Merge.
authorblanchet
Wed, 04 Mar 2009 10:45:52 +0100
changeset 302405b25fee0362c
parent 30239 179ff9cb160b
child 30241 3a1aef73b2b2
Merge.
doc-src/IsarImplementation/Thy/ML.thy
doc-src/IsarImplementation/Thy/ROOT.ML
doc-src/IsarImplementation/Thy/document/ML.tex
doc-src/IsarImplementation/Thy/document/session.tex
doc-src/IsarImplementation/implementation.tex
doc-src/IsarImplementation/style.sty
doc-src/IsarRef/IsaMakefile
doc-src/IsarRef/Makefile
doc-src/IsarRef/Thy/Document_Preparation.thy
doc-src/IsarRef/Thy/Generic.thy
doc-src/IsarRef/Thy/HOLCF_Specific.thy
doc-src/IsarRef/Thy/HOL_Specific.thy
doc-src/IsarRef/Thy/Inner_Syntax.thy
doc-src/IsarRef/Thy/Introduction.thy
doc-src/IsarRef/Thy/ML_Tactic.thy
doc-src/IsarRef/Thy/Misc.thy
doc-src/IsarRef/Thy/Outer_Syntax.thy
doc-src/IsarRef/Thy/Proof.thy
doc-src/IsarRef/Thy/Quick_Reference.thy
doc-src/IsarRef/Thy/ROOT-HOLCF.ML
doc-src/IsarRef/Thy/ROOT-ZF.ML
doc-src/IsarRef/Thy/ROOT.ML
doc-src/IsarRef/Thy/Spec.thy
doc-src/IsarRef/Thy/Symbols.thy
doc-src/IsarRef/Thy/ZF_Specific.thy
doc-src/IsarRef/Thy/document/Document_Preparation.tex
doc-src/IsarRef/Thy/document/Generic.tex
doc-src/IsarRef/Thy/document/HOLCF_Specific.tex
doc-src/IsarRef/Thy/document/HOL_Specific.tex
doc-src/IsarRef/Thy/document/Inner_Syntax.tex
doc-src/IsarRef/Thy/document/Introduction.tex
doc-src/IsarRef/Thy/document/ML_Tactic.tex
doc-src/IsarRef/Thy/document/Misc.tex
doc-src/IsarRef/Thy/document/Outer_Syntax.tex
doc-src/IsarRef/Thy/document/Proof.tex
doc-src/IsarRef/Thy/document/Quick_Reference.tex
doc-src/IsarRef/Thy/document/Spec.tex
doc-src/IsarRef/Thy/document/Symbols.tex
doc-src/IsarRef/Thy/document/ZF_Specific.tex
doc-src/IsarRef/isar-ref.tex
doc-src/IsarRef/style.sty
doc-src/Ref/Makefile
doc-src/Ref/classical.tex
doc-src/Ref/defining.tex
doc-src/Ref/introduction.tex
doc-src/Ref/ref.tex
doc-src/Ref/simplifier.tex
doc-src/Ref/substitution.tex
doc-src/Ref/syntax.tex
doc-src/Ref/tactic.tex
doc-src/Ref/tctical.tex
doc-src/Ref/theories.tex
doc-src/Ref/thm.tex
doc-src/System/Thy/Basics.thy
doc-src/System/Thy/Presentation.thy
doc-src/System/Thy/document/Basics.tex
doc-src/System/Thy/document/Presentation.tex
doc-src/System/system.tex
doc-src/TutorialI/Types/Numbers.thy
doc-src/TutorialI/Types/document/Numbers.tex
doc-src/TutorialI/Types/numerics.tex
doc-src/ZF/FOL.tex
doc-src/antiquote_setup.ML
doc-src/isar.sty
doc-src/manual.bib
doc-src/more_antiquote.ML
doc/Contents
etc/settings
lib/Tools/codegen
src/FOL/IFOL.thy
src/FOL/IsaMakefile
src/FOL/ex/ROOT.ML
src/FOLP/simp.ML
src/HOL/Algebra/Coset.thy
src/HOL/Algebra/Exponent.thy
src/HOL/Algebra/Sylow.thy
src/HOL/Algebra/poly/UnivPoly2.thy
src/HOL/Arith_Tools.thy
src/HOL/Complex_Main.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Decision_Procs/Cooper.thy
src/HOL/Decision_Procs/Ferrack.thy
src/HOL/Decision_Procs/MIR.thy
src/HOL/Decision_Procs/cooper_tac.ML
src/HOL/Decision_Procs/ferrack_tac.ML
src/HOL/Decision_Procs/mir_tac.ML
src/HOL/Deriv.thy
src/HOL/Divides.thy
src/HOL/Equiv_Relations.thy
src/HOL/Extraction/Euclid.thy
src/HOL/Fact.thy
src/HOL/GCD.thy
src/HOL/Groebner_Basis.thy
src/HOL/HOL.thy
src/HOL/Hoare/Arith2.thy
src/HOL/Import/lazy_seq.ML
src/HOL/Import/proof_kernel.ML
src/HOL/Induct/Common_Patterns.thy
src/HOL/Induct/LList.thy
src/HOL/Induct/QuoDataType.thy
src/HOL/Induct/QuoNestedDataType.thy
src/HOL/Induct/SList.thy
src/HOL/Int.thy
src/HOL/IntDiv.thy
src/HOL/Integration.thy
src/HOL/IsaMakefile
src/HOL/Library/Abstract_Rat.thy
src/HOL/Library/Boolean_Algebra.thy
src/HOL/Library/Char_nat.thy
src/HOL/Library/Code_Char.thy
src/HOL/Library/Coinductive_List.thy
src/HOL/Library/Determinants.thy
src/HOL/Library/Enum.thy
src/HOL/Library/Euclidean_Space.thy
src/HOL/Library/Float.thy
src/HOL/Library/Fundamental_Theorem_Algebra.thy
src/HOL/Library/Library.thy
src/HOL/Library/Numeral_Type.thy
src/HOL/Library/Order_Relation.thy
src/HOL/Library/Permutations.thy
src/HOL/Library/Pocklington.thy
src/HOL/Library/Primes.thy
src/HOL/Library/Word.thy
src/HOL/Library/Zorn.thy
src/HOL/Library/reflection.ML
src/HOL/List.thy
src/HOL/MacLaurin.thy
src/HOL/MetisExamples/Tarski.thy
src/HOL/NSA/NSA.thy
src/HOL/NSA/StarDef.thy
src/HOL/Nat.thy
src/HOL/NatBin.thy
src/HOL/Nominal/Examples/Fsub.thy
src/HOL/Nominal/Nominal.thy
src/HOL/Nominal/nominal_atoms.ML
src/HOL/Nominal/nominal_induct.ML
src/HOL/Nominal/nominal_inductive.ML
src/HOL/Nominal/nominal_inductive2.ML
src/HOL/Nominal/nominal_package.ML
src/HOL/Nominal/nominal_primrec.ML
src/HOL/Nominal/nominal_thmdecls.ML
src/HOL/NumberTheory/Chinese.thy
src/HOL/NumberTheory/Euler.thy
src/HOL/NumberTheory/EulerFermat.thy
src/HOL/NumberTheory/Gauss.thy
src/HOL/NumberTheory/Int2.thy
src/HOL/NumberTheory/IntPrimes.thy
src/HOL/NumberTheory/Quadratic_Reciprocity.thy
src/HOL/NumberTheory/Residues.thy
src/HOL/NumberTheory/WilsonBij.thy
src/HOL/NumberTheory/WilsonRuss.thy
src/HOL/Orderings.thy
src/HOL/Parity.thy
src/HOL/Plain.thy
src/HOL/Power.thy
src/HOL/Presburger.thy
src/HOL/RComplete.thy
src/HOL/ROOT.ML
src/HOL/Rational.thy
src/HOL/RealDef.thy
src/HOL/RealPow.thy
src/HOL/RealVector.thy
src/HOL/Relation.thy
src/HOL/Relation_Power.thy
src/HOL/Ring_and_Field.thy
src/HOL/SEQ.thy
src/HOL/Series.thy
src/HOL/SetInterval.thy
src/HOL/Tools/Qelim/langford.ML
src/HOL/Tools/Qelim/presburger.ML
src/HOL/Tools/TFL/post.ML
src/HOL/Tools/TFL/rules.ML
src/HOL/Tools/TFL/tfl.ML
src/HOL/Tools/atp_wrapper.ML
src/HOL/Tools/datatype_abs_proofs.ML
src/HOL/Tools/datatype_aux.ML
src/HOL/Tools/datatype_codegen.ML
src/HOL/Tools/datatype_package.ML
src/HOL/Tools/datatype_prop.ML
src/HOL/Tools/datatype_realizer.ML
src/HOL/Tools/datatype_rep_proofs.ML
src/HOL/Tools/function_package/fundef_common.ML
src/HOL/Tools/function_package/fundef_package.ML
src/HOL/Tools/function_package/scnp_solve.ML
src/HOL/Tools/function_package/size.ML
src/HOL/Tools/inductive_codegen.ML
src/HOL/Tools/inductive_package.ML
src/HOL/Tools/inductive_realizer.ML
src/HOL/Tools/inductive_set_package.ML
src/HOL/Tools/int_factor_simprocs.ML
src/HOL/Tools/lin_arith.ML
src/HOL/Tools/meson.ML
src/HOL/Tools/metis_tools.ML
src/HOL/Tools/old_primrec_package.ML
src/HOL/Tools/primrec_package.ML
src/HOL/Tools/recdef_package.ML
src/HOL/Tools/recfun_codegen.ML
src/HOL/Tools/record_package.ML
src/HOL/Tools/refute.ML
src/HOL/Tools/res_atp.ML
src/HOL/Tools/res_axioms.ML
src/HOL/Tools/res_clause.ML
src/HOL/Tools/res_hol_clause.ML
src/HOL/Tools/res_reconstruct.ML
src/HOL/Tools/sat_solver.ML
src/HOL/Tools/simpdata.ML
src/HOL/Tools/specification_package.ML
src/HOL/Transcendental.thy
src/HOL/Transitive_Closure.thy
src/HOL/UNITY/ListOrder.thy
src/HOL/UNITY/ProgressSets.thy
src/HOL/UNITY/UNITY.thy
src/HOL/Word/BinGeneral.thy
src/HOL/Word/Num_Lemmas.thy
src/HOL/Word/WordGenLib.thy
src/HOL/Word/WordShift.thy
src/HOL/ZF/Games.thy
src/HOL/ex/ApproximationEx.thy
src/HOL/ex/Eval_Examples.thy
src/HOL/ex/Numeral.thy
src/HOL/ex/ROOT.ML
src/HOL/ex/Tarski.thy
src/HOL/ex/ThreeDivides.thy
src/HOLCF/ConvexPD.thy
src/HOLCF/Fixrec.thy
src/HOLCF/IsaMakefile
src/HOLCF/LowerPD.thy
src/HOLCF/Tools/domain/domain_axioms.ML
src/HOLCF/Tools/domain/domain_library.ML
src/HOLCF/Tools/domain/domain_syntax.ML
src/HOLCF/Tools/fixrec_package.ML
src/HOLCF/UpperPD.thy
src/HOLCF/ex/Fixrec_ex.thy
src/HOLCF/ex/ROOT.ML
src/Provers/README
src/Provers/blast.ML
src/Provers/clasimp.ML
src/Provers/classical.ML
src/Provers/order.ML
src/Provers/trancl.ML
src/Provers/typedsimp.ML
src/Pure/General/binding.ML
src/Pure/General/markup.ML
src/Pure/General/name_space.ML
src/Pure/General/output.ML
src/Pure/General/swing.scala
src/Pure/IsaMakefile
src/Pure/Isar/ROOT.ML
src/Pure/Isar/args.ML
src/Pure/Isar/attrib.ML
src/Pure/Isar/calculation.ML
src/Pure/Isar/class.ML
src/Pure/Isar/class_target.ML
src/Pure/Isar/code.ML
src/Pure/Isar/code_unit.ML
src/Pure/Isar/constdefs.ML
src/Pure/Isar/element.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/isar_cmd.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/local_defs.ML
src/Pure/Isar/locale.ML
src/Pure/Isar/method.ML
src/Pure/Isar/obtain.ML
src/Pure/Isar/outer_parse.ML
src/Pure/Isar/proof.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/Isar/theory_target.ML
src/Pure/ML-Systems/mosml.ML
src/Pure/ML-Systems/polyml-experimental.ML
src/Pure/ML-Systems/polyml_common.ML
src/Pure/ML-Systems/smlnj.ML
src/Pure/ML/ml_antiquote.ML
src/Pure/ML/ml_syntax.ML
src/Pure/Proof/proofchecker.ML
src/Pure/Proof/reconstruct.ML
src/Pure/ProofGeneral/README
src/Pure/README
src/Pure/ROOT.ML
src/Pure/Syntax/parser.ML
src/Pure/Syntax/syn_ext.ML
src/Pure/Syntax/syn_trans.ML
src/Pure/Syntax/syntax.ML
src/Pure/Thy/thy_output.ML
src/Pure/Tools/ROOT.ML
src/Pure/axclass.ML
src/Pure/conv.ML
src/Pure/display.ML
src/Pure/envir.ML
src/Pure/library.ML
src/Pure/mk
src/Pure/more_thm.ML
src/Pure/proofterm.ML
src/Pure/pure_setup.ML
src/Pure/pure_thy.ML
src/Pure/sign.ML
src/Pure/sorts.ML
src/Pure/tctical.ML
src/Pure/term.ML
src/Pure/theory.ML
src/Pure/type_infer.ML
src/Tools/Compute_Oracle/Compute_Oracle.thy
src/Tools/Compute_Oracle/am_compiler.ML
src/Tools/Compute_Oracle/am_ghc.ML
src/Tools/Compute_Oracle/am_interpreter.ML
src/Tools/Compute_Oracle/am_sml.ML
src/Tools/Compute_Oracle/report.ML
src/Tools/IsaPlanner/README
src/Tools/IsaPlanner/isand.ML
src/Tools/IsaPlanner/rw_inst.ML
src/Tools/IsaPlanner/rw_tools.ML
src/Tools/IsaPlanner/zipper.ML
src/Tools/Metis/make-metis
src/Tools/Metis/metis.ML
src/Tools/README
src/Tools/atomize_elim.ML
src/Tools/auto_solve.ML
src/Tools/code/code_funcgr.ML
src/Tools/code/code_haskell.ML
src/Tools/code/code_name.ML
src/Tools/code/code_printer.ML
src/Tools/code/code_target.ML
src/Tools/code/code_thingol.ML
src/Tools/float.ML
src/Tools/induct.ML
src/Tools/induct_tacs.ML
src/Tools/nbe.ML
src/Tools/random_word.ML
src/Tools/rat.ML
src/ZF/Tools/datatype_package.ML
src/ZF/Tools/inductive_package.ML
src/ZF/Tools/primrec_package.ML
     1.1 --- a/doc-src/IsarImplementation/Thy/ML.thy	Wed Mar 04 10:43:39 2009 +0100
     1.2 +++ b/doc-src/IsarImplementation/Thy/ML.thy	Wed Mar 04 10:45:52 2009 +0100
     1.3 @@ -1,6 +1,6 @@
     1.4 -(* $Id$ *)
     1.5 -
     1.6 -theory "ML" imports base begin
     1.7 +theory "ML"
     1.8 +imports Base
     1.9 +begin
    1.10  
    1.11  chapter {* Advanced ML programming *}
    1.12  
     2.1 --- a/doc-src/IsarImplementation/Thy/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
     2.2 +++ b/doc-src/IsarImplementation/Thy/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
     2.3 @@ -1,11 +1,11 @@
     2.4 -
     2.5 -(* $Id$ *)
     2.6 -
     2.7 -use_thy "prelim";
     2.8 -use_thy "logic";
     2.9 -use_thy "tactic";
    2.10 -use_thy "proof";
    2.11 -use_thy "isar";
    2.12 -use_thy "locale";
    2.13 -use_thy "integration";
    2.14 -use_thy "ML";
    2.15 +use_thys [
    2.16 +  "Integration",
    2.17 +  "Isar",
    2.18 +  "Local_Theory",
    2.19 +  "Logic",
    2.20 +  "ML",
    2.21 +  "Prelim",
    2.22 +  "Proof",
    2.23 +  "Syntax",
    2.24 +  "Tactic"
    2.25 +];
     3.1 --- a/doc-src/IsarImplementation/Thy/document/ML.tex	Wed Mar 04 10:43:39 2009 +0100
     3.2 +++ b/doc-src/IsarImplementation/Thy/document/ML.tex	Wed Mar 04 10:45:52 2009 +0100
     3.3 @@ -3,14 +3,14 @@
     3.4  \def\isabellecontext{ML}%
     3.5  %
     3.6  \isadelimtheory
     3.7 -\isanewline
     3.8 -\isanewline
     3.9  %
    3.10  \endisadelimtheory
    3.11  %
    3.12  \isatagtheory
    3.13  \isacommand{theory}\isamarkupfalse%
    3.14 -\ {\isachardoublequoteopen}ML{\isachardoublequoteclose}\ \isakeyword{imports}\ base\ \isakeyword{begin}%
    3.15 +\ {\isachardoublequoteopen}ML{\isachardoublequoteclose}\isanewline
    3.16 +\isakeyword{imports}\ Base\isanewline
    3.17 +\isakeyword{begin}%
    3.18  \endisatagtheory
    3.19  {\isafoldtheory}%
    3.20  %
    3.21 @@ -275,9 +275,9 @@
    3.22  %
    3.23  \begin{isamarkuptext}%
    3.24  \begin{mldecls}
    3.25 -  \indexml{NAMED\_CRITICAL}\verb|NAMED_CRITICAL: string -> (unit -> 'a) -> 'a| \\
    3.26 -  \indexml{CRITICAL}\verb|CRITICAL: (unit -> 'a) -> 'a| \\
    3.27 -  \indexml{setmp}\verb|setmp: 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
    3.28 +  \indexdef{}{ML}{NAMED\_CRITICAL}\verb|NAMED_CRITICAL: string -> (unit -> 'a) -> 'a| \\
    3.29 +  \indexdef{}{ML}{CRITICAL}\verb|CRITICAL: (unit -> 'a) -> 'a| \\
    3.30 +  \indexdef{}{ML}{setmp}\verb|setmp: 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
    3.31    \end{mldecls}
    3.32  
    3.33    \begin{description}
    3.34 @@ -331,7 +331,7 @@
    3.35  %
    3.36  \begin{isamarkuptext}%
    3.37  \begin{mldecls}
    3.38 -  \indexml{op |$>$ }\verb|op |\verb,|,\verb|> : 'a * ('a -> 'b) -> 'b| \\
    3.39 +  \indexdef{}{ML}{op $\mid$$>$ }\verb|op |\verb,|,\verb|> : 'a * ('a -> 'b) -> 'b| \\
    3.40    \end{mldecls}%
    3.41  \end{isamarkuptext}%
    3.42  \isamarkuptrue%
    3.43 @@ -410,10 +410,10 @@
    3.44  %
    3.45  \begin{isamarkuptext}%
    3.46  \begin{mldecls}
    3.47 -  \indexml{op |-$>$ }\verb|op |\verb,|,\verb|-> : ('c * 'a) * ('c -> 'a -> 'b) -> 'b| \\
    3.48 -  \indexml{op |$>$$>$ }\verb|op |\verb,|,\verb|>> : ('a * 'c) * ('a -> 'b) -> 'b * 'c| \\
    3.49 -  \indexml{op ||$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|> : ('c * 'a) * ('a -> 'b) -> 'c * 'b| \\
    3.50 -  \indexml{op ||$>$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|>> : ('c * 'a) * ('a -> 'd * 'b) -> ('c * 'd) * 'b| \\
    3.51 +  \indexdef{}{ML}{op $\mid$-$>$ }\verb|op |\verb,|,\verb|-> : ('c * 'a) * ('c -> 'a -> 'b) -> 'b| \\
    3.52 +  \indexdef{}{ML}{op $\mid$$>$$>$ }\verb|op |\verb,|,\verb|>> : ('a * 'c) * ('a -> 'b) -> 'b * 'c| \\
    3.53 +  \indexdef{}{ML}{op $\mid$$\mid$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|> : ('c * 'a) * ('a -> 'b) -> 'c * 'b| \\
    3.54 +  \indexdef{}{ML}{op $\mid$$\mid$$>$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|>> : ('c * 'a) * ('a -> 'd * 'b) -> ('c * 'd) * 'b| \\
    3.55    \end{mldecls}%
    3.56  \end{isamarkuptext}%
    3.57  \isamarkuptrue%
    3.58 @@ -483,8 +483,8 @@
    3.59  %
    3.60  \begin{isamarkuptext}%
    3.61  \begin{mldecls}
    3.62 -  \indexml{fold}\verb|fold: ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b| \\
    3.63 -  \indexml{fold\_map}\verb|fold_map: ('a -> 'b -> 'c * 'b) -> 'a list -> 'b -> 'c list * 'b| \\
    3.64 +  \indexdef{}{ML}{fold}\verb|fold: ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b| \\
    3.65 +  \indexdef{}{ML}{fold\_map}\verb|fold_map: ('a -> 'b -> 'c * 'b) -> 'a list -> 'b -> 'c list * 'b| \\
    3.66    \end{mldecls}%
    3.67  \end{isamarkuptext}%
    3.68  \isamarkuptrue%
    3.69 @@ -545,11 +545,11 @@
    3.70  %
    3.71  \begin{isamarkuptext}%
    3.72  \begin{mldecls}
    3.73 -  \indexml{op \#$>$ }\verb|op #> : ('a -> 'b) * ('b -> 'c) -> 'a -> 'c| \\
    3.74 -  \indexml{op \#-$>$ }\verb|op #-> : ('a -> 'c * 'b) * ('c -> 'b -> 'd) -> 'a -> 'd| \\
    3.75 -  \indexml{op \#$>$$>$ }\verb|op #>> : ('a -> 'c * 'b) * ('c -> 'd) -> 'a -> 'd * 'b| \\
    3.76 -  \indexml{op \#\#$>$ }\verb|op ##> : ('a -> 'c * 'b) * ('b -> 'd) -> 'a -> 'c * 'd| \\
    3.77 -  \indexml{op \#\#$>$$>$ }\verb|op ##>> : ('a -> 'c * 'b) * ('b -> 'e * 'd) -> 'a -> ('c * 'e) * 'd| \\
    3.78 +  \indexdef{}{ML}{op \#$>$ }\verb|op #> : ('a -> 'b) * ('b -> 'c) -> 'a -> 'c| \\
    3.79 +  \indexdef{}{ML}{op \#-$>$ }\verb|op #-> : ('a -> 'c * 'b) * ('c -> 'b -> 'd) -> 'a -> 'd| \\
    3.80 +  \indexdef{}{ML}{op \#$>$$>$ }\verb|op #>> : ('a -> 'c * 'b) * ('c -> 'd) -> 'a -> 'd * 'b| \\
    3.81 +  \indexdef{}{ML}{op \#\#$>$ }\verb|op ##> : ('a -> 'c * 'b) * ('b -> 'd) -> 'a -> 'c * 'd| \\
    3.82 +  \indexdef{}{ML}{op \#\#$>$$>$ }\verb|op ##>> : ('a -> 'c * 'b) * ('b -> 'e * 'd) -> 'a -> ('c * 'e) * 'd| \\
    3.83    \end{mldecls}%
    3.84  \end{isamarkuptext}%
    3.85  \isamarkuptrue%
    3.86 @@ -576,8 +576,8 @@
    3.87  %
    3.88  \begin{isamarkuptext}%
    3.89  \begin{mldecls}
    3.90 -  \indexml{op ` }\verb|op ` : ('b -> 'a) -> 'b -> 'a * 'b| \\
    3.91 -  \indexml{tap}\verb|tap: ('b -> 'a) -> 'b -> 'b| \\
    3.92 +  \indexdef{}{ML}{op ` }\verb|op ` : ('b -> 'a) -> 'b -> 'a * 'b| \\
    3.93 +  \indexdef{}{ML}{tap}\verb|tap: ('b -> 'a) -> 'b -> 'b| \\
    3.94    \end{mldecls}%
    3.95  \end{isamarkuptext}%
    3.96  \isamarkuptrue%
    3.97 @@ -619,14 +619,14 @@
    3.98  %
    3.99  \begin{isamarkuptext}%
   3.100  \begin{mldecls}
   3.101 -  \indexml{is\_some}\verb|is_some: 'a option -> bool| \\
   3.102 -  \indexml{is\_none}\verb|is_none: 'a option -> bool| \\
   3.103 -  \indexml{the}\verb|the: 'a option -> 'a| \\
   3.104 -  \indexml{these}\verb|these: 'a list option -> 'a list| \\
   3.105 -  \indexml{the\_list}\verb|the_list: 'a option -> 'a list| \\
   3.106 -  \indexml{the\_default}\verb|the_default: 'a -> 'a option -> 'a| \\
   3.107 -  \indexml{try}\verb|try: ('a -> 'b) -> 'a -> 'b option| \\
   3.108 -  \indexml{can}\verb|can: ('a -> 'b) -> 'a -> bool| \\
   3.109 +  \indexdef{}{ML}{is\_some}\verb|is_some: 'a option -> bool| \\
   3.110 +  \indexdef{}{ML}{is\_none}\verb|is_none: 'a option -> bool| \\
   3.111 +  \indexdef{}{ML}{the}\verb|the: 'a option -> 'a| \\
   3.112 +  \indexdef{}{ML}{these}\verb|these: 'a list option -> 'a list| \\
   3.113 +  \indexdef{}{ML}{the\_list}\verb|the_list: 'a option -> 'a list| \\
   3.114 +  \indexdef{}{ML}{the\_default}\verb|the_default: 'a -> 'a option -> 'a| \\
   3.115 +  \indexdef{}{ML}{try}\verb|try: ('a -> 'b) -> 'a -> 'b option| \\
   3.116 +  \indexdef{}{ML}{can}\verb|can: ('a -> 'b) -> 'a -> bool| \\
   3.117    \end{mldecls}%
   3.118  \end{isamarkuptext}%
   3.119  \isamarkuptrue%
   3.120 @@ -659,10 +659,10 @@
   3.121  %
   3.122  \begin{isamarkuptext}%
   3.123  \begin{mldecls}
   3.124 -  \indexml{member}\verb|member: ('b * 'a -> bool) -> 'a list -> 'b -> bool| \\
   3.125 -  \indexml{insert}\verb|insert: ('a * 'a -> bool) -> 'a -> 'a list -> 'a list| \\
   3.126 -  \indexml{remove}\verb|remove: ('b * 'a -> bool) -> 'b -> 'a list -> 'a list| \\
   3.127 -  \indexml{merge}\verb|merge: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list| \\
   3.128 +  \indexdef{}{ML}{member}\verb|member: ('b * 'a -> bool) -> 'a list -> 'b -> bool| \\
   3.129 +  \indexdef{}{ML}{insert}\verb|insert: ('a * 'a -> bool) -> 'a -> 'a list -> 'a list| \\
   3.130 +  \indexdef{}{ML}{remove}\verb|remove: ('b * 'a -> bool) -> 'b -> 'a list -> 'a list| \\
   3.131 +  \indexdef{}{ML}{merge}\verb|merge: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list| \\
   3.132    \end{mldecls}%
   3.133  \end{isamarkuptext}%
   3.134  \isamarkuptrue%
   3.135 @@ -690,19 +690,19 @@
   3.136  %
   3.137  \begin{isamarkuptext}%
   3.138  \begin{mldecls}
   3.139 -  \indexmlexception{AList.DUP}\verb|exception AList.DUP| \\
   3.140 -  \indexml{AList.lookup}\verb|AList.lookup: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> 'c option| \\
   3.141 -  \indexml{AList.defined}\verb|AList.defined: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> bool| \\
   3.142 -  \indexml{AList.update}\verb|AList.update: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
   3.143 -  \indexml{AList.default}\verb|AList.default: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
   3.144 -  \indexml{AList.delete}\verb|AList.delete: ('a * 'b -> bool) -> 'a -> ('b * 'c) list -> ('b * 'c) list| \\
   3.145 -  \indexml{AList.map\_entry}\verb|AList.map_entry: ('a * 'b -> bool) -> 'a|\isasep\isanewline%
   3.146 +  \indexdef{}{ML exception}{AList.DUP}\verb|exception AList.DUP| \\
   3.147 +  \indexdef{}{ML}{AList.lookup}\verb|AList.lookup: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> 'c option| \\
   3.148 +  \indexdef{}{ML}{AList.defined}\verb|AList.defined: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> bool| \\
   3.149 +  \indexdef{}{ML}{AList.update}\verb|AList.update: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
   3.150 +  \indexdef{}{ML}{AList.default}\verb|AList.default: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
   3.151 +  \indexdef{}{ML}{AList.delete}\verb|AList.delete: ('a * 'b -> bool) -> 'a -> ('b * 'c) list -> ('b * 'c) list| \\
   3.152 +  \indexdef{}{ML}{AList.map\_entry}\verb|AList.map_entry: ('a * 'b -> bool) -> 'a|\isasep\isanewline%
   3.153  \verb|    -> ('c -> 'c) -> ('b * 'c) list -> ('b * 'c) list| \\
   3.154 -  \indexml{AList.map\_default}\verb|AList.map_default: ('a * 'a -> bool) -> 'a * 'b -> ('b -> 'b)|\isasep\isanewline%
   3.155 +  \indexdef{}{ML}{AList.map\_default}\verb|AList.map_default: ('a * 'a -> bool) -> 'a * 'b -> ('b -> 'b)|\isasep\isanewline%
   3.156  \verb|    -> ('a * 'b) list -> ('a * 'b) list| \\
   3.157 -  \indexml{AList.join}\verb|AList.join: ('a * 'a -> bool) -> ('a -> 'b * 'b -> 'b) (*exception DUP*)|\isasep\isanewline%
   3.158 +  \indexdef{}{ML}{AList.join}\verb|AList.join: ('a * 'a -> bool) -> ('a -> 'b * 'b -> 'b) (*exception DUP*)|\isasep\isanewline%
   3.159  \verb|    -> ('a * 'b) list * ('a * 'b) list -> ('a * 'b) list (*exception AList.DUP*)| \\
   3.160 -  \indexml{AList.merge}\verb|AList.merge: ('a * 'a -> bool) -> ('b * 'b -> bool)|\isasep\isanewline%
   3.161 +  \indexdef{}{ML}{AList.merge}\verb|AList.merge: ('a * 'a -> bool) -> ('b * 'b -> bool)|\isasep\isanewline%
   3.162  \verb|    -> ('a * 'b) list * ('a * 'b) list -> ('a * 'b) list (*exception AList.DUP*)|
   3.163    \end{mldecls}%
   3.164  \end{isamarkuptext}%
   3.165 @@ -732,25 +732,25 @@
   3.166  %
   3.167  \begin{isamarkuptext}%
   3.168  \begin{mldecls}
   3.169 -  \indexmltype{'a Symtab.table}\verb|type 'a Symtab.table| \\
   3.170 -  \indexmlexception{Symtab.DUP}\verb|exception Symtab.DUP of string| \\
   3.171 -  \indexmlexception{Symtab.SAME}\verb|exception Symtab.SAME| \\
   3.172 -  \indexmlexception{Symtab.UNDEF}\verb|exception Symtab.UNDEF of string| \\
   3.173 -  \indexml{Symtab.empty}\verb|Symtab.empty: 'a Symtab.table| \\
   3.174 -  \indexml{Symtab.lookup}\verb|Symtab.lookup: 'a Symtab.table -> string -> 'a option| \\
   3.175 -  \indexml{Symtab.defined}\verb|Symtab.defined: 'a Symtab.table -> string -> bool| \\
   3.176 -  \indexml{Symtab.update}\verb|Symtab.update: (string * 'a) -> 'a Symtab.table -> 'a Symtab.table| \\
   3.177 -  \indexml{Symtab.default}\verb|Symtab.default: string * 'a -> 'a Symtab.table -> 'a Symtab.table| \\
   3.178 -  \indexml{Symtab.delete}\verb|Symtab.delete: string|\isasep\isanewline%
   3.179 +  \indexdef{}{ML type}{'a Symtab.table}\verb|type 'a Symtab.table| \\
   3.180 +  \indexdef{}{ML exception}{Symtab.DUP}\verb|exception Symtab.DUP of string| \\
   3.181 +  \indexdef{}{ML exception}{Symtab.SAME}\verb|exception Symtab.SAME| \\
   3.182 +  \indexdef{}{ML exception}{Symtab.UNDEF}\verb|exception Symtab.UNDEF of string| \\
   3.183 +  \indexdef{}{ML}{Symtab.empty}\verb|Symtab.empty: 'a Symtab.table| \\
   3.184 +  \indexdef{}{ML}{Symtab.lookup}\verb|Symtab.lookup: 'a Symtab.table -> string -> 'a option| \\
   3.185 +  \indexdef{}{ML}{Symtab.defined}\verb|Symtab.defined: 'a Symtab.table -> string -> bool| \\
   3.186 +  \indexdef{}{ML}{Symtab.update}\verb|Symtab.update: (string * 'a) -> 'a Symtab.table -> 'a Symtab.table| \\
   3.187 +  \indexdef{}{ML}{Symtab.default}\verb|Symtab.default: string * 'a -> 'a Symtab.table -> 'a Symtab.table| \\
   3.188 +  \indexdef{}{ML}{Symtab.delete}\verb|Symtab.delete: string|\isasep\isanewline%
   3.189  \verb|    -> 'a Symtab.table -> 'a Symtab.table (*exception Symtab.UNDEF*)| \\
   3.190 -  \indexml{Symtab.map\_entry}\verb|Symtab.map_entry: string -> ('a -> 'a)|\isasep\isanewline%
   3.191 +  \indexdef{}{ML}{Symtab.map\_entry}\verb|Symtab.map_entry: string -> ('a -> 'a)|\isasep\isanewline%
   3.192  \verb|    -> 'a Symtab.table -> 'a Symtab.table| \\
   3.193 -  \indexml{Symtab.map\_default}\verb|Symtab.map_default: (string * 'a) -> ('a -> 'a)|\isasep\isanewline%
   3.194 +  \indexdef{}{ML}{Symtab.map\_default}\verb|Symtab.map_default: (string * 'a) -> ('a -> 'a)|\isasep\isanewline%
   3.195  \verb|    -> 'a Symtab.table -> 'a Symtab.table| \\
   3.196 -  \indexml{Symtab.join}\verb|Symtab.join: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*)|\isasep\isanewline%
   3.197 +  \indexdef{}{ML}{Symtab.join}\verb|Symtab.join: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*)|\isasep\isanewline%
   3.198  \verb|    -> 'a Symtab.table * 'a Symtab.table|\isasep\isanewline%
   3.199  \verb|    -> 'a Symtab.table (*exception Symtab.DUP*)| \\
   3.200 -  \indexml{Symtab.merge}\verb|Symtab.merge: ('a * 'a -> bool)|\isasep\isanewline%
   3.201 +  \indexdef{}{ML}{Symtab.merge}\verb|Symtab.merge: ('a * 'a -> bool)|\isasep\isanewline%
   3.202  \verb|    -> 'a Symtab.table * 'a Symtab.table|\isasep\isanewline%
   3.203  \verb|    -> 'a Symtab.table (*exception Symtab.DUP*)|
   3.204    \end{mldecls}%
     4.1 --- a/doc-src/IsarImplementation/Thy/document/session.tex	Wed Mar 04 10:43:39 2009 +0100
     4.2 +++ b/doc-src/IsarImplementation/Thy/document/session.tex	Wed Mar 04 10:45:52 2009 +0100
     4.3 @@ -1,21 +1,23 @@
     4.4 -\input{base.tex}
     4.5 +\input{Base.tex}
     4.6  
     4.7 -\input{prelim.tex}
     4.8 +\input{Integration.tex}
     4.9  
    4.10 -\input{logic.tex}
    4.11 +\input{Isar.tex}
    4.12  
    4.13 -\input{tactic.tex}
    4.14 +\input{Local_Theory.tex}
    4.15  
    4.16 -\input{proof.tex}
    4.17 -
    4.18 -\input{isar.tex}
    4.19 -
    4.20 -\input{locale.tex}
    4.21 -
    4.22 -\input{integration.tex}
    4.23 +\input{Logic.tex}
    4.24  
    4.25  \input{ML.tex}
    4.26  
    4.27 +\input{Prelim.tex}
    4.28 +
    4.29 +\input{Proof.tex}
    4.30 +
    4.31 +\input{Syntax.tex}
    4.32 +
    4.33 +\input{Tactic.tex}
    4.34 +
    4.35  %%% Local Variables:
    4.36  %%% mode: latex
    4.37  %%% TeX-master: "root"
     5.1 --- a/doc-src/IsarImplementation/implementation.tex	Wed Mar 04 10:43:39 2009 +0100
     5.2 +++ b/doc-src/IsarImplementation/implementation.tex	Wed Mar 04 10:45:52 2009 +0100
     5.3 @@ -1,6 +1,3 @@
     5.4 -
     5.5 -%% $Id$
     5.6 -
     5.7  \documentclass[12pt,a4paper,fleqn]{report}
     5.8  \usepackage{latexsym,graphicx}
     5.9  \usepackage[refpage]{nomencl}
    5.10 @@ -23,9 +20,6 @@
    5.11    and Larry Paulson
    5.12  }
    5.13  
    5.14 -%FIXME
    5.15 -%\makeglossary
    5.16 -
    5.17  \makeindex
    5.18  
    5.19  
    5.20 @@ -71,28 +65,24 @@
    5.21  \listoffigures
    5.22  \clearfirst
    5.23  
    5.24 -%\input{intro.tex}
    5.25 -\input{Thy/document/prelim.tex}
    5.26 -\input{Thy/document/logic.tex}
    5.27 -\input{Thy/document/tactic.tex}
    5.28 -\input{Thy/document/proof.tex}
    5.29 -\input{Thy/document/isar.tex}
    5.30 -\input{Thy/document/locale.tex}
    5.31 -\input{Thy/document/integration.tex}
    5.32 +\input{Thy/document/Prelim.tex}
    5.33 +\input{Thy/document/Logic.tex}
    5.34 +\input{Thy/document/Tactic.tex}
    5.35 +\input{Thy/document/Proof.tex}
    5.36 +\input{Thy/document/Syntax.tex}
    5.37 +\input{Thy/document/Isar.tex}
    5.38 +\input{Thy/document/Local_Theory.tex}
    5.39 +\input{Thy/document/Integration.tex}
    5.40  
    5.41  \appendix
    5.42  \input{Thy/document/ML.tex}
    5.43  
    5.44  \begingroup
    5.45  \tocentry{\bibname}
    5.46 -\bibliographystyle{plain} \small\raggedright\frenchspacing
    5.47 +\bibliographystyle{abbrv} \small\raggedright\frenchspacing
    5.48  \bibliography{../manual}
    5.49  \endgroup
    5.50  
    5.51 -%FIXME
    5.52 -%\tocentry{\glossaryname}
    5.53 -%\printglossary
    5.54 -
    5.55  \tocentry{\indexname}
    5.56  \printindex
    5.57  
     6.1 --- a/doc-src/IsarImplementation/style.sty	Wed Mar 04 10:43:39 2009 +0100
     6.2 +++ b/doc-src/IsarImplementation/style.sty	Wed Mar 04 10:45:52 2009 +0100
     6.3 @@ -1,6 +1,3 @@
     6.4 -
     6.5 -%% $Id$
     6.6 -
     6.7  %% toc
     6.8  \newcommand{\tocentry}[1]{\cleardoublepage\phantomsection\addcontentsline{toc}{chapter}{#1}
     6.9  \@mkboth{\MakeUppercase{#1}}{\MakeUppercase{#1}}}
    6.10 @@ -10,24 +7,12 @@
    6.11  \newcommand{\chref}[1]{chapter~\ref{#1}}
    6.12  \newcommand{\figref}[1]{figure~\ref{#1}}
    6.13  
    6.14 -%% glossary
    6.15 -\renewcommand{\glossary}[2]{\nomenclature{\bf #1}{#2}}
    6.16 -\newcommand{\seeglossary}[1]{\emph{#1}}
    6.17 -\newcommand{\glossaryname}{Glossary}
    6.18 -\renewcommand{\nomname}{\glossaryname}
    6.19 -\renewcommand{\pagedeclaration}[1]{\nobreak\quad\dotfill~page~\bold{#1}}
    6.20 -
    6.21 -%% index
    6.22 -\newcommand{\indexml}[1]{\index{\emph{#1}|bold}}
    6.23 -\newcommand{\indexmlexception}[1]{\index{\emph{#1} (exception)|bold}}
    6.24 -\newcommand{\indexmltype}[1]{\index{\emph{#1} (type)|bold}}
    6.25 -\newcommand{\indexmlstructure}[1]{\index{\emph{#1} (structure)|bold}}
    6.26 -\newcommand{\indexmlfunctor}[1]{\index{\emph{#1} (functor)|bold}}
    6.27 -
    6.28  %% math
    6.29  \newcommand{\text}[1]{\mbox{#1}}
    6.30  \newcommand{\isasymvartheta}{\isamath{\theta}}
    6.31 -\newcommand{\isactrlvec}[1]{\emph{$\overline{#1}$}}
    6.32 +\newcommand{\isactrlvec}[1]{\emph{$\vec{#1}$}}
    6.33 +\newcommand{\isactrlBG}{\isacharbackquoteopen}
    6.34 +\newcommand{\isactrlEN}{\isacharbackquoteclose}
    6.35  
    6.36  \setcounter{secnumdepth}{2} \setcounter{tocdepth}{2}
    6.37  
    6.38 @@ -49,6 +34,10 @@
    6.39  \newcommand{\isasymtype}{\minorcmd{type}}
    6.40  \newcommand{\isasymval}{\minorcmd{val}}
    6.41  
    6.42 +\newcommand{\isasymFIX}{\isakeyword{fix}}
    6.43 +\newcommand{\isasymASSUME}{\isakeyword{assume}}
    6.44 +\newcommand{\isasymDEFINE}{\isakeyword{define}}
    6.45 +\newcommand{\isasymNOTE}{\isakeyword{note}}
    6.46  \newcommand{\isasymGUESS}{\isakeyword{guess}}
    6.47  \newcommand{\isasymOBTAIN}{\isakeyword{obtain}}
    6.48  \newcommand{\isasymTHEORY}{\isakeyword{theory}}
    6.49 @@ -61,6 +50,7 @@
    6.50  
    6.51  \isabellestyle{it}
    6.52  
    6.53 +
    6.54  %%% Local Variables: 
    6.55  %%% mode: latex
    6.56  %%% TeX-master: "implementation"
     7.1 --- a/doc-src/IsarRef/IsaMakefile	Wed Mar 04 10:43:39 2009 +0100
     7.2 +++ b/doc-src/IsarRef/IsaMakefile	Wed Mar 04 10:45:52 2009 +0100
     7.3 @@ -22,10 +22,11 @@
     7.4  HOL-IsarRef: $(LOG)/HOL-IsarRef.gz
     7.5  
     7.6  $(LOG)/HOL-IsarRef.gz: Thy/ROOT.ML ../antiquote_setup.ML		\
     7.7 -  Thy/Inner_Syntax.thy Thy/Introduction.thy Thy/Outer_Syntax.thy	\
     7.8 -  Thy/Spec.thy Thy/Proof.thy Thy/Misc.thy Thy/Document_Preparation.thy	\
     7.9 -  Thy/Generic.thy Thy/HOL_Specific.thy Thy/Quick_Reference.thy		\
    7.10 -  Thy/Symbols.thy Thy/ML_Tactic.thy
    7.11 +  Thy/First_Order_Logic.thy Thy/Framework.thy Thy/Inner_Syntax.thy	\
    7.12 +  Thy/Introduction.thy Thy/Outer_Syntax.thy Thy/Spec.thy Thy/Proof.thy	\
    7.13 +  Thy/Misc.thy Thy/Document_Preparation.thy Thy/Generic.thy		\
    7.14 +  Thy/HOL_Specific.thy Thy/Quick_Reference.thy Thy/Symbols.thy		\
    7.15 +  Thy/ML_Tactic.thy
    7.16  	@$(USEDIR) -s IsarRef HOL Thy
    7.17  
    7.18  
     8.1 --- a/doc-src/IsarRef/Makefile	Wed Mar 04 10:43:39 2009 +0100
     8.2 +++ b/doc-src/IsarRef/Makefile	Wed Mar 04 10:45:52 2009 +0100
     8.3 @@ -1,7 +1,3 @@
     8.4 -#
     8.5 -# $Id$
     8.6 -#
     8.7 -
     8.8  ## targets
     8.9  
    8.10  default: dvi
     9.1 --- a/doc-src/IsarRef/Thy/Document_Preparation.thy	Wed Mar 04 10:43:39 2009 +0100
     9.2 +++ b/doc-src/IsarRef/Thy/Document_Preparation.thy	Wed Mar 04 10:45:52 2009 +0100
     9.3 @@ -1,5 +1,3 @@
     9.4 -(* $Id$ *)
     9.5 -
     9.6  theory Document_Preparation
     9.7  imports Main
     9.8  begin
    10.1 --- a/doc-src/IsarRef/Thy/Generic.thy	Wed Mar 04 10:43:39 2009 +0100
    10.2 +++ b/doc-src/IsarRef/Thy/Generic.thy	Wed Mar 04 10:45:52 2009 +0100
    10.3 @@ -1,5 +1,3 @@
    10.4 -(* $Id$ *)
    10.5 -
    10.6  theory Generic
    10.7  imports Main
    10.8  begin
    11.1 --- a/doc-src/IsarRef/Thy/HOLCF_Specific.thy	Wed Mar 04 10:43:39 2009 +0100
    11.2 +++ b/doc-src/IsarRef/Thy/HOLCF_Specific.thy	Wed Mar 04 10:45:52 2009 +0100
    11.3 @@ -1,5 +1,3 @@
    11.4 -(* $Id$ *)
    11.5 -
    11.6  theory HOLCF_Specific
    11.7  imports HOLCF
    11.8  begin
    12.1 --- a/doc-src/IsarRef/Thy/HOL_Specific.thy	Wed Mar 04 10:43:39 2009 +0100
    12.2 +++ b/doc-src/IsarRef/Thy/HOL_Specific.thy	Wed Mar 04 10:45:52 2009 +0100
    12.3 @@ -771,6 +771,55 @@
    12.4  *}
    12.5  
    12.6  
    12.7 +section {* Intuitionistic proof search *}
    12.8 +
    12.9 +text {*
   12.10 +  \begin{matharray}{rcl}
   12.11 +    @{method_def (HOL) iprover} & : & @{text method} \\
   12.12 +  \end{matharray}
   12.13 +
   12.14 +  \begin{rail}
   12.15 +    'iprover' ('!' ?) (rulemod *)
   12.16 +    ;
   12.17 +  \end{rail}
   12.18 +
   12.19 +  The @{method (HOL) iprover} method performs intuitionistic proof
   12.20 +  search, depending on specifically declared rules from the context,
   12.21 +  or given as explicit arguments.  Chained facts are inserted into the
   12.22 +  goal before commencing proof search; ``@{method (HOL) iprover}@{text
   12.23 +  "!"}''  means to include the current @{fact prems} as well.
   12.24 +  
   12.25 +  Rules need to be classified as @{attribute (Pure) intro},
   12.26 +  @{attribute (Pure) elim}, or @{attribute (Pure) dest}; here the
   12.27 +  ``@{text "!"}'' indicator refers to ``safe'' rules, which may be
   12.28 +  applied aggressively (without considering back-tracking later).
   12.29 +  Rules declared with ``@{text "?"}'' are ignored in proof search (the
   12.30 +  single-step @{method rule} method still observes these).  An
   12.31 +  explicit weight annotation may be given as well; otherwise the
   12.32 +  number of rule premises will be taken into account here.
   12.33 +*}
   12.34 +
   12.35 +
   12.36 +section {* Coherent Logic *}
   12.37 +
   12.38 +text {*
   12.39 +  \begin{matharray}{rcl}
   12.40 +    @{method_def (HOL) "coherent"} & : & @{text method} \\
   12.41 +  \end{matharray}
   12.42 +
   12.43 +  \begin{rail}
   12.44 +    'coherent' thmrefs?
   12.45 +    ;
   12.46 +  \end{rail}
   12.47 +
   12.48 +  The @{method (HOL) coherent} method solves problems of
   12.49 +  \emph{Coherent Logic} \cite{Bezem-Coquand:2005}, which covers
   12.50 +  applications in confluence theory, lattice theory and projective
   12.51 +  geometry.  See @{"file" "~~/src/HOL/ex/Coherent.thy"} for some
   12.52 +  examples.
   12.53 +*}
   12.54 +
   12.55 +
   12.56  section {* Invoking automated reasoning tools -- The Sledgehammer *}
   12.57  
   12.58  text {*
    13.1 --- a/doc-src/IsarRef/Thy/Inner_Syntax.thy	Wed Mar 04 10:43:39 2009 +0100
    13.2 +++ b/doc-src/IsarRef/Thy/Inner_Syntax.thy	Wed Mar 04 10:45:52 2009 +0100
    13.3 @@ -1,5 +1,3 @@
    13.4 -(* $Id$ *)
    13.5 -
    13.6  theory Inner_Syntax
    13.7  imports Main
    13.8  begin
    13.9 @@ -370,7 +368,7 @@
   13.10    \end{matharray}
   13.11  
   13.12    \begin{rail}
   13.13 -    ('notation' | 'no\_notation') target? mode? (nameref structmixfix + 'and')
   13.14 +    ('notation' | 'no\_notation') target? mode? \\ (nameref structmixfix + 'and')
   13.15      ;
   13.16    \end{rail}
   13.17  
   13.18 @@ -525,13 +523,15 @@
   13.19      & @{text "|"} & @{text "tid  |  tvar  |  "}@{verbatim "_"} \\
   13.20      & @{text "|"} & @{text "tid"} @{verbatim "::"} @{text "sort  |  tvar  "}@{verbatim "::"} @{text "sort  |  "}@{verbatim "_"} @{verbatim "::"} @{text "sort"} \\
   13.21      & @{text "|"} & @{text "id  |  type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) id  |  "}@{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text id} \\
   13.22 -    & @{text "|"} & @{text "longid  |  type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) longid  |  "}@{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text longid} \\
   13.23 +    & @{text "|"} & @{text "longid  |  type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) longid"} \\
   13.24 +    & @{text "|"} & @{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text longid} \\
   13.25      & @{text "|"} & @{text "type\<^sup>(\<^sup>1\<^sup>)"} @{verbatim "=>"} @{text type} & @{text "(0)"} \\
   13.26      & @{text "|"} & @{text "type\<^sup>(\<^sup>1\<^sup>)"} @{text "\<Rightarrow>"} @{text type} & @{text "(0)"} \\
   13.27      & @{text "|"} & @{verbatim "["} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim "]"} @{verbatim "=>"} @{text type} & @{text "(0)"} \\
   13.28      & @{text "|"} & @{verbatim "["} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim "]"} @{text "\<Rightarrow>"} @{text type} & @{text "(0)"} \\\\
   13.29  
   13.30 -  @{syntax_def (inner) sort} & = & @{text "id  |  longid  |  "}@{verbatim "{}"}@{text "  |  "}@{verbatim "{"} @{text "(id | longid)"} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text "(id | longid)"} @{verbatim "}"} \\
   13.31 +  @{syntax_def (inner) sort} & = & @{text "id  |  longid  |  "}@{verbatim "{}"} \\
   13.32 +    & @{text "|"} & @{verbatim "{"} @{text "(id | longid)"} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text "(id | longid)"} @{verbatim "}"} \\
   13.33    \end{supertabular}
   13.34    \end{center}
   13.35  
    14.1 --- a/doc-src/IsarRef/Thy/Introduction.thy	Wed Mar 04 10:43:39 2009 +0100
    14.2 +++ b/doc-src/IsarRef/Thy/Introduction.thy	Wed Mar 04 10:45:52 2009 +0100
    14.3 @@ -1,5 +1,3 @@
    14.4 -(* $Id$ *)
    14.5 -
    14.6  theory Introduction
    14.7  imports Main
    14.8  begin
    14.9 @@ -12,27 +10,27 @@
   14.10    The \emph{Isabelle} system essentially provides a generic
   14.11    infrastructure for building deductive systems (programmed in
   14.12    Standard ML), with a special focus on interactive theorem proving in
   14.13 -  higher-order logics.  In the olden days even end-users would refer
   14.14 -  to certain ML functions (goal commands, tactics, tacticals etc.) to
   14.15 -  pursue their everyday theorem proving tasks
   14.16 -  \cite{isabelle-intro,isabelle-ref}.
   14.17 +  higher-order logics.  Many years ago, even end-users would refer to
   14.18 +  certain ML functions (goal commands, tactics, tacticals etc.) to
   14.19 +  pursue their everyday theorem proving tasks.
   14.20    
   14.21    In contrast \emph{Isar} provides an interpreted language environment
   14.22    of its own, which has been specifically tailored for the needs of
   14.23    theory and proof development.  Compared to raw ML, the Isabelle/Isar
   14.24    top-level provides a more robust and comfortable development
   14.25 -  platform, with proper support for theory development graphs,
   14.26 -  single-step transactions with unlimited undo, etc.  The
   14.27 -  Isabelle/Isar version of the \emph{Proof~General} user interface
   14.28 -  \cite{proofgeneral,Aspinall:TACAS:2000} provides an adequate
   14.29 -  front-end for interactive theory and proof development in this
   14.30 -  advanced theorem proving environment.
   14.31 +  platform, with proper support for theory development graphs, managed
   14.32 +  transactions with unlimited undo etc.  The Isabelle/Isar version of
   14.33 +  the \emph{Proof~General} user interface
   14.34 +  \cite{proofgeneral,Aspinall:TACAS:2000} provides a decent front-end
   14.35 +  for interactive theory and proof development in this advanced
   14.36 +  theorem proving environment, even though it is somewhat biased
   14.37 +  towards old-style proof scripts.
   14.38  
   14.39    \medskip Apart from the technical advances over bare-bones ML
   14.40    programming, the main purpose of the Isar language is to provide a
   14.41    conceptually different view on machine-checked proofs
   14.42 -  \cite{Wenzel:1999:TPHOL,Wenzel-PhD}.  ``Isar'' stands for
   14.43 -  ``Intelligible semi-automated reasoning''.  Drawing from both the
   14.44 +  \cite{Wenzel:1999:TPHOL,Wenzel-PhD}.  \emph{Isar} stands for
   14.45 +  \emph{Intelligible semi-automated reasoning}.  Drawing from both the
   14.46    traditions of informal mathematical proof texts and high-level
   14.47    programming languages, Isar offers a versatile environment for
   14.48    structured formal proof documents.  Thus properly written Isar
   14.49 @@ -47,12 +45,12 @@
   14.50    Despite its grand design of structured proof texts, Isar is able to
   14.51    assimilate the old tactical style as an ``improper'' sub-language.
   14.52    This provides an easy upgrade path for existing tactic scripts, as
   14.53 -  well as additional means for interactive experimentation and
   14.54 -  debugging of structured proofs.  Isabelle/Isar supports a broad
   14.55 -  range of proof styles, both readable and unreadable ones.
   14.56 +  well as some means for interactive experimentation and debugging of
   14.57 +  structured proofs.  Isabelle/Isar supports a broad range of proof
   14.58 +  styles, both readable and unreadable ones.
   14.59  
   14.60 -  \medskip The Isabelle/Isar framework \cite{Wenzel:2006:Festschrift}
   14.61 -  is generic and should work reasonably well for any Isabelle
   14.62 +  \medskip The generic Isabelle/Isar framework (see
   14.63 +  \chref{ch:isar-framework}) works reasonably well for any Isabelle
   14.64    object-logic that conforms to the natural deduction view of the
   14.65    Isabelle/Pure framework.  Specific language elements introduced by
   14.66    the major object-logics are described in \chref{ch:hol}
   14.67 @@ -72,194 +70,4 @@
   14.68    context; other commands emulate old-style tactical theorem proving.
   14.69  *}
   14.70  
   14.71 -
   14.72 -section {* User interfaces *}
   14.73 -
   14.74 -subsection {* Terminal sessions *}
   14.75 -
   14.76 -text {*
   14.77 -  The Isabelle \texttt{tty} tool provides a very interface for running
   14.78 -  the Isar interaction loop, with some support for command line
   14.79 -  editing.  For example:
   14.80 -\begin{ttbox}
   14.81 -isabelle tty\medskip
   14.82 -{\out Welcome to Isabelle/HOL (Isabelle2008)}\medskip
   14.83 -theory Foo imports Main begin;
   14.84 -definition foo :: nat where "foo == 1";
   14.85 -lemma "0 < foo" by (simp add: foo_def);
   14.86 -end;
   14.87 -\end{ttbox}
   14.88 -
   14.89 -  Any Isabelle/Isar command may be retracted by @{command undo}.
   14.90 -  See the Isabelle/Isar Quick Reference (\appref{ap:refcard}) for a
   14.91 -  comprehensive overview of available commands and other language
   14.92 -  elements.
   14.93 -*}
   14.94 -
   14.95 -
   14.96 -subsection {* Emacs Proof General *}
   14.97 -
   14.98 -text {*
   14.99 -  Plain TTY-based interaction as above used to be quite feasible with
  14.100 -  traditional tactic based theorem proving, but developing Isar
  14.101 -  documents really demands some better user-interface support.  The
  14.102 -  Proof~General environment by David Aspinall
  14.103 -  \cite{proofgeneral,Aspinall:TACAS:2000} offers a generic Emacs
  14.104 -  interface for interactive theorem provers that organizes all the
  14.105 -  cut-and-paste and forward-backward walk through the text in a very
  14.106 -  neat way.  In Isabelle/Isar, the current position within a partial
  14.107 -  proof document is equally important than the actual proof state.
  14.108 -  Thus Proof~General provides the canonical working environment for
  14.109 -  Isabelle/Isar, both for getting acquainted (e.g.\ by replaying
  14.110 -  existing Isar documents) and for production work.
  14.111 -*}
  14.112 -
  14.113 -
  14.114 -subsubsection{* Proof~General as default Isabelle interface *}
  14.115 -
  14.116 -text {*
  14.117 -  The Isabelle interface wrapper script provides an easy way to invoke
  14.118 -  Proof~General (including XEmacs or GNU Emacs).  The default
  14.119 -  configuration of Isabelle is smart enough to detect the
  14.120 -  Proof~General distribution in several canonical places (e.g.\
  14.121 -  @{verbatim "$ISABELLE_HOME/contrib/ProofGeneral"}).  Thus the
  14.122 -  capital @{verbatim Isabelle} executable would already refer to the
  14.123 -  @{verbatim "ProofGeneral/isar"} interface without further ado.  The
  14.124 -  Isabelle interface script provides several options; pass @{verbatim
  14.125 -  "-?"}  to see its usage.
  14.126 -
  14.127 -  With the proper Isabelle interface setup, Isar documents may now be edited by
  14.128 -  visiting appropriate theory files, e.g.\ 
  14.129 -\begin{ttbox}
  14.130 -Isabelle \({\langle}isabellehome{\rangle}\)/src/HOL/Isar_examples/Summation.thy
  14.131 -\end{ttbox}
  14.132 -  Beginners may note the tool bar for navigating forward and backward
  14.133 -  through the text (this depends on the local Emacs installation).
  14.134 -  Consult the Proof~General documentation \cite{proofgeneral} for
  14.135 -  further basic command sequences, in particular ``@{verbatim "C-c C-return"}''
  14.136 -  and ``@{verbatim "C-c u"}''.
  14.137 -
  14.138 -  \medskip Proof~General may be also configured manually by giving
  14.139 -  Isabelle settings like this (see also \cite{isabelle-sys}):
  14.140 -
  14.141 -\begin{ttbox}
  14.142 -ISABELLE_INTERFACE=\$ISABELLE_HOME/contrib/ProofGeneral/isar/interface
  14.143 -PROOFGENERAL_OPTIONS=""
  14.144 -\end{ttbox}
  14.145 -  You may have to change @{verbatim
  14.146 -  "$ISABELLE_HOME/contrib/ProofGeneral"} to the actual installation
  14.147 -  directory of Proof~General.
  14.148 -
  14.149 -  \medskip Apart from the Isabelle command line, defaults for
  14.150 -  interface options may be given by the @{verbatim PROOFGENERAL_OPTIONS}
  14.151 -  setting.  For example, the Emacs executable to be used may be
  14.152 -  configured in Isabelle's settings like this:
  14.153 -\begin{ttbox}
  14.154 -PROOFGENERAL_OPTIONS="-p xemacs-mule"  
  14.155 -\end{ttbox}
  14.156 -
  14.157 -  Occasionally, a user's @{verbatim "~/.emacs"} file contains code
  14.158 -  that is incompatible with the (X)Emacs version used by
  14.159 -  Proof~General, causing the interface startup to fail prematurely.
  14.160 -  Here the @{verbatim "-u false"} option helps to get the interface
  14.161 -  process up and running.  Note that additional Lisp customization
  14.162 -  code may reside in @{verbatim "proofgeneral-settings.el"} of
  14.163 -  @{verbatim "$ISABELLE_HOME/etc"} or @{verbatim
  14.164 -  "$ISABELLE_HOME_USER/etc"}.
  14.165 -*}
  14.166 -
  14.167 -
  14.168 -subsubsection {* The X-Symbol package *}
  14.169 -
  14.170 -text {*
  14.171 -  Proof~General incorporates a version of the Emacs X-Symbol package
  14.172 -  \cite{x-symbol}, which handles proper mathematical symbols displayed
  14.173 -  on screen.  Pass option @{verbatim "-x true"} to the Isabelle
  14.174 -  interface script, or check the appropriate Proof~General menu
  14.175 -  setting by hand.  The main challenge of getting X-Symbol to work
  14.176 -  properly is the underlying (semi-automated) X11 font setup.
  14.177 -
  14.178 -  \medskip Using proper mathematical symbols in Isabelle theories can
  14.179 -  be very convenient for readability of large formulas.  On the other
  14.180 -  hand, the plain ASCII sources easily become somewhat unintelligible.
  14.181 -  For example, @{text "\<Longrightarrow>"} would appear as @{verbatim "\<Longrightarrow>"} according
  14.182 -  the default set of Isabelle symbols.  Nevertheless, the Isabelle
  14.183 -  document preparation system (see \chref{ch:document-prep}) will be
  14.184 -  happy to print non-ASCII symbols properly.  It is even possible to
  14.185 -  invent additional notation beyond the display capabilities of Emacs
  14.186 -  and X-Symbol.
  14.187 -*}
  14.188 -
  14.189 -
  14.190 -section {* Isabelle/Isar theories *}
  14.191 -
  14.192 -text {*
  14.193 -  Isabelle/Isar offers the following main improvements over classic
  14.194 -  Isabelle.
  14.195 -
  14.196 -  \begin{enumerate}
  14.197 -  
  14.198 -  \item A \emph{theory format} that integrates specifications and
  14.199 -  proofs, supporting interactive development and unlimited undo
  14.200 -  operation.
  14.201 -  
  14.202 -  \item A \emph{formal proof document language} designed to support
  14.203 -  intelligible semi-automated reasoning.  Instead of putting together
  14.204 -  unreadable tactic scripts, the author is enabled to express the
  14.205 -  reasoning in way that is close to usual mathematical practice.  The
  14.206 -  old tactical style has been assimilated as ``improper'' language
  14.207 -  elements.
  14.208 -  
  14.209 -  \item A simple document preparation system, for typesetting formal
  14.210 -  developments together with informal text.  The resulting
  14.211 -  hyper-linked PDF documents are equally well suited for WWW
  14.212 -  presentation and as printed copies.
  14.213 -
  14.214 -  \end{enumerate}
  14.215 -
  14.216 -  The Isar proof language is embedded into the new theory format as a
  14.217 -  proper sub-language.  Proof mode is entered by stating some
  14.218 -  @{command theorem} or @{command lemma} at the theory level, and
  14.219 -  left again with the final conclusion (e.g.\ via @{command qed}).
  14.220 -  A few theory specification mechanisms also require some proof, such
  14.221 -  as HOL's @{command typedef} which demands non-emptiness of the
  14.222 -  representing sets.
  14.223 -*}
  14.224 -
  14.225 -
  14.226 -section {* How to write Isar proofs anyway? \label{sec:isar-howto} *}
  14.227 -
  14.228 -text {*
  14.229 -  This is one of the key questions, of course.  First of all, the
  14.230 -  tactic script emulation of Isabelle/Isar essentially provides a
  14.231 -  clarified version of the very same unstructured proof style of
  14.232 -  classic Isabelle.  Old-time users should quickly become acquainted
  14.233 -  with that (slightly degenerative) view of Isar.
  14.234 -
  14.235 -  Writing \emph{proper} Isar proof texts targeted at human readers is
  14.236 -  quite different, though.  Experienced users of the unstructured
  14.237 -  style may even have to unlearn some of their habits to master proof
  14.238 -  composition in Isar.  In contrast, new users with less experience in
  14.239 -  old-style tactical proving, but a good understanding of mathematical
  14.240 -  proof in general, often get started easier.
  14.241 -
  14.242 -  \medskip The present text really is only a reference manual on
  14.243 -  Isabelle/Isar, not a tutorial.  Nevertheless, we will attempt to
  14.244 -  give some clues of how the concepts introduced here may be put into
  14.245 -  practice.  Especially note that \appref{ap:refcard} provides a quick
  14.246 -  reference card of the most common Isabelle/Isar language elements.
  14.247 -
  14.248 -  Further issues concerning the Isar concepts are covered in the
  14.249 -  literature
  14.250 -  \cite{Wenzel:1999:TPHOL,Wiedijk:2000:MV,Bauer-Wenzel:2000:HB,Bauer-Wenzel:2001}.
  14.251 -  The author's PhD thesis \cite{Wenzel-PhD} presently provides the
  14.252 -  most complete exposition of Isar foundations, techniques, and
  14.253 -  applications.  A number of example applications are distributed with
  14.254 -  Isabelle, and available via the Isabelle WWW library (e.g.\
  14.255 -  \url{http://isabelle.in.tum.de/library/}).  The ``Archive of Formal
  14.256 -  Proofs'' \url{http://afp.sourceforge.net/} also provides plenty of
  14.257 -  examples, both in proper Isar proof style and unstructured tactic
  14.258 -  scripts.
  14.259 -*}
  14.260 -
  14.261  end
    15.1 --- a/doc-src/IsarRef/Thy/ML_Tactic.thy	Wed Mar 04 10:43:39 2009 +0100
    15.2 +++ b/doc-src/IsarRef/Thy/ML_Tactic.thy	Wed Mar 04 10:45:52 2009 +0100
    15.3 @@ -1,5 +1,3 @@
    15.4 -(* $Id$ *)
    15.5 -
    15.6  theory ML_Tactic
    15.7  imports Main
    15.8  begin
    16.1 --- a/doc-src/IsarRef/Thy/Misc.thy	Wed Mar 04 10:43:39 2009 +0100
    16.2 +++ b/doc-src/IsarRef/Thy/Misc.thy	Wed Mar 04 10:45:52 2009 +0100
    16.3 @@ -1,5 +1,3 @@
    16.4 -(* $Id$ *)
    16.5 -
    16.6  theory Misc
    16.7  imports Main
    16.8  begin
    17.1 --- a/doc-src/IsarRef/Thy/Outer_Syntax.thy	Wed Mar 04 10:43:39 2009 +0100
    17.2 +++ b/doc-src/IsarRef/Thy/Outer_Syntax.thy	Wed Mar 04 10:45:52 2009 +0100
    17.3 @@ -1,5 +1,3 @@
    17.4 -(* $Id$ *)
    17.5 -
    17.6  theory Outer_Syntax
    17.7  imports Main
    17.8  begin
    17.9 @@ -170,10 +168,10 @@
   17.10    Isabelle as @{verbatim \<forall>}.  There are infinitely many Isabelle
   17.11    symbols like this, although proper presentation is left to front-end
   17.12    tools such as {\LaTeX} or Proof~General with the X-Symbol package.
   17.13 -  A list of standard Isabelle symbols that work well with these tools
   17.14 -  is given in \appref{app:symbols}.  Note that @{verbatim "\<lambda>"} does
   17.15 -  not belong to the @{text letter} category, since it is already used
   17.16 -  differently in the Pure term language.
   17.17 +  A list of predefined Isabelle symbols that work well with these
   17.18 +  tools is given in \appref{app:symbols}.  Note that @{verbatim "\<lambda>"}
   17.19 +  does not belong to the @{text letter} category, since it is already
   17.20 +  used differently in the Pure term language.
   17.21  *}
   17.22  
   17.23  
    18.1 --- a/doc-src/IsarRef/Thy/Proof.thy	Wed Mar 04 10:43:39 2009 +0100
    18.2 +++ b/doc-src/IsarRef/Thy/Proof.thy	Wed Mar 04 10:45:52 2009 +0100
    18.3 @@ -1,17 +1,15 @@
    18.4 -(* $Id$ *)
    18.5 -
    18.6  theory Proof
    18.7  imports Main
    18.8  begin
    18.9  
   18.10 -chapter {* Proofs *}
   18.11 +chapter {* Proofs \label{ch:proofs} *}
   18.12  
   18.13  text {*
   18.14    Proof commands perform transitions of Isar/VM machine
   18.15    configurations, which are block-structured, consisting of a stack of
   18.16    nodes with three main components: logical proof context, current
   18.17 -  facts, and open goals.  Isar/VM transitions are \emph{typed}
   18.18 -  according to the following three different modes of operation:
   18.19 +  facts, and open goals.  Isar/VM transitions are typed according to
   18.20 +  the following three different modes of operation:
   18.21  
   18.22    \begin{description}
   18.23  
   18.24 @@ -32,13 +30,17 @@
   18.25  
   18.26    \end{description}
   18.27  
   18.28 -  The proof mode indicator may be read as a verb telling the writer
   18.29 -  what kind of operation may be performed next.  The corresponding
   18.30 -  typings of proof commands restricts the shape of well-formed proof
   18.31 -  texts to particular command sequences.  So dynamic arrangements of
   18.32 -  commands eventually turn out as static texts of a certain structure.
   18.33 -  \Appref{ap:refcard} gives a simplified grammar of the overall
   18.34 -  (extensible) language emerging that way.
   18.35 +  The proof mode indicator may be understood as an instruction to the
   18.36 +  writer, telling what kind of operation may be performed next.  The
   18.37 +  corresponding typings of proof commands restricts the shape of
   18.38 +  well-formed proof texts to particular command sequences.  So dynamic
   18.39 +  arrangements of commands eventually turn out as static texts of a
   18.40 +  certain structure.
   18.41 +
   18.42 +  \Appref{ap:refcard} gives a simplified grammar of the (extensible)
   18.43 +  language emerging that way from the different types of proof
   18.44 +  commands.  The main ideas of the overall Isar framework are
   18.45 +  explained in \chref{ch:isar-framework}.
   18.46  *}
   18.47  
   18.48  
   18.49 @@ -681,7 +683,6 @@
   18.50      @{method_def "assumption"} & : & @{text method} \\
   18.51      @{method_def "this"} & : & @{text method} \\
   18.52      @{method_def "rule"} & : & @{text method} \\
   18.53 -    @{method_def "iprover"} & : & @{text method} \\[0.5ex]
   18.54      @{attribute_def (Pure) "intro"} & : & @{text attribute} \\
   18.55      @{attribute_def (Pure) "elim"} & : & @{text attribute} \\
   18.56      @{attribute_def (Pure) "dest"} & : & @{text attribute} \\
   18.57 @@ -696,8 +697,6 @@
   18.58      ;
   18.59      'rule' thmrefs?
   18.60      ;
   18.61 -    'iprover' ('!' ?) (rulemod *)
   18.62 -    ;
   18.63      rulemod: ('intro' | 'elim' | 'dest') ((('!' | () | '?') nat?) | 'del') ':' thmrefs
   18.64      ;
   18.65      ('intro' | 'elim' | 'dest') ('!' | () | '?') nat?
   18.66 @@ -756,27 +755,11 @@
   18.67    default behavior of @{command "proof"} and ``@{command ".."}'' 
   18.68    (double-dot) steps (see \secref{sec:proof-steps}).
   18.69    
   18.70 -  \item @{method iprover} performs intuitionistic proof search,
   18.71 -  depending on specifically declared rules from the context, or given
   18.72 -  as explicit arguments.  Chained facts are inserted into the goal
   18.73 -  before commencing proof search; ``@{method iprover}@{text "!"}''
   18.74 -  means to include the current @{fact prems} as well.
   18.75 -  
   18.76 -  Rules need to be classified as @{attribute (Pure) intro},
   18.77 -  @{attribute (Pure) elim}, or @{attribute (Pure) dest}; here the
   18.78 -  ``@{text "!"}'' indicator refers to ``safe'' rules, which may be
   18.79 -  applied aggressively (without considering back-tracking later).
   18.80 -  Rules declared with ``@{text "?"}'' are ignored in proof search (the
   18.81 -  single-step @{method rule} method still observes these).  An
   18.82 -  explicit weight annotation may be given as well; otherwise the
   18.83 -  number of rule premises will be taken into account here.
   18.84 -  
   18.85    \item @{attribute (Pure) intro}, @{attribute (Pure) elim}, and
   18.86    @{attribute (Pure) dest} declare introduction, elimination, and
   18.87 -  destruct rules, to be used with the @{method rule} and @{method
   18.88 -  iprover} methods.  Note that the latter will ignore rules declared
   18.89 -  with ``@{text "?"}'', while ``@{text "!"}''  are used most
   18.90 -  aggressively.
   18.91 +  destruct rules, to be used with method @{method rule}, and similar
   18.92 +  tools.  Note that the latter will ignore rules declared with
   18.93 +  ``@{text "?"}'', while ``@{text "!"}''  are used most aggressively.
   18.94    
   18.95    The classical reasoner (see \secref{sec:classical}) introduces its
   18.96    own variants of these attributes; use qualified names to access the
   18.97 @@ -963,7 +946,7 @@
   18.98    \begin{matharray}{l}
   18.99      @{text "\<langle>using b\<^sub>1 \<dots> b\<^sub>k\<rangle>"}~~@{command "obtain"}~@{text "x\<^sub>1 \<dots> x\<^sub>m \<WHERE> a: \<phi>\<^sub>1 \<dots> \<phi>\<^sub>n  \<langle>proof\<rangle> \<equiv>"} \\[1ex]
  18.100      \quad @{command "have"}~@{text "\<And>thesis. (\<And>x\<^sub>1 \<dots> x\<^sub>m. \<phi>\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> thesis) \<Longrightarrow> thesis"} \\
  18.101 -    \quad @{command "proof"}~@{text succeed} \\
  18.102 +    \quad @{command "proof"}~@{method succeed} \\
  18.103      \qquad @{command "fix"}~@{text thesis} \\
  18.104      \qquad @{command "assume"}~@{text "that [Pure.intro?]: \<And>x\<^sub>1 \<dots> x\<^sub>m. \<phi>\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> thesis"} \\
  18.105      \qquad @{command "then"}~@{command "show"}~@{text thesis} \\
    19.1 --- a/doc-src/IsarRef/Thy/Quick_Reference.thy	Wed Mar 04 10:43:39 2009 +0100
    19.2 +++ b/doc-src/IsarRef/Thy/Quick_Reference.thy	Wed Mar 04 10:45:52 2009 +0100
    19.3 @@ -1,5 +1,3 @@
    19.4 -(* $Id$ *)
    19.5 -
    19.6  theory Quick_Reference
    19.7  imports Main
    19.8  begin
    19.9 @@ -30,7 +28,7 @@
   19.10  
   19.11    \begin{tabular}{rcl}
   19.12      @{text "theory\<dash>stmt"} & = & @{command "theorem"}~@{text "name: props proof  |"}~~@{command "definition"}~@{text "\<dots>  |  \<dots>"} \\[1ex]
   19.13 -    @{text "proof"} & = & @{text "prfx\<^sup>*"}~@{command "proof"}~@{text "method stmt\<^sup>*"}~@{command "qed"}~@{text method} \\
   19.14 +    @{text "proof"} & = & @{text "prfx\<^sup>*"}~@{command "proof"}~@{text "method\<^sup>? stmt\<^sup>*"}~@{command "qed"}~@{text "method\<^sup>?"} \\
   19.15      & @{text "|"} & @{text "prfx\<^sup>*"}~@{command "done"} \\[1ex]
   19.16      @{text prfx} & = & @{command "apply"}~@{text method} \\
   19.17      & @{text "|"} & @{command "using"}~@{text "facts"} \\
    20.1 --- a/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Wed Mar 04 10:43:39 2009 +0100
    20.2 +++ b/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Wed Mar 04 10:45:52 2009 +0100
    20.3 @@ -1,6 +1,3 @@
    20.4 -
    20.5 -(* $Id$ *)
    20.6 -
    20.7  set ThyOutput.source;
    20.8  use "../../antiquote_setup.ML";
    20.9  
    21.1 --- a/doc-src/IsarRef/Thy/ROOT-ZF.ML	Wed Mar 04 10:43:39 2009 +0100
    21.2 +++ b/doc-src/IsarRef/Thy/ROOT-ZF.ML	Wed Mar 04 10:45:52 2009 +0100
    21.3 @@ -1,6 +1,3 @@
    21.4 -
    21.5 -(* $Id$ *)
    21.6 -
    21.7  set ThyOutput.source;
    21.8  use "../../antiquote_setup.ML";
    21.9  
    22.1 --- a/doc-src/IsarRef/Thy/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
    22.2 +++ b/doc-src/IsarRef/Thy/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
    22.3 @@ -1,18 +1,20 @@
    22.4 -
    22.5 -(* $Id$ *)
    22.6 -
    22.7 +set quick_and_dirty;
    22.8  set ThyOutput.source;
    22.9  use "../../antiquote_setup.ML";
   22.10  
   22.11 -use_thy "Introduction";
   22.12 -use_thy "Outer_Syntax";
   22.13 -use_thy "Document_Preparation";
   22.14 -use_thy "Spec";
   22.15 -use_thy "Proof";
   22.16 -use_thy "Inner_Syntax";
   22.17 -use_thy "Misc";
   22.18 -use_thy "Generic";
   22.19 -use_thy "HOL_Specific";
   22.20 -use_thy "Quick_Reference";
   22.21 -use_thy "Symbols";
   22.22 -use_thy "ML_Tactic";
   22.23 +use_thys [
   22.24 +  "Introduction",
   22.25 +  "Framework",
   22.26 +  "First_Order_Logic",
   22.27 +  "Outer_Syntax",
   22.28 +  "Document_Preparation",
   22.29 +  "Spec",
   22.30 +  "Proof",
   22.31 +  "Inner_Syntax",
   22.32 +  "Misc",
   22.33 +  "Generic",
   22.34 +  "HOL_Specific",
   22.35 +  "Quick_Reference",
   22.36 +  "Symbols",
   22.37 +  "ML_Tactic"
   22.38 +];
    23.1 --- a/doc-src/IsarRef/Thy/Spec.thy	Wed Mar 04 10:43:39 2009 +0100
    23.2 +++ b/doc-src/IsarRef/Thy/Spec.thy	Wed Mar 04 10:45:52 2009 +0100
    23.3 @@ -4,6 +4,24 @@
    23.4  
    23.5  chapter {* Theory specifications *}
    23.6  
    23.7 +text {*
    23.8 +  The Isabelle/Isar theory format integrates specifications and
    23.9 +  proofs, supporting interactive development with unlimited undo
   23.10 +  operation.  There is an integrated document preparation system (see
   23.11 +  \chref{ch:document-prep}), for typesetting formal developments
   23.12 +  together with informal text.  The resulting hyper-linked PDF
   23.13 +  documents can be used both for WWW presentation and printed copies.
   23.14 +
   23.15 +  The Isar proof language (see \chref{ch:proofs}) is embedded into the
   23.16 +  theory language as a proper sub-language.  Proof mode is entered by
   23.17 +  stating some @{command theorem} or @{command lemma} at the theory
   23.18 +  level, and left again with the final conclusion (e.g.\ via @{command
   23.19 +  qed}).  Some theory specification mechanisms also require a proof,
   23.20 +  such as @{command typedef} in HOL, which demands non-emptiness of
   23.21 +  the representing sets.
   23.22 +*}
   23.23 +
   23.24 +
   23.25  section {* Defining theories \label{sec:begin-thy} *}
   23.26  
   23.27  text {*
   23.28 @@ -106,9 +124,9 @@
   23.29    @{command (global) "end"} has a different meaning: it concludes the
   23.30    theory itself (\secref{sec:begin-thy}).
   23.31    
   23.32 -  \item @{text "(\<IN> c)"} given after any local theory command
   23.33 -  specifies an immediate target, e.g.\ ``@{command
   23.34 -  "definition"}~@{text "(\<IN> c) \<dots>"}'' or ``@{command
   23.35 +  \item @{text "("}@{keyword_def "in"}~@{text "c)"} given after any
   23.36 +  local theory command specifies an immediate target, e.g.\
   23.37 +  ``@{command "definition"}~@{text "(\<IN> c) \<dots>"}'' or ``@{command
   23.38    "theorem"}~@{text "(\<IN> c) \<dots>"}''.  This works both in a local or
   23.39    global theory context; the current target context will be suspended
   23.40    for this command only.  Note that ``@{text "(\<IN> -)"}'' will
   23.41 @@ -1164,7 +1182,7 @@
   23.42  
   23.43    \end{description}
   23.44  
   23.45 -  See @{"file" "~~/src/FOL/ex/IffOracle.thy"} for a worked example of
   23.46 +  See @{"file" "~~/src/FOL/ex/Iff_Oracle.thy"} for a worked example of
   23.47    defining a new primitive rule as oracle, and turning it into a proof
   23.48    method.
   23.49  *}
    24.1 --- a/doc-src/IsarRef/Thy/Symbols.thy	Wed Mar 04 10:43:39 2009 +0100
    24.2 +++ b/doc-src/IsarRef/Thy/Symbols.thy	Wed Mar 04 10:45:52 2009 +0100
    24.3 @@ -1,10 +1,8 @@
    24.4 -(* $Id$ *)
    24.5 -
    24.6  theory Symbols
    24.7  imports Pure
    24.8  begin
    24.9  
   24.10 -chapter {* Standard Isabelle symbols \label{app:symbols} *}
   24.11 +chapter {* Predefined Isabelle symbols \label{app:symbols} *}
   24.12  
   24.13  text {*
   24.14    Isabelle supports an infinite number of non-ASCII symbols, which are
    25.1 --- a/doc-src/IsarRef/Thy/ZF_Specific.thy	Wed Mar 04 10:43:39 2009 +0100
    25.2 +++ b/doc-src/IsarRef/Thy/ZF_Specific.thy	Wed Mar 04 10:45:52 2009 +0100
    25.3 @@ -1,5 +1,3 @@
    25.4 -(* $Id$ *)
    25.5 -
    25.6  theory ZF_Specific
    25.7  imports Main
    25.8  begin
    26.1 --- a/doc-src/IsarRef/Thy/document/Document_Preparation.tex	Wed Mar 04 10:43:39 2009 +0100
    26.2 +++ b/doc-src/IsarRef/Thy/document/Document_Preparation.tex	Wed Mar 04 10:45:52 2009 +0100
    26.3 @@ -3,8 +3,6 @@
    26.4  \def\isabellecontext{Document{\isacharunderscore}Preparation}%
    26.5  %
    26.6  \isadelimtheory
    26.7 -\isanewline
    26.8 -\isanewline
    26.9  %
   26.10  \endisadelimtheory
   26.11  %
    27.1 --- a/doc-src/IsarRef/Thy/document/Generic.tex	Wed Mar 04 10:43:39 2009 +0100
    27.2 +++ b/doc-src/IsarRef/Thy/document/Generic.tex	Wed Mar 04 10:45:52 2009 +0100
    27.3 @@ -3,8 +3,6 @@
    27.4  \def\isabellecontext{Generic}%
    27.5  %
    27.6  \isadelimtheory
    27.7 -\isanewline
    27.8 -\isanewline
    27.9  %
   27.10  \endisadelimtheory
   27.11  %
    28.1 --- a/doc-src/IsarRef/Thy/document/HOLCF_Specific.tex	Wed Mar 04 10:43:39 2009 +0100
    28.2 +++ b/doc-src/IsarRef/Thy/document/HOLCF_Specific.tex	Wed Mar 04 10:45:52 2009 +0100
    28.3 @@ -3,8 +3,6 @@
    28.4  \def\isabellecontext{HOLCF{\isacharunderscore}Specific}%
    28.5  %
    28.6  \isadelimtheory
    28.7 -\isanewline
    28.8 -\isanewline
    28.9  %
   28.10  \endisadelimtheory
   28.11  %
    29.1 --- a/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Wed Mar 04 10:43:39 2009 +0100
    29.2 +++ b/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Wed Mar 04 10:45:52 2009 +0100
    29.3 @@ -779,6 +779,58 @@
    29.4  \end{isamarkuptext}%
    29.5  \isamarkuptrue%
    29.6  %
    29.7 +\isamarkupsection{Intuitionistic proof search%
    29.8 +}
    29.9 +\isamarkuptrue%
   29.10 +%
   29.11 +\begin{isamarkuptext}%
   29.12 +\begin{matharray}{rcl}
   29.13 +    \indexdef{HOL}{method}{iprover}\hypertarget{method.HOL.iprover}{\hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}}} & : & \isa{method} \\
   29.14 +  \end{matharray}
   29.15 +
   29.16 +  \begin{rail}
   29.17 +    'iprover' ('!' ?) (rulemod *)
   29.18 +    ;
   29.19 +  \end{rail}
   29.20 +
   29.21 +  The \hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}} method performs intuitionistic proof
   29.22 +  search, depending on specifically declared rules from the context,
   29.23 +  or given as explicit arguments.  Chained facts are inserted into the
   29.24 +  goal before commencing proof search; ``\hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}}\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}''  means to include the current \hyperlink{fact.prems}{\mbox{\isa{prems}}} as well.
   29.25 +  
   29.26 +  Rules need to be classified as \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}},
   29.27 +  \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, or \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}; here the
   29.28 +  ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' indicator refers to ``safe'' rules, which may be
   29.29 +  applied aggressively (without considering back-tracking later).
   29.30 +  Rules declared with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'' are ignored in proof search (the
   29.31 +  single-step \hyperlink{method.rule}{\mbox{\isa{rule}}} method still observes these).  An
   29.32 +  explicit weight annotation may be given as well; otherwise the
   29.33 +  number of rule premises will be taken into account here.%
   29.34 +\end{isamarkuptext}%
   29.35 +\isamarkuptrue%
   29.36 +%
   29.37 +\isamarkupsection{Coherent Logic%
   29.38 +}
   29.39 +\isamarkuptrue%
   29.40 +%
   29.41 +\begin{isamarkuptext}%
   29.42 +\begin{matharray}{rcl}
   29.43 +    \indexdef{HOL}{method}{coherent}\hypertarget{method.HOL.coherent}{\hyperlink{method.HOL.coherent}{\mbox{\isa{coherent}}}} & : & \isa{method} \\
   29.44 +  \end{matharray}
   29.45 +
   29.46 +  \begin{rail}
   29.47 +    'coherent' thmrefs?
   29.48 +    ;
   29.49 +  \end{rail}
   29.50 +
   29.51 +  The \hyperlink{method.HOL.coherent}{\mbox{\isa{coherent}}} method solves problems of
   29.52 +  \emph{Coherent Logic} \cite{Bezem-Coquand:2005}, which covers
   29.53 +  applications in confluence theory, lattice theory and projective
   29.54 +  geometry.  See \hyperlink{file.~~/src/HOL/ex/Coherent.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}HOL{\isacharslash}ex{\isacharslash}Coherent{\isachardot}thy}}}} for some
   29.55 +  examples.%
   29.56 +\end{isamarkuptext}%
   29.57 +\isamarkuptrue%
   29.58 +%
   29.59  \isamarkupsection{Invoking automated reasoning tools -- The Sledgehammer%
   29.60  }
   29.61  \isamarkuptrue%
    30.1 --- a/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Wed Mar 04 10:43:39 2009 +0100
    30.2 +++ b/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Wed Mar 04 10:45:52 2009 +0100
    30.3 @@ -3,8 +3,6 @@
    30.4  \def\isabellecontext{Inner{\isacharunderscore}Syntax}%
    30.5  %
    30.6  \isadelimtheory
    30.7 -\isanewline
    30.8 -\isanewline
    30.9  %
   30.10  \endisadelimtheory
   30.11  %
   30.12 @@ -120,19 +118,19 @@
   30.13  %
   30.14  \begin{isamarkuptext}%
   30.15  \begin{mldecls} 
   30.16 -    \indexml{show\_types}\verb|show_types: bool ref| & default \verb|false| \\
   30.17 -    \indexml{show\_sorts}\verb|show_sorts: bool ref| & default \verb|false| \\
   30.18 -    \indexml{show\_consts}\verb|show_consts: bool ref| & default \verb|false| \\
   30.19 -    \indexml{long\_names}\verb|long_names: bool ref| & default \verb|false| \\
   30.20 -    \indexml{short\_names}\verb|short_names: bool ref| & default \verb|false| \\
   30.21 -    \indexml{unique\_names}\verb|unique_names: bool ref| & default \verb|true| \\
   30.22 -    \indexml{show\_brackets}\verb|show_brackets: bool ref| & default \verb|false| \\
   30.23 -    \indexml{eta\_contract}\verb|eta_contract: bool ref| & default \verb|true| \\
   30.24 -    \indexml{goals\_limit}\verb|goals_limit: int ref| & default \verb|10| \\
   30.25 -    \indexml{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool ref| & default \verb|false| \\
   30.26 -    \indexml{show\_hyps}\verb|show_hyps: bool ref| & default \verb|false| \\
   30.27 -    \indexml{show\_tags}\verb|show_tags: bool ref| & default \verb|false| \\
   30.28 -    \indexml{show\_question\_marks}\verb|show_question_marks: bool ref| & default \verb|true| \\
   30.29 +    \indexdef{}{ML}{show\_types}\verb|show_types: bool ref| & default \verb|false| \\
   30.30 +    \indexdef{}{ML}{show\_sorts}\verb|show_sorts: bool ref| & default \verb|false| \\
   30.31 +    \indexdef{}{ML}{show\_consts}\verb|show_consts: bool ref| & default \verb|false| \\
   30.32 +    \indexdef{}{ML}{long\_names}\verb|long_names: bool ref| & default \verb|false| \\
   30.33 +    \indexdef{}{ML}{short\_names}\verb|short_names: bool ref| & default \verb|false| \\
   30.34 +    \indexdef{}{ML}{unique\_names}\verb|unique_names: bool ref| & default \verb|true| \\
   30.35 +    \indexdef{}{ML}{show\_brackets}\verb|show_brackets: bool ref| & default \verb|false| \\
   30.36 +    \indexdef{}{ML}{eta\_contract}\verb|eta_contract: bool ref| & default \verb|true| \\
   30.37 +    \indexdef{}{ML}{goals\_limit}\verb|goals_limit: int ref| & default \verb|10| \\
   30.38 +    \indexdef{}{ML}{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool ref| & default \verb|false| \\
   30.39 +    \indexdef{}{ML}{show\_hyps}\verb|show_hyps: bool ref| & default \verb|false| \\
   30.40 +    \indexdef{}{ML}{show\_tags}\verb|show_tags: bool ref| & default \verb|false| \\
   30.41 +    \indexdef{}{ML}{show\_question\_marks}\verb|show_question_marks: bool ref| & default \verb|true| \\
   30.42    \end{mldecls}
   30.43  
   30.44    These global ML variables control the detail of information that is
   30.45 @@ -233,9 +231,9 @@
   30.46  %
   30.47  \begin{isamarkuptext}%
   30.48  \begin{mldecls}
   30.49 -    \indexml{Pretty.setdepth}\verb|Pretty.setdepth: int -> unit| \\
   30.50 -    \indexml{Pretty.setmargin}\verb|Pretty.setmargin: int -> unit| \\
   30.51 -    \indexml{print\_depth}\verb|print_depth: int -> unit| \\
   30.52 +    \indexdef{}{ML}{Pretty.setdepth}\verb|Pretty.setdepth: int -> unit| \\
   30.53 +    \indexdef{}{ML}{Pretty.setmargin}\verb|Pretty.setmargin: int -> unit| \\
   30.54 +    \indexdef{}{ML}{print\_depth}\verb|print_depth: int -> unit| \\
   30.55    \end{mldecls}
   30.56  
   30.57    These ML functions set limits for pretty printed text.
   30.58 @@ -392,7 +390,7 @@
   30.59    \end{matharray}
   30.60  
   30.61    \begin{rail}
   30.62 -    ('notation' | 'no\_notation') target? mode? (nameref structmixfix + 'and')
   30.63 +    ('notation' | 'no\_notation') target? mode? \\ (nameref structmixfix + 'and')
   30.64      ;
   30.65    \end{rail}
   30.66  
   30.67 @@ -551,13 +549,15 @@
   30.68      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}tid\ \ {\isacharbar}\ \ tvar\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|_| \\
   30.69      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}tid{\isachardoublequote}} \verb|::| \isa{{\isachardoublequote}sort\ \ {\isacharbar}\ \ tvar\ \ {\isachardoublequote}}\verb|::| \isa{{\isachardoublequote}sort\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|_| \verb|::| \isa{{\isachardoublequote}sort{\isachardoublequote}} \\
   30.70      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ id\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{id} \\
   30.71 -    & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}longid\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{longid} \\
   30.72 +    & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}longid\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ longid{\isachardoublequote}} \\
   30.73 +    & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{longid} \\
   30.74      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isacharparenright}{\isachardoublequote}} \verb|=>| \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
   30.75      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isacharparenright}{\isachardoublequote}} \isa{{\isachardoublequote}{\isasymRightarrow}{\isachardoublequote}} \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
   30.76      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|[| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|]| \verb|=>| \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
   30.77      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|[| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|]| \isa{{\isachardoublequote}{\isasymRightarrow}{\isachardoublequote}} \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\\\
   30.78  
   30.79 -  \indexdef{inner}{syntax}{sort}\hypertarget{syntax.inner.sort}{\hyperlink{syntax.inner.sort}{\mbox{\isa{sort}}}} & = & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{}|\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|}| \\
   30.80 +  \indexdef{inner}{syntax}{sort}\hypertarget{syntax.inner.sort}{\hyperlink{syntax.inner.sort}{\mbox{\isa{sort}}}} & = & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{}| \\
   30.81 +    & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|{| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|}| \\
   30.82    \end{supertabular}
   30.83    \end{center}
   30.84  
    31.1 --- a/doc-src/IsarRef/Thy/document/Introduction.tex	Wed Mar 04 10:43:39 2009 +0100
    31.2 +++ b/doc-src/IsarRef/Thy/document/Introduction.tex	Wed Mar 04 10:45:52 2009 +0100
    31.3 @@ -3,8 +3,6 @@
    31.4  \def\isabellecontext{Introduction}%
    31.5  %
    31.6  \isadelimtheory
    31.7 -\isanewline
    31.8 -\isanewline
    31.9  %
   31.10  \endisadelimtheory
   31.11  %
   31.12 @@ -32,27 +30,27 @@
   31.13  The \emph{Isabelle} system essentially provides a generic
   31.14    infrastructure for building deductive systems (programmed in
   31.15    Standard ML), with a special focus on interactive theorem proving in
   31.16 -  higher-order logics.  In the olden days even end-users would refer
   31.17 -  to certain ML functions (goal commands, tactics, tacticals etc.) to
   31.18 -  pursue their everyday theorem proving tasks
   31.19 -  \cite{isabelle-intro,isabelle-ref}.
   31.20 +  higher-order logics.  Many years ago, even end-users would refer to
   31.21 +  certain ML functions (goal commands, tactics, tacticals etc.) to
   31.22 +  pursue their everyday theorem proving tasks.
   31.23    
   31.24    In contrast \emph{Isar} provides an interpreted language environment
   31.25    of its own, which has been specifically tailored for the needs of
   31.26    theory and proof development.  Compared to raw ML, the Isabelle/Isar
   31.27    top-level provides a more robust and comfortable development
   31.28 -  platform, with proper support for theory development graphs,
   31.29 -  single-step transactions with unlimited undo, etc.  The
   31.30 -  Isabelle/Isar version of the \emph{Proof~General} user interface
   31.31 -  \cite{proofgeneral,Aspinall:TACAS:2000} provides an adequate
   31.32 -  front-end for interactive theory and proof development in this
   31.33 -  advanced theorem proving environment.
   31.34 +  platform, with proper support for theory development graphs, managed
   31.35 +  transactions with unlimited undo etc.  The Isabelle/Isar version of
   31.36 +  the \emph{Proof~General} user interface
   31.37 +  \cite{proofgeneral,Aspinall:TACAS:2000} provides a decent front-end
   31.38 +  for interactive theory and proof development in this advanced
   31.39 +  theorem proving environment, even though it is somewhat biased
   31.40 +  towards old-style proof scripts.
   31.41  
   31.42    \medskip Apart from the technical advances over bare-bones ML
   31.43    programming, the main purpose of the Isar language is to provide a
   31.44    conceptually different view on machine-checked proofs
   31.45 -  \cite{Wenzel:1999:TPHOL,Wenzel-PhD}.  ``Isar'' stands for
   31.46 -  ``Intelligible semi-automated reasoning''.  Drawing from both the
   31.47 +  \cite{Wenzel:1999:TPHOL,Wenzel-PhD}.  \emph{Isar} stands for
   31.48 +  \emph{Intelligible semi-automated reasoning}.  Drawing from both the
   31.49    traditions of informal mathematical proof texts and high-level
   31.50    programming languages, Isar offers a versatile environment for
   31.51    structured formal proof documents.  Thus properly written Isar
   31.52 @@ -67,12 +65,12 @@
   31.53    Despite its grand design of structured proof texts, Isar is able to
   31.54    assimilate the old tactical style as an ``improper'' sub-language.
   31.55    This provides an easy upgrade path for existing tactic scripts, as
   31.56 -  well as additional means for interactive experimentation and
   31.57 -  debugging of structured proofs.  Isabelle/Isar supports a broad
   31.58 -  range of proof styles, both readable and unreadable ones.
   31.59 +  well as some means for interactive experimentation and debugging of
   31.60 +  structured proofs.  Isabelle/Isar supports a broad range of proof
   31.61 +  styles, both readable and unreadable ones.
   31.62  
   31.63 -  \medskip The Isabelle/Isar framework \cite{Wenzel:2006:Festschrift}
   31.64 -  is generic and should work reasonably well for any Isabelle
   31.65 +  \medskip The generic Isabelle/Isar framework (see
   31.66 +  \chref{ch:isar-framework}) works reasonably well for any Isabelle
   31.67    object-logic that conforms to the natural deduction view of the
   31.68    Isabelle/Pure framework.  Specific language elements introduced by
   31.69    the major object-logics are described in \chref{ch:hol}
   31.70 @@ -92,207 +90,6 @@
   31.71  \end{isamarkuptext}%
   31.72  \isamarkuptrue%
   31.73  %
   31.74 -\isamarkupsection{User interfaces%
   31.75 -}
   31.76 -\isamarkuptrue%
   31.77 -%
   31.78 -\isamarkupsubsection{Terminal sessions%
   31.79 -}
   31.80 -\isamarkuptrue%
   31.81 -%
   31.82 -\begin{isamarkuptext}%
   31.83 -The Isabelle \texttt{tty} tool provides a very interface for running
   31.84 -  the Isar interaction loop, with some support for command line
   31.85 -  editing.  For example:
   31.86 -\begin{ttbox}
   31.87 -isabelle tty\medskip
   31.88 -{\out Welcome to Isabelle/HOL (Isabelle2008)}\medskip
   31.89 -theory Foo imports Main begin;
   31.90 -definition foo :: nat where "foo == 1";
   31.91 -lemma "0 < foo" by (simp add: foo_def);
   31.92 -end;
   31.93 -\end{ttbox}
   31.94 -
   31.95 -  Any Isabelle/Isar command may be retracted by \hyperlink{command.undo}{\mbox{\isa{\isacommand{undo}}}}.
   31.96 -  See the Isabelle/Isar Quick Reference (\appref{ap:refcard}) for a
   31.97 -  comprehensive overview of available commands and other language
   31.98 -  elements.%
   31.99 -\end{isamarkuptext}%
  31.100 -\isamarkuptrue%
  31.101 -%
  31.102 -\isamarkupsubsection{Emacs Proof General%
  31.103 -}
  31.104 -\isamarkuptrue%
  31.105 -%
  31.106 -\begin{isamarkuptext}%
  31.107 -Plain TTY-based interaction as above used to be quite feasible with
  31.108 -  traditional tactic based theorem proving, but developing Isar
  31.109 -  documents really demands some better user-interface support.  The
  31.110 -  Proof~General environment by David Aspinall
  31.111 -  \cite{proofgeneral,Aspinall:TACAS:2000} offers a generic Emacs
  31.112 -  interface for interactive theorem provers that organizes all the
  31.113 -  cut-and-paste and forward-backward walk through the text in a very
  31.114 -  neat way.  In Isabelle/Isar, the current position within a partial
  31.115 -  proof document is equally important than the actual proof state.
  31.116 -  Thus Proof~General provides the canonical working environment for
  31.117 -  Isabelle/Isar, both for getting acquainted (e.g.\ by replaying
  31.118 -  existing Isar documents) and for production work.%
  31.119 -\end{isamarkuptext}%
  31.120 -\isamarkuptrue%
  31.121 -%
  31.122 -\isamarkupsubsubsection{Proof~General as default Isabelle interface%
  31.123 -}
  31.124 -\isamarkuptrue%
  31.125 -%
  31.126 -\begin{isamarkuptext}%
  31.127 -The Isabelle interface wrapper script provides an easy way to invoke
  31.128 -  Proof~General (including XEmacs or GNU Emacs).  The default
  31.129 -  configuration of Isabelle is smart enough to detect the
  31.130 -  Proof~General distribution in several canonical places (e.g.\
  31.131 -  \verb|$ISABELLE_HOME/contrib/ProofGeneral|).  Thus the
  31.132 -  capital \verb|Isabelle| executable would already refer to the
  31.133 -  \verb|ProofGeneral/isar| interface without further ado.  The
  31.134 -  Isabelle interface script provides several options; pass \verb|-?|  to see its usage.
  31.135 -
  31.136 -  With the proper Isabelle interface setup, Isar documents may now be edited by
  31.137 -  visiting appropriate theory files, e.g.\ 
  31.138 -\begin{ttbox}
  31.139 -Isabelle \({\langle}isabellehome{\rangle}\)/src/HOL/Isar_examples/Summation.thy
  31.140 -\end{ttbox}
  31.141 -  Beginners may note the tool bar for navigating forward and backward
  31.142 -  through the text (this depends on the local Emacs installation).
  31.143 -  Consult the Proof~General documentation \cite{proofgeneral} for
  31.144 -  further basic command sequences, in particular ``\verb|C-c C-return|''
  31.145 -  and ``\verb|C-c u|''.
  31.146 -
  31.147 -  \medskip Proof~General may be also configured manually by giving
  31.148 -  Isabelle settings like this (see also \cite{isabelle-sys}):
  31.149 -
  31.150 -\begin{ttbox}
  31.151 -ISABELLE_INTERFACE=\$ISABELLE_HOME/contrib/ProofGeneral/isar/interface
  31.152 -PROOFGENERAL_OPTIONS=""
  31.153 -\end{ttbox}
  31.154 -  You may have to change \verb|$ISABELLE_HOME/contrib/ProofGeneral| to the actual installation
  31.155 -  directory of Proof~General.
  31.156 -
  31.157 -  \medskip Apart from the Isabelle command line, defaults for
  31.158 -  interface options may be given by the \verb|PROOFGENERAL_OPTIONS|
  31.159 -  setting.  For example, the Emacs executable to be used may be
  31.160 -  configured in Isabelle's settings like this:
  31.161 -\begin{ttbox}
  31.162 -PROOFGENERAL_OPTIONS="-p xemacs-mule"  
  31.163 -\end{ttbox}
  31.164 -
  31.165 -  Occasionally, a user's \verb|~/.emacs| file contains code
  31.166 -  that is incompatible with the (X)Emacs version used by
  31.167 -  Proof~General, causing the interface startup to fail prematurely.
  31.168 -  Here the \verb|-u false| option helps to get the interface
  31.169 -  process up and running.  Note that additional Lisp customization
  31.170 -  code may reside in \verb|proofgeneral-settings.el| of
  31.171 -  \verb|$ISABELLE_HOME/etc| or \verb|$ISABELLE_HOME_USER/etc|.%
  31.172 -\end{isamarkuptext}%
  31.173 -\isamarkuptrue%
  31.174 -%
  31.175 -\isamarkupsubsubsection{The X-Symbol package%
  31.176 -}
  31.177 -\isamarkuptrue%
  31.178 -%
  31.179 -\begin{isamarkuptext}%
  31.180 -Proof~General incorporates a version of the Emacs X-Symbol package
  31.181 -  \cite{x-symbol}, which handles proper mathematical symbols displayed
  31.182 -  on screen.  Pass option \verb|-x true| to the Isabelle
  31.183 -  interface script, or check the appropriate Proof~General menu
  31.184 -  setting by hand.  The main challenge of getting X-Symbol to work
  31.185 -  properly is the underlying (semi-automated) X11 font setup.
  31.186 -
  31.187 -  \medskip Using proper mathematical symbols in Isabelle theories can
  31.188 -  be very convenient for readability of large formulas.  On the other
  31.189 -  hand, the plain ASCII sources easily become somewhat unintelligible.
  31.190 -  For example, \isa{{\isachardoublequote}{\isasymLongrightarrow}{\isachardoublequote}} would appear as \verb|\<Longrightarrow>| according
  31.191 -  the default set of Isabelle symbols.  Nevertheless, the Isabelle
  31.192 -  document preparation system (see \chref{ch:document-prep}) will be
  31.193 -  happy to print non-ASCII symbols properly.  It is even possible to
  31.194 -  invent additional notation beyond the display capabilities of Emacs
  31.195 -  and X-Symbol.%
  31.196 -\end{isamarkuptext}%
  31.197 -\isamarkuptrue%
  31.198 -%
  31.199 -\isamarkupsection{Isabelle/Isar theories%
  31.200 -}
  31.201 -\isamarkuptrue%
  31.202 -%
  31.203 -\begin{isamarkuptext}%
  31.204 -Isabelle/Isar offers the following main improvements over classic
  31.205 -  Isabelle.
  31.206 -
  31.207 -  \begin{enumerate}
  31.208 -  
  31.209 -  \item A \emph{theory format} that integrates specifications and
  31.210 -  proofs, supporting interactive development and unlimited undo
  31.211 -  operation.
  31.212 -  
  31.213 -  \item A \emph{formal proof document language} designed to support
  31.214 -  intelligible semi-automated reasoning.  Instead of putting together
  31.215 -  unreadable tactic scripts, the author is enabled to express the
  31.216 -  reasoning in way that is close to usual mathematical practice.  The
  31.217 -  old tactical style has been assimilated as ``improper'' language
  31.218 -  elements.
  31.219 -  
  31.220 -  \item A simple document preparation system, for typesetting formal
  31.221 -  developments together with informal text.  The resulting
  31.222 -  hyper-linked PDF documents are equally well suited for WWW
  31.223 -  presentation and as printed copies.
  31.224 -
  31.225 -  \end{enumerate}
  31.226 -
  31.227 -  The Isar proof language is embedded into the new theory format as a
  31.228 -  proper sub-language.  Proof mode is entered by stating some
  31.229 -  \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}} or \hyperlink{command.lemma}{\mbox{\isa{\isacommand{lemma}}}} at the theory level, and
  31.230 -  left again with the final conclusion (e.g.\ via \hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}).
  31.231 -  A few theory specification mechanisms also require some proof, such
  31.232 -  as HOL's \hyperlink{command.typedef}{\mbox{\isa{\isacommand{typedef}}}} which demands non-emptiness of the
  31.233 -  representing sets.%
  31.234 -\end{isamarkuptext}%
  31.235 -\isamarkuptrue%
  31.236 -%
  31.237 -\isamarkupsection{How to write Isar proofs anyway? \label{sec:isar-howto}%
  31.238 -}
  31.239 -\isamarkuptrue%
  31.240 -%
  31.241 -\begin{isamarkuptext}%
  31.242 -This is one of the key questions, of course.  First of all, the
  31.243 -  tactic script emulation of Isabelle/Isar essentially provides a
  31.244 -  clarified version of the very same unstructured proof style of
  31.245 -  classic Isabelle.  Old-time users should quickly become acquainted
  31.246 -  with that (slightly degenerative) view of Isar.
  31.247 -
  31.248 -  Writing \emph{proper} Isar proof texts targeted at human readers is
  31.249 -  quite different, though.  Experienced users of the unstructured
  31.250 -  style may even have to unlearn some of their habits to master proof
  31.251 -  composition in Isar.  In contrast, new users with less experience in
  31.252 -  old-style tactical proving, but a good understanding of mathematical
  31.253 -  proof in general, often get started easier.
  31.254 -
  31.255 -  \medskip The present text really is only a reference manual on
  31.256 -  Isabelle/Isar, not a tutorial.  Nevertheless, we will attempt to
  31.257 -  give some clues of how the concepts introduced here may be put into
  31.258 -  practice.  Especially note that \appref{ap:refcard} provides a quick
  31.259 -  reference card of the most common Isabelle/Isar language elements.
  31.260 -
  31.261 -  Further issues concerning the Isar concepts are covered in the
  31.262 -  literature
  31.263 -  \cite{Wenzel:1999:TPHOL,Wiedijk:2000:MV,Bauer-Wenzel:2000:HB,Bauer-Wenzel:2001}.
  31.264 -  The author's PhD thesis \cite{Wenzel-PhD} presently provides the
  31.265 -  most complete exposition of Isar foundations, techniques, and
  31.266 -  applications.  A number of example applications are distributed with
  31.267 -  Isabelle, and available via the Isabelle WWW library (e.g.\
  31.268 -  \url{http://isabelle.in.tum.de/library/}).  The ``Archive of Formal
  31.269 -  Proofs'' \url{http://afp.sourceforge.net/} also provides plenty of
  31.270 -  examples, both in proper Isar proof style and unstructured tactic
  31.271 -  scripts.%
  31.272 -\end{isamarkuptext}%
  31.273 -\isamarkuptrue%
  31.274 -%
  31.275  \isadelimtheory
  31.276  %
  31.277  \endisadelimtheory
    32.1 --- a/doc-src/IsarRef/Thy/document/ML_Tactic.tex	Wed Mar 04 10:43:39 2009 +0100
    32.2 +++ b/doc-src/IsarRef/Thy/document/ML_Tactic.tex	Wed Mar 04 10:45:52 2009 +0100
    32.3 @@ -3,8 +3,6 @@
    32.4  \def\isabellecontext{ML{\isacharunderscore}Tactic}%
    32.5  %
    32.6  \isadelimtheory
    32.7 -\isanewline
    32.8 -\isanewline
    32.9  %
   32.10  \endisadelimtheory
   32.11  %
    33.1 --- a/doc-src/IsarRef/Thy/document/Misc.tex	Wed Mar 04 10:43:39 2009 +0100
    33.2 +++ b/doc-src/IsarRef/Thy/document/Misc.tex	Wed Mar 04 10:45:52 2009 +0100
    33.3 @@ -3,8 +3,6 @@
    33.4  \def\isabellecontext{Misc}%
    33.5  %
    33.6  \isadelimtheory
    33.7 -\isanewline
    33.8 -\isanewline
    33.9  %
   33.10  \endisadelimtheory
   33.11  %
    34.1 --- a/doc-src/IsarRef/Thy/document/Outer_Syntax.tex	Wed Mar 04 10:43:39 2009 +0100
    34.2 +++ b/doc-src/IsarRef/Thy/document/Outer_Syntax.tex	Wed Mar 04 10:45:52 2009 +0100
    34.3 @@ -3,8 +3,6 @@
    34.4  \def\isabellecontext{Outer{\isacharunderscore}Syntax}%
    34.5  %
    34.6  \isadelimtheory
    34.7 -\isanewline
    34.8 -\isanewline
    34.9  %
   34.10  \endisadelimtheory
   34.11  %
   34.12 @@ -185,10 +183,10 @@
   34.13    Isabelle as \verb|\<forall>|.  There are infinitely many Isabelle
   34.14    symbols like this, although proper presentation is left to front-end
   34.15    tools such as {\LaTeX} or Proof~General with the X-Symbol package.
   34.16 -  A list of standard Isabelle symbols that work well with these tools
   34.17 -  is given in \appref{app:symbols}.  Note that \verb|\<lambda>| does
   34.18 -  not belong to the \isa{letter} category, since it is already used
   34.19 -  differently in the Pure term language.%
   34.20 +  A list of predefined Isabelle symbols that work well with these
   34.21 +  tools is given in \appref{app:symbols}.  Note that \verb|\<lambda>|
   34.22 +  does not belong to the \isa{letter} category, since it is already
   34.23 +  used differently in the Pure term language.%
   34.24  \end{isamarkuptext}%
   34.25  \isamarkuptrue%
   34.26  %
    35.1 --- a/doc-src/IsarRef/Thy/document/Proof.tex	Wed Mar 04 10:43:39 2009 +0100
    35.2 +++ b/doc-src/IsarRef/Thy/document/Proof.tex	Wed Mar 04 10:45:52 2009 +0100
    35.3 @@ -3,8 +3,6 @@
    35.4  \def\isabellecontext{Proof}%
    35.5  %
    35.6  \isadelimtheory
    35.7 -\isanewline
    35.8 -\isanewline
    35.9  %
   35.10  \endisadelimtheory
   35.11  %
   35.12 @@ -20,7 +18,7 @@
   35.13  %
   35.14  \endisadelimtheory
   35.15  %
   35.16 -\isamarkupchapter{Proofs%
   35.17 +\isamarkupchapter{Proofs \label{ch:proofs}%
   35.18  }
   35.19  \isamarkuptrue%
   35.20  %
   35.21 @@ -28,8 +26,8 @@
   35.22  Proof commands perform transitions of Isar/VM machine
   35.23    configurations, which are block-structured, consisting of a stack of
   35.24    nodes with three main components: logical proof context, current
   35.25 -  facts, and open goals.  Isar/VM transitions are \emph{typed}
   35.26 -  according to the following three different modes of operation:
   35.27 +  facts, and open goals.  Isar/VM transitions are typed according to
   35.28 +  the following three different modes of operation:
   35.29  
   35.30    \begin{description}
   35.31  
   35.32 @@ -49,13 +47,17 @@
   35.33  
   35.34    \end{description}
   35.35  
   35.36 -  The proof mode indicator may be read as a verb telling the writer
   35.37 -  what kind of operation may be performed next.  The corresponding
   35.38 -  typings of proof commands restricts the shape of well-formed proof
   35.39 -  texts to particular command sequences.  So dynamic arrangements of
   35.40 -  commands eventually turn out as static texts of a certain structure.
   35.41 -  \Appref{ap:refcard} gives a simplified grammar of the overall
   35.42 -  (extensible) language emerging that way.%
   35.43 +  The proof mode indicator may be understood as an instruction to the
   35.44 +  writer, telling what kind of operation may be performed next.  The
   35.45 +  corresponding typings of proof commands restricts the shape of
   35.46 +  well-formed proof texts to particular command sequences.  So dynamic
   35.47 +  arrangements of commands eventually turn out as static texts of a
   35.48 +  certain structure.
   35.49 +
   35.50 +  \Appref{ap:refcard} gives a simplified grammar of the (extensible)
   35.51 +  language emerging that way from the different types of proof
   35.52 +  commands.  The main ideas of the overall Isar framework are
   35.53 +  explained in \chref{ch:isar-framework}.%
   35.54  \end{isamarkuptext}%
   35.55  \isamarkuptrue%
   35.56  %
   35.57 @@ -691,7 +693,6 @@
   35.58      \indexdef{}{method}{assumption}\hypertarget{method.assumption}{\hyperlink{method.assumption}{\mbox{\isa{assumption}}}} & : & \isa{method} \\
   35.59      \indexdef{}{method}{this}\hypertarget{method.this}{\hyperlink{method.this}{\mbox{\isa{this}}}} & : & \isa{method} \\
   35.60      \indexdef{}{method}{rule}\hypertarget{method.rule}{\hyperlink{method.rule}{\mbox{\isa{rule}}}} & : & \isa{method} \\
   35.61 -    \indexdef{}{method}{iprover}\hypertarget{method.iprover}{\hyperlink{method.iprover}{\mbox{\isa{iprover}}}} & : & \isa{method} \\[0.5ex]
   35.62      \indexdef{Pure}{attribute}{intro}\hypertarget{attribute.Pure.intro}{\hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}}} & : & \isa{attribute} \\
   35.63      \indexdef{Pure}{attribute}{elim}\hypertarget{attribute.Pure.elim}{\hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}} & : & \isa{attribute} \\
   35.64      \indexdef{Pure}{attribute}{dest}\hypertarget{attribute.Pure.dest}{\hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}} & : & \isa{attribute} \\
   35.65 @@ -706,8 +707,6 @@
   35.66      ;
   35.67      'rule' thmrefs?
   35.68      ;
   35.69 -    'iprover' ('!' ?) (rulemod *)
   35.70 -    ;
   35.71      rulemod: ('intro' | 'elim' | 'dest') ((('!' | () | '?') nat?) | 'del') ':' thmrefs
   35.72      ;
   35.73      ('intro' | 'elim' | 'dest') ('!' | () | '?') nat?
   35.74 @@ -762,26 +761,11 @@
   35.75    default behavior of \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}} and ``\hyperlink{command.ddot}{\mbox{\isa{\isacommand{{\isachardot}{\isachardot}}}}}'' 
   35.76    (double-dot) steps (see \secref{sec:proof-steps}).
   35.77    
   35.78 -  \item \hyperlink{method.iprover}{\mbox{\isa{iprover}}} performs intuitionistic proof search,
   35.79 -  depending on specifically declared rules from the context, or given
   35.80 -  as explicit arguments.  Chained facts are inserted into the goal
   35.81 -  before commencing proof search; ``\hyperlink{method.iprover}{\mbox{\isa{iprover}}}\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}''
   35.82 -  means to include the current \hyperlink{fact.prems}{\mbox{\isa{prems}}} as well.
   35.83 -  
   35.84 -  Rules need to be classified as \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}},
   35.85 -  \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, or \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}; here the
   35.86 -  ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' indicator refers to ``safe'' rules, which may be
   35.87 -  applied aggressively (without considering back-tracking later).
   35.88 -  Rules declared with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'' are ignored in proof search (the
   35.89 -  single-step \hyperlink{method.rule}{\mbox{\isa{rule}}} method still observes these).  An
   35.90 -  explicit weight annotation may be given as well; otherwise the
   35.91 -  number of rule premises will be taken into account here.
   35.92 -  
   35.93    \item \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}}, \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, and
   35.94    \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}} declare introduction, elimination, and
   35.95 -  destruct rules, to be used with the \hyperlink{method.rule}{\mbox{\isa{rule}}} and \hyperlink{method.iprover}{\mbox{\isa{iprover}}} methods.  Note that the latter will ignore rules declared
   35.96 -  with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'', while ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}''  are used most
   35.97 -  aggressively.
   35.98 +  destruct rules, to be used with method \hyperlink{method.rule}{\mbox{\isa{rule}}}, and similar
   35.99 +  tools.  Note that the latter will ignore rules declared with
  35.100 +  ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'', while ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}''  are used most aggressively.
  35.101    
  35.102    The classical reasoner (see \secref{sec:classical}) introduces its
  35.103    own variants of these attributes; use qualified names to access the
  35.104 @@ -966,7 +950,7 @@
  35.105    \begin{matharray}{l}
  35.106      \isa{{\isachardoublequote}{\isasymlangle}using\ b\isactrlsub {\isadigit{1}}\ {\isasymdots}\ b\isactrlsub k{\isasymrangle}{\isachardoublequote}}~~\hyperlink{command.obtain}{\mbox{\isa{\isacommand{obtain}}}}~\isa{{\isachardoublequote}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m\ {\isasymWHERE}\ a{\isacharcolon}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ \ {\isasymlangle}proof{\isasymrangle}\ {\isasymequiv}{\isachardoublequote}} \\[1ex]
  35.107      \quad \hyperlink{command.have}{\mbox{\isa{\isacommand{have}}}}~\isa{{\isachardoublequote}{\isasymAnd}thesis{\isachardot}\ {\isacharparenleft}{\isasymAnd}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m{\isachardot}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymLongrightarrow}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ {\isasymLongrightarrow}\ thesis{\isacharparenright}\ {\isasymLongrightarrow}\ thesis{\isachardoublequote}} \\
  35.108 -    \quad \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{succeed} \\
  35.109 +    \quad \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\hyperlink{method.succeed}{\mbox{\isa{succeed}}} \\
  35.110      \qquad \hyperlink{command.fix}{\mbox{\isa{\isacommand{fix}}}}~\isa{thesis} \\
  35.111      \qquad \hyperlink{command.assume}{\mbox{\isa{\isacommand{assume}}}}~\isa{{\isachardoublequote}that\ {\isacharbrackleft}Pure{\isachardot}intro{\isacharquery}{\isacharbrackright}{\isacharcolon}\ {\isasymAnd}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m{\isachardot}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymLongrightarrow}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ {\isasymLongrightarrow}\ thesis{\isachardoublequote}} \\
  35.112      \qquad \hyperlink{command.then}{\mbox{\isa{\isacommand{then}}}}~\hyperlink{command.show}{\mbox{\isa{\isacommand{show}}}}~\isa{thesis} \\
    36.1 --- a/doc-src/IsarRef/Thy/document/Quick_Reference.tex	Wed Mar 04 10:43:39 2009 +0100
    36.2 +++ b/doc-src/IsarRef/Thy/document/Quick_Reference.tex	Wed Mar 04 10:45:52 2009 +0100
    36.3 @@ -3,8 +3,6 @@
    36.4  \def\isabellecontext{Quick{\isacharunderscore}Reference}%
    36.5  %
    36.6  \isadelimtheory
    36.7 -\isanewline
    36.8 -\isanewline
    36.9  %
   36.10  \endisadelimtheory
   36.11  %
   36.12 @@ -52,7 +50,7 @@
   36.13  
   36.14    \begin{tabular}{rcl}
   36.15      \isa{{\isachardoublequote}theory{\isasymdash}stmt{\isachardoublequote}} & = & \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}name{\isacharcolon}\ props\ proof\ \ {\isacharbar}{\isachardoublequote}}~~\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isasymdots}\ \ {\isacharbar}\ \ {\isasymdots}{\isachardoublequote}} \\[1ex]
   36.16 -    \isa{{\isachardoublequote}proof{\isachardoublequote}} & = & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{{\isachardoublequote}method\ stmt\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}~\isa{method} \\
   36.17 +    \isa{{\isachardoublequote}proof{\isachardoublequote}} & = & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{{\isachardoublequote}method\isactrlsup {\isacharquery}\ stmt\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}~\isa{{\isachardoublequote}method\isactrlsup {\isacharquery}{\isachardoublequote}} \\
   36.18      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.done}{\mbox{\isa{\isacommand{done}}}} \\[1ex]
   36.19      \isa{prfx} & = & \hyperlink{command.apply}{\mbox{\isa{\isacommand{apply}}}}~\isa{method} \\
   36.20      & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \hyperlink{command.using}{\mbox{\isa{\isacommand{using}}}}~\isa{{\isachardoublequote}facts{\isachardoublequote}} \\
    37.1 --- a/doc-src/IsarRef/Thy/document/Spec.tex	Wed Mar 04 10:43:39 2009 +0100
    37.2 +++ b/doc-src/IsarRef/Thy/document/Spec.tex	Wed Mar 04 10:45:52 2009 +0100
    37.3 @@ -22,6 +22,23 @@
    37.4  }
    37.5  \isamarkuptrue%
    37.6  %
    37.7 +\begin{isamarkuptext}%
    37.8 +The Isabelle/Isar theory format integrates specifications and
    37.9 +  proofs, supporting interactive development with unlimited undo
   37.10 +  operation.  There is an integrated document preparation system (see
   37.11 +  \chref{ch:document-prep}), for typesetting formal developments
   37.12 +  together with informal text.  The resulting hyper-linked PDF
   37.13 +  documents can be used both for WWW presentation and printed copies.
   37.14 +
   37.15 +  The Isar proof language (see \chref{ch:proofs}) is embedded into the
   37.16 +  theory language as a proper sub-language.  Proof mode is entered by
   37.17 +  stating some \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}} or \hyperlink{command.lemma}{\mbox{\isa{\isacommand{lemma}}}} at the theory
   37.18 +  level, and left again with the final conclusion (e.g.\ via \hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}).  Some theory specification mechanisms also require a proof,
   37.19 +  such as \hyperlink{command.typedef}{\mbox{\isa{\isacommand{typedef}}}} in HOL, which demands non-emptiness of
   37.20 +  the representing sets.%
   37.21 +\end{isamarkuptext}%
   37.22 +\isamarkuptrue%
   37.23 +%
   37.24  \isamarkupsection{Defining theories \label{sec:begin-thy}%
   37.25  }
   37.26  \isamarkuptrue%
   37.27 @@ -127,8 +144,9 @@
   37.28    \hyperlink{command.global.end}{\mbox{\isa{\isacommand{end}}}} has a different meaning: it concludes the
   37.29    theory itself (\secref{sec:begin-thy}).
   37.30    
   37.31 -  \item \isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}{\isachardoublequote}} given after any local theory command
   37.32 -  specifies an immediate target, e.g.\ ``\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}'' or ``\hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}''.  This works both in a local or
   37.33 +  \item \isa{{\isachardoublequote}{\isacharparenleft}{\isachardoublequote}}\indexdef{}{keyword}{in}\hypertarget{keyword.in}{\hyperlink{keyword.in}{\mbox{\isa{\isakeyword{in}}}}}~\isa{{\isachardoublequote}c{\isacharparenright}{\isachardoublequote}} given after any
   37.34 +  local theory command specifies an immediate target, e.g.\
   37.35 +  ``\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}'' or ``\hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}''.  This works both in a local or
   37.36    global theory context; the current target context will be suspended
   37.37    for this command only.  Note that ``\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ {\isacharminus}{\isacharparenright}{\isachardoublequote}}'' will
   37.38    always produce a global result independently of the current target
   37.39 @@ -792,8 +810,8 @@
   37.40    \end{matharray}
   37.41  
   37.42    \begin{mldecls}
   37.43 -    \indexml{bind\_thms}\verb|bind_thms: string * thm list -> unit| \\
   37.44 -    \indexml{bind\_thm}\verb|bind_thm: string * thm -> unit| \\
   37.45 +    \indexdef{}{ML}{bind\_thms}\verb|bind_thms: string * thm list -> unit| \\
   37.46 +    \indexdef{}{ML}{bind\_thm}\verb|bind_thm: string * thm -> unit| \\
   37.47    \end{mldecls}
   37.48  
   37.49    \begin{rail}
   37.50 @@ -1178,7 +1196,7 @@
   37.51  
   37.52    \end{description}
   37.53  
   37.54 -  See \hyperlink{file.~~/src/FOL/ex/IffOracle.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}FOL{\isacharslash}ex{\isacharslash}IffOracle{\isachardot}thy}}}} for a worked example of
   37.55 +  See \hyperlink{file.~~/src/FOL/ex/Iff-Oracle.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}FOL{\isacharslash}ex{\isacharslash}Iff{\isacharunderscore}Oracle{\isachardot}thy}}}} for a worked example of
   37.56    defining a new primitive rule as oracle, and turning it into a proof
   37.57    method.%
   37.58  \end{isamarkuptext}%
    38.1 --- a/doc-src/IsarRef/Thy/document/Symbols.tex	Wed Mar 04 10:43:39 2009 +0100
    38.2 +++ b/doc-src/IsarRef/Thy/document/Symbols.tex	Wed Mar 04 10:45:52 2009 +0100
    38.3 @@ -3,8 +3,6 @@
    38.4  \def\isabellecontext{Symbols}%
    38.5  %
    38.6  \isadelimtheory
    38.7 -\isanewline
    38.8 -\isanewline
    38.9  %
   38.10  \endisadelimtheory
   38.11  %
   38.12 @@ -20,7 +18,7 @@
   38.13  %
   38.14  \endisadelimtheory
   38.15  %
   38.16 -\isamarkupchapter{Standard Isabelle symbols \label{app:symbols}%
   38.17 +\isamarkupchapter{Predefined Isabelle symbols \label{app:symbols}%
   38.18  }
   38.19  \isamarkuptrue%
   38.20  %
    39.1 --- a/doc-src/IsarRef/Thy/document/ZF_Specific.tex	Wed Mar 04 10:43:39 2009 +0100
    39.2 +++ b/doc-src/IsarRef/Thy/document/ZF_Specific.tex	Wed Mar 04 10:45:52 2009 +0100
    39.3 @@ -3,8 +3,6 @@
    39.4  \def\isabellecontext{ZF{\isacharunderscore}Specific}%
    39.5  %
    39.6  \isadelimtheory
    39.7 -\isanewline
    39.8 -\isanewline
    39.9  %
   39.10  \endisadelimtheory
   39.11  %
    40.1 --- a/doc-src/IsarRef/isar-ref.tex	Wed Mar 04 10:43:39 2009 +0100
    40.2 +++ b/doc-src/IsarRef/isar-ref.tex	Wed Mar 04 10:45:52 2009 +0100
    40.3 @@ -1,6 +1,3 @@
    40.4 -
    40.5 -%% $Id$
    40.6 -
    40.7  \documentclass[12pt,a4paper,fleqn]{report}
    40.8  \usepackage{amssymb}
    40.9  \usepackage[greek,english]{babel}
   40.10 @@ -27,12 +24,13 @@
   40.11    With Contributions by
   40.12    Clemens Ballarin,
   40.13    Stefan Berghofer, \\
   40.14 +  Timothy Bourke
   40.15    Lucas Dixon,
   40.16 -  Florian Haftmann,
   40.17 -  Gerwin Klein, \\
   40.18 +  Florian Haftmann, \\
   40.19 +  Gerwin Klein,
   40.20    Alexander Krauss,
   40.21 -  Tobias Nipkow,
   40.22 -  David von Oheimb, \\
   40.23 +  Tobias Nipkow, \\
   40.24 +  David von Oheimb,
   40.25    Larry Paulson,
   40.26    and Sebastian Skalberg
   40.27  }
   40.28 @@ -82,7 +80,11 @@
   40.29  
   40.30  \pagenumbering{roman} \tableofcontents \clearfirst
   40.31  
   40.32 +\part{Basic Concepts}
   40.33  \input{Thy/document/Introduction.tex}
   40.34 +\input{Thy/document/Framework.tex}
   40.35 +\input{Thy/document/First_Order_Logic.tex}
   40.36 +\part{General Language Elements}
   40.37  \input{Thy/document/Outer_Syntax.tex}
   40.38  \input{Thy/document/Document_Preparation.tex}
   40.39  \input{Thy/document/Spec.tex}
   40.40 @@ -90,10 +92,12 @@
   40.41  \input{Thy/document/Inner_Syntax.tex}
   40.42  \input{Thy/document/Misc.tex}
   40.43  \input{Thy/document/Generic.tex}
   40.44 +\part{Object-Logics}
   40.45  \input{Thy/document/HOL_Specific.tex}
   40.46  \input{Thy/document/HOLCF_Specific.tex}
   40.47  \input{Thy/document/ZF_Specific.tex}
   40.48  
   40.49 +\part{Appendix}
   40.50  \appendix
   40.51  \input{Thy/document/Quick_Reference.tex}
   40.52  \let\int\intorig
   40.53 @@ -101,7 +105,7 @@
   40.54  \input{Thy/document/ML_Tactic.tex}
   40.55  
   40.56  \begingroup
   40.57 -  \bibliographystyle{plain} \small\raggedright\frenchspacing
   40.58 +  \bibliographystyle{abbrv} \small\raggedright\frenchspacing
   40.59    \bibliography{../manual}
   40.60  \endgroup
   40.61  
    41.1 --- a/doc-src/IsarRef/style.sty	Wed Mar 04 10:43:39 2009 +0100
    41.2 +++ b/doc-src/IsarRef/style.sty	Wed Mar 04 10:45:52 2009 +0100
    41.3 @@ -1,6 +1,3 @@
    41.4 -
    41.5 -%% $Id$
    41.6 -
    41.7  %% toc
    41.8  \newcommand{\tocentry}[1]{\cleardoublepage\phantomsection\addcontentsline{toc}{chapter}{#1}
    41.9  \@mkboth{\MakeUppercase{#1}}{\MakeUppercase{#1}}}
   41.10 @@ -18,12 +15,17 @@
   41.11  
   41.12  %% ML
   41.13  \newenvironment{mldecls}{\par\noindent\begingroup\def\isanewline{\\}\begin{tabular}{ll}}{\end{tabular}\medskip\endgroup}
   41.14 -\newcommand{\indexml}[1]{\index{#1 (ML value)|bold}}
   41.15 +
   41.16 +%% Isar
   41.17 +\newcommand{\isasymBBAR}{{\,\newdimen{\tmpheight}\settoheight\tmpheight{\isacharbar}\rule{1pt}{\tmpheight}\,}}
   41.18 +\isafoldtag{noproof}\def\isafoldnoproof{~\isafold{proof}}
   41.19  
   41.20  %% math
   41.21 +\newcommand{\isasymstrut}{\isamath{\mathstrut}}
   41.22 +\newcommand{\isasymvartheta}{\isamath{\,\theta}}
   41.23  \newcommand{\isactrlvec}[1]{\emph{$\overline{#1}$}}
   41.24  \renewcommand{\isadigit}[1]{\isamath{#1}}
   41.25 -
   41.26 +\newcommand{\text}[1]{\mbox{#1}}
   41.27  
   41.28  %% global style options
   41.29  \pagestyle{headings}
    42.1 --- a/doc-src/Ref/Makefile	Wed Mar 04 10:43:39 2009 +0100
    42.2 +++ b/doc-src/Ref/Makefile	Wed Mar 04 10:45:52 2009 +0100
    42.3 @@ -1,6 +1,3 @@
    42.4 -#
    42.5 -# $Id$
    42.6 -#
    42.7  
    42.8  ## targets
    42.9  
   42.10 @@ -12,16 +9,15 @@
   42.11  include ../Makefile.in
   42.12  
   42.13  NAME = ref
   42.14 -FILES = ref.tex introduction.tex goals.tex tactic.tex tctical.tex \
   42.15 -	thm.tex theories.tex defining.tex syntax.tex substitution.tex \
   42.16 -	simplifier.tex classical.tex theory-syntax.tex \
   42.17 -	../rail.sty ../proof.sty ../iman.sty ../extra.sty ../ttbox.sty ../manual.bib
   42.18 +FILES = ref.tex introduction.tex tactic.tex tctical.tex thm.tex	\
   42.19 +	theories.tex defining.tex syntax.tex substitution.tex	\
   42.20 +	simplifier.tex classical.tex ../proof.sty ../iman.sty	\
   42.21 +	../extra.sty ../ttbox.sty ../manual.bib
   42.22  
   42.23  dvi: $(NAME).dvi
   42.24  
   42.25  $(NAME).dvi: $(FILES) isabelle.eps
   42.26  	$(LATEX) $(NAME)
   42.27 -	$(RAIL) $(NAME)
   42.28  	$(BIBTEX) $(NAME)
   42.29  	$(LATEX) $(NAME)
   42.30  	$(LATEX) $(NAME)
   42.31 @@ -32,7 +28,6 @@
   42.32  
   42.33  $(NAME).pdf: $(FILES) isabelle.pdf
   42.34  	$(PDFLATEX) $(NAME)
   42.35 -	$(RAIL) $(NAME)
   42.36  	$(BIBTEX) $(NAME)
   42.37  	$(PDFLATEX) $(NAME)
   42.38  	$(PDFLATEX) $(NAME)
    43.1 --- a/doc-src/Ref/classical.tex	Wed Mar 04 10:43:39 2009 +0100
    43.2 +++ b/doc-src/Ref/classical.tex	Wed Mar 04 10:45:52 2009 +0100
    43.3 @@ -1,4 +1,4 @@
    43.4 -%% $Id$
    43.5 +
    43.6  \chapter{The Classical Reasoner}\label{chap:classical}
    43.7  \index{classical reasoner|(}
    43.8  \newcommand\ainfer[2]{\begin{array}{r@{\,}l}#2\\ \hline#1\end{array}}
    43.9 @@ -28,29 +28,6 @@
   43.10  be traced, and their components can be called directly; in this manner,
   43.11  any proof can be viewed interactively.
   43.12  
   43.13 -The simplest way to apply the classical reasoner (to subgoal~$i$) is to type
   43.14 -\begin{ttbox}
   43.15 -by (Blast_tac \(i\));
   43.16 -\end{ttbox}
   43.17 -This command quickly proves most simple formulas of the predicate calculus or
   43.18 -set theory.  To attempt to prove subgoals using a combination of
   43.19 -rewriting and classical reasoning, try
   43.20 -\begin{ttbox}
   43.21 -auto();                         \emph{\textrm{applies to all subgoals}}
   43.22 -force i;                        \emph{\textrm{applies to one subgoal}}
   43.23 -\end{ttbox}
   43.24 -To do all obvious logical steps, even if they do not prove the
   43.25 -subgoal, type one of the following:
   43.26 -\begin{ttbox}
   43.27 -by Safe_tac;                   \emph{\textrm{applies to all subgoals}}
   43.28 -by (Clarify_tac \(i\));            \emph{\textrm{applies to one subgoal}}
   43.29 -\end{ttbox}
   43.30 -
   43.31 -
   43.32 -You need to know how the classical reasoner works in order to use it
   43.33 -effectively.  There are many tactics to choose from, including 
   43.34 -{\tt Fast_tac} and \texttt{Best_tac}.
   43.35 -
   43.36  We shall first discuss the underlying principles, then present the classical
   43.37  reasoner.  Finally, we shall see how to instantiate it for new logics.  The
   43.38  logics FOL, ZF, HOL and HOLCF have it already installed.
    44.1 --- a/doc-src/Ref/defining.tex	Wed Mar 04 10:43:39 2009 +0100
    44.2 +++ b/doc-src/Ref/defining.tex	Wed Mar 04 10:45:52 2009 +0100
    44.3 @@ -1,376 +1,5 @@
    44.4 -%% $Id$
    44.5 +
    44.6  \chapter{Defining Logics} \label{Defining-Logics}
    44.7 -This chapter explains how to define new formal systems --- in particular,
    44.8 -their concrete syntax.  While Isabelle can be regarded as a theorem prover
    44.9 -for set theory, higher-order logic or the sequent calculus, its
   44.10 -distinguishing feature is support for the definition of new logics.
   44.11 -
   44.12 -Isabelle logics are hierarchies of theories, which are described and
   44.13 -illustrated in
   44.14 -\iflabelundefined{sec:defining-theories}{{\em Introduction to Isabelle}}%
   44.15 -{\S\ref{sec:defining-theories}}.  That material, together with the theory
   44.16 -files provided in the examples directories, should suffice for all simple
   44.17 -applications.  The easiest way to define a new theory is by modifying a
   44.18 -copy of an existing theory.
   44.19 -
   44.20 -This chapter documents the meta-logic syntax, mixfix declarations and
   44.21 -pretty printing.  The extended examples in \S\ref{sec:min_logics}
   44.22 -demonstrate the logical aspects of the definition of theories.
   44.23 -
   44.24 -
   44.25 -\section{Priority grammars} \label{sec:priority_grammars}
   44.26 -\index{priority grammars|(}
   44.27 -
   44.28 -A context-free grammar contains a set of {\bf nonterminal symbols}, a set of
   44.29 -{\bf terminal symbols} and a set of {\bf productions}\index{productions}.
   44.30 -Productions have the form ${A=\gamma}$, where $A$ is a nonterminal and
   44.31 -$\gamma$ is a string of terminals and nonterminals.  One designated
   44.32 -nonterminal is called the {\bf start symbol}.  The language defined by the
   44.33 -grammar consists of all strings of terminals that can be derived from the
   44.34 -start symbol by applying productions as rewrite rules.
   44.35 -
   44.36 -The syntax of an Isabelle logic is specified by a {\bf priority
   44.37 -  grammar}.\index{priorities} Each nonterminal is decorated by an integer
   44.38 -priority, as in~$A^{(p)}$.  A nonterminal $A^{(p)}$ in a derivation may be
   44.39 -rewritten using a production $A^{(q)} = \gamma$ only if~$p \leq q$.  Any
   44.40 -priority grammar can be translated into a normal context free grammar by
   44.41 -introducing new nonterminals and productions.
   44.42 -
   44.43 -Formally, a set of context free productions $G$ induces a derivation
   44.44 -relation $\longrightarrow@G$.  Let $\alpha$ and $\beta$ denote strings of
   44.45 -terminal or nonterminal symbols.  Then
   44.46 -\[ \alpha\, A^{(p)}\, \beta ~\longrightarrow@G~ \alpha\,\gamma\,\beta \]
   44.47 -if and only if $G$ contains some production $A^{(q)}=\gamma$ for~$p \leq q$.
   44.48 -
   44.49 -The following simple grammar for arithmetic expressions demonstrates how
   44.50 -binding power and associativity of operators can be enforced by priorities.
   44.51 -\begin{center}
   44.52 -\begin{tabular}{rclr}
   44.53 -  $A^{(9)}$ & = & {\tt0} \\
   44.54 -  $A^{(9)}$ & = & {\tt(} $A^{(0)}$ {\tt)} \\
   44.55 -  $A^{(0)}$ & = & $A^{(0)}$ {\tt+} $A^{(1)}$ \\
   44.56 -  $A^{(2)}$ & = & $A^{(3)}$ {\tt*} $A^{(2)}$ \\
   44.57 -  $A^{(3)}$ & = & {\tt-} $A^{(3)}$
   44.58 -\end{tabular}
   44.59 -\end{center}
   44.60 -The choice of priorities determines that {\tt -} binds tighter than {\tt *},
   44.61 -which binds tighter than {\tt +}.  Furthermore {\tt +} associates to the
   44.62 -left and {\tt *} to the right.
   44.63 -
   44.64 -For clarity, grammars obey these conventions:
   44.65 -\begin{itemize}
   44.66 -\item All priorities must lie between~0 and \ttindex{max_pri}, which is a
   44.67 -  some fixed integer.  Sometimes {\tt max_pri} is written as $\infty$.
   44.68 -\item Priority 0 on the right-hand side and priority \ttindex{max_pri} on
   44.69 -  the left-hand side may be omitted.
   44.70 -\item The production $A^{(p)} = \alpha$ is written as $A = \alpha~(p)$; the
   44.71 -  priority of the left-hand side actually appears in a column on the far
   44.72 -  right.
   44.73 -\item Alternatives are separated by~$|$.
   44.74 -\item Repetition is indicated by dots~(\dots) in an informal but obvious
   44.75 -  way.
   44.76 -\end{itemize}
   44.77 -
   44.78 -Using these conventions and assuming $\infty=9$, the grammar
   44.79 -takes the form
   44.80 -\begin{center}
   44.81 -\begin{tabular}{rclc}
   44.82 -$A$ & = & {\tt0} & \hspace*{4em} \\
   44.83 - & $|$ & {\tt(} $A$ {\tt)} \\
   44.84 - & $|$ & $A$ {\tt+} $A^{(1)}$ & (0) \\
   44.85 - & $|$ & $A^{(3)}$ {\tt*} $A^{(2)}$ & (2) \\
   44.86 - & $|$ & {\tt-} $A^{(3)}$ & (3)
   44.87 -\end{tabular}
   44.88 -\end{center}
   44.89 -\index{priority grammars|)}
   44.90 -
   44.91 -
   44.92 -\begin{figure}\small
   44.93 -\begin{center}
   44.94 -\begin{tabular}{rclc}
   44.95 -$any$ &=& $prop$ ~~$|$~~ $logic$ \\\\
   44.96 -$prop$ &=& {\tt(} $prop$ {\tt)} \\
   44.97 -     &$|$& $prop^{(4)}$ {\tt::} $type$ & (3) \\
   44.98 -     &$|$& {\tt PROP} $aprop$ \\
   44.99 -     &$|$& $any^{(3)}$ {\tt ==} $any^{(2)}$ & (2) \\
  44.100 -     &$|$& $any^{(3)}$ {\tt =?=} $any^{(2)}$ & (2) \\
  44.101 -     &$|$& $prop^{(2)}$ {\tt ==>} $prop^{(1)}$ & (1) \\
  44.102 -     &$|$& {\tt[|} $prop$ {\tt;} \dots {\tt;} $prop$ {\tt|]} {\tt==>} $prop^{(1)}$ & (1) \\
  44.103 -     &$|$& {\tt!!} $idts$ {\tt.} $prop$ & (0) \\
  44.104 -     &$|$& {\tt OFCLASS} {\tt(} $type$ {\tt,} $logic$ {\tt)} \\\\
  44.105 -$aprop$ &=& $id$ ~~$|$~~ $longid$ ~~$|$~~ $var$
  44.106 -    ~~$|$~~ $logic^{(\infty)}$ {\tt(} $any$ {\tt,} \dots {\tt,} $any$ {\tt)} \\\\
  44.107 -$logic$ &=& {\tt(} $logic$ {\tt)} \\
  44.108 -      &$|$& $logic^{(4)}$ {\tt::} $type$ & (3) \\
  44.109 -      &$|$& $id$ ~~$|$~~ $longid$ ~~$|$~~ $var$
  44.110 -    ~~$|$~~ $logic^{(\infty)}$ {\tt(} $any$ {\tt,} \dots {\tt,} $any$ {\tt)} \\
  44.111 -      &$|$& {\tt \%} $pttrns$ {\tt.} $any^{(3)}$ & (3) \\
  44.112 -      &$|$& {\tt TYPE} {\tt(} $type$ {\tt)} \\\\
  44.113 -$idts$ &=& $idt$ ~~$|$~~ $idt^{(1)}$ $idts$ \\\\
  44.114 -$idt$ &=& $id$ ~~$|$~~ {\tt(} $idt$ {\tt)} \\
  44.115 -    &$|$& $id$ {\tt ::} $type$ & (0) \\\\
  44.116 -$pttrns$ &=& $pttrn$ ~~$|$~~ $pttrn^{(1)}$ $pttrns$ \\\\
  44.117 -$pttrn$ &=& $idt$ \\\\
  44.118 -$type$ &=& {\tt(} $type$ {\tt)} \\
  44.119 -     &$|$& $tid$ ~~$|$~~ $tvar$ ~~$|$~~ $tid$ {\tt::} $sort$
  44.120 -       ~~$|$~~ $tvar$ {\tt::} $sort$ \\
  44.121 -     &$|$& $id$ ~~$|$~~ $type^{(\infty)}$ $id$
  44.122 -                ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $id$ \\
  44.123 -     &$|$& $longid$ ~~$|$~~ $type^{(\infty)}$ $longid$
  44.124 -                ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $longid$ \\
  44.125 -     &$|$& $type^{(1)}$ {\tt =>} $type$ & (0) \\
  44.126 -     &$|$& {\tt[}  $type$ {\tt,} \dots {\tt,} $type$ {\tt]} {\tt=>} $type$&(0) \\\\
  44.127 -$sort$ &=& $id$ ~~$|$~~ $longid$ ~~$|$~~ {\tt\ttlbrace\ttrbrace} ~~$|$~~
  44.128 -  {\tt\ttlbrace} $id$ ~$|$~ $longid${\tt,}\dots{\tt,} $id$ ~$|$~$longid$ {\tt\ttrbrace}
  44.129 -\end{tabular}
  44.130 -\index{*PROP symbol}
  44.131 -\index{*== symbol}\index{*=?= symbol}\index{*==> symbol}
  44.132 -\index{*:: symbol}\index{*=> symbol}
  44.133 -\index{sort constraints}
  44.134 -%the index command: a percent is permitted, but braces must match!
  44.135 -\index{%@{\tt\%} symbol}
  44.136 -\index{{}@{\tt\ttlbrace} symbol}\index{{}@{\tt\ttrbrace} symbol}
  44.137 -\index{*[ symbol}\index{*] symbol}
  44.138 -\index{*"!"! symbol}
  44.139 -\index{*"["| symbol}
  44.140 -\index{*"|"] symbol}
  44.141 -\end{center}
  44.142 -\caption{Meta-logic syntax}\label{fig:pure_gram}
  44.143 -\end{figure}
  44.144 -
  44.145 -
  44.146 -\section{The Pure syntax} \label{sec:basic_syntax}
  44.147 -\index{syntax!Pure|(}
  44.148 -
  44.149 -At the root of all object-logics lies the theory \thydx{Pure}.  It
  44.150 -contains, among many other things, the Pure syntax.  An informal account of
  44.151 -this basic syntax (types, terms and formulae) appears in
  44.152 -\iflabelundefined{sec:forward}{{\em Introduction to Isabelle}}%
  44.153 -{\S\ref{sec:forward}}.  A more precise description using a priority grammar
  44.154 -appears in Fig.\ts\ref{fig:pure_gram}.  It defines the following
  44.155 -nonterminals:
  44.156 -\begin{ttdescription}
  44.157 -  \item[\ndxbold{any}] denotes any term.
  44.158 -
  44.159 -  \item[\ndxbold{prop}] denotes terms of type {\tt prop}.  These are formulae
  44.160 -    of the meta-logic.  Note that user constants of result type {\tt prop}
  44.161 -    (i.e.\ $c :: \ldots \To prop$) should always provide concrete syntax.
  44.162 -    Otherwise atomic propositions with head $c$ may be printed incorrectly.
  44.163 -
  44.164 -  \item[\ndxbold{aprop}] denotes atomic propositions.
  44.165 -
  44.166 -%% FIXME huh!?
  44.167 -%  These typically
  44.168 -%  include the judgement forms of the object-logic; its definition
  44.169 -%  introduces a meta-level predicate for each judgement form.
  44.170 -
  44.171 -  \item[\ndxbold{logic}] denotes terms whose type belongs to class
  44.172 -    \cldx{logic}, excluding type \tydx{prop}.
  44.173 -
  44.174 -  \item[\ndxbold{idts}] denotes a list of identifiers, possibly constrained
  44.175 -    by types.
  44.176 -    
  44.177 -  \item[\ndxbold{pttrn}, \ndxbold{pttrns}] denote patterns for
  44.178 -    abstraction, cases etc.  Initially the same as $idt$ and $idts$,
  44.179 -    these are intended to be augmented by user extensions.
  44.180 -
  44.181 -  \item[\ndxbold{type}] denotes types of the meta-logic.
  44.182 -
  44.183 -  \item[\ndxbold{sort}] denotes meta-level sorts.
  44.184 -\end{ttdescription}
  44.185 -
  44.186 -\begin{warn}
  44.187 -  In {\tt idts}, note that \verb|x::nat y| is parsed as \verb|x::(nat y)|,
  44.188 -  treating {\tt y} like a type constructor applied to {\tt nat}.  The
  44.189 -  likely result is an error message.  To avoid this interpretation, use
  44.190 -  parentheses and write \verb|(x::nat) y|.
  44.191 -  \index{type constraints}\index{*:: symbol}
  44.192 -
  44.193 -  Similarly, \verb|x::nat y::nat| is parsed as \verb|x::(nat y::nat)| and
  44.194 -  yields an error.  The correct form is \verb|(x::nat) (y::nat)|.
  44.195 -\end{warn}
  44.196 -
  44.197 -\begin{warn}
  44.198 -  Type constraints bind very weakly.  For example, \verb!x<y::nat! is normally
  44.199 -  parsed as \verb!(x<y)::nat!, unless \verb$<$ has priority of 3 or less, in
  44.200 -  which case the string is likely to be ambiguous.  The correct form is
  44.201 -  \verb!x<(y::nat)!.
  44.202 -\end{warn}
  44.203 -
  44.204 -\subsection{Logical types and default syntax}\label{logical-types}
  44.205 -\index{lambda calc@$\lambda$-calculus}
  44.206 -
  44.207 -Isabelle's representation of mathematical languages is based on the
  44.208 -simply typed $\lambda$-calculus.  All logical types, namely those of
  44.209 -class \cldx{logic}, are automatically equipped with a basic syntax of
  44.210 -types, identifiers, variables, parentheses, $\lambda$-abstraction and
  44.211 -application.
  44.212 -\begin{warn}
  44.213 -  Isabelle combines the syntaxes for all types of class \cldx{logic} by
  44.214 -  mapping all those types to the single nonterminal $logic$.  Thus all
  44.215 -  productions of $logic$, in particular $id$, $var$ etc, become available.
  44.216 -\end{warn}
  44.217 -
  44.218 -
  44.219 -\subsection{Lexical matters}
  44.220 -The parser does not process input strings directly.  It operates on token
  44.221 -lists provided by Isabelle's \bfindex{lexer}.  There are two kinds of
  44.222 -tokens: \bfindex{delimiters} and \bfindex{name tokens}.
  44.223 -
  44.224 -\index{reserved words}
  44.225 -Delimiters can be regarded as reserved words of the syntax.  You can
  44.226 -add new ones when extending theories.  In Fig.\ts\ref{fig:pure_gram} they
  44.227 -appear in typewriter font, for example {\tt ==}, {\tt =?=} and
  44.228 -{\tt PROP}\@.
  44.229 -
  44.230 -Name tokens have a predefined syntax.  The lexer distinguishes six disjoint
  44.231 -classes of names: \rmindex{identifiers}, \rmindex{unknowns}, type
  44.232 -identifiers\index{type identifiers}, type unknowns\index{type unknowns},
  44.233 -\rmindex{numerals}, \rmindex{strings}.  They are denoted by \ndxbold{id},
  44.234 -\ndxbold{var}, \ndxbold{tid}, \ndxbold{tvar}, \ndxbold{num}, \ndxbold{xnum},
  44.235 -\ndxbold{xstr}, respectively.  Typical examples are {\tt x}, {\tt ?x7}, {\tt
  44.236 -  'a}, {\tt ?'a3}, {\tt \#42}, {\tt ''foo bar''}.  Here is the precise syntax:
  44.237 -\begin{eqnarray*}
  44.238 -id        & =   & letter\,quasiletter^* \\
  44.239 -longid    & =   & id (\mbox{\tt .}id)^+ \\
  44.240 -var       & =   & \mbox{\tt ?}id ~~|~~ \mbox{\tt ?}id\mbox{\tt .}nat \\
  44.241 -tid       & =   & \mbox{\tt '}id \\
  44.242 -tvar      & =   & \mbox{\tt ?}tid ~~|~~
  44.243 -                  \mbox{\tt ?}tid\mbox{\tt .}nat \\
  44.244 -num       & =   & nat ~~|~~ \mbox{\tt-}nat ~~|~~ \verb,0x,\,hex^+ ~~|~~ \verb,0b,\,bin^+ \\
  44.245 -xnum      & =   & \mbox{\tt \#}num \\
  44.246 -xstr      & =   & \mbox{\tt ''~\dots~\tt ''} \\[1ex]
  44.247 -letter & = & latin ~|~ \verb,\<,latin\verb,>, ~|~ \verb,\<,latin\,latin\verb,>, ~|~ greek ~| \\
  44.248 -      &   & \verb,\<^isub>, ~|~ \verb,\<^isup>, \\
  44.249 -quasiletter & = & letter ~|~ digit ~|~ \verb,_, ~|~ \verb,', \\
  44.250 -latin & = & \verb,a, ~|~ \dots ~|~ \verb,z, ~|~ \verb,A, ~|~ \dots ~|~ \verb,Z, \\
  44.251 -digit & = & \verb,0, ~|~ \dots ~|~ \verb,9, \\
  44.252 -nat & = & digit^+ \\
  44.253 -bin & = & \verb,0, ~|~ \verb,1, \\
  44.254 -hex & = & digit  ~|~  \verb,a, ~|~ \dots ~|~ \verb,f, ~|~ \verb,A, ~|~ \dots ~|~ \verb,F, \\
  44.255 -greek & = & \verb,\<alpha>, ~|~ \verb,\<beta>, ~|~ \verb,\<gamma>, ~|~ \verb,\<delta>, ~| \\
  44.256 -      &   & \verb,\<epsilon>, ~|~ \verb,\<zeta>, ~|~ \verb,\<eta>, ~|~ \verb,\<theta>, ~| \\
  44.257 -      &   & \verb,\<iota>, ~|~ \verb,\<kappa>, ~|~ \verb,\<mu>, ~|~ \verb,\<nu>, ~| \\
  44.258 -      &   & \verb,\<xi>, ~|~ \verb,\<pi>, ~|~ \verb,\<rho>, ~|~ \verb,\<sigma>, ~| \\
  44.259 -      &   & \verb,\<tau>, ~|~ \verb,\<upsilon>, ~|~ \verb,\<phi>, ~|~ \verb,\<psi>, ~| \\
  44.260 -      &   & \verb,\<omega>, ~|~ \verb,\<Gamma>, ~|~ \verb,\<Delta>, ~|~ \verb,\<Theta>, ~| \\
  44.261 -      &   & \verb,\<Lambda>, ~|~ \verb,\<Xi>, ~|~ \verb,\<Pi>, ~|~ \verb,\<Sigma>, ~| \\
  44.262 -      &   & \verb,\<Upsilon>, ~|~ \verb,\<Phi>, ~|~ \verb,\<Psi>, ~|~ \verb,\<Omega>, \\
  44.263 -\end{eqnarray*}
  44.264 -The lexer repeatedly takes the longest prefix of the input string that
  44.265 -forms a valid token.  A maximal prefix that is both a delimiter and a
  44.266 -name is treated as a delimiter.  Spaces, tabs, newlines and formfeeds
  44.267 -are separators; they never occur within tokens, except those of class
  44.268 -$xstr$.
  44.269 -
  44.270 -\medskip
  44.271 -Delimiters need not be separated by white space.  For example, if {\tt -}
  44.272 -is a delimiter but {\tt --} is not, then the string {\tt --} is treated as
  44.273 -two consecutive occurrences of the token~{\tt -}.  In contrast, \ML\
  44.274 -treats {\tt --} as a single symbolic name.  The consequence of Isabelle's
  44.275 -more liberal scheme is that the same string may be parsed in different ways
  44.276 -after extending the syntax: after adding {\tt --} as a delimiter, the input
  44.277 -{\tt --} is treated as a single token.
  44.278 -
  44.279 -A \ndxbold{var} or \ndxbold{tvar} describes an unknown, which is internally
  44.280 -a pair of base name and index (\ML\ type \mltydx{indexname}).  These
  44.281 -components are either separated by a dot as in {\tt ?x.1} or {\tt ?x7.3} or
  44.282 -run together as in {\tt ?x1}.  The latter form is possible if the base name
  44.283 -does not end with digits.  If the index is 0, it may be dropped altogether:
  44.284 -{\tt ?x} abbreviates both {\tt ?x0} and {\tt ?x.0}.
  44.285 -
  44.286 -Tokens of class $num$, $xnum$ or $xstr$ are not used by the meta-logic.
  44.287 -Object-logics may provide numerals and string constants by adding appropriate
  44.288 -productions and translation functions.
  44.289 -
  44.290 -\medskip
  44.291 -Although name tokens are returned from the lexer rather than the parser, it
  44.292 -is more logical to regard them as nonterminals.  Delimiters, however, are
  44.293 -terminals; they are just syntactic sugar and contribute nothing to the
  44.294 -abstract syntax tree.
  44.295 -
  44.296 -
  44.297 -\subsection{*Inspecting the syntax} \label{pg:print_syn}
  44.298 -\begin{ttbox}
  44.299 -syn_of              : theory -> Syntax.syntax
  44.300 -print_syntax        : theory -> unit
  44.301 -Syntax.print_syntax : Syntax.syntax -> unit
  44.302 -Syntax.print_gram   : Syntax.syntax -> unit
  44.303 -Syntax.print_trans  : Syntax.syntax -> unit
  44.304 -\end{ttbox}
  44.305 -The abstract type \mltydx{Syntax.syntax} allows manipulation of syntaxes
  44.306 -in \ML.  You can display values of this type by calling the following
  44.307 -functions:
  44.308 -\begin{ttdescription}
  44.309 -\item[\ttindexbold{syn_of} {\it thy}] returns the syntax of the Isabelle
  44.310 -  theory~{\it thy} as an \ML\ value.
  44.311 -
  44.312 -\item[\ttindexbold{print_syntax} $thy$] uses {\tt Syntax.print_syntax}
  44.313 - to display the syntax part of theory $thy$.
  44.314 -
  44.315 -\item[\ttindexbold{Syntax.print_syntax} {\it syn}] shows virtually all
  44.316 -  information contained in the syntax {\it syn}.  The displayed output can
  44.317 -  be large.  The following two functions are more selective.
  44.318 -
  44.319 -\item[\ttindexbold{Syntax.print_gram} {\it syn}] shows the grammar part
  44.320 -  of~{\it syn}, namely the lexicon, logical types and productions.  These are
  44.321 -  discussed below.
  44.322 -
  44.323 -\item[\ttindexbold{Syntax.print_trans} {\it syn}] shows the translation
  44.324 -  part of~{\it syn}, namely the constants, parse/print macros and
  44.325 -  parse/print translations.
  44.326 -\end{ttdescription}
  44.327 -
  44.328 -The output of the above print functions is divided into labelled sections.
  44.329 -The grammar is represented by {\tt lexicon}, {\tt logtypes} and {\tt prods}.
  44.330 -The rest refers to syntactic translations and macro expansion.  Here is an
  44.331 -explanation of the various sections.
  44.332 -\begin{description}
  44.333 -  \item[{\tt lexicon}] lists the delimiters used for lexical
  44.334 -    analysis.\index{delimiters}
  44.335 -
  44.336 -  \item[{\tt logtypes}] lists the types that are regarded the same as {\tt
  44.337 -    logic} syntactically.  Thus types of object-logics (e.g.\ {\tt nat}, say)
  44.338 -    will be automatically equipped with the standard syntax of
  44.339 -    $\lambda$-calculus.
  44.340 -
  44.341 -  \item[{\tt prods}] lists the \rmindex{productions} of the priority grammar.
  44.342 -    The nonterminal $A^{(n)}$ is rendered in {\sc ascii} as {\tt $A$[$n$]}.
  44.343 -    Each delimiter is quoted.  Some productions are shown with {\tt =>} and
  44.344 -    an attached string.  These strings later become the heads of parse
  44.345 -    trees; they also play a vital role when terms are printed (see
  44.346 -    \S\ref{sec:asts}).
  44.347 -
  44.348 -    Productions with no strings attached are called {\bf copy
  44.349 -      productions}\indexbold{productions!copy}.  Their right-hand side must
  44.350 -    have exactly one nonterminal symbol (or name token).  The parser does
  44.351 -    not create a new parse tree node for copy productions, but simply
  44.352 -    returns the parse tree of the right-hand symbol.
  44.353 -
  44.354 -    If the right-hand side consists of a single nonterminal with no
  44.355 -    delimiters, then the copy production is called a {\bf chain
  44.356 -      production}.  Chain productions act as abbreviations:
  44.357 -    conceptually, they are removed from the grammar by adding new
  44.358 -    productions.  Priority information attached to chain productions is
  44.359 -    ignored; only the dummy value $-1$ is displayed.
  44.360 -    
  44.361 -  \item[\ttindex{print_modes}] lists the alternative print modes
  44.362 -    provided by this syntax (see \S\ref{sec:prmodes}).
  44.363 -
  44.364 -  \item[{\tt consts}, {\tt parse_rules}, {\tt print_rules}]
  44.365 -    relate to macros (see \S\ref{sec:macros}).
  44.366 -
  44.367 -  \item[{\tt parse_ast_translation}, {\tt print_ast_translation}]
  44.368 -    list sets of constants that invoke translation functions for abstract
  44.369 -    syntax trees.  Section \S\ref{sec:asts} below discusses this obscure
  44.370 -    matter.\index{constants!for translations}
  44.371 -
  44.372 -  \item[{\tt parse_translation}, {\tt print_translation}] list the sets
  44.373 -    of constants that invoke translation functions for terms (see
  44.374 -    \S\ref{sec:tr_funs}).
  44.375 -\end{description}
  44.376 -\index{syntax!Pure|)}
  44.377 -
  44.378  
  44.379  \section{Mixfix declarations} \label{sec:mixfix}
  44.380  \index{mixfix declarations|(}
  44.381 @@ -515,49 +144,6 @@
  44.382    syntax}.  Try this as an exercise and study the changes in the
  44.383  grammar.
  44.384  
  44.385 -\subsection{The mixfix template}
  44.386 -Let us now take a closer look at the string $template$ appearing in mixfix
  44.387 -annotations.  This string specifies a list of parsing and printing
  44.388 -directives: delimiters\index{delimiters}, arguments, spaces, blocks of
  44.389 -indentation and line breaks.  These are encoded by the following character
  44.390 -sequences:
  44.391 -\index{pretty printing|(}
  44.392 -\begin{description}
  44.393 -\item[~$d$~] is a delimiter, namely a non-empty sequence of characters
  44.394 -  other than the special characters {\tt _}, {\tt(}, {\tt)} and~{\tt/}.
  44.395 -  Even these characters may appear if escaped; this means preceding it with
  44.396 -  a~{\tt '} (single quote).  Thus you have to write {\tt ''} if you really
  44.397 -  want a single quote.  Furthermore, a~{\tt '} followed by a space separates
  44.398 -  delimiters without extra white space being added for printing.
  44.399 -
  44.400 -\item[~{\tt_}~] is an argument position, which stands for a nonterminal symbol
  44.401 -  or name token.
  44.402 -
  44.403 -\item[~$s$~] is a non-empty sequence of spaces for printing.  This and the
  44.404 -  following specifications do not affect parsing at all.
  44.405 -
  44.406 -\item[~{\tt(}$n$~] opens a pretty printing block.  The optional number $n$
  44.407 -  specifies how much indentation to add when a line break occurs within the
  44.408 -  block.  If {\tt(} is not followed by digits, the indentation defaults
  44.409 -  to~0.
  44.410 -
  44.411 -\item[~{\tt)}~] closes a pretty printing block.
  44.412 -
  44.413 -\item[~{\tt//}~] forces a line break.
  44.414 -
  44.415 -\item[~{\tt/}$s$~] allows a line break.  Here $s$ stands for the string of
  44.416 -  spaces (zero or more) right after the {\tt /} character.  These spaces
  44.417 -  are printed if the break is not taken.
  44.418 -\end{description}
  44.419 -For example, the template {\tt"(_ +/ _)"} specifies an infix operator.
  44.420 -There are two argument positions; the delimiter~{\tt+} is preceded by a
  44.421 -space and followed by a space or line break; the entire phrase is a pretty
  44.422 -printing block.  Other examples appear in Fig.\ts\ref{fig:set_trans} below.
  44.423 -Isabelle's pretty printer resembles the one described in
  44.424 -Paulson~\cite{paulson-ml2}.
  44.425 -
  44.426 -\index{pretty printing|)}
  44.427 -
  44.428  
  44.429  \subsection{Infixes}
  44.430  \indexbold{infixes}
  44.431 @@ -723,141 +309,6 @@
  44.432  ambiguity should be eliminated by changing the grammar or the rule.
  44.433  
  44.434  
  44.435 -\section{Example: some minimal logics} \label{sec:min_logics}
  44.436 -\index{examples!of logic definitions}
  44.437 -
  44.438 -This section presents some examples that have a simple syntax.  They
  44.439 -demonstrate how to define new object-logics from scratch.
  44.440 -
  44.441 -First we must define how an object-logic syntax is embedded into the
  44.442 -meta-logic.  Since all theorems must conform to the syntax for~\ndx{prop}
  44.443 -(see Fig.\ts\ref{fig:pure_gram}), that syntax has to be extended with the
  44.444 -object-level syntax.  Assume that the syntax of your object-logic defines a
  44.445 -meta-type~\tydx{o} of formulae which refers to the nonterminal {\tt logic}.
  44.446 -These formulae can now appear in axioms and theorems wherever \ndx{prop} does
  44.447 -if you add the production
  44.448 -\[ prop ~=~ logic. \]
  44.449 -This is not supposed to be a copy production but an implicit coercion from
  44.450 -formulae to propositions:
  44.451 -\begin{ttbox}
  44.452 -Base = Pure +
  44.453 -types
  44.454 -  o
  44.455 -arities
  44.456 -  o :: logic
  44.457 -consts
  44.458 -  Trueprop :: o => prop   ("_" 5)
  44.459 -end
  44.460 -\end{ttbox}
  44.461 -The constant \cdx{Trueprop} (the name is arbitrary) acts as an invisible
  44.462 -coercion function.  Assuming this definition resides in a file {\tt Base.thy},
  44.463 -you have to load it with the command {\tt use_thy "Base"}.
  44.464 -
  44.465 -One of the simplest nontrivial logics is {\bf minimal logic} of
  44.466 -implication.  Its definition in Isabelle needs no advanced features but
  44.467 -illustrates the overall mechanism nicely:
  44.468 -\begin{ttbox}
  44.469 -Hilbert = Base +
  44.470 -consts
  44.471 -  "-->" :: [o, o] => o   (infixr 10)
  44.472 -rules
  44.473 -  K     "P --> Q --> P"
  44.474 -  S     "(P --> Q --> R) --> (P --> Q) --> P --> R"
  44.475 -  MP    "[| P --> Q; P |] ==> Q"
  44.476 -end
  44.477 -\end{ttbox}
  44.478 -After loading this definition from the file {\tt Hilbert.thy}, you can
  44.479 -start to prove theorems in the logic:
  44.480 -\begin{ttbox}
  44.481 -Goal "P --> P";
  44.482 -{\out Level 0}
  44.483 -{\out P --> P}
  44.484 -{\out  1.  P --> P}
  44.485 -\ttbreak
  44.486 -by (resolve_tac [Hilbert.MP] 1);
  44.487 -{\out Level 1}
  44.488 -{\out P --> P}
  44.489 -{\out  1.  ?P --> P --> P}
  44.490 -{\out  2.  ?P}
  44.491 -\ttbreak
  44.492 -by (resolve_tac [Hilbert.MP] 1);
  44.493 -{\out Level 2}
  44.494 -{\out P --> P}
  44.495 -{\out  1.  ?P1 --> ?P --> P --> P}
  44.496 -{\out  2.  ?P1}
  44.497 -{\out  3.  ?P}
  44.498 -\ttbreak
  44.499 -by (resolve_tac [Hilbert.S] 1);
  44.500 -{\out Level 3}
  44.501 -{\out P --> P}
  44.502 -{\out  1.  P --> ?Q2 --> P}
  44.503 -{\out  2.  P --> ?Q2}
  44.504 -\ttbreak
  44.505 -by (resolve_tac [Hilbert.K] 1);
  44.506 -{\out Level 4}
  44.507 -{\out P --> P}
  44.508 -{\out  1.  P --> ?Q2}
  44.509 -\ttbreak
  44.510 -by (resolve_tac [Hilbert.K] 1);
  44.511 -{\out Level 5}
  44.512 -{\out P --> P}
  44.513 -{\out No subgoals!}
  44.514 -\end{ttbox}
  44.515 -As we can see, this Hilbert-style formulation of minimal logic is easy to
  44.516 -define but difficult to use.  The following natural deduction formulation is
  44.517 -better:
  44.518 -\begin{ttbox}
  44.519 -MinI = Base +
  44.520 -consts
  44.521 -  "-->" :: [o, o] => o   (infixr 10)
  44.522 -rules
  44.523 -  impI  "(P ==> Q) ==> P --> Q"
  44.524 -  impE  "[| P --> Q; P |] ==> Q"
  44.525 -end
  44.526 -\end{ttbox}
  44.527 -Note, however, that although the two systems are equivalent, this fact
  44.528 -cannot be proved within Isabelle.  Axioms {\tt S} and {\tt K} can be
  44.529 -derived in {\tt MinI} (exercise!), but {\tt impI} cannot be derived in {\tt
  44.530 -  Hilbert}.  The reason is that {\tt impI} is only an {\bf admissible} rule
  44.531 -in {\tt Hilbert}, something that can only be shown by induction over all
  44.532 -possible proofs in {\tt Hilbert}.
  44.533 -
  44.534 -We may easily extend minimal logic with falsity:
  44.535 -\begin{ttbox}
  44.536 -MinIF = MinI +
  44.537 -consts
  44.538 -  False :: o
  44.539 -rules
  44.540 -  FalseE "False ==> P"
  44.541 -end
  44.542 -\end{ttbox}
  44.543 -On the other hand, we may wish to introduce conjunction only:
  44.544 -\begin{ttbox}
  44.545 -MinC = Base +
  44.546 -consts
  44.547 -  "&" :: [o, o] => o   (infixr 30)
  44.548 -\ttbreak
  44.549 -rules
  44.550 -  conjI  "[| P; Q |] ==> P & Q"
  44.551 -  conjE1 "P & Q ==> P"
  44.552 -  conjE2 "P & Q ==> Q"
  44.553 -end
  44.554 -\end{ttbox}
  44.555 -And if we want to have all three connectives together, we create and load a
  44.556 -theory file consisting of a single line:
  44.557 -\begin{ttbox}
  44.558 -MinIFC = MinIF + MinC
  44.559 -\end{ttbox}
  44.560 -Now we can prove mixed theorems like
  44.561 -\begin{ttbox}
  44.562 -Goal "P & False --> Q";
  44.563 -by (resolve_tac [MinI.impI] 1);
  44.564 -by (dresolve_tac [MinC.conjE2] 1);
  44.565 -by (eresolve_tac [MinIF.FalseE] 1);
  44.566 -\end{ttbox}
  44.567 -Try this as an exercise!
  44.568 -
  44.569 -
  44.570  %%% Local Variables: 
  44.571  %%% mode: latex
  44.572  %%% TeX-master: "ref"
    45.1 --- a/doc-src/Ref/introduction.tex	Wed Mar 04 10:43:39 2009 +0100
    45.2 +++ b/doc-src/Ref/introduction.tex	Wed Mar 04 10:45:52 2009 +0100
    45.3 @@ -1,23 +1,5 @@
    45.4 -
    45.5 -%% $Id$
    45.6  
    45.7  \chapter{Basic Use of Isabelle}\index{sessions|(} 
    45.8 -The Reference Manual is a comprehensive description of Isabelle
    45.9 -proper, including all \ML{} commands, functions and packages.  It
   45.10 -really is intended for reference, perhaps for browsing, but not for
   45.11 -reading through.  It is not a tutorial, but assumes familiarity with
   45.12 -the basic logical concepts of Isabelle.
   45.13 -
   45.14 -When you are looking for a way of performing some task, scan the Table of
   45.15 -Contents for a relevant heading.  Functions are organized by their purpose,
   45.16 -by their operands (subgoals, tactics, theorems), and by their usefulness.
   45.17 -In each section, basic functions appear first, then advanced functions, and
   45.18 -finally esoteric functions.  Use the Index when you are looking for the
   45.19 -definition of a particular Isabelle function.
   45.20 -
   45.21 -A few examples are presented.  Many example files are distributed with
   45.22 -Isabelle, however; please experiment interactively.
   45.23 -
   45.24  
   45.25  \section{Basic interaction with Isabelle}
   45.26  \index{starting up|bold}\nobreak
   45.27 @@ -217,109 +199,6 @@
   45.28  value is returned.
   45.29  
   45.30  
   45.31 -\section{Printing of terms and theorems}\label{sec:printing-control}
   45.32 -\index{printing control|(}
   45.33 -Isabelle's pretty printer is controlled by a number of parameters.
   45.34 -
   45.35 -\subsection{Printing limits}
   45.36 -\begin{ttbox} 
   45.37 -Pretty.setdepth  : int -> unit
   45.38 -Pretty.setmargin : int -> unit
   45.39 -print_depth      : int -> unit
   45.40 -\end{ttbox}
   45.41 -These set limits for terminal output.  See also {\tt goals_limit},
   45.42 -which limits the number of subgoals printed
   45.43 -(\S\ref{sec:goals-printing}).
   45.44 -
   45.45 -\begin{ttdescription}
   45.46 -\item[\ttindexbold{Pretty.setdepth} \(d\);] tells Isabelle's pretty printer to
   45.47 -  limit the printing depth to~$d$.  This affects the display of theorems and
   45.48 -  terms.  The default value is~0, which permits printing to an arbitrary
   45.49 -  depth.  Useful values for $d$ are~10 and~20.
   45.50 -
   45.51 -\item[\ttindexbold{Pretty.setmargin} \(m\);]  
   45.52 -  tells Isabelle's pretty printer to assume a right margin (page width)
   45.53 -  of~$m$.  The initial margin is~76.
   45.54 -
   45.55 -\item[\ttindexbold{print_depth} \(n\);]  
   45.56 -  limits the printing depth of complex \ML{} values, such as theorems and
   45.57 -  terms.  This command affects the \ML{} top level and its effect is
   45.58 -  compiler-dependent.  Typically $n$ should be less than~10.
   45.59 -\end{ttdescription}
   45.60 -
   45.61 -
   45.62 -\subsection{Printing of hypotheses, brackets, types etc.}
   45.63 -\index{meta-assumptions!printing of}
   45.64 -\index{types!printing of}\index{sorts!printing of}
   45.65 -\begin{ttbox} 
   45.66 -show_hyps     : bool ref \hfill{\bf initially false}
   45.67 -show_tags     : bool ref \hfill{\bf initially false}
   45.68 -show_brackets : bool ref \hfill{\bf initially false}
   45.69 -show_types    : bool ref \hfill{\bf initially false}
   45.70 -show_sorts    : bool ref \hfill{\bf initially false}
   45.71 -show_consts   : bool ref \hfill{\bf initially false}
   45.72 -long_names    : bool ref \hfill{\bf initially false}
   45.73 -\end{ttbox}
   45.74 -These flags allow you to control how much information is displayed for
   45.75 -types, terms and theorems.  The hypotheses of theorems \emph{are}
   45.76 -normally shown.  Superfluous parentheses of types and terms are not.
   45.77 -Types and sorts of variables are normally hidden.
   45.78 -
   45.79 -Note that displaying types and sorts may explain why a polymorphic
   45.80 -inference rule fails to resolve with some goal, or why a rewrite rule
   45.81 -does not apply as expected.
   45.82 -
   45.83 -\begin{ttdescription}
   45.84 -
   45.85 -\item[reset \ttindexbold{show_hyps};] makes Isabelle show each
   45.86 -  meta-level hypothesis as a dot.
   45.87 -  
   45.88 -\item[set \ttindexbold{show_tags};] makes Isabelle show tags of theorems
   45.89 -  (which are basically just comments that may be attached by some tools).
   45.90 -  
   45.91 -\item[set \ttindexbold{show_brackets};] makes Isabelle show full
   45.92 -  bracketing.  In particular, this reveals the grouping of infix
   45.93 -  operators.
   45.94 -  
   45.95 -\item[set \ttindexbold{show_types};] makes Isabelle show types when
   45.96 -  printing a term or theorem.
   45.97 -  
   45.98 -\item[set \ttindexbold{show_sorts};] makes Isabelle show both types
   45.99 -  and the sorts of type variables, independently of the value of
  45.100 -  \texttt{show_types}.
  45.101 -  
  45.102 -\item[set \ttindexbold{show_consts};] makes Isabelle show types of constants
  45.103 -  when printing proof states.  Note that the output can be enormous as
  45.104 -  polymorphic constants often occur at several different type instances.
  45.105 -
  45.106 -\item[set \ttindexbold{long_names};] forces names of all objects
  45.107 -  (types, constants, theorems, etc.) to be printed in their fully
  45.108 -  qualified internal form.
  45.109 -
  45.110 -\end{ttdescription}
  45.111 -
  45.112 -
  45.113 -\subsection{Eta-contraction before printing}
  45.114 -\begin{ttbox} 
  45.115 -eta_contract: bool ref
  45.116 -\end{ttbox}
  45.117 -The {\bf $\eta$-contraction law} asserts $(\lambda x.f(x))\equiv f$,
  45.118 -provided $x$ is not free in ~$f$.  It asserts {\bf extensionality} of
  45.119 -functions: $f\equiv g$ if $f(x)\equiv g(x)$ for all~$x$.  Higher-order
  45.120 -unification frequently puts terms into a fully $\eta$-expanded form.  For
  45.121 -example, if $F$ has type $(\tau\To\tau)\To\tau$ then its expanded form is
  45.122 -$\lambda h.F(\lambda x.h(x))$.  By default, the user sees this expanded
  45.123 -form.
  45.124 -
  45.125 -\begin{ttdescription}
  45.126 -\item[set \ttindexbold{eta_contract};]
  45.127 -makes Isabelle perform $\eta$-contractions before printing, so that
  45.128 -$\lambda h.F(\lambda x.h(x))$ appears simply as~$F$.  The
  45.129 -distinction between a term and its $\eta$-expanded form occasionally
  45.130 -matters.
  45.131 -\end{ttdescription}
  45.132 -\index{printing control|)}
  45.133 -
  45.134  \section{Diagnostic messages}
  45.135  \index{error messages}
  45.136  \index{warnings}
  45.137 @@ -351,40 +230,16 @@
  45.138  \ttindex{warning} resume normal program execution.
  45.139  
  45.140  
  45.141 -\section{Displaying exceptions as error messages}
  45.142 -\index{exceptions!printing of}
  45.143 +\section{Timing}
  45.144 +\index{timing statistics}\index{proofs!timing}
  45.145  \begin{ttbox} 
  45.146 -print_exn: exn -> 'a
  45.147 +timing: bool ref \hfill{\bf initially false}
  45.148  \end{ttbox}
  45.149 -Certain Isabelle primitives, such as the forward proof functions {\tt RS}
  45.150 -and {\tt RSN}, are called both interactively and from programs.  They
  45.151 -indicate errors not by printing messages, but by raising exceptions.  For
  45.152 -interactive use, \ML's reporting of an uncaught exception may be
  45.153 -uninformative.  The Poly/ML function {\tt exception_trace} can generate a
  45.154 -backtrace.\index{Poly/{\ML} compiler}
  45.155  
  45.156  \begin{ttdescription}
  45.157 -\item[\ttindexbold{print_exn} $e$] 
  45.158 -displays the exception~$e$ in a readable manner, and then re-raises~$e$.
  45.159 -Typical usage is~\hbox{\tt $EXP$ handle e => print_exn e;}, where
  45.160 -$EXP$ is an expression that may raise an exception.
  45.161 -
  45.162 -{\tt print_exn} can display the following common exceptions, which concern
  45.163 -types, terms, theorems and theories, respectively.  Each carries a message
  45.164 -and related information.
  45.165 -\begin{ttbox} 
  45.166 -exception TYPE   of string * typ list * term list
  45.167 -exception TERM   of string * term list
  45.168 -exception THM    of string * int * thm list
  45.169 -exception THEORY of string * theory list
  45.170 -\end{ttbox}
  45.171 +\item[set \ttindexbold{timing};] enables global timing in Isabelle.
  45.172 +  This information is compiler-dependent.
  45.173  \end{ttdescription}
  45.174 -\begin{warn}
  45.175 -  {\tt print_exn} prints terms by calling \ttindex{prin}, which obtains
  45.176 -  pretty printing information from the proof state last stored in the
  45.177 -  subgoal module.  The appearance of the output thus depends upon the
  45.178 -  theory used in the last interactive proof.
  45.179 -\end{warn}
  45.180  
  45.181  \index{sessions|)}
  45.182  
    46.1 --- a/doc-src/Ref/ref.tex	Wed Mar 04 10:43:39 2009 +0100
    46.2 +++ b/doc-src/Ref/ref.tex	Wed Mar 04 10:45:52 2009 +0100
    46.3 @@ -1,13 +1,12 @@
    46.4  \documentclass[12pt,a4paper]{report}
    46.5 -\usepackage{graphicx,../iman,../extra,../ttbox,../proof,../rail,../pdfsetup}
    46.6 +\usepackage{graphicx,../iman,../extra,../ttbox,../proof,../pdfsetup}
    46.7  
    46.8 -%% $Id$
    46.9  %%\includeonly{}
   46.10  %%% to index ids: \[\\tt \([a-zA-Z0-9][a-zA-Z0-9_'.]*\)    [\\ttindexbold{\1}
   46.11  %%% to delete old ones:  \\indexbold{\*[^}]*}
   46.12  %% run    sedindex ref    to prepare index file
   46.13  %%% needs chapter on Provers/typedsimp.ML?
   46.14 -\title{\includegraphics[scale=0.5]{isabelle} \\[4ex] The Isabelle Reference Manual}
   46.15 +\title{\includegraphics[scale=0.5]{isabelle} \\[4ex] Old Isabelle Reference Manual}
   46.16  
   46.17  \author{{\em Lawrence C. Paulson}\\
   46.18          Computer Laboratory \\ University of Cambridge \\
   46.19 @@ -22,10 +21,6 @@
   46.20  \sloppy
   46.21  \binperiod     %%%treat . like a binary operator
   46.22  
   46.23 -\railalias{lbrace}{\ttlbrace}
   46.24 -\railalias{rbrace}{\ttrbrace}
   46.25 -\railterm{lbrace,rbrace}
   46.26 -
   46.27  \begin{document}
   46.28  \underscoreoff
   46.29  
   46.30 @@ -34,17 +29,10 @@
   46.31  \index{meta-rules|see{meta-rules}}
   46.32  
   46.33  \maketitle 
   46.34 -\emph{Note}: this document is part of the earlier Isabelle documentation, 
   46.35 -which is somewhat superseded by the Isabelle/HOL
   46.36 -\emph{Tutorial}~\cite{isa-tutorial}. Much of it is concerned with 
   46.37 -the old-style theory syntax and the primitives for conducting proofs 
   46.38 -using the ML top level. This style of interaction is largely obsolete:
   46.39 -most Isabelle proofs are now written using the Isar 
   46.40 -language and the Proof General interface. However, this is the only
   46.41 -comprehensive Isabelle reference manual.  
   46.42 -
   46.43 -See also the \emph{Introduction to Isabelle}, which has tutorial examples
   46.44 -on conducting proofs using the ML top-level.
   46.45 +\emph{Note}: this document is part of the earlier Isabelle
   46.46 +documentation and is mostly outdated.  Fully obsolete parts of the
   46.47 +original text have already been removed.  The remaining material
   46.48 +covers some aspects that did not make it into the newer manuals yet.
   46.49  
   46.50  \subsubsection*{Acknowledgements} 
   46.51  Tobias Nipkow, of T. U. Munich, wrote most of
   46.52 @@ -62,7 +50,6 @@
   46.53  \pagenumbering{roman} \tableofcontents \clearfirst
   46.54  
   46.55  \include{introduction}
   46.56 -\include{goals}
   46.57  \include{tactic}
   46.58  \include{tctical}
   46.59  \include{thm}
    47.1 --- a/doc-src/Ref/simplifier.tex	Wed Mar 04 10:43:39 2009 +0100
    47.2 +++ b/doc-src/Ref/simplifier.tex	Wed Mar 04 10:45:52 2009 +0100
    47.3 @@ -1,4 +1,4 @@
    47.4 -%% $Id$
    47.5 +
    47.6  \chapter{Simplification}
    47.7  \label{chap:simplification}
    47.8  \index{simplification|(}
    47.9 @@ -810,173 +810,6 @@
   47.10  \end{warn}
   47.11  
   47.12  
   47.13 -\section{Examples of using the Simplifier}
   47.14 -\index{examples!of simplification} Assume we are working within {\tt
   47.15 -  FOL} (see the file \texttt{FOL/ex/Nat}) and that
   47.16 -\begin{ttdescription}
   47.17 -\item[Nat.thy] 
   47.18 -  is a theory including the constants $0$, $Suc$ and $+$,
   47.19 -\item[add_0]
   47.20 -  is the rewrite rule $0+\Var{n} = \Var{n}$,
   47.21 -\item[add_Suc]
   47.22 -  is the rewrite rule $Suc(\Var{m})+\Var{n} = Suc(\Var{m}+\Var{n})$,
   47.23 -\item[induct]
   47.24 -  is the induction rule $\List{\Var{P}(0);\; \Forall x. \Var{P}(x)\Imp
   47.25 -    \Var{P}(Suc(x))} \Imp \Var{P}(\Var{n})$.
   47.26 -\end{ttdescription}
   47.27 -We augment the implicit simpset inherited from \texttt{Nat} with the
   47.28 -basic rewrite rules for addition of natural numbers:
   47.29 -\begin{ttbox}
   47.30 -Addsimps [add_0, add_Suc];
   47.31 -\end{ttbox}
   47.32 -
   47.33 -\subsection{A trivial example}
   47.34 -Proofs by induction typically involve simplification.  Here is a proof
   47.35 -that~0 is a right identity:
   47.36 -\begin{ttbox}
   47.37 -Goal "m+0 = m";
   47.38 -{\out Level 0}
   47.39 -{\out m + 0 = m}
   47.40 -{\out  1. m + 0 = m}
   47.41 -\end{ttbox}
   47.42 -The first step is to perform induction on the variable~$m$.  This returns a
   47.43 -base case and inductive step as two subgoals:
   47.44 -\begin{ttbox}
   47.45 -by (res_inst_tac [("n","m")] induct 1);
   47.46 -{\out Level 1}
   47.47 -{\out m + 0 = m}
   47.48 -{\out  1. 0 + 0 = 0}
   47.49 -{\out  2. !!x. x + 0 = x ==> Suc(x) + 0 = Suc(x)}
   47.50 -\end{ttbox}
   47.51 -Simplification solves the first subgoal trivially:
   47.52 -\begin{ttbox}
   47.53 -by (Simp_tac 1);
   47.54 -{\out Level 2}
   47.55 -{\out m + 0 = m}
   47.56 -{\out  1. !!x. x + 0 = x ==> Suc(x) + 0 = Suc(x)}
   47.57 -\end{ttbox}
   47.58 -The remaining subgoal requires \ttindex{Asm_simp_tac} in order to use the
   47.59 -induction hypothesis as a rewrite rule:
   47.60 -\begin{ttbox}
   47.61 -by (Asm_simp_tac 1);
   47.62 -{\out Level 3}
   47.63 -{\out m + 0 = m}
   47.64 -{\out No subgoals!}
   47.65 -\end{ttbox}
   47.66 -
   47.67 -\subsection{An example of tracing}
   47.68 -\index{tracing!of simplification|(}\index{*trace_simp}
   47.69 -
   47.70 -Let us prove a similar result involving more complex terms.  We prove
   47.71 -that addition is commutative.
   47.72 -\begin{ttbox}
   47.73 -Goal "m+Suc(n) = Suc(m+n)";
   47.74 -{\out Level 0}
   47.75 -{\out m + Suc(n) = Suc(m + n)}
   47.76 -{\out  1. m + Suc(n) = Suc(m + n)}
   47.77 -\end{ttbox}
   47.78 -Performing induction on~$m$ yields two subgoals:
   47.79 -\begin{ttbox}
   47.80 -by (res_inst_tac [("n","m")] induct 1);
   47.81 -{\out Level 1}
   47.82 -{\out m + Suc(n) = Suc(m + n)}
   47.83 -{\out  1. 0 + Suc(n) = Suc(0 + n)}
   47.84 -{\out  2. !!x. x + Suc(n) = Suc(x + n) ==>}
   47.85 -{\out          Suc(x) + Suc(n) = Suc(Suc(x) + n)}
   47.86 -\end{ttbox}
   47.87 -Simplification solves the first subgoal, this time rewriting two
   47.88 -occurrences of~0:
   47.89 -\begin{ttbox}
   47.90 -by (Simp_tac 1);
   47.91 -{\out Level 2}
   47.92 -{\out m + Suc(n) = Suc(m + n)}
   47.93 -{\out  1. !!x. x + Suc(n) = Suc(x + n) ==>}
   47.94 -{\out          Suc(x) + Suc(n) = Suc(Suc(x) + n)}
   47.95 -\end{ttbox}
   47.96 -Switching tracing on illustrates how the simplifier solves the remaining
   47.97 -subgoal: 
   47.98 -\begin{ttbox}
   47.99 -set trace_simp;
  47.100 -by (Asm_simp_tac 1);
  47.101 -\ttbreak
  47.102 -{\out Adding rewrite rule:}
  47.103 -{\out .x + Suc n == Suc (.x + n)}
  47.104 -\ttbreak
  47.105 -{\out Applying instance of rewrite rule:}
  47.106 -{\out ?m + Suc ?n == Suc (?m + ?n)}
  47.107 -{\out Rewriting:}
  47.108 -{\out Suc .x + Suc n == Suc (Suc .x + n)}
  47.109 -\ttbreak
  47.110 -{\out Applying instance of rewrite rule:}
  47.111 -{\out Suc ?m + ?n == Suc (?m + ?n)}
  47.112 -{\out Rewriting:}
  47.113 -{\out Suc .x + n == Suc (.x + n)}
  47.114 -\ttbreak
  47.115 -{\out Applying instance of rewrite rule:}
  47.116 -{\out Suc ?m + ?n == Suc (?m + ?n)}
  47.117 -{\out Rewriting:}
  47.118 -{\out Suc .x + n == Suc (.x + n)}
  47.119 -\ttbreak
  47.120 -{\out Applying instance of rewrite rule:}
  47.121 -{\out ?x = ?x == True}
  47.122 -{\out Rewriting:}
  47.123 -{\out Suc (Suc (.x + n)) = Suc (Suc (.x + n)) == True}
  47.124 -\ttbreak
  47.125 -{\out Level 3}
  47.126 -{\out m + Suc(n) = Suc(m + n)}
  47.127 -{\out No subgoals!}
  47.128 -\end{ttbox}
  47.129 -Many variations are possible.  At Level~1 (in either example) we could have
  47.130 -solved both subgoals at once using the tactical \ttindex{ALLGOALS}:
  47.131 -\begin{ttbox}
  47.132 -by (ALLGOALS Asm_simp_tac);
  47.133 -{\out Level 2}
  47.134 -{\out m + Suc(n) = Suc(m + n)}
  47.135 -{\out No subgoals!}
  47.136 -\end{ttbox}
  47.137 -\index{tracing!of simplification|)}
  47.138 -
  47.139 -
  47.140 -\subsection{Free variables and simplification}
  47.141 -
  47.142 -Here is a conjecture to be proved for an arbitrary function~$f$
  47.143 -satisfying the law $f(Suc(\Var{n})) = Suc(f(\Var{n}))$:
  47.144 -\begin{ttbox}
  47.145 -val [prem] = Goal
  47.146 -               "(!!n. f(Suc(n)) = Suc(f(n))) ==> f(i+j) = i+f(j)";
  47.147 -{\out Level 0}
  47.148 -{\out f(i + j) = i + f(j)}
  47.149 -{\out  1. f(i + j) = i + f(j)}
  47.150 -\ttbreak
  47.151 -{\out val prem = "f(Suc(?n)) = Suc(f(?n))}
  47.152 -{\out             [!!n. f(Suc(n)) = Suc(f(n))]" : thm}
  47.153 -\end{ttbox}
  47.154 -In the theorem~\texttt{prem}, note that $f$ is a free variable while
  47.155 -$\Var{n}$ is a schematic variable.
  47.156 -\begin{ttbox}
  47.157 -by (res_inst_tac [("n","i")] induct 1);
  47.158 -{\out Level 1}
  47.159 -{\out f(i + j) = i + f(j)}
  47.160 -{\out  1. f(0 + j) = 0 + f(j)}
  47.161 -{\out  2. !!x. f(x + j) = x + f(j) ==> f(Suc(x) + j) = Suc(x) + f(j)}
  47.162 -\end{ttbox}
  47.163 -We simplify each subgoal in turn.  The first one is trivial:
  47.164 -\begin{ttbox}
  47.165 -by (Simp_tac 1);
  47.166 -{\out Level 2}
  47.167 -{\out f(i + j) = i + f(j)}
  47.168 -{\out  1. !!x. f(x + j) = x + f(j) ==> f(Suc(x) + j) = Suc(x) + f(j)}
  47.169 -\end{ttbox}
  47.170 -The remaining subgoal requires rewriting by the premise, so we add it
  47.171 -to the current simpset:
  47.172 -\begin{ttbox}
  47.173 -by (asm_simp_tac (simpset() addsimps [prem]) 1);
  47.174 -{\out Level 3}
  47.175 -{\out f(i + j) = i + f(j)}
  47.176 -{\out No subgoals!}
  47.177 -\end{ttbox}
  47.178 -
  47.179 -
  47.180  \section{Permutative rewrite rules}
  47.181  \index{rewrite rules!permutative|(}
  47.182  
    48.1 --- a/doc-src/Ref/substitution.tex	Wed Mar 04 10:43:39 2009 +0100
    48.2 +++ b/doc-src/Ref/substitution.tex	Wed Mar 04 10:45:52 2009 +0100
    48.3 @@ -1,4 +1,4 @@
    48.4 -%% $Id$
    48.5 +
    48.6  \chapter{Substitution Tactics} \label{substitution}
    48.7  \index{tactics!substitution|(}\index{equality|(}
    48.8  
    49.1 --- a/doc-src/Ref/syntax.tex	Wed Mar 04 10:43:39 2009 +0100
    49.2 +++ b/doc-src/Ref/syntax.tex	Wed Mar 04 10:45:52 2009 +0100
    49.3 @@ -1,4 +1,4 @@
    49.4 -%% $Id$
    49.5 +
    49.6  \chapter{Syntax Transformations} \label{chap:syntax}
    49.7  \newcommand\ttapp{\mathrel{\hbox{\tt\$}}}
    49.8  \newcommand\mtt[1]{\mbox{\tt #1}}
    50.1 --- a/doc-src/Ref/tactic.tex	Wed Mar 04 10:43:39 2009 +0100
    50.2 +++ b/doc-src/Ref/tactic.tex	Wed Mar 04 10:45:52 2009 +0100
    50.3 @@ -1,235 +1,8 @@
    50.4 -%% $Id$
    50.5 +
    50.6  \chapter{Tactics} \label{tactics}
    50.7 -\index{tactics|(} Tactics have type \mltydx{tactic}.  This is just an
    50.8 -abbreviation for functions from theorems to theorem sequences, where
    50.9 -the theorems represent states of a backward proof.  Tactics seldom
   50.10 -need to be coded from scratch, as functions; instead they are
   50.11 -expressed using basic tactics and tacticals.
   50.12 -
   50.13 -This chapter only presents the primitive tactics.  Substantial proofs
   50.14 -require the power of automatic tools like simplification
   50.15 -(Chapter~\ref{chap:simplification}) and classical tableau reasoning
   50.16 -(Chapter~\ref{chap:classical}).
   50.17 -
   50.18 -\section{Resolution and assumption tactics}
   50.19 -{\bf Resolution} is Isabelle's basic mechanism for refining a subgoal using
   50.20 -a rule.  {\bf Elim-resolution} is particularly suited for elimination
   50.21 -rules, while {\bf destruct-resolution} is particularly suited for
   50.22 -destruction rules.  The {\tt r}, {\tt e}, {\tt d} naming convention is
   50.23 -maintained for several different kinds of resolution tactics, as well as
   50.24 -the shortcuts in the subgoal module.
   50.25 -
   50.26 -All the tactics in this section act on a subgoal designated by a positive
   50.27 -integer~$i$.  They fail (by returning the empty sequence) if~$i$ is out of
   50.28 -range.
   50.29 -
   50.30 -\subsection{Resolution tactics}
   50.31 -\index{resolution!tactics}
   50.32 -\index{tactics!resolution|bold}
   50.33 -\begin{ttbox} 
   50.34 -resolve_tac  : thm list -> int -> tactic
   50.35 -eresolve_tac : thm list -> int -> tactic
   50.36 -dresolve_tac : thm list -> int -> tactic
   50.37 -forward_tac  : thm list -> int -> tactic 
   50.38 -\end{ttbox}
   50.39 -These perform resolution on a list of theorems, $thms$, representing a list
   50.40 -of object-rules.  When generating next states, they take each of the rules
   50.41 -in the order given.  Each rule may yield several next states, or none:
   50.42 -higher-order resolution may yield multiple resolvents.
   50.43 -\begin{ttdescription}
   50.44 -\item[\ttindexbold{resolve_tac} {\it thms} {\it i}] 
   50.45 -  refines the proof state using the rules, which should normally be
   50.46 -  introduction rules.  It resolves a rule's conclusion with
   50.47 -  subgoal~$i$ of the proof state.
   50.48 -
   50.49 -\item[\ttindexbold{eresolve_tac} {\it thms} {\it i}] 
   50.50 -  \index{elim-resolution}
   50.51 -  performs elim-resolution with the rules, which should normally be
   50.52 -  elimination rules.  It resolves with a rule, proves its first premise by
   50.53 -  assumption, and finally \emph{deletes} that assumption from any new
   50.54 -  subgoals.  (To rotate a rule's premises,
   50.55 -  see \texttt{rotate_prems} in~{\S}\ref{MiscellaneousForwardRules}.)
   50.56 -
   50.57 -\item[\ttindexbold{dresolve_tac} {\it thms} {\it i}] 
   50.58 -  \index{forward proof}\index{destruct-resolution}
   50.59 -  performs destruct-resolution with the rules, which normally should
   50.60 -  be destruction rules.  This replaces an assumption by the result of
   50.61 -  applying one of the rules.
   50.62 -
   50.63 -\item[\ttindexbold{forward_tac}]\index{forward proof}
   50.64 -  is like {\tt dresolve_tac} except that the selected assumption is not
   50.65 -  deleted.  It applies a rule to an assumption, adding the result as a new
   50.66 -  assumption.
   50.67 -\end{ttdescription}
   50.68 -
   50.69 -\subsection{Assumption tactics}
   50.70 -\index{tactics!assumption|bold}\index{assumptions!tactics for}
   50.71 -\begin{ttbox} 
   50.72 -assume_tac    : int -> tactic
   50.73 -eq_assume_tac : int -> tactic
   50.74 -\end{ttbox} 
   50.75 -\begin{ttdescription}
   50.76 -\item[\ttindexbold{assume_tac} {\it i}] 
   50.77 -attempts to solve subgoal~$i$ by assumption.
   50.78 -
   50.79 -\item[\ttindexbold{eq_assume_tac}] 
   50.80 -is like {\tt assume_tac} but does not use unification.  It succeeds (with a
   50.81 -\emph{unique} next state) if one of the assumptions is identical to the
   50.82 -subgoal's conclusion.  Since it does not instantiate variables, it cannot
   50.83 -make other subgoals unprovable.  It is intended to be called from proof
   50.84 -strategies, not interactively.
   50.85 -\end{ttdescription}
   50.86 -
   50.87 -\subsection{Matching tactics} \label{match_tac}
   50.88 -\index{tactics!matching}
   50.89 -\begin{ttbox} 
   50.90 -match_tac  : thm list -> int -> tactic
   50.91 -ematch_tac : thm list -> int -> tactic
   50.92 -dmatch_tac : thm list -> int -> tactic
   50.93 -\end{ttbox}
   50.94 -These are just like the resolution tactics except that they never
   50.95 -instantiate unknowns in the proof state.  Flexible subgoals are not updated
   50.96 -willy-nilly, but are left alone.  Matching --- strictly speaking --- means
   50.97 -treating the unknowns in the proof state as constants; these tactics merely
   50.98 -discard unifiers that would update the proof state.
   50.99 -\begin{ttdescription}
  50.100 -\item[\ttindexbold{match_tac} {\it thms} {\it i}] 
  50.101 -refines the proof state using the rules, matching a rule's
  50.102 -conclusion with subgoal~$i$ of the proof state.
  50.103 -
  50.104 -\item[\ttindexbold{ematch_tac}] 
  50.105 -is like {\tt match_tac}, but performs elim-resolution.
  50.106 -
  50.107 -\item[\ttindexbold{dmatch_tac}] 
  50.108 -is like {\tt match_tac}, but performs destruct-resolution.
  50.109 -\end{ttdescription}
  50.110 -
  50.111 -
  50.112 -\subsection{Explicit instantiation} \label{res_inst_tac}
  50.113 -\index{tactics!instantiation}\index{instantiation}
  50.114 -\begin{ttbox} 
  50.115 -res_inst_tac    : (string*string)list -> thm -> int -> tactic
  50.116 -eres_inst_tac   : (string*string)list -> thm -> int -> tactic
  50.117 -dres_inst_tac   : (string*string)list -> thm -> int -> tactic
  50.118 -forw_inst_tac   : (string*string)list -> thm -> int -> tactic
  50.119 -instantiate_tac : (string*string)list -> tactic
  50.120 -\end{ttbox}
  50.121 -The first four of these tactics are designed for applying rules by resolution
  50.122 -such as substitution and induction, which cause difficulties for higher-order 
  50.123 -unification.  The tactics accept explicit instantiations for unknowns 
  50.124 -in the rule ---typically, in the rule's conclusion. The last one, 
  50.125 -{\tt instantiate_tac}, may be used to instantiate unknowns in the proof state,
  50.126 -independently of rule application. 
  50.127 -
  50.128 -Each instantiation is a pair {\tt($v$,$e$)}, 
  50.129 -where $v$ is an unknown \emph{without} its leading question mark!
  50.130 -\begin{itemize}
  50.131 -\item If $v$ is the type unknown {\tt'a}, then
  50.132 -the rule must contain a type unknown \verb$?'a$ of some
  50.133 -sort~$s$, and $e$ should be a type of sort $s$.
  50.134 -
  50.135 -\item If $v$ is the unknown {\tt P}, then
  50.136 -the rule must contain an unknown \verb$?P$ of some type~$\tau$,
  50.137 -and $e$ should be a term of some type~$\sigma$ such that $\tau$ and
  50.138 -$\sigma$ are unifiable.  If the unification of $\tau$ and $\sigma$
  50.139 -instantiates any type unknowns in $\tau$, these instantiations
  50.140 -are recorded for application to the rule.
  50.141 -\end{itemize}
  50.142 -Types are instantiated before terms are.  Because type instantiations are
  50.143 -inferred from term instantiations, explicit type instantiations are seldom
  50.144 -necessary --- if \verb$?t$ has type \verb$?'a$, then the instantiation list
  50.145 -\texttt{[("'a","bool"), ("t","True")]} may be simplified to
  50.146 -\texttt{[("t","True")]}.  Type unknowns in the proof state may cause
  50.147 -failure because the tactics cannot instantiate them.
  50.148 -
  50.149 -The first four instantiation tactics act on a given subgoal.  Terms in the
  50.150 -instantiations are type-checked in the context of that subgoal --- in
  50.151 -particular, they may refer to that subgoal's parameters.  Any unknowns in
  50.152 -the terms receive subscripts and are lifted over the parameters; thus, you
  50.153 -may not refer to unknowns in the subgoal.
  50.154 -
  50.155 -\begin{ttdescription}
  50.156 -\item[\ttindexbold{res_inst_tac} {\it insts} {\it thm} {\it i}]
  50.157 -instantiates the rule {\it thm} with the instantiations {\it insts}, as
  50.158 -described above, and then performs resolution on subgoal~$i$.  Resolution
  50.159 -typically causes further instantiations; you need not give explicit
  50.160 -instantiations for every unknown in the rule.
  50.161 -
  50.162 -\item[\ttindexbold{eres_inst_tac}] 
  50.163 -is like {\tt res_inst_tac}, but performs elim-resolution.
  50.164 -
  50.165 -\item[\ttindexbold{dres_inst_tac}] 
  50.166 -is like {\tt res_inst_tac}, but performs destruct-resolution.
  50.167 -
  50.168 -\item[\ttindexbold{forw_inst_tac}] 
  50.169 -is like {\tt dres_inst_tac} except that the selected assumption is not
  50.170 -deleted.  It applies the instantiated rule to an assumption, adding the
  50.171 -result as a new assumption.
  50.172 -
  50.173 -\item[\ttindexbold{instantiate_tac} {\it insts}] 
  50.174 -instantiates unknowns in the proof state. This affects the main goal as 
  50.175 -well as all subgoals.
  50.176 -\end{ttdescription}
  50.177 -
  50.178 +\index{tactics|(}
  50.179  
  50.180  \section{Other basic tactics}
  50.181 -\subsection{Tactic shortcuts}
  50.182 -\index{shortcuts!for tactics}
  50.183 -\index{tactics!resolution}\index{tactics!assumption}
  50.184 -\index{tactics!meta-rewriting}
  50.185 -\begin{ttbox} 
  50.186 -rtac     :      thm ->        int -> tactic
  50.187 -etac     :      thm ->        int -> tactic
  50.188 -dtac     :      thm ->        int -> tactic
  50.189 -ftac     :      thm ->        int -> tactic
  50.190 -atac     :                    int -> tactic
  50.191 -eatac    :      thm -> int -> int -> tactic
  50.192 -datac    :      thm -> int -> int -> tactic
  50.193 -fatac    :      thm -> int -> int -> tactic
  50.194 -ares_tac :      thm list   -> int -> tactic
  50.195 -rewtac   :      thm ->               tactic
  50.196 -\end{ttbox}
  50.197 -These abbreviate common uses of tactics.
  50.198 -\begin{ttdescription}
  50.199 -\item[\ttindexbold{rtac} {\it thm} {\it i}] 
  50.200 -abbreviates \hbox{\tt resolve_tac [{\it thm}] {\it i}}, doing resolution.
  50.201 -
  50.202 -\item[\ttindexbold{etac} {\it thm} {\it i}] 
  50.203 -abbreviates \hbox{\tt eresolve_tac [{\it thm}] {\it i}}, doing elim-resolution.
  50.204 -
  50.205 -\item[\ttindexbold{dtac} {\it thm} {\it i}] 
  50.206 -abbreviates \hbox{\tt dresolve_tac [{\it thm}] {\it i}}, doing
  50.207 -destruct-resolution.
  50.208 -
  50.209 -\item[\ttindexbold{ftac} {\it thm} {\it i}] 
  50.210 -abbreviates \hbox{\tt forward_tac [{\it thm}] {\it i}}, doing
  50.211 -destruct-resolution without deleting the assumption.
  50.212 -
  50.213 -\item[\ttindexbold{atac} {\it i}] 
  50.214 -abbreviates \hbox{\tt assume_tac {\it i}}, doing proof by assumption.
  50.215 -
  50.216 -\item[\ttindexbold{eatac} {\it thm} {\it j} {\it i}] 
  50.217 -performs \hbox{\tt etac {\it thm}} and then {\it j} times \texttt{atac}, 
  50.218 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
  50.219 -
  50.220 -\item[\ttindexbold{datac} {\it thm} {\it j} {\it i}] 
  50.221 -performs \hbox{\tt dtac {\it thm}} and then {\it j} times \texttt{atac}, 
  50.222 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
  50.223 -
  50.224 -\item[\ttindexbold{fatac} {\it thm} {\it j} {\it i}] 
  50.225 -performs \hbox{\tt ftac {\it thm}} and then {\it j} times \texttt{atac}, 
  50.226 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
  50.227 -
  50.228 -\item[\ttindexbold{ares_tac} {\it thms} {\it i}] 
  50.229 -tries proof by assumption and resolution; it abbreviates
  50.230 -\begin{ttbox}
  50.231 -assume_tac {\it i} ORELSE resolve_tac {\it thms} {\it i}
  50.232 -\end{ttbox}
  50.233 -
  50.234 -\item[\ttindexbold{rewtac} {\it def}] 
  50.235 -abbreviates \hbox{\tt rewrite_goals_tac [{\it def}]}, unfolding a definition.
  50.236 -\end{ttdescription}
  50.237 -
  50.238  
  50.239  \subsection{Inserting premises and facts}\label{cut_facts_tac}
  50.240  \index{tactics!for inserting facts}\index{assumptions!inserting}
  50.241 @@ -351,52 +124,6 @@
  50.242  
  50.243  \section{Obscure tactics}
  50.244  
  50.245 -\subsection{Renaming parameters in a goal} \index{parameters!renaming}
  50.246 -\begin{ttbox} 
  50.247 -rename_tac        : string -> int -> tactic
  50.248 -rename_last_tac   : string -> string list -> int -> tactic
  50.249 -Logic.set_rename_prefix : string -> unit
  50.250 -Logic.auto_rename       : bool ref      \hfill{\bf initially false}
  50.251 -\end{ttbox}
  50.252 -When creating a parameter, Isabelle chooses its name by matching variable
  50.253 -names via the object-rule.  Given the rule $(\forall I)$ formalized as
  50.254 -$\left(\Forall x. P(x)\right) \Imp \forall x.P(x)$, Isabelle will note that
  50.255 -the $\Forall$-bound variable in the premise has the same name as the
  50.256 -$\forall$-bound variable in the conclusion.  
  50.257 -
  50.258 -Sometimes there is insufficient information and Isabelle chooses an
  50.259 -arbitrary name.  The renaming tactics let you override Isabelle's choice.
  50.260 -Because renaming parameters has no logical effect on the proof state, the
  50.261 -{\tt by} command prints the message {\tt Warning:\ same as previous
  50.262 -level}.
  50.263 -
  50.264 -Alternatively, you can suppress the naming mechanism described above and
  50.265 -have Isabelle generate uniform names for parameters.  These names have the
  50.266 -form $p${\tt a}, $p${\tt b}, $p${\tt c},~\ldots, where $p$ is any desired
  50.267 -prefix.  They are ugly but predictable.
  50.268 -
  50.269 -\begin{ttdescription}
  50.270 -\item[\ttindexbold{rename_tac} {\it str} {\it i}] 
  50.271 -interprets the string {\it str} as a series of blank-separated variable
  50.272 -names, and uses them to rename the parameters of subgoal~$i$.  The names
  50.273 -must be distinct.  If there are fewer names than parameters, then the
  50.274 -tactic renames the innermost parameters and may modify the remaining ones
  50.275 -to ensure that all the parameters are distinct.
  50.276 -
  50.277 -\item[\ttindexbold{rename_last_tac} {\it prefix} {\it suffixes} {\it i}] 
  50.278 -generates a list of names by attaching each of the {\it suffixes\/} to the 
  50.279 -{\it prefix}.  It is intended for coding structural induction tactics,
  50.280 -where several of the new parameters should have related names.
  50.281 -
  50.282 -\item[\ttindexbold{Logic.set_rename_prefix} {\it prefix};] 
  50.283 -sets the prefix for uniform renaming to~{\it prefix}.  The default prefix
  50.284 -is {\tt"k"}.
  50.285 -
  50.286 -\item[set \ttindexbold{Logic.auto_rename};] 
  50.287 -makes Isabelle generate uniform names for parameters. 
  50.288 -\end{ttdescription}
  50.289 -
  50.290 -
  50.291  \subsection{Manipulating assumptions}
  50.292  \index{assumptions!rotating}
  50.293  \begin{ttbox} 
  50.294 @@ -594,142 +321,6 @@
  50.295  is no longer than {\it limit}.
  50.296  \end{ttdescription}
  50.297  
  50.298 -
  50.299 -\section{Programming tools for proof strategies}
  50.300 -Do not consider using the primitives discussed in this section unless you
  50.301 -really need to code tactics from scratch.
  50.302 -
  50.303 -\subsection{Operations on tactics}
  50.304 -\index{tactics!primitives for coding} A tactic maps theorems to sequences of
  50.305 -theorems.  The type constructor for sequences (lazy lists) is called
  50.306 -\mltydx{Seq.seq}.  To simplify the types of tactics and tacticals,
  50.307 -Isabelle defines a type abbreviation:
  50.308 -\begin{ttbox} 
  50.309 -type tactic = thm -> thm Seq.seq
  50.310 -\end{ttbox} 
  50.311 -The following operations provide means for coding tactics in a clean style.
  50.312 -\begin{ttbox} 
  50.313 -PRIMITIVE :                  (thm -> thm) -> tactic  
  50.314 -SUBGOAL   : ((term*int) -> tactic) -> int -> tactic
  50.315 -\end{ttbox} 
  50.316 -\begin{ttdescription}
  50.317 -\item[\ttindexbold{PRIMITIVE} $f$] packages the meta-rule~$f$ as a tactic that
  50.318 -  applies $f$ to the proof state and returns the result as a one-element
  50.319 -  sequence.  If $f$ raises an exception, then the tactic's result is the empty
  50.320 -  sequence.
  50.321 -
  50.322 -\item[\ttindexbold{SUBGOAL} $f$ $i$] 
  50.323 -extracts subgoal~$i$ from the proof state as a term~$t$, and computes a
  50.324 -tactic by calling~$f(t,i)$.  It applies the resulting tactic to the same
  50.325 -state.  The tactic body is expressed using tactics and tacticals, but may
  50.326 -peek at a particular subgoal:
  50.327 -\begin{ttbox} 
  50.328 -SUBGOAL (fn (t,i) => {\it tactic-valued expression})
  50.329 -\end{ttbox} 
  50.330 -\end{ttdescription}
  50.331 -
  50.332 -
  50.333 -\subsection{Tracing}
  50.334 -\index{tactics!tracing}
  50.335 -\index{tracing!of tactics}
  50.336 -\begin{ttbox} 
  50.337 -pause_tac: tactic
  50.338 -print_tac: string -> tactic
  50.339 -\end{ttbox}
  50.340 -These tactics print tracing information when they are applied to a proof
  50.341 -state.  Their output may be difficult to interpret.  Note that certain of
  50.342 -the searching tacticals, such as {\tt REPEAT}, have built-in tracing
  50.343 -options.
  50.344 -\begin{ttdescription}
  50.345 -\item[\ttindexbold{pause_tac}] 
  50.346 -prints {\footnotesize\tt** Press RETURN to continue:} and then reads a line
  50.347 -from the terminal.  If this line is blank then it returns the proof state
  50.348 -unchanged; otherwise it fails (which may terminate a repetition).
  50.349 -
  50.350 -\item[\ttindexbold{print_tac}~$msg$] 
  50.351 -returns the proof state unchanged, with the side effect of printing it at
  50.352 -the terminal.
  50.353 -\end{ttdescription}
  50.354 -
  50.355 -
  50.356 -\section{*Sequences}
  50.357 -\index{sequences (lazy lists)|bold}
  50.358 -The module {\tt Seq} declares a type of lazy lists.  It uses
  50.359 -Isabelle's type \mltydx{option} to represent the possible presence
  50.360 -(\ttindexbold{Some}) or absence (\ttindexbold{None}) of
  50.361 -a value:
  50.362 -\begin{ttbox}
  50.363 -datatype 'a option = None  |  Some of 'a;
  50.364 -\end{ttbox}
  50.365 -The {\tt Seq} structure is supposed to be accessed via fully qualified
  50.366 -names and should not be \texttt{open}.
  50.367 -
  50.368 -\subsection{Basic operations on sequences}
  50.369 -\begin{ttbox} 
  50.370 -Seq.empty   : 'a seq
  50.371 -Seq.make    : (unit -> ('a * 'a seq) option) -> 'a seq
  50.372 -Seq.single  : 'a -> 'a seq
  50.373 -Seq.pull    : 'a seq -> ('a * 'a seq) option
  50.374 -\end{ttbox}
  50.375 -\begin{ttdescription}
  50.376 -\item[Seq.empty] is the empty sequence.
  50.377 -
  50.378 -\item[\tt Seq.make (fn () => Some ($x$, $xq$))] constructs the
  50.379 -  sequence with head~$x$ and tail~$xq$, neither of which is evaluated.
  50.380 -
  50.381 -\item[Seq.single $x$] 
  50.382 -constructs the sequence containing the single element~$x$.
  50.383 -
  50.384 -\item[Seq.pull $xq$] returns {\tt None} if the sequence is empty and
  50.385 -  {\tt Some ($x$, $xq'$)} if the sequence has head~$x$ and tail~$xq'$.
  50.386 -  Warning: calling \hbox{Seq.pull $xq$} again will {\it recompute\/}
  50.387 -  the value of~$x$; it is not stored!
  50.388 -\end{ttdescription}
  50.389 -
  50.390 -
  50.391 -\subsection{Converting between sequences and lists}
  50.392 -\begin{ttbox} 
  50.393 -Seq.chop    : int * 'a seq -> 'a list * 'a seq
  50.394 -Seq.list_of : 'a seq -> 'a list
  50.395 -Seq.of_list : 'a list -> 'a seq
  50.396 -\end{ttbox}
  50.397 -\begin{ttdescription}
  50.398 -\item[Seq.chop ($n$, $xq$)] returns the first~$n$ elements of~$xq$ as a
  50.399 -  list, paired with the remaining elements of~$xq$.  If $xq$ has fewer
  50.400 -  than~$n$ elements, then so will the list.
  50.401 -  
  50.402 -\item[Seq.list_of $xq$] returns the elements of~$xq$, which must be
  50.403 -  finite, as a list.
  50.404 -  
  50.405 -\item[Seq.of_list $xs$] creates a sequence containing the elements
  50.406 -  of~$xs$.
  50.407 -\end{ttdescription}
  50.408 -
  50.409 -
  50.410 -\subsection{Combining sequences}
  50.411 -\begin{ttbox} 
  50.412 -Seq.append      : 'a seq * 'a seq -> 'a seq
  50.413 -Seq.interleave  : 'a seq * 'a seq -> 'a seq
  50.414 -Seq.flat        : 'a seq seq -> 'a seq
  50.415 -Seq.map         : ('a -> 'b) -> 'a seq -> 'b seq
  50.416 -Seq.filter      : ('a -> bool) -> 'a seq -> 'a seq
  50.417 -\end{ttbox} 
  50.418 -\begin{ttdescription}
  50.419 -\item[Seq.append ($xq$, $yq$)] concatenates $xq$ to $yq$.
  50.420 -  
  50.421 -\item[Seq.interleave ($xq$, $yq$)] joins $xq$ with $yq$ by
  50.422 -  interleaving their elements.  The result contains all the elements
  50.423 -  of the sequences, even if both are infinite.
  50.424 -  
  50.425 -\item[Seq.flat $xqq$] concatenates a sequence of sequences.
  50.426 -  
  50.427 -\item[Seq.map $f$ $xq$] applies $f$ to every element
  50.428 -  of~$xq=x@1,x@2,\ldots$, yielding the sequence $f(x@1),f(x@2),\ldots$.
  50.429 -  
  50.430 -\item[Seq.filter $p$ $xq$] returns the sequence consisting of all
  50.431 -  elements~$x$ of~$xq$ such that $p(x)$ is {\tt true}.
  50.432 -\end{ttdescription}
  50.433 -
  50.434  \index{tactics|)}
  50.435  
  50.436  
    51.1 --- a/doc-src/Ref/tctical.tex	Wed Mar 04 10:43:39 2009 +0100
    51.2 +++ b/doc-src/Ref/tctical.tex	Wed Mar 04 10:45:52 2009 +0100
    51.3 @@ -1,4 +1,4 @@
    51.4 -%% $Id$
    51.5 +
    51.6  \chapter{Tacticals}
    51.7  \index{tacticals|(}
    51.8  Tacticals are operations on tactics.  Their implementation makes use of
    52.1 --- a/doc-src/Ref/theories.tex	Wed Mar 04 10:43:39 2009 +0100
    52.2 +++ b/doc-src/Ref/theories.tex	Wed Mar 04 10:45:52 2009 +0100
    52.3 @@ -1,216 +1,6 @@
    52.4 -
    52.5 -%% $Id$
    52.6  
    52.7  \chapter{Theories, Terms and Types} \label{theories}
    52.8 -\index{theories|(}\index{signatures|bold}
    52.9 -\index{reading!axioms|see{\texttt{assume_ax}}} Theories organize the syntax,
   52.10 -declarations and axioms of a mathematical development.  They are built,
   52.11 -starting from the Pure or CPure theory, by extending and merging existing
   52.12 -theories.  They have the \ML\ type \mltydx{theory}.  Theory operations signal
   52.13 -errors by raising exception \xdx{THEORY}, returning a message and a list of
   52.14 -theories.
   52.15 -
   52.16 -Signatures, which contain information about sorts, types, constants and
   52.17 -syntax, have the \ML\ type~\mltydx{Sign.sg}.  For identification, each
   52.18 -signature carries a unique list of \bfindex{stamps}, which are \ML\
   52.19 -references to strings.  The strings serve as human-readable names; the
   52.20 -references serve as unique identifiers.  Each primitive signature has a
   52.21 -single stamp.  When two signatures are merged, their lists of stamps are
   52.22 -also merged.  Every theory carries a unique signature.
   52.23 -
   52.24 -Terms and types are the underlying representation of logical syntax.  Their
   52.25 -\ML\ definitions are irrelevant to naive Isabelle users.  Programmers who
   52.26 -wish to extend Isabelle may need to know such details, say to code a tactic
   52.27 -that looks for subgoals of a particular form.  Terms and types may be
   52.28 -`certified' to be well-formed with respect to a given signature.
   52.29 -
   52.30 -
   52.31 -\section{Defining theories}\label{sec:ref-defining-theories}
   52.32 -
   52.33 -Theories are defined via theory files $name$\texttt{.thy} (there are also
   52.34 -\ML-level interfaces which are only intended for people building advanced
   52.35 -theory definition packages).  Appendix~\ref{app:TheorySyntax} presents the
   52.36 -concrete syntax for theory files; here follows an explanation of the
   52.37 -constituent parts.
   52.38 -\begin{description}
   52.39 -\item[{\it theoryDef}] is the full definition.  The new theory is called $id$.
   52.40 -  It is the union of the named \textbf{parent
   52.41 -    theories}\indexbold{theories!parent}, possibly extended with new
   52.42 -  components.  \thydx{Pure} and \thydx{CPure} are the basic theories, which
   52.43 -  contain only the meta-logic.  They differ just in their concrete syntax for
   52.44 -  function applications.
   52.45 -  
   52.46 -  The new theory begins as a merge of its parents.
   52.47 -  \begin{ttbox}
   52.48 -    Attempt to merge different versions of theories: "\(T@1\)", \(\ldots\), "\(T@n\)"
   52.49 -  \end{ttbox}
   52.50 -  This error may especially occur when a theory is redeclared --- say to
   52.51 -  change an inappropriate definition --- and bindings to old versions persist.
   52.52 -  Isabelle ensures that old and new theories of the same name are not involved
   52.53 -  in a proof.
   52.54 -
   52.55 -\item[$classes$]
   52.56 -  is a series of class declarations.  Declaring {\tt$id$ < $id@1$ \dots\
   52.57 -    $id@n$} makes $id$ a subclass of the existing classes $id@1\dots
   52.58 -  id@n$.  This rules out cyclic class structures.  Isabelle automatically
   52.59 -  computes the transitive closure of subclass hierarchies; it is not
   52.60 -  necessary to declare \texttt{c < e} in addition to \texttt{c < d} and \texttt{d <
   52.61 -    e}.
   52.62 -
   52.63 -\item[$default$]
   52.64 -  introduces $sort$ as the new default sort for type variables.  This applies
   52.65 -  to unconstrained type variables in an input string but not to type
   52.66 -  variables created internally.  If omitted, the default sort is the listwise
   52.67 -  union of the default sorts of the parent theories (i.e.\ their logical
   52.68 -  intersection).
   52.69 -  
   52.70 -\item[$sort$] is a finite set of classes.  A single class $id$ abbreviates the
   52.71 -  sort $\{id\}$.
   52.72 -
   52.73 -\item[$types$]
   52.74 -  is a series of type declarations.  Each declares a new type constructor
   52.75 -  or type synonym.  An $n$-place type constructor is specified by
   52.76 -  $(\alpha@1,\dots,\alpha@n)name$, where the type variables serve only to
   52.77 -  indicate the number~$n$.
   52.78 -
   52.79 -  A \textbf{type synonym}\indexbold{type synonyms} is an abbreviation
   52.80 -  $(\alpha@1,\dots,\alpha@n)name = \tau$, where $name$ and $\tau$ can
   52.81 -  be strings.
   52.82 -
   52.83 -\item[$infix$]
   52.84 -  declares a type or constant to be an infix operator having priority $nat$
   52.85 -  and associating to the left (\texttt{infixl}) or right (\texttt{infixr}).
   52.86 -  Only 2-place type constructors can have infix status; an example is {\tt
   52.87 -  ('a,'b)~"*"~(infixr~20)}, which may express binary product types.
   52.88 -
   52.89 -\item[$arities$] is a series of type arity declarations.  Each assigns
   52.90 -  arities to type constructors.  The $name$ must be an existing type
   52.91 -  constructor, which is given the additional arity $arity$.
   52.92 -  
   52.93 -\item[$nonterminals$]\index{*nonterminal symbols} declares purely
   52.94 -  syntactic types to be used as nonterminal symbols of the context
   52.95 -  free grammar.
   52.96 -
   52.97 -\item[$consts$] is a series of constant declarations.  Each new
   52.98 -  constant $name$ is given the specified type.  The optional $mixfix$
   52.99 -  annotations may attach concrete syntax to the constant.
  52.100 -  
  52.101 -\item[$syntax$] \index{*syntax section}\index{print mode} is a variant
  52.102 -  of $consts$ which adds just syntax without actually declaring
  52.103 -  logical constants.  This gives full control over a theory's context
  52.104 -  free grammar.  The optional $mode$ specifies the print mode where the
  52.105 -  mixfix productions should be added.  If there is no \texttt{output}
  52.106 -  option given, all productions are also added to the input syntax
  52.107 -  (regardless of the print mode).
  52.108 -
  52.109 -\item[$mixfix$] \index{mixfix declarations}
  52.110 -  annotations can take three forms:
  52.111 -  \begin{itemize}
  52.112 -  \item A mixfix template given as a $string$ of the form
  52.113 -    {\tt"}\dots{\tt\_}\dots{\tt\_}\dots{\tt"} where the $i$-th underscore
  52.114 -    indicates the position where the $i$-th argument should go.  The list
  52.115 -    of numbers gives the priority of each argument.  The final number gives
  52.116 -    the priority of the whole construct.
  52.117 -
  52.118 -  \item A constant $f$ of type $\tau@1\To(\tau@2\To\tau)$ can be given {\bf
  52.119 -    infix} status.
  52.120 -
  52.121 -  \item A constant $f$ of type $(\tau@1\To\tau@2)\To\tau$ can be given {\bf
  52.122 -    binder} status.  The declaration \texttt{binder} $\cal Q$ $p$ causes
  52.123 -  ${\cal Q}\,x.F(x)$ to be treated
  52.124 -  like $f(F)$, where $p$ is the priority.
  52.125 -  \end{itemize}
  52.126 -
  52.127 -\item[$trans$]
  52.128 -  specifies syntactic translation rules (macros).  There are three forms:
  52.129 -  parse rules (\texttt{=>}), print rules (\texttt{<=}), and parse/print rules ({\tt
  52.130 -  ==}).
  52.131 -
  52.132 -\item[$rules$]
  52.133 -  is a series of rule declarations.  Each has a name $id$ and the formula is
  52.134 -  given by the $string$.  Rule names must be distinct within any single
  52.135 -  theory.
  52.136 -
  52.137 -\item[$defs$] is a series of definitions.  They are just like $rules$, except
  52.138 -  that every $string$ must be a definition (see below for details).
  52.139 -
  52.140 -\item[$constdefs$] combines the declaration of constants and their
  52.141 -  definition.  The first $string$ is the type, the second the definition.
  52.142 -  
  52.143 -\item[$axclass$] \index{*axclass section} defines an \rmindex{axiomatic type
  52.144 -    class} \cite{Wenzel:1997:TPHOL} as the intersection of existing classes,
  52.145 -  with additional axioms holding.  Class axioms may not contain more than one
  52.146 -  type variable.  The class axioms (with implicit sort constraints added) are
  52.147 -  bound to the given names.  Furthermore a class introduction rule is
  52.148 -  generated, which is automatically employed by $instance$ to prove
  52.149 -  instantiations of this class.
  52.150 -  
  52.151 -\item[$instance$] \index{*instance section} proves class inclusions or
  52.152 -  type arities at the logical level and then transfers these to the
  52.153 -  type signature.  The instantiation is proven and checked properly.
  52.154 -  The user has to supply sufficient witness information: theorems
  52.155 -  ($longident$), axioms ($string$), or even arbitrary \ML{} tactic
  52.156 -  code $verbatim$.
  52.157 -
  52.158 -\item[$oracle$] links the theory to a trusted external reasoner.  It is
  52.159 -  allowed to create theorems, but each theorem carries a proof object
  52.160 -  describing the oracle invocation.  See \S\ref{sec:oracles} for details.
  52.161 -  
  52.162 -\item[$local$, $global$] change the current name declaration mode.
  52.163 -  Initially, theories start in $local$ mode, causing all names of
  52.164 -  types, constants, axioms etc.\ to be automatically qualified by the
  52.165 -  theory name.  Changing this to $global$ causes all names to be
  52.166 -  declared as short base names only.
  52.167 -  
  52.168 -  The $local$ and $global$ declarations act like switches, affecting
  52.169 -  all following theory sections until changed again explicitly.  Also
  52.170 -  note that the final state at the end of the theory will persist.  In
  52.171 -  particular, this determines how the names of theorems stored later
  52.172 -  on are handled.
  52.173 -  
  52.174 -\item[$setup$]\index{*setup!theory} applies a list of ML functions to
  52.175 -  the theory.  The argument should denote a value of type
  52.176 -  \texttt{(theory -> theory) list}.  Typically, ML packages are
  52.177 -  initialized in this way.
  52.178 -
  52.179 -\item[$ml$] \index{*ML section}
  52.180 -  consists of \ML\ code, typically for parse and print translation functions.
  52.181 -\end{description}
  52.182 -%
  52.183 -Chapters~\ref{Defining-Logics} and \ref{chap:syntax} explain mixfix
  52.184 -declarations, translation rules and the \texttt{ML} section in more detail.
  52.185 -
  52.186 -
  52.187 -\subsection{*Classes and arities}
  52.188 -\index{classes!context conditions}\index{arities!context conditions}
  52.189 -
  52.190 -In order to guarantee principal types~\cite{nipkow-prehofer},
  52.191 -arity declarations must obey two conditions:
  52.192 -\begin{itemize}
  52.193 -\item There must not be any two declarations $ty :: (\vec{r})c$ and
  52.194 -  $ty :: (\vec{s})c$ with $\vec{r} \neq \vec{s}$.  For example, this
  52.195 -  excludes the following:
  52.196 -\begin{ttbox}
  52.197 -arities
  52.198 -  foo :: (\{logic{\}}) logic
  52.199 -  foo :: (\{{\}})logic
  52.200 -\end{ttbox}
  52.201 -
  52.202 -\item If there are two declarations $ty :: (s@1,\dots,s@n)c$ and $ty ::
  52.203 -  (s@1',\dots,s@n')c'$ such that $c' < c$ then $s@i' \preceq s@i$ must hold
  52.204 -  for $i=1,\dots,n$.  The relationship $\preceq$, defined as
  52.205 -\[ s' \preceq s \iff \forall c\in s. \exists c'\in s'.~ c'\le c, \]
  52.206 -expresses that the set of types represented by $s'$ is a subset of the
  52.207 -set of types represented by $s$.  Assuming $term \preceq logic$, the
  52.208 -following is forbidden:
  52.209 -\begin{ttbox}
  52.210 -arities
  52.211 -  foo :: (\{logic{\}})logic
  52.212 -  foo :: (\{{\}})term
  52.213 -\end{ttbox}
  52.214 -
  52.215 -\end{itemize}
  52.216 -
  52.217 +\index{theories|(}
  52.218  
  52.219  \section{The theory loader}\label{sec:more-theories}
  52.220  \index{theories!reading}\index{files!reading}
  52.221 @@ -247,13 +37,6 @@
  52.222    dispose a large number of theories at once.  Note that {\ML} bindings to
  52.223    theorems etc.\ of removed theories may still persist.
  52.224    
  52.225 -\item[reset \ttindexbold{delete_tmpfiles};] processing theory files usually
  52.226 -  involves temporary {\ML} files to be created.  By default, these are deleted
  52.227 -  afterwards.  Resetting the \texttt{delete_tmpfiles} flag inhibits this,
  52.228 -  leaving the generated code for debugging purposes.  The basic location for
  52.229 -  temporary files is determined by the \texttt{ISABELLE_TMP} environment
  52.230 -  variable (which is private to the running Isabelle process and may be
  52.231 -  retrieved by \ttindex{getenv} from {\ML}).
  52.232  \end{ttdescription}
  52.233  
  52.234  \medskip Theory and {\ML} files are located by skimming through the
  52.235 @@ -296,224 +79,6 @@
  52.236  temporarily appended to the load path, too.
  52.237  
  52.238  
  52.239 -\section{Locales}
  52.240 -\label{Locales}
  52.241 -
  52.242 -Locales \cite{kammueller-locales} are a concept of local proof contexts.  They
  52.243 -are introduced as named syntactic objects within theories and can be
  52.244 -opened in any descendant theory.
  52.245 -
  52.246 -\subsection{Declaring Locales}
  52.247 -
  52.248 -A locale is declared in a theory section that starts with the
  52.249 -keyword \texttt{locale}.  It consists typically of three parts, the
  52.250 -\texttt{fixes} part, the \texttt{assumes} part, and the \texttt{defines} part.
  52.251 -Appendix \ref{app:TheorySyntax} presents the full syntax.
  52.252 -
  52.253 -\subsubsection{Parts of Locales}
  52.254 -
  52.255 -The subsection introduced by the keyword \texttt{fixes} declares the locale
  52.256 -constants in a way that closely resembles a global \texttt{consts}
  52.257 -declaration.  In particular, there may be an optional pretty printing syntax
  52.258 -for the locale constants.
  52.259 -
  52.260 -The subsequent \texttt{assumes} part specifies the locale rules.  They are
  52.261 -defined like \texttt{rules}: by an identifier followed by the rule
  52.262 -given as a string.  Locale rules admit the statement of local assumptions
  52.263 -about the locale constants.  The \texttt{assumes} part is optional.  Non-fixed
  52.264 -variables in locale rules are automatically bound by the universal quantifier
  52.265 -\texttt{!!} of the meta-logic.
  52.266 -
  52.267 -Finally, the \texttt{defines} part introduces the definitions that are
  52.268 -available in the locale.  Locale constants declared in the \texttt{fixes}
  52.269 -section are defined using the meta-equality \texttt{==}.  If the
  52.270 -locale constant is a functiond then its definition can (as usual) have
  52.271 -variables on the left-hand side acting as formal parameters; they are
  52.272 -considered as schematic variables and are automatically generalized by
  52.273 -universal quantification of the meta-logic.  The right hand side of a
  52.274 -definition must not contain variables that are not already on the left hand
  52.275 -side.  In so far locale definitions behave like theory level definitions.
  52.276 -However, the locale concept realizes \emph{dependent definitions}: any variable
  52.277 -that is fixed as a locale constant can occur on the right hand side of
  52.278 -definitions.  For an illustration of these dependent definitions see the
  52.279 -occurrence of the locale constant \texttt{G} on the right hand side of the
  52.280 -definitions of the locale \texttt{group} below.  Naturally, definitions can
  52.281 -already use the syntax of the locale constants in the \texttt{fixes}
  52.282 -subsection.  The \texttt{defines} part is, as the \texttt{assumes} part,
  52.283 -optional.
  52.284 -
  52.285 -\subsubsection{Example for Definition}
  52.286 -The concrete syntax of locale definitions is demonstrated by example below.
  52.287 -
  52.288 -Locale \texttt{group} assumes the definition of groups in a theory
  52.289 -file\footnote{This and other examples are from \texttt{HOL/ex}.}.  A locale
  52.290 -defining a convenient proof environment for group related proofs may be
  52.291 -added to the theory as follows:
  52.292 -\begin{ttbox}
  52.293 -  locale group =
  52.294 -    fixes 
  52.295 -      G         :: "'a grouptype"
  52.296 -      e         :: "'a"
  52.297 -      binop     :: "'a => 'a => 'a"        (infixr "#" 80)
  52.298 -      inv       :: "'a => 'a"              ("i(_)" [90] 91)
  52.299 -    assumes
  52.300 -      Group_G   "G: Group"
  52.301 -    defines
  52.302 -      e_def     "e == unit G"
  52.303 -      binop_def "x # y == bin_op G x y"
  52.304 -      inv_def   "i(x) == inverse G x"
  52.305 -\end{ttbox}
  52.306 -
  52.307 -\subsubsection{Polymorphism}
  52.308 -
  52.309 -In contrast to polymorphic definitions in theories, the use of the
  52.310 -same type variable for the declaration of different locale constants in the
  52.311 -fixes part means \emph{the same} type.  In other words, the scope of the
  52.312 -polymorphic variables is extended over all constant declarations of a locale.
  52.313 -In the above example \texttt{'a} refers to the same type which is fixed inside
  52.314 -the locale.  In an exported theorem (see \S\ref{sec:locale-export}) the
  52.315 -constructors of locale \texttt{group} are polymorphic, yet only simultaneously
  52.316 -instantiatable.
  52.317 -
  52.318 -\subsubsection{Nested Locales}
  52.319 -
  52.320 -A locale can be defined as the extension of a previously defined
  52.321 -locale.  This operation of extension is optional and is syntactically
  52.322 -expressed as 
  52.323 -\begin{ttbox}
  52.324 -locale foo = bar + ...
  52.325 -\end{ttbox}
  52.326 -The locale \texttt{foo} builds on the constants and syntax of the locale {\tt
  52.327 -bar}.  That is, all contents of the locale \texttt{bar} can be used in
  52.328 -definitions and rules of the corresponding parts of the locale {\tt
  52.329 -foo}.  Although locale \texttt{foo} assumes the \texttt{fixes} part of \texttt{bar} it
  52.330 -does not automatically subsume its rules and definitions.  Normally, one
  52.331 -expects to use locale \texttt{foo} only if locale \texttt{bar} is already
  52.332 -active.  These aspects of use and activation of locales are considered in the
  52.333 -subsequent section.
  52.334 -
  52.335 -
  52.336 -\subsection{Locale Scope}
  52.337 -
  52.338 -Locales are by default inactive, but they can be invoked.  The list of
  52.339 -currently active locales is called \emph{scope}.  The process of activating
  52.340 -them is called \emph{opening}; the reverse is \emph{closing}.
  52.341 -
  52.342 -\subsubsection{Scope}
  52.343 -The locale scope is part of each theory.  It is a dynamic stack containing
  52.344 -all active locales at a certain point in an interactive session.
  52.345 -The scope lives until all locales are explicitly closed.  At one time there
  52.346 -can be more than one locale open.  The contents of these various active
  52.347 -locales are all visible in the scope.  In case of nested locales for example,
  52.348 -the nesting is actually reflected to the scope, which contains the nested
  52.349 -locales as layers.  To check the state of the scope during a development the
  52.350 -function \texttt{Print\_scope} may be used.  It displays the names of all open
  52.351 -locales on the scope.  The function \texttt{print\_locales} applied to a theory
  52.352 -displays all locales contained in that theory and in addition also the
  52.353 -current scope.
  52.354 -
  52.355 -The scope is manipulated by the commands for opening and closing of locales. 
  52.356 -
  52.357 -\subsubsection{Opening}
  52.358 -Locales can be \emph{opened} at any point during a session where
  52.359 -we want to prove theorems concerning the locale.  Opening a locale means
  52.360 -making its contents visible by pushing it onto the scope of the current
  52.361 -theory.  Inside a scope of opened locales, theorems can use all definitions and
  52.362 -rules contained in the locales on the scope.  The rules and definitions may
  52.363 -be accessed individually using the function \ttindex{thm}.  This function is
  52.364 -applied to the names assigned to locale rules and definitions as
  52.365 -strings.  The opening command is called \texttt{Open\_locale} and takes the 
  52.366 -name of the locale to be opened as its argument.
  52.367 -
  52.368 -If one opens a locale \texttt{foo} that is defined by extension from locale
  52.369 -\texttt{bar}, the function \texttt{Open\_locale} checks if locale \texttt{bar}
  52.370 -is open.  If so, then it just opens \texttt{foo}, if not, then it prints a
  52.371 -message and opens \texttt{bar} before opening \texttt{foo}.  Naturally, this
  52.372 -carries on, if \texttt{bar} is again an extension.
  52.373 -
  52.374 -\subsubsection{Closing}
  52.375 -
  52.376 -\emph{Closing} means to cancel the last opened locale, pushing it out of the
  52.377 -scope.  Theorems proved during the life cycle of this locale will be disabled,
  52.378 -unless they have been explicitly exported, as described below.  However, when
  52.379 -the same locale is opened again these theorems may be used again as well,
  52.380 -provided that they were saved as theorems in the first place, using
  52.381 -\texttt{qed} or ML assignment.  The command \texttt{Close\_locale} takes a
  52.382 -locale name as a string and checks if this locale is actually the topmost
  52.383 -locale on the scope.  If this is the case, it removes this locale, otherwise
  52.384 -it prints a warning message and does not change the scope.
  52.385 -
  52.386 -\subsubsection{Export of Theorems}
  52.387 -\label{sec:locale-export}
  52.388 -
  52.389 -Export of theorems transports theorems out of the scope of locales.  Locale
  52.390 -rules that have been used in the proof of an exported theorem inside the
  52.391 -locale are carried by the exported form of the theorem as its individual
  52.392 -meta-assumptions.  The locale constants are universally quantified variables
  52.393 -in these theorems, hence such theorems can be instantiated individually.
  52.394 -Definitions become unfolded; locale constants that were merely used for
  52.395 -definitions vanish.  Logically, exporting corresponds to a combined
  52.396 -application of introduction rules for implication and universal
  52.397 -quantification.  Exporting forms a kind of normalization of theorems in a
  52.398 -locale scope.
  52.399 -
  52.400 -According to the possibility of nested locales there are two different forms
  52.401 -of export.  The first one is realized by the function \texttt{export} that
  52.402 -exports theorems through all layers of opened locales of the scope.  Hence,
  52.403 -the application of export to a theorem yields a theorem of the global level,
  52.404 -that is, the current theory context without any local assumptions or
  52.405 -definitions.
  52.406 -
  52.407 -When locales are nested we might want to export a theorem, not to the global
  52.408 -level of the current theory but just to the previous level.  The other export
  52.409 -function, \texttt{Export}, transports theorems one level up in the scope; the
  52.410 -theorem still uses locale constants, definitions and rules of the locales
  52.411 -underneath.
  52.412 -
  52.413 -\subsection{Functions for Locales}
  52.414 -\label{Syntax}
  52.415 -\index{locales!functions}
  52.416 -
  52.417 -Here is a quick reference list of locale functions.
  52.418 -\begin{ttbox}
  52.419 -  Open_locale  : xstring -> unit 
  52.420 -  Close_locale : xstring -> unit
  52.421 -  export       :     thm -> thm
  52.422 -  Export       :     thm -> thm
  52.423 -  thm          : xstring -> thm
  52.424 -  Print_scope  :    unit -> unit
  52.425 -  print_locales:  theory -> unit
  52.426 -\end{ttbox}
  52.427 -\begin{ttdescription}
  52.428 -\item[\ttindexbold{Open_locale} $xstring$] 
  52.429 -    opens the locale {\it xstring}, adding it to the scope of the theory of the
  52.430 -  current context.  If the opened locale is built by extension, the ancestors
  52.431 -  are opened automatically.
  52.432 -  
  52.433 -\item[\ttindexbold{Close_locale} $xstring$] eliminates the locale {\it
  52.434 -    xstring} from the scope if it is the topmost item on it, otherwise it does
  52.435 -  not change the scope and produces a warning.
  52.436 -
  52.437 -\item[\ttindexbold{export} $thm$] locale definitions become expanded in {\it
  52.438 -    thm} and locale rules that were used in the proof of {\it thm} become part
  52.439 -  of its individual assumptions.  This normalization happens with respect to
  52.440 -  \emph{all open locales} on the scope.
  52.441 -  
  52.442 -\item[\ttindexbold{Export} $thm$] works like \texttt{export} but normalizes
  52.443 -  theorems only up to the previous level of locales on the scope.
  52.444 -  
  52.445 -\item[\ttindexbold{thm} $xstring$] applied to the name of a locale definition
  52.446 -  or rule it returns the definition as a theorem.
  52.447 -  
  52.448 -\item[\ttindexbold{Print_scope}()] prints the names of the locales in the
  52.449 -  current scope of the current theory context.
  52.450 -  
  52.451 -\item[\ttindexbold{print_locale} $theory$] prints all locales that are
  52.452 -  contained in {\it theory} directly or indirectly.  It also displays the
  52.453 -  current scope similar to \texttt{Print\_scope}.
  52.454 -\end{ttdescription}
  52.455 -
  52.456 -
  52.457  \section{Basic operations on theories}\label{BasicOperationsOnTheories}
  52.458  
  52.459  \subsection{*Theory inclusion}
  52.460 @@ -905,111 +470,6 @@
  52.461  \end{ttdescription}
  52.462  
  52.463  
  52.464 -\section{Oracles: calling trusted external reasoners}
  52.465 -\label{sec:oracles}
  52.466 -\index{oracles|(}
  52.467 -
  52.468 -Oracles allow Isabelle to take advantage of external reasoners such as
  52.469 -arithmetic decision procedures, model checkers, fast tautology checkers or
  52.470 -computer algebra systems.  Invoked as an oracle, an external reasoner can
  52.471 -create arbitrary Isabelle theorems.  It is your responsibility to ensure that
  52.472 -the external reasoner is as trustworthy as your application requires.
  52.473 -Isabelle's proof objects~(\S\ref{sec:proofObjects}) record how each theorem
  52.474 -depends upon oracle calls.
  52.475 -
  52.476 -\begin{ttbox}
  52.477 -invoke_oracle     : theory -> xstring -> Sign.sg * object -> thm
  52.478 -Theory.add_oracle : bstring * (Sign.sg * object -> term) -> theory 
  52.479 -                    -> theory
  52.480 -\end{ttbox}
  52.481 -\begin{ttdescription}
  52.482 -\item[\ttindexbold{invoke_oracle} $thy$ $name$ ($sign$, $data$)]
  52.483 -  invokes the oracle $name$ of theory $thy$ passing the information
  52.484 -  contained in the exception value $data$ and creating a theorem
  52.485 -  having signature $sign$.  Note that type \ttindex{object} is just an
  52.486 -  abbreviation for \texttt{exn}.  Errors arise if $thy$ does not have
  52.487 -  an oracle called $name$, if the oracle rejects its arguments or if
  52.488 -  its result is ill-typed.
  52.489 -  
  52.490 -\item[\ttindexbold{Theory.add_oracle} $name$ $fun$ $thy$] extends
  52.491 -  $thy$ by oracle $fun$ called $name$.  It is seldom called
  52.492 -  explicitly, as there is concrete syntax for oracles in theory files.
  52.493 -\end{ttdescription}
  52.494 -
  52.495 -A curious feature of {\ML} exceptions is that they are ordinary constructors.
  52.496 -The {\ML} type \texttt{exn} is a datatype that can be extended at any time.  (See
  52.497 -my {\em {ML} for the Working Programmer}~\cite{paulson-ml2}, especially
  52.498 -page~136.)  The oracle mechanism takes advantage of this to allow an oracle to
  52.499 -take any information whatever.
  52.500 -
  52.501 -There must be some way of invoking the external reasoner from \ML, either
  52.502 -because it is coded in {\ML} or via an operating system interface.  Isabelle
  52.503 -expects the {\ML} function to take two arguments: a signature and an
  52.504 -exception object.
  52.505 -\begin{itemize}
  52.506 -\item The signature will typically be that of a desendant of the theory
  52.507 -  declaring the oracle.  The oracle will use it to distinguish constants from
  52.508 -  variables, etc., and it will be attached to the generated theorems.
  52.509 -
  52.510 -\item The exception is used to pass arbitrary information to the oracle.  This
  52.511 -  information must contain a full description of the problem to be solved by
  52.512 -  the external reasoner, including any additional information that might be
  52.513 -  required.  The oracle may raise the exception to indicate that it cannot
  52.514 -  solve the specified problem.
  52.515 -\end{itemize}
  52.516 -
  52.517 -A trivial example is provided in theory \texttt{FOL/ex/IffOracle}.  This
  52.518 -oracle generates tautologies of the form $P\bimp\cdots\bimp P$, with
  52.519 -an even number of $P$s.
  52.520 -
  52.521 -The \texttt{ML} section of \texttt{IffOracle.thy} begins by declaring
  52.522 -a few auxiliary functions (suppressed below) for creating the
  52.523 -tautologies.  Then it declares a new exception constructor for the
  52.524 -information required by the oracle: here, just an integer. It finally
  52.525 -defines the oracle function itself.
  52.526 -\begin{ttbox}
  52.527 -exception IffOracleExn of int;\medskip
  52.528 -fun mk_iff_oracle (sign, IffOracleExn n) =
  52.529 -  if n > 0 andalso n mod 2 = 0
  52.530 -  then Trueprop \$ mk_iff n
  52.531 -  else raise IffOracleExn n;
  52.532 -\end{ttbox}
  52.533 -Observe the function's two arguments, the signature \texttt{sign} and the
  52.534 -exception given as a pattern.  The function checks its argument for
  52.535 -validity.  If $n$ is positive and even then it creates a tautology
  52.536 -containing $n$ occurrences of~$P$.  Otherwise it signals error by
  52.537 -raising its own exception (just by happy coincidence).  Errors may be
  52.538 -signalled by other means, such as returning the theorem \texttt{True}.
  52.539 -Please ensure that the oracle's result is correctly typed; Isabelle
  52.540 -will reject ill-typed theorems by raising a cryptic exception at top
  52.541 -level.
  52.542 -
  52.543 -The \texttt{oracle} section of \texttt{IffOracle.thy} installs above
  52.544 -\texttt{ML} function as follows:
  52.545 -\begin{ttbox}
  52.546 -IffOracle = FOL +\medskip
  52.547 -oracle
  52.548 -  iff = mk_iff_oracle\medskip
  52.549 -end
  52.550 -\end{ttbox}
  52.551 -
  52.552 -Now in \texttt{IffOracle.ML} we first define a wrapper for invoking
  52.553 -the oracle:
  52.554 -\begin{ttbox}
  52.555 -fun iff_oracle n = invoke_oracle IffOracle.thy "iff"
  52.556 -                      (sign_of IffOracle.thy, IffOracleExn n);
  52.557 -\end{ttbox}
  52.558 -
  52.559 -Here are some example applications of the \texttt{iff} oracle.  An
  52.560 -argument of 10 is allowed, but one of 5 is forbidden:
  52.561 -\begin{ttbox}
  52.562 -iff_oracle 10;
  52.563 -{\out  "P <-> P <-> P <-> P <-> P <-> P <-> P <-> P <-> P <-> P" : thm}
  52.564 -iff_oracle 5;
  52.565 -{\out Exception- IffOracleExn 5 raised}
  52.566 -\end{ttbox}
  52.567 -
  52.568 -\index{oracles|)}
  52.569  \index{theories|)}
  52.570  
  52.571  
    53.1 --- a/doc-src/Ref/thm.tex	Wed Mar 04 10:43:39 2009 +0100
    53.2 +++ b/doc-src/Ref/thm.tex	Wed Mar 04 10:45:52 2009 +0100
    53.3 @@ -1,4 +1,4 @@
    53.4 -%% $Id$
    53.5 +
    53.6  \chapter{Theorems and Forward Proof}
    53.7  \index{theorems|(}
    53.8  
    53.9 @@ -13,19 +13,6 @@
   53.10  ignore such complexities --- and skip all but the first section of
   53.11  this chapter.
   53.12  
   53.13 -The theorem operations do not print error messages.  Instead, they raise
   53.14 -exception~\xdx{THM}\@.  Use \ttindex{print_exn} to display
   53.15 -exceptions nicely:
   53.16 -\begin{ttbox} 
   53.17 -allI RS mp  handle e => print_exn e;
   53.18 -{\out Exception THM raised:}
   53.19 -{\out RSN: no unifiers -- premise 1}
   53.20 -{\out (!!x. ?P(x)) ==> ALL x. ?P(x)}
   53.21 -{\out [| ?P --> ?Q; ?P |] ==> ?Q}
   53.22 -{\out}
   53.23 -{\out uncaught exception THM}
   53.24 -\end{ttbox}
   53.25 -
   53.26  
   53.27  \section{Basic operations on theorems}
   53.28  \subsection{Pretty-printing a theorem}
    54.1 --- a/doc-src/System/Thy/Basics.thy	Wed Mar 04 10:43:39 2009 +0100
    54.2 +++ b/doc-src/System/Thy/Basics.thy	Wed Mar 04 10:45:52 2009 +0100
    54.3 @@ -360,8 +360,8 @@
    54.4    @{verbatim "-W"} option makes Isabelle enter a special process
    54.5    wrapper for interaction via an external program; the protocol is a
    54.6    stripped-down version of Proof General the interaction mode, see
    54.7 -  also @{"file" "~~/src/Pure/Tools/isabelle_process.ML"} and @{"file"
    54.8 -  "~~/src/Pure/Tools/isabelle_process.scala"}.
    54.9 +  also @{"file" "~~/src/Pure/System/isabelle_process.ML"} and @{"file"
   54.10 +  "~~/src/Pure/System/isabelle_process.scala"}.
   54.11  
   54.12    \medskip The @{verbatim "-S"} option makes the Isabelle process more
   54.13    secure by disabling some critical operations, notably runtime
    55.1 --- a/doc-src/System/Thy/Presentation.thy	Wed Mar 04 10:43:39 2009 +0100
    55.2 +++ b/doc-src/System/Thy/Presentation.thy	Wed Mar 04 10:45:52 2009 +0100
    55.3 @@ -654,7 +654,7 @@
    55.4    "-"}@{text foo}'' to drop, and ``@{verbatim "/"}@{text foo}'' to
    55.5    fold text tagged as @{text foo}.  The builtin default is equivalent
    55.6    to the tag specification ``@{verbatim
    55.7 -  "/theory,/proof,/ML,+visible,-invisible"}''; see also the {\LaTeX}
    55.8 +  "+theory,+proof,+ML,+visible,-invisible"}''; see also the {\LaTeX}
    55.9    macros @{verbatim "\\isakeeptag"}, @{verbatim "\\isadroptag"}, and
   55.10    @{verbatim "\\isafoldtag"}, in @{"file"
   55.11    "~~/lib/texinputs/isabelle.sty"}.
    56.1 --- a/doc-src/System/Thy/document/Basics.tex	Wed Mar 04 10:43:39 2009 +0100
    56.2 +++ b/doc-src/System/Thy/document/Basics.tex	Wed Mar 04 10:45:52 2009 +0100
    56.3 @@ -369,7 +369,7 @@
    56.4    \verb|-W| option makes Isabelle enter a special process
    56.5    wrapper for interaction via an external program; the protocol is a
    56.6    stripped-down version of Proof General the interaction mode, see
    56.7 -  also \hyperlink{file.~~/src/Pure/Tools/isabelle-process.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Tools{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}ML}}}} and \hyperlink{file.~~/src/Pure/Tools/isabelle-process.scala}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Tools{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}scala}}}}.
    56.8 +  also \hyperlink{file.~~/src/Pure/System/isabelle-process.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}System{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}ML}}}} and \hyperlink{file.~~/src/Pure/System/isabelle-process.scala}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}System{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}scala}}}}.
    56.9  
   56.10    \medskip The \verb|-S| option makes the Isabelle process more
   56.11    secure by disabling some critical operations, notably runtime
    57.1 --- a/doc-src/System/Thy/document/Presentation.tex	Wed Mar 04 10:43:39 2009 +0100
    57.2 +++ b/doc-src/System/Thy/document/Presentation.tex	Wed Mar 04 10:45:52 2009 +0100
    57.3 @@ -668,7 +668,7 @@
    57.4    tagged Isabelle command regions.  Tags are specified as a comma
    57.5    separated list of modifier/name pairs: ``\verb|+|\isa{foo}'' (or just ``\isa{foo}'') means to keep, ``\verb|-|\isa{foo}'' to drop, and ``\verb|/|\isa{foo}'' to
    57.6    fold text tagged as \isa{foo}.  The builtin default is equivalent
    57.7 -  to the tag specification ``\verb|/theory,/proof,/ML,+visible,-invisible|''; see also the {\LaTeX}
    57.8 +  to the tag specification ``\verb|+theory,+proof,+ML,+visible,-invisible|''; see also the {\LaTeX}
    57.9    macros \verb|\isakeeptag|, \verb|\isadroptag|, and
   57.10    \verb|\isafoldtag|, in \hyperlink{file.~~/lib/texinputs/isabelle.sty}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}lib{\isacharslash}texinputs{\isacharslash}isabelle{\isachardot}sty}}}}.
   57.11  
    58.1 --- a/doc-src/System/system.tex	Wed Mar 04 10:43:39 2009 +0100
    58.2 +++ b/doc-src/System/system.tex	Wed Mar 04 10:45:52 2009 +0100
    58.3 @@ -36,7 +36,7 @@
    58.4  \input{Thy/document/Misc.tex}
    58.5  
    58.6  \begingroup
    58.7 -  \bibliographystyle{plain} \small\raggedright\frenchspacing
    58.8 +  \bibliographystyle{abbrv} \small\raggedright\frenchspacing
    58.9    \bibliography{../manual}
   58.10  \endgroup
   58.11  
    59.1 --- a/doc-src/TutorialI/Types/Numbers.thy	Wed Mar 04 10:43:39 2009 +0100
    59.2 +++ b/doc-src/TutorialI/Types/Numbers.thy	Wed Mar 04 10:45:52 2009 +0100
    59.3 @@ -100,8 +100,8 @@
    59.4  @{thm[display] div_mult1_eq[no_vars]}
    59.5  \rulename{div_mult1_eq}
    59.6  
    59.7 -@{thm[display] mod_mult1_eq[no_vars]}
    59.8 -\rulename{mod_mult1_eq}
    59.9 +@{thm[display] mod_mult_right_eq[no_vars]}
   59.10 +\rulename{mod_mult_right_eq}
   59.11  
   59.12  @{thm[display] div_mult2_eq[no_vars]}
   59.13  \rulename{div_mult2_eq}
   59.14 @@ -147,8 +147,8 @@
   59.15  @{thm[display] zdiv_zadd1_eq[no_vars]}
   59.16  \rulename{zdiv_zadd1_eq}
   59.17  
   59.18 -@{thm[display] zmod_zadd1_eq[no_vars]}
   59.19 -\rulename{zmod_zadd1_eq}
   59.20 +@{thm[display] mod_add_eq[no_vars]}
   59.21 +\rulename{mod_add_eq}
   59.22  
   59.23  @{thm[display] zdiv_zmult1_eq[no_vars]}
   59.24  \rulename{zdiv_zmult1_eq}
    60.1 --- a/doc-src/TutorialI/Types/document/Numbers.tex	Wed Mar 04 10:43:39 2009 +0100
    60.2 +++ b/doc-src/TutorialI/Types/document/Numbers.tex	Wed Mar 04 10:45:52 2009 +0100
    60.3 @@ -244,7 +244,7 @@
    60.4  \begin{isabelle}%
    60.5  a\ {\isacharasterisk}\ b\ mod\ c\ {\isacharequal}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ mod\ c{\isacharparenright}\ mod\ c%
    60.6  \end{isabelle}
    60.7 -\rulename{mod_mult1_eq}
    60.8 +\rulename{mod_mult_right_eq}
    60.9  
   60.10  \begin{isabelle}%
   60.11  a\ div\ {\isacharparenleft}b\ {\isacharasterisk}\ c{\isacharparenright}\ {\isacharequal}\ a\ div\ b\ div\ c%
   60.12 @@ -318,7 +318,7 @@
   60.13  \begin{isabelle}%
   60.14  {\isacharparenleft}a\ {\isacharplus}\ b{\isacharparenright}\ mod\ c\ {\isacharequal}\ {\isacharparenleft}a\ mod\ c\ {\isacharplus}\ b\ mod\ c{\isacharparenright}\ mod\ c%
   60.15  \end{isabelle}
   60.16 -\rulename{zmod_zadd1_eq}
   60.17 +\rulename{mod_add_eq}
   60.18  
   60.19  \begin{isabelle}%
   60.20  a\ {\isacharasterisk}\ b\ div\ c\ {\isacharequal}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ div\ c{\isacharparenright}\ {\isacharplus}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ mod\ c{\isacharparenright}\ div\ c%
    61.1 --- a/doc-src/TutorialI/Types/numerics.tex	Wed Mar 04 10:43:39 2009 +0100
    61.2 +++ b/doc-src/TutorialI/Types/numerics.tex	Wed Mar 04 10:45:52 2009 +0100
    61.3 @@ -154,7 +154,7 @@
    61.4  a\ *\ b\ div\ c\ =\ a\ *\ (b\ div\ c)\ +\ a\ *\ (b\ mod\ c)\ div\ c%
    61.5  \rulename{div_mult1_eq}\isanewline
    61.6  a\ *\ b\ mod\ c\ =\ a\ *\ (b\ mod\ c)\ mod\ c%
    61.7 -\rulename{mod_mult1_eq}\isanewline
    61.8 +\rulename{mod_mult_right_eq}\isanewline
    61.9  a\ div\ (b*c)\ =\ a\ div\ b\ div\ c%
   61.10  \rulename{div_mult2_eq}\isanewline
   61.11  a\ mod\ (b*c)\ =\ b * (a\ div\ b\ mod\ c)\ +\ a\ mod\ b%
   61.12 @@ -276,7 +276,7 @@
   61.13  \rulename{zdiv_zadd1_eq}
   61.14  \par\smallskip
   61.15  (a\ +\ b)\ mod\ c\ =\ (a\ mod\ c\ +\ b\ mod\ c)\ mod\ c%
   61.16 -\rulename{zmod_zadd1_eq}
   61.17 +\rulename{mod_add_eq}
   61.18  \end{isabelle}
   61.19  
   61.20  \begin{isabelle}
    62.1 --- a/doc-src/ZF/FOL.tex	Wed Mar 04 10:43:39 2009 +0100
    62.2 +++ b/doc-src/ZF/FOL.tex	Wed Mar 04 10:45:52 2009 +0100
    62.3 @@ -1,4 +1,4 @@
    62.4 -%% $Id$
    62.5 +%!TEX root = logics-ZF.tex
    62.6  \chapter{First-Order Logic}
    62.7  \index{first-order logic|(}
    62.8  
    62.9 @@ -360,7 +360,8 @@
   62.10  logic by designating \isa{IFOL} rather than \isa{FOL} as the parent
   62.11  theory:
   62.12  \begin{isabelle}
   62.13 -\isacommand{theory}\ IFOL\_examples\ =\ IFOL:
   62.14 +\isacommand{theory}\ IFOL\_examples\ \isacommand{imports}\ IFOL\isanewline
   62.15 +\isacommand{begin}
   62.16  \end{isabelle}
   62.17  The proof begins by entering the goal, then applying the rule $({\imp}I)$.
   62.18  \begin{isabelle}
   62.19 @@ -441,7 +442,7 @@
   62.20  \ 1.\ (\isasymexists y.\ \isasymforall x.\ Q(x,\ y))\
   62.21  \isasymlongrightarrow \ (\isasymforall x.\ \isasymexists y.\ Q(x,\ y))
   62.22  \isanewline
   62.23 -\isacommand{by} (tactic {*IntPr.fast_tac 1*})\isanewline
   62.24 +\isacommand{by} (tactic \ttlbrace*IntPr.fast_tac 1*\ttrbrace)\isanewline
   62.25  No\ subgoals!
   62.26  \end{isabelle}
   62.27  
   62.28 @@ -529,7 +530,8 @@
   62.29  $\all{x}P(x)$ is true.  Either way the theorem holds.  First, we must
   62.30  work in a theory based on classical logic, the theory \isa{FOL}:
   62.31  \begin{isabelle}
   62.32 -\isacommand{theory}\ FOL\_examples\ =\ FOL:
   62.33 +\isacommand{theory}\ FOL\_examples\ \isacommand{imports}\ FOL\isanewline
   62.34 +\isacommand{begin}
   62.35  \end{isabelle}
   62.36  
   62.37  The formal proof does not conform in any obvious way to the sketch given
   62.38 @@ -631,7 +633,8 @@
   62.39  $if::[o,o,o]\To o$.  The axiom \tdx{if_def} asserts the
   62.40  equation~$(if)$.
   62.41  \begin{isabelle}
   62.42 -\isacommand{theory}\ If\ =\ FOL:\isanewline
   62.43 +\isacommand{theory}\ If\ \isacommand{imports}\ FOL\isanewline
   62.44 +\isacommand{begin}\isanewline
   62.45  \isacommand{constdefs}\isanewline
   62.46  \ \ if\ ::\ "[o,o,o]=>o"\isanewline
   62.47  \ \ \ "if(P,Q,R)\ ==\ P\&Q\ |\ \isachartilde P\&R"
    63.1 --- a/doc-src/antiquote_setup.ML	Wed Mar 04 10:43:39 2009 +0100
    63.2 +++ b/doc-src/antiquote_setup.ML	Wed Mar 04 10:45:52 2009 +0100
    63.3 @@ -1,5 +1,4 @@
    63.4  (*  Title:      Doc/antiquote_setup.ML
    63.5 -    ID:         $Id$
    63.6      Author:     Makarius
    63.7  
    63.8  Auxiliary antiquotations for the Isabelle manuals.
    63.9 @@ -13,13 +12,17 @@
   63.10  
   63.11  (* misc utils *)
   63.12  
   63.13 -val clean_string = translate_string
   63.14 +fun translate f = Symbol.explode #> map f #> implode;
   63.15 +
   63.16 +val clean_string = translate
   63.17    (fn "_" => "\\_"
   63.18 +    | "#" => "\\#"
   63.19      | "<" => "$<$"
   63.20      | ">" => "$>$"
   63.21 -    | "#" => "\\#"
   63.22      | "{" => "\\{"
   63.23 +    | "|" => "$\\mid$"
   63.24      | "}" => "\\}"
   63.25 +    | "\\<dash>" => "-"
   63.26      | c => c);
   63.27  
   63.28  fun clean_name "\\<dots>" = "dots"
   63.29 @@ -28,7 +31,7 @@
   63.30    | clean_name "_" = "underscore"
   63.31    | clean_name "{" = "braceleft"
   63.32    | clean_name "}" = "braceright"
   63.33 -  | clean_name s = s |> translate_string (fn "_" => "-" | c => c);
   63.34 +  | clean_name s = s |> translate (fn "_" => "-" | "\\<dash>" => "-" | c => c);
   63.35  
   63.36  
   63.37  (* verbatim text *)
   63.38 @@ -66,8 +69,9 @@
   63.39      val txt' = if kind = "" then txt else kind ^ " " ^ txt;
   63.40      val _ = writeln (ml (txt1, txt2));
   63.41      val _ = ML_Context.eval_in (SOME ctxt) false Position.none (ml (txt1, txt2));
   63.42 +    val kind' = if kind = "" then "ML" else "ML " ^ kind;
   63.43    in
   63.44 -    "\\indexml" ^ kind ^ enclose "{" "}" (clean_string txt1) ^
   63.45 +    "\\indexdef{}{" ^ kind' ^ "}{" ^ clean_string txt1 ^ "}" ^
   63.46      (txt'
   63.47      |> (if ! O.quotes then quote else I)
   63.48      |> (if ! O.display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
   63.49 @@ -193,6 +197,7 @@
   63.50    entity_antiqs no_check "" "case" @
   63.51    entity_antiqs (K ThyOutput.defined_command) "" "antiquotation" @
   63.52    entity_antiqs (fn _ => fn name => is_some (OS.Process.getEnv name)) "isatt" "setting" @
   63.53 +  entity_antiqs no_check "" "inference" @
   63.54    entity_antiqs no_check "isatt" "executable" @
   63.55    entity_antiqs (K check_tool) "isatt" "tool" @
   63.56    entity_antiqs (K (File.exists o Path.explode)) "isatt" "file" @
    64.1 --- a/doc-src/isar.sty	Wed Mar 04 10:43:39 2009 +0100
    64.2 +++ b/doc-src/isar.sty	Wed Mar 04 10:45:52 2009 +0100
    64.3 @@ -1,6 +1,3 @@
    64.4 -
    64.5 -%% $Id$
    64.6 -
    64.7  \usepackage{ifthen}
    64.8  
    64.9  \newcommand{\indexdef}[3]%
   64.10 @@ -20,3 +17,9 @@
   64.11  \newcommand{\isasymIMPORTS}{\isakeyword{imports}}
   64.12  \newcommand{\isasymIN}{\isakeyword{in}}
   64.13  \newcommand{\isasymSTRUCTURE}{\isakeyword{structure}}
   64.14 +\newcommand{\isasymFIXES}{\isakeyword{fixes}}
   64.15 +\newcommand{\isasymASSUMES}{\isakeyword{assumes}}
   64.16 +\newcommand{\isasymSHOWS}{\isakeyword{shows}}
   64.17 +\newcommand{\isasymOBTAINS}{\isakeyword{obtains}}
   64.18 +
   64.19 +\newcommand{\isasymASSM}{\isacommand{assm}}
    65.1 --- a/doc-src/manual.bib	Wed Mar 04 10:43:39 2009 +0100
    65.2 +++ b/doc-src/manual.bib	Wed Mar 04 10:45:52 2009 +0100
    65.3 @@ -1,6 +1,4 @@
    65.4  % BibTeX database for the Isabelle documentation
    65.5 -%
    65.6 -% Lawrence C Paulson $Id$
    65.7  
    65.8  %publishers
    65.9  @string{AP="Academic Press"}
   65.10 @@ -185,6 +183,16 @@
   65.11                    {F}ormal-{L}ogic {E}ngineering},
   65.12    crossref =     {tphols99}}
   65.13  
   65.14 +
   65.15 +@InProceedings{Bezem-Coquand:2005,
   65.16 +  author = 	 {M.A. Bezem and T. Coquand},
   65.17 +  title = 	 {Automating {Coherent Logic}},
   65.18 +  booktitle = {LPAR-12},
   65.19 +  editor = 	 {G. Sutcliffe and A. Voronkov},
   65.20 +  volume = 	 3835,
   65.21 +  series = 	 LNCS,
   65.22 +  publisher = Springer}
   65.23 +
   65.24  @book{Bird-Wadler,author="Richard Bird and Philip Wadler",
   65.25  title="Introduction to Functional Programming",publisher=PH,year=1988}
   65.26  
   65.27 @@ -469,6 +477,17 @@
   65.28    number        = {364/07}
   65.29  }
   65.30  
   65.31 +@InProceedings{Haftmann-Wenzel:2009,
   65.32 +  author        = {Florian Haftmann and Makarius Wenzel},
   65.33 +  title         = {Local theory specifications in {Isabelle/Isar}},
   65.34 +  editor        = {Stefano Berardi and Ferruccio Damiani and de Liguoro, Ugo},
   65.35 +  booktitle     = {Types for Proofs and Programs, TYPES 2008},
   65.36 +  publisher     = {Springer},
   65.37 +  series        = {LNCS},
   65.38 +  volume        = {????},
   65.39 +  year          = {2009}
   65.40 +}
   65.41 +
   65.42  @manual{isabelle-classes,
   65.43    author        = {Florian Haftmann},
   65.44    title         = {Haskell-style type classes with {Isabelle}/{Isar}},
   65.45 @@ -669,6 +688,16 @@
   65.46    pages		= {341-386},
   65.47    crossref	= {birtwistle89}}
   65.48  
   65.49 +@Article{Miller:1991,
   65.50 +  author = 	 {Dale Miller},
   65.51 +  title = 	 {A Logic Programming Language with Lambda-Abstraction, Function Variables,
   65.52 +    and Simple Unification},
   65.53 +  journal = 	 {Journal of Logic and Computation},
   65.54 +  year = 	 1991,
   65.55 +  volume =	 1,
   65.56 +  number =	 4
   65.57 +}
   65.58 +
   65.59  @Article{miller-mixed,
   65.60    Author	= {Dale Miller},
   65.61    Title		= {Unification Under a Mixed Prefix},
   65.62 @@ -1198,6 +1227,15 @@
   65.63    pages		= {578-596},
   65.64    crossref	= {fme93}}
   65.65  
   65.66 +@Article{Schroeder-Heister:1984,
   65.67 +  author =       {Peter Schroeder-Heister},
   65.68 +  title =        {A Natural Extension of Natural Deduction},
   65.69 +  journal =      {Journal of Symbolic Logic},
   65.70 +  year =         1984,
   65.71 +  volume =       49,
   65.72 +  number =       4
   65.73 +}
   65.74 +
   65.75  @inproceedings{slind-tfl,
   65.76    author	= {Konrad Slind},
   65.77    title		= {Function Definition in Higher Order Logic},
   65.78 @@ -1331,6 +1369,24 @@
   65.79    year=2002,
   65.80    note =	 {\url{http://tumb1.biblio.tu-muenchen.de/publ/diss/in/2002/wenzel.html}}}
   65.81  
   65.82 +@Article{Wenzel-Wiedijk:2002,
   65.83 +  author = 	 {Freek Wiedijk and Markus Wenzel},
   65.84 +  title = 	 {A comparison of the mathematical proof languages {Mizar} and {Isar}.},
   65.85 +  journal = 	 {Journal of Automated Reasoning},
   65.86 +  year = 	 2002,
   65.87 +  volume =	 29,
   65.88 +  number =	 {3-4}
   65.89 +}
   65.90 +
   65.91 +@InCollection{Wenzel-Paulson:2006,
   65.92 +  author = 	 {Markus Wenzel and Lawrence C. Paulson},
   65.93 +  title = 	 {{Isabelle/Isar}},
   65.94 +  booktitle = 	 {The Seventeen Provers of the World},
   65.95 +  year =	 2006,
   65.96 +  editor =	 {F. Wiedijk},
   65.97 +  series =	 {LNAI 3600}
   65.98 +}
   65.99 +
  65.100  @InCollection{Wenzel:2006:Festschrift,
  65.101    author = 	 {Makarius Wenzel},
  65.102    title = 	 {{Isabelle/Isar} --- a generic framework for human-readable proof documents},
    66.1 --- a/doc-src/more_antiquote.ML	Wed Mar 04 10:43:39 2009 +0100
    66.2 +++ b/doc-src/more_antiquote.ML	Wed Mar 04 10:45:52 2009 +0100
    66.3 @@ -1,5 +1,4 @@
    66.4  (*  Title:      Doc/more_antiquote.ML
    66.5 -    ID:         $Id$
    66.6      Author:     Florian Haftmann, TU Muenchen
    66.7  
    66.8  More antiquotations.
    66.9 @@ -92,9 +91,9 @@
   66.10    let
   66.11      val thy = ProofContext.theory_of ctxt;
   66.12      val const = Code_Unit.check_const thy raw_const;
   66.13 -    val (_, funcgr) = Code_Funcgr.make thy [const];
   66.14 +    val (_, funcgr) = Code_Wellsorted.make thy [const];
   66.15      fun holize thm = @{thm meta_eq_to_obj_eq} OF [thm];
   66.16 -    val thms = Code_Funcgr.eqns funcgr const
   66.17 +    val thms = Code_Wellsorted.eqns funcgr const
   66.18        |> map_filter (fn (thm, linear) => if linear then SOME thm else NONE)
   66.19        |> map (holize o no_vars ctxt o AxClass.overload thy);
   66.20    in ThyOutput.output_list pretty_thm src ctxt thms end;
    67.1 --- a/doc/Contents	Wed Mar 04 10:43:39 2009 +0100
    67.2 +++ b/doc/Contents	Wed Mar 04 10:45:52 2009 +0100
    67.3 @@ -6,13 +6,16 @@
    67.4    functions       Tutorial on Function Definitions
    67.5    codegen         Tutorial on Code Generation
    67.6    sugar           LaTeX sugar for proof documents
    67.7 -  ind-defs        (Co)Inductive Definitions in ZF
    67.8  
    67.9  Reference Manuals
   67.10    isar-ref        The Isabelle/Isar Reference Manual
   67.11    implementation  The Isabelle/Isar Implementation Manual
   67.12    system          The Isabelle System Manual
   67.13 -  ref             The Isabelle Reference Manual
   67.14 +
   67.15 +Old Manuals (outdated!)
   67.16 +  intro           Old Introduction to Isabelle
   67.17 +  ref             Old Isabelle Reference Manual
   67.18    logics          Isabelle's Logics: overview and misc logics
   67.19    logics-HOL      Isabelle's Logics: HOL
   67.20    logics-ZF       Isabelle's Logics: FOL and ZF
   67.21 +  ind-defs        (Co)Inductive Definitions in ZF
    68.1 --- a/etc/settings	Wed Mar 04 10:43:39 2009 +0100
    68.2 +++ b/etc/settings	Wed Mar 04 10:45:52 2009 +0100
    68.3 @@ -60,12 +60,6 @@
    68.4  #ML_OPTIONS=""
    68.5  #ML_PLATFORM=""
    68.6  
    68.7 -# Alice 1.4 (experimental!)
    68.8 -#ML_SYSTEM=alice
    68.9 -#ML_HOME="/usr/local/alice/bin"
   68.10 -#ML_OPTIONS=""
   68.11 -#ML_PLATFORM=""
   68.12 -
   68.13  
   68.14  ###
   68.15  ### JVM components (Scala or Java)
   68.16 @@ -268,6 +262,8 @@
   68.17  
   68.18  # zChaff (SAT Solver, cf. Isabelle/src/HOL/Tools/sat_solver.ML)
   68.19  #ZCHAFF_HOME=/usr/local/bin
   68.20 +#ZCHAFF_VERSION=2004.5.13
   68.21 +#ZCHAFF_VERSION=2004.11.15
   68.22  
   68.23  # BerkMin561 (SAT Solver, cf. Isabelle/src/HOL/Tools/sat_solver.ML)
   68.24  #BERKMIN_HOME=/usr/local/bin
    69.1 --- a/lib/Tools/codegen	Wed Mar 04 10:43:39 2009 +0100
    69.2 +++ b/lib/Tools/codegen	Wed Mar 04 10:45:52 2009 +0100
    69.3 @@ -36,5 +36,5 @@
    69.4  THY=$(echo $THY | sed -e 's/\\/\\\\"/g; s/"/\\\"/g')
    69.5  ISAR="theory Codegen imports \"$THY\" begin export_code $CMD end"
    69.6  
    69.7 -echo "$ISAR" | "$ISABELLE_TOOL" tty -l "$IMAGE"
    69.8 +echo "$ISAR" | "$ISABELLE_PROCESS" -I "$IMAGE"
    69.9  exit ${PIPESTATUS[1]}
    70.1 --- a/src/FOL/IFOL.thy	Wed Mar 04 10:43:39 2009 +0100
    70.2 +++ b/src/FOL/IFOL.thy	Wed Mar 04 10:45:52 2009 +0100
    70.3 @@ -1,5 +1,4 @@
    70.4  (*  Title:      FOL/IFOL.thy
    70.5 -    ID:         $Id$
    70.6      Author:     Lawrence C Paulson and Markus Wenzel
    70.7  *)
    70.8  
    70.9 @@ -14,9 +13,10 @@
   70.10    "~~/src/Tools/IsaPlanner/isand.ML"
   70.11    "~~/src/Tools/IsaPlanner/rw_tools.ML"
   70.12    "~~/src/Tools/IsaPlanner/rw_inst.ML"
   70.13 -  "~~/src/Provers/eqsubst.ML"
   70.14 +  "~~/src/Tools/eqsubst.ML"
   70.15    "~~/src/Provers/quantifier1.ML"
   70.16 -  "~~/src/Provers/project_rule.ML"
   70.17 +  "~~/src/Tools/intuitionistic.ML"
   70.18 +  "~~/src/Tools/project_rule.ML"
   70.19    "~~/src/Tools/atomize_elim.ML"
   70.20    ("fologic.ML")
   70.21    ("hypsubstdata.ML")
   70.22 @@ -610,6 +610,8 @@
   70.23  
   70.24  subsection {* Intuitionistic Reasoning *}
   70.25  
   70.26 +setup {* Intuitionistic.method_setup "iprover" *}
   70.27 +
   70.28  lemma impE':
   70.29    assumes 1: "P --> Q"
   70.30      and 2: "Q ==> R"
    71.1 --- a/src/FOL/IsaMakefile	Wed Mar 04 10:43:39 2009 +0100
    71.2 +++ b/src/FOL/IsaMakefile	Wed Mar 04 10:45:52 2009 +0100
    71.3 @@ -32,12 +32,13 @@
    71.4    $(SRC)/Provers/clasimp.ML $(SRC)/Provers/classical.ML			\
    71.5    $(SRC)/Tools/IsaPlanner/zipper.ML $(SRC)/Tools/IsaPlanner/isand.ML	\
    71.6    $(SRC)/Tools/IsaPlanner/rw_tools.ML					\
    71.7 -  $(SRC)/Tools/IsaPlanner/rw_inst.ML $(SRC)/Provers/eqsubst.ML		\
    71.8 +  $(SRC)/Tools/IsaPlanner/rw_inst.ML $(SRC)/Tools/eqsubst.ML		\
    71.9    $(SRC)/Provers/hypsubst.ML $(SRC)/Tools/induct.ML			\
   71.10 -  $(SRC)/Tools/atomize_elim.ML $(SRC)/Provers/project_rule.ML		\
   71.11 -  $(SRC)/Provers/quantifier1.ML $(SRC)/Provers/splitter.ML FOL.thy	\
   71.12 -  IFOL.thy ROOT.ML blastdata.ML cladata.ML document/root.tex		\
   71.13 -  fologic.ML hypsubstdata.ML intprover.ML simpdata.ML
   71.14 +  $(SRC)/Tools/intuitionistic.ML $(SRC)/Tools/atomize_elim.ML		\
   71.15 +  $(SRC)/Tools/project_rule.ML $(SRC)/Provers/quantifier1.ML		\
   71.16 +  $(SRC)/Provers/splitter.ML FOL.thy IFOL.thy ROOT.ML blastdata.ML	\
   71.17 +  cladata.ML document/root.tex fologic.ML hypsubstdata.ML intprover.ML	\
   71.18 +  simpdata.ML
   71.19  	@$(ISABELLE_TOOL) usedir -p 2 -b $(OUT)/Pure FOL
   71.20  
   71.21  
   71.22 @@ -46,12 +47,12 @@
   71.23  FOL-ex: FOL $(LOG)/FOL-ex.gz
   71.24  
   71.25  $(LOG)/FOL-ex.gz: $(OUT)/FOL ex/First_Order_Logic.thy ex/If.thy		\
   71.26 -  ex/IffOracle.thy ex/Nat.thy ex/Natural_Numbers.thy	\
   71.27 -  ex/LocaleTest.thy    \
   71.28 -  ex/Miniscope.thy ex/Prolog.thy ex/ROOT.ML ex/Classical.thy		\
   71.29 -  ex/document/root.tex ex/Foundation.thy ex/Intuitionistic.thy		\
   71.30 -  ex/Intro.thy ex/Propositional_Int.thy ex/Propositional_Cla.thy	\
   71.31 -  ex/Quantifiers_Int.thy ex/Quantifiers_Cla.thy
   71.32 +  ex/Iff_Oracle.thy ex/Nat.thy ex/Nat_Class.thy ex/Natural_Numbers.thy	\
   71.33 +  ex/LocaleTest.thy ex/Miniscope.thy ex/Prolog.thy ex/ROOT.ML		\
   71.34 +  ex/Classical.thy ex/document/root.tex ex/Foundation.thy		\
   71.35 +  ex/Intuitionistic.thy ex/Intro.thy ex/Propositional_Int.thy		\
   71.36 +  ex/Propositional_Cla.thy ex/Quantifiers_Int.thy			\
   71.37 +  ex/Quantifiers_Cla.thy
   71.38  	@$(ISABELLE_TOOL) usedir $(OUT)/FOL ex
   71.39  
   71.40  
    72.1 --- a/src/FOL/ex/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
    72.2 +++ b/src/FOL/ex/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
    72.3 @@ -1,7 +1,4 @@
    72.4  (*  Title:      FOL/ex/ROOT.ML
    72.5 -    ID:         $Id$
    72.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    72.7 -    Copyright   1992  University of Cambridge
    72.8  
    72.9  Examples for First-Order Logic. 
   72.10  *)
   72.11 @@ -11,23 +8,19 @@
   72.12    "Natural_Numbers",
   72.13    "Intro",
   72.14    "Nat",
   72.15 +  "Nat_Class",
   72.16    "Foundation",
   72.17    "Prolog",
   72.18 -
   72.19    "Intuitionistic",
   72.20    "Propositional_Int",
   72.21    "Quantifiers_Int",
   72.22 -
   72.23    "Classical",
   72.24    "Propositional_Cla",
   72.25    "Quantifiers_Cla",
   72.26    "Miniscope",
   72.27    "If",
   72.28 -
   72.29 -  "NatClass",
   72.30 -  "IffOracle"
   72.31 +  "Iff_Oracle"
   72.32  ];
   72.33  
   72.34  (*regression test for locales -- sets several global flags!*)
   72.35  no_document use_thy "LocaleTest";
   72.36 -
    73.1 --- a/src/FOLP/simp.ML	Wed Mar 04 10:43:39 2009 +0100
    73.2 +++ b/src/FOLP/simp.ML	Wed Mar 04 10:45:52 2009 +0100
    73.3 @@ -433,7 +433,7 @@
    73.4          val thms = map (trivial o cterm_of(Thm.theory_of_thm thm)) As;
    73.5          val new_rws = List.concat(map mk_rew_rules thms);
    73.6          val rwrls = map mk_trans (List.concat(map mk_rew_rules thms));
    73.7 -        val anet' = foldr lhs_insert_thm anet rwrls
    73.8 +        val anet' = List.foldr lhs_insert_thm anet rwrls
    73.9      in  if !tracing andalso not(null new_rws)
   73.10          then (writeln"Adding rewrites:";  Display.prths new_rws;  ())
   73.11          else ();
    74.1 --- a/src/HOL/Algebra/Coset.thy	Wed Mar 04 10:43:39 2009 +0100
    74.2 +++ b/src/HOL/Algebra/Coset.thy	Wed Mar 04 10:45:52 2009 +0100
    74.3 @@ -602,8 +602,8 @@
    74.4    interpret group G by fact
    74.5    show ?thesis
    74.6    proof (intro equiv.intro)
    74.7 -    show "refl (carrier G) (rcong H)"
    74.8 -      by (auto simp add: r_congruent_def refl_def) 
    74.9 +    show "refl_on (carrier G) (rcong H)"
   74.10 +      by (auto simp add: r_congruent_def refl_on_def) 
   74.11    next
   74.12      show "sym (rcong H)"
   74.13      proof (simp add: r_congruent_def sym_def, clarify)
    75.1 --- a/src/HOL/Algebra/Exponent.thy	Wed Mar 04 10:43:39 2009 +0100
    75.2 +++ b/src/HOL/Algebra/Exponent.thy	Wed Mar 04 10:45:52 2009 +0100
    75.3 @@ -210,12 +210,12 @@
    75.4  
    75.5  lemma p_fac_forw: "[| (m::nat) > 0; k>0; k < p^a; (p^r) dvd (p^a)* m - k |]  
    75.6    ==> (p^r) dvd (p^a) - k"
    75.7 -apply (frule_tac k1 = k and i = p in p_fac_forw_lemma [THEN le_imp_power_dvd], auto)
    75.8 +apply (frule p_fac_forw_lemma [THEN le_imp_power_dvd, of _ k p], auto)
    75.9  apply (subgoal_tac "p^r dvd p^a*m")
   75.10   prefer 2 apply (blast intro: dvd_mult2)
   75.11  apply (drule dvd_diffD1)
   75.12    apply assumption
   75.13 - prefer 2 apply (blast intro: dvd_diff)
   75.14 + prefer 2 apply (blast intro: nat_dvd_diff)
   75.15  apply (drule gr0_implies_Suc, auto)
   75.16  done
   75.17  
   75.18 @@ -226,12 +226,12 @@
   75.19  
   75.20  lemma p_fac_backw: "[| m>0; k>0; (p::nat)\<noteq>0;  k < p^a;  (p^r) dvd p^a - k |]  
   75.21    ==> (p^r) dvd (p^a)*m - k"
   75.22 -apply (frule_tac k1 = k and i = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
   75.23 +apply (frule_tac k1 = k and p1 = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
   75.24  apply (subgoal_tac "p^r dvd p^a*m")
   75.25   prefer 2 apply (blast intro: dvd_mult2)
   75.26  apply (drule dvd_diffD1)
   75.27    apply assumption
   75.28 - prefer 2 apply (blast intro: dvd_diff)
   75.29 + prefer 2 apply (blast intro: nat_dvd_diff)
   75.30  apply (drule less_imp_Suc_add, auto)
   75.31  done
   75.32  
    76.1 --- a/src/HOL/Algebra/Sylow.thy	Wed Mar 04 10:43:39 2009 +0100
    76.2 +++ b/src/HOL/Algebra/Sylow.thy	Wed Mar 04 10:45:52 2009 +0100
    76.3 @@ -20,8 +20,8 @@
    76.4        and "RelM == {(N1,N2). N1 \<in> calM & N2 \<in> calM &
    76.5                               (\<exists>g \<in> carrier(G). N1 = (N2 #> g) )}"
    76.6  
    76.7 -lemma (in sylow) RelM_refl: "refl calM RelM"
    76.8 -apply (auto simp add: refl_def RelM_def calM_def)
    76.9 +lemma (in sylow) RelM_refl_on: "refl_on calM RelM"
   76.10 +apply (auto simp add: refl_on_def RelM_def calM_def)
   76.11  apply (blast intro!: coset_mult_one [symmetric])
   76.12  done
   76.13  
   76.14 @@ -40,7 +40,7 @@
   76.15  
   76.16  lemma (in sylow) RelM_equiv: "equiv calM RelM"
   76.17  apply (unfold equiv_def)
   76.18 -apply (blast intro: RelM_refl RelM_sym RelM_trans)
   76.19 +apply (blast intro: RelM_refl_on RelM_sym RelM_trans)
   76.20  done
   76.21  
   76.22  lemma (in sylow) M_subset_calM_prep: "M' \<in> calM // RelM  ==> M' \<subseteq> calM"
    77.1 --- a/src/HOL/Algebra/poly/UnivPoly2.thy	Wed Mar 04 10:43:39 2009 +0100
    77.2 +++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Wed Mar 04 10:45:52 2009 +0100
    77.3 @@ -1,6 +1,5 @@
    77.4  (*
    77.5    Title:     Univariate Polynomials
    77.6 -  Id:        $Id$
    77.7    Author:    Clemens Ballarin, started 9 December 1996
    77.8    Copyright: Clemens Ballarin
    77.9  *)
   77.10 @@ -388,7 +387,7 @@
   77.11    proof (cases k)
   77.12      case 0 then show ?thesis by simp ring
   77.13    next
   77.14 -    case Suc then show ?thesis by (simp add: algebra_simps) ring
   77.15 +    case Suc then show ?thesis by simp (ring, simp)
   77.16    qed
   77.17    then show "coeff (monom a 0 * p) k = coeff (a *s p) k" by ring
   77.18  qed
    78.1 --- a/src/HOL/Arith_Tools.thy	Wed Mar 04 10:43:39 2009 +0100
    78.2 +++ b/src/HOL/Arith_Tools.thy	Wed Mar 04 10:45:52 2009 +0100
    78.3 @@ -68,8 +68,9 @@
    78.4  apply (subst add_eq_if)
    78.5  apply (simp split add: nat.split
    78.6              del: nat_numeral_1_eq_1
    78.7 -            add: numeral_1_eq_Suc_0 [symmetric] Let_def
    78.8 -                 neg_imp_number_of_eq_0 neg_number_of_pred_iff_0)
    78.9 +            add: nat_numeral_1_eq_1 [symmetric]
   78.10 +                 numeral_1_eq_Suc_0 [symmetric]
   78.11 +                 neg_number_of_pred_iff_0)
   78.12  done
   78.13  
   78.14  lemma nat_rec_number_of [simp]:
   78.15 @@ -89,7 +90,8 @@
   78.16  apply (subst add_eq_if)
   78.17  apply (simp split add: nat.split
   78.18              del: nat_numeral_1_eq_1
   78.19 -            add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
   78.20 +            add: nat_numeral_1_eq_1 [symmetric]
   78.21 +                 numeral_1_eq_Suc_0 [symmetric]
   78.22                   neg_number_of_pred_iff_0)
   78.23  done
   78.24  
    79.1 --- a/src/HOL/Complex_Main.thy	Wed Mar 04 10:43:39 2009 +0100
    79.2 +++ b/src/HOL/Complex_Main.thy	Wed Mar 04 10:45:52 2009 +0100
    79.3 @@ -9,7 +9,6 @@
    79.4    Ln
    79.5    Taylor
    79.6    Integration
    79.7 -  FrechetDeriv
    79.8  begin
    79.9  
   79.10  end
    80.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Wed Mar 04 10:43:39 2009 +0100
    80.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Wed Mar 04 10:45:52 2009 +0100
    80.3 @@ -1,7 +1,9 @@
    80.4 -(* Title:     HOL/Reflection/Approximation.thy
    80.5 - * Author:    Johannes Hölzl <hoelzl@in.tum.de> 2008 / 2009
    80.6 - *)
    80.7 +(*  Title:      HOL/Reflection/Approximation.thy
    80.8 +    Author:     Johannes Hoelzl <hoelzl@in.tum.de> 2008 / 2009
    80.9 +*)
   80.10 +
   80.11  header {* Prove unequations about real numbers by computation *}
   80.12 +
   80.13  theory Approximation
   80.14  imports Complex_Main Float Reflection Dense_Linear_Order Efficient_Nat
   80.15  begin
    81.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Wed Mar 04 10:43:39 2009 +0100
    81.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Wed Mar 04 10:45:52 2009 +0100
    81.3 @@ -620,7 +620,7 @@
    81.4    {assume "i=0" hence ?case using "12.hyps" by (simp add: dvd_def Let_def)}
    81.5    moreover 
    81.6    {assume i1: "abs i = 1"
    81.7 -      from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
    81.8 +      from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
    81.9        have ?case using i1 apply (cases "i=0", simp_all add: Let_def) 
   81.10  	by (cases "i > 0", simp_all)}
   81.11    moreover   
   81.12 @@ -640,7 +640,7 @@
   81.13    {assume "i=0" hence ?case using "13.hyps" by (simp add: dvd_def Let_def)}
   81.14    moreover 
   81.15    {assume i1: "abs i = 1"
   81.16 -      from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
   81.17 +      from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
   81.18        have ?case using i1 apply (cases "i=0", simp_all add: Let_def)
   81.19        apply (cases "i > 0", simp_all) done}
   81.20    moreover   
   81.21 @@ -990,7 +990,7 @@
   81.22    have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
   81.23    moreover
   81.24    {assume "j=0" hence z: "zlfm (Dvd j a) = (zlfm (Eq a))" by (simp add: Let_def) 
   81.25 -    hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
   81.26 +    hence ?case using prems by (simp del: zlfm.simps)}
   81.27    moreover
   81.28    {assume "?c=0" and "j\<noteq>0" hence ?case 
   81.29        using zsplit0_I[OF spl, where x="i" and bs="bs"]
   81.30 @@ -1005,7 +1005,7 @@
   81.31    moreover
   81.32    {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))" 
   81.33        by (simp add: nb Let_def split_def)
   81.34 -    hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
   81.35 +    hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r" ]
   81.36        by (simp add: Let_def split_def) }
   81.37    ultimately show ?case by blast
   81.38  next
   81.39 @@ -1019,7 +1019,7 @@
   81.40    have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
   81.41    moreover
   81.42    {assume "j=0" hence z: "zlfm (NDvd j a) = (zlfm (NEq a))" by (simp add: Let_def) 
   81.43 -    hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
   81.44 +    hence ?case using prems by (simp del: zlfm.simps)}
   81.45    moreover
   81.46    {assume "?c=0" and "j\<noteq>0" hence ?case 
   81.47        using zsplit0_I[OF spl, where x="i" and bs="bs"]
   81.48 @@ -1034,7 +1034,7 @@
   81.49    moreover
   81.50    {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))" 
   81.51        by (simp add: nb Let_def split_def)
   81.52 -    hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
   81.53 +    hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r"]
   81.54        by (simp add: Let_def split_def)}
   81.55    ultimately show ?case by blast
   81.56  qed auto
   81.57 @@ -1092,10 +1092,10 @@
   81.58    using lin ad d
   81.59  proof(induct p rule: iszlfm.induct)
   81.60    case (9 i c e)  thus ?case using d
   81.61 -    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
   81.62 +    by (simp add: dvd_trans[of "i" "d" "d'"])
   81.63  next
   81.64    case (10 i c e) thus ?case using d
   81.65 -    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
   81.66 +    by (simp add: dvd_trans[of "i" "d" "d'"])
   81.67  qed simp_all
   81.68  
   81.69  lemma \<delta> : assumes lin:"iszlfm p"
   81.70 @@ -1354,7 +1354,7 @@
   81.71    case (9 j c e) hence nb: "numbound0 e" by simp
   81.72    have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
   81.73      also have "\<dots> = (j dvd (- (c*x - ?e)))"
   81.74 -    by (simp only: zdvd_zminus_iff)
   81.75 +    by (simp only: dvd_minus_iff)
   81.76    also have "\<dots> = (j dvd (c* (- x)) + ?e)"
   81.77      apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
   81.78      by (simp add: algebra_simps)
   81.79 @@ -1366,7 +1366,7 @@
   81.80      case (10 j c e) hence nb: "numbound0 e" by simp
   81.81    have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
   81.82      also have "\<dots> = (j dvd (- (c*x - ?e)))"
   81.83 -    by (simp only: zdvd_zminus_iff)
   81.84 +    by (simp only: dvd_minus_iff)
   81.85    also have "\<dots> = (j dvd (c* (- x)) + ?e)"
   81.86      apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
   81.87      by (simp add: algebra_simps)
   81.88 @@ -1392,7 +1392,7 @@
   81.89    and dr: "d\<beta> p l"
   81.90    and d: "l dvd l'"
   81.91    shows "d\<beta> p l'"
   81.92 -using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
   81.93 +using dr linp dvd_trans[of _ "l" "l'", simplified d]
   81.94  by (induct p rule: iszlfm.induct) simp_all
   81.95  
   81.96  lemma \<alpha>_l: assumes lp: "iszlfm p"
   81.97 @@ -1431,7 +1431,7 @@
   81.98        by (simp add: zdiv_mono1[OF clel cp])
   81.99      then have ldcp:"0 < l div c" 
  81.100        by (simp add: zdiv_self[OF cnz])
  81.101 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.102 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.103      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.104        by simp
  81.105      hence "(l*x + (l div c) * Inum (x # bs) e < 0) =
  81.106 @@ -1449,7 +1449,7 @@
  81.107        by (simp add: zdiv_mono1[OF clel cp])
  81.108      then have ldcp:"0 < l div c" 
  81.109        by (simp add: zdiv_self[OF cnz])
  81.110 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.111 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.112      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.113        by simp
  81.114      hence "(l*x + (l div c) * Inum (x# bs) e \<le> 0) =
  81.115 @@ -1467,7 +1467,7 @@
  81.116        by (simp add: zdiv_mono1[OF clel cp])
  81.117      then have ldcp:"0 < l div c" 
  81.118        by (simp add: zdiv_self[OF cnz])
  81.119 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.120 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.121      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.122        by simp
  81.123      hence "(l*x + (l div c)* Inum (x # bs) e > 0) =
  81.124 @@ -1485,7 +1485,7 @@
  81.125        by (simp add: zdiv_mono1[OF clel cp])
  81.126      then have ldcp:"0 < l div c" 
  81.127        by (simp add: zdiv_self[OF cnz])
  81.128 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.129 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.130      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.131        by simp
  81.132      hence "(l*x + (l div c)* Inum (x # bs) e \<ge> 0) =
  81.133 @@ -1505,7 +1505,7 @@
  81.134        by (simp add: zdiv_mono1[OF clel cp])
  81.135      then have ldcp:"0 < l div c" 
  81.136        by (simp add: zdiv_self[OF cnz])
  81.137 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.138 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.139      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.140        by simp
  81.141      hence "(l * x + (l div c) * Inum (x # bs) e = 0) =
  81.142 @@ -1523,7 +1523,7 @@
  81.143        by (simp add: zdiv_mono1[OF clel cp])
  81.144      then have ldcp:"0 < l div c" 
  81.145        by (simp add: zdiv_self[OF cnz])
  81.146 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.147 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.148      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.149        by simp
  81.150      hence "(l * x + (l div c) * Inum (x # bs) e \<noteq> 0) =
  81.151 @@ -1541,7 +1541,7 @@
  81.152        by (simp add: zdiv_mono1[OF clel cp])
  81.153      then have ldcp:"0 < l div c" 
  81.154        by (simp add: zdiv_self[OF cnz])
  81.155 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.156 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.157      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.158        by simp
  81.159      hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)"  by simp
  81.160 @@ -1558,7 +1558,7 @@
  81.161        by (simp add: zdiv_mono1[OF clel cp])
  81.162      then have ldcp:"0 < l div c" 
  81.163        by (simp add: zdiv_self[OF cnz])
  81.164 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  81.165 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  81.166      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  81.167        by simp
  81.168      hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)"  by simp
    82.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Wed Mar 04 10:43:39 2009 +0100
    82.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Wed Mar 04 10:45:52 2009 +0100
    82.3 @@ -501,9 +501,9 @@
    82.4    assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
    82.5    shows "dvdnumcoeff t g"
    82.6    using dgt' gdg 
    82.7 -  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
    82.8 +  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
    82.9  
   82.10 -declare zdvd_trans [trans add]
   82.11 +declare dvd_trans [trans add]
   82.12  
   82.13  lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
   82.14  by arith
    83.1 --- a/src/HOL/Decision_Procs/MIR.thy	Wed Mar 04 10:43:39 2009 +0100
    83.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Wed Mar 04 10:45:52 2009 +0100
    83.3 @@ -83,7 +83,7 @@
    83.4    have "real (floor x) \<le> x" by simp 
    83.5    hence "real (floor x) < real (n + 1) " using ub by arith
    83.6    hence "floor x < n+1" by simp
    83.7 -  moreover from lb have "n \<le> floor x" using floor_mono2[where x="real n" and y="x"] 
    83.8 +  moreover from lb have "n \<le> floor x" using floor_mono[where x="real n" and y="x"] 
    83.9      by simp ultimately show "floor x = n" by simp
   83.10  qed
   83.11  
   83.12 @@ -132,13 +132,13 @@
   83.13    assume d: "real d rdvd t"
   83.14    from d int_rdvd_real have d2: "d dvd (floor t)" and ti: "real (floor t) = t" by auto
   83.15  
   83.16 -  from iffD2[OF zdvd_abs1] d2 have "(abs d) dvd (floor t)" by blast
   83.17 +  from iffD2[OF abs_dvd_iff] d2 have "(abs d) dvd (floor t)" by blast
   83.18    with ti int_rdvd_real[symmetric] have "real (abs d) rdvd t" by blast 
   83.19    thus "abs (real d) rdvd t" by simp
   83.20  next
   83.21    assume "abs (real d) rdvd t" hence "real (abs d) rdvd t" by simp
   83.22    with int_rdvd_real[where i="abs d" and x="t"] have d2: "abs d dvd floor t" and ti: "real (floor t) =t" by auto
   83.23 -  from iffD1[OF zdvd_abs1] d2 have "d dvd floor t" by blast
   83.24 +  from iffD1[OF abs_dvd_iff] d2 have "d dvd floor t" by blast
   83.25    with ti int_rdvd_real[symmetric] show "real d rdvd t" by blast
   83.26  qed
   83.27  
   83.28 @@ -675,9 +675,9 @@
   83.29    assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
   83.30    shows "dvdnumcoeff t g"
   83.31    using dgt' gdg 
   83.32 -  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
   83.33 -
   83.34 -declare zdvd_trans [trans add]
   83.35 +  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
   83.36 +
   83.37 +declare dvd_trans [trans add]
   83.38  
   83.39  lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
   83.40  by arith
   83.41 @@ -1775,11 +1775,11 @@
   83.42    "(real (a::int) \<le> b) = (a \<le> floor b \<or> (a = floor b \<and> real (floor b) < b))"
   83.43  proof( auto)
   83.44    assume alb: "real a \<le> b" and agb: "\<not> a \<le> floor b"
   83.45 -  from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono2) 
   83.46 +  from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono) 
   83.47    hence "a \<le> floor b" by simp with agb show "False" by simp
   83.48  next
   83.49    assume alb: "a \<le> floor b"
   83.50 -  hence "real a \<le> real (floor b)" by (simp only: floor_mono2)
   83.51 +  hence "real a \<le> real (floor b)" by (simp only: floor_mono)
   83.52    also have "\<dots>\<le> b" by simp  finally show  "real a \<le> b" . 
   83.53  qed
   83.54  
   83.55 @@ -2114,10 +2114,10 @@
   83.56    using lin ad d
   83.57  proof(induct p rule: iszlfm.induct)
   83.58    case (9 i c e)  thus ?case using d
   83.59 -    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
   83.60 +    by (simp add: dvd_trans[of "i" "d" "d'"])
   83.61  next
   83.62    case (10 i c e) thus ?case using d
   83.63 -    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
   83.64 +    by (simp add: dvd_trans[of "i" "d" "d'"])
   83.65  qed simp_all
   83.66  
   83.67  lemma \<delta> : assumes lin:"iszlfm p bs"
   83.68 @@ -2496,7 +2496,7 @@
   83.69    and dr: "d\<beta> p l"
   83.70    and d: "l dvd l'"
   83.71    shows "d\<beta> p l'"
   83.72 -using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
   83.73 +using dr linp dvd_trans[of _ "l" "l'", simplified d]
   83.74  by (induct p rule: iszlfm.induct) simp_all
   83.75  
   83.76  lemma \<alpha>_l: assumes lp: "iszlfm p (a#bs)"
   83.77 @@ -2535,7 +2535,7 @@
   83.78        by (simp add: zdiv_mono1[OF clel cp])
   83.79      then have ldcp:"0 < l div c" 
   83.80        by (simp add: zdiv_self[OF cnz])
   83.81 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
   83.82 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
   83.83      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
   83.84        by simp
   83.85      hence "(real l * real x + real (l div c) * Inum (real x # bs) e < (0\<Colon>real)) =
   83.86 @@ -2553,7 +2553,7 @@
   83.87        by (simp add: zdiv_mono1[OF clel cp])
   83.88      then have ldcp:"0 < l div c" 
   83.89        by (simp add: zdiv_self[OF cnz])
   83.90 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
   83.91 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
   83.92      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
   83.93        by simp
   83.94      hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<le> (0\<Colon>real)) =
   83.95 @@ -2571,7 +2571,7 @@
   83.96        by (simp add: zdiv_mono1[OF clel cp])
   83.97      then have ldcp:"0 < l div c" 
   83.98        by (simp add: zdiv_self[OF cnz])
   83.99 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.100 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.101      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.102        by simp
  83.103      hence "(real l * real x + real (l div c) * Inum (real x # bs) e > (0\<Colon>real)) =
  83.104 @@ -2589,7 +2589,7 @@
  83.105        by (simp add: zdiv_mono1[OF clel cp])
  83.106      then have ldcp:"0 < l div c" 
  83.107        by (simp add: zdiv_self[OF cnz])
  83.108 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.109 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.110      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.111        by simp
  83.112      hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<ge> (0\<Colon>real)) =
  83.113 @@ -2607,7 +2607,7 @@
  83.114        by (simp add: zdiv_mono1[OF clel cp])
  83.115      then have ldcp:"0 < l div c" 
  83.116        by (simp add: zdiv_self[OF cnz])
  83.117 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.118 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.119      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.120        by simp
  83.121      hence "(real l * real x + real (l div c) * Inum (real x # bs) e = (0\<Colon>real)) =
  83.122 @@ -2625,7 +2625,7 @@
  83.123        by (simp add: zdiv_mono1[OF clel cp])
  83.124      then have ldcp:"0 < l div c" 
  83.125        by (simp add: zdiv_self[OF cnz])
  83.126 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.127 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.128      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.129        by simp
  83.130      hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<noteq> (0\<Colon>real)) =
  83.131 @@ -2643,7 +2643,7 @@
  83.132        by (simp add: zdiv_mono1[OF clel cp])
  83.133      then have ldcp:"0 < l div c" 
  83.134        by (simp add: zdiv_self[OF cnz])
  83.135 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.136 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.137      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.138        by simp
  83.139      hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)"  by simp
  83.140 @@ -2660,7 +2660,7 @@
  83.141        by (simp add: zdiv_mono1[OF clel cp])
  83.142      then have ldcp:"0 < l div c" 
  83.143        by (simp add: zdiv_self[OF cnz])
  83.144 -    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
  83.145 +    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
  83.146      hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
  83.147        by simp
  83.148      hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)"  by simp
  83.149 @@ -3697,7 +3697,7 @@
  83.150    assumes xb: "real m \<le> x \<and> x < real ((n::int) + 1)"
  83.151    shows "\<exists> j\<in> {m.. n}. real j \<le> x \<and> x < real (j+1)" (is "\<exists> j\<in> ?N. ?P j")
  83.152  by (rule bexI[where P="?P" and x="floor x" and A="?N"]) 
  83.153 -(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono2[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
  83.154 +(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
  83.155  
  83.156  lemma rsplit0_complete:
  83.157    assumes xp:"0 \<le> x" and x1:"x < 1"
  83.158 @@ -5926,7 +5926,7 @@
  83.159  apply mir
  83.160  done
  83.161  
  83.162 -lemma "ALL x y. \<lfloor>x\<rfloor> = \<lfloor>y\<rfloor> \<longrightarrow> 0 \<le> abs (y - x) \<and> abs (y - x) \<le> 1"
  83.163 +lemma "ALL (x::real) (y::real). \<lfloor>x\<rfloor> = \<lfloor>y\<rfloor> \<longrightarrow> 0 \<le> abs (y - x) \<and> abs (y - x) \<le> 1"
  83.164  apply mir
  83.165  done
  83.166  
    84.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Wed Mar 04 10:43:39 2009 +0100
    84.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Wed Mar 04 10:45:52 2009 +0100
    84.3 @@ -27,12 +27,9 @@
    84.4  val Suc_plus1 = @{thm Suc_plus1};
    84.5  val imp_le_cong = @{thm imp_le_cong};
    84.6  val conj_le_cong = @{thm conj_le_cong};
    84.7 -val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
    84.8 -val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
    84.9 -val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
   84.10 -val int_mod_add_eq = @{thm mod_add_eq} RS sym;
   84.11 -val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
   84.12 -val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
   84.13 +val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
   84.14 +val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
   84.15 +val mod_add_eq = @{thm mod_add_eq} RS sym;
   84.16  val nat_div_add_eq = @{thm div_add1_eq} RS sym;
   84.17  val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
   84.18  
   84.19 @@ -70,14 +67,13 @@
   84.20      val (t,np,nh) = prepare_for_linz q g
   84.21      (* Some simpsets for dealing with mod div abs and nat*)
   84.22      val mod_div_simpset = HOL_basic_ss 
   84.23 -			addsimps [refl,nat_mod_add_eq, nat_mod_add_left_eq, 
   84.24 -				  nat_mod_add_right_eq, int_mod_add_eq, 
   84.25 -				  int_mod_add_right_eq, int_mod_add_left_eq,
   84.26 +			addsimps [refl,mod_add_eq, mod_add_left_eq, 
   84.27 +				  mod_add_right_eq,
   84.28  				  nat_div_add_eq, int_div_add_eq,
   84.29  				  @{thm mod_self}, @{thm "zmod_self"},
   84.30  				  @{thm mod_by_0}, @{thm div_by_0},
   84.31  				  @{thm "zdiv_zero"}, @{thm "zmod_zero"}, @{thm "div_0"}, @{thm "mod_0"},
   84.32 -				  @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
   84.33 +				  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
   84.34  				  Suc_plus1]
   84.35  			addsimps @{thms add_ac}
   84.36  			addsimprocs [cancel_div_mod_proc]
    85.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Wed Mar 04 10:43:39 2009 +0100
    85.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Wed Mar 04 10:45:52 2009 +0100
    85.3 @@ -31,12 +31,8 @@
    85.4  val Suc_plus1 = @{thm Suc_plus1};
    85.5  val imp_le_cong = @{thm imp_le_cong};
    85.6  val conj_le_cong = @{thm conj_le_cong};
    85.7 -val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
    85.8 -val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
    85.9 -val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
   85.10 -val int_mod_add_eq = @{thm mod_add_eq} RS sym;
   85.11 -val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
   85.12 -val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
   85.13 +val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
   85.14 +val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
   85.15  val nat_div_add_eq = @{thm div_add1_eq} RS sym;
   85.16  val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
   85.17  val ZDIVISION_BY_ZERO_MOD = @{thm DIVISION_BY_ZERO} RS conjunct2;
    86.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Wed Mar 04 10:43:39 2009 +0100
    86.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Wed Mar 04 10:45:52 2009 +0100
    86.3 @@ -46,12 +46,9 @@
    86.4  val Suc_plus1 = @{thm "Suc_plus1"};
    86.5  val imp_le_cong = @{thm "imp_le_cong"};
    86.6  val conj_le_cong = @{thm "conj_le_cong"};
    86.7 -val nat_mod_add_eq = @{thm "mod_add1_eq"} RS sym;
    86.8 -val nat_mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
    86.9 -val nat_mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
   86.10 -val int_mod_add_eq = @{thm "mod_add_eq"} RS sym;
   86.11 -val int_mod_add_left_eq = @{thm "zmod_zadd_left_eq"} RS sym;
   86.12 -val int_mod_add_right_eq = @{thm "zmod_zadd_right_eq"} RS sym;
   86.13 +val mod_add_eq = @{thm "mod_add_eq"} RS sym;
   86.14 +val mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
   86.15 +val mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
   86.16  val nat_div_add_eq = @{thm "div_add1_eq"} RS sym;
   86.17  val int_div_add_eq = @{thm "zdiv_zadd1_eq"} RS sym;
   86.18  val ZDIVISION_BY_ZERO_MOD = @{thm "DIVISION_BY_ZERO"} RS conjunct2;
   86.19 @@ -96,10 +93,10 @@
   86.20      val (t,np,nh) = prepare_for_mir thy q g
   86.21      (* Some simpsets for dealing with mod div abs and nat*)
   86.22      val mod_div_simpset = HOL_basic_ss 
   86.23 -                        addsimps [refl,nat_mod_add_eq, 
   86.24 +                        addsimps [refl, mod_add_eq, 
   86.25                                    @{thm "mod_self"}, @{thm "zmod_self"},
   86.26                                    @{thm "zdiv_zero"},@{thm "zmod_zero"},@{thm "div_0"}, @{thm "mod_0"},
   86.27 -                                  @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
   86.28 +                                  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
   86.29                                    @{thm "Suc_plus1"}]
   86.30                          addsimps @{thms add_ac}
   86.31                          addsimprocs [cancel_div_mod_proc]
    87.1 --- a/src/HOL/Deriv.thy	Wed Mar 04 10:43:39 2009 +0100
    87.2 +++ b/src/HOL/Deriv.thy	Wed Mar 04 10:45:52 2009 +0100
    87.3 @@ -9,7 +9,7 @@
    87.4  header{* Differentiation *}
    87.5  
    87.6  theory Deriv
    87.7 -imports Lim Polynomial
    87.8 +imports Lim
    87.9  begin
   87.10  
   87.11  text{*Standard Definitions*}
   87.12 @@ -217,9 +217,7 @@
   87.13  by (cases "n", simp, simp add: DERIV_power_Suc f)
   87.14  
   87.15  
   87.16 -(* ------------------------------------------------------------------------ *)
   87.17 -(* Caratheodory formulation of derivative at a point: standard proof        *)
   87.18 -(* ------------------------------------------------------------------------ *)
   87.19 +text {* Caratheodory formulation of derivative at a point *}
   87.20  
   87.21  lemma CARAT_DERIV:
   87.22       "(DERIV f x :> l) =
   87.23 @@ -307,6 +305,9 @@
   87.24         ==> DERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / (g(x) ^ Suc (Suc 0))"
   87.25  by (drule (2) DERIV_divide) (simp add: mult_commute power_Suc)
   87.26  
   87.27 +lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
   87.28 +by auto
   87.29 +
   87.30  
   87.31  subsection {* Differentiability predicate *}
   87.32  
   87.33 @@ -655,6 +656,9 @@
   87.34  apply (blast intro: IVT2)
   87.35  done
   87.36  
   87.37 +
   87.38 +subsection {* Boundedness of continuous functions *}
   87.39 +
   87.40  text{*By bisection, function continuous on closed interval is bounded above*}
   87.41  
   87.42  lemma isCont_bounded:
   87.43 @@ -773,6 +777,8 @@
   87.44  done
   87.45  
   87.46  
   87.47 +subsection {* Local extrema *}
   87.48 +
   87.49  text{*If @{term "0 < f'(x)"} then @{term x} is Locally Strictly Increasing At The Right*}
   87.50  
   87.51  lemma DERIV_left_inc:
   87.52 @@ -877,6 +883,9 @@
   87.53    shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) = f(y) |] ==> l = 0"
   87.54  by (auto dest!: DERIV_local_max)
   87.55  
   87.56 +
   87.57 +subsection {* Rolle's Theorem *}
   87.58 +
   87.59  text{*Lemma about introducing open ball in open interval*}
   87.60  lemma lemma_interval_lt:
   87.61       "[| a < x;  x < b |]
   87.62 @@ -1163,6 +1172,8 @@
   87.63  qed
   87.64  
   87.65  
   87.66 +subsection {* Continuous injective functions *}
   87.67 +
   87.68  text{*Dull lemma: an continuous injection on an interval must have a
   87.69  strict maximum at an end point, not in the middle.*}
   87.70  
   87.71 @@ -1356,6 +1367,9 @@
   87.72      using neq by (rule LIM_inverse)
   87.73  qed
   87.74  
   87.75 +
   87.76 +subsection {* Generalized Mean Value Theorem *}
   87.77 +
   87.78  theorem GMVT:
   87.79    fixes a b :: real
   87.80    assumes alb: "a < b"
   87.81 @@ -1442,245 +1456,6 @@
   87.82    with g'cdef f'cdef cint show ?thesis by auto
   87.83  qed
   87.84  
   87.85 -lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
   87.86 -by auto
   87.87 -
   87.88 -
   87.89 -subsection {* Derivatives of univariate polynomials *}
   87.90 -
   87.91 -definition
   87.92 -  pderiv :: "'a::real_normed_field poly \<Rightarrow> 'a poly" where
   87.93 -  "pderiv = poly_rec 0 (\<lambda>a p p'. p + pCons 0 p')"
   87.94 -
   87.95 -lemma pderiv_0 [simp]: "pderiv 0 = 0"
   87.96 -  unfolding pderiv_def by (simp add: poly_rec_0)
   87.97 -
   87.98 -lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
   87.99 -  unfolding pderiv_def by (simp add: poly_rec_pCons)
  87.100 -
  87.101 -lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
  87.102 -  apply (induct p arbitrary: n, simp)
  87.103 -  apply (simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
  87.104 -  done
  87.105 -
  87.106 -lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
  87.107 -  apply (rule iffI)
  87.108 -  apply (cases p, simp)
  87.109 -  apply (simp add: expand_poly_eq coeff_pderiv del: of_nat_Suc)
  87.110 -  apply (simp add: expand_poly_eq coeff_pderiv coeff_eq_0)
  87.111 -  done
  87.112 -
  87.113 -lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
  87.114 -  apply (rule order_antisym [OF degree_le])
  87.115 -  apply (simp add: coeff_pderiv coeff_eq_0)
  87.116 -  apply (cases "degree p", simp)
  87.117 -  apply (rule le_degree)
  87.118 -  apply (simp add: coeff_pderiv del: of_nat_Suc)
  87.119 -  apply (rule subst, assumption)
  87.120 -  apply (rule leading_coeff_neq_0, clarsimp)
  87.121 -  done
  87.122 -
  87.123 -lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
  87.124 -by (simp add: pderiv_pCons)
  87.125 -
  87.126 -lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
  87.127 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
  87.128 -
  87.129 -lemma pderiv_minus: "pderiv (- p) = - pderiv p"
  87.130 -by (rule poly_ext, simp add: coeff_pderiv)
  87.131 -
  87.132 -lemma pderiv_diff: "pderiv (p - q) = pderiv p - pderiv q"
  87.133 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
  87.134 -
  87.135 -lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
  87.136 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
  87.137 -
  87.138 -lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
  87.139 -apply (induct p)
  87.140 -apply simp
  87.141 -apply (simp add: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
  87.142 -done
  87.143 -
  87.144 -lemma pderiv_power_Suc:
  87.145 -  "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
  87.146 -apply (induct n)
  87.147 -apply simp
  87.148 -apply (subst power_Suc)
  87.149 -apply (subst pderiv_mult)
  87.150 -apply (erule ssubst)
  87.151 -apply (simp add: smult_add_left algebra_simps)
  87.152 -done
  87.153 -
  87.154 -lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
  87.155 -by (simp add: DERIV_cmult mult_commute [of _ c])
  87.156 -
  87.157 -lemma DERIV_pow2: "DERIV (%x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
  87.158 -by (rule lemma_DERIV_subst, rule DERIV_pow, simp)
  87.159 -declare DERIV_pow2 [simp] DERIV_pow [simp]
  87.160 -
  87.161 -lemma DERIV_add_const: "DERIV f x :> D ==>  DERIV (%x. a + f x :: 'a::real_normed_field) x :> D"
  87.162 -by (rule lemma_DERIV_subst, rule DERIV_add, auto)
  87.163 -
  87.164 -lemma poly_DERIV[simp]: "DERIV (%x. poly p x) x :> poly (pderiv p) x"
  87.165 -apply (induct p)
  87.166 -apply simp
  87.167 -apply (simp add: pderiv_pCons)
  87.168 -apply (rule lemma_DERIV_subst)
  87.169 -apply (rule DERIV_add DERIV_mult DERIV_const DERIV_ident | assumption)+
  87.170 -apply simp
  87.171 -done
  87.172 -
  87.173 -text{* Consequences of the derivative theorem above*}
  87.174 -
  87.175 -lemma poly_differentiable[simp]: "(%x. poly p x) differentiable (x::real)"
  87.176 -apply (simp add: differentiable_def)
  87.177 -apply (blast intro: poly_DERIV)
  87.178 -done
  87.179 -
  87.180 -lemma poly_isCont[simp]: "isCont (%x. poly p x) (x::real)"
  87.181 -by (rule poly_DERIV [THEN DERIV_isCont])
  87.182 -
  87.183 -lemma poly_IVT_pos: "[| a < b; poly p (a::real) < 0; 0 < poly p b |]
  87.184 -      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
  87.185 -apply (cut_tac f = "%x. poly p x" and a = a and b = b and y = 0 in IVT_objl)
  87.186 -apply (auto simp add: order_le_less)
  87.187 -done
  87.188 -
  87.189 -lemma poly_IVT_neg: "[| (a::real) < b; 0 < poly p a; poly p b < 0 |]
  87.190 -      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
  87.191 -by (insert poly_IVT_pos [where p = "- p" ]) simp
  87.192 -
  87.193 -lemma poly_MVT: "(a::real) < b ==>
  87.194 -     \<exists>x. a < x & x < b & (poly p b - poly p a = (b - a) * poly (pderiv p) x)"
  87.195 -apply (drule_tac f = "poly p" in MVT, auto)
  87.196 -apply (rule_tac x = z in exI)
  87.197 -apply (auto simp add: real_mult_left_cancel poly_DERIV [THEN DERIV_unique])
  87.198 -done
  87.199 -
  87.200 -text{*Lemmas for Derivatives*}
  87.201 -
  87.202 -(* FIXME
  87.203 -lemma lemma_order_pderiv [rule_format]:
  87.204 -     "\<forall>p q a. 0 < n &
  87.205 -       poly (pderiv p) \<noteq> poly [] &
  87.206 -       poly p = poly ([- a, 1] %^ n *** q) & ~ [- a, 1] divides q
  87.207 -       --> n = Suc (order a (pderiv p))"
  87.208 -apply (induct "n", safe)
  87.209 -apply (rule order_unique_lemma, rule conjI, assumption)
  87.210 -apply (subgoal_tac "\<forall>r. r divides (pderiv p) = r divides (pderiv ([-a, 1] %^ Suc n *** q))")
  87.211 -apply (drule_tac [2] poly_pderiv_welldef)
  87.212 - prefer 2 apply (simp add: divides_def del: pmult_Cons pexp_Suc) 
  87.213 -apply (simp del: pmult_Cons pexp_Suc) 
  87.214 -apply (rule conjI)
  87.215 -apply (simp add: divides_def fun_eq del: pmult_Cons pexp_Suc)
  87.216 -apply (rule_tac x = "[-a, 1] *** (pderiv q) +++ real (Suc n) %* q" in exI)
  87.217 -apply (simp add: poly_pderiv_mult poly_pderiv_exp_prime poly_add poly_mult poly_cmult right_distrib mult_ac del: pmult_Cons pexp_Suc)
  87.218 -apply (simp add: poly_mult right_distrib left_distrib mult_ac del: pmult_Cons)
  87.219 -apply (erule_tac V = "\<forall>r. r divides pderiv p = r divides pderiv ([- a, 1] %^ Suc n *** q)" in thin_rl)
  87.220 -apply (unfold divides_def)
  87.221 -apply (simp (no_asm) add: poly_pderiv_mult poly_pderiv_exp_prime fun_eq poly_add poly_mult del: pmult_Cons pexp_Suc)
  87.222 -apply (rule contrapos_np, assumption)
  87.223 -apply (rotate_tac 3, erule contrapos_np)
  87.224 -apply (simp del: pmult_Cons pexp_Suc, safe)
  87.225 -apply (rule_tac x = "inverse (real (Suc n)) %* (qa +++ -- (pderiv q))" in exI)
  87.226 -apply (subgoal_tac "poly ([-a, 1] %^ n *** q) = poly ([-a, 1] %^ n *** ([-a, 1] *** (inverse (real (Suc n)) %* (qa +++ -- (pderiv q))))) ")
  87.227 -apply (drule poly_mult_left_cancel [THEN iffD1], simp)
  87.228 -apply (simp add: fun_eq poly_mult poly_add poly_cmult poly_minus del: pmult_Cons mult_cancel_left, safe)
  87.229 -apply (rule_tac c1 = "real (Suc n)" in real_mult_left_cancel [THEN iffD1])
  87.230 -apply (simp (no_asm))
  87.231 -apply (subgoal_tac "real (Suc n) * (poly ([- a, 1] %^ n) xa * poly q xa) =
  87.232 -          (poly qa xa + - poly (pderiv q) xa) *
  87.233 -          (poly ([- a, 1] %^ n) xa *
  87.234 -           ((- a + xa) * (inverse (real (Suc n)) * real (Suc n))))")
  87.235 -apply (simp only: mult_ac)  
  87.236 -apply (rotate_tac 2)
  87.237 -apply (drule_tac x = xa in spec)
  87.238 -apply (simp add: left_distrib mult_ac del: pmult_Cons)
  87.239 -done
  87.240 -
  87.241 -lemma order_pderiv: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
  87.242 -      ==> (order a p = Suc (order a (pderiv p)))"
  87.243 -apply (case_tac "poly p = poly []")
  87.244 -apply (auto dest: pderiv_zero)
  87.245 -apply (drule_tac a = a and p = p in order_decomp)
  87.246 -using neq0_conv
  87.247 -apply (blast intro: lemma_order_pderiv)
  87.248 -done
  87.249 -
  87.250 -text{*Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *}
  87.251 -
  87.252 -lemma poly_squarefree_decomp_order: "[| poly (pderiv p) \<noteq> poly [];
  87.253 -         poly p = poly (q *** d);
  87.254 -         poly (pderiv p) = poly (e *** d);
  87.255 -         poly d = poly (r *** p +++ s *** pderiv p)
  87.256 -      |] ==> order a q = (if order a p = 0 then 0 else 1)"
  87.257 -apply (subgoal_tac "order a p = order a q + order a d")
  87.258 -apply (rule_tac [2] s = "order a (q *** d)" in trans)
  87.259 -prefer 2 apply (blast intro: order_poly)
  87.260 -apply (rule_tac [2] order_mult)
  87.261 - prefer 2 apply force
  87.262 -apply (case_tac "order a p = 0", simp)
  87.263 -apply (subgoal_tac "order a (pderiv p) = order a e + order a d")
  87.264 -apply (rule_tac [2] s = "order a (e *** d)" in trans)
  87.265 -prefer 2 apply (blast intro: order_poly)
  87.266 -apply (rule_tac [2] order_mult)
  87.267 - prefer 2 apply force
  87.268 -apply (case_tac "poly p = poly []")
  87.269 -apply (drule_tac p = p in pderiv_zero, simp)
  87.270 -apply (drule order_pderiv, assumption)
  87.271 -apply (subgoal_tac "order a (pderiv p) \<le> order a d")
  87.272 -apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides d")
  87.273 - prefer 2 apply (simp add: poly_entire order_divides)
  87.274 -apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides p & ([-a, 1] %^ (order a (pderiv p))) divides (pderiv p) ")
  87.275 - prefer 3 apply (simp add: order_divides)
  87.276 - prefer 2 apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe)
  87.277 -apply (rule_tac x = "r *** qa +++ s *** qaa" in exI)
  87.278 -apply (simp add: fun_eq poly_add poly_mult left_distrib right_distrib mult_ac del: pexp_Suc pmult_Cons, auto)
  87.279 -done
  87.280 -
  87.281 -
  87.282 -lemma poly_squarefree_decomp_order2: "[| poly (pderiv p) \<noteq> poly [];
  87.283 -         poly p = poly (q *** d);
  87.284 -         poly (pderiv p) = poly (e *** d);
  87.285 -         poly d = poly (r *** p +++ s *** pderiv p)
  87.286 -      |] ==> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
  87.287 -apply (blast intro: poly_squarefree_decomp_order)
  87.288 -done
  87.289 -
  87.290 -lemma order_pderiv2: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
  87.291 -      ==> (order a (pderiv p) = n) = (order a p = Suc n)"
  87.292 -apply (auto dest: order_pderiv)
  87.293 -done
  87.294 -
  87.295 -lemma rsquarefree_roots:
  87.296 -  "rsquarefree p = (\<forall>a. ~(poly p a = 0 & poly (pderiv p) a = 0))"
  87.297 -apply (simp add: rsquarefree_def)
  87.298 -apply (case_tac "poly p = poly []", simp, simp)
  87.299 -apply (case_tac "poly (pderiv p) = poly []")
  87.300 -apply simp
  87.301 -apply (drule pderiv_iszero, clarify)
  87.302 -apply (subgoal_tac "\<forall>a. order a p = order a [h]")
  87.303 -apply (simp add: fun_eq)
  87.304 -apply (rule allI)
  87.305 -apply (cut_tac p = "[h]" and a = a in order_root)
  87.306 -apply (simp add: fun_eq)
  87.307 -apply (blast intro: order_poly)
  87.308 -apply (auto simp add: order_root order_pderiv2)
  87.309 -apply (erule_tac x="a" in allE, simp)
  87.310 -done
  87.311 -
  87.312 -lemma poly_squarefree_decomp: "[| poly (pderiv p) \<noteq> poly [];
  87.313 -         poly p = poly (q *** d);
  87.314 -         poly (pderiv p) = poly (e *** d);
  87.315 -         poly d = poly (r *** p +++ s *** pderiv p)
  87.316 -      |] ==> rsquarefree q & (\<forall>a. (poly q a = 0) = (poly p a = 0))"
  87.317 -apply (frule poly_squarefree_decomp_order2, assumption+) 
  87.318 -apply (case_tac "poly p = poly []")
  87.319 -apply (blast dest: pderiv_zero)
  87.320 -apply (simp (no_asm) add: rsquarefree_def order_root del: pmult_Cons)
  87.321 -apply (simp add: poly_entire del: pmult_Cons)
  87.322 -done
  87.323 -*)
  87.324  
  87.325  subsection {* Theorems about Limits *}
  87.326  
    88.1 --- a/src/HOL/Divides.thy	Wed Mar 04 10:43:39 2009 +0100
    88.2 +++ b/src/HOL/Divides.thy	Wed Mar 04 10:45:52 2009 +0100
    88.3 @@ -44,10 +44,10 @@
    88.4  by (simp add: mod_div_equality2)
    88.5  
    88.6  lemma mod_by_0 [simp]: "a mod 0 = a"
    88.7 -  using mod_div_equality [of a zero] by simp
    88.8 +using mod_div_equality [of a zero] by simp
    88.9  
   88.10  lemma mod_0 [simp]: "0 mod a = 0"
   88.11 -  using mod_div_equality [of zero a] div_0 by simp 
   88.12 +using mod_div_equality [of zero a] div_0 by simp
   88.13  
   88.14  lemma div_mult_self2 [simp]:
   88.15    assumes "b \<noteq> 0"
   88.16 @@ -178,6 +178,12 @@
   88.17  lemma dvd_div_mult_self: "a dvd b \<Longrightarrow> (b div a) * a = b"
   88.18  by (subst (2) mod_div_equality [of b a, symmetric]) (simp add:dvd_imp_mod_0)
   88.19  
   88.20 +lemma dvd_div_mult: "a dvd b \<Longrightarrow> (b div a) * c = b * c div a"
   88.21 +apply (cases "a = 0")
   88.22 + apply simp
   88.23 +apply (auto simp: dvd_def mult_assoc)
   88.24 +done
   88.25 +
   88.26  lemma div_dvd_div[simp]:
   88.27    "a dvd b \<Longrightarrow> a dvd c \<Longrightarrow> (b div a dvd c div a) = (b dvd c)"
   88.28  apply (cases "a = 0")
   88.29 @@ -188,6 +194,12 @@
   88.30  apply(fastsimp simp add: mult_assoc)
   88.31  done
   88.32  
   88.33 +lemma dvd_mod_imp_dvd: "[| k dvd m mod n;  k dvd n |] ==> k dvd m"
   88.34 +  apply (subgoal_tac "k dvd (m div n) *n + m mod n")
   88.35 +   apply (simp add: mod_div_equality)
   88.36 +  apply (simp only: dvd_add dvd_mult)
   88.37 +  done
   88.38 +
   88.39  text {* Addition respects modular equivalence. *}
   88.40  
   88.41  lemma mod_add_left_eq: "(a + b) mod c = (a mod c + b) mod c"
   88.42 @@ -330,6 +342,25 @@
   88.43    unfolding diff_minus using assms
   88.44    by (intro mod_add_cong mod_minus_cong)
   88.45  
   88.46 +lemma dvd_neg_div: "y dvd x \<Longrightarrow> -x div y = - (x div y)"
   88.47 +apply (case_tac "y = 0") apply simp
   88.48 +apply (auto simp add: dvd_def)
   88.49 +apply (subgoal_tac "-(y * k) = y * - k")
   88.50 + apply (erule ssubst)
   88.51 + apply (erule div_mult_self1_is_id)
   88.52 +apply simp
   88.53 +done
   88.54 +
   88.55 +lemma dvd_div_neg: "y dvd x \<Longrightarrow> x div -y = - (x div y)"
   88.56 +apply (case_tac "y = 0") apply simp
   88.57 +apply (auto simp add: dvd_def)
   88.58 +apply (subgoal_tac "y * k = -y * -k")
   88.59 + apply (erule ssubst)
   88.60 + apply (rule div_mult_self1_is_id)
   88.61 + apply simp
   88.62 +apply simp
   88.63 +done
   88.64 +
   88.65  end
   88.66  
   88.67  
   88.68 @@ -478,9 +509,9 @@
   88.69    from divmod_rel have divmod_m_n: "divmod_rel m n (m div n) (m mod n)" .
   88.70    with assms have m_div_n: "m div n \<ge> 1"
   88.71      by (cases "m div n") (auto simp add: divmod_rel_def)
   88.72 -  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - 1) (m mod n)"
   88.73 +  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0) (m mod n)"
   88.74      by (cases "m div n") (auto simp add: divmod_rel_def)
   88.75 -  with divmod_eq have "divmod (m - n) n = (m div n - 1, m mod n)" by simp
   88.76 +  with divmod_eq have "divmod (m - n) n = (m div n - Suc 0, m mod n)" by simp
   88.77    moreover from divmod_div_mod have "divmod (m - n) n = ((m - n) div n, (m - n) mod n)" .
   88.78    ultimately have "m div n = Suc ((m - n) div n)"
   88.79      and "m mod n = (m - n) mod n" using m_div_n by simp_all
   88.80 @@ -653,16 +684,6 @@
   88.81  apply (blast intro: divmod_rel [THEN divmod_rel_mult1_eq, THEN div_eq])
   88.82  done
   88.83  
   88.84 -lemma mod_mult1_eq: "(a*b) mod c = a*(b mod c) mod (c::nat)"
   88.85 -by (rule mod_mult_right_eq)
   88.86 -
   88.87 -lemma mod_mult1_eq': "(a*b) mod (c::nat) = ((a mod c) * b) mod c"
   88.88 -by (rule mod_mult_left_eq)
   88.89 -
   88.90 -lemma mod_mult_distrib_mod:
   88.91 -  "(a*b) mod (c::nat) = ((a mod c) * (b mod c)) mod c"
   88.92 -by (rule mod_mult_eq)
   88.93 -
   88.94  lemma divmod_rel_add1_eq:
   88.95    "[| divmod_rel a c aq ar; divmod_rel b c bq br;  c > 0 |]
   88.96     ==> divmod_rel (a + b) c (aq + bq + (ar+br) div c) ((ar + br) mod c)"
   88.97 @@ -675,9 +696,6 @@
   88.98  apply (blast intro: divmod_rel_add1_eq [THEN div_eq] divmod_rel)
   88.99  done
  88.100  
  88.101 -lemma mod_add1_eq: "(a+b) mod (c::nat) = (a mod c + b mod c) mod c"
  88.102 -by (rule mod_add_eq)
  88.103 -
  88.104  lemma mod_lemma: "[| (0::nat) < c; r < b |] ==> b * (q mod c) + r < b * c"
  88.105    apply (cut_tac m = q and n = c in mod_less_divisor)
  88.106    apply (drule_tac [2] m = "q mod c" in less_imp_Suc_add, auto)
  88.107 @@ -795,12 +813,6 @@
  88.108  apply (auto simp add: Suc_diff_le le_mod_geq)
  88.109  done
  88.110  
  88.111 -lemma nat_mod_div_trivial: "m mod n div n = (0 :: nat)"
  88.112 -by simp
  88.113 -
  88.114 -lemma nat_mod_mod_trivial: "m mod n mod n = (m mod n :: nat)"
  88.115 -by simp
  88.116 -
  88.117  
  88.118  subsubsection {* The Divides Relation *}
  88.119  
  88.120 @@ -810,6 +822,9 @@
  88.121  lemma dvd_1_iff_1 [simp]: "(m dvd Suc 0) = (m = Suc 0)"
  88.122  by (simp add: dvd_def)
  88.123  
  88.124 +lemma nat_dvd_1_iff_1 [simp]: "m dvd (1::nat) \<longleftrightarrow> m = 1"
  88.125 +by (simp add: dvd_def)
  88.126 +
  88.127  lemma dvd_anti_sym: "[| m dvd n; n dvd m |] ==> m = (n::nat)"
  88.128    unfolding dvd_def
  88.129    by (force dest: mult_eq_self_implies_10 simp add: mult_assoc mult_eq_1_iff)
  88.130 @@ -819,9 +834,9 @@
  88.131  interpretation dvd!: order "op dvd" "\<lambda>n m \<Colon> nat. n dvd m \<and> \<not> m dvd n"
  88.132    proof qed (auto intro: dvd_refl dvd_trans dvd_anti_sym)
  88.133  
  88.134 -lemma dvd_diff: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
  88.135 -  unfolding dvd_def
  88.136 -  by (blast intro: diff_mult_distrib2 [symmetric])
  88.137 +lemma nat_dvd_diff[simp]: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
  88.138 +unfolding dvd_def
  88.139 +by (blast intro: diff_mult_distrib2 [symmetric])
  88.140  
  88.141  lemma dvd_diffD: "[| k dvd m-n; k dvd n; n\<le>m |] ==> k dvd (m::nat)"
  88.142    apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
  88.143 @@ -829,7 +844,7 @@
  88.144    done
  88.145  
  88.146  lemma dvd_diffD1: "[| k dvd m-n; k dvd m; n\<le>m |] ==> k dvd (n::nat)"
  88.147 -by (drule_tac m = m in dvd_diff, auto)
  88.148 +by (drule_tac m = m in nat_dvd_diff, auto)
  88.149  
  88.150  lemma dvd_reduce: "(k dvd n + k) = (k dvd (n::nat))"
  88.151    apply (rule iffI)
  88.152 @@ -838,7 +853,7 @@
  88.153    apply (subgoal_tac "n = (n+k) -k")
  88.154     prefer 2 apply simp
  88.155    apply (erule ssubst)
  88.156 -  apply (erule dvd_diff)
  88.157 +  apply (erule nat_dvd_diff)
  88.158    apply (rule dvd_refl)
  88.159    done
  88.160  
  88.161 @@ -848,12 +863,6 @@
  88.162    apply (blast intro: mod_mult_distrib2 [symmetric])
  88.163    done
  88.164  
  88.165 -lemma dvd_mod_imp_dvd: "[| (k::nat) dvd m mod n;  k dvd n |] ==> k dvd m"
  88.166 -  apply (subgoal_tac "k dvd (m div n) *n + m mod n")
  88.167 -   apply (simp add: mod_div_equality)
  88.168 -  apply (simp only: dvd_add dvd_mult)
  88.169 -  done
  88.170 -
  88.171  lemma dvd_mod_iff: "k dvd n ==> ((k::nat) dvd m mod n) = (k dvd m)"
  88.172  by (blast intro: dvd_mod_imp_dvd dvd_mod)
  88.173  
  88.174 @@ -889,21 +898,9 @@
  88.175    apply (simp only: dvd_eq_mod_eq_0)
  88.176    done
  88.177  
  88.178 -lemma le_imp_power_dvd: "!!i::nat. m \<le> n ==> i^m dvd i^n"
  88.179 -  apply (unfold dvd_def)
  88.180 -  apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
  88.181 -  apply (simp add: power_add)
  88.182 -  done
  88.183 -
  88.184  lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
  88.185    by (induct n) auto
  88.186  
  88.187 -lemma power_le_dvd [rule_format]: "k^j dvd n --> i\<le>j --> k^i dvd (n::nat)"
  88.188 -  apply (induct j)
  88.189 -   apply (simp_all add: le_Suc_eq)
  88.190 -  apply (blast dest!: dvd_mult_right)
  88.191 -  done
  88.192 -
  88.193  lemma power_dvd_imp_le: "[|i^m dvd i^n;  (1::nat) < i|] ==> m \<le> n"
  88.194    apply (rule power_le_imp_le_exp, assumption)
  88.195    apply (erule dvd_imp_le, simp)
    89.1 --- a/src/HOL/Equiv_Relations.thy	Wed Mar 04 10:43:39 2009 +0100
    89.2 +++ b/src/HOL/Equiv_Relations.thy	Wed Mar 04 10:45:52 2009 +0100
    89.3 @@ -12,7 +12,7 @@
    89.4  
    89.5  locale equiv =
    89.6    fixes A and r
    89.7 -  assumes refl: "refl A r"
    89.8 +  assumes refl_on: "refl_on A r"
    89.9      and sym: "sym r"
   89.10      and trans: "trans r"
   89.11  
   89.12 @@ -27,21 +27,21 @@
   89.13      "sym r ==> trans r ==> r\<inverse> O r \<subseteq> r"
   89.14    by (unfold trans_def sym_def converse_def) blast
   89.15  
   89.16 -lemma refl_comp_subset: "refl A r ==> r \<subseteq> r\<inverse> O r"
   89.17 -  by (unfold refl_def) blast
   89.18 +lemma refl_on_comp_subset: "refl_on A r ==> r \<subseteq> r\<inverse> O r"
   89.19 +  by (unfold refl_on_def) blast
   89.20  
   89.21  lemma equiv_comp_eq: "equiv A r ==> r\<inverse> O r = r"
   89.22    apply (unfold equiv_def)
   89.23    apply clarify
   89.24    apply (rule equalityI)
   89.25 -   apply (iprover intro: sym_trans_comp_subset refl_comp_subset)+
   89.26 +   apply (iprover intro: sym_trans_comp_subset refl_on_comp_subset)+
   89.27    done
   89.28  
   89.29  text {* Second half. *}
   89.30  
   89.31  lemma comp_equivI:
   89.32      "r\<inverse> O r = r ==> Domain r = A ==> equiv A r"
   89.33 -  apply (unfold equiv_def refl_def sym_def trans_def)
   89.34 +  apply (unfold equiv_def refl_on_def sym_def trans_def)
   89.35    apply (erule equalityE)
   89.36    apply (subgoal_tac "\<forall>x y. (x, y) \<in> r --> (y, x) \<in> r")
   89.37     apply fast
   89.38 @@ -63,12 +63,12 @@
   89.39    done
   89.40  
   89.41  lemma equiv_class_self: "equiv A r ==> a \<in> A ==> a \<in> r``{a}"
   89.42 -  by (unfold equiv_def refl_def) blast
   89.43 +  by (unfold equiv_def refl_on_def) blast
   89.44  
   89.45  lemma subset_equiv_class:
   89.46      "equiv A r ==> r``{b} \<subseteq> r``{a} ==> b \<in> A ==> (a,b) \<in> r"
   89.47    -- {* lemma for the next result *}
   89.48 -  by (unfold equiv_def refl_def) blast
   89.49 +  by (unfold equiv_def refl_on_def) blast
   89.50  
   89.51  lemma eq_equiv_class:
   89.52      "r``{a} = r``{b} ==> equiv A r ==> b \<in> A ==> (a, b) \<in> r"
   89.53 @@ -79,7 +79,7 @@
   89.54    by (unfold equiv_def trans_def sym_def) blast
   89.55  
   89.56  lemma equiv_type: "equiv A r ==> r \<subseteq> A \<times> A"
   89.57 -  by (unfold equiv_def refl_def) blast
   89.58 +  by (unfold equiv_def refl_on_def) blast
   89.59  
   89.60  theorem equiv_class_eq_iff:
   89.61    "equiv A r ==> ((x, y) \<in> r) = (r``{x} = r``{y} & x \<in> A & y \<in> A)"
   89.62 @@ -103,7 +103,7 @@
   89.63    by (unfold quotient_def) blast
   89.64  
   89.65  lemma Union_quotient: "equiv A r ==> Union (A//r) = A"
   89.66 -  by (unfold equiv_def refl_def quotient_def) blast
   89.67 +  by (unfold equiv_def refl_on_def quotient_def) blast
   89.68  
   89.69  lemma quotient_disj:
   89.70    "equiv A r ==> X \<in> A//r ==> Y \<in> A//r ==> X = Y | (X \<inter> Y = {})"
   89.71 @@ -228,7 +228,7 @@
   89.72  
   89.73  lemma congruent2_implies_congruent:
   89.74      "equiv A r1 ==> congruent2 r1 r2 f ==> a \<in> A ==> congruent r2 (f a)"
   89.75 -  by (unfold congruent_def congruent2_def equiv_def refl_def) blast
   89.76 +  by (unfold congruent_def congruent2_def equiv_def refl_on_def) blast
   89.77  
   89.78  lemma congruent2_implies_congruent_UN:
   89.79    "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a \<in> A2 ==>
   89.80 @@ -237,7 +237,7 @@
   89.81    apply clarify
   89.82    apply (rule equiv_type [THEN subsetD, THEN SigmaE2], assumption+)
   89.83    apply (simp add: UN_equiv_class congruent2_implies_congruent)
   89.84 -  apply (unfold congruent2_def equiv_def refl_def)
   89.85 +  apply (unfold congruent2_def equiv_def refl_on_def)
   89.86    apply (blast del: equalityI)
   89.87    done
   89.88  
   89.89 @@ -272,7 +272,7 @@
   89.90      ==> congruent2 r1 r2 f"
   89.91    -- {* Suggested by John Harrison -- the two subproofs may be *}
   89.92    -- {* \emph{much} simpler than the direct proof. *}
   89.93 -  apply (unfold congruent2_def equiv_def refl_def)
   89.94 +  apply (unfold congruent2_def equiv_def refl_on_def)
   89.95    apply clarify
   89.96    apply (blast intro: trans)
   89.97    done
    90.1 --- a/src/HOL/Extraction/Euclid.thy	Wed Mar 04 10:43:39 2009 +0100
    90.2 +++ b/src/HOL/Extraction/Euclid.thy	Wed Mar 04 10:45:52 2009 +0100
    90.3 @@ -189,7 +189,7 @@
    90.4        assume pn: "p \<le> n"
    90.5        from `prime p` have "0 < p" by (rule prime_g_zero)
    90.6        then have "p dvd n!" using pn by (rule dvd_factorial)
    90.7 -      with dvd have "p dvd ?k - n!" by (rule dvd_diff)
    90.8 +      with dvd have "p dvd ?k - n!" by (rule nat_dvd_diff)
    90.9        then have "p dvd 1" by simp
   90.10        with prime show False using prime_nd_one by auto
   90.11      qed
    91.1 --- a/src/HOL/Fact.thy	Wed Mar 04 10:43:39 2009 +0100
    91.2 +++ b/src/HOL/Fact.thy	Wed Mar 04 10:45:52 2009 +0100
    91.3 @@ -7,7 +7,7 @@
    91.4  header{*Factorial Function*}
    91.5  
    91.6  theory Fact
    91.7 -imports Nat
    91.8 +imports Main
    91.9  begin
   91.10  
   91.11  consts fact :: "nat => nat"
   91.12 @@ -58,7 +58,7 @@
   91.13    "n < Suc m ==> fact (Suc m - n) = (Suc m - n) * fact (m - n)"
   91.14  apply (induct n arbitrary: m)
   91.15  apply auto
   91.16 -apply (drule_tac x = "m - 1" in meta_spec, auto)
   91.17 +apply (drule_tac x = "m - Suc 0" in meta_spec, auto)
   91.18  done
   91.19  
   91.20  lemma fact_num0: "fact 0 = 1"
    92.1 --- a/src/HOL/GCD.thy	Wed Mar 04 10:43:39 2009 +0100
    92.2 +++ b/src/HOL/GCD.thy	Wed Mar 04 10:45:52 2009 +0100
    92.3 @@ -60,9 +60,12 @@
    92.4  lemma gcd_non_0: "n > 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
    92.5    by simp
    92.6  
    92.7 -lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = 1"
    92.8 +lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = Suc 0"
    92.9    by simp
   92.10  
   92.11 +lemma nat_gcd_1_right [simp, algebra]: "gcd m 1 = 1"
   92.12 +  unfolding One_nat_def by (rule gcd_1)
   92.13 +
   92.14  declare gcd.simps [simp del]
   92.15  
   92.16  text {*
   92.17 @@ -116,9 +119,12 @@
   92.18    apply (blast intro: dvd_trans)
   92.19    done
   92.20  
   92.21 -lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = 1"
   92.22 +lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = Suc 0"
   92.23    by (simp add: gcd_commute)
   92.24  
   92.25 +lemma nat_gcd_1_left [simp, algebra]: "gcd 1 m = 1"
   92.26 +  unfolding One_nat_def by (rule gcd_1_left)
   92.27 +
   92.28  text {*
   92.29    \medskip Multiplication laws
   92.30  *}
   92.31 @@ -156,7 +162,6 @@
   92.32       apply (simp add: gcd_assoc)
   92.33       apply (simp add: gcd_commute)
   92.34      apply (simp_all add: mult_commute)
   92.35 -  apply (blast intro: dvd_mult)
   92.36    done
   92.37  
   92.38  
   92.39 @@ -404,7 +409,7 @@
   92.40    {fix x y assume H: "a * x - b * y = d \<or> b * x - a * y = d"
   92.41      have dv: "?g dvd a*x" "?g dvd b * y" "?g dvd b*x" "?g dvd a * y"
   92.42        using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
   92.43 -    from dvd_diff[OF dv(1,2)] dvd_diff[OF dv(3,4)] H
   92.44 +    from nat_dvd_diff[OF dv(1,2)] nat_dvd_diff[OF dv(3,4)] H
   92.45      have ?rhs by auto}
   92.46    ultimately show ?thesis by blast
   92.47  qed
   92.48 @@ -597,8 +602,8 @@
   92.49    from h' have "int (nat \<bar>k\<bar>) = int (nat \<bar>i\<bar> * h')" by simp
   92.50    then have "\<bar>k\<bar> = \<bar>i\<bar> * int h'" by (simp add: int_mult)
   92.51    then show ?thesis
   92.52 -    apply (subst zdvd_abs1 [symmetric])
   92.53 -    apply (subst zdvd_abs2 [symmetric])
   92.54 +    apply (subst abs_dvd_iff [symmetric])
   92.55 +    apply (subst dvd_abs_iff [symmetric])
   92.56      apply (unfold dvd_def)
   92.57      apply (rule_tac x = "int h'" in exI, simp)
   92.58      done
   92.59 @@ -614,11 +619,11 @@
   92.60    let ?m' = "nat \<bar>m\<bar>"
   92.61    let ?n' = "nat \<bar>n\<bar>"
   92.62    from `k dvd m` and `k dvd n` have dvd': "?k' dvd ?m'" "?k' dvd ?n'"
   92.63 -    unfolding zdvd_int by (simp_all only: int_nat_abs zdvd_abs1 zdvd_abs2)
   92.64 +    unfolding zdvd_int by (simp_all only: int_nat_abs abs_dvd_iff dvd_abs_iff)
   92.65    from gcd_greatest [OF dvd'] have "int (nat \<bar>k\<bar>) dvd zgcd m n"
   92.66      unfolding zgcd_def by (simp only: zdvd_int)
   92.67    then have "\<bar>k\<bar> dvd zgcd m n" by (simp only: int_nat_abs)
   92.68 -  then show "k dvd zgcd m n" by (simp add: zdvd_abs1)
   92.69 +  then show "k dvd zgcd m n" by simp
   92.70  qed
   92.71  
   92.72  lemma div_zgcd_relprime:
   92.73 @@ -721,7 +726,7 @@
   92.74    assumes "k dvd i" shows "k dvd (zlcm i j)"
   92.75  proof -
   92.76    have "nat(abs k) dvd nat(abs i)" using `k dvd i`
   92.77 -    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
   92.78 +    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
   92.79    thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
   92.80  qed
   92.81  
   92.82 @@ -729,7 +734,7 @@
   92.83    assumes "k dvd j" shows "k dvd (zlcm i j)"
   92.84  proof -
   92.85    have "nat(abs k) dvd nat(abs j)" using `k dvd j`
   92.86 -    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
   92.87 +    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
   92.88    thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
   92.89  qed
   92.90  
    93.1 --- a/src/HOL/Groebner_Basis.thy	Wed Mar 04 10:43:39 2009 +0100
    93.2 +++ b/src/HOL/Groebner_Basis.thy	Wed Mar 04 10:45:52 2009 +0100
    93.3 @@ -147,7 +147,7 @@
    93.4  next show "pwr (mul x y) q = mul (pwr x q) (pwr y q)" by (rule pwr_mul)
    93.5  next show "pwr (pwr x p) q = pwr x (p * q)" by (rule pwr_pwr)
    93.6  next show "pwr x 0 = r1" using pwr_0 .
    93.7 -next show "pwr x 1 = x" by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
    93.8 +next show "pwr x 1 = x" unfolding One_nat_def by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
    93.9  next show "mul x (add y z) = add (mul x y) (mul x z)" using mul_d by simp
   93.10  next show "pwr x (Suc q) = mul x (pwr x q)" using pwr_Suc by simp
   93.11  next show "pwr x (2 * n) = mul (pwr x n) (pwr x n)" by (simp add: nat_number mul_pwr)
   93.12 @@ -436,8 +436,8 @@
   93.13  *} "solve polynomial equations over (semi)rings and ideal membership problems using Groebner bases"
   93.14  declare dvd_def[algebra]
   93.15  declare dvd_eq_mod_eq_0[symmetric, algebra]
   93.16 -declare nat_mod_div_trivial[algebra]
   93.17 -declare nat_mod_mod_trivial[algebra]
   93.18 +declare mod_div_trivial[algebra]
   93.19 +declare mod_mod_trivial[algebra]
   93.20  declare conjunct1[OF DIVISION_BY_ZERO, algebra]
   93.21  declare conjunct2[OF DIVISION_BY_ZERO, algebra]
   93.22  declare zmod_zdiv_equality[symmetric,algebra]
   93.23 @@ -448,16 +448,16 @@
   93.24  declare zmod_zminus2[algebra]
   93.25  declare zdiv_zero[algebra]
   93.26  declare zmod_zero[algebra]
   93.27 -declare zmod_1[algebra]
   93.28 -declare zdiv_1[algebra]
   93.29 +declare mod_by_1[algebra]
   93.30 +declare div_by_1[algebra]
   93.31  declare zmod_minus1_right[algebra]
   93.32  declare zdiv_minus1_right[algebra]
   93.33  declare mod_div_trivial[algebra]
   93.34  declare mod_mod_trivial[algebra]
   93.35 -declare zmod_zmult_self1[algebra]
   93.36 -declare zmod_zmult_self2[algebra]
   93.37 +declare mod_mult_self2_is_0[algebra]
   93.38 +declare mod_mult_self1_is_0[algebra]
   93.39  declare zmod_eq_0_iff[algebra]
   93.40 -declare zdvd_0_left[algebra]
   93.41 +declare dvd_0_left_iff[algebra]
   93.42  declare zdvd1_eq[algebra]
   93.43  declare zmod_eq_dvd_iff[algebra]
   93.44  declare nat_mod_eq_iff[algebra]
    94.1 --- a/src/HOL/HOL.thy	Wed Mar 04 10:43:39 2009 +0100
    94.2 +++ b/src/HOL/HOL.thy	Wed Mar 04 10:45:52 2009 +0100
    94.3 @@ -12,14 +12,15 @@
    94.4    "~~/src/Tools/IsaPlanner/isand.ML"
    94.5    "~~/src/Tools/IsaPlanner/rw_tools.ML"
    94.6    "~~/src/Tools/IsaPlanner/rw_inst.ML"
    94.7 -  "~~/src/Provers/project_rule.ML"
    94.8 +  "~~/src/Tools/intuitionistic.ML"
    94.9 +  "~~/src/Tools/project_rule.ML"
   94.10    "~~/src/Provers/hypsubst.ML"
   94.11    "~~/src/Provers/splitter.ML"
   94.12    "~~/src/Provers/classical.ML"
   94.13    "~~/src/Provers/blast.ML"
   94.14    "~~/src/Provers/clasimp.ML"
   94.15 -  "~~/src/Provers/coherent.ML"
   94.16 -  "~~/src/Provers/eqsubst.ML"
   94.17 +  "~~/src/Tools/coherent.ML"
   94.18 +  "~~/src/Tools/eqsubst.ML"
   94.19    "~~/src/Provers/quantifier1.ML"
   94.20    ("Tools/simpdata.ML")
   94.21    "~~/src/Tools/random_word.ML"
   94.22 @@ -28,7 +29,8 @@
   94.23    ("~~/src/Tools/induct_tacs.ML")
   94.24    "~~/src/Tools/value.ML"
   94.25    "~~/src/Tools/code/code_name.ML"
   94.26 -  "~~/src/Tools/code/code_funcgr.ML"
   94.27 +  "~~/src/Tools/code/code_funcgr.ML" (*formal dependency*)
   94.28 +  "~~/src/Tools/code/code_wellsorted.ML" 
   94.29    "~~/src/Tools/code/code_thingol.ML"
   94.30    "~~/src/Tools/code/code_printer.ML"
   94.31    "~~/src/Tools/code/code_target.ML"
   94.32 @@ -38,6 +40,9 @@
   94.33    ("Tools/recfun_codegen.ML")
   94.34  begin
   94.35  
   94.36 +setup {* Intuitionistic.method_setup "iprover" *}
   94.37 +
   94.38 +
   94.39  subsection {* Primitive logic *}
   94.40  
   94.41  subsubsection {* Core syntax *}
   94.42 @@ -290,7 +295,7 @@
   94.43  typed_print_translation {*
   94.44  let
   94.45    fun tr' c = (c, fn show_sorts => fn T => fn ts =>
   94.46 -    if T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
   94.47 +    if (not o null) ts orelse T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
   94.48      else Syntax.const Syntax.constrainC $ Syntax.const c $ Syntax.term_of_typ show_sorts T);
   94.49  in map tr' [@{const_syntax HOL.one}, @{const_syntax HOL.zero}] end;
   94.50  *} -- {* show types that are presumably too general *}
   94.51 @@ -1704,11 +1709,6 @@
   94.52  subsection {* Nitpick theorem store *}
   94.53  
   94.54  ML {*
   94.55 -structure Nitpick_Const_Def_Thms = NamedThmsFun
   94.56 -(
   94.57 -  val name = "nitpick_const_def"
   94.58 -  val description = "pseudo-definition of constants as needed by Nitpick"
   94.59 -)
   94.60  structure Nitpick_Const_Simp_Thms = NamedThmsFun
   94.61  (
   94.62    val name = "nitpick_const_simp"
   94.63 @@ -1725,8 +1725,7 @@
   94.64    val description = "introduction rules for (co)inductive predicates as needed by Nitpick"
   94.65  )
   94.66  *}
   94.67 -setup {* Nitpick_Const_Def_Thms.setup
   94.68 -         #> Nitpick_Const_Simp_Thms.setup
   94.69 +setup {* Nitpick_Const_Simp_Thms.setup
   94.70           #> Nitpick_Const_Psimp_Thms.setup
   94.71           #> Nitpick_Ind_Intro_Thms.setup *}
   94.72  
    95.1 --- a/src/HOL/Hoare/Arith2.thy	Wed Mar 04 10:43:39 2009 +0100
    95.2 +++ b/src/HOL/Hoare/Arith2.thy	Wed Mar 04 10:45:52 2009 +0100
    95.3 @@ -42,12 +42,12 @@
    95.4  
    95.5  lemma cd_diff_l: "n<=m ==> cd x m n = cd x (m-n) n"
    95.6    apply (unfold cd_def)
    95.7 -  apply (blast intro: dvd_diff dest: dvd_diffD)
    95.8 +  apply (fastsimp dest: dvd_diffD)
    95.9    done
   95.10  
   95.11  lemma cd_diff_r: "m<=n ==> cd x m n = cd x m (n-m)"
   95.12    apply (unfold cd_def)
   95.13 -  apply (blast intro: dvd_diff dest: dvd_diffD)
   95.14 +  apply (fastsimp dest: dvd_diffD)
   95.15    done
   95.16  
   95.17  
    96.1 --- a/src/HOL/Import/lazy_seq.ML	Wed Mar 04 10:43:39 2009 +0100
    96.2 +++ b/src/HOL/Import/lazy_seq.ML	Wed Mar 04 10:45:52 2009 +0100
    96.3 @@ -1,5 +1,4 @@
    96.4  (*  Title:      HOL/Import/lazy_seq.ML
    96.5 -    ID:         $Id$
    96.6      Author:     Sebastian Skalberg, TU Muenchen
    96.7  
    96.8  Alternative version of lazy sequences.
    96.9 @@ -408,8 +407,8 @@
   96.10  	make (fn () => copy (f x))
   96.11      end
   96.12  
   96.13 -fun EVERY fs = foldr (op THEN) succeed fs
   96.14 -fun FIRST fs = foldr (op ORELSE) fail fs
   96.15 +fun EVERY fs = List.foldr (op THEN) succeed fs
   96.16 +fun FIRST fs = List.foldr (op ORELSE) fail fs
   96.17  
   96.18  fun TRY f x =
   96.19      make (fn () =>
    97.1 --- a/src/HOL/Import/proof_kernel.ML	Wed Mar 04 10:43:39 2009 +0100
    97.2 +++ b/src/HOL/Import/proof_kernel.ML	Wed Mar 04 10:45:52 2009 +0100
    97.3 @@ -777,7 +777,7 @@
    97.4                  val (c,asl) = case terms of
    97.5                                    [] => raise ERR "x2p" "Bad oracle description"
    97.6                                  | (hd::tl) => (hd,tl)
    97.7 -                val tg = foldr (fn (oracle,tg) => Tag.merge (Tag.read oracle) tg) Tag.empty_tag ors
    97.8 +                val tg = List.foldr (fn (oracle,tg) => Tag.merge (Tag.read oracle) tg) Tag.empty_tag ors
    97.9              in
   97.10                  mk_proof (POracle(tg,map xml_to_term asl,xml_to_term c))
   97.11              end
   97.12 @@ -1840,7 +1840,7 @@
   97.13                        | inst_type ty1 ty2 (ty as Type(name,tys)) =
   97.14                          Type(name,map (inst_type ty1 ty2) tys)
   97.15                  in
   97.16 -                    foldr (fn (v,th) =>
   97.17 +                    List.foldr (fn (v,th) =>
   97.18                                let
   97.19                                    val cdom = fst (dom_rng (fst (dom_rng cty)))
   97.20                                    val vty  = type_of v
   97.21 @@ -1852,7 +1852,7 @@
   97.22                  end
   97.23                | SOME _ => raise ERR "GEN_ABS" "Bad constant"
   97.24                | NONE =>
   97.25 -                foldr (fn (v,th) => mk_ABS v th thy) th vlist'
   97.26 +                List.foldr (fn (v,th) => mk_ABS v th thy) th vlist'
   97.27          val res = HOLThm(rens_of info',th1)
   97.28          val _ = message "RESULT:"
   97.29          val _ = if_debug pth res
   97.30 @@ -2020,7 +2020,7 @@
   97.31                                 Sign.add_consts_i consts thy'
   97.32                             end
   97.33  
   97.34 -            val thy1 = foldr (fn(name,thy)=>
   97.35 +            val thy1 = List.foldr (fn(name,thy)=>
   97.36                                  snd (get_defname thyname name thy)) thy1 names
   97.37              fun new_name name = fst (get_defname thyname name thy1)
   97.38              val names' = map (fn name => (new_name name,name,false)) names
   97.39 @@ -2041,7 +2041,7 @@
   97.40                       then quotename name
   97.41                       else (quotename newname) ^ ": " ^ (quotename name),thy')
   97.42                  end
   97.43 -            val (new_names,thy') = foldr (fn(name,(names,thy)) =>
   97.44 +            val (new_names,thy') = List.foldr (fn(name,(names,thy)) =>
   97.45                                              let
   97.46                                                  val (name',thy') = handle_const (name,thy)
   97.47                                              in
    98.1 --- a/src/HOL/Induct/Common_Patterns.thy	Wed Mar 04 10:43:39 2009 +0100
    98.2 +++ b/src/HOL/Induct/Common_Patterns.thy	Wed Mar 04 10:45:52 2009 +0100
    98.3 @@ -1,5 +1,4 @@
    98.4  (*  Title:      HOL/Induct/Common_Patterns.thy
    98.5 -    ID:         $Id$
    98.6      Author:     Makarius
    98.7  *)
    98.8  
    99.1 --- a/src/HOL/Induct/LList.thy	Wed Mar 04 10:43:39 2009 +0100
    99.2 +++ b/src/HOL/Induct/LList.thy	Wed Mar 04 10:45:52 2009 +0100
    99.3 @@ -8,7 +8,7 @@
    99.4  bounds on the amount of lookahead required.
    99.5  
    99.6  Could try (but would it work for the gfp analogue of term?)
    99.7 -  LListD_Fun_def "LListD_Fun(A) == (%Z. diag({Numb(0)}) <++> diag(A) <**> Z)"
    99.8 +  LListD_Fun_def "LListD_Fun(A) == (%Z. Id_on({Numb(0)}) <++> Id_on(A) <**> Z)"
    99.9  
   99.10  A nice but complex example would be [ML for the Working Programmer, page 176]
   99.11    from(1) = enumerate (Lmap (Lmap(pack), makeqq(from(1),from(1))))
   99.12 @@ -95,7 +95,7 @@
   99.13    llistD_Fun :: "('a llist * 'a llist)set => ('a llist * 'a llist)set" where
   99.14      "llistD_Fun(r) =   
   99.15          prod_fun Abs_LList Abs_LList `         
   99.16 -                LListD_Fun (diag(range Leaf))   
   99.17 +                LListD_Fun (Id_on(range Leaf))   
   99.18                              (prod_fun Rep_LList Rep_LList ` r)"
   99.19  
   99.20  
   99.21 @@ -265,12 +265,12 @@
   99.22  subsection{* @{text llist} equality as a @{text gfp}; the bisimulation principle *}
   99.23  
   99.24  text{*This theorem is actually used, unlike the many similar ones in ZF*}
   99.25 -lemma LListD_unfold: "LListD r = dsum (diag {Numb 0}) (dprod r (LListD r))"
   99.26 +lemma LListD_unfold: "LListD r = dsum (Id_on {Numb 0}) (dprod r (LListD r))"
   99.27    by (fast intro!: LListD.intros [unfolded NIL_def CONS_def]
   99.28             elim: LListD.cases [unfolded NIL_def CONS_def])
   99.29  
   99.30  lemma LListD_implies_ntrunc_equality [rule_format]:
   99.31 -     "\<forall>M N. (M,N) \<in> LListD(diag A) --> ntrunc k M = ntrunc k N"
   99.32 +     "\<forall>M N. (M,N) \<in> LListD(Id_on A) --> ntrunc k M = ntrunc k N"
   99.33  apply (induct_tac "k" rule: nat_less_induct) 
   99.34  apply (safe del: equalityI)
   99.35  apply (erule LListD.cases)
   99.36 @@ -283,7 +283,7 @@
   99.37  
   99.38  text{*The domain of the @{text LListD} relation*}
   99.39  lemma Domain_LListD: 
   99.40 -    "Domain (LListD(diag A)) \<subseteq> llist(A)"
   99.41 +    "Domain (LListD(Id_on A)) \<subseteq> llist(A)"
   99.42  apply (rule subsetI)
   99.43  apply (erule llist.coinduct)
   99.44  apply (simp add: NIL_def CONS_def)
   99.45 @@ -291,10 +291,10 @@
   99.46  done
   99.47  
   99.48  text{*This inclusion justifies the use of coinduction to show @{text "M = N"}*}
   99.49 -lemma LListD_subset_diag: "LListD(diag A) \<subseteq> diag(llist(A))"
   99.50 +lemma LListD_subset_Id_on: "LListD(Id_on A) \<subseteq> Id_on(llist(A))"
   99.51  apply (rule subsetI)
   99.52  apply (rule_tac p = x in PairE, safe)
   99.53 -apply (rule diag_eqI)
   99.54 +apply (rule Id_on_eqI)
   99.55  apply (rule LListD_implies_ntrunc_equality [THEN ntrunc_equality], assumption) 
   99.56  apply (erule DomainI [THEN Domain_LListD [THEN subsetD]])
   99.57  done
   99.58 @@ -321,7 +321,7 @@
   99.59  by (simp add: LListD_Fun_def NIL_def)
   99.60  
   99.61  lemma LListD_Fun_CONS_I: 
   99.62 -     "[| x\<in>A;  (M,N):s |] ==> (CONS x M, CONS x N) \<in> LListD_Fun (diag A) s"
   99.63 +     "[| x\<in>A;  (M,N):s |] ==> (CONS x M, CONS x N) \<in> LListD_Fun (Id_on A) s"
   99.64  by (simp add: LListD_Fun_def CONS_def, blast)
   99.65  
   99.66  text{*Utilise the "strong" part, i.e. @{text "gfp(f)"}*}
   99.67 @@ -335,24 +335,24 @@
   99.68  
   99.69  
   99.70  text{*This converse inclusion helps to strengthen @{text LList_equalityI}*}
   99.71 -lemma diag_subset_LListD: "diag(llist(A)) \<subseteq> LListD(diag A)"
   99.72 +lemma Id_on_subset_LListD: "Id_on(llist(A)) \<subseteq> LListD(Id_on A)"
   99.73  apply (rule subsetI)
   99.74  apply (erule LListD_coinduct)
   99.75  apply (rule subsetI)
   99.76 -apply (erule diagE)
   99.77 +apply (erule Id_onE)
   99.78  apply (erule ssubst)
   99.79  apply (erule llist.cases)
   99.80 -apply (simp_all add: diagI LListD_Fun_NIL_I LListD_Fun_CONS_I)
   99.81 +apply (simp_all add: Id_onI LListD_Fun_NIL_I LListD_Fun_CONS_I)
   99.82  done
   99.83  
   99.84 -lemma LListD_eq_diag: "LListD(diag A) = diag(llist(A))"
   99.85 -apply (rule equalityI LListD_subset_diag diag_subset_LListD)+
   99.86 +lemma LListD_eq_Id_on: "LListD(Id_on A) = Id_on(llist(A))"
   99.87 +apply (rule equalityI LListD_subset_Id_on Id_on_subset_LListD)+
   99.88  done
   99.89  
   99.90 -lemma LListD_Fun_diag_I: "M \<in> llist(A) ==> (M,M) \<in> LListD_Fun (diag A) (X Un diag(llist(A)))"
   99.91 -apply (rule LListD_eq_diag [THEN subst])
   99.92 +lemma LListD_Fun_Id_on_I: "M \<in> llist(A) ==> (M,M) \<in> LListD_Fun (Id_on A) (X Un Id_on(llist(A)))"
   99.93 +apply (rule LListD_eq_Id_on [THEN subst])
   99.94  apply (rule LListD_Fun_LListD_I)
   99.95 -apply (simp add: LListD_eq_diag diagI)
   99.96 +apply (simp add: LListD_eq_Id_on Id_onI)
   99.97  done
   99.98  
   99.99  
  99.100 @@ -360,11 +360,11 @@
  99.101        [also admits true equality]
  99.102     Replace @{text A} by some particular set, like @{text "{x. True}"}??? *}
  99.103  lemma LList_equalityI:
  99.104 -     "[| (M,N) \<in> r;  r \<subseteq> LListD_Fun (diag A) (r Un diag(llist(A))) |] 
  99.105 +     "[| (M,N) \<in> r;  r \<subseteq> LListD_Fun (Id_on A) (r Un Id_on(llist(A))) |] 
  99.106        ==>  M=N"
  99.107 -apply (rule LListD_subset_diag [THEN subsetD, THEN diagE])
  99.108 +apply (rule LListD_subset_Id_on [THEN subsetD, THEN Id_onE])
  99.109  apply (erule LListD_coinduct)
  99.110 -apply (simp add: LListD_eq_diag, safe)
  99.111 +apply (simp add: LListD_eq_Id_on, safe)
  99.112  done
  99.113  
  99.114  
  99.115 @@ -525,14 +525,14 @@
  99.116       f(NIL)=g(NIL);                                              
  99.117       !!x l. [| x\<in>A;  l \<in> llist(A) |] ==>                          
  99.118              (f(CONS x l),g(CONS x l)) \<in>                          
  99.119 -                LListD_Fun (diag A) ((%u.(f(u),g(u)))`llist(A) Un   
  99.120 -                                    diag(llist(A)))              
  99.121 +                LListD_Fun (Id_on A) ((%u.(f(u),g(u)))`llist(A) Un   
  99.122 +                                    Id_on(llist(A)))              
  99.123    |] ==> f(M) = g(M)"
  99.124  apply (rule LList_equalityI)
  99.125  apply (erule imageI)
  99.126  apply (rule image_subsetI)
  99.127  apply (erule_tac a=x in llist.cases)
  99.128 -apply (erule ssubst, erule ssubst, erule LListD_Fun_diag_I, blast) 
  99.129 +apply (erule ssubst, erule ssubst, erule LListD_Fun_Id_on_I, blast) 
  99.130  done
  99.131  
  99.132  
  99.133 @@ -687,7 +687,7 @@
  99.134  
  99.135  lemma LListD_Fun_subset_Times_llist: 
  99.136      "r \<subseteq> (llist A) <*> (llist A) 
  99.137 -     ==> LListD_Fun (diag A) r \<subseteq> (llist A) <*> (llist A)"
  99.138 +     ==> LListD_Fun (Id_on A) r \<subseteq> (llist A) <*> (llist A)"
  99.139  by (auto simp add: LListD_Fun_def)
  99.140  
  99.141  lemma subset_Times_llist:
  99.142 @@ -703,9 +703,9 @@
  99.143  apply (simp add: LListI [THEN Abs_LList_inverse])
  99.144  done
  99.145  
  99.146 -lemma prod_fun_range_eq_diag:
  99.147 +lemma prod_fun_range_eq_Id_on:
  99.148       "prod_fun Rep_LList  Rep_LList ` range(%x. (x, x)) =  
  99.149 -      diag(llist(range Leaf))"
  99.150 +      Id_on(llist(range Leaf))"
  99.151  apply (rule equalityI, blast) 
  99.152  apply (fast elim: LListI [THEN Abs_LList_inverse, THEN subst])
  99.153  done
  99.154 @@ -730,10 +730,10 @@
  99.155  apply (rule image_compose [THEN subst])
  99.156  apply (rule prod_fun_compose [THEN subst])
  99.157  apply (subst image_Un)
  99.158 -apply (subst prod_fun_range_eq_diag)
  99.159 +apply (subst prod_fun_range_eq_Id_on)
  99.160  apply (rule LListD_Fun_subset_Times_llist [THEN prod_fun_lemma])
  99.161  apply (rule subset_Times_llist [THEN Un_least])
  99.162 -apply (rule diag_subset_Times)
  99.163 +apply (rule Id_on_subset_Times)
  99.164  done
  99.165  
  99.166  subsubsection{* Rules to prove the 2nd premise of @{text llist_equalityI} *}
  99.167 @@ -755,8 +755,8 @@
  99.168  apply (rule Rep_LList_inverse [THEN subst])
  99.169  apply (rule prod_fun_imageI)
  99.170  apply (subst image_Un)
  99.171 -apply (subst prod_fun_range_eq_diag)
  99.172 -apply (rule Rep_LList [THEN LListD, THEN LListD_Fun_diag_I])
  99.173 +apply (subst prod_fun_range_eq_Id_on)
  99.174 +apply (rule Rep_LList [THEN LListD, THEN LListD_Fun_Id_on_I])
  99.175  done
  99.176  
  99.177  text{*A special case of @{text list_equality} for functions over lazy lists*}
   100.1 --- a/src/HOL/Induct/QuoDataType.thy	Wed Mar 04 10:43:39 2009 +0100
   100.2 +++ b/src/HOL/Induct/QuoDataType.thy	Wed Mar 04 10:45:52 2009 +0100
   100.3 @@ -47,7 +47,7 @@
   100.4  
   100.5  theorem equiv_msgrel: "equiv UNIV msgrel"
   100.6  proof -
   100.7 -  have "reflexive msgrel" by (simp add: refl_def msgrel_refl)
   100.8 +  have "refl msgrel" by (simp add: refl_on_def msgrel_refl)
   100.9    moreover have "sym msgrel" by (simp add: sym_def, blast intro: msgrel.SYM)
  100.10    moreover have "trans msgrel" by (simp add: trans_def, blast intro: msgrel.TRANS)
  100.11    ultimately show ?thesis by (simp add: equiv_def)
   101.1 --- a/src/HOL/Induct/QuoNestedDataType.thy	Wed Mar 04 10:43:39 2009 +0100
   101.2 +++ b/src/HOL/Induct/QuoNestedDataType.thy	Wed Mar 04 10:45:52 2009 +0100
   101.3 @@ -44,7 +44,7 @@
   101.4  
   101.5  theorem equiv_exprel: "equiv UNIV exprel"
   101.6  proof -
   101.7 -  have "reflexive exprel" by (simp add: refl_def exprel_refl)
   101.8 +  have "refl exprel" by (simp add: refl_on_def exprel_refl)
   101.9    moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM)
  101.10    moreover have "trans exprel" by (simp add: trans_def, blast intro: exprel.TRANS)
  101.11    ultimately show ?thesis by (simp add: equiv_def)
   102.1 --- a/src/HOL/Induct/SList.thy	Wed Mar 04 10:43:39 2009 +0100
   102.2 +++ b/src/HOL/Induct/SList.thy	Wed Mar 04 10:45:52 2009 +0100
   102.3 @@ -1,15 +1,10 @@
   102.4 -(* *********************************************************************** *)
   102.5 -(*                                                                         *)
   102.6 -(* Title:      SList.thy (Extended List Theory)                            *)
   102.7 -(* Based on:   $Id$      *)
   102.8 -(* Author:     Lawrence C Paulson, Cambridge University Computer Laboratory*)
   102.9 -(* Author:     B. Wolff, University of Bremen                              *)
  102.10 -(* Purpose:    Enriched theory of lists                                    *)
  102.11 -(*	       mutual indirect recursive data-types                        *)
  102.12 -(*                                                                         *)
  102.13 -(* *********************************************************************** *)
  102.14 +(*  Title:      SList.thy
  102.15 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
  102.16 +    Author:     B. Wolff, University of Bremen
  102.17  
  102.18 -(* Definition of type 'a list (strict lists) by a least fixed point
  102.19 +Enriched theory of lists; mutual indirect recursive data-types.
  102.20 +
  102.21 +Definition of type 'a list (strict lists) by a least fixed point
  102.22  
  102.23  We use          list(A) == lfp(%Z. {NUMB(0)} <+> A <*> Z)
  102.24  and not         list    == lfp(%Z. {NUMB(0)} <+> range(Leaf) <*> Z)
  102.25 @@ -24,6 +19,8 @@
  102.26  Tidied by lcp.  Still needs removal of nat_rec.
  102.27  *)
  102.28  
  102.29 +header {* Extended List Theory (old) *}
  102.30 +
  102.31  theory SList
  102.32  imports Sexp
  102.33  begin
  102.34 @@ -79,12 +76,12 @@
  102.35  
  102.36  (*Declaring the abstract list constructors*)
  102.37  
  102.38 -(*<*)no_translations
  102.39 +no_translations
  102.40    "[x, xs]" == "x#[xs]"
  102.41    "[x]" == "x#[]"
  102.42 -no_syntax
  102.43 -  Nil :: "'a list"  ("[]")
  102.44 -  Cons :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixr "#" 65)(*>*)
  102.45 +no_notation
  102.46 +  Nil  ("[]") and
  102.47 +  Cons (infixr "#" 65)
  102.48  
  102.49  definition
  102.50    Nil       :: "'a list"                               ("[]") where
  102.51 @@ -149,8 +146,8 @@
  102.52    ttl       :: "'a list => 'a list" where
  102.53    "ttl xs   = list_rec xs [] (%x xs r. xs)"
  102.54  
  102.55 -(*<*)no_syntax
  102.56 -    member :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" (infixl "mem" 55)(*>*)
  102.57 +no_notation member  (infixl "mem" 55)
  102.58 +
  102.59  definition
  102.60    member :: "['a, 'a list] => bool"    (infixl "mem" 55) where
  102.61    "x mem xs = list_rec xs False (%y ys r. if y=x then True else r)"
  102.62 @@ -163,8 +160,8 @@
  102.63    map       :: "('a=>'b) => ('a list => 'b list)" where
  102.64    "map f xs = list_rec xs [] (%x l r. f(x)#r)"
  102.65  
  102.66 -(*<*)no_syntax
  102.67 -  "\<^const>List.append" :: "'a list => 'a list => 'a list" (infixr "@" 65)(*>*)
  102.68 +no_notation append  (infixr "@" 65)
  102.69 +
  102.70  definition
  102.71    append    :: "['a list, 'a list] => 'a list"   (infixr "@" 65) where
  102.72    "xs@ys = list_rec xs ys (%x l r. x#r)"
  102.73 @@ -342,14 +339,14 @@
  102.74  
  102.75  
  102.76  lemma not_CONS_self: "N: list(A) ==> !M. N ~= CONS M N"
  102.77 -by (erule list.induct, simp_all)
  102.78 +apply (erule list.induct) apply simp_all done
  102.79  
  102.80  lemma not_Cons_self2: "\<forall>x. l ~= x#l"
  102.81 -by (induct_tac "l" rule: list_induct, simp_all)
  102.82 +by (induct l rule: list_induct) simp_all
  102.83  
  102.84  
  102.85  lemma neq_Nil_conv2: "(xs ~= []) = (\<exists>y ys. xs = y#ys)"
  102.86 -by (induct_tac "xs" rule: list_induct, auto)
  102.87 +by (induct xs rule: list_induct) auto
  102.88  
  102.89  (** Conversion rules for List_case: case analysis operator **)
  102.90  
  102.91 @@ -491,7 +488,7 @@
  102.92  
  102.93  lemma expand_list_case: 
  102.94   "P(list_case a f xs) = ((xs=[] --> P a ) & (!y ys. xs=y#ys --> P(f y ys)))"
  102.95 -by (induct_tac "xs" rule: list_induct, simp_all)
  102.96 +by (induct xs rule: list_induct) simp_all
  102.97  
  102.98  
  102.99  (**** Function definitions ****)
 102.100 @@ -533,41 +530,44 @@
 102.101  (** @ - append **)
 102.102  
 102.103  lemma append_assoc [simp]: "(xs@ys)@zs = xs@(ys@zs)"
 102.104 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.105 +by (induct xs rule: list_induct) simp_all
 102.106  
 102.107  lemma append_Nil2 [simp]: "xs @ [] = xs"
 102.108 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.109 +by (induct xs rule: list_induct) simp_all
 102.110  
 102.111  (** mem **)
 102.112  
 102.113  lemma mem_append [simp]: "x mem (xs@ys) = (x mem xs | x mem ys)"
 102.114 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.115 +by (induct xs rule: list_induct) simp_all
 102.116  
 102.117  lemma mem_filter [simp]: "x mem [x\<leftarrow>xs. P x ] = (x mem xs & P(x))"
 102.118 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.119 +by (induct xs rule: list_induct) simp_all
 102.120  
 102.121  (** list_all **)
 102.122  
 102.123  lemma list_all_True [simp]: "(Alls x:xs. True) = True"
 102.124 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.125 +by (induct xs rule: list_induct) simp_all
 102.126  
 102.127  lemma list_all_conj [simp]:
 102.128       "list_all p (xs@ys) = ((list_all p xs) & (list_all p ys))"
 102.129 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.130 +by (induct xs rule: list_induct) simp_all
 102.131  
 102.132  lemma list_all_mem_conv: "(Alls x:xs. P(x)) = (!x. x mem xs --> P(x))"
 102.133 -apply (induct_tac "xs" rule: list_induct, simp_all)
 102.134 +apply (induct xs rule: list_induct)
 102.135 +apply simp_all
 102.136  apply blast 
 102.137  done
 102.138  
 102.139  lemma nat_case_dist : "(! n. P n) = (P 0 & (! n. P (Suc n)))"
 102.140  apply auto
 102.141 -apply (induct_tac "n", auto)
 102.142 +apply (induct_tac n)
 102.143 +apply auto
 102.144  done
 102.145  
 102.146  
 102.147  lemma alls_P_eq_P_nth: "(Alls u:A. P u) = (!n. n < length A --> P(nth n A))"
 102.148 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.149 +apply (induct_tac A rule: list_induct)
 102.150 +apply simp_all
 102.151  apply (rule trans)
 102.152  apply (rule_tac [2] nat_case_dist [symmetric], simp_all)
 102.153  done
 102.154 @@ -583,7 +583,7 @@
 102.155  lemma Abs_Rep_map: 
 102.156       "(!!x. f(x): sexp) ==>  
 102.157          Abs_map g (Rep_map f xs) = map (%t. g(f(t))) xs"
 102.158 -apply (induct_tac "xs" rule: list_induct)
 102.159 +apply (induct xs rule: list_induct)
 102.160  apply (simp_all add: Rep_map_type list_sexp [THEN subsetD])
 102.161  done
 102.162  
 102.163 @@ -591,24 +591,25 @@
 102.164  (** Additional mapping lemmas **)
 102.165  
 102.166  lemma map_ident [simp]: "map(%x. x)(xs) = xs"
 102.167 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.168 +by (induct xs rule: list_induct) simp_all
 102.169  
 102.170  lemma map_append [simp]: "map f (xs@ys) = map f xs  @ map f ys"
 102.171 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.172 +by (induct xs rule: list_induct) simp_all
 102.173  
 102.174  lemma map_compose: "map(f o g)(xs) = map f (map g xs)"
 102.175  apply (simp add: o_def)
 102.176 -apply (induct_tac "xs" rule: list_induct, simp_all)
 102.177 +apply (induct xs rule: list_induct)
 102.178 +apply simp_all
 102.179  done
 102.180  
 102.181  
 102.182  lemma mem_map_aux1 [rule_format]:
 102.183       "x mem (map f q) --> (\<exists>y. y mem q & x = f y)"
 102.184 -by (induct_tac "q" rule: list_induct, simp_all, blast)
 102.185 +by (induct q rule: list_induct) auto
 102.186  
 102.187  lemma mem_map_aux2 [rule_format]: 
 102.188       "(\<exists>y. y mem q & x = f y) --> x mem (map f q)"
 102.189 -by (induct_tac "q" rule: list_induct, auto)
 102.190 +by (induct q rule: list_induct) auto
 102.191  
 102.192  lemma mem_map: "x mem (map f q) = (\<exists>y. y mem q & x = f y)"
 102.193  apply (rule iffI)
 102.194 @@ -617,10 +618,10 @@
 102.195  done
 102.196  
 102.197  lemma hd_append [rule_format]: "A ~= [] --> hd(A @ B) = hd(A)"
 102.198 -by (induct_tac "A" rule: list_induct, auto)
 102.199 +by (induct A rule: list_induct) auto
 102.200  
 102.201  lemma tl_append [rule_format]: "A ~= [] --> tl(A @ B) = tl(A) @ B"
 102.202 -by (induct_tac "A" rule: list_induct, auto)
 102.203 +by (induct A rule: list_induct) auto
 102.204  
 102.205  
 102.206  (** take **)
 102.207 @@ -638,8 +639,8 @@
 102.208  by (simp add: drop_def)
 102.209  
 102.210  lemma drop_Suc1 [simp]: "drop [] (Suc x) = []"
 102.211 -apply (simp add: drop_def)
 102.212 -apply (induct_tac "x", auto) 
 102.213 +apply (induct x) 
 102.214 +apply (simp_all add: drop_def)
 102.215  done
 102.216  
 102.217  lemma drop_Suc2 [simp]: "drop(a#xs)(Suc x) = drop xs x"
 102.218 @@ -698,9 +699,7 @@
 102.219  
 102.220  
 102.221  lemma zipWith_Cons_Nil [simp]: "zipWith f (x,[])  = []"
 102.222 -apply (simp add: zipWith_def)
 102.223 -apply (induct_tac "x" rule: list_induct, simp_all)
 102.224 -done
 102.225 +by (induct x rule: list_induct) (simp_all add: zipWith_def)
 102.226  
 102.227  
 102.228  lemma zipWith_Nil_Cons [simp]: "zipWith f ([],x) = []"
 102.229 @@ -722,23 +721,23 @@
 102.230  done
 102.231  
 102.232  lemma map_flat: "map f (flat S) = flat(map (map f) S)"
 102.233 -by (induct_tac "S" rule: list_induct, simp_all)
 102.234 +by (induct S rule: list_induct) simp_all
 102.235  
 102.236  lemma list_all_map_eq: "(Alls u:xs. f(u) = g(u)) --> map f xs = map g xs"
 102.237 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.238 +by (induct xs rule: list_induct) simp_all
 102.239  
 102.240  lemma filter_map_d: "filter p (map f xs) = map f (filter(p o f)(xs))"
 102.241 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.242 +by (induct xs rule: list_induct) simp_all
 102.243  
 102.244  lemma filter_compose: "filter p (filter q xs) = filter(%x. p x & q x) xs"
 102.245 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.246 +by (induct xs rule: list_induct) simp_all
 102.247  
 102.248  (* "filter(p, filter(q,xs)) = filter(q, filter(p,xs))",
 102.249     "filter(p, filter(p,xs)) = filter(p,xs)" BIRD's thms.*)
 102.250   
 102.251  lemma filter_append [rule_format, simp]:
 102.252       "\<forall>B. filter p (A @ B) = (filter p A @ filter p B)"
 102.253 -by (induct_tac "A" rule: list_induct, simp_all)
 102.254 +by (induct A rule: list_induct) simp_all
 102.255  
 102.256  
 102.257  (* inits(xs) == map(fst,splits(xs)), 
 102.258 @@ -749,44 +748,50 @@
 102.259     x mem xs & y mem ys = <x,y> mem diag(xs,ys) *)
 102.260  
 102.261  lemma length_append: "length(xs@ys) = length(xs)+length(ys)"
 102.262 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.263 +by (induct xs rule: list_induct) simp_all
 102.264  
 102.265  lemma length_map: "length(map f xs) = length(xs)"
 102.266 -by (induct_tac "xs" rule: list_induct, simp_all)
 102.267 +by (induct xs rule: list_induct) simp_all
 102.268  
 102.269  
 102.270  lemma take_Nil [simp]: "take [] n = []"
 102.271 -by (induct_tac "n", simp_all)
 102.272 +by (induct n) simp_all
 102.273  
 102.274  lemma take_take_eq [simp]: "\<forall>n. take (take xs n) n = take xs n"
 102.275 -apply (induct_tac "xs" rule: list_induct, simp_all)
 102.276 +apply (induct xs rule: list_induct)
 102.277 +apply simp_all
 102.278  apply (rule allI)
 102.279 -apply (induct_tac "n", auto)
 102.280 +apply (induct_tac n)
 102.281 +apply auto
 102.282  done
 102.283  
 102.284  lemma take_take_Suc_eq1 [rule_format]:
 102.285       "\<forall>n. take (take xs(Suc(n+m))) n = take xs n"
 102.286 -apply (induct_tac "xs" rule: list_induct, simp_all)
 102.287 +apply (induct_tac xs rule: list_induct)
 102.288 +apply simp_all
 102.289  apply (rule allI)
 102.290 -apply (induct_tac "n", auto)
 102.291 +apply (induct_tac n)
 102.292 +apply auto
 102.293  done
 102.294  
 102.295  declare take_Suc [simp del]
 102.296  
 102.297  lemma take_take_1: "take (take xs (n+m)) n = take xs n"
 102.298 -apply (induct_tac "m")
 102.299 +apply (induct m)
 102.300  apply (simp_all add: take_take_Suc_eq1)
 102.301  done
 102.302  
 102.303  lemma take_take_Suc_eq2 [rule_format]:
 102.304       "\<forall>n. take (take xs n)(Suc(n+m)) = take xs n"
 102.305 -apply (induct_tac "xs" rule: list_induct, simp_all)
 102.306 +apply (induct_tac xs rule: list_induct)
 102.307 +apply simp_all
 102.308  apply (rule allI)
 102.309 -apply (induct_tac "n", auto)
 102.310 +apply (induct_tac n)
 102.311 +apply auto
 102.312  done
 102.313  
 102.314  lemma take_take_2: "take(take xs n)(n+m) = take xs n"
 102.315 -apply (induct_tac "m")
 102.316 +apply (induct m)
 102.317  apply (simp_all add: take_take_Suc_eq2)
 102.318  done
 102.319  
 102.320 @@ -794,29 +799,33 @@
 102.321  (* length(drop(xs,n)) = length(xs) - n *)
 102.322  
 102.323  lemma drop_Nil [simp]: "drop  [] n  = []"
 102.324 -by (induct_tac "n", auto)
 102.325 +by (induct n) auto
 102.326  
 102.327  lemma drop_drop [rule_format]: "\<forall>xs. drop (drop xs m) n = drop xs(m+n)"
 102.328 -apply (induct_tac "m", auto) 
 102.329 -apply (induct_tac "xs" rule: list_induct, auto) 
 102.330 +apply (induct_tac m)
 102.331 +apply auto
 102.332 +apply (induct_tac xs rule: list_induct)
 102.333 +apply auto
 102.334  done
 102.335  
 102.336  lemma take_drop [rule_format]: "\<forall>xs. (take xs n) @ (drop xs n) = xs"
 102.337 -apply (induct_tac "n", auto) 
 102.338 -apply (induct_tac "xs" rule: list_induct, auto) 
 102.339 +apply (induct_tac n)
 102.340 +apply auto
 102.341 +apply (induct_tac xs rule: list_induct)
 102.342 +apply auto
 102.343  done
 102.344  
 102.345  lemma copy_copy: "copy x n @ copy x m = copy x (n+m)"
 102.346 -by (induct_tac "n", auto)
 102.347 +by (induct n) auto
 102.348  
 102.349  lemma length_copy: "length(copy x n)  = n"
 102.350 -by (induct_tac "n", auto)
 102.351 +by (induct n) auto
 102.352  
 102.353  lemma length_take [rule_format, simp]:
 102.354       "\<forall>xs. length(take xs n) = min (length xs) n"
 102.355 -apply (induct_tac "n")
 102.356 +apply (induct n)
 102.357   apply auto
 102.358 -apply (induct_tac "xs" rule: list_induct)
 102.359 +apply (induct_tac xs rule: list_induct)
 102.360   apply auto
 102.361  done
 102.362  
 102.363 @@ -824,85 +833,93 @@
 102.364  by (simp only: length_append [symmetric] take_drop)
 102.365  
 102.366  lemma take_append [rule_format]: "\<forall>A. length(A) = n --> take(A@B) n = A"
 102.367 -apply (induct_tac "n")
 102.368 +apply (induct n)
 102.369  apply (rule allI)
 102.370  apply (rule_tac [2] allI)
 102.371 -apply (induct_tac "A" rule: list_induct)
 102.372 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
 102.373 +apply (induct_tac A rule: list_induct)
 102.374 +apply (induct_tac [3] A rule: list_induct, simp_all)
 102.375  done
 102.376  
 102.377  lemma take_append2 [rule_format]:
 102.378       "\<forall>A. length(A) = n --> take(A@B) (n+k) = A @ take B k"
 102.379 -apply (induct_tac "n")
 102.380 +apply (induct n)
 102.381  apply (rule allI)
 102.382  apply (rule_tac [2] allI)
 102.383 -apply (induct_tac "A" rule: list_induct)
 102.384 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
 102.385 +apply (induct_tac A rule: list_induct)
 102.386 +apply (induct_tac [3] A rule: list_induct, simp_all)
 102.387  done
 102.388  
 102.389  lemma take_map [rule_format]: "\<forall>n. take (map f A) n = map f (take A n)"
 102.390 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.391 +apply (induct A rule: list_induct)
 102.392 +apply simp_all
 102.393  apply (rule allI)
 102.394 -apply (induct_tac "n", simp_all)
 102.395 +apply (induct_tac n)
 102.396 +apply simp_all
 102.397  done
 102.398  
 102.399  lemma drop_append [rule_format]: "\<forall>A. length(A) = n --> drop(A@B)n = B"
 102.400 -apply (induct_tac "n")
 102.401 +apply (induct n)
 102.402  apply (rule allI)
 102.403  apply (rule_tac [2] allI)
 102.404 -apply (induct_tac "A" rule: list_induct)
 102.405 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
 102.406 +apply (induct_tac A rule: list_induct)
 102.407 +apply (induct_tac [3] A rule: list_induct)
 102.408 +apply simp_all
 102.409  done
 102.410  
 102.411  lemma drop_append2 [rule_format]:
 102.412       "\<forall>A. length(A) = n --> drop(A@B)(n+k) = drop B k"
 102.413 -apply (induct_tac "n")
 102.414 +apply (induct n)
 102.415  apply (rule allI)
 102.416  apply (rule_tac [2] allI)
 102.417 -apply (induct_tac "A" rule: list_induct)
 102.418 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
 102.419 +apply (induct_tac A rule: list_induct)
 102.420 +apply (induct_tac [3] A rule: list_induct)
 102.421 +apply simp_all
 102.422  done
 102.423  
 102.424  
 102.425  lemma drop_all [rule_format]: "\<forall>A. length(A) = n --> drop A n = []"
 102.426 -apply (induct_tac "n")
 102.427 +apply (induct n)
 102.428  apply (rule allI)
 102.429  apply (rule_tac [2] allI)
 102.430 -apply (induct_tac "A" rule: list_induct)
 102.431 -apply (induct_tac [3] "A" rule: list_induct, auto)
 102.432 +apply (induct_tac A rule: list_induct)
 102.433 +apply (induct_tac [3] A rule: list_induct)
 102.434 +apply auto
 102.435  done
 102.436  
 102.437  lemma drop_map [rule_format]: "\<forall>n. drop (map f A) n = map f (drop A n)"
 102.438 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.439 +apply (induct A rule: list_induct)
 102.440 +apply simp_all
 102.441  apply (rule allI)
 102.442 -apply (induct_tac "n", simp_all)
 102.443 +apply (induct_tac n)
 102.444 +apply simp_all
 102.445  done
 102.446  
 102.447  lemma take_all [rule_format]: "\<forall>A. length(A) = n --> take A n = A"
 102.448 -apply (induct_tac "n")
 102.449 +apply (induct n)
 102.450  apply (rule allI)
 102.451  apply (rule_tac [2] allI)
 102.452 -apply (induct_tac "A" rule: list_induct)
 102.453 -apply (induct_tac [3] "A" rule: list_induct, auto) 
 102.454 +apply (induct_tac A rule: list_induct)
 102.455 +apply (induct_tac [3] A rule: list_induct)
 102.456 +apply auto
 102.457  done
 102.458  
 102.459  lemma foldl_single: "foldl f a [b] = f a b"
 102.460  by simp_all
 102.461  
 102.462 -lemma foldl_append [rule_format, simp]:
 102.463 -     "\<forall>a. foldl f a (A @ B) = foldl f (foldl f a A) B"
 102.464 -by (induct_tac "A" rule: list_induct, simp_all)
 102.465 +lemma foldl_append [simp]:
 102.466 +  "\<And>a. foldl f a (A @ B) = foldl f (foldl f a A) B"
 102.467 +by (induct A rule: list_induct) simp_all
 102.468  
 102.469 -lemma foldl_map [rule_format]:
 102.470 -     "\<forall>e. foldl f e (map g S) = foldl (%x y. f x (g y)) e S"
 102.471 -by (induct_tac "S" rule: list_induct, simp_all)
 102.472 +lemma foldl_map:
 102.473 +  "\<And>e. foldl f e (map g S) = foldl (%x y. f x (g y)) e S"
 102.474 +by (induct S rule: list_induct) simp_all
 102.475  
 102.476  lemma foldl_neutr_distr [rule_format]:
 102.477    assumes r_neutr: "\<forall>a. f a e = a" 
 102.478        and r_neutl: "\<forall>a. f e a = a"
 102.479        and assoc:   "\<forall>a b c. f a (f b c) = f(f a b) c"
 102.480    shows "\<forall>y. f y (foldl f e A) = foldl f y A"
 102.481 -apply (induct_tac "A" rule: list_induct)
 102.482 +apply (induct A rule: list_induct)
 102.483  apply (simp_all add: r_neutr r_neutl, clarify) 
 102.484  apply (erule all_dupE) 
 102.485  apply (rule trans) 
 102.486 @@ -923,95 +940,98 @@
 102.487  
 102.488  lemma foldr_append [rule_format, simp]:
 102.489       "\<forall>a. foldr f a (A @ B) = foldr f (foldr f a B) A"
 102.490 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.491 -done
 102.492 +by (induct A rule: list_induct) simp_all
 102.493  
 102.494  
 102.495 -lemma foldr_map [rule_format]: "\<forall>e. foldr f e (map g S) = foldr (f o g) e S"
 102.496 -apply (simp add: o_def)
 102.497 -apply (induct_tac "S" rule: list_induct, simp_all)
 102.498 -done
 102.499 +lemma foldr_map: "\<And>e. foldr f e (map g S) = foldr (f o g) e S"
 102.500 +by (induct S rule: list_induct) (simp_all add: o_def)
 102.501  
 102.502  lemma foldr_Un_eq_UN: "foldr op Un {} S = (UN X: {t. t mem S}.X)"
 102.503 -by (induct_tac "S" rule: list_induct, auto)
 102.504 +by (induct S rule: list_induct) auto
 102.505  
 102.506  lemma foldr_neutr_distr:
 102.507       "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |]    
 102.508        ==> foldr f y S = f (foldr f e S) y"
 102.509 -by (induct_tac "S" rule: list_induct, auto)
 102.510 +by (induct S rule: list_induct) auto
 102.511  
 102.512  lemma foldr_append2: 
 102.513      "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |]
 102.514       ==> foldr f e (A @ B) = f (foldr f e A) (foldr f e B)"
 102.515  apply auto
 102.516 -apply (rule foldr_neutr_distr, auto)
 102.517 +apply (rule foldr_neutr_distr)
 102.518 +apply auto
 102.519  done
 102.520  
 102.521  lemma foldr_flat: 
 102.522      "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |] ==>  
 102.523        foldr f e (flat S) = (foldr f e)(map (foldr f e) S)"
 102.524 -apply (induct_tac "S" rule: list_induct)
 102.525 +apply (induct S rule: list_induct)
 102.526  apply (simp_all del: foldr_append add: foldr_append2)
 102.527  done
 102.528  
 102.529  
 102.530  lemma list_all_map: "(Alls x:map f xs .P(x)) = (Alls x:xs.(P o f)(x))"
 102.531 -by (induct_tac "xs" rule: list_induct, auto)
 102.532 +by (induct xs rule: list_induct) auto
 102.533  
 102.534  lemma list_all_and: 
 102.535       "(Alls x:xs. P(x)&Q(x)) = ((Alls x:xs. P(x))&(Alls x:xs. Q(x)))"
 102.536 -by (induct_tac "xs" rule: list_induct, auto)
 102.537 +by (induct xs rule: list_induct) auto
 102.538  
 102.539  
 102.540  lemma nth_map [rule_format]:
 102.541       "\<forall>i. i < length(A)  --> nth i (map f A) = f(nth i A)"
 102.542 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.543 +apply (induct A rule: list_induct)
 102.544 +apply simp_all
 102.545  apply (rule allI)
 102.546 -apply (induct_tac "i", auto) 
 102.547 +apply (induct_tac i)
 102.548 +apply auto
 102.549  done
 102.550  
 102.551  lemma nth_app_cancel_right [rule_format]:
 102.552       "\<forall>i. i < length(A)  --> nth i(A@B) = nth i A"
 102.553 -apply (induct_tac "A" rule: list_induct, simp_all)
 102.554 +apply (induct A rule: list_induct)
 102.555 +apply simp_all
 102.556  apply (rule allI)
 102.557 -apply (induct_tac "i", simp_all)
 102.558 +apply (induct_tac i)
 102.559 +apply simp_all
 102.560  done
 102.561  
 102.562  lemma nth_app_cancel_left [rule_format]:
 102.563       "\<forall>n. n = length(A) --> nth(n+i)(A@B) = nth i B"
 102.564 -by (induct_tac "A" rule: list_induct, simp_all)
 102.565 +by (induct A rule: list_induct) simp_all
 102.566  
 102.567  
 102.568  (** flat **)
 102.569  
 102.570  lemma flat_append [simp]: "flat(xs@ys) = flat(xs) @ flat(ys)"
 102.571 -by (induct_tac "xs" rule: list_induct, auto)
 102.572 +by (induct xs rule: list_induct) auto
 102.573  
 102.574  lemma filter_flat: "filter p (flat S) = flat(map (filter p) S)"
 102.575 -by (induct_tac "S" rule: list_induct, auto)
 102.576 +by (induct S rule: list_induct) auto
 102.577  
 102.578  
 102.579  (** rev **)
 102.580  
 102.581  lemma rev_append [simp]: "rev(xs@ys) = rev(ys) @ rev(xs)"
 102.582 -by (induct_tac "xs" rule: list_induct, auto)
 102.583 +by (induct xs rule: list_induct) auto
 102.584  
 102.585  lemma rev_rev_ident [simp]: "rev(rev l) = l"
 102.586 -by (induct_tac "l" rule: list_induct, auto)
 102.587 +by (induct l rule: list_induct) auto
 102.588  
 102.589  lemma rev_flat: "rev(flat ls) = flat (map rev (rev ls))"
 102.590 -by (induct_tac "ls" rule: list_induct, auto)
 102.591 +by (induct ls rule: list_induct) auto
 102.592  
 102.593  lemma rev_map_distrib: "rev(map f l) = map f (rev l)"
 102.594 -by (induct_tac "l" rule: list_induct, auto)
 102.595 +by (induct l rule: list_induct) auto
 102.596  
 102.597  lemma foldl_rev: "foldl f b (rev l) = foldr (%x y. f y x) b l"
 102.598 -by (induct_tac "l" rule: list_induct, auto)
 102.599 +by (induct l rule: list_induct) auto
 102.600  
 102.601  lemma foldr_rev: "foldr f b (rev l) = foldl (%x y. f y x) b l"
 102.602  apply (rule sym)
 102.603  apply (rule trans)
 102.604 -apply (rule_tac [2] foldl_rev, simp)
 102.605 +apply (rule_tac [2] foldl_rev)
 102.606 +apply simp
 102.607  done
 102.608  
 102.609  end
   103.1 --- a/src/HOL/Int.thy	Wed Mar 04 10:43:39 2009 +0100
   103.2 +++ b/src/HOL/Int.thy	Wed Mar 04 10:45:52 2009 +0100
   103.3 @@ -77,7 +77,7 @@
   103.4  by (simp add: intrel_def)
   103.5  
   103.6  lemma equiv_intrel: "equiv UNIV intrel"
   103.7 -by (simp add: intrel_def equiv_def refl_def sym_def trans_def)
   103.8 +by (simp add: intrel_def equiv_def refl_on_def sym_def trans_def)
   103.9  
  103.10  text{*Reduces equality of equivalence classes to the @{term intrel} relation:
  103.11    @{term "(intrel `` {x} = intrel `` {y}) = ((x,y) \<in> intrel)"} *}
  103.12 @@ -832,8 +832,8 @@
  103.13                               le_imp_0_less [THEN order_less_imp_le])  
  103.14  next
  103.15    case (neg n)
  103.16 -  thus ?thesis by (simp del: of_nat_Suc of_nat_add
  103.17 -    add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
  103.18 +  thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
  103.19 +    add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  103.20  qed
  103.21  
  103.22  lemma bin_less_0_simps:
  103.23 @@ -1165,8 +1165,8 @@
  103.24                               le_imp_0_less [THEN order_less_imp_le])  
  103.25  next
  103.26    case (neg n)
  103.27 -  thus ?thesis by (simp del: of_nat_Suc of_nat_add
  103.28 -    add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
  103.29 +  thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
  103.30 +    add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  103.31  qed
  103.32  
  103.33  text {* Less-Than or Equals *}
  103.34 @@ -1547,7 +1547,7 @@
  103.35       "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
  103.36  by (simp add: power_abs)
  103.37  
  103.38 -lemma of_int_number_of_eq:
  103.39 +lemma of_int_number_of_eq [simp]:
  103.40       "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  103.41  by (simp add: number_of_eq) 
  103.42  
  103.43 @@ -1785,11 +1785,12 @@
  103.44  lemma int_val_lemma:
  103.45       "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->  
  103.46        f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
  103.47 +unfolding One_nat_def
  103.48  apply (induct n, simp)
  103.49  apply (intro strip)
  103.50  apply (erule impE, simp)
  103.51  apply (erule_tac x = n in allE, simp)
  103.52 -apply (case_tac "k = f (n+1) ")
  103.53 +apply (case_tac "k = f (Suc n)")
  103.54  apply force
  103.55  apply (erule impE)
  103.56   apply (simp add: abs_if split add: split_if_asm)
  103.57 @@ -1803,6 +1804,7 @@
  103.58           f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
  103.59  apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k 
  103.60         in int_val_lemma)
  103.61 +unfolding One_nat_def
  103.62  apply simp
  103.63  apply (erule exE)
  103.64  apply (rule_tac x = "i+m" in exI, arith)
   104.1 --- a/src/HOL/IntDiv.thy	Wed Mar 04 10:43:39 2009 +0100
   104.2 +++ b/src/HOL/IntDiv.thy	Wed Mar 04 10:45:52 2009 +0100
   104.3 @@ -547,34 +547,6 @@
   104.4  simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
   104.5    {* K (divmod_proc (@{thm divmod_rel_mod_eq})) *}
   104.6  
   104.7 -(* The following 8 lemmas are made unnecessary by the above simprocs: *)
   104.8 -
   104.9 -lemmas div_pos_pos_number_of =
  104.10 -    div_pos_pos [of "number_of v" "number_of w", standard]
  104.11 -
  104.12 -lemmas div_neg_pos_number_of =
  104.13 -    div_neg_pos [of "number_of v" "number_of w", standard]
  104.14 -
  104.15 -lemmas div_pos_neg_number_of =
  104.16 -    div_pos_neg [of "number_of v" "number_of w", standard]
  104.17 -
  104.18 -lemmas div_neg_neg_number_of =
  104.19 -    div_neg_neg [of "number_of v" "number_of w", standard]
  104.20 -
  104.21 -
  104.22 -lemmas mod_pos_pos_number_of =
  104.23 -    mod_pos_pos [of "number_of v" "number_of w", standard]
  104.24 -
  104.25 -lemmas mod_neg_pos_number_of =
  104.26 -    mod_neg_pos [of "number_of v" "number_of w", standard]
  104.27 -
  104.28 -lemmas mod_pos_neg_number_of =
  104.29 -    mod_pos_neg [of "number_of v" "number_of w", standard]
  104.30 -
  104.31 -lemmas mod_neg_neg_number_of =
  104.32 -    mod_neg_neg [of "number_of v" "number_of w", standard]
  104.33 -
  104.34 -
  104.35  lemmas posDivAlg_eqn_number_of [simp] =
  104.36      posDivAlg_eqn [of "number_of v" "number_of w", standard]
  104.37  
  104.38 @@ -584,15 +556,6 @@
  104.39  
  104.40  text{*Special-case simplification *}
  104.41  
  104.42 -lemma zmod_1 [simp]: "a mod (1::int) = 0"
  104.43 -apply (cut_tac a = a and b = 1 in pos_mod_sign)
  104.44 -apply (cut_tac [2] a = a and b = 1 in pos_mod_bound)
  104.45 -apply (auto simp del:pos_mod_bound pos_mod_sign)
  104.46 -done
  104.47 -
  104.48 -lemma zdiv_1 [simp]: "a div (1::int) = a"
  104.49 -by (cut_tac a = a and b = 1 in zmod_zdiv_equality, auto)
  104.50 -
  104.51  lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0"
  104.52  apply (cut_tac a = a and b = "-1" in neg_mod_sign)
  104.53  apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound)
  104.54 @@ -726,9 +689,6 @@
  104.55  apply (blast intro: divmod_rel_div_mod [THEN zmult1_lemma, THEN divmod_rel_mod])
  104.56  done
  104.57  
  104.58 -lemma zdiv_zmult_self1 [simp]: "b \<noteq> (0::int) ==> (a*b) div b = a"
  104.59 -by (simp add: zdiv_zmult1_eq)
  104.60 -
  104.61  lemma zmod_zdiv_trivial: "(a mod b) div b = (0::int)"
  104.62  apply (case_tac "b = 0", simp)
  104.63  apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial)
  104.64 @@ -754,7 +714,7 @@
  104.65    assume not0: "b \<noteq> 0"
  104.66    show "(a + c * b) div b = c + a div b"
  104.67      unfolding zdiv_zadd1_eq [of a "c * b"] using not0 
  104.68 -      by (simp add: zmod_zmult1_eq zmod_zdiv_trivial)
  104.69 +      by (simp add: zmod_zmult1_eq zmod_zdiv_trivial zdiv_zmult1_eq)
  104.70  qed auto
  104.71  
  104.72  lemma posDivAlg_div_mod:
  104.73 @@ -784,41 +744,12 @@
  104.74    show ?thesis by simp
  104.75  qed
  104.76  
  104.77 -lemma zdiv_zadd_self1: "a \<noteq> (0::int) ==> (a+b) div a = b div a + 1"
  104.78 -by (rule div_add_self1) (* already declared [simp] *)
  104.79 -
  104.80 -lemma zdiv_zadd_self2: "a \<noteq> (0::int) ==> (b+a) div a = b div a + 1"
  104.81 -by (rule div_add_self2) (* already declared [simp] *)
  104.82 -
  104.83 -lemma zdiv_zmult_self2: "b \<noteq> (0::int) ==> (b*a) div b = a"
  104.84 -by (rule div_mult_self1_is_id) (* already declared [simp] *)
  104.85 -
  104.86 -lemma zmod_zmult_self1: "(a*b) mod b = (0::int)"
  104.87 -by (rule mod_mult_self2_is_0) (* already declared [simp] *)
  104.88 -
  104.89 -lemma zmod_zmult_self2: "(b*a) mod b = (0::int)"
  104.90 -by (rule mod_mult_self1_is_0) (* already declared [simp] *)
  104.91 -
  104.92  lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)"
  104.93  by (simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def)
  104.94  
  104.95  (* REVISIT: should this be generalized to all semiring_div types? *)
  104.96  lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
  104.97  
  104.98 -lemma zmod_zadd_left_eq: "(a+b) mod (c::int) = ((a mod c) + b) mod c"
  104.99 -by (rule mod_add_left_eq)
 104.100 -
 104.101 -lemma zmod_zadd_right_eq: "(a+b) mod (c::int) = (a + (b mod c)) mod c"
 104.102 -by (rule mod_add_right_eq)
 104.103 -
 104.104 -lemma zmod_zadd_self1: "(a+b) mod a = b mod (a::int)"
 104.105 -by (rule mod_add_self1) (* already declared [simp] *)
 104.106 -
 104.107 -lemma zmod_zadd_self2: "(b+a) mod a = b mod (a::int)"
 104.108 -by (rule mod_add_self2) (* already declared [simp] *)
 104.109 -
 104.110 -lemma zmod_zdiff1_eq: "(a - b) mod c = (a mod c - b mod c) mod (c::int)"
 104.111 -by (rule mod_diff_eq)
 104.112  
 104.113  subsection{*Proving  @{term "a div (b*c) = (a div b) div c"} *}
 104.114  
 104.115 @@ -902,13 +833,6 @@
 104.116    "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)"
 104.117  by (simp add:zdiv_zmult_zmult1)
 104.118  
 104.119 -(*
 104.120 -lemma zdiv_zmult_zmult2: "c \<noteq> (0::int) ==> (a*c) div (b*c) = a div b"
 104.121 -apply (drule zdiv_zmult_zmult1)
 104.122 -apply (auto simp add: mult_commute)
 104.123 -done
 104.124 -*)
 104.125 -
 104.126  
 104.127  subsection{*Distribution of Factors over mod*}
 104.128  
 104.129 @@ -933,9 +857,6 @@
 104.130  apply (auto simp add: mult_commute)
 104.131  done
 104.132  
 104.133 -lemma zmod_zmod_cancel: "n dvd m \<Longrightarrow> (k::int) mod m mod n = k mod n"
 104.134 -by (rule mod_mod_cancel)
 104.135 -
 104.136  
 104.137  subsection {*Splitting Rules for div and mod*}
 104.138  
 104.139 @@ -1070,7 +991,7 @@
 104.140  apply (subgoal_tac "(1 + 2* (-b - 1)) mod (2* (-a)) = 
 104.141                      1 + 2* ((-b - 1) mod (-a))")
 104.142  apply (rule_tac [2] pos_zmod_mult_2)
 104.143 -apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
 104.144 +apply (auto simp add: right_diff_distrib)
 104.145  apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
 104.146   prefer 2 apply simp 
 104.147  apply (simp only: zmod_zminus_zminus diff_minus minus_add_distrib [symmetric])
 104.148 @@ -1132,38 +1053,8 @@
 104.149  
 104.150  subsection {* The Divides Relation *}
 104.151  
 104.152 -lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
 104.153 -  by (rule dvd_eq_mod_eq_0)
 104.154 -
 104.155  lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
 104.156 -  zdvd_iff_zmod_eq_0 [of "number_of x" "number_of y", standard]
 104.157 -
 104.158 -lemma zdvd_0_right: "(m::int) dvd 0"
 104.159 -  by (rule dvd_0_right) (* already declared [iff] *)
 104.160 -
 104.161 -lemma zdvd_0_left: "(0 dvd (m::int)) = (m = 0)"
 104.162 -  by (rule dvd_0_left_iff) (* already declared [noatp,simp] *)
 104.163 -
 104.164 -lemma zdvd_1_left: "1 dvd (m::int)"
 104.165 -  by (rule one_dvd) (* already declared [simp] *)
 104.166 -
 104.167 -lemma zdvd_refl: "m dvd (m::int)"
 104.168 -  by (rule dvd_refl) (* already declared [simp] *)
 104.169 -
 104.170 -lemma zdvd_trans: "m dvd n ==> n dvd k ==> m dvd (k::int)"
 104.171 -  by (rule dvd_trans)
 104.172 -
 104.173 -lemma zdvd_zminus_iff: "m dvd -n \<longleftrightarrow> m dvd (n::int)"
 104.174 -  by (rule dvd_minus_iff) (* already declared [simp] *)
 104.175 -
 104.176 -lemma zdvd_zminus2_iff: "-m dvd n \<longleftrightarrow> m dvd (n::int)"
 104.177 -  by (rule minus_dvd_iff) (* already declared [simp] *)
 104.178 -
 104.179 -lemma zdvd_abs1: "( \<bar>i::int\<bar> dvd j) = (i dvd j)"
 104.180 -  by (rule abs_dvd_iff) (* already declared [simp] *)
 104.181 -
 104.182 -lemma zdvd_abs2: "( (i::int) dvd \<bar>j\<bar>) = (i dvd j)" 
 104.183 -  by (rule dvd_abs_iff) (* already declared [simp] *)
 104.184 +  dvd_eq_mod_eq_0 [of "number_of x::int" "number_of y::int", standard]
 104.185  
 104.186  lemma zdvd_anti_sym:
 104.187      "0 < m ==> 0 < n ==> m dvd n ==> n dvd m ==> m = (n::int)"
 104.188 @@ -1171,58 +1062,32 @@
 104.189    apply (simp add: mult_assoc zero_less_mult_iff zmult_eq_1_iff)
 104.190    done
 104.191  
 104.192 -lemma zdvd_zadd: "k dvd m ==> k dvd n ==> k dvd (m + n :: int)"
 104.193 -  by (rule dvd_add)
 104.194 -
 104.195 -lemma zdvd_dvd_eq: assumes anz:"a \<noteq> 0" and ab: "(a::int) dvd b" and ba:"b dvd a" 
 104.196 +lemma zdvd_dvd_eq: assumes "a \<noteq> 0" and "(a::int) dvd b" and "b dvd a" 
 104.197    shows "\<bar>a\<bar> = \<bar>b\<bar>"
 104.198  proof-
 104.199 -  from ab obtain k where k:"b = a*k" unfolding dvd_def by blast 
 104.200 -  from ba obtain k' where k':"a = b*k'" unfolding dvd_def by blast 
 104.201 +  from `a dvd b` obtain k where k:"b = a*k" unfolding dvd_def by blast 
 104.202 +  from `b dvd a` obtain k' where k':"a = b*k'" unfolding dvd_def by blast 
 104.203    from k k' have "a = a*k*k'" by simp
 104.204    with mult_cancel_left1[where c="a" and b="k*k'"]
 104.205 -  have kk':"k*k' = 1" using anz by (simp add: mult_assoc)
 104.206 +  have kk':"k*k' = 1" using `a\<noteq>0` by (simp add: mult_assoc)
 104.207    hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
 104.208    thus ?thesis using k k' by auto
 104.209  qed
 104.210  
 104.211 -lemma zdvd_zdiff: "k dvd m ==> k dvd n ==> k dvd (m - n :: int)"
 104.212 -  by (rule Ring_and_Field.dvd_diff)
 104.213 -
 104.214  lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
 104.215    apply (subgoal_tac "m = n + (m - n)")
 104.216     apply (erule ssubst)
 104.217 -   apply (blast intro: zdvd_zadd, simp)
 104.218 +   apply (blast intro: dvd_add, simp)
 104.219    done
 104.220  
 104.221 -lemma zdvd_zmult: "k dvd (n::int) ==> k dvd m * n"
 104.222 -  by (rule dvd_mult)
 104.223 -
 104.224 -lemma zdvd_zmult2: "k dvd (m::int) ==> k dvd m * n"
 104.225 -  by (rule dvd_mult2)
 104.226 -
 104.227 -lemma zdvd_triv_right: "(k::int) dvd m * k"
 104.228 -  by (rule dvd_triv_right) (* already declared [simp] *)
 104.229 -
 104.230 -lemma zdvd_triv_left: "(k::int) dvd k * m"
 104.231 -  by (rule dvd_triv_left) (* already declared [simp] *)
 104.232 -
 104.233 -lemma zdvd_zmultD2: "j * k dvd n ==> j dvd (n::int)"
 104.234 -  by (rule dvd_mult_left)
 104.235 -
 104.236 -lemma zdvd_zmultD: "j * k dvd n ==> k dvd (n::int)"
 104.237 -  by (rule dvd_mult_right)
 104.238 -
 104.239 -lemma zdvd_zmult_mono: "i dvd m ==> j dvd (n::int) ==> i * j dvd m * n"
 104.240 -  by (rule mult_dvd_mono)
 104.241 -
 104.242  lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
 104.243 -  apply (rule iffI)
 104.244 -   apply (erule_tac [2] zdvd_zadd)
 104.245 -   apply (subgoal_tac "n = (n + k * m) - k * m")
 104.246 -    apply (erule ssubst)
 104.247 -    apply (erule zdvd_zdiff, simp_all)
 104.248 -  done
 104.249 +apply (rule iffI)
 104.250 + apply (erule_tac [2] dvd_add)
 104.251 + apply (subgoal_tac "n = (n + k * m) - k * m")
 104.252 +  apply (erule ssubst)
 104.253 +  apply (erule dvd_diff)
 104.254 +  apply(simp_all)
 104.255 +done
 104.256  
 104.257  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
 104.258    apply (simp add: dvd_def)
 104.259 @@ -1232,7 +1097,7 @@
 104.260  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
 104.261    apply (subgoal_tac "k dvd n * (m div n) + m mod n")
 104.262     apply (simp add: zmod_zdiv_equality [symmetric])
 104.263 -  apply (simp only: zdvd_zadd zdvd_zmult2)
 104.264 +  apply (simp only: dvd_add dvd_mult2)
 104.265    done
 104.266  
 104.267  lemma zdvd_not_zless: "0 < m ==> m < n ==> \<not> n dvd (m::int)"
 104.268 @@ -1252,7 +1117,7 @@
 104.269  lemma zdvd_mult_div_cancel:"(n::int) dvd m \<Longrightarrow> n * (m div n) = m"
 104.270  apply (subgoal_tac "m mod n = 0")
 104.271   apply (simp add: zmult_div_cancel)
 104.272 -apply (simp only: zdvd_iff_zmod_eq_0)
 104.273 +apply (simp only: dvd_eq_mod_eq_0)
 104.274  done
 104.275  
 104.276  lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
 104.277 @@ -1265,10 +1130,6 @@
 104.278    thus ?thesis by simp
 104.279  qed
 104.280  
 104.281 -lemma zdvd_zmult_cancel_disj[simp]:
 104.282 -  "(k*m) dvd (k*n) = (k=0 | m dvd (n::int))"
 104.283 -by (auto simp: zdvd_zmult_mono dest: zdvd_mult_cancel)
 104.284 -
 104.285  
 104.286  theorem ex_nat: "(\<exists>x::nat. P x) = (\<exists>x::int. 0 <= x \<and> P (nat x))"
 104.287  apply (simp split add: split_nat)
 104.288 @@ -1300,44 +1161,38 @@
 104.289        then show ?thesis by (simp only: negative_eq_positive) auto
 104.290      qed
 104.291    qed
 104.292 -  then show ?thesis by (auto elim!: dvdE simp only: zdvd_triv_left int_mult)
 104.293 +  then show ?thesis by (auto elim!: dvdE simp only: dvd_triv_left int_mult)
 104.294  qed
 104.295  
 104.296  lemma zdvd1_eq[simp]: "(x::int) dvd 1 = ( \<bar>x\<bar> = 1)"
 104.297  proof
 104.298 -  assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by (simp add: zdvd_abs1)
 104.299 +  assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by simp
 104.300    hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
 104.301    hence "nat \<bar>x\<bar> = 1"  by simp
 104.302    thus "\<bar>x\<bar> = 1" by (cases "x < 0", auto)
 104.303  next
 104.304    assume "\<bar>x\<bar>=1" thus "x dvd 1" 
 104.305 -    by(cases "x < 0",simp_all add: minus_equation_iff zdvd_iff_zmod_eq_0)
 104.306 +    by(cases "x < 0",simp_all add: minus_equation_iff dvd_eq_mod_eq_0)
 104.307  qed
 104.308  lemma zdvd_mult_cancel1: 
 104.309    assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
 104.310  proof
 104.311    assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m" 
 104.312 -    by (cases "n >0", auto simp add: zdvd_zminus2_iff minus_equation_iff)
 104.313 +    by (cases "n >0", auto simp add: minus_dvd_iff minus_equation_iff)
 104.314  next
 104.315    assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
 104.316    from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
 104.317  qed
 104.318  
 104.319  lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
 104.320 -  unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus_iff)
 104.321 +  unfolding zdvd_int by (cases "z \<ge> 0") simp_all
 104.322  
 104.323  lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
 104.324 -  unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus2_iff)
 104.325 +  unfolding zdvd_int by (cases "z \<ge> 0") simp_all
 104.326  
 104.327  lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
 104.328    by (auto simp add: dvd_int_iff)
 104.329  
 104.330 -lemma zminus_dvd_iff [iff]: "(-z dvd w) = (z dvd (w::int))"
 104.331 -  by (rule minus_dvd_iff)
 104.332 -
 104.333 -lemma dvd_zminus_iff [iff]: "(z dvd -w) = (z dvd (w::int))"
 104.334 -  by (rule dvd_minus_iff)
 104.335 -
 104.336  lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
 104.337    apply (rule_tac z=n in int_cases)
 104.338    apply (auto simp add: dvd_int_iff)
 104.339 @@ -1367,10 +1222,13 @@
 104.340  apply (auto simp add: IntDiv.divmod_rel_def of_nat_mult)
 104.341  done
 104.342  
 104.343 +lemma abs_div: "(y::int) dvd x \<Longrightarrow> abs (x div y) = abs x div abs y"
 104.344 +by (unfold dvd_def, cases "y=0", auto simp add: abs_mult)
 104.345 +
 104.346  text{*Suggested by Matthias Daum*}
 104.347  lemma int_power_div_base:
 104.348       "\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)"
 104.349 -apply (subgoal_tac "k ^ m = k ^ ((m - 1) + 1)")
 104.350 +apply (subgoal_tac "k ^ m = k ^ ((m - Suc 0) + Suc 0)")
 104.351   apply (erule ssubst)
 104.352   apply (simp only: power_add)
 104.353   apply simp_all
 104.354 @@ -1387,8 +1245,8 @@
 104.355  by (rule mod_diff_right_eq [symmetric])
 104.356  
 104.357  lemmas zmod_simps =
 104.358 -  IntDiv.zmod_zadd_left_eq  [symmetric]
 104.359 -  IntDiv.zmod_zadd_right_eq [symmetric]
 104.360 +  mod_add_left_eq  [symmetric]
 104.361 +  mod_add_right_eq [symmetric]
 104.362    IntDiv.zmod_zmult1_eq     [symmetric]
 104.363    mod_mult_left_eq          [symmetric]
 104.364    IntDiv.zpower_zmod
 104.365 @@ -1463,14 +1321,14 @@
 104.366    assume H: "x mod n = y mod n"
 104.367    hence "x mod n - y mod n = 0" by simp
 104.368    hence "(x mod n - y mod n) mod n = 0" by simp 
 104.369 -  hence "(x - y) mod n = 0" by (simp add: zmod_zdiff1_eq[symmetric])
 104.370 -  thus "n dvd x - y" by (simp add: zdvd_iff_zmod_eq_0)
 104.371 +  hence "(x - y) mod n = 0" by (simp add: mod_diff_eq[symmetric])
 104.372 +  thus "n dvd x - y" by (simp add: dvd_eq_mod_eq_0)
 104.373  next
 104.374    assume H: "n dvd x - y"
 104.375    then obtain k where k: "x-y = n*k" unfolding dvd_def by blast
 104.376    hence "x = n*k + y" by simp
 104.377    hence "x mod n = (n*k + y) mod n" by simp
 104.378 -  thus "x mod n = y mod n" by (simp add: zmod_zadd_left_eq)
 104.379 +  thus "x mod n = y mod n" by (simp add: mod_add_left_eq)
 104.380  qed
 104.381  
 104.382  lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y  mod n" and xy:"y \<le> x"
   105.1 --- a/src/HOL/Integration.thy	Wed Mar 04 10:43:39 2009 +0100
   105.2 +++ b/src/HOL/Integration.thy	Wed Mar 04 10:45:52 2009 +0100
   105.3 @@ -134,7 +134,7 @@
   105.4  apply (frule partition [THEN iffD1], safe)
   105.5  apply (drule_tac x = "psize D" and P="%n. psize D \<le> n --> ?P n" in spec, safe)
   105.6  apply (case_tac "psize D = 0")
   105.7 -apply (drule_tac [2] n = "psize D - 1" in partition_lt, auto)
   105.8 +apply (drule_tac [2] n = "psize D - Suc 0" in partition_lt, auto)
   105.9  done
  105.10  
  105.11  lemma partition_gt: "[|partition(a,b) D; n < (psize D)|] ==> D(n) < D(psize D)"
  105.12 @@ -145,7 +145,7 @@
  105.13  apply (rotate_tac 2)
  105.14  apply (drule_tac x = "psize D" in spec)
  105.15  apply (rule ccontr)
  105.16 -apply (drule_tac n = "psize D - 1" in partition_lt)
  105.17 +apply (drule_tac n = "psize D - Suc 0" in partition_lt)
  105.18  apply auto
  105.19  done
  105.20  
   106.1 --- a/src/HOL/IsaMakefile	Wed Mar 04 10:43:39 2009 +0100
   106.2 +++ b/src/HOL/IsaMakefile	Wed Mar 04 10:45:52 2009 +0100
   106.3 @@ -13,7 +13,6 @@
   106.4    HOL-Library \
   106.5    HOL-ex \
   106.6    HOL-Auth \
   106.7 -  HOL-AxClasses \
   106.8    HOL-Bali \
   106.9    HOL-Decision_Procs \
  106.10    HOL-Extraction \
  106.11 @@ -79,38 +78,39 @@
  106.12  $(OUT)/Pure: Pure
  106.13  
  106.14  BASE_DEPENDENCIES = $(OUT)/Pure \
  106.15 +  $(SRC)/Provers/blast.ML \
  106.16 +  $(SRC)/Provers/clasimp.ML \
  106.17 +  $(SRC)/Provers/classical.ML \
  106.18 +  $(SRC)/Provers/hypsubst.ML \
  106.19 +  $(SRC)/Provers/quantifier1.ML \
  106.20 +  $(SRC)/Provers/splitter.ML \
  106.21 +  $(SRC)/Tools/IsaPlanner/isand.ML \
  106.22 +  $(SRC)/Tools/IsaPlanner/rw_inst.ML \
  106.23 +  $(SRC)/Tools/IsaPlanner/rw_tools.ML \
  106.24 +  $(SRC)/Tools/IsaPlanner/zipper.ML \
  106.25 +  $(SRC)/Tools/atomize_elim.ML \
  106.26 +  $(SRC)/Tools/code/code_funcgr.ML \
  106.27 +  $(SRC)/Tools/code/code_haskell.ML \
  106.28 +  $(SRC)/Tools/code/code_ml.ML \
  106.29 +  $(SRC)/Tools/code/code_name.ML \
  106.30 +  $(SRC)/Tools/code/code_printer.ML \
  106.31 +  $(SRC)/Tools/code/code_target.ML \
  106.32 +  $(SRC)/Tools/code/code_thingol.ML \
  106.33 +  $(SRC)/Tools/code/code_wellsorted.ML \
  106.34 +  $(SRC)/Tools/coherent.ML \
  106.35 +  $(SRC)/Tools/eqsubst.ML \
  106.36 +  $(SRC)/Tools/induct.ML \
  106.37 +  $(SRC)/Tools/intuitionistic.ML \
  106.38 +  $(SRC)/Tools/induct_tacs.ML \
  106.39 +  $(SRC)/Tools/nbe.ML \
  106.40 +  $(SRC)/Tools/project_rule.ML \
  106.41 +  $(SRC)/Tools/random_word.ML \
  106.42 +  $(SRC)/Tools/value.ML \
  106.43    Code_Setup.thy \
  106.44    HOL.thy \
  106.45    Tools/hologic.ML \
  106.46    Tools/recfun_codegen.ML \
  106.47    Tools/simpdata.ML \
  106.48 -  $(SRC)/Tools/atomize_elim.ML \
  106.49 -  $(SRC)/Tools/code/code_funcgr.ML \
  106.50 -  $(SRC)/Tools/code/code_funcgr.ML \
  106.51 -  $(SRC)/Tools/code/code_name.ML \
  106.52 -  $(SRC)/Tools/code/code_printer.ML \
  106.53 -  $(SRC)/Tools/code/code_target.ML \
  106.54 -  $(SRC)/Tools/code/code_ml.ML \
  106.55 -  $(SRC)/Tools/code/code_haskell.ML \
  106.56 -  $(SRC)/Tools/code/code_thingol.ML \
  106.57 -  $(SRC)/Tools/induct.ML \
  106.58 -  $(SRC)/Tools/induct_tacs.ML \
  106.59 -  $(SRC)/Tools/IsaPlanner/isand.ML \
  106.60 -  $(SRC)/Tools/IsaPlanner/rw_inst.ML \
  106.61 -  $(SRC)/Tools/IsaPlanner/rw_tools.ML \
  106.62 -  $(SRC)/Tools/IsaPlanner/zipper.ML \
  106.63 -  $(SRC)/Tools/nbe.ML \
  106.64 -  $(SRC)/Tools/random_word.ML \
  106.65 -  $(SRC)/Tools/value.ML \
  106.66 -  $(SRC)/Provers/blast.ML \
  106.67 -  $(SRC)/Provers/clasimp.ML \
  106.68 -  $(SRC)/Provers/classical.ML \
  106.69 -  $(SRC)/Provers/coherent.ML \
  106.70 -  $(SRC)/Provers/eqsubst.ML \
  106.71 -  $(SRC)/Provers/hypsubst.ML \
  106.72 -  $(SRC)/Provers/project_rule.ML \
  106.73 -  $(SRC)/Provers/quantifier1.ML \
  106.74 -  $(SRC)/Provers/splitter.ML \
  106.75  
  106.76  $(OUT)/HOL-Base: base.ML $(BASE_DEPENDENCIES)
  106.77  	@$(ISABELLE_TOOL) usedir -b -f base.ML -d false -g false $(OUT)/Pure HOL-Base
  106.78 @@ -267,11 +267,11 @@
  106.79  	@$(ISABELLE_TOOL) usedir -b -f main.ML -g true $(OUT)/Pure HOL-Main
  106.80  
  106.81  $(OUT)/HOL: ROOT.ML $(MAIN_DEPENDENCIES) \
  106.82 +  Archimedean_Field.thy \
  106.83    Complex_Main.thy \
  106.84    Complex.thy \
  106.85    Deriv.thy \
  106.86    Fact.thy \
  106.87 -  FrechetDeriv.thy \
  106.88    Integration.thy \
  106.89    Lim.thy \
  106.90    Ln.thy \
  106.91 @@ -285,7 +285,6 @@
  106.92    GCD.thy \
  106.93    Parity.thy \
  106.94    Lubs.thy \
  106.95 -  Polynomial.thy \
  106.96    PReal.thy \
  106.97    Rational.thy \
  106.98    RComplete.thy \
  106.99 @@ -314,8 +313,11 @@
 106.100    Library/Euclidean_Space.thy Library/Glbs.thy Library/normarith.ML \
 106.101    Library/Executable_Set.thy Library/Infinite_Set.thy			\
 106.102    Library/FuncSet.thy Library/Permutations.thy Library/Determinants.thy\
 106.103 +  Library/Bit.thy \
 106.104    Library/Finite_Cartesian_Product.thy \
 106.105 +  Library/FrechetDeriv.thy \
 106.106    Library/Fundamental_Theorem_Algebra.thy \
 106.107 +  Library/Inner_Product.thy \
 106.108    Library/Library.thy Library/List_Prefix.thy Library/State_Monad.thy	\
 106.109    Library/Nat_Int_Bij.thy Library/Multiset.thy Library/Permutation.thy	\
 106.110    Library/Primes.thy Library/Pocklington.thy Library/Quotient.thy	\
 106.111 @@ -336,6 +338,10 @@
 106.112    Library/Boolean_Algebra.thy Library/Countable.thy	\
 106.113    Library/RBT.thy	Library/Univ_Poly.thy	\
 106.114    Library/Random.thy	Library/Quickcheck.thy	\
 106.115 +  Library/Poly_Deriv.thy \
 106.116 +  Library/Polynomial.thy \
 106.117 +  Library/Product_plus.thy \
 106.118 +  Library/Product_Vector.thy \
 106.119    Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML $(SRC)/HOL/Tools/float_arith.ML \
 106.120    Library/reify_data.ML Library/reflection.ML
 106.121  	@cd Library; $(ISABELLE_TOOL) usedir $(OUT)/HOL Library
 106.122 @@ -790,15 +796,6 @@
 106.123  	@$(ISABELLE_TOOL) usedir $(OUT)/HOL IOA
 106.124  
 106.125  
 106.126 -## HOL-AxClasses
 106.127 -
 106.128 -HOL-AxClasses: HOL $(LOG)/HOL-AxClasses.gz
 106.129 -
 106.130 -$(LOG)/HOL-AxClasses.gz: $(OUT)/HOL AxClasses/Group.thy			\
 106.131 -  AxClasses/Product.thy AxClasses/ROOT.ML AxClasses/Semigroups.thy
 106.132 -	@$(ISABELLE_TOOL) usedir $(OUT)/HOL AxClasses
 106.133 -
 106.134 -
 106.135  ## HOL-Lattice
 106.136  
 106.137  HOL-Lattice: HOL $(LOG)/HOL-Lattice.gz
 106.138 @@ -814,34 +811,31 @@
 106.139  HOL-ex: HOL $(LOG)/HOL-ex.gz
 106.140  
 106.141  $(LOG)/HOL-ex.gz: $(OUT)/HOL Library/Commutative_Ring.thy		\
 106.142 -  Library/Primes.thy							\
 106.143 -  ex/Abstract_NAT.thy ex/Antiquote.thy ex/Arith_Examples.thy ex/BT.thy	\
 106.144 -  ex/BinEx.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy		\
 106.145 -  ex/Coherent.thy ex/Dense_Linear_Order_Ex.thy ex/Eval_Examples.thy	\
 106.146 -  ex/Groebner_Examples.thy ex/Quickcheck_Generators.thy		\
 106.147 -  ex/Codegenerator.thy ex/Codegenerator_Pretty.thy			\
 106.148 -  ex/CodegenSML_Test.thy ex/Formal_Power_Series_Examples.thy						\
 106.149 -  ex/Commutative_RingEx.thy ex/Efficient_Nat_examples.thy		\
 106.150 -  ex/Hex_Bin_Examples.thy ex/Commutative_Ring_Complete.thy		\
 106.151 -  ex/ExecutableContent.thy ex/Fundefs.thy ex/Guess.thy ex/Hebrew.thy	\
 106.152 -  ex/Binary.thy ex/Higher_Order_Logic.thy ex/Hilbert_Classical.thy	\
 106.153 +  Library/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy		\
 106.154 +  ex/ApproximationEx.thy ex/Arith_Examples.thy				\
 106.155 +  ex/Arithmetic_Series_Complex.thy ex/BT.thy ex/BinEx.thy		\
 106.156 +  ex/Binary.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy		\
 106.157 +  ex/CodegenSML_Test.thy ex/Codegenerator.thy				\
 106.158 +  ex/Codegenerator_Pretty.thy ex/Coherent.thy				\
 106.159 +  ex/Commutative_RingEx.thy ex/Commutative_Ring_Complete.thy		\
 106.160 +  ex/Dense_Linear_Order_Ex.thy ex/Efficient_Nat_examples.thy		\
 106.161 +  ex/Eval_Examples.thy ex/ExecutableContent.thy				\
 106.162 +  ex/Formal_Power_Series_Examples.thy ex/Fundefs.thy			\
 106.163 +  ex/Groebner_Examples.thy ex/Guess.thy ex/HarmonicSeries.thy		\
 106.164 +  ex/Hebrew.thy ex/Hex_Bin_Examples.thy ex/Higher_Order_Logic.thy	\
 106.165 +  ex/Hilbert_Classical.thy ex/ImperativeQuicksort.thy			\
 106.166    ex/Induction_Scheme.thy ex/InductiveInvariant.thy			\
 106.167    ex/InductiveInvariant_examples.thy ex/Intuitionistic.thy		\
 106.168 -  ex/Lagrange.thy ex/LocaleTest2.thy ex/MT.thy		\
 106.169 -  ex/MergeSort.thy ex/MonoidGroup.thy ex/Multiquote.thy ex/NatSum.thy	\
 106.170 +  ex/Lagrange.thy ex/LocaleTest2.thy ex/MT.thy ex/MergeSort.thy		\
 106.171 +  ex/Meson_Test.thy ex/MonoidGroup.thy ex/Multiquote.thy ex/NatSum.thy	\
 106.172    ex/Numeral.thy ex/PER.thy ex/PresburgerEx.thy ex/Primrec.thy		\
 106.173 -  ex/Quickcheck_Examples.thy	\
 106.174 -  ex/ReflectionEx.thy ex/ROOT.ML ex/Recdefs.thy ex/Records.thy		\
 106.175 +  ex/Quickcheck_Examples.thy ex/Quickcheck_Generators.thy ex/ROOT.ML	\
 106.176 +  ex/Recdefs.thy ex/Records.thy ex/ReflectionEx.thy			\
 106.177    ex/Refute_Examples.thy ex/SAT_Examples.thy ex/SVC_Oracle.thy		\
 106.178 -  ex/Subarray.thy ex/Sublist.thy                                        \
 106.179 -  ex/Sudoku.thy ex/Tarski.thy ex/Termination.thy ex/Term_Of_Syntax.thy	\
 106.180 -  ex/Unification.thy ex/document/root.bib			        \
 106.181 -  ex/document/root.tex ex/Meson_Test.thy ex/set.thy	\
 106.182 -  ex/svc_funcs.ML ex/svc_test.thy	\
 106.183 -  ex/ImperativeQuicksort.thy	\
 106.184 -  ex/Arithmetic_Series_Complex.thy ex/HarmonicSeries.thy	\
 106.185 -  ex/Sqrt.thy ex/Sqrt_Script.thy \
 106.186 -  ex/ApproximationEx.thy
 106.187 +  ex/Serbian.thy ex/Sqrt.thy ex/Sqrt_Script.thy ex/Subarray.thy		\
 106.188 +  ex/Sublist.thy ex/Sudoku.thy ex/Tarski.thy ex/Term_Of_Syntax.thy	\
 106.189 +  ex/Termination.thy ex/Unification.thy ex/document/root.bib		\
 106.190 +  ex/document/root.tex ex/set.thy ex/svc_funcs.ML ex/svc_test.thy
 106.191  	@$(ISABELLE_TOOL) usedir $(OUT)/HOL ex
 106.192  
 106.193  
 106.194 @@ -1062,22 +1056,22 @@
 106.195  ## clean
 106.196  
 106.197  clean:
 106.198 -	@rm -f  $(OUT)/HOL-Plain $(OUT)/HOL-Main $(OUT)/HOL $(OUT)/HOL-Nominal $(OUT)/TLA \
 106.199 -		$(LOG)/HOL.gz $(LOG)/TLA.gz \
 106.200 -		$(LOG)/HOL-Isar_examples.gz $(LOG)/HOL-Induct.gz \
 106.201 -		$(LOG)/HOL-ex.gz $(LOG)/HOL-Subst.gz $(LOG)/HOL-IMP.gz \
 106.202 -		$(LOG)/HOL-IMPP.gz $(LOG)/HOL-Hoare.gz \
 106.203 -		$(LOG)/HOL-HoareParallel.gz \
 106.204 -		$(LOG)/HOL-Lex.gz $(LOG)/HOL-Algebra.gz \
 106.205 -		$(LOG)/HOL-Auth.gz $(LOG)/HOL-UNITY.gz \
 106.206 -		$(LOG)/HOL-Modelcheck.gz $(LOG)/HOL-Lambda.gz \
 106.207 -                $(LOG)/HOL-Bali.gz \
 106.208 -		$(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz \
 106.209 -                $(LOG)/HOL-Nominal-Examples.gz \
 106.210 -		$(LOG)/HOL-IOA.gz $(LOG)/HOL-AxClasses \
 106.211 -		$(LOG)/HOL-Lattice $(LOG)/HOL-Matrix \
 106.212 -		$(LOG)/HOL-HahnBanach.gz $(LOG)/HOL-SET-Protocol.gz \
 106.213 -                $(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz $(LOG)/TLA-Memory.gz \
 106.214 -		$(LOG)/HOL-Library.gz $(LOG)/HOL-Unix.gz \
 106.215 -                $(OUT)/HOL-Word $(LOG)/HOL-Word.gz $(LOG)/HOL-Word-Examples.gz \
 106.216 -                $(OUT)/HOL-NSA $(LOG)/HOL-NSA.gz $(LOG)/HOL-NSA-Examples.gz
 106.217 +	@rm -f $(OUT)/HOL-Plain $(OUT)/HOL-Main $(OUT)/HOL		\
 106.218 +		$(OUT)/HOL-Nominal $(OUT)/TLA $(LOG)/HOL.gz		\
 106.219 +		$(LOG)/TLA.gz $(LOG)/HOL-Isar_examples.gz		\
 106.220 +		$(LOG)/HOL-Induct.gz $(LOG)/HOL-ex.gz			\
 106.221 +		$(LOG)/HOL-Subst.gz $(LOG)/HOL-IMP.gz			\
 106.222 +		$(LOG)/HOL-IMPP.gz $(LOG)/HOL-Hoare.gz			\
 106.223 +		$(LOG)/HOL-HoareParallel.gz $(LOG)/HOL-Lex.gz		\
 106.224 +		$(LOG)/HOL-Algebra.gz $(LOG)/HOL-Auth.gz		\
 106.225 +		$(LOG)/HOL-UNITY.gz $(LOG)/HOL-Modelcheck.gz		\
 106.226 +		$(LOG)/HOL-Lambda.gz $(LOG)/HOL-Bali.gz			\
 106.227 +		$(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz		\
 106.228 +		$(LOG)/HOL-Nominal-Examples.gz $(LOG)/HOL-IOA.gz	\
 106.229 +		$(LOG)/HOL-Lattice $(LOG)/HOL-Matrix			\
 106.230 +		$(LOG)/HOL-HahnBanach.gz $(LOG)/HOL-SET-Protocol.gz	\
 106.231 +		$(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz			\
 106.232 +		$(LOG)/TLA-Memory.gz $(LOG)/HOL-Library.gz		\
 106.233 +		$(LOG)/HOL-Unix.gz $(OUT)/HOL-Word $(LOG)/HOL-Word.gz	\
 106.234 +		$(LOG)/HOL-Word-Examples.gz $(OUT)/HOL-NSA		\
 106.235 +		$(LOG)/HOL-NSA.gz $(LOG)/HOL-NSA-Examples.gz
   107.1 --- a/src/HOL/Library/Abstract_Rat.thy	Wed Mar 04 10:43:39 2009 +0100
   107.2 +++ b/src/HOL/Library/Abstract_Rat.thy	Wed Mar 04 10:45:52 2009 +0100
   107.3 @@ -247,7 +247,7 @@
   107.4      (of_int(n div d)::'a::{field, ring_char_0}) = of_int n / of_int d"
   107.5    apply (frule of_int_div_aux [of d n, where ?'a = 'a])
   107.6    apply simp
   107.7 -  apply (simp add: zdvd_iff_zmod_eq_0)
   107.8 +  apply (simp add: dvd_eq_mod_eq_0)
   107.9  done
  107.10  
  107.11  
   108.1 --- a/src/HOL/Library/Boolean_Algebra.thy	Wed Mar 04 10:43:39 2009 +0100
   108.2 +++ b/src/HOL/Library/Boolean_Algebra.thy	Wed Mar 04 10:45:52 2009 +0100
   108.3 @@ -223,7 +223,7 @@
   108.4  lemma xor_left_self [simp]: "x \<oplus> (x \<oplus> y) = y"
   108.5  by (simp only: xor_assoc [symmetric] xor_self xor_zero_left)
   108.6  
   108.7 -lemma xor_compl_left: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
   108.8 +lemma xor_compl_left [simp]: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
   108.9  apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
  108.10  apply (simp only: conj_disj_distribs)
  108.11  apply (simp only: conj_cancel_right conj_cancel_left)
  108.12 @@ -231,7 +231,7 @@
  108.13  apply (simp only: disj_ac conj_ac)
  108.14  done
  108.15  
  108.16 -lemma xor_compl_right: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
  108.17 +lemma xor_compl_right [simp]: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
  108.18  apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
  108.19  apply (simp only: conj_disj_distribs)
  108.20  apply (simp only: conj_cancel_right conj_cancel_left)
  108.21 @@ -239,11 +239,11 @@
  108.22  apply (simp only: disj_ac conj_ac)
  108.23  done
  108.24  
  108.25 -lemma xor_cancel_right [simp]: "x \<oplus> \<sim> x = \<one>"
  108.26 +lemma xor_cancel_right: "x \<oplus> \<sim> x = \<one>"
  108.27  by (simp only: xor_compl_right xor_self compl_zero)
  108.28  
  108.29 -lemma xor_cancel_left [simp]: "\<sim> x \<oplus> x = \<one>"
  108.30 -by (subst xor_commute) (rule xor_cancel_right)
  108.31 +lemma xor_cancel_left: "\<sim> x \<oplus> x = \<one>"
  108.32 +by (simp only: xor_compl_left xor_self compl_zero)
  108.33  
  108.34  lemma conj_xor_distrib: "x \<sqinter> (y \<oplus> z) = (x \<sqinter> y) \<oplus> (x \<sqinter> z)"
  108.35  proof -
   109.1 --- a/src/HOL/Library/Char_nat.thy	Wed Mar 04 10:43:39 2009 +0100
   109.2 +++ b/src/HOL/Library/Char_nat.thy	Wed Mar 04 10:45:52 2009 +0100
   109.3 @@ -132,7 +132,7 @@
   109.4  lemma Char_char_of_nat:
   109.5    "Char n m = char_of_nat (nat_of_nibble n * 16 + nat_of_nibble m)"
   109.6    unfolding char_of_nat_def Let_def nibble_pair_of_nat_def
   109.7 -  by (auto simp add: div_add1_eq mod_add1_eq nat_of_nibble_div_16 nibble_of_nat_norm nibble_of_nat_of_nibble)
   109.8 +  by (auto simp add: div_add1_eq mod_add_eq nat_of_nibble_div_16 nibble_of_nat_norm nibble_of_nat_of_nibble)
   109.9  
  109.10  lemma char_of_nat_of_char:
  109.11    "char_of_nat (nat_of_char c) = c"
  109.12 @@ -165,7 +165,7 @@
  109.13    show ?thesis
  109.14      by (simp add: nat_of_char.simps char_of_nat_def nibble_of_pair
  109.15        nat_of_nibble_of_nat mod_mult_distrib
  109.16 -      n aux3 mod_mult_self3 l_256 aux4 mod_add1_eq [of "256 * k"] l_div_256)
  109.17 +      n aux3 mod_mult_self3 l_256 aux4 mod_add_eq [of "256 * k"] l_div_256)
  109.18  qed
  109.19  
  109.20  lemma nibble_pair_of_nat_char:
   110.1 --- a/src/HOL/Library/Code_Char.thy	Wed Mar 04 10:43:39 2009 +0100
   110.2 +++ b/src/HOL/Library/Code_Char.thy	Wed Mar 04 10:45:52 2009 +0100
   110.3 @@ -1,5 +1,4 @@
   110.4  (*  Title:      HOL/Library/Code_Char.thy
   110.5 -    ID:         $Id$
   110.6      Author:     Florian Haftmann
   110.7  *)
   110.8  
   111.1 --- a/src/HOL/Library/Coinductive_List.thy	Wed Mar 04 10:43:39 2009 +0100
   111.2 +++ b/src/HOL/Library/Coinductive_List.thy	Wed Mar 04 10:45:52 2009 +0100
   111.3 @@ -298,12 +298,12 @@
   111.4        (CONS a M, CONS b N) \<in> EqLList r"
   111.5  
   111.6  lemma EqLList_unfold:
   111.7 -    "EqLList r = dsum (diag {Datatype.Numb 0}) (dprod r (EqLList r))"
   111.8 +    "EqLList r = dsum (Id_on {Datatype.Numb 0}) (dprod r (EqLList r))"
   111.9    by (fast intro!: EqLList.intros [unfolded NIL_def CONS_def]
  111.10             elim: EqLList.cases [unfolded NIL_def CONS_def])
  111.11  
  111.12  lemma EqLList_implies_ntrunc_equality:
  111.13 -    "(M, N) \<in> EqLList (diag A) \<Longrightarrow> ntrunc k M = ntrunc k N"
  111.14 +    "(M, N) \<in> EqLList (Id_on A) \<Longrightarrow> ntrunc k M = ntrunc k N"
  111.15    apply (induct k arbitrary: M N rule: nat_less_induct)
  111.16    apply (erule EqLList.cases)
  111.17     apply (safe del: equalityI)
  111.18 @@ -314,28 +314,28 @@
  111.19     apply (simp_all add: CONS_def less_Suc_eq)
  111.20    done
  111.21  
  111.22 -lemma Domain_EqLList: "Domain (EqLList (diag A)) \<subseteq> LList A"
  111.23 +lemma Domain_EqLList: "Domain (EqLList (Id_on A)) \<subseteq> LList A"
  111.24    apply (rule subsetI)
  111.25    apply (erule LList.coinduct)
  111.26    apply (subst (asm) EqLList_unfold)
  111.27    apply (auto simp add: NIL_def CONS_def)
  111.28    done
  111.29  
  111.30 -lemma EqLList_diag: "EqLList (diag A) = diag (LList A)"
  111.31 +lemma EqLList_Id_on: "EqLList (Id_on A) = Id_on (LList A)"
  111.32    (is "?lhs = ?rhs")
  111.33  proof
  111.34    show "?lhs \<subseteq> ?rhs"
  111.35      apply (rule subsetI)
  111.36      apply (rule_tac p = x in PairE)
  111.37      apply clarify
  111.38 -    apply (rule diag_eqI)
  111.39 +    apply (rule Id_on_eqI)
  111.40       apply (rule EqLList_implies_ntrunc_equality [THEN ntrunc_equality],
  111.41         assumption)
  111.42      apply (erule DomainI [THEN Domain_EqLList [THEN subsetD]])
  111.43      done
  111.44    {
  111.45 -    fix M N assume "(M, N) \<in> diag (LList A)"
  111.46 -    then have "(M, N) \<in> EqLList (diag A)"
  111.47 +    fix M N assume "(M, N) \<in> Id_on (LList A)"
  111.48 +    then have "(M, N) \<in> EqLList (Id_on A)"
  111.49      proof coinduct
  111.50        case (EqLList M N)
  111.51        then obtain L where L: "L \<in> LList A" and MN: "M = L" "N = L" by blast
  111.52 @@ -344,7 +344,7 @@
  111.53          case NIL with MN have ?EqNIL by simp
  111.54          then show ?thesis ..
  111.55        next
  111.56 -        case CONS with MN have ?EqCONS by (simp add: diagI)
  111.57 +        case CONS with MN have ?EqCONS by (simp add: Id_onI)
  111.58          then show ?thesis ..
  111.59        qed
  111.60      qed
  111.61 @@ -352,8 +352,8 @@
  111.62    then show "?rhs \<subseteq> ?lhs" by auto
  111.63  qed
  111.64  
  111.65 -lemma EqLList_diag_iff [iff]: "(p \<in> EqLList (diag A)) = (p \<in> diag (LList A))"
  111.66 -  by (simp only: EqLList_diag)
  111.67 +lemma EqLList_Id_on_iff [iff]: "(p \<in> EqLList (Id_on A)) = (p \<in> Id_on (LList A))"
  111.68 +  by (simp only: EqLList_Id_on)
  111.69  
  111.70  
  111.71  text {*
  111.72 @@ -367,11 +367,11 @@
  111.73      and step: "\<And>M N. (M, N) \<in> r \<Longrightarrow>
  111.74        M = NIL \<and> N = NIL \<or>
  111.75          (\<exists>a b M' N'.
  111.76 -          M = CONS a M' \<and> N = CONS b N' \<and> (a, b) \<in> diag A \<and>
  111.77 -            ((M', N') \<in> r \<or> (M', N') \<in> EqLList (diag A)))"
  111.78 +          M = CONS a M' \<and> N = CONS b N' \<and> (a, b) \<in> Id_on A \<and>
  111.79 +            ((M', N') \<in> r \<or> (M', N') \<in> EqLList (Id_on A)))"
  111.80    shows "M = N"
  111.81  proof -
  111.82 -  from r have "(M, N) \<in> EqLList (diag A)"
  111.83 +  from r have "(M, N) \<in> EqLList (Id_on A)"
  111.84    proof coinduct
  111.85      case EqLList
  111.86      then show ?case by (rule step)
  111.87 @@ -387,8 +387,8 @@
  111.88              (f (CONS x l), g (CONS x l)) = (NIL, NIL) \<or>
  111.89              (\<exists>M N a b.
  111.90                (f (CONS x l), g (CONS x l)) = (CONS a M, CONS b N) \<and>
  111.91 -                (a, b) \<in> diag A \<and>
  111.92 -                (M, N) \<in> {(f u, g u) | u. u \<in> LList A} \<union> diag (LList A))"
  111.93 +                (a, b) \<in> Id_on A \<and>
  111.94 +                (M, N) \<in> {(f u, g u) | u. u \<in> LList A} \<union> Id_on (LList A))"
  111.95        (is "\<And>x l. _ \<Longrightarrow> _ \<Longrightarrow> ?fun_CONS x l")
  111.96    shows "f M = g M"
  111.97  proof -
  111.98 @@ -401,8 +401,8 @@
  111.99      from L show ?case
 111.100      proof (cases L)
 111.101        case NIL
 111.102 -      with fun_NIL and MN have "(M, N) \<in> diag (LList A)" by auto
 111.103 -      then have "(M, N) \<in> EqLList (diag A)" ..
 111.104 +      with fun_NIL and MN have "(M, N) \<in> Id_on (LList A)" by auto
 111.105 +      then have "(M, N) \<in> EqLList (Id_on A)" ..
 111.106        then show ?thesis by cases simp_all
 111.107      next
 111.108        case (CONS a K)
 111.109 @@ -411,23 +411,23 @@
 111.110        then show ?thesis
 111.111        proof
 111.112          assume ?NIL
 111.113 -        with MN CONS have "(M, N) \<in> diag (LList A)" by auto
 111.114 -        then have "(M, N) \<in> EqLList (diag A)" ..
 111.115 +        with MN CONS have "(M, N) \<in> Id_on (LList A)" by auto
 111.116 +        then have "(M, N) \<in> EqLList (Id_on A)" ..
 111.117          then show ?thesis by cases simp_all
 111.118        next
 111.119          assume ?CONS
 111.120          with CONS obtain a b M' N' where
 111.121              fg: "(f L, g L) = (CONS a M', CONS b N')"
 111.122 -          and ab: "(a, b) \<in> diag A"
 111.123 -          and M'N': "(M', N') \<in> ?bisim \<union> diag (LList A)"
 111.124 +          and ab: "(a, b) \<in> Id_on A"
 111.125 +          and M'N': "(M', N') \<in> ?bisim \<union> Id_on (LList A)"
 111.126            by blast
 111.127          from M'N' show ?thesis
 111.128          proof
 111.129            assume "(M', N') \<in> ?bisim"
 111.130            with MN fg ab show ?thesis by simp
 111.131          next
 111.132 -          assume "(M', N') \<in> diag (LList A)"
 111.133 -          then have "(M', N') \<in> EqLList (diag A)" ..
 111.134 +          assume "(M', N') \<in> Id_on (LList A)"
 111.135 +          then have "(M', N') \<in> EqLList (Id_on A)" ..
 111.136            with MN fg ab show ?thesis by simp
 111.137          qed
 111.138        qed
 111.139 @@ -463,7 +463,7 @@
 111.140        with h h' MN have "M = CONS (fst p) (h (snd p))"
 111.141  	and "N = CONS (fst p) (h' (snd p))"
 111.142          by (simp_all split: prod.split)
 111.143 -      then have ?EqCONS by (auto iff: diag_iff)
 111.144 +      then have ?EqCONS by (auto iff: Id_on_iff)
 111.145        then show ?thesis ..
 111.146      qed
 111.147    qed
 111.148 @@ -498,7 +498,7 @@
 111.149      next
 111.150        assume "?EqLCons (l1, l2)"
 111.151        with MN have ?EqCONS
 111.152 -        by (force simp add: Rep_llist_LCons EqLList_diag intro: Rep_llist_UNIV)
 111.153 +        by (force simp add: Rep_llist_LCons EqLList_Id_on intro: Rep_llist_UNIV)
 111.154        then show ?thesis ..
 111.155      qed
 111.156    qed
   112.1 --- a/src/HOL/Library/Determinants.thy	Wed Mar 04 10:43:39 2009 +0100
   112.2 +++ b/src/HOL/Library/Determinants.thy	Wed Mar 04 10:45:52 2009 +0100
   112.3 @@ -1048,7 +1048,7 @@
   112.4    note th0 = this
   112.5    let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
   112.6    {fix x:: "real ^'n" assume nx: "norm x = 1"
   112.7 -    have "?g x = f x" using nx by (simp add: norm_eq_0[symmetric])}
   112.8 +    have "?g x = f x" using nx by auto}
   112.9    hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
  112.10    have g0: "?g 0 = 0" by simp
  112.11    {fix x y :: "real ^'n"
  112.12 @@ -1057,15 +1057,15 @@
  112.13      moreover
  112.14      {assume "x = 0" "y \<noteq> 0"
  112.15        then have "dist (?g x) (?g y) = dist x y" 
  112.16 -	apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
  112.17 +	apply (simp add: dist_def norm_mul)
  112.18  	apply (rule f1[rule_format])
  112.19 -	by(simp add: norm_mul norm_eq_0 field_simps)}
  112.20 +	by(simp add: norm_mul field_simps)}
  112.21      moreover
  112.22      {assume "x \<noteq> 0" "y = 0"
  112.23        then have "dist (?g x) (?g y) = dist x y" 
  112.24 -	apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
  112.25 +	apply (simp add: dist_def norm_mul)
  112.26  	apply (rule f1[rule_format])
  112.27 -	by(simp add: norm_mul norm_eq_0 field_simps)}
  112.28 +	by(simp add: norm_mul field_simps)}
  112.29      moreover
  112.30      {assume z: "x \<noteq> 0" "y \<noteq> 0"
  112.31        have th00: "x = norm x *s inverse (norm x) *s x" "y = norm y *s inverse (norm y) *s y" "norm x *s f (inverse (norm x) *s x) = norm x *s f (inverse (norm x) *s x)"
  112.32 @@ -1077,7 +1077,7 @@
  112.33  	"norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
  112.34  	norm (inverse (norm x) *s x - inverse (norm y) *s y)"
  112.35  	using z
  112.36 -	by (auto simp add: norm_eq_0 vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
  112.37 +	by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
  112.38        from z th0[OF th00] have "dist (?g x) (?g y) = dist x y" 
  112.39  	by (simp add: dist_def)}
  112.40      ultimately have "dist (?g x) (?g y) = dist x y" by blast}
  112.41 @@ -1148,4 +1148,4 @@
  112.42    by (simp add: ring_simps)
  112.43  qed
  112.44  
  112.45 -end
  112.46 \ No newline at end of file
  112.47 +end
   113.1 --- a/src/HOL/Library/Enum.thy	Wed Mar 04 10:43:39 2009 +0100
   113.2 +++ b/src/HOL/Library/Enum.thy	Wed Mar 04 10:45:52 2009 +0100
   113.3 @@ -1,5 +1,4 @@
   113.4  (*  Title:      HOL/Library/Enum.thy
   113.5 -    ID:         $Id$
   113.6      Author:     Florian Haftmann, TU Muenchen
   113.7  *)
   113.8  
   114.1 --- a/src/HOL/Library/Euclidean_Space.thy	Wed Mar 04 10:43:39 2009 +0100
   114.2 +++ b/src/HOL/Library/Euclidean_Space.thy	Wed Mar 04 10:45:52 2009 +0100
   114.3 @@ -8,6 +8,7 @@
   114.4  theory Euclidean_Space
   114.5    imports "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Complex_Main 
   114.6    Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
   114.7 +  Inner_Product
   114.8    uses ("normarith.ML")
   114.9  begin
  114.10  
  114.11 @@ -84,7 +85,13 @@
  114.12  instance by (intro_classes)
  114.13  end
  114.14  
  114.15 -text{* Also the scalar-vector multiplication. FIXME: We should unify this with the scalar multiplication in @{text real_vector} *}
  114.16 +instantiation "^" :: (scaleR, type) scaleR
  114.17 +begin
  114.18 +definition vector_scaleR_def: "scaleR = (\<lambda> r x.  (\<chi> i. scaleR r (x$i)))" 
  114.19 +instance ..
  114.20 +end
  114.21 +
  114.22 +text{* Also the scalar-vector multiplication. *}
  114.23  
  114.24  definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixr "*s" 75)
  114.25    where "c *s x = (\<chi> i. c * (x$i))"
  114.26 @@ -118,6 +125,7 @@
  114.27               [@{thm vector_add_def}, @{thm vector_mult_def},  
  114.28                @{thm vector_minus_def}, @{thm vector_uminus_def}, 
  114.29                @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def}, 
  114.30 +              @{thm vector_scaleR_def},
  114.31                @{thm Cart_lambda_beta'}, @{thm vector_scalar_mult_def}]
  114.32   fun vector_arith_tac ths = 
  114.33     simp_tac ss1
  114.34 @@ -166,9 +174,18 @@
  114.35    shows "(- x)$i = - (x$i)"
  114.36    using i by vector
  114.37  
  114.38 +lemma vector_scaleR_component:
  114.39 +  fixes x :: "'a::scaleR ^ 'n"
  114.40 +  assumes i: "i \<in> {1 .. dimindex(UNIV :: 'n set)}"
  114.41 +  shows "(scaleR r x)$i = scaleR r (x$i)"
  114.42 +  using i by vector
  114.43 +
  114.44  lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
  114.45  
  114.46 -lemmas vector_component = vec_component vector_add_component vector_mult_component vector_smult_component vector_minus_component vector_uminus_component cond_component 
  114.47 +lemmas vector_component =
  114.48 +  vec_component vector_add_component vector_mult_component
  114.49 +  vector_smult_component vector_minus_component vector_uminus_component
  114.50 +  vector_scaleR_component cond_component
  114.51  
  114.52  subsection {* Some frequently useful arithmetic lemmas over vectors. *}
  114.53  
  114.54 @@ -199,6 +216,9 @@
  114.55    apply (intro_classes)
  114.56    by (vector Cart_eq)
  114.57  
  114.58 +instance "^" :: (real_vector, type) real_vector
  114.59 +  by default (vector scaleR_left_distrib scaleR_right_distrib)+
  114.60 +
  114.61  instance "^" :: (semigroup_mult,type) semigroup_mult 
  114.62    apply (intro_classes) by (vector mult_assoc)
  114.63  
  114.64 @@ -242,6 +262,18 @@
  114.65  instance "^" :: (ring,type) ring by (intro_classes) 
  114.66  instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes) 
  114.67  instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
  114.68 +
  114.69 +instance "^" :: (ring_1,type) ring_1 ..
  114.70 +
  114.71 +instance "^" :: (real_algebra,type) real_algebra
  114.72 +  apply intro_classes
  114.73 +  apply (simp_all add: vector_scaleR_def ring_simps)
  114.74 +  apply vector
  114.75 +  apply vector
  114.76 +  done
  114.77 +
  114.78 +instance "^" :: (real_algebra_1,type) real_algebra_1 ..
  114.79 +
  114.80  lemma of_nat_index: 
  114.81    "i\<in>{1 .. dimindex (UNIV :: 'n set)} \<Longrightarrow> (of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
  114.82    apply (induct n)
  114.83 @@ -290,8 +322,7 @@
  114.84  qed
  114.85  
  114.86  instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
  114.87 -  (* FIXME!!! Why does the axclass package complain here !!*)
  114.88 -(* instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes *)
  114.89 +instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
  114.90  
  114.91  lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"  
  114.92    by (vector mult_assoc)
  114.93 @@ -314,6 +345,241 @@
  114.94    apply (auto simp add: vec_def Cart_eq vec_component Cart_lambda_beta )
  114.95    using dimindex_ge_1 apply auto done
  114.96  
  114.97 +subsection {* Square root of sum of squares *}
  114.98 +
  114.99 +definition
 114.100 +  "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
 114.101 +
 114.102 +lemma setL2_cong:
 114.103 +  "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
 114.104 +  unfolding setL2_def by simp
 114.105 +
 114.106 +lemma strong_setL2_cong:
 114.107 +  "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
 114.108 +  unfolding setL2_def simp_implies_def by simp
 114.109 +
 114.110 +lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
 114.111 +  unfolding setL2_def by simp
 114.112 +
 114.113 +lemma setL2_empty [simp]: "setL2 f {} = 0"
 114.114 +  unfolding setL2_def by simp
 114.115 +
 114.116 +lemma setL2_insert [simp]:
 114.117 +  "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
 114.118 +    setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
 114.119 +  unfolding setL2_def by (simp add: setsum_nonneg)
 114.120 +
 114.121 +lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
 114.122 +  unfolding setL2_def by (simp add: setsum_nonneg)
 114.123 +
 114.124 +lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
 114.125 +  unfolding setL2_def by simp
 114.126 +
 114.127 +lemma setL2_mono:
 114.128 +  assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
 114.129 +  assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
 114.130 +  shows "setL2 f K \<le> setL2 g K"
 114.131 +  unfolding setL2_def
 114.132 +  by (simp add: setsum_nonneg setsum_mono power_mono prems)
 114.133 +
 114.134 +lemma setL2_right_distrib:
 114.135 +  "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
 114.136 +  unfolding setL2_def
 114.137 +  apply (simp add: power_mult_distrib)
 114.138 +  apply (simp add: setsum_right_distrib [symmetric])
 114.139 +  apply (simp add: real_sqrt_mult setsum_nonneg)
 114.140 +  done
 114.141 +
 114.142 +lemma setL2_left_distrib:
 114.143 +  "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
 114.144 +  unfolding setL2_def
 114.145 +  apply (simp add: power_mult_distrib)
 114.146 +  apply (simp add: setsum_left_distrib [symmetric])
 114.147 +  apply (simp add: real_sqrt_mult setsum_nonneg)
 114.148 +  done
 114.149 +
 114.150 +lemma setsum_nonneg_eq_0_iff:
 114.151 +  fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
 114.152 +  shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
 114.153 +  apply (induct set: finite, simp)
 114.154 +  apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
 114.155 +  done
 114.156 +
 114.157 +lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
 114.158 +  unfolding setL2_def
 114.159 +  by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
 114.160 +
 114.161 +lemma setL2_triangle_ineq:
 114.162 +  shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
 114.163 +proof (cases "finite A")
 114.164 +  case False
 114.165 +  thus ?thesis by simp
 114.166 +next
 114.167 +  case True
 114.168 +  thus ?thesis
 114.169 +  proof (induct set: finite)
 114.170 +    case empty
 114.171 +    show ?case by simp
 114.172 +  next
 114.173 +    case (insert x F)
 114.174 +    hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
 114.175 +           sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
 114.176 +      by (intro real_sqrt_le_mono add_left_mono power_mono insert
 114.177 +                setL2_nonneg add_increasing zero_le_power2)
 114.178 +    also have
 114.179 +      "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
 114.180 +      by (rule real_sqrt_sum_squares_triangle_ineq)
 114.181 +    finally show ?case
 114.182 +      using insert by simp
 114.183 +  qed
 114.184 +qed
 114.185 +
 114.186 +lemma sqrt_sum_squares_le_sum:
 114.187 +  "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
 114.188 +  apply (rule power2_le_imp_le)
 114.189 +  apply (simp add: power2_sum)
 114.190 +  apply (simp add: mult_nonneg_nonneg)
 114.191 +  apply (simp add: add_nonneg_nonneg)
 114.192 +  done
 114.193 +
 114.194 +lemma setL2_le_setsum [rule_format]:
 114.195 +  "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
 114.196 +  apply (cases "finite A")
 114.197 +  apply (induct set: finite)
 114.198 +  apply simp
 114.199 +  apply clarsimp
 114.200 +  apply (erule order_trans [OF sqrt_sum_squares_le_sum])
 114.201 +  apply simp
 114.202 +  apply simp
 114.203 +  apply simp
 114.204 +  done
 114.205 +
 114.206 +lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
 114.207 +  apply (rule power2_le_imp_le)
 114.208 +  apply (simp add: power2_sum)
 114.209 +  apply (simp add: mult_nonneg_nonneg)
 114.210 +  apply (simp add: add_nonneg_nonneg)
 114.211 +  done
 114.212 +
 114.213 +lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
 114.214 +  apply (cases "finite A")
 114.215 +  apply (induct set: finite)
 114.216 +  apply simp
 114.217 +  apply simp
 114.218 +  apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
 114.219 +  apply simp
 114.220 +  apply simp
 114.221 +  done
 114.222 +
 114.223 +lemma setL2_mult_ineq_lemma:
 114.224 +  fixes a b c d :: real
 114.225 +  shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
 114.226 +proof -
 114.227 +  have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
 114.228 +  also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
 114.229 +    by (simp only: power2_diff power_mult_distrib)
 114.230 +  also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
 114.231 +    by simp
 114.232 +  finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
 114.233 +    by simp
 114.234 +qed
 114.235 +
 114.236 +lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
 114.237 +  apply (cases "finite A")
 114.238 +  apply (induct set: finite)
 114.239 +  apply simp
 114.240 +  apply (rule power2_le_imp_le, simp)
 114.241 +  apply (rule order_trans)
 114.242 +  apply (rule power_mono)
 114.243 +  apply (erule add_left_mono)
 114.244 +  apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
 114.245 +  apply (simp add: power2_sum)
 114.246 +  apply (simp add: power_mult_distrib)
 114.247 +  apply (simp add: right_distrib left_distrib)
 114.248 +  apply (rule ord_le_eq_trans)
 114.249 +  apply (rule setL2_mult_ineq_lemma)
 114.250 +  apply simp
 114.251 +  apply (intro mult_nonneg_nonneg setL2_nonneg)
 114.252 +  apply simp
 114.253 +  done
 114.254 +
 114.255 +lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
 114.256 +  apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
 114.257 +  apply fast
 114.258 +  apply (subst setL2_insert)
 114.259 +  apply simp
 114.260 +  apply simp
 114.261 +  apply simp
 114.262 +  done
 114.263 +
 114.264 +subsection {* Norms *}
 114.265 +
 114.266 +instantiation "^" :: (real_normed_vector, type) real_normed_vector
 114.267 +begin
 114.268 +
 114.269 +definition vector_norm_def:
 114.270 +  "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) {1 .. dimindex (UNIV:: 'b set)}"
 114.271 +
 114.272 +definition vector_sgn_def:
 114.273 +  "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
 114.274 +
 114.275 +instance proof
 114.276 +  fix a :: real and x y :: "'a ^ 'b"
 114.277 +  show "0 \<le> norm x"
 114.278 +    unfolding vector_norm_def
 114.279 +    by (rule setL2_nonneg)
 114.280 +  show "norm x = 0 \<longleftrightarrow> x = 0"
 114.281 +    unfolding vector_norm_def
 114.282 +    by (simp add: setL2_eq_0_iff Cart_eq)
 114.283 +  show "norm (x + y) \<le> norm x + norm y"
 114.284 +    unfolding vector_norm_def
 114.285 +    apply (rule order_trans [OF _ setL2_triangle_ineq])
 114.286 +    apply (rule setL2_mono)
 114.287 +    apply (simp add: vector_component norm_triangle_ineq)
 114.288 +    apply simp
 114.289 +    done
 114.290 +  show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
 114.291 +    unfolding vector_norm_def
 114.292 +    by (simp add: vector_component norm_scaleR setL2_right_distrib
 114.293 +             cong: strong_setL2_cong)
 114.294 +  show "sgn x = scaleR (inverse (norm x)) x"
 114.295 +    by (rule vector_sgn_def)
 114.296 +qed
 114.297 +
 114.298 +end
 114.299 +
 114.300 +subsection {* Inner products *}
 114.301 +
 114.302 +instantiation "^" :: (real_inner, type) real_inner
 114.303 +begin
 114.304 +
 114.305 +definition vector_inner_def:
 114.306 +  "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) {1 .. dimindex(UNIV::'b set)}"
 114.307 +
 114.308 +instance proof
 114.309 +  fix r :: real and x y z :: "'a ^ 'b"
 114.310 +  show "inner x y = inner y x"
 114.311 +    unfolding vector_inner_def
 114.312 +    by (simp add: inner_commute)
 114.313 +  show "inner (x + y) z = inner x z + inner y z"
 114.314 +    unfolding vector_inner_def
 114.315 +    by (vector inner_left_distrib)
 114.316 +  show "inner (scaleR r x) y = r * inner x y"
 114.317 +    unfolding vector_inner_def
 114.318 +    by (vector inner_scaleR_left)
 114.319 +  show "0 \<le> inner x x"
 114.320 +    unfolding vector_inner_def
 114.321 +    by (simp add: setsum_nonneg)
 114.322 +  show "inner x x = 0 \<longleftrightarrow> x = 0"
 114.323 +    unfolding vector_inner_def
 114.324 +    by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
 114.325 +  show "norm x = sqrt (inner x x)"
 114.326 +    unfolding vector_inner_def vector_norm_def setL2_def
 114.327 +    by (simp add: power2_norm_eq_inner)
 114.328 +qed
 114.329 +
 114.330 +end
 114.331 +
 114.332  subsection{* Properties of the dot product.  *}
 114.333  
 114.334  lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x" 
 114.335 @@ -363,18 +629,7 @@
 114.336  lemma dot_pos_lt: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x] 
 114.337    by (auto simp add: le_less) 
 114.338  
 114.339 -subsection {* Introduce norms, but defer many properties till we get square roots. *}
 114.340 -text{* FIXME : This is ugly *}
 114.341 -defs (overloaded) 
 114.342 -  real_of_real_def [code inline, simp]: "real == id"
 114.343 -
 114.344 -instantiation "^" :: ("{times, comm_monoid_add}", type) norm begin
 114.345 -definition  real_vector_norm_def: "norm \<equiv> (\<lambda>x. sqrt (real (x \<bullet> x)))" 
 114.346 -instance ..
 114.347 -end
 114.348 -
 114.349 -
 114.350 -subsection{* The collapse of the general concepts to dimention one. *}
 114.351 +subsection{* The collapse of the general concepts to dimension one. *}
 114.352  
 114.353  lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
 114.354    by (vector dimindex_def)
 114.355 @@ -385,11 +640,15 @@
 114.356    apply (simp only: vector_one[symmetric])
 114.357    done
 114.358  
 114.359 +lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
 114.360 +  by (simp add: vector_norm_def dimindex_def)
 114.361 +
 114.362  lemma norm_real: "norm(x::real ^ 1) = abs(x$1)" 
 114.363 -  by (simp add: real_vector_norm_def)
 114.364 +  by (simp add: norm_vector_1)
 114.365  
 114.366  text{* Metric *}
 114.367  
 114.368 +text {* FIXME: generalize to arbitrary @{text real_normed_vector} types *}
 114.369  definition dist:: "real ^ 'n \<Rightarrow> real ^ 'n \<Rightarrow> real" where 
 114.370    "dist x y = norm (x - y)"
 114.371  
 114.372 @@ -501,27 +760,18 @@
 114.373  text{* Hence derive more interesting properties of the norm. *}
 114.374  
 114.375  lemma norm_0: "norm (0::real ^ 'n) = 0"
 114.376 -  by (simp add: real_vector_norm_def dot_eq_0)
 114.377 -
 114.378 -lemma norm_pos_le: "0 <= norm (x::real^'n)" 
 114.379 -  by (simp add: real_vector_norm_def dot_pos_le)
 114.380 -lemma norm_neg: " norm(-x) = norm (x:: real ^ 'n)" 
 114.381 -  by (simp add: real_vector_norm_def dot_lneg dot_rneg)
 114.382 -lemma norm_sub: "norm(x - y) = norm(y - (x::real ^ 'n))" 
 114.383 -  by (metis norm_neg minus_diff_eq)
 114.384 +  by (rule norm_zero)
 114.385 +
 114.386  lemma norm_mul: "norm(a *s x) = abs(a) * norm x"
 114.387 -  by (simp add: real_vector_norm_def dot_lmult dot_rmult mult_assoc[symmetric] real_sqrt_mult)
 114.388 +  by (simp add: vector_norm_def vector_component setL2_right_distrib
 114.389 +           abs_mult cong: strong_setL2_cong)
 114.390  lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
 114.391 +  by (simp add: vector_norm_def dot_def setL2_def power2_eq_square)
 114.392 +lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
 114.393 +  by (simp add: vector_norm_def setL2_def dot_def power2_eq_square)
 114.394 +lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
 114.395    by (simp add: real_vector_norm_def)
 114.396 -lemma norm_eq_0: "norm x = 0 \<longleftrightarrow> x = (0::real ^ 'n)"
 114.397 -  by (simp add: real_vector_norm_def dot_eq_0)
 114.398 -lemma norm_pos_lt: "0 < norm x \<longleftrightarrow> x \<noteq> (0::real ^ 'n)"
 114.399 -  by (metis less_le real_vector_norm_def norm_pos_le norm_eq_0)
 114.400 -lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
 114.401 -  by (simp add: real_vector_norm_def dot_pos_le)
 114.402 -lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_0)
 114.403 -lemma norm_le_0: "norm x <= 0 \<longleftrightarrow> x = (0::real ^'n)"
 114.404 -  by (metis norm_eq_0 norm_pos_le order_antisym) 
 114.405 +lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero)
 114.406  lemma vector_mul_eq_0: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
 114.407    by vector
 114.408  lemma vector_mul_lcancel: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
 114.409 @@ -535,14 +785,14 @@
 114.410  lemma norm_cauchy_schwarz: "x \<bullet> y <= norm x * norm y"
 114.411  proof-
 114.412    {assume "norm x = 0"
 114.413 -    hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
 114.414 +    hence ?thesis by (simp add: dot_lzero dot_rzero)}
 114.415    moreover
 114.416    {assume "norm y = 0" 
 114.417 -    hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
 114.418 +    hence ?thesis by (simp add: dot_lzero dot_rzero)}
 114.419    moreover
 114.420    {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
 114.421      let ?z = "norm y *s x - norm x *s y"
 114.422 -    from h have p: "norm x * norm y > 0" by (metis norm_pos_le le_less zero_compare_simps)
 114.423 +    from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
 114.424      from dot_pos_le[of ?z]
 114.425      have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
 114.426        apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
 114.427 @@ -553,26 +803,16 @@
 114.428    ultimately show ?thesis by metis
 114.429  qed
 114.430  
 114.431 -lemma norm_abs[simp]: "abs (norm x) = norm (x::real ^'n)" 
 114.432 -  using norm_pos_le[of x] by (simp add: real_abs_def linorder_linear)
 114.433 -
 114.434  lemma norm_cauchy_schwarz_abs: "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
 114.435    using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
 114.436 -  by (simp add: real_abs_def dot_rneg norm_neg)
 114.437 -lemma norm_triangle: "norm(x + y) <= norm x + norm (y::real ^'n)"
 114.438 -  unfolding real_vector_norm_def
 114.439 -  apply (rule real_le_lsqrt)
 114.440 -  apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
 114.441 -  apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
 114.442 -  apply (simp add: dot_ladd dot_radd dot_sym )
 114.443 -    by (simp add: norm_pow_2[symmetric] power2_eq_square ring_simps norm_cauchy_schwarz)
 114.444 +  by (simp add: real_abs_def dot_rneg)
 114.445  
 114.446  lemma norm_triangle_sub: "norm (x::real ^'n) <= norm(y) + norm(x - y)"
 114.447 -  using norm_triangle[of "y" "x - y"] by (simp add: ring_simps)
 114.448 +  using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
 114.449  lemma norm_triangle_le: "norm(x::real ^'n) + norm y <= e ==> norm(x + y) <= e"
 114.450 -  by (metis order_trans norm_triangle)
 114.451 +  by (metis order_trans norm_triangle_ineq)
 114.452  lemma norm_triangle_lt: "norm(x::real ^'n) + norm(y) < e ==> norm(x + y) < e"
 114.453 -  by (metis basic_trans_rules(21) norm_triangle)
 114.454 +  by (metis basic_trans_rules(21) norm_triangle_ineq)
 114.455  
 114.456  lemma setsum_delta: 
 114.457    assumes fS: "finite S"
 114.458 @@ -597,19 +837,10 @@
 114.459  qed
 114.460    
 114.461  lemma component_le_norm: "i \<in> {1 .. dimindex(UNIV :: 'n set)} ==> \<bar>x$i\<bar> <= norm (x::real ^ 'n)"
 114.462 -proof(simp add: real_vector_norm_def, rule real_le_rsqrt, clarsimp)
 114.463 -  assume i: "Suc 0 \<le> i" "i \<le> dimindex (UNIV :: 'n set)"
 114.464 -  let ?S = "{1 .. dimindex(UNIV :: 'n set)}"
 114.465 -  let ?f = "(\<lambda>k. if k = i then x$i ^2 else 0)"
 114.466 -  have fS: "finite ?S" by simp
 114.467 -  from i setsum_delta[OF fS, of i "\<lambda>k. x$i ^ 2"]
 114.468 -  have th: "x$i^2 = setsum ?f ?S" by simp
 114.469 -  let ?g = "\<lambda>k. x$k * x$k"
 114.470 -  {fix x assume x: "x \<in> ?S" have "?f x \<le> ?g x" by (simp add: power2_eq_square)}
 114.471 -  with setsum_mono[of ?S ?f ?g] 
 114.472 -  have "setsum ?f ?S \<le> setsum ?g ?S" by blast 
 114.473 -  then show "x$i ^2 \<le> x \<bullet> (x:: real ^ 'n)" unfolding dot_def th[symmetric] .
 114.474 -qed    
 114.475 +  apply (simp add: vector_norm_def)
 114.476 +  apply (rule member_le_setL2, simp_all)
 114.477 +  done
 114.478 +
 114.479  lemma norm_bound_component_le: "norm(x::real ^ 'n) <= e
 114.480                  ==> \<forall>i \<in> {1 .. dimindex(UNIV:: 'n set)}. \<bar>x$i\<bar> <= e"
 114.481    by (metis component_le_norm order_trans)
 114.482 @@ -619,24 +850,12 @@
 114.483    by (metis component_le_norm basic_trans_rules(21))
 114.484  
 114.485  lemma norm_le_l1: "norm (x:: real ^'n) <= setsum(\<lambda>i. \<bar>x$i\<bar>) {1..dimindex(UNIV::'n set)}"
 114.486 -proof (simp add: real_vector_norm_def, rule real_le_lsqrt,simp add: dot_pos_le, simp add: setsum_mono, simp add: dot_def, induct "dimindex(UNIV::'n set)")
 114.487 -  case 0 thus ?case by simp
 114.488 -next
 114.489 -  case (Suc n)
 114.490 -  have th: "2 * (\<bar>x$(Suc n)\<bar> * (\<Sum>i = Suc 0..n. \<bar>x$i\<bar>)) \<ge> 0" 
 114.491 -    apply simp
 114.492 -    apply (rule mult_nonneg_nonneg)
 114.493 -    by (simp_all add: setsum_abs_ge_zero)
 114.494 -  
 114.495 -  from Suc
 114.496 -  show ?case using th by (simp add: power2_eq_square ring_simps)
 114.497 -qed
 114.498 +  by (simp add: vector_norm_def setL2_le_setsum)
 114.499  
 114.500  lemma real_abs_norm: "\<bar> norm x\<bar> = norm (x :: real ^'n)" 
 114.501 -  by (simp add: norm_pos_le)
 114.502 +  by (rule abs_norm_cancel)
 114.503  lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n) - norm y\<bar> <= norm(x - y)"
 114.504 -  apply (simp add: abs_le_iff ring_simps)
 114.505 -  by (metis norm_triangle_sub norm_sub)
 114.506 +  by (rule norm_triangle_ineq3)
 114.507  lemma norm_le: "norm(x::real ^ 'n) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
 114.508    by (simp add: real_vector_norm_def)
 114.509  lemma norm_lt: "norm(x::real ^'n) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
 114.510 @@ -652,13 +871,7 @@
 114.511    by (simp add: real_vector_norm_def  dot_pos_le )
 114.512  
 114.513  lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
 114.514 -proof-
 114.515 -  have th: "\<And>x y::real. x^2 = y^2 \<longleftrightarrow> x = y \<or> x = -y" by algebra
 114.516 -  show ?thesis using norm_pos_le[of x]
 114.517 -  apply (simp add: dot_square_norm th)
 114.518 -  apply arith
 114.519 -  done
 114.520 -qed
 114.521 +  by (auto simp add: real_vector_norm_def)
 114.522  
 114.523  lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
 114.524  proof-
 114.525 @@ -668,14 +881,14 @@
 114.526  qed
 114.527  
 114.528  lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
 114.529 -  using norm_pos_le[of x]
 114.530    apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
 114.531 +  using norm_ge_zero[of x]
 114.532    apply arith
 114.533    done
 114.534  
 114.535  lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2" 
 114.536 -  using norm_pos_le[of x]
 114.537    apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
 114.538 +  using norm_ge_zero[of x]
 114.539    apply arith
 114.540    done
 114.541  
 114.542 @@ -746,14 +959,14 @@
 114.543  lemma pth_d: "x + (0::real ^'n) == x" by (atomize (full)) vector
 114.544  
 114.545  lemma norm_imp_pos_and_ge: "norm (x::real ^ 'n) == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
 114.546 -  by (atomize) (auto simp add: norm_pos_le)
 114.547 +  by (atomize) (auto simp add: norm_ge_zero)
 114.548  
 114.549  lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
 114.550  
 114.551  lemma norm_pths: 
 114.552    "(x::real ^'n) = y \<longleftrightarrow> norm (x - y) \<le> 0"
 114.553    "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
 114.554 -  using norm_pos_le[of "x - y"] by (auto simp add: norm_0 norm_eq_0)
 114.555 +  using norm_ge_zero[of "x - y"] by auto
 114.556  
 114.557  use "normarith.ML"
 114.558  
 114.559 @@ -797,11 +1010,6 @@
 114.560  
 114.561  lemma dist_le_0: "dist x y <= 0 \<longleftrightarrow> x = y" by norm 
 114.562  
 114.563 -instantiation "^" :: (monoid_add,type) monoid_add
 114.564 -begin
 114.565 -  instance by (intro_classes)
 114.566 -end
 114.567 -
 114.568  lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
 114.569    apply vector
 114.570    apply auto
 114.571 @@ -873,7 +1081,7 @@
 114.572    assumes fS: "finite S"
 114.573    shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
 114.574  proof(induct rule: finite_induct[OF fS])
 114.575 -  case 1 thus ?case by (simp add: norm_zero)
 114.576 +  case 1 thus ?case by simp
 114.577  next
 114.578    case (2 x S)
 114.579    from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
 114.580 @@ -887,10 +1095,10 @@
 114.581    assumes fS: "finite S"
 114.582    shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
 114.583  proof(induct rule: finite_induct[OF fS])
 114.584 -  case 1 thus ?case by simp norm
 114.585 +  case 1 thus ?case by simp
 114.586  next
 114.587    case (2 x S)
 114.588 -  from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" apply (simp add: norm_triangle_ineq) by norm
 114.589 +  from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
 114.590    also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
 114.591      using "2.hyps" by simp
 114.592    finally  show ?case  using "2.hyps" by simp
 114.593 @@ -936,45 +1144,6 @@
 114.594    using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
 114.595    by simp
 114.596  
 114.597 -instantiation "^" :: ("{scaleR, one, times}",type) scaleR
 114.598 -begin
 114.599 -
 114.600 -definition vector_scaleR_def: "(scaleR :: real \<Rightarrow> 'a ^'b \<Rightarrow> 'a ^'b) \<equiv> (\<lambda> c x . (scaleR c 1) *s x)"
 114.601 -instance ..
 114.602 -end
 114.603 -
 114.604 -instantiation "^" :: ("ring_1",type) ring_1
 114.605 -begin
 114.606 -instance by intro_classes
 114.607 -end
 114.608 -
 114.609 -instantiation "^" :: (real_algebra_1,type) real_vector
 114.610 -begin
 114.611 -
 114.612 -instance
 114.613 -  apply intro_classes
 114.614 -  apply (simp_all  add: vector_scaleR_def)
 114.615 -  apply (simp_all add: vector_sadd_rdistrib vector_add_ldistrib vector_smult_lid vector_smult_assoc scaleR_left_distrib mult_commute)
 114.616 -  done
 114.617 -end
 114.618 -
 114.619 -instantiation "^" :: (real_algebra_1,type) real_algebra
 114.620 -begin
 114.621 -
 114.622 -instance
 114.623 -  apply intro_classes
 114.624 -  apply (simp_all add: vector_scaleR_def ring_simps)
 114.625 -  apply vector
 114.626 -  apply vector
 114.627 -  done
 114.628 -end
 114.629 -
 114.630 -instantiation "^" :: (real_algebra_1,type) real_algebra_1
 114.631 -begin
 114.632 -
 114.633 -instance ..
 114.634 -end
 114.635 -
 114.636  lemma setsum_vmul:
 114.637    fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
 114.638    assumes fS: "finite S"
 114.639 @@ -1211,7 +1380,7 @@
 114.640        by (auto simp add: setsum_component intro: abs_le_D1)
 114.641      have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
 114.642        using i component_le_norm[OF i, of "setsum (\<lambda>x. - f x) ?Pn"]  fPs[OF PnP]
 114.643 -      by (auto simp add: setsum_negf norm_neg setsum_component vector_component intro: abs_le_D1)
 114.644 +      by (auto simp add: setsum_negf setsum_component vector_component intro: abs_le_D1)
 114.645      have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn" 
 114.646        apply (subst thp)
 114.647        apply (rule setsum_Un_nonzero) 
 114.648 @@ -1535,7 +1704,7 @@
 114.649        unfolding norm_mul
 114.650        apply (simp only: mult_commute)
 114.651        apply (rule mult_mono)
 114.652 -      by (auto simp add: ring_simps norm_pos_le) }
 114.653 +      by (auto simp add: ring_simps norm_ge_zero) }
 114.654      then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis
 114.655      from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
 114.656      have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
 114.657 @@ -1552,16 +1721,18 @@
 114.658    let ?K = "\<bar>B\<bar> + 1"
 114.659    have Kp: "?K > 0" by arith
 114.660      {assume C: "B < 0"
 114.661 -      have "norm (1::real ^ 'n) > 0" by (simp add: norm_pos_lt)
 114.662 +      have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
 114.663        with C have "B * norm (1:: real ^ 'n) < 0"
 114.664  	by (simp add: zero_compare_simps)
 114.665 -      with B[rule_format, of 1] norm_pos_le[of "f 1"] have False by simp
 114.666 +      with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
 114.667      }
 114.668      then have Bp: "B \<ge> 0" by ferrack
 114.669      {fix x::"real ^ 'n"
 114.670        have "norm (f x) \<le> ?K *  norm x"
 114.671 -      using B[rule_format, of x] norm_pos_le[of x] norm_pos_le[of "f x"] Bp
 114.672 -      by (auto simp add: ring_simps split add: abs_split)
 114.673 +      using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
 114.674 +      apply (auto simp add: ring_simps split add: abs_split)
 114.675 +      apply (erule order_trans, simp)
 114.676 +      done
 114.677    }
 114.678    then show ?thesis using Kp by blast
 114.679  qed
 114.680 @@ -1641,9 +1812,9 @@
 114.681        apply simp
 114.682        apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
 114.683        apply (rule mult_mono)
 114.684 -      apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
 114.685 +      apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
 114.686        apply (rule mult_mono)
 114.687 -      apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
 114.688 +      apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
 114.689        done}
 114.690    then show ?thesis by metis
 114.691  qed
 114.692 @@ -1663,7 +1834,7 @@
 114.693      have "B * norm x * norm y \<le> ?K * norm x * norm y"
 114.694        apply - 
 114.695        apply (rule mult_right_mono, rule mult_right_mono)
 114.696 -      by (auto simp add: norm_pos_le)
 114.697 +      by (auto simp add: norm_ge_zero)
 114.698      then have "norm (h x y) \<le> ?K * norm x * norm y"
 114.699        using B[rule_format, of x y] by simp} 
 114.700    with Kp show ?thesis by blast
 114.701 @@ -2276,21 +2447,21 @@
 114.702    moreover
 114.703    {assume H: ?lhs
 114.704      from H[rule_format, of "basis 1"] 
 114.705 -    have bp: "b \<ge> 0" using norm_pos_le[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
 114.706 -      by (auto simp add: norm_basis) 
 114.707 +    have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
 114.708 +      by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
 114.709      {fix x :: "real ^'n"
 114.710        {assume "x = 0"
 114.711 -	then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] norm_0 bp)}
 114.712 +	then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
 114.713        moreover
 114.714        {assume x0: "x \<noteq> 0"
 114.715 -	hence n0: "norm x \<noteq> 0" by (metis norm_eq_0)
 114.716 +	hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
 114.717  	let ?c = "1/ norm x"
 114.718 -	have "norm (?c*s x) = 1" by (simp add: n0 norm_mul)
 114.719 +	have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
 114.720  	with H have "norm (f(?c*s x)) \<le> b" by blast
 114.721  	hence "?c * norm (f x) \<le> b" 
 114.722  	  by (simp add: linear_cmul[OF lf] norm_mul)
 114.723  	hence "norm (f x) \<le> b * norm x" 
 114.724 -	  using n0 norm_pos_le[of x] by (auto simp add: field_simps)}
 114.725 +	  using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
 114.726        ultimately have "norm (f x) \<le> b * norm x" by blast}
 114.727      then have ?rhs by blast}
 114.728    ultimately show ?thesis by blast
 114.729 @@ -2322,12 +2493,12 @@
 114.730  qed
 114.731  
 114.732  lemma onorm_pos_le: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)" shows "0 <= onorm f"
 114.733 -  using order_trans[OF norm_pos_le onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
 114.734 +  using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
 114.735  
 114.736  lemma onorm_eq_0: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)" 
 114.737    shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
 114.738    using onorm[OF lf]
 114.739 -  apply (auto simp add: norm_0 onorm_pos_le norm_le_0)
 114.740 +  apply (auto simp add: onorm_pos_le)
 114.741    apply atomize
 114.742    apply (erule allE[where x="0::real"])
 114.743    using onorm_pos_le[OF lf]
 114.744 @@ -2365,7 +2536,7 @@
 114.745  lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
 114.746    shows "onorm (\<lambda>x. - f x) \<le> onorm f"
 114.747    using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
 114.748 -  unfolding norm_neg by metis
 114.749 +  unfolding norm_minus_cancel by metis
 114.750  
 114.751  lemma onorm_neg: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
 114.752    shows "onorm (\<lambda>x. - f x) = onorm f"
 114.753 @@ -2377,7 +2548,7 @@
 114.754    shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
 114.755    apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
 114.756    apply (rule order_trans)
 114.757 -  apply (rule norm_triangle)
 114.758 +  apply (rule norm_triangle_ineq)
 114.759    apply (simp add: distrib)
 114.760    apply (rule add_mono)
 114.761    apply (rule onorm(1)[OF lf])
 114.762 @@ -2594,7 +2765,7 @@
 114.763      by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square del: One_nat_def)
 114.764    then show ?thesis
 114.765      unfolding th0 
 114.766 -    unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
 114.767 +    unfolding real_vector_norm_def real_sqrt_le_iff id_def
 114.768      by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
 114.769  qed
 114.770  
 114.771 @@ -2626,7 +2797,7 @@
 114.772      by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square setsum_reindex[OF finj, unfolded fS] del: One_nat_def)    
 114.773    then show ?thesis
 114.774      unfolding th0 
 114.775 -    unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
 114.776 +    unfolding real_vector_norm_def real_sqrt_le_iff id_def
 114.777      by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
 114.778  qed
 114.779  
 114.780 @@ -2683,7 +2854,7 @@
 114.781  qed
 114.782  
 114.783  lemma norm_pastecart: "norm(pastecart x y) <= norm(x :: real ^ _) + norm(y)"
 114.784 -  unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff real_of_real_def id_def
 114.785 +  unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff id_def
 114.786    apply (rule power2_le_imp_le)
 114.787    apply (simp add: real_sqrt_pow2[OF add_nonneg_nonneg[OF dot_pos_le[of x] dot_pos_le[of y]]])
 114.788    apply (auto simp add: power2_eq_square ring_simps)
 114.789 @@ -5007,7 +5178,7 @@
 114.790      apply blast
 114.791      by (rule abs_ge_zero)
 114.792    from real_le_lsqrt[OF dot_pos_le th th1]
 114.793 -  show ?thesis unfolding real_vector_norm_def  real_of_real_def id_def . 
 114.794 +  show ?thesis unfolding real_vector_norm_def id_def . 
 114.795  qed
 114.796  
 114.797  (* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
 114.798 @@ -5015,10 +5186,10 @@
 114.799  lemma norm_cauchy_schwarz_eq: "(x::real ^'n) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
 114.800  proof-
 114.801    {assume h: "x = 0"
 114.802 -    hence ?thesis by (simp add: norm_0)}
 114.803 +    hence ?thesis by simp}
 114.804    moreover
 114.805    {assume h: "y = 0"
 114.806 -    hence ?thesis by (simp add: norm_0)}
 114.807 +    hence ?thesis by simp}
 114.808    moreover
 114.809    {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
 114.810      from dot_eq_0[of "norm y *s x - norm x *s y"]
 114.811 @@ -5032,7 +5203,7 @@
 114.812      also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
 114.813        by (simp add: ring_simps dot_sym)
 114.814      also have "\<dots> \<longleftrightarrow> ?lhs" using x y
 114.815 -      apply (simp add: norm_eq_0)
 114.816 +      apply simp
 114.817        by metis
 114.818      finally have ?thesis by blast}
 114.819    ultimately show ?thesis by blast
 114.820 @@ -5043,14 +5214,14 @@
 114.821  proof-
 114.822    have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
 114.823    have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
 114.824 -    apply (simp add: norm_neg) by vector
 114.825 +    apply simp by vector
 114.826    also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
 114.827       (-x) \<bullet> y = norm x * norm y)"
 114.828      unfolding norm_cauchy_schwarz_eq[symmetric]
 114.829 -    unfolding norm_neg
 114.830 +    unfolding norm_minus_cancel
 114.831        norm_mul by blast
 114.832    also have "\<dots> \<longleftrightarrow> ?lhs"
 114.833 -    unfolding th[OF mult_nonneg_nonneg, OF norm_pos_le[of x] norm_pos_le[of y]] dot_lneg
 114.834 +    unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
 114.835      by arith
 114.836    finally show ?thesis ..
 114.837  qed
 114.838 @@ -5058,17 +5229,17 @@
 114.839  lemma norm_triangle_eq: "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
 114.840  proof-
 114.841    {assume x: "x =0 \<or> y =0"
 114.842 -    hence ?thesis by (cases "x=0", simp_all add: norm_0)}
 114.843 +    hence ?thesis by (cases "x=0", simp_all)}
 114.844    moreover
 114.845    {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
 114.846      hence "norm x \<noteq> 0" "norm y \<noteq> 0"
 114.847 -      by (simp_all add: norm_eq_0)
 114.848 +      by simp_all
 114.849      hence n: "norm x > 0" "norm y > 0" 
 114.850 -      using norm_pos_le[of x] norm_pos_le[of y]
 114.851 +      using norm_ge_zero[of x] norm_ge_zero[of y]
 114.852        by arith+
 114.853      have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
 114.854      have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
 114.855 -      apply (rule th) using n norm_pos_le[of "x + y"]
 114.856 +      apply (rule th) using n norm_ge_zero[of "x + y"]
 114.857        by arith
 114.858      also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
 114.859        unfolding norm_cauchy_schwarz_eq[symmetric]
 114.860 @@ -5138,8 +5309,8 @@
 114.861  
 114.862  lemma norm_cauchy_schwarz_equal: "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
 114.863  unfolding norm_cauchy_schwarz_abs_eq
 114.864 -apply (cases "x=0", simp_all add: collinear_2 norm_0)
 114.865 -apply (cases "y=0", simp_all add: collinear_2 norm_0 insert_commute)
 114.866 +apply (cases "x=0", simp_all add: collinear_2)
 114.867 +apply (cases "y=0", simp_all add: collinear_2 insert_commute)
 114.868  unfolding collinear_lemma
 114.869  apply simp
 114.870  apply (subgoal_tac "norm x \<noteq> 0")
 114.871 @@ -5164,8 +5335,8 @@
 114.872  apply (simp add: ring_simps)
 114.873  apply (case_tac "c <= 0", simp add: ring_simps)
 114.874  apply (simp add: ring_simps)
 114.875 -apply (simp add: norm_eq_0)
 114.876 -apply (simp add: norm_eq_0)
 114.877 +apply simp
 114.878 +apply simp
 114.879  done
 114.880  
 114.881 -end
 114.882 \ No newline at end of file
 114.883 +end
   115.1 --- a/src/HOL/Library/Float.thy	Wed Mar 04 10:43:39 2009 +0100
   115.2 +++ b/src/HOL/Library/Float.thy	Wed Mar 04 10:45:52 2009 +0100
   115.3 @@ -1,7 +1,10 @@
   115.4 -(* Title:    HOL/Library/Float.thy
   115.5 - * Author:   Steven Obua 2008
   115.6 - *           Johannes Hölzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
   115.7 - *)
   115.8 +(*  Title:      HOL/Library/Float.thy
   115.9 +    Author:     Steven Obua 2008
  115.10 +    Author:     Johannes Hoelzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
  115.11 +*)
  115.12 +
  115.13 +header {* Floating-Point Numbers *}
  115.14 +
  115.15  theory Float
  115.16  imports Complex_Main
  115.17  begin
  115.18 @@ -792,7 +795,7 @@
  115.19      have "x \<noteq> y"
  115.20      proof (rule ccontr)
  115.21        assume "\<not> x \<noteq> y" hence "x = y" by auto
  115.22 -      have "?X mod y = 0" unfolding `x = y` using zmod_zmult_self2 by auto
  115.23 +      have "?X mod y = 0" unfolding `x = y` using mod_mult_self1_is_0 by auto
  115.24        thus False using False by auto
  115.25      qed
  115.26      hence "x < y" using `x \<le> y` by auto
  115.27 @@ -1090,7 +1093,7 @@
  115.28    { have "2^(prec - 1) * m \<le> 2^(prec - 1) * 2^?b" using `m < 2^?b`[THEN less_imp_le] by (rule mult_left_mono, auto)
  115.29      also have "\<dots> = 2 ^ nat (int prec + bitlen m - 1)" unfolding pow_split zpower_zadd_distrib by auto
  115.30      finally have "2^(prec - 1) * m div m \<le> 2 ^ nat (int prec + bitlen m - 1) div m" using `0 < m` by (rule zdiv_mono1)
  115.31 -    hence "2^(prec - 1) \<le> 2 ^ nat (int prec + bitlen m - 1) div m" unfolding zdiv_zmult_self1[OF `m \<noteq> 0`] .
  115.32 +    hence "2^(prec - 1) \<le> 2 ^ nat (int prec + bitlen m - 1) div m" unfolding div_mult_self2_is_id[OF `m \<noteq> 0`] .
  115.33      hence "2^(prec - 1) * inverse (2 ^ nat (int prec + bitlen m - 1)) \<le> ?d"
  115.34        unfolding real_of_int_le_iff[of "2^(prec - 1)", symmetric] by auto }
  115.35    from mult_left_mono[OF this[unfolded pow_split power_add inverse_mult_distrib real_mult_assoc[symmetric] right_inverse[OF pow_not0] real_mult_1], of "2^?e"]
   116.1 --- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Wed Mar 04 10:43:39 2009 +0100
   116.2 +++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Wed Mar 04 10:45:52 2009 +0100
   116.3 @@ -177,151 +177,6 @@
   116.4    thus ?thesis by blast
   116.5  qed
   116.6  
   116.7 -
   116.8 -subsection{* Some theorems about Sequences*}
   116.9 -text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
  116.10 -
  116.11 -lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
  116.12 -  unfolding Ex1_def
  116.13 -  apply (rule_tac x="nat_rec e f" in exI)
  116.14 -  apply (rule conjI)+
  116.15 -apply (rule def_nat_rec_0, simp)
  116.16 -apply (rule allI, rule def_nat_rec_Suc, simp)
  116.17 -apply (rule allI, rule impI, rule ext)
  116.18 -apply (erule conjE)
  116.19 -apply (induct_tac x)
  116.20 -apply (simp add: nat_rec_0)
  116.21 -apply (erule_tac x="n" in allE)
  116.22 -apply (simp)
  116.23 -done
  116.24 -
  116.25 -text{* for any sequence, there is a mootonic subsequence *}
  116.26 -lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
  116.27 -proof-
  116.28 -  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
  116.29 -    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
  116.30 -    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
  116.31 -    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
  116.32 -    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
  116.33 -      using H apply - 
  116.34 -      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
  116.35 -      unfolding order_le_less by blast 
  116.36 -    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
  116.37 -    {fix n
  116.38 -      have "?P (f (Suc n)) (f n)" 
  116.39 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  116.40 -	using H apply - 
  116.41 -      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
  116.42 -      unfolding order_le_less by blast 
  116.43 -    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
  116.44 -  note fSuc = this
  116.45 -    {fix p q assume pq: "p \<ge> f q"
  116.46 -      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
  116.47 -	by (cases q, simp_all) }
  116.48 -    note pqth = this
  116.49 -    {fix q
  116.50 -      have "f (Suc q) > f q" apply (induct q) 
  116.51 -	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
  116.52 -    note fss = this
  116.53 -    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
  116.54 -    {fix a b 
  116.55 -      have "f a \<le> f (a + b)"
  116.56 -      proof(induct b)
  116.57 -	case 0 thus ?case by simp
  116.58 -      next
  116.59 -	case (Suc b)
  116.60 -	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
  116.61 -      qed}
  116.62 -    note fmon0 = this
  116.63 -    have "monoseq (\<lambda>n. s (f n))" 
  116.64 -    proof-
  116.65 -      {fix n
  116.66 -	have "s (f n) \<ge> s (f (Suc n))" 
  116.67 -	proof(cases n)
  116.68 -	  case 0
  116.69 -	  assume n0: "n = 0"
  116.70 -	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
  116.71 -	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
  116.72 -	next
  116.73 -	  case (Suc m)
  116.74 -	  assume m: "n = Suc m"
  116.75 -	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
  116.76 -	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
  116.77 -	qed}
  116.78 -      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
  116.79 -    qed
  116.80 -    with th1 have ?thesis by blast}
  116.81 -  moreover
  116.82 -  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
  116.83 -    {fix p assume p: "p \<ge> Suc N" 
  116.84 -      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
  116.85 -      have "m \<noteq> p" using m(2) by auto 
  116.86 -      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
  116.87 -    note th0 = this
  116.88 -    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
  116.89 -    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
  116.90 -    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
  116.91 -      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
  116.92 -    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
  116.93 -      using N apply - 
  116.94 -      apply (erule allE[where x="Suc N"], clarsimp)
  116.95 -      apply (rule_tac x="m" in exI)
  116.96 -      apply auto
  116.97 -      apply (subgoal_tac "Suc N \<noteq> m")
  116.98 -      apply simp
  116.99 -      apply (rule ccontr, simp)
 116.100 -      done
 116.101 -    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
 116.102 -    {fix n
 116.103 -      have "f n > N \<and> ?P (f (Suc n)) (f n)"
 116.104 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
 116.105 -      proof (induct n)
 116.106 -	case 0 thus ?case
 116.107 -	  using f0 N apply auto 
 116.108 -	  apply (erule allE[where x="f 0"], clarsimp) 
 116.109 -	  apply (rule_tac x="m" in exI, simp)
 116.110 -	  by (subgoal_tac "f 0 \<noteq> m", auto)
 116.111 -      next
 116.112 -	case (Suc n)
 116.113 -	from Suc.hyps have Nfn: "N < f n" by blast
 116.114 -	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
 116.115 -	with Nfn have mN: "m > N" by arith
 116.116 -	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
 116.117 -	
 116.118 -	from key have th0: "f (Suc n) > N" by simp
 116.119 -	from N[rule_format, OF th0]
 116.120 -	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
 116.121 -	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
 116.122 -	hence "m' > f (Suc n)" using m'(1) by simp
 116.123 -	with key m'(2) show ?case by auto
 116.124 -      qed}
 116.125 -    note fSuc = this
 116.126 -    {fix n
 116.127 -      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
 116.128 -      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
 116.129 -    note thf = this
 116.130 -    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
 116.131 -    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
 116.132 -      apply -
 116.133 -      apply (rule disjI1)
 116.134 -      apply auto
 116.135 -      apply (rule order_less_imp_le)
 116.136 -      apply blast
 116.137 -      done
 116.138 -    then have ?thesis  using sqf by blast}
 116.139 -  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
 116.140 -qed
 116.141 -
 116.142 -lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
 116.143 -proof(induct n)
 116.144 -  case 0 thus ?case by simp
 116.145 -next
 116.146 -  case (Suc n)
 116.147 -  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
 116.148 -  have "n < f (Suc n)" by arith 
 116.149 -  thus ?case by arith
 116.150 -qed
 116.151 -
 116.152  subsection {* Fundamental theorem of algebra *}
 116.153  lemma  unimodular_reduce_norm:
 116.154    assumes md: "cmod z = 1"
 116.155 @@ -407,7 +262,6 @@
 116.156    ultimately show "\<exists>z. ?P z n" by blast
 116.157  qed
 116.158  
 116.159 -
 116.160  text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
 116.161  
 116.162  lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
 116.163 @@ -946,90 +800,6 @@
 116.164    ultimately show ?case by blast  
 116.165  qed simp
 116.166  
 116.167 -subsection {* Order of polynomial roots *}
 116.168 -
 116.169 -definition
 116.170 -  order :: "'a::{idom,recpower} \<Rightarrow> 'a poly \<Rightarrow> nat"
 116.171 -where
 116.172 -  [code del]:
 116.173 -  "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
 116.174 -
 116.175 -lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
 116.176 -by (induct n, simp, auto intro: order_trans degree_mult_le)
 116.177 -
 116.178 -lemma coeff_linear_power:
 116.179 -  fixes a :: "'a::{comm_semiring_1,recpower}"
 116.180 -  shows "coeff ([:a, 1:] ^ n) n = 1"
 116.181 -apply (induct n, simp_all)
 116.182 -apply (subst coeff_eq_0)
 116.183 -apply (auto intro: le_less_trans degree_power_le)
 116.184 -done
 116.185 -
 116.186 -lemma degree_linear_power:
 116.187 -  fixes a :: "'a::{comm_semiring_1,recpower}"
 116.188 -  shows "degree ([:a, 1:] ^ n) = n"
 116.189 -apply (rule order_antisym)
 116.190 -apply (rule ord_le_eq_trans [OF degree_power_le], simp)
 116.191 -apply (rule le_degree, simp add: coeff_linear_power)
 116.192 -done
 116.193 -
 116.194 -lemma order_1: "[:-a, 1:] ^ order a p dvd p"
 116.195 -apply (cases "p = 0", simp)
 116.196 -apply (cases "order a p", simp)
 116.197 -apply (subgoal_tac "nat < (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)")
 116.198 -apply (drule not_less_Least, simp)
 116.199 -apply (fold order_def, simp)
 116.200 -done
 116.201 -
 116.202 -lemma order_2: "p \<noteq> 0 \<Longrightarrow> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
 116.203 -unfolding order_def
 116.204 -apply (rule LeastI_ex)
 116.205 -apply (rule_tac x="degree p" in exI)
 116.206 -apply (rule notI)
 116.207 -apply (drule (1) dvd_imp_degree_le)
 116.208 -apply (simp only: degree_linear_power)
 116.209 -done
 116.210 -
 116.211 -lemma order:
 116.212 -  "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
 116.213 -by (rule conjI [OF order_1 order_2])
 116.214 -
 116.215 -lemma order_degree:
 116.216 -  assumes p: "p \<noteq> 0"
 116.217 -  shows "order a p \<le> degree p"
 116.218 -proof -
 116.219 -  have "order a p = degree ([:-a, 1:] ^ order a p)"
 116.220 -    by (simp only: degree_linear_power)
 116.221 -  also have "\<dots> \<le> degree p"
 116.222 -    using order_1 p by (rule dvd_imp_degree_le)
 116.223 -  finally show ?thesis .
 116.224 -qed
 116.225 -
 116.226 -lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0"
 116.227 -apply (cases "p = 0", simp_all)
 116.228 -apply (rule iffI)
 116.229 -apply (rule ccontr, simp)
 116.230 -apply (frule order_2 [where a=a], simp)
 116.231 -apply (simp add: poly_eq_0_iff_dvd)
 116.232 -apply (simp add: poly_eq_0_iff_dvd)
 116.233 -apply (simp only: order_def)
 116.234 -apply (drule not_less_Least, simp)
 116.235 -done
 116.236 -
 116.237 -lemma poly_zero:
 116.238 -  fixes p :: "'a::{idom,ring_char_0} poly"
 116.239 -  shows "poly p = poly 0 \<longleftrightarrow> p = 0"
 116.240 -apply (cases "p = 0", simp_all)
 116.241 -apply (drule poly_roots_finite)
 116.242 -apply (auto simp add: infinite_UNIV_char_0)
 116.243 -done
 116.244 -
 116.245 -lemma poly_eq_iff:
 116.246 -  fixes p q :: "'a::{idom,ring_char_0} poly"
 116.247 -  shows "poly p = poly q \<longleftrightarrow> p = q"
 116.248 -  using poly_zero [of "p - q"]
 116.249 -  by (simp add: expand_fun_eq)
 116.250 -
 116.251  
 116.252  subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
 116.253  
   117.1 --- a/src/HOL/Library/Library.thy	Wed Mar 04 10:43:39 2009 +0100
   117.2 +++ b/src/HOL/Library/Library.thy	Wed Mar 04 10:45:52 2009 +0100
   117.3 @@ -5,6 +5,7 @@
   117.4    AssocList
   117.5    BigO
   117.6    Binomial
   117.7 +  Bit
   117.8    Boolean_Algebra
   117.9    Char_ord
  117.10    Code_Char_chr
  117.11 @@ -22,9 +23,11 @@
  117.12    Executable_Set
  117.13    Float
  117.14    Formal_Power_Series
  117.15 +  FrechetDeriv
  117.16    FuncSet
  117.17    Fundamental_Theorem_Algebra
  117.18    Infinite_Set
  117.19 +  Inner_Product
  117.20    ListVector
  117.21    Mapping
  117.22    Multiset
  117.23 @@ -35,7 +38,10 @@
  117.24    Option_ord
  117.25    Permutation
  117.26    Pocklington
  117.27 +  Poly_Deriv
  117.28 +  Polynomial
  117.29    Primes
  117.30 +  Product_Vector
  117.31    Quickcheck
  117.32    Quicksort
  117.33    Quotient
   118.1 --- a/src/HOL/Library/Numeral_Type.thy	Wed Mar 04 10:43:39 2009 +0100
   118.2 +++ b/src/HOL/Library/Numeral_Type.thy	Wed Mar 04 10:45:52 2009 +0100
   118.3 @@ -42,36 +42,87 @@
   118.4  end
   118.5  *}
   118.6  
   118.7 -lemma card_unit: "CARD(unit) = 1"
   118.8 +lemma card_unit [simp]: "CARD(unit) = 1"
   118.9    unfolding UNIV_unit by simp
  118.10  
  118.11 -lemma card_bool: "CARD(bool) = 2"
  118.12 +lemma card_bool [simp]: "CARD(bool) = 2"
  118.13    unfolding UNIV_bool by simp
  118.14  
  118.15 -lemma card_prod: "CARD('a::finite \<times> 'b::finite) = CARD('a) * CARD('b)"
  118.16 +lemma card_prod [simp]: "CARD('a \<times> 'b) = CARD('a::finite) * CARD('b::finite)"
  118.17    unfolding UNIV_Times_UNIV [symmetric] by (simp only: card_cartesian_product)
  118.18  
  118.19 -lemma card_sum: "CARD('a::finite + 'b::finite) = CARD('a) + CARD('b)"
  118.20 +lemma card_sum [simp]: "CARD('a + 'b) = CARD('a::finite) + CARD('b::finite)"
  118.21    unfolding UNIV_Plus_UNIV [symmetric] by (simp only: finite card_Plus)
  118.22  
  118.23 -lemma card_option: "CARD('a::finite option) = Suc CARD('a)"
  118.24 +lemma card_option [simp]: "CARD('a option) = Suc CARD('a::finite)"
  118.25    unfolding insert_None_conv_UNIV [symmetric]
  118.26    apply (subgoal_tac "(None::'a option) \<notin> range Some")
  118.27 -  apply (simp add: finite card_image)
  118.28 +  apply (simp add: card_image)
  118.29    apply fast
  118.30    done
  118.31  
  118.32 -lemma card_set: "CARD('a::finite set) = 2 ^ CARD('a)"
  118.33 +lemma card_set [simp]: "CARD('a set) = 2 ^ CARD('a::finite)"
  118.34    unfolding Pow_UNIV [symmetric]
  118.35    by (simp only: card_Pow finite numeral_2_eq_2)
  118.36  
  118.37 +lemma card_nat [simp]: "CARD(nat) = 0"
  118.38 +  by (simp add: infinite_UNIV_nat card_eq_0_iff)
  118.39 +
  118.40 +
  118.41 +subsection {* Classes with at least 1 and 2  *}
  118.42 +
  118.43 +text {* Class finite already captures "at least 1" *}
  118.44 +
  118.45 +lemma zero_less_card_finite [simp]: "0 < CARD('a::finite)"
  118.46 +  unfolding neq0_conv [symmetric] by simp
  118.47 +
  118.48 +lemma one_le_card_finite [simp]: "Suc 0 \<le> CARD('a::finite)"
  118.49 +  by (simp add: less_Suc_eq_le [symmetric])
  118.50 +
  118.51 +text {* Class for cardinality "at least 2" *}
  118.52 +
  118.53 +class card2 = finite + 
  118.54 +  assumes two_le_card: "2 \<le> CARD('a)"
  118.55 +
  118.56 +lemma one_less_card: "Suc 0 < CARD('a::card2)"
  118.57 +  using two_le_card [where 'a='a] by simp
  118.58 +
  118.59 +lemma one_less_int_card: "1 < int CARD('a::card2)"
  118.60 +  using one_less_card [where 'a='a] by simp
  118.61 +
  118.62  
  118.63  subsection {* Numeral Types *}
  118.64  
  118.65  typedef (open) num0 = "UNIV :: nat set" ..
  118.66  typedef (open) num1 = "UNIV :: unit set" ..
  118.67 -typedef (open) 'a bit0 = "UNIV :: (bool * 'a) set" ..
  118.68 -typedef (open) 'a bit1 = "UNIV :: (bool * 'a) option set" ..
  118.69 +
  118.70 +typedef (open) 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
  118.71 +proof
  118.72 +  show "0 \<in> {0 ..< 2 * int CARD('a)}"
  118.73 +    by simp
  118.74 +qed
  118.75 +
  118.76 +typedef (open) 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
  118.77 +proof
  118.78 +  show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
  118.79 +    by simp
  118.80 +qed
  118.81 +
  118.82 +lemma card_num0 [simp]: "CARD (num0) = 0"
  118.83 +  unfolding type_definition.card [OF type_definition_num0]
  118.84 +  by simp
  118.85 +
  118.86 +lemma card_num1 [simp]: "CARD(num1) = 1"
  118.87 +  unfolding type_definition.card [OF type_definition_num1]
  118.88 +  by (simp only: card_unit)
  118.89 +
  118.90 +lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
  118.91 +  unfolding type_definition.card [OF type_definition_bit0]
  118.92 +  by simp
  118.93 +
  118.94 +lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
  118.95 +  unfolding type_definition.card [OF type_definition_bit1]
  118.96 +  by simp
  118.97  
  118.98  instance num1 :: finite
  118.99  proof
 118.100 @@ -80,46 +131,263 @@
 118.101      using finite by (rule finite_imageI)
 118.102  qed
 118.103  
 118.104 -instance bit0 :: (finite) finite
 118.105 +instance bit0 :: (finite) card2
 118.106  proof
 118.107    show "finite (UNIV::'a bit0 set)"
 118.108      unfolding type_definition.univ [OF type_definition_bit0]
 118.109 -    using finite by (rule finite_imageI)
 118.110 +    by simp
 118.111 +  show "2 \<le> CARD('a bit0)"
 118.112 +    by simp
 118.113  qed
 118.114  
 118.115 -instance bit1 :: (finite) finite
 118.116 +instance bit1 :: (finite) card2
 118.117  proof
 118.118    show "finite (UNIV::'a bit1 set)"
 118.119      unfolding type_definition.univ [OF type_definition_bit1]
 118.120 -    using finite by (rule finite_imageI)
 118.121 +    by simp
 118.122 +  show "2 \<le> CARD('a bit1)"
 118.123 +    by simp
 118.124  qed
 118.125  
 118.126 -lemma card_num1: "CARD(num1) = 1"
 118.127 -  unfolding type_definition.card [OF type_definition_num1]
 118.128 -  by (simp only: card_unit)
 118.129  
 118.130 -lemma card_bit0: "CARD('a::finite bit0) = 2 * CARD('a)"
 118.131 -  unfolding type_definition.card [OF type_definition_bit0]
 118.132 -  by (simp only: card_prod card_bool)
 118.133 +subsection {* Locale for modular arithmetic subtypes *}
 118.134  
 118.135 -lemma card_bit1: "CARD('a::finite bit1) = Suc (2 * CARD('a))"
 118.136 -  unfolding type_definition.card [OF type_definition_bit1]
 118.137 -  by (simp only: card_prod card_option card_bool)
 118.138 +locale mod_type =
 118.139 +  fixes n :: int
 118.140 +  and Rep :: "'a::{zero,one,plus,times,uminus,minus,power} \<Rightarrow> int"
 118.141 +  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus,power}"
 118.142 +  assumes type: "type_definition Rep Abs {0..<n}"
 118.143 +  and size1: "1 < n"
 118.144 +  and zero_def: "0 = Abs 0"
 118.145 +  and one_def:  "1 = Abs 1"
 118.146 +  and add_def:  "x + y = Abs ((Rep x + Rep y) mod n)"
 118.147 +  and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
 118.148 +  and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
 118.149 +  and minus_def: "- x = Abs ((- Rep x) mod n)"
 118.150 +  and power_def: "x ^ k = Abs (Rep x ^ k mod n)"
 118.151 +begin
 118.152  
 118.153 -lemma card_num0: "CARD (num0) = 0"
 118.154 -  by (simp add: infinite_UNIV_nat card_eq_0_iff type_definition.card [OF type_definition_num0])
 118.155 +lemma size0: "0 < n"
 118.156 +by (cut_tac size1, simp)
 118.157  
 118.158 -lemmas card_univ_simps [simp] =
 118.159 -  card_unit
 118.160 -  card_bool
 118.161 -  card_prod
 118.162 -  card_sum
 118.163 -  card_option
 118.164 -  card_set
 118.165 -  card_num1
 118.166 -  card_bit0
 118.167 -  card_bit1
 118.168 -  card_num0
 118.169 +lemmas definitions =
 118.170 +  zero_def one_def add_def mult_def minus_def diff_def power_def
 118.171 +
 118.172 +lemma Rep_less_n: "Rep x < n"
 118.173 +by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
 118.174 +
 118.175 +lemma Rep_le_n: "Rep x \<le> n"
 118.176 +by (rule Rep_less_n [THEN order_less_imp_le])
 118.177 +
 118.178 +lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
 118.179 +by (rule type_definition.Rep_inject [OF type, symmetric])
 118.180 +
 118.181 +lemma Rep_inverse: "Abs (Rep x) = x"
 118.182 +by (rule type_definition.Rep_inverse [OF type])
 118.183 +
 118.184 +lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
 118.185 +by (rule type_definition.Abs_inverse [OF type])
 118.186 +
 118.187 +lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
 118.188 +by (simp add: Abs_inverse IntDiv.pos_mod_conj [OF size0])
 118.189 +
 118.190 +lemma Rep_Abs_0: "Rep (Abs 0) = 0"
 118.191 +by (simp add: Abs_inverse size0)
 118.192 +
 118.193 +lemma Rep_0: "Rep 0 = 0"
 118.194 +by (simp add: zero_def Rep_Abs_0)
 118.195 +
 118.196 +lemma Rep_Abs_1: "Rep (Abs 1) = 1"
 118.197 +by (simp add: Abs_inverse size1)
 118.198 +
 118.199 +lemma Rep_1: "Rep 1 = 1"
 118.200 +by (simp add: one_def Rep_Abs_1)
 118.201 +
 118.202 +lemma Rep_mod: "Rep x mod n = Rep x"
 118.203 +apply (rule_tac x=x in type_definition.Abs_cases [OF type])
 118.204 +apply (simp add: type_definition.Abs_inverse [OF type])
 118.205 +apply (simp add: mod_pos_pos_trivial)
 118.206 +done
 118.207 +
 118.208 +lemmas Rep_simps =
 118.209 +  Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1
 118.210 +
 118.211 +lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
 118.212 +apply (intro_classes, unfold definitions)
 118.213 +apply (simp_all add: Rep_simps zmod_simps ring_simps)
 118.214 +done
 118.215 +
 118.216 +lemma recpower: "OFCLASS('a, recpower_class)"
 118.217 +apply (intro_classes, unfold definitions)
 118.218 +apply (simp_all add: Rep_simps zmod_simps add_ac mult_assoc
 118.219 +                     mod_pos_pos_trivial size1)
 118.220 +done
 118.221 +
 118.222 +end
 118.223 +
 118.224 +locale mod_ring = mod_type +
 118.225 +  constrains n :: int
 118.226 +  and Rep :: "'a::{number_ring,power} \<Rightarrow> int"
 118.227 +  and Abs :: "int \<Rightarrow> 'a::{number_ring,power}"
 118.228 +begin
 118.229 +
 118.230 +lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
 118.231 +apply (induct k)
 118.232 +apply (simp add: zero_def)
 118.233 +apply (simp add: Rep_simps add_def one_def zmod_simps add_ac)
 118.234 +done
 118.235 +
 118.236 +lemma of_int_eq: "of_int z = Abs (z mod n)"
 118.237 +apply (cases z rule: int_diff_cases)
 118.238 +apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
 118.239 +done
 118.240 +
 118.241 +lemma Rep_number_of:
 118.242 +  "Rep (number_of w) = number_of w mod n"
 118.243 +by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
 118.244 +
 118.245 +lemma iszero_number_of:
 118.246 +  "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
 118.247 +by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
 118.248 +
 118.249 +lemma cases:
 118.250 +  assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
 118.251 +  shows "P"
 118.252 +apply (cases x rule: type_definition.Abs_cases [OF type])
 118.253 +apply (rule_tac z="y" in 1)
 118.254 +apply (simp_all add: of_int_eq mod_pos_pos_trivial)
 118.255 +done
 118.256 +
 118.257 +lemma induct:
 118.258 +  "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
 118.259 +by (cases x rule: cases) simp
 118.260 +
 118.261 +end
 118.262 +
 118.263 +
 118.264 +subsection {* Number ring instances *}
 118.265 +
 118.266 +text {*
 118.267 +  Unfortunately a number ring instance is not possible for
 118.268 +  @{typ num1}, since 0 and 1 are not distinct.
 118.269 +*}
 118.270 +
 118.271 +instantiation num1 :: "{comm_ring,comm_monoid_mult,number,recpower}"
 118.272 +begin
 118.273 +
 118.274 +lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
 118.275 +  by (induct x, induct y) simp
 118.276 +
 118.277 +instance proof
 118.278 +qed (simp_all add: num1_eq_iff)
 118.279 +
 118.280 +end
 118.281 +
 118.282 +instantiation
 118.283 +  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus,power}"
 118.284 +begin
 118.285 +
 118.286 +definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
 118.287 +  "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"
 118.288 +
 118.289 +definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
 118.290 +  "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"
 118.291 +
 118.292 +definition "0 = Abs_bit0 0"
 118.293 +definition "1 = Abs_bit0 1"
 118.294 +definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
 118.295 +definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
 118.296 +definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
 118.297 +definition "- x = Abs_bit0' (- Rep_bit0 x)"
 118.298 +definition "x ^ k = Abs_bit0' (Rep_bit0 x ^ k)"
 118.299 +
 118.300 +definition "0 = Abs_bit1 0"
 118.301 +definition "1 = Abs_bit1 1"
 118.302 +definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
 118.303 +definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
 118.304 +definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
 118.305 +definition "- x = Abs_bit1' (- Rep_bit1 x)"
 118.306 +definition "x ^ k = Abs_bit1' (Rep_bit1 x ^ k)"
 118.307 +
 118.308 +instance ..
 118.309 +
 118.310 +end
 118.311 +
 118.312 +interpretation bit0!:
 118.313 +  mod_type "int CARD('a::finite bit0)"
 118.314 +           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
 118.315 +           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
 118.316 +apply (rule mod_type.intro)
 118.317 +apply (simp add: int_mult type_definition_bit0)
 118.318 +apply (rule one_less_int_card)
 118.319 +apply (rule zero_bit0_def)
 118.320 +apply (rule one_bit0_def)
 118.321 +apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
 118.322 +apply (rule times_bit0_def [unfolded Abs_bit0'_def])
 118.323 +apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
 118.324 +apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
 118.325 +apply (rule power_bit0_def [unfolded Abs_bit0'_def])
 118.326 +done
 118.327 +
 118.328 +interpretation bit1!:
 118.329 +  mod_type "int CARD('a::finite bit1)"
 118.330 +           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
 118.331 +           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
 118.332 +apply (rule mod_type.intro)
 118.333 +apply (simp add: int_mult type_definition_bit1)
 118.334 +apply (rule one_less_int_card)
 118.335 +apply (rule zero_bit1_def)
 118.336 +apply (rule one_bit1_def)
 118.337 +apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
 118.338 +apply (rule times_bit1_def [unfolded Abs_bit1'_def])
 118.339 +apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
 118.340 +apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
 118.341 +apply (rule power_bit1_def [unfolded Abs_bit1'_def])
 118.342 +done
 118.343 +
 118.344 +instance bit0 :: (finite) "{comm_ring_1,recpower}"
 118.345 +  by (rule bit0.comm_ring_1 bit0.recpower)+
 118.346 +
 118.347 +instance bit1 :: (finite) "{comm_ring_1,recpower}"
 118.348 +  by (rule bit1.comm_ring_1 bit1.recpower)+
 118.349 +
 118.350 +instantiation bit0 and bit1 :: (finite) number_ring
 118.351 +begin
 118.352 +
 118.353 +definition "(number_of w :: _ bit0) = of_int w"
 118.354 +
 118.355 +definition "(number_of w :: _ bit1) = of_int w"
 118.356 +
 118.357 +instance proof
 118.358 +qed (rule number_of_bit0_def number_of_bit1_def)+
 118.359 +
 118.360 +end
 118.361 +
 118.362 +interpretation bit0!:
 118.363 +  mod_ring "int CARD('a::finite bit0)"
 118.364 +           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
 118.365 +           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
 118.366 +  ..
 118.367 +
 118.368 +interpretation bit1!:
 118.369 +  mod_ring "int CARD('a::finite bit1)"
 118.370 +           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
 118.371 +           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
 118.372 +  ..
 118.373 +
 118.374 +text {* Set up cases, induction, and arithmetic *}
 118.375 +
 118.376 +lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
 118.377 +lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases
 118.378 +
 118.379 +lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
 118.380 +lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
 118.381 +
 118.382 +lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
 118.383 +lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
 118.384 +
 118.385 +declare power_Suc [where ?'a="'a::finite bit0", standard, simp]
 118.386 +declare power_Suc [where ?'a="'a::finite bit1", standard, simp]
 118.387  
 118.388  
 118.389  subsection {* Syntax *}
 118.390 @@ -184,42 +452,10 @@
 118.391  in [("bit0", bit_tr' 0), ("bit1", bit_tr' 1)] end;
 118.392  *}
 118.393  
 118.394 -
 118.395 -subsection {* Classes with at least 1 and 2  *}
 118.396 -
 118.397 -text {* Class finite already captures "at least 1" *}
 118.398 -
 118.399 -lemma zero_less_card_finite [simp]:
 118.400 -  "0 < CARD('a::finite)"
 118.401 -proof (cases "CARD('a::finite) = 0")
 118.402 -  case False thus ?thesis by (simp del: card_0_eq)
 118.403 -next
 118.404 -  case True
 118.405 -  thus ?thesis by (simp add: finite)
 118.406 -qed
 118.407 -
 118.408 -lemma one_le_card_finite [simp]:
 118.409 -  "Suc 0 <= CARD('a::finite)"
 118.410 -  by (simp add: less_Suc_eq_le [symmetric] zero_less_card_finite)
 118.411 -
 118.412 -
 118.413 -text {* Class for cardinality "at least 2" *}
 118.414 -
 118.415 -class card2 = finite + 
 118.416 -  assumes two_le_card: "2 <= CARD('a)"
 118.417 -
 118.418 -lemma one_less_card: "Suc 0 < CARD('a::card2)"
 118.419 -  using two_le_card [where 'a='a] by simp
 118.420 -
 118.421 -instance bit0 :: (finite) card2
 118.422 -  by intro_classes (simp add: one_le_card_finite)
 118.423 -
 118.424 -instance bit1 :: (finite) card2
 118.425 -  by intro_classes (simp add: one_le_card_finite)
 118.426 -
 118.427  subsection {* Examples *}
 118.428  
 118.429  lemma "CARD(0) = 0" by simp
 118.430  lemma "CARD(17) = 17" by simp
 118.431 +lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp
 118.432  
 118.433  end
   119.1 --- a/src/HOL/Library/Order_Relation.thy	Wed Mar 04 10:43:39 2009 +0100
   119.2 +++ b/src/HOL/Library/Order_Relation.thy	Wed Mar 04 10:45:52 2009 +0100
   119.3 @@ -10,7 +10,7 @@
   119.4  
   119.5  subsection{* Orders on a set *}
   119.6  
   119.7 -definition "preorder_on A r \<equiv> refl A r \<and> trans r"
   119.8 +definition "preorder_on A r \<equiv> refl_on A r \<and> trans r"
   119.9  
  119.10  definition "partial_order_on A r \<equiv> preorder_on A r \<and> antisym r"
  119.11  
  119.12 @@ -57,7 +57,7 @@
  119.13  
  119.14  subsection{* Orders on the field *}
  119.15  
  119.16 -abbreviation "Refl r \<equiv> refl (Field r) r"
  119.17 +abbreviation "Refl r \<equiv> refl_on (Field r) r"
  119.18  
  119.19  abbreviation "Preorder r \<equiv> preorder_on (Field r) r"
  119.20  
  119.21 @@ -73,7 +73,7 @@
  119.22  lemma subset_Image_Image_iff:
  119.23    "\<lbrakk> Preorder r; A \<subseteq> Field r; B \<subseteq> Field r\<rbrakk> \<Longrightarrow>
  119.24     r `` A \<subseteq> r `` B \<longleftrightarrow> (\<forall>a\<in>A.\<exists>b\<in>B. (b,a):r)"
  119.25 -apply(auto simp add: subset_eq preorder_on_def refl_def Image_def)
  119.26 +apply(auto simp add: subset_eq preorder_on_def refl_on_def Image_def)
  119.27  apply metis
  119.28  by(metis trans_def)
  119.29  
  119.30 @@ -83,7 +83,7 @@
  119.31  
  119.32  lemma Refl_antisym_eq_Image1_Image1_iff:
  119.33    "\<lbrakk>Refl r; antisym r; a:Field r; b:Field r\<rbrakk> \<Longrightarrow> r `` {a} = r `` {b} \<longleftrightarrow> a=b"
  119.34 -by(simp add: expand_set_eq antisym_def refl_def) metis
  119.35 +by(simp add: expand_set_eq antisym_def refl_on_def) metis
  119.36  
  119.37  lemma Partial_order_eq_Image1_Image1_iff:
  119.38    "\<lbrakk>Partial_order r; a:Field r; b:Field r\<rbrakk> \<Longrightarrow> r `` {a} = r `` {b} \<longleftrightarrow> a=b"
   120.1 --- a/src/HOL/Library/Permutations.thy	Wed Mar 04 10:43:39 2009 +0100
   120.2 +++ b/src/HOL/Library/Permutations.thy	Wed Mar 04 10:45:52 2009 +0100
   120.3 @@ -6,7 +6,7 @@
   120.4  header {* Permutations, both general and specifically on finite sets.*}
   120.5  
   120.6  theory Permutations
   120.7 -imports Main Finite_Cartesian_Product Parity 
   120.8 +imports Main Finite_Cartesian_Product Parity Fact
   120.9  begin
  120.10  
  120.11    (* Why should I import Main just to solve the Typerep problem! *)
  120.12 @@ -683,13 +683,13 @@
  120.13  (* ------------------------------------------------------------------------- *)
  120.14  
  120.15  lemma permutes_natset_le:
  120.16 -  assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S.  p i <= i" shows "p = id"
  120.17 +  assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S.  p i <= i" shows "p = id"
  120.18  proof-
  120.19    {fix n
  120.20      have "p n = n" 
  120.21        using p le
  120.22 -    proof(induct n arbitrary: S rule: nat_less_induct)
  120.23 -      fix n S assume H: "\<forall> m< n. \<forall>S. p permutes S \<longrightarrow> (\<forall>i\<in>S. p i \<le> i) \<longrightarrow> p m = m" 
  120.24 +    proof(induct n arbitrary: S rule: less_induct)
  120.25 +      fix n S assume H: "\<And>m S. \<lbrakk>m < n; p permutes S; \<forall>i\<in>S. p i \<le> i\<rbrakk> \<Longrightarrow> p m = m" 
  120.26  	"p permutes S" "\<forall>i \<in>S. p i \<le> i"
  120.27        {assume "n \<notin> S"
  120.28  	with H(2) have "p n = n" unfolding permutes_def by metis}
  120.29 @@ -699,7 +699,7 @@
  120.30  	moreover{assume h: "p n < n"
  120.31  	  from H h have "p (p n) = p n" by metis
  120.32  	  with permutes_inj[OF H(2)] have "p n = n" unfolding inj_on_def by blast
  120.33 -	  with h have False by arith}
  120.34 +	  with h have False by simp}
  120.35  	ultimately have "p n = n" by blast }
  120.36        ultimately show "p n = n"  by blast
  120.37      qed}
  120.38 @@ -707,7 +707,7 @@
  120.39  qed
  120.40  
  120.41  lemma permutes_natset_ge:
  120.42 -  assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S.  p i \<ge> i" shows "p = id"
  120.43 +  assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S.  p i \<ge> i" shows "p = id"
  120.44  proof-
  120.45    {fix i assume i: "i \<in> S"
  120.46      from i permutes_in_image[OF permutes_inv[OF p]] have "inv p i \<in> S" by simp
  120.47 @@ -757,13 +757,13 @@
  120.48  done
  120.49  
  120.50  term setsum
  120.51 -lemma setsum_permutations_inverse: "setsum f {p. p permutes {m..n}} = setsum (\<lambda>p. f(inv p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
  120.52 +lemma setsum_permutations_inverse: "setsum f {p. p permutes S} = setsum (\<lambda>p. f(inv p)) {p. p permutes S}" (is "?lhs = ?rhs")
  120.53  proof-
  120.54 -  let ?S = "{p . p permutes {m .. n}}"
  120.55 +  let ?S = "{p . p permutes S}"
  120.56  have th0: "inj_on inv ?S" 
  120.57  proof(auto simp add: inj_on_def)
  120.58    fix q r
  120.59 -  assume q: "q permutes {m .. n}" and r: "r permutes {m .. n}" and qr: "inv q = inv r"
  120.60 +  assume q: "q permutes S" and r: "r permutes S" and qr: "inv q = inv r"
  120.61    hence "inv (inv q) = inv (inv r)" by simp
  120.62    with permutes_inv_inv[OF q] permutes_inv_inv[OF r]
  120.63    show "q = r" by metis
  120.64 @@ -774,17 +774,17 @@
  120.65  qed
  120.66  
  120.67  lemma setum_permutations_compose_left:
  120.68 -  assumes q: "q permutes {m..n}"
  120.69 -  shows "setsum f {p. p permutes {m..n}} =
  120.70 -            setsum (\<lambda>p. f(q o p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
  120.71 +  assumes q: "q permutes S"
  120.72 +  shows "setsum f {p. p permutes S} =
  120.73 +            setsum (\<lambda>p. f(q o p)) {p. p permutes S}" (is "?lhs = ?rhs")
  120.74  proof-
  120.75 -  let ?S = "{p. p permutes {m..n}}"
  120.76 +  let ?S = "{p. p permutes S}"
  120.77    have th0: "?rhs = setsum (f o (op o q)) ?S" by (simp add: o_def)
  120.78    have th1: "inj_on (op o q) ?S"
  120.79      apply (auto simp add: inj_on_def)
  120.80    proof-
  120.81      fix p r
  120.82 -    assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "q \<circ> p = q \<circ> r"
  120.83 +    assume "p permutes S" and r:"r permutes S" and rp: "q \<circ> p = q \<circ> r"
  120.84      hence "inv q o q o p = inv q o q o r" by (simp add: o_assoc[symmetric])
  120.85      with permutes_inj[OF q, unfolded inj_iff]
  120.86  
  120.87 @@ -796,17 +796,17 @@
  120.88  qed
  120.89  
  120.90  lemma sum_permutations_compose_right:
  120.91 -  assumes q: "q permutes {m..n}"
  120.92 -  shows "setsum f {p. p permutes {m..n}} =
  120.93 -            setsum (\<lambda>p. f(p o q)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
  120.94 +  assumes q: "q permutes S"
  120.95 +  shows "setsum f {p. p permutes S} =
  120.96 +            setsum (\<lambda>p. f(p o q)) {p. p permutes S}" (is "?lhs = ?rhs")
  120.97  proof-
  120.98 -  let ?S = "{p. p permutes {m..n}}"
  120.99 +  let ?S = "{p. p permutes S}"
 120.100    have th0: "?rhs = setsum (f o (\<lambda>p. p o q)) ?S" by (simp add: o_def)
 120.101    have th1: "inj_on (\<lambda>p. p o q) ?S"
 120.102      apply (auto simp add: inj_on_def)
 120.103    proof-
 120.104      fix p r
 120.105 -    assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "p o q = r o q"
 120.106 +    assume "p permutes S" and r:"r permutes S" and rp: "p o q = r o q"
 120.107      hence "p o (q o inv q)  = r o (q o inv q)" by (simp add: o_assoc)
 120.108      with permutes_surj[OF q, unfolded surj_iff]
 120.109  
   121.1 --- a/src/HOL/Library/Pocklington.thy	Wed Mar 04 10:43:39 2009 +0100
   121.2 +++ b/src/HOL/Library/Pocklington.thy	Wed Mar 04 10:45:52 2009 +0100
   121.3 @@ -142,10 +142,10 @@
   121.4    shows "[x * y = x' * y'] (mod n)"
   121.5  proof-
   121.6    have "(x * y) mod n = (x mod n) * (y mod n) mod n"  
   121.7 -    by (simp add: mod_mult1_eq'[of x y n] mod_mult1_eq[of "x mod n" y n])
   121.8 +    by (simp add: mod_mult_left_eq[of x y n] mod_mult_right_eq[of "x mod n" y n])
   121.9    also have "\<dots> = (x' mod n) * (y' mod n) mod n" using xx'[unfolded modeq_def] yy'[unfolded modeq_def] by simp  
  121.10    also have "\<dots> = (x' * y') mod n"
  121.11 -    by (simp add: mod_mult1_eq'[of x' y' n] mod_mult1_eq[of "x' mod n" y' n])
  121.12 +    by (simp add: mod_mult_left_eq[of x' y' n] mod_mult_right_eq[of "x' mod n" y' n])
  121.13    finally show ?thesis unfolding modeq_def . 
  121.14  qed
  121.15  
  121.16 @@ -296,7 +296,7 @@
  121.17    from cong_solve[OF an] obtain x where x: "[a*x = b] (mod n)" by blast
  121.18    let ?x = "x mod n"
  121.19    from x have th: "[a * ?x = b] (mod n)"
  121.20 -    by (simp add: modeq_def mod_mult1_eq[of a x n])
  121.21 +    by (simp add: modeq_def mod_mult_right_eq[of a x n])
  121.22    from mod_less_divisor[ of n x] nz th have Px: "?P ?x" by simp
  121.23    {fix y assume Py: "y < n" "[a * y = b] (mod n)"
  121.24      from Py(2) th have "[a * y = a*?x] (mod n)" by (simp add: modeq_def)
  121.25 @@ -753,10 +753,10 @@
  121.26  next
  121.27    case (Suc n) 
  121.28    have "(x mod m)^(Suc n) mod m = ((x mod m) * (((x mod m) ^ n) mod m)) mod m" 
  121.29 -    by (simp add: mod_mult1_eq[symmetric])
  121.30 +    by (simp add: mod_mult_right_eq[symmetric])
  121.31    also have "\<dots> = ((x mod m) * (x^n mod m)) mod m" using Suc.hyps by simp
  121.32    also have "\<dots> = x^(Suc n) mod m"
  121.33 -    by (simp add: mod_mult1_eq'[symmetric] mod_mult1_eq[symmetric])
  121.34 +    by (simp add: mod_mult_left_eq[symmetric] mod_mult_right_eq[symmetric])
  121.35    finally show ?case .
  121.36  qed
  121.37  
  121.38 @@ -873,7 +873,7 @@
  121.39        from lh[unfolded nat_mod] 
  121.40        obtain q1 q2 where q12:"a ^ d + n * q1 = 1 + n * q2" by blast
  121.41        hence "a ^ d + n * q1 - n * q2 = 1" by simp
  121.42 -      with dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp 
  121.43 +      with nat_dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp
  121.44        with p(3) have False by simp
  121.45        hence ?rhs ..}
  121.46      ultimately have ?rhs by blast}
  121.47 @@ -891,9 +891,9 @@
  121.48      hence "[(a^?o)^?q * (a^?r) = 1] (mod n)" 
  121.49        by (simp add: modeq_def power_mult[symmetric] power_add[symmetric])
  121.50      hence th: "[a^?r = 1] (mod n)"
  121.51 -      using eqo mod_mult1_eq'[of "(a^?o)^?q" "a^?r" n]
  121.52 +      using eqo mod_mult_left_eq[of "(a^?o)^?q" "a^?r" n]
  121.53        apply (simp add: modeq_def del: One_nat_def)
  121.54 -      by (simp add: mod_mult1_eq'[symmetric])
  121.55 +      by (simp add: mod_mult_left_eq[symmetric])
  121.56      {assume r: "?r = 0" hence ?rhs by (simp add: dvd_eq_mod_eq_0)}
  121.57      moreover
  121.58      {assume r: "?r \<noteq> 0" 
   122.1 --- a/src/HOL/Library/Primes.thy	Wed Mar 04 10:43:39 2009 +0100
   122.2 +++ b/src/HOL/Library/Primes.thy	Wed Mar 04 10:45:52 2009 +0100
   122.3 @@ -45,12 +45,14 @@
   122.4    by (rule prime_dvd_square) (simp_all add: power2_eq_square)
   122.5  
   122.6  
   122.7 -lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0" by (induct n, auto)
   122.8 +lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0"
   122.9 +by (induct n, auto)
  122.10 +
  122.11  lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \<longleftrightarrow> x < y"
  122.12 -  using power_less_imp_less_base[of x "Suc n" y] power_strict_mono[of x y "Suc n"]
  122.13 -    by auto
  122.14 +by(metis linorder_not_less not_less0 power_le_imp_le_base power_less_imp_less_base)
  122.15 +
  122.16  lemma exp_mono_le: "(x::nat) ^ (Suc n) \<le> y ^ (Suc n) \<longleftrightarrow> x \<le> y"
  122.17 -  by (simp only: linorder_not_less[symmetric] exp_mono_lt)
  122.18 +by (simp only: linorder_not_less[symmetric] exp_mono_lt)
  122.19  
  122.20  lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \<longleftrightarrow> x = y"
  122.21  using power_inject_base[of x n y] by auto
  122.22 @@ -307,8 +309,8 @@
  122.23    {fix e assume H: "e dvd a^n" "e dvd b^n"
  122.24      from bezout_gcd_pow[of a n b] obtain x y 
  122.25        where xy: "a ^ n * x - b ^ n * y = ?gn \<or> b ^ n * x - a ^ n * y = ?gn" by blast
  122.26 -    from dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
  122.27 -      dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
  122.28 +    from nat_dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
  122.29 +      nat_dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
  122.30      have "e dvd ?gn" by (cases "a ^ n * x - b ^ n * y = gcd a b ^ n", simp_all)}
  122.31    hence th:  "\<forall>e. e dvd a^n \<and> e dvd b^n \<longrightarrow> e dvd ?gn" by blast
  122.32    from divides_exp[OF gcd_dvd1[of a b], of n] divides_exp[OF gcd_dvd2[of a b], of n] th
   123.1 --- a/src/HOL/Library/Word.thy	Wed Mar 04 10:43:39 2009 +0100
   123.2 +++ b/src/HOL/Library/Word.thy	Wed Mar 04 10:45:52 2009 +0100
   123.3 @@ -575,7 +575,7 @@
   123.4      have "?lhs = (1 + 2 * bv_to_nat w) mod 2"
   123.5        by (simp add: add_commute)
   123.6      also have "... = 1"
   123.7 -      by (subst mod_add1_eq) simp
   123.8 +      by (subst mod_add_eq) simp
   123.9      finally have eq1: "?lhs = 1" .
  123.10      have "?rhs  = 0" by simp
  123.11      with orig and eq1
   124.1 --- a/src/HOL/Library/Zorn.thy	Wed Mar 04 10:43:39 2009 +0100
   124.2 +++ b/src/HOL/Library/Zorn.thy	Wed Mar 04 10:45:52 2009 +0100
   124.3 @@ -297,7 +297,7 @@
   124.4        fix a B assume aB: "B:C" "a:B"
   124.5        with 1 obtain x where "x:Field r" "B = r^-1 `` {x}" by auto
   124.6        thus "(a,u) : r" using uA aB `Preorder r`
   124.7 -	by (auto simp add: preorder_on_def refl_def) (metis transD)
   124.8 +	by (auto simp add: preorder_on_def refl_on_def) (metis transD)
   124.9      qed
  124.10      thus "EX u:Field r. ?P u" using `u:Field r` by blast
  124.11    qed
  124.12 @@ -322,7 +322,7 @@
  124.13               (infix "initial'_segment'_of" 55) where
  124.14  "r initial_segment_of s == (r,s):init_seg_of"
  124.15  
  124.16 -lemma refl_init_seg_of[simp]: "r initial_segment_of r"
  124.17 +lemma refl_on_init_seg_of[simp]: "r initial_segment_of r"
  124.18  by(simp add:init_seg_of_def)
  124.19  
  124.20  lemma trans_init_seg_of:
  124.21 @@ -411,7 +411,7 @@
  124.22      by(simp add:Chain_def I_def) blast
  124.23    have FI: "Field I = ?WO" by(auto simp add:I_def init_seg_of_def Field_def)
  124.24    hence 0: "Partial_order I"
  124.25 -    by(auto simp: partial_order_on_def preorder_on_def antisym_def antisym_init_seg_of refl_def trans_def I_def elim!: trans_init_seg_of)
  124.26 +    by(auto simp: partial_order_on_def preorder_on_def antisym_def antisym_init_seg_of refl_on_def trans_def I_def elim!: trans_init_seg_of)
  124.27  -- {*I-chains have upper bounds in ?WO wrt I: their Union*}
  124.28    { fix R assume "R \<in> Chain I"
  124.29      hence Ris: "R \<in> Chain init_seg_of" using mono_Chain[OF I_init] by blast
  124.30 @@ -420,7 +420,7 @@
  124.31      have "\<forall>r\<in>R. Refl r" "\<forall>r\<in>R. trans r" "\<forall>r\<in>R. antisym r" "\<forall>r\<in>R. Total r"
  124.32           "\<forall>r\<in>R. wf(r-Id)"
  124.33        using Chain_wo[OF `R \<in> Chain I`] by(simp_all add:order_on_defs)
  124.34 -    have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by(auto simp:refl_def)
  124.35 +    have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by(auto simp:refl_on_def)
  124.36      moreover have "trans (\<Union>R)"
  124.37        by(rule chain_subset_trans_Union[OF subch `\<forall>r\<in>R. trans r`])
  124.38      moreover have "antisym(\<Union>R)"
  124.39 @@ -452,7 +452,7 @@
  124.40      proof
  124.41        assume "m={}"
  124.42        moreover have "Well_order {(x,x)}"
  124.43 -	by(simp add:order_on_defs refl_def trans_def antisym_def total_on_def Field_def Domain_def Range_def)
  124.44 +	by(simp add:order_on_defs refl_on_def trans_def antisym_def total_on_def Field_def Domain_def Range_def)
  124.45        ultimately show False using max
  124.46  	by (auto simp:I_def init_seg_of_def simp del:Field_insert)
  124.47      qed
  124.48 @@ -467,7 +467,7 @@
  124.49      have "Refl m" "trans m" "antisym m" "Total m" "wf(m-Id)"
  124.50        using `Well_order m` by(simp_all add:order_on_defs)
  124.51  --{*We show that the extension is a well-order*}
  124.52 -    have "Refl ?m" using `Refl m` Fm by(auto simp:refl_def)
  124.53 +    have "Refl ?m" using `Refl m` Fm by(auto simp:refl_on_def)
  124.54      moreover have "trans ?m" using `trans m` `x \<notin> Field m`
  124.55        unfolding trans_def Field_def Domain_def Range_def by blast
  124.56      moreover have "antisym ?m" using `antisym m` `x \<notin> Field m`
  124.57 @@ -500,10 +500,10 @@
  124.58      using well_ordering[where 'a = "'a"] by blast
  124.59    let ?r = "{(x,y). x:A & y:A & (x,y):r}"
  124.60    have 1: "Field ?r = A" using wo univ
  124.61 -    by(fastsimp simp: Field_def Domain_def Range_def order_on_defs refl_def)
  124.62 +    by(fastsimp simp: Field_def Domain_def Range_def order_on_defs refl_on_def)
  124.63    have "Refl r" "trans r" "antisym r" "Total r" "wf(r-Id)"
  124.64      using `Well_order r` by(simp_all add:order_on_defs)
  124.65 -  have "Refl ?r" using `Refl r` by(auto simp:refl_def 1 univ)
  124.66 +  have "Refl ?r" using `Refl r` by(auto simp:refl_on_def 1 univ)
  124.67    moreover have "trans ?r" using `trans r`
  124.68      unfolding trans_def by blast
  124.69    moreover have "antisym ?r" using `antisym r`
   125.1 --- a/src/HOL/Library/reflection.ML	Wed Mar 04 10:43:39 2009 +0100
   125.2 +++ b/src/HOL/Library/reflection.ML	Wed Mar 04 10:45:52 2009 +0100
   125.3 @@ -88,17 +88,12 @@
   125.4  
   125.5  fun dest_listT (Type ("List.list", [T])) = T;
   125.6  
   125.7 -fun partition P [] = ([],[])
   125.8 -  | partition P (x::xs) = 
   125.9 -     let val (yes,no) = partition P xs
  125.10 -     in if P x then (x::yes,no) else (yes, x::no) end
  125.11 -
  125.12  fun rearrange congs = 
  125.13  let 
  125.14   fun P (_, th) = 
  125.15    let val @{term "Trueprop"}$(Const ("op =",_) $l$_) = concl_of th
  125.16    in can dest_Var l end
  125.17 - val (yes,no) = partition P congs 
  125.18 + val (yes,no) = List.partition P congs 
  125.19   in no @ yes end
  125.20  
  125.21  fun genreif ctxt raw_eqs t =
   126.1 --- a/src/HOL/List.thy	Wed Mar 04 10:43:39 2009 +0100
   126.2 +++ b/src/HOL/List.thy	Wed Mar 04 10:45:52 2009 +0100
   126.3 @@ -1461,6 +1461,12 @@
   126.4  
   126.5  declare take_Cons [simp del] and drop_Cons [simp del]
   126.6  
   126.7 +lemma take_1_Cons [simp]: "take 1 (x # xs) = [x]"
   126.8 +  unfolding One_nat_def by simp
   126.9 +
  126.10 +lemma drop_1_Cons [simp]: "drop 1 (x # xs) = xs"
  126.11 +  unfolding One_nat_def by simp
  126.12 +
  126.13  lemma take_Suc: "xs ~= [] ==> take (Suc n) xs = hd xs # take n (tl xs)"
  126.14  by(clarsimp simp add:neq_Nil_conv)
  126.15  
  126.16 @@ -1592,13 +1598,13 @@
  126.17  by (simp add: butlast_conv_take min_max.inf_absorb1 min_max.inf_absorb2)
  126.18  
  126.19  lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)"
  126.20 -by (simp add: butlast_conv_take drop_take)
  126.21 +by (simp add: butlast_conv_take drop_take add_ac)
  126.22  
  126.23  lemma take_butlast: "n < length xs ==> take n (butlast xs) = take n xs"
  126.24  by (simp add: butlast_conv_take min_max.inf_absorb1)
  126.25  
  126.26  lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)"
  126.27 -by (simp add: butlast_conv_take drop_take)
  126.28 +by (simp add: butlast_conv_take drop_take add_ac)
  126.29  
  126.30  lemma hd_drop_conv_nth: "\<lbrakk> xs \<noteq> []; n < length xs \<rbrakk> \<Longrightarrow> hd(drop n xs) = xs!n"
  126.31  by(simp add: hd_conv_nth)
  126.32 @@ -1639,7 +1645,7 @@
  126.33  done
  126.34  
  126.35  lemma take_hd_drop:
  126.36 -  "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (n+1) xs"
  126.37 +  "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs"
  126.38  apply(induct xs arbitrary: n)
  126.39  apply simp
  126.40  apply(simp add:drop_Cons split:nat.split)
  126.41 @@ -3220,7 +3226,7 @@
  126.42  lemma lenlex_conv:
  126.43      "lenlex r = {(xs,ys). length xs < length ys |
  126.44                   length xs = length ys \<and> (xs, ys) : lex r}"
  126.45 -by (simp add: lenlex_def diag_def lex_prod_def inv_image_def)
  126.46 +by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def)
  126.47  
  126.48  lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r"
  126.49  by (simp add: lex_conv)
  126.50 @@ -3386,8 +3392,8 @@
  126.51  apply (erule listrel.induct, auto) 
  126.52  done
  126.53  
  126.54 -lemma listrel_refl: "refl A r \<Longrightarrow> refl (lists A) (listrel r)" 
  126.55 -apply (simp add: refl_def listrel_subset Ball_def)
  126.56 +lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)" 
  126.57 +apply (simp add: refl_on_def listrel_subset Ball_def)
  126.58  apply (rule allI) 
  126.59  apply (induct_tac x) 
  126.60  apply (auto intro: listrel.intros)
  126.61 @@ -3408,7 +3414,7 @@
  126.62  done
  126.63  
  126.64  theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)"
  126.65 -by (simp add: equiv_def listrel_refl listrel_sym listrel_trans) 
  126.66 +by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) 
  126.67  
  126.68  lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}"
  126.69  by (blast intro: listrel.intros)
  126.70 @@ -3564,52 +3570,51 @@
  126.71  
  126.72  open Basic_Code_Thingol;
  126.73  
  126.74 -fun implode_list (nil', cons') t =
  126.75 -  let
  126.76 -    fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
  126.77 -          if c = cons'
  126.78 -          then SOME (t1, t2)
  126.79 -          else NONE
  126.80 -      | dest_cons _ = NONE;
  126.81 -    val (ts, t') = Code_Thingol.unfoldr dest_cons t;
  126.82 -  in case t'
  126.83 -   of IConst (c, _) => if c = nil' then SOME ts else NONE
  126.84 +fun implode_list naming t = case pairself
  126.85 +  (Code_Thingol.lookup_const naming) (@{const_name Nil}, @{const_name Cons})
  126.86 +   of (SOME nil', SOME cons') => let
  126.87 +          fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
  126.88 +                if c = cons'
  126.89 +                then SOME (t1, t2)
  126.90 +                else NONE
  126.91 +            | dest_cons _ = NONE;
  126.92 +          val (ts, t') = Code_Thingol.unfoldr dest_cons t;
  126.93 +        in case t'
  126.94 +         of IConst (c, _) => if c = nil' then SOME ts else NONE
  126.95 +          | _ => NONE
  126.96 +        end
  126.97      | _ => NONE
  126.98 -  end;
  126.99 -
 126.100 -fun decode_char nibbles' (IConst (c1, _), IConst (c2, _)) =
 126.101 -      let
 126.102 -        fun idx c = find_index (curry (op =) c) nibbles';
 126.103 -        fun decode ~1 _ = NONE
 126.104 -          | decode _ ~1 = NONE
 126.105 -          | decode n m = SOME (chr (n * 16 + m));
 126.106 -      in decode (idx c1) (idx c2) end
 126.107 -  | decode_char _ _ = NONE;
 126.108 -
 126.109 -fun implode_string (char', nibbles') mk_char mk_string ts =
 126.110 -  let
 126.111 -    fun implode_char (IConst (c, _) `$ t1 `$ t2) =
 126.112 -          if c = char' then decode_char nibbles' (t1, t2) else NONE
 126.113 -      | implode_char _ = NONE;
 126.114 -    val ts' = map implode_char ts;
 126.115 -  in if forall is_some ts'
 126.116 -    then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
 126.117 -    else NONE
 126.118 -  end;
 126.119 -
 126.120 -fun list_names naming = pairself (the o Code_Thingol.lookup_const naming)
 126.121 -  (@{const_name Nil}, @{const_name Cons});
 126.122 -fun char_name naming = (the o Code_Thingol.lookup_const naming)
 126.123 -  @{const_name Char}
 126.124 -fun nibble_names naming = map (the o Code_Thingol.lookup_const naming)
 126.125 -  [@{const_name Nibble0}, @{const_name Nibble1},
 126.126 +
 126.127 +fun decode_char naming (IConst (c1, _), IConst (c2, _)) = (case map_filter
 126.128 +  (Code_Thingol.lookup_const naming)[@{const_name Nibble0}, @{const_name Nibble1},
 126.129     @{const_name Nibble2}, @{const_name Nibble3},
 126.130     @{const_name Nibble4}, @{const_name Nibble5},
 126.131     @{const_name Nibble6}, @{const_name Nibble7},
 126.132     @{const_name Nibble8}, @{const_name Nibble9},
 126.133     @{const_name NibbleA}, @{const_name NibbleB},
 126.134     @{const_name NibbleC}, @{const_name NibbleD},
 126.135 -   @{const_name NibbleE}, @{const_name NibbleF}];
 126.136 +   @{const_name NibbleE}, @{const_name NibbleF}]
 126.137 +   of nibbles' as [_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _] => let
 126.138 +          fun idx c = find_index (curry (op =) c) nibbles';
 126.139 +          fun decode ~1 _ = NONE
 126.140 +            | decode _ ~1 = NONE
 126.141 +            | decode n m = SOME (chr (n * 16 + m));
 126.142 +        in decode (idx c1) (idx c2) end
 126.143 +    | _ => NONE)
 126.144 + | decode_char _ _ = NONE
 126.145 +   
 126.146 +fun implode_string naming mk_char mk_string ts = case
 126.147 +  Code_Thingol.lookup_const naming @{const_name Char}
 126.148 +   of SOME char' => let
 126.149 +        fun implode_char (IConst (c, _) `$ t1 `$ t2) =
 126.150 +              if c = char' then decode_char naming (t1, t2) else NONE
 126.151 +          | implode_char _ = NONE;
 126.152 +        val ts' = map implode_char ts;
 126.153 +      in if forall is_some ts'
 126.154 +        then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
 126.155 +        else NONE
 126.156 +      end
 126.157 +    | _ => NONE;
 126.158  
 126.159  fun default_list (target_fxy, target_cons) pr fxy t1 t2 =
 126.160    Code_Printer.brackify_infix (target_fxy, Code_Printer.R) fxy [
 126.161 @@ -3622,7 +3627,7 @@
 126.162    let
 126.163      val mk_list = Code_Printer.literal_list literals;
 126.164      fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
 126.165 -      case Option.map (cons t1) (implode_list (list_names naming) t2)
 126.166 +      case Option.map (cons t1) (implode_list naming t2)
 126.167         of SOME ts => mk_list (map (pr vars Code_Printer.NOBR) ts)
 126.168          | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
 126.169    in (2, pretty) end;
 126.170 @@ -3633,8 +3638,8 @@
 126.171      val mk_char = Code_Printer.literal_char literals;
 126.172      val mk_string = Code_Printer.literal_string literals;
 126.173      fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
 126.174 -      case Option.map (cons t1) (implode_list (list_names naming) t2)
 126.175 -       of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
 126.176 +      case Option.map (cons t1) (implode_list naming t2)
 126.177 +       of SOME ts => (case implode_string naming mk_char mk_string ts
 126.178             of SOME p => p
 126.179              | NONE => mk_list (map (pr vars Code_Printer.NOBR) ts))
 126.180          | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
 126.181 @@ -3644,7 +3649,7 @@
 126.182    let
 126.183      val mk_char = Code_Printer.literal_char literals;
 126.184      fun pretty _ naming thm _ _ [(t1, _), (t2, _)] =
 126.185 -      case decode_char (nibble_names naming) (t1, t2)
 126.186 +      case decode_char naming (t1, t2)
 126.187         of SOME c => (Code_Printer.str o mk_char) c
 126.188          | NONE => Code_Printer.nerror thm "Illegal character expression";
 126.189    in (2, pretty) end;
 126.190 @@ -3654,8 +3659,8 @@
 126.191      val mk_char = Code_Printer.literal_char literals;
 126.192      val mk_string = Code_Printer.literal_string literals;
 126.193      fun pretty _ naming thm _ _ [(t, _)] =
 126.194 -      case implode_list (list_names naming) t
 126.195 -       of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
 126.196 +      case implode_list naming t
 126.197 +       of SOME ts => (case implode_string naming mk_char mk_string ts
 126.198             of SOME p => p
 126.199              | NONE => Code_Printer.nerror thm "Illegal message expression")
 126.200          | NONE => Code_Printer.nerror thm "Illegal message expression";
   127.1 --- a/src/HOL/MacLaurin.thy	Wed Mar 04 10:43:39 2009 +0100
   127.2 +++ b/src/HOL/MacLaurin.thy	Wed Mar 04 10:45:52 2009 +0100
   127.3 @@ -81,7 +81,7 @@
   127.4    prefer 2 apply simp
   127.5   apply (frule less_iff_Suc_add [THEN iffD1], clarify)
   127.6   apply (simp del: setsum_op_ivl_Suc)
   127.7 - apply (insert sumr_offset4 [of 1])
   127.8 + apply (insert sumr_offset4 [of "Suc 0"])
   127.9   apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
  127.10   apply (rule lemma_DERIV_subst)
  127.11    apply (rule DERIV_add)
  127.12 @@ -124,7 +124,7 @@
  127.13  
  127.14    have g2: "g 0 = 0 & g h = 0"
  127.15      apply (simp add: m f_h g_def del: setsum_op_ivl_Suc)
  127.16 -    apply (cut_tac n = m and k = 1 in sumr_offset2)
  127.17 +    apply (cut_tac n = m and k = "Suc 0" in sumr_offset2)
  127.18      apply (simp add: eq_diff_eq' diff_0 del: setsum_op_ivl_Suc)
  127.19      done
  127.20  
  127.21 @@ -144,7 +144,7 @@
  127.22      apply (simp add: m difg_def)
  127.23      apply (frule less_iff_Suc_add [THEN iffD1], clarify)
  127.24      apply (simp del: setsum_op_ivl_Suc)
  127.25 -    apply (insert sumr_offset4 [of 1])
  127.26 +    apply (insert sumr_offset4 [of "Suc 0"])
  127.27      apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
  127.28      done
  127.29  
  127.30 @@ -552,6 +552,10 @@
  127.31      "[|x = y; abs u \<le> (v::real) |] ==> \<bar>(x + u) - y\<bar> \<le> v"
  127.32  by auto
  127.33  
  127.34 +text {* TODO: move to Parity.thy *}
  127.35 +lemma nat_odd_1 [simp]: "odd (1::nat)"
  127.36 +  unfolding even_nat_def by simp
  127.37 +
  127.38  lemma Maclaurin_sin_bound:
  127.39    "abs(sin x - (\<Sum>m=0..<n. (if even m then 0 else (-1 ^ ((m - Suc 0) div 2)) / real (fact m)) *
  127.40    x ^ m))  \<le> inverse(real (fact n)) * \<bar>x\<bar> ^ n"
   128.1 --- a/src/HOL/MetisExamples/Tarski.thy	Wed Mar 04 10:43:39 2009 +0100
   128.2 +++ b/src/HOL/MetisExamples/Tarski.thy	Wed Mar 04 10:45:52 2009 +0100
   128.3 @@ -61,7 +61,7 @@
   128.4    "Top po == greatest (%x. True) po"
   128.5  
   128.6    PartialOrder :: "('a potype) set"
   128.7 -  "PartialOrder == {P. refl (pset P) (order P) & antisym (order P) &
   128.8 +  "PartialOrder == {P. refl_on (pset P) (order P) & antisym (order P) &
   128.9                         trans (order P)}"
  128.10  
  128.11    CompleteLattice :: "('a potype) set"
  128.12 @@ -126,7 +126,7 @@
  128.13  
  128.14  subsection {* Partial Order *}
  128.15  
  128.16 -lemma (in PO) PO_imp_refl: "refl A r"
  128.17 +lemma (in PO) PO_imp_refl_on: "refl_on A r"
  128.18  apply (insert cl_po)
  128.19  apply (simp add: PartialOrder_def A_def r_def)
  128.20  done
  128.21 @@ -143,7 +143,7 @@
  128.22  
  128.23  lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
  128.24  apply (insert cl_po)
  128.25 -apply (simp add: PartialOrder_def refl_def A_def r_def)
  128.26 +apply (simp add: PartialOrder_def refl_on_def A_def r_def)
  128.27  done
  128.28  
  128.29  lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
  128.30 @@ -166,7 +166,7 @@
  128.31  apply (simp (no_asm) add: PartialOrder_def)
  128.32  apply auto
  128.33  -- {* refl *}
  128.34 -apply (simp add: refl_def induced_def)
  128.35 +apply (simp add: refl_on_def induced_def)
  128.36  apply (blast intro: reflE)
  128.37  -- {* antisym *}
  128.38  apply (simp add: antisym_def induced_def)
  128.39 @@ -203,7 +203,7 @@
  128.40  
  128.41  lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
  128.42  apply (insert cl_po)
  128.43 -apply (simp add: PartialOrder_def dual_def refl_converse
  128.44 +apply (simp add: PartialOrder_def dual_def refl_on_converse
  128.45                   trans_converse antisym_converse)
  128.46  done
  128.47  
  128.48 @@ -230,12 +230,12 @@
  128.49  
  128.50  lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]
  128.51  
  128.52 -declare PO.PO_imp_refl  [OF PO.intro [OF CL_imp_PO], simp]
  128.53 +declare PO.PO_imp_refl_on  [OF PO.intro [OF CL_imp_PO], simp]
  128.54  declare PO.PO_imp_sym   [OF PO.intro [OF CL_imp_PO], simp]
  128.55  declare PO.PO_imp_trans [OF PO.intro [OF CL_imp_PO], simp]
  128.56  
  128.57 -lemma (in CL) CO_refl: "refl A r"
  128.58 -by (rule PO_imp_refl)
  128.59 +lemma (in CL) CO_refl_on: "refl_on A r"
  128.60 +by (rule PO_imp_refl_on)
  128.61  
  128.62  lemma (in CL) CO_antisym: "antisym r"
  128.63  by (rule PO_imp_sym)
  128.64 @@ -501,10 +501,10 @@
  128.65  apply (rule conjI)
  128.66  ML_command{*AtpWrapper.problem_name:="Tarski__CLF_flubH_le_lubH_simpler"*}
  128.67  (*??no longer terminates, with combinators
  128.68 -apply (metis CO_refl lubH_le_flubH monotone_def monotone_f reflD1 reflD2) 
  128.69 +apply (metis CO_refl_on lubH_le_flubH monotone_def monotone_f reflD1 reflD2) 
  128.70  *)
  128.71 -apply (metis CO_refl lubH_le_flubH monotoneE [OF monotone_f] reflD1 reflD2)
  128.72 -apply (metis CO_refl lubH_le_flubH reflD2)
  128.73 +apply (metis CO_refl_on lubH_le_flubH monotoneE [OF monotone_f] refl_onD1 refl_onD2)
  128.74 +apply (metis CO_refl_on lubH_le_flubH refl_onD2)
  128.75  done
  128.76    declare CLF.f_in_funcset[rule del] funcset_mem[rule del] 
  128.77            CL.lub_in_lattice[rule del] PO.monotoneE[rule del] 
  128.78 @@ -542,12 +542,12 @@
  128.79    by (metis 5 3)
  128.80  have 7: "(lub H cl, lub H cl) \<in> r"
  128.81    by (metis 6 4)
  128.82 -have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl X1 r"
  128.83 -  by (metis 7 reflD2)
  128.84 -have 9: "\<not> refl A r"
  128.85 +have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl_on X1 r"
  128.86 +  by (metis 7 refl_onD2)
  128.87 +have 9: "\<not> refl_on A r"
  128.88    by (metis 8 2)
  128.89  show "False"
  128.90 -  by (metis CO_refl 9);
  128.91 +  by (metis CO_refl_on 9);
  128.92  next --{*apparently the way to insert a second structured proof*}
  128.93    show "H = {x. (x, f x) \<in> r \<and> x \<in> A} \<Longrightarrow>
  128.94    f (lub {x. (x, f x) \<in> r \<and> x \<in> A} cl) = lub {x. (x, f x) \<in> r \<and> x \<in> A} cl"
  128.95 @@ -589,13 +589,13 @@
  128.96  apply (simp add: fix_def)
  128.97  apply (rule conjI)
  128.98  ML_command{*AtpWrapper.problem_name:="Tarski__CLF_lubH_is_fixp_simpler"*} 
  128.99 -apply (metis CO_refl lubH_le_flubH reflD1)
 128.100 +apply (metis CO_refl_on lubH_le_flubH refl_onD1)
 128.101  apply (metis antisymE flubH_le_lubH lubH_le_flubH)
 128.102  done
 128.103  
 128.104  lemma (in CLF) fix_in_H:
 128.105       "[| H = {x. (x, f x) \<in> r & x \<in> A};  x \<in> P |] ==> x \<in> H"
 128.106 -by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl
 128.107 +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
 128.108                      fix_subset [of f A, THEN subsetD])
 128.109  
 128.110  
 128.111 @@ -678,16 +678,16 @@
 128.112  
 128.113  
 128.114  ML{*AtpWrapper.problem_name:="Tarski__rel_imp_elem"*}
 128.115 -  declare (in CLF) CO_refl[simp] refl_def [simp]
 128.116 +  declare (in CLF) CO_refl_on[simp] refl_on_def [simp]
 128.117  lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
 128.118 -by (metis CO_refl reflD1)
 128.119 -  declare (in CLF) CO_refl[simp del]  refl_def [simp del]
 128.120 +by (metis CO_refl_on refl_onD1)
 128.121 +  declare (in CLF) CO_refl_on[simp del]  refl_on_def [simp del]
 128.122  
 128.123  ML{*AtpWrapper.problem_name:="Tarski__interval_subset"*}
 128.124    declare (in CLF) rel_imp_elem[intro] 
 128.125    declare interval_def [simp]
 128.126  lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
 128.127 -by (metis CO_refl interval_imp_mem reflD reflD2 rel_imp_elem subset_eq)
 128.128 +by (metis CO_refl_on interval_imp_mem refl_onD refl_onD2 rel_imp_elem subset_eq)
 128.129    declare (in CLF) rel_imp_elem[rule del] 
 128.130    declare interval_def [simp del]
 128.131  
   129.1 --- a/src/HOL/NSA/NSA.thy	Wed Mar 04 10:43:39 2009 +0100
   129.2 +++ b/src/HOL/NSA/NSA.thy	Wed Mar 04 10:45:52 2009 +0100
   129.3 @@ -157,7 +157,7 @@
   129.4  by transfer (rule norm_divide)
   129.5  
   129.6  lemma hypreal_hnorm_def [simp]:
   129.7 -  "\<And>r::hypreal. hnorm r \<equiv> \<bar>r\<bar>"
   129.8 +  "\<And>r::hypreal. hnorm r = \<bar>r\<bar>"
   129.9  by transfer (rule real_norm_def)
  129.10  
  129.11  lemma hnorm_add_less:
   130.1 --- a/src/HOL/NSA/StarDef.thy	Wed Mar 04 10:43:39 2009 +0100
   130.2 +++ b/src/HOL/NSA/StarDef.thy	Wed Mar 04 10:45:52 2009 +0100
   130.3 @@ -64,7 +64,7 @@
   130.4  
   130.5  lemma equiv_starrel: "equiv UNIV starrel"
   130.6  proof (rule equiv.intro)
   130.7 -  show "reflexive starrel" by (simp add: refl_def)
   130.8 +  show "refl starrel" by (simp add: refl_on_def)
   130.9    show "sym starrel" by (simp add: sym_def eq_commute)
  130.10    show "trans starrel" by (auto intro: transI elim!: ultra)
  130.11  qed
   131.1 --- a/src/HOL/Nat.thy	Wed Mar 04 10:43:39 2009 +0100
   131.2 +++ b/src/HOL/Nat.thy	Wed Mar 04 10:45:52 2009 +0100
   131.3 @@ -196,8 +196,8 @@
   131.4  
   131.5  instance proof
   131.6    fix n m q :: nat
   131.7 -  show "0 \<noteq> (1::nat)" by simp
   131.8 -  show "1 * n = n" by simp
   131.9 +  show "0 \<noteq> (1::nat)" unfolding One_nat_def by simp
  131.10 +  show "1 * n = n" unfolding One_nat_def by simp
  131.11    show "n * m = m * n" by (induct n) simp_all
  131.12    show "(n * m) * q = n * (m * q)" by (induct n) (simp_all add: add_mult_distrib)
  131.13    show "(n + m) * q = n * q + m * q" by (rule add_mult_distrib)
  131.14 @@ -280,6 +280,9 @@
  131.15  lemma diff_add_0: "n - (n + m) = (0::nat)"
  131.16    by (induct n) simp_all
  131.17  
  131.18 +lemma diff_Suc_1 [simp]: "Suc n - 1 = n"
  131.19 +  unfolding One_nat_def by simp
  131.20 +
  131.21  text {* Difference distributes over multiplication *}
  131.22  
  131.23  lemma diff_mult_distrib: "((m::nat) - n) * k = (m * k) - (n * k)"
  131.24 @@ -307,18 +310,24 @@
  131.25  lemmas nat_distrib =
  131.26    add_mult_distrib add_mult_distrib2 diff_mult_distrib diff_mult_distrib2
  131.27  
  131.28 -lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = 1 & n = 1)"
  131.29 +lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = Suc 0 & n = Suc 0)"
  131.30    apply (induct m)
  131.31     apply simp
  131.32    apply (induct n)
  131.33     apply auto
  131.34    done
  131.35  
  131.36 -lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = 1 & n = 1)"
  131.37 +lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = Suc 0 & n = Suc 0)"
  131.38    apply (rule trans)
  131.39    apply (rule_tac [2] mult_eq_1_iff, fastsimp)
  131.40    done
  131.41  
  131.42 +lemma nat_mult_eq_1_iff [simp]: "m * n = (1::nat) \<longleftrightarrow> m = 1 \<and> n = 1"
  131.43 +  unfolding One_nat_def by (rule mult_eq_1_iff)
  131.44 +
  131.45 +lemma nat_1_eq_mult_iff [simp]: "(1::nat) = m * n \<longleftrightarrow> m = 1 \<and> n = 1"
  131.46 +  unfolding One_nat_def by (rule one_eq_mult_iff)
  131.47 +
  131.48  lemma mult_cancel1 [simp]: "(k * m = k * n) = (m = n | (k = (0::nat)))"
  131.49  proof -
  131.50    have "k \<noteq> 0 \<Longrightarrow> k * m = k * n \<Longrightarrow> m = n"
  131.51 @@ -465,11 +474,11 @@
  131.52  lemma less_Suc_eq: "(m < Suc n) = (m < n | m = n)"
  131.53    unfolding less_Suc_eq_le le_less ..
  131.54  
  131.55 -lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
  131.56 +lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
  131.57    by (simp add: less_Suc_eq)
  131.58  
  131.59 -lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
  131.60 -  by (simp add: less_Suc_eq)
  131.61 +lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
  131.62 +  unfolding One_nat_def by (rule less_Suc0)
  131.63  
  131.64  lemma Suc_mono: "m < n ==> Suc m < Suc n"
  131.65    by simp
  131.66 @@ -692,6 +701,9 @@
  131.67  lemma Suc_pred [simp]: "n>0 ==> Suc (n - Suc 0) = n"
  131.68  by (simp add: diff_Suc split: nat.split)
  131.69  
  131.70 +lemma Suc_diff_1 [simp]: "0 < n ==> Suc (n - 1) = n"
  131.71 +unfolding One_nat_def by (rule Suc_pred)
  131.72 +
  131.73  lemma nat_add_left_cancel_le [simp]: "(k + m \<le> k + n) = (m\<le>(n::nat))"
  131.74  by (induct k) simp_all
  131.75  
  131.76 @@ -735,6 +747,11 @@
  131.77    show "i < j ==> 0 < k ==> k * i < k * j" by (simp add: mult_less_mono2)
  131.78  qed
  131.79  
  131.80 +instance nat :: no_zero_divisors
  131.81 +proof
  131.82 +  fix a::nat and b::nat show "a ~= 0 \<Longrightarrow> b ~= 0 \<Longrightarrow> a * b ~= 0" by auto
  131.83 +qed
  131.84 +
  131.85  lemma nat_mult_1: "(1::nat) * n = n"
  131.86  by simp
  131.87  
  131.88 @@ -795,6 +812,7 @@
  131.89    done
  131.90  
  131.91  lemma ex_least_nat_less: "\<not>P(0) \<Longrightarrow> P(n::nat) \<Longrightarrow> \<exists>k<n. (\<forall>i\<le>k. \<not>P i) & P(k+1)"
  131.92 +  unfolding One_nat_def
  131.93    apply (cases n)
  131.94     apply blast
  131.95    apply (frule (1) ex_least_nat_le)
  131.96 @@ -1084,7 +1102,7 @@
  131.97     apply simp_all
  131.98    done
  131.99  
 131.100 -lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (1 \<le> m & 1 \<le> n)"
 131.101 +lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (Suc 0 \<le> m & Suc 0 \<le> n)"
 131.102    apply (induct m)
 131.103     apply simp
 131.104    apply (case_tac n)
 131.105 @@ -1159,7 +1177,7 @@
 131.106    | of_nat_Suc: "of_nat (Suc m) = 1 + of_nat m"
 131.107  
 131.108  lemma of_nat_1 [simp]: "of_nat 1 = 1"
 131.109 -  by simp
 131.110 +  unfolding One_nat_def by simp
 131.111  
 131.112  lemma of_nat_add [simp]: "of_nat (m + n) = of_nat m + of_nat n"
 131.113    by (induct m) (simp_all add: add_ac)
 131.114 @@ -1271,7 +1289,7 @@
 131.115  end
 131.116  
 131.117  lemma of_nat_id [simp]: "of_nat n = n"
 131.118 -  by (induct n) auto
 131.119 +  by (induct n) (auto simp add: One_nat_def)
 131.120  
 131.121  lemma of_nat_eq_id [simp]: "of_nat = id"
 131.122    by (auto simp add: expand_fun_eq)
 131.123 @@ -1376,7 +1394,7 @@
 131.124  apply(induct_tac k)
 131.125   apply simp
 131.126  apply(erule_tac x="m+n" in meta_allE)
 131.127 -apply(erule_tac x="m+n+1" in meta_allE)
 131.128 +apply(erule_tac x="Suc(m+n)" in meta_allE)
 131.129  apply simp
 131.130  done
 131.131  
   132.1 --- a/src/HOL/NatBin.thy	Wed Mar 04 10:43:39 2009 +0100
   132.2 +++ b/src/HOL/NatBin.thy	Wed Mar 04 10:45:52 2009 +0100
   132.3 @@ -159,6 +159,21 @@
   132.4    unfolding nat_number_of_def number_of_is_id numeral_simps
   132.5    by (simp add: nat_add_distrib)
   132.6  
   132.7 +lemma nat_number_of_add_1 [simp]:
   132.8 +  "number_of v + (1::nat) =
   132.9 +    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  132.10 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  132.11 +  by (simp add: nat_add_distrib)
  132.12 +
  132.13 +lemma nat_1_add_number_of [simp]:
  132.14 +  "(1::nat) + number_of v =
  132.15 +    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  132.16 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  132.17 +  by (simp add: nat_add_distrib)
  132.18 +
  132.19 +lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  132.20 +  by (rule int_int_eq [THEN iffD1]) simp
  132.21 +
  132.22  
  132.23  subsubsection{*Subtraction *}
  132.24  
  132.25 @@ -178,6 +193,12 @@
  132.26    unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  132.27    by auto
  132.28  
  132.29 +lemma nat_number_of_diff_1 [simp]:
  132.30 +  "number_of v - (1::nat) =
  132.31 +    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  132.32 +  unfolding nat_number_of_def number_of_is_id numeral_simps
  132.33 +  by auto
  132.34 +
  132.35  
  132.36  subsubsection{*Multiplication *}
  132.37  
  132.38 @@ -362,9 +383,14 @@
  132.39  unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
  132.40  
  132.41  lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
  132.42 -apply (induct "n")
  132.43 -apply (auto simp add: power_Suc power_add)
  132.44 -done
  132.45 +proof (induct n)
  132.46 +  case 0 show ?case by simp
  132.47 +next
  132.48 +  case (Suc n) then show ?case by (simp add: power_Suc power_add)
  132.49 +qed
  132.50 +
  132.51 +lemma power_minus1_odd: "(- 1) ^ Suc(2*n) = -(1::'a::{comm_ring_1,recpower})"
  132.52 +  by (simp add: power_Suc) 
  132.53  
  132.54  lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
  132.55  by (subst mult_commute) (simp add: power_mult)
  132.56 @@ -437,19 +463,13 @@
  132.57  (* These two can be useful when m = number_of... *)
  132.58  
  132.59  lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  132.60 -apply (case_tac "m")
  132.61 -apply (simp_all add: numerals)
  132.62 -done
  132.63 +  unfolding One_nat_def by (cases m) simp_all
  132.64  
  132.65  lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
  132.66 -apply (case_tac "m")
  132.67 -apply (simp_all add: numerals)
  132.68 -done
  132.69 +  unfolding One_nat_def by (cases m) simp_all
  132.70  
  132.71  lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
  132.72 -apply (case_tac "m")
  132.73 -apply (simp_all add: numerals)
  132.74 -done
  132.75 +  unfolding One_nat_def by (cases m) simp_all
  132.76  
  132.77  
  132.78  subsection{*Comparisons involving (0::nat) *}
   133.1 --- a/src/HOL/Nominal/Examples/Fsub.thy	Wed Mar 04 10:43:39 2009 +0100
   133.2 +++ b/src/HOL/Nominal/Examples/Fsub.thy	Wed Mar 04 10:45:52 2009 +0100
   133.3 @@ -7,13 +7,18 @@
   133.4  text{* Authors: Christian Urban,
   133.5                  Benjamin Pierce,
   133.6                  Dimitrios Vytiniotis
   133.7 -                Stephanie Weirich and
   133.8 +                Stephanie Weirich
   133.9                  Steve Zdancewic
  133.10 +                Julien Narboux
  133.11 +                Stefan Berghofer
  133.12  
  133.13 -       with great help from Stefan Berghofer and  Markus Wenzel. *}
  133.14 +       with great help from Markus Wenzel. *}
  133.15  
  133.16  section {* Types for Names, Nominal Datatype Declaration for Types and Terms *}
  133.17  
  133.18 +no_syntax
  133.19 +  "_Map" :: "maplets => 'a ~=> 'b"  ("(1[_])")
  133.20 +
  133.21  text {* The main point of this solution is to use names everywhere (be they bound, 
  133.22    binding or free). In System \FSUB{} there are two kinds of names corresponding to 
  133.23    type-variables and to term-variables. These two kinds of names are represented in 
  133.24 @@ -31,30 +36,35 @@
  133.25  nominal_datatype ty = 
  133.26      Tvar   "tyvrs"
  133.27    | Top
  133.28 -  | Arrow  "ty" "ty"          ("_ \<rightarrow> _" [100,100] 100)
  133.29 +  | Arrow  "ty" "ty"         (infixr "\<rightarrow>" 200)
  133.30    | Forall "\<guillemotleft>tyvrs\<guillemotright>ty" "ty" 
  133.31  
  133.32  nominal_datatype trm = 
  133.33      Var   "vrs"
  133.34 -  | Lam   "\<guillemotleft>vrs\<guillemotright>trm" "ty" 
  133.35 -  | Tabs  "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
  133.36 -  | App   "trm" "trm"
  133.37 -  | Tapp  "trm" "ty"
  133.38 +  | Abs   "\<guillemotleft>vrs\<guillemotright>trm" "ty" 
  133.39 +  | TAbs  "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
  133.40 +  | App   "trm" "trm" (infixl "\<cdot>" 200)
  133.41 +  | TApp  "trm" "ty"  (infixl "\<cdot>\<^sub>\<tau>" 200)
  133.42  
  133.43  text {* To be polite to the eye, some more familiar notation is introduced. 
  133.44    Because of the change in the order of arguments, one needs to use 
  133.45    translation rules, instead of syntax annotations at the term-constructors
  133.46    as given above for @{term "Arrow"}. *}
  133.47  
  133.48 -syntax
  133.49 -  Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty" ("\<forall>[_<:_]._" [100,100,100] 100)
  133.50 -  Lam_syn    :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"   ("Lam [_:_]._" [100,100,100] 100)
  133.51 -  Tabs_syn   :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("Tabs [_<:_]._" [100,100,100] 100)
  133.52 +abbreviation
  133.53 +  Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty"  ("(3\<forall>_<:_./ _)" [0, 0, 10] 10) 
  133.54 +where
  133.55 +  "\<forall>X<:T\<^isub>1. T\<^isub>2 \<equiv> ty.Forall X T\<^isub>2 T\<^isub>1"
  133.56  
  133.57 -translations 
  133.58 -  "\<forall>[X<:T\<^isub>1].T\<^isub>2" \<rightleftharpoons> "ty.Forall X T\<^isub>2 T\<^isub>1"
  133.59 -  "Lam [x:T].t" \<rightleftharpoons> "trm.Lam x t T"
  133.60 -  "Tabs [X<:T].t" \<rightleftharpoons> "trm.Tabs X t T"
  133.61 +abbreviation
  133.62 +  Abs_syn    :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"  ("(3\<lambda>_:_./ _)" [0, 0, 10] 10) 
  133.63 +where
  133.64 +  "\<lambda>x:T. t \<equiv> trm.Abs x t T"
  133.65 +
  133.66 +abbreviation
  133.67 +  TAbs_syn   :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("(3\<lambda>_<:_./ _)" [0, 0, 10] 10) 
  133.68 +where
  133.69 +  "\<lambda>X<:T. t \<equiv> trm.TAbs X t T"
  133.70  
  133.71  text {* Again there are numerous facts that are proved automatically for @{typ "ty"} 
  133.72    and @{typ "trm"}: for example that the set of free variables, i.e.~the @{text "support"}, 
  133.73 @@ -64,13 +74,17 @@
  133.74    and @{typ "trm"}s are equal: *}
  133.75  
  133.76  lemma alpha_illustration:
  133.77 -  shows "\<forall>[X<:T].(Tvar X) = \<forall>[Y<:T].(Tvar Y)" 
  133.78 -  and "Lam [x:T].(Var x) = Lam [y:T].(Var y)"
  133.79 +  shows "(\<forall>X<:T. Tvar X) = (\<forall>Y<:T. Tvar Y)"
  133.80 +  and   "(\<lambda>x:T. Var x) = (\<lambda>y:T. Var y)"
  133.81    by (simp_all add: ty.inject trm.inject alpha calc_atm fresh_atm)
  133.82  
  133.83  section {* SubTyping Contexts *}
  133.84  
  133.85 -types ty_context = "(tyvrs\<times>ty) list"
  133.86 +nominal_datatype binding = 
  133.87 +    VarB vrs ty 
  133.88 +  | TVarB tyvrs ty
  133.89 +
  133.90 +types env = "binding list"
  133.91  
  133.92  text {* Typing contexts are represented as lists that ``grow" on the left; we
  133.93    thereby deviating from the convention in the POPLmark-paper. The lists contain
  133.94 @@ -79,66 +93,139 @@
  133.95  text {* In order to state validity-conditions for typing-contexts, the notion of
  133.96    a @{text "domain"} of a typing-context is handy. *}
  133.97  
  133.98 +nominal_primrec
  133.99 +  "tyvrs_of" :: "binding \<Rightarrow> tyvrs set"
 133.100 +where
 133.101 +  "tyvrs_of (VarB  x y) = {}"
 133.102 +| "tyvrs_of (TVarB x y) = {x}"
 133.103 +by auto
 133.104 +
 133.105 +nominal_primrec
 133.106 +  "vrs_of" :: "binding \<Rightarrow> vrs set"
 133.107 +where
 133.108 +  "vrs_of (VarB  x y) = {x}"
 133.109 +| "vrs_of (TVarB x y) = {}"
 133.110 +by auto
 133.111 +
 133.112  consts
 133.113 -  "domain" :: "ty_context \<Rightarrow> tyvrs set"
 133.114 +  "ty_domain" :: "env \<Rightarrow> tyvrs set"
 133.115  primrec
 133.116 -  "domain [] = {}"
 133.117 -  "domain (X#\<Gamma>) = {fst X}\<union>(domain \<Gamma>)" 
 133.118 +  "ty_domain [] = {}"
 133.119 +  "ty_domain (X#\<Gamma>) = (tyvrs_of X)\<union>(ty_domain \<Gamma>)" 
 133.120  
 133.121 -lemma domain_eqvt[eqvt]:
 133.122 +consts
 133.123 +  "trm_domain" :: "env \<Rightarrow> vrs set"
 133.124 +primrec
 133.125 +  "trm_domain [] = {}"
 133.126 +  "trm_domain (X#\<Gamma>) = (vrs_of X)\<union>(trm_domain \<Gamma>)" 
 133.127 +
 133.128 +lemma vrs_of_eqvt[eqvt]:
 133.129 +  fixes pi ::"tyvrs prm"
 133.130 +  and   pi'::"vrs   prm"
 133.131 +  shows "pi \<bullet>(tyvrs_of x) = tyvrs_of (pi\<bullet>x)"
 133.132 +  and   "pi'\<bullet>(tyvrs_of x) = tyvrs_of (pi'\<bullet>x)"
 133.133 +  and   "pi \<bullet>(vrs_of x)   = vrs_of   (pi\<bullet>x)"
 133.134 +  and   "pi'\<bullet>(vrs_of x)   = vrs_of   (pi'\<bullet>x)"
 133.135 +by (nominal_induct x rule: binding.strong_induct) (simp_all add: tyvrs_of.simps eqvts)
 133.136 +
 133.137 +lemma domains_eqvt[eqvt]:
 133.138    fixes pi::"tyvrs prm"
 133.139    and   pi'::"vrs prm"
 133.140 -  shows "pi\<bullet>(domain \<Gamma>) = domain (pi\<bullet>\<Gamma>)"
 133.141 -  and   "pi'\<bullet>(domain \<Gamma>) = domain (pi'\<bullet>\<Gamma>)"
 133.142 -  by (induct \<Gamma>) (simp_all add: eqvts)
 133.143 +  shows "pi \<bullet>(ty_domain \<Gamma>)  = ty_domain  (pi\<bullet>\<Gamma>)"
 133.144 +  and   "pi'\<bullet>(ty_domain \<Gamma>)  = ty_domain  (pi'\<bullet>\<Gamma>)"
 133.145 +  and   "pi \<bullet>(trm_domain \<Gamma>) = trm_domain (pi\<bullet>\<Gamma>)"
 133.146 +  and   "pi'\<bullet>(trm_domain \<Gamma>) = trm_domain (pi'\<bullet>\<Gamma>)"
 133.147 +by (induct \<Gamma>) (simp_all add: eqvts)
 133.148  
 133.149 -lemma finite_domain:
 133.150 -  shows "finite (domain \<Gamma>)"
 133.151 +lemma finite_vrs:
 133.152 +  shows "finite (tyvrs_of x)"
 133.153 +  and   "finite (vrs_of x)"
 133.154 +by (nominal_induct rule:binding.strong_induct, auto)
 133.155 + 
 133.156 +lemma finite_domains:
 133.157 +  shows "finite (ty_domain \<Gamma>)"
 133.158 +  and   "finite (trm_domain \<Gamma>)"
 133.159 +by (induct \<Gamma>, auto simp add: finite_vrs)
 133.160 +
 133.161 +lemma ty_domain_supp:
 133.162 +  shows "(supp (ty_domain  \<Gamma>)) = (ty_domain  \<Gamma>)"
 133.163 +  and   "(supp (trm_domain \<Gamma>)) = (trm_domain \<Gamma>)"
 133.164 +by (simp only: at_fin_set_supp at_tyvrs_inst at_vrs_inst finite_domains)+
 133.165 +
 133.166 +lemma ty_domain_inclusion:
 133.167 +  assumes a: "(TVarB X T)\<in>set \<Gamma>" 
 133.168 +  shows "X\<in>(ty_domain \<Gamma>)"
 133.169 +using a by (induct \<Gamma>, auto)
 133.170 +
 133.171 +lemma ty_binding_existence:
 133.172 +  assumes "X \<in> (tyvrs_of a)"
 133.173 +  shows "\<exists>T.(TVarB X T=a)"
 133.174 +  using assms
 133.175 +by (nominal_induct a rule: binding.strong_induct, auto)
 133.176 +
 133.177 +lemma ty_domain_existence:
 133.178 +  assumes a: "X\<in>(ty_domain \<Gamma>)" 
 133.179 +  shows "\<exists>T.(TVarB X T)\<in>set \<Gamma>"
 133.180 +  using a 
 133.181 +  apply (induct \<Gamma>, auto) 
 133.182 +  apply (subgoal_tac "\<exists>T.(TVarB X T=a)")
 133.183 +  apply (auto)
 133.184 +  apply (auto simp add: ty_binding_existence)
 133.185 +done
 133.186 +
 133.187 +lemma domains_append:
 133.188 +  shows "ty_domain (\<Gamma>@\<Delta>) = ((ty_domain \<Gamma>) \<union> (ty_domain \<Delta>))"
 133.189 +  and   "trm_domain (\<Gamma>@\<Delta>) = ((trm_domain \<Gamma>) \<union> (trm_domain \<Delta>))"
 133.190    by (induct \<Gamma>, auto)
 133.191  
 133.192 -lemma domain_supp:
 133.193 -  shows "(supp (domain \<Gamma>)) = (domain \<Gamma>)"
 133.194 -  by (simp only: at_fin_set_supp at_tyvrs_inst finite_domain)
 133.195 +lemma ty_vrs_prm_simp:
 133.196 +  fixes pi::"vrs prm"
 133.197 +  and   S::"ty"
 133.198 +  shows "pi\<bullet>S = S"
 133.199 +by (induct S rule: ty.induct) (auto simp add: calc_atm)
 133.200  
 133.201 -lemma domain_inclusion:
 133.202 -  assumes a: "(X,T)\<in>set \<Gamma>" 
 133.203 -  shows "X\<in>(domain \<Gamma>)"
 133.204 -  using a by (induct \<Gamma>, auto)
 133.205 +lemma fresh_ty_domain_cons:
 133.206 +  fixes X::"tyvrs"
 133.207 +  shows "X\<sharp>(ty_domain (Y#\<Gamma>)) = (X\<sharp>(tyvrs_of Y) \<and> X\<sharp>(ty_domain \<Gamma>))"
 133.208 +  apply (nominal_induct rule:binding.strong_induct)
 133.209 +  apply (auto)
 133.210 +  apply (simp add: fresh_def supp_def eqvts)
 133.211 +  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)
 133.212 +  apply (simp add: fresh_def supp_def eqvts)
 133.213 +  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)+
 133.214 +  done
 133.215  
 133.216 -lemma domain_existence:
 133.217 -  assumes a: "X\<in>(domain \<Gamma>)" 
 133.218 -  shows "\<exists>T.(X,T)\<in>set \<Gamma>"
 133.219 -  using a by (induct \<Gamma>, auto)
 133.220 -
 133.221 -lemma domain_append:
 133.222 -  shows "domain (\<Gamma>@\<Delta>) = ((domain \<Gamma>) \<union> (domain \<Delta>))"
 133.223 -  by (induct \<Gamma>, auto)
 133.224 -
 133.225 -lemma fresh_domain_cons:
 133.226 -  fixes X::"tyvrs"
 133.227 -  shows "X\<sharp>(domain (Y#\<Gamma>)) = (X\<sharp>(fst Y) \<and> X\<sharp>(domain \<Gamma>))"
 133.228 -  by (simp add: fresh_fin_insert pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst finite_domain)
 133.229 +lemma tyvrs_fresh:
 133.230 +  fixes   X::"tyvrs"
 133.231 +  assumes "X \<sharp> a" 
 133.232 +  shows   "X \<sharp> tyvrs_of a"
 133.233 +  and     "X \<sharp> vrs_of a"
 133.234 +  using assms
 133.235 +  apply (nominal_induct a rule:binding.strong_induct)
 133.236 +  apply (auto)
 133.237 +  apply (fresh_guess)+
 133.238 +done
 133.239  
 133.240  lemma fresh_domain:
 133.241    fixes X::"tyvrs"
 133.242    assumes a: "X\<sharp>\<Gamma>" 
 133.243 -  shows "X\<sharp>(domain \<Gamma>)"
 133.244 +  shows "X\<sharp>(ty_domain \<Gamma>)"
 133.245  using a
 133.246  apply(induct \<Gamma>)
 133.247  apply(simp add: fresh_set_empty) 
 133.248 -apply(simp only: fresh_domain_cons)
 133.249 -apply(auto simp add: fresh_prod fresh_list_cons) 
 133.250 +apply(simp only: fresh_ty_domain_cons)
 133.251 +apply(auto simp add: fresh_prod fresh_list_cons tyvrs_fresh) 
 133.252  done
 133.253  
 133.254 -text {* Not all lists of type @{typ "ty_context"} are well-formed. One condition
 133.255 -  requires that in @{term "(X,S)#\<Gamma>"} all free variables of @{term "S"} must be 
 133.256 -  in the @{term "domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"} 
 133.257 +text {* Not all lists of type @{typ "env"} are well-formed. One condition
 133.258 +  requires that in @{term "TVarB X S#\<Gamma>"} all free variables of @{term "S"} must be 
 133.259 +  in the @{term "ty_domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"} 
 133.260    in @{term "\<Gamma>"}. The set of free variables of @{term "S"} is the 
 133.261    @{text "support"} of @{term "S"}. *}
 133.262  
 133.263  constdefs
 133.264 -  "closed_in" :: "ty \<Rightarrow> ty_context \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
 133.265 -  "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(domain \<Gamma>)"
 133.266 +  "closed_in" :: "ty \<Rightarrow> env \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
 133.267 +  "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(ty_domain \<Gamma>)"
 133.268  
 133.269  lemma closed_in_eqvt[eqvt]:
 133.270    fixes pi::"tyvrs prm"
 133.271 @@ -150,80 +237,148 @@
 133.272    then show "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)" by (simp add: closed_in_def eqvts)
 133.273  qed
 133.274  
 133.275 -lemma ty_vrs_prm_simp:
 133.276 +lemma tyvrs_vrs_prm_simp:
 133.277    fixes pi::"vrs prm"
 133.278 -  and   S::"ty"
 133.279 -  shows "pi\<bullet>S = S"
 133.280 -by (induct S rule: ty.induct) (auto simp add: calc_atm)
 133.281 +  shows "tyvrs_of (pi\<bullet>a) = tyvrs_of a"
 133.282 +  apply (nominal_induct rule:binding.strong_induct) 
 133.283 +  apply (simp_all add: eqvts)
 133.284 +  apply (simp add: dj_perm_forget[OF dj_tyvrs_vrs])
 133.285 +  done
 133.286  
 133.287 -lemma ty_context_vrs_prm_simp:
 133.288 +lemma ty_vrs_fresh[fresh]:
 133.289 +  fixes x::"vrs"
 133.290 +  and   T::"ty"
 133.291 +  shows "x \<sharp> T"
 133.292 +by (simp add: fresh_def supp_def ty_vrs_prm_simp)
 133.293 +
 133.294 +lemma ty_domain_vrs_prm_simp:
 133.295    fixes pi::"vrs prm"
 133.296 -  and   \<Gamma>::"ty_context"
 133.297 -  shows "pi\<bullet>\<Gamma> = \<Gamma>"
 133.298 -by (induct \<Gamma>) 
 133.299 -   (auto simp add: calc_atm ty_vrs_prm_simp)
 133.300 +  and   \<Gamma>::"env"
 133.301 +  shows "(ty_domain (pi\<bullet>\<Gamma>)) = (ty_domain \<Gamma>)"
 133.302 +  apply(induct \<Gamma>) 
 133.303 +  apply (simp add: eqvts)
 133.304 +  apply(simp add:  tyvrs_vrs_prm_simp)
 133.305 +done
 133.306  
 133.307  lemma closed_in_eqvt'[eqvt]:
 133.308    fixes pi::"vrs prm"
 133.309    assumes a: "S closed_in \<Gamma>" 
 133.310    shows "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)"
 133.311  using a
 133.312 -by (simp add: ty_vrs_prm_simp ty_context_vrs_prm_simp)
 133.313 +by (simp add: closed_in_def ty_domain_vrs_prm_simp  ty_vrs_prm_simp)
 133.314 +
 133.315 +lemma fresh_vrs_of: 
 133.316 +  fixes x::"vrs"
 133.317 +  shows "x\<sharp>vrs_of b = x\<sharp>b"
 133.318 +  by (nominal_induct b rule: binding.strong_induct)
 133.319 +    (simp_all add: fresh_singleton [OF pt_vrs_inst at_vrs_inst] fresh_set_empty ty_vrs_fresh fresh_atm)
 133.320 +
 133.321 +lemma fresh_trm_domain: 
 133.322 +  fixes x::"vrs"
 133.323 +  shows "x\<sharp> trm_domain \<Gamma> = x\<sharp>\<Gamma>"
 133.324 +  by (induct \<Gamma>)
 133.325 +    (simp_all add: fresh_set_empty fresh_list_cons
 133.326 +     fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
 133.327 +     finite_domains finite_vrs fresh_vrs_of fresh_list_nil)
 133.328 +
 133.329 +lemma closed_in_fresh: "(X::tyvrs) \<sharp> ty_domain \<Gamma> \<Longrightarrow> T closed_in \<Gamma> \<Longrightarrow> X \<sharp> T"
 133.330 +  by (auto simp add: closed_in_def fresh_def ty_domain_supp)
 133.331  
 133.332  text {* Now validity of a context is a straightforward inductive definition. *}
 133.333    
 133.334 -inductive 
 133.335 -  valid_rel :: "ty_context \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
 133.336 +inductive
 133.337 +  valid_rel :: "env \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
 133.338  where
 133.339 -  valid_nil[simp]:  "\<turnstile> [] ok"
 133.340 -| valid_cons[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(domain \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> ((X,T)#\<Gamma>) ok"
 133.341 +  valid_nil[simp]:   "\<turnstile> [] ok"
 133.342 +| valid_consT[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(ty_domain  \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (TVarB X T#\<Gamma>) ok"
 133.343 +| valid_cons [simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; x\<sharp>(trm_domain \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (VarB  x T#\<Gamma>) ok"
 133.344  
 133.345  equivariance valid_rel
 133.346  
 133.347 -lemma validE:
 133.348 -  assumes a: "\<turnstile> ((X,T)#\<Gamma>) ok"
 133.349 -  shows "\<turnstile> \<Gamma> ok \<and> X\<sharp>(domain \<Gamma>) \<and> T closed_in \<Gamma>"
 133.350 -using a by (cases, auto)
 133.351 +declare binding.inject [simp add]
 133.352 +declare trm.inject     [simp add]
 133.353 +
 133.354 +inductive_cases validE[elim]: "\<turnstile> (TVarB X T#\<Gamma>) ok" "\<turnstile> (VarB  x T#\<Gamma>) ok" "\<turnstile> (b#\<Gamma>) ok" 
 133.355 +
 133.356 +declare binding.inject [simp del]
 133.357 +declare trm.inject     [simp del]
 133.358  
 133.359  lemma validE_append:
 133.360    assumes a: "\<turnstile> (\<Delta>@\<Gamma>) ok" 
 133.361    shows "\<turnstile> \<Gamma> ok"
 133.362 -  using a by (induct \<Delta>, auto dest: validE)
 133.363 +  using a 
 133.364 +proof (induct \<Delta>)
 133.365 +  case (Cons a \<Gamma>')
 133.366 +  then show ?case 
 133.367 +    by (nominal_induct a rule:binding.strong_induct)
 133.368 +       (auto elim: validE)
 133.369 +qed (auto)
 133.370  
 133.371  lemma replace_type:
 133.372 -  assumes a: "\<turnstile> (\<Delta>@(X,T)#\<Gamma>) ok"
 133.373 +  assumes a: "\<turnstile> (\<Delta>@(TVarB X T)#\<Gamma>) ok"
 133.374    and     b: "S closed_in \<Gamma>"
 133.375 -  shows "\<turnstile> (\<Delta>@(X,S)#\<Gamma>) ok"
 133.376 +  shows "\<turnstile> (\<Delta>@(TVarB X S)#\<Gamma>) ok"
 133.377  using a b
 133.378 -apply(induct \<Delta>)
 133.379 -apply(auto dest!: validE intro!: valid_cons simp add: domain_append closed_in_def)
 133.380 -done
 133.381 +proof(induct \<Delta>)
 133.382 +  case Nil
 133.383 +  then show ?case by (auto elim: validE intro: valid_cons simp add: domains_append closed_in_def)
 133.384 +next
 133.385 +  case (Cons a \<Gamma>')
 133.386 +  then show ?case 
 133.387 +    by (nominal_induct a rule:binding.strong_induct)
 133.388 +       (auto elim: validE intro!: valid_cons simp add: domains_append closed_in_def)
 133.389 +qed
 133.390  
 133.391  text {* Well-formed contexts have a unique type-binding for a type-variable. *} 
 133.392  
 133.393  lemma uniqueness_of_ctxt:
 133.394 -  fixes \<Gamma>::"ty_context"
 133.395 +  fixes \<Gamma>::"env"
 133.396    assumes a: "\<turnstile> \<Gamma> ok"
 133.397 -  and     b: "(X,T)\<in>set \<Gamma>"
 133.398 -  and     c: "(X,S)\<in>set \<Gamma>"
 133.399 +  and     b: "(TVarB X T)\<in>set \<Gamma>"
 133.400 +  and     c: "(TVarB X S)\<in>set \<Gamma>"
 133.401    shows "T=S"
 133.402  using a b c
 133.403  proof (induct)
 133.404 -  case valid_nil thus "T=S" by simp
 133.405 -next
 133.406 -  case valid_cons
 133.407 +  case (valid_consT \<Gamma> X' T')
 133.408    moreover
 133.409 -  { fix \<Gamma>::"ty_context"
 133.410 -    assume a: "X\<sharp>(domain \<Gamma>)" 
 133.411 -    have "\<not>(\<exists>T.(X,T)\<in>(set \<Gamma>))" using a 
 133.412 -    proof (induct \<Gamma>)
 133.413 -      case (Cons Y \<Gamma>)
 133.414 -      thus "\<not> (\<exists>T.(X,T)\<in>set(Y#\<Gamma>))" 
 133.415 -	by (simp only: fresh_domain_cons, auto simp add: fresh_atm)
 133.416 +  { fix \<Gamma>'::"env"
 133.417 +    assume a: "X'\<sharp>(ty_domain \<Gamma>')" 
 133.418 +    have "\<not>(\<exists>T.(TVarB X' T)\<in>(set \<Gamma>'))" using a 
 133.419 +    proof (induct \<Gamma>')
 133.420 +      case (Cons Y \<Gamma>')
 133.421 +      thus "\<not> (\<exists>T.(TVarB X' T)\<in>set(Y#\<Gamma>'))"
 133.422 +	by (simp add:  fresh_ty_domain_cons 
 133.423 +                       fresh_fin_union[OF pt_tyvrs_inst  at_tyvrs_inst fs_tyvrs_inst]  
 133.424 +                       finite_vrs finite_domains, 
 133.425 +            auto simp add: fresh_atm fresh_singleton [OF pt_tyvrs_inst at_tyvrs_inst])
 133.426      qed (simp)
 133.427    }
 133.428 -  ultimately show "T=S" by auto
 133.429 -qed 
 133.430 +  ultimately show "T=S" by (auto simp add: binding.inject)
 133.431 +qed (auto)
 133.432 +
 133.433 +lemma uniqueness_of_ctxt':
 133.434 +  fixes \<Gamma>::"env"
 133.435 +  assumes a: "\<turnstile> \<Gamma> ok"
 133.436 +  and     b: "(VarB x T)\<in>set \<Gamma>"
 133.437 +  and     c: "(VarB x S)\<in>set \<Gamma>"
 133.438 +  shows "T=S"
 133.439 +using a b c
 133.440 +proof (induct)
 133.441 +  case (valid_cons \<Gamma> x' T')
 133.442 +  moreover
 133.443 +  { fix \<Gamma>'::"env"
 133.444 +    assume a: "x'\<sharp>(trm_domain \<Gamma>')" 
 133.445 +    have "\<not>(\<exists>T.(VarB x' T)\<in>(set \<Gamma>'))" using a 
 133.446 +    proof (induct \<Gamma>')
 133.447 +      case (Cons y \<Gamma>')
 133.448 +      thus "\<not> (\<exists>T.(VarB x' T)\<in>set(y#\<Gamma>'))" 
 133.449 +	by (simp add:  fresh_fin_union[OF pt_vrs_inst  at_vrs_inst fs_vrs_inst]  
 133.450 +                       finite_vrs finite_domains, 
 133.451 +            auto simp add: fresh_atm fresh_singleton [OF pt_vrs_inst at_vrs_inst])
 133.452 +    qed (simp)
 133.453 +  }
 133.454 +  ultimately show "T=S" by (auto simp add: binding.inject)
 133.455 +qed (auto)
 133.456  
 133.457  section {* Size and Capture-Avoiding Substitution for Types *}
 133.458  
 133.459 @@ -233,7 +388,7 @@
 133.460    "size_ty (Tvar X) = 1"
 133.461  | "size_ty (Top) = 1"
 133.462  | "size_ty (T1 \<rightarrow> T2) = (size_ty T1) + (size_ty T2) + 1"
 133.463 -| "X\<sharp>T1 \<Longrightarrow> size_ty (\<forall>[X<:T1].T2) = (size_ty T1) + (size_ty T2) + 1"
 133.464 +| "X \<sharp> T1 \<Longrightarrow> size_ty (\<forall>X<:T1. T2) = (size_ty T1) + (size_ty T2) + 1"
 133.465    apply (finite_guess)+
 133.466    apply (rule TrueI)+
 133.467    apply (simp add: fresh_nat)
 133.468 @@ -241,24 +396,195 @@
 133.469    done
 133.470  
 133.471  nominal_primrec
 133.472 -  subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_:=_]\<^isub>t\<^isub>y" [100,100,100] 100)
 133.473 +  subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_ \<mapsto> _]\<^sub>\<tau>" [300, 0, 0] 300)
 133.474  where
 133.475 -  "(Tvar X)[Y:=T]\<^isub>t\<^isub>y= (if X=Y then T else (Tvar X))"
 133.476 -| "(Top)[Y:=T]\<^isub>t\<^isub>y = Top"
 133.477 -| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (T\<^isub>1[Y:=T]\<^isub>t\<^isub>y) \<rightarrow> (T\<^isub>2[Y:=T]\<^isub>t\<^isub>y)"
 133.478 -| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>[X<:T\<^isub>1].T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (\<forall>[X<:(T\<^isub>1[Y:=T]\<^isub>t\<^isub>y)].(T\<^isub>2[Y:=T]\<^isub>t\<^isub>y))"
 133.479 +  "(Tvar X)[Y \<mapsto> T]\<^sub>\<tau> = (if X=Y then T else Tvar X)"
 133.480 +| "(Top)[Y \<mapsto> T]\<^sub>\<tau> = Top"
 133.481 +| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau> \<rightarrow> T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>"
 133.482 +| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>X<:T\<^isub>1. T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = (\<forall>X<:T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau>. T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>)"
 133.483    apply (finite_guess)+
 133.484    apply (rule TrueI)+
 133.485    apply (simp add: abs_fresh)
 133.486    apply (fresh_guess)+
 133.487    done
 133.488  
 133.489 +lemma subst_eqvt[eqvt]:
 133.490 +  fixes pi::"tyvrs prm" 
 133.491 +  and   T::"ty"
 133.492 +  shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
 133.493 +  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
 133.494 +     (perm_simp add: fresh_bij)+
 133.495 +
 133.496 +lemma subst_eqvt'[eqvt]:
 133.497 +  fixes pi::"vrs prm" 
 133.498 +  and   T::"ty"
 133.499 +  shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
 133.500 +  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
 133.501 +     (perm_simp add: fresh_left)+
 133.502 +
 133.503 +lemma type_subst_fresh[fresh]:
 133.504 +  fixes X::"tyvrs"
 133.505 +  assumes "X \<sharp> T" and "X \<sharp> P"
 133.506 +  shows   "X \<sharp> T[Y \<mapsto> P]\<^sub>\<tau>"
 133.507 +using assms
 133.508 +by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
 133.509 +   (auto simp add: abs_fresh)
 133.510 +
 133.511 +lemma fresh_type_subst_fresh[fresh]:
 133.512 +    assumes "X\<sharp>T'"
 133.513 +    shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
 133.514 +using assms 
 133.515 +by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
 133.516 +   (auto simp add: fresh_atm abs_fresh fresh_nat) 
 133.517 +
 133.518 +lemma type_subst_identity: "X \<sharp> T \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> = T"
 133.519 +  by (nominal_induct T avoiding: X U rule: ty.strong_induct)
 133.520 +    (simp_all add: fresh_atm abs_fresh)
 133.521 +
 133.522 +lemma type_substitution_lemma:  
 133.523 +  "X \<noteq> Y \<Longrightarrow> X \<sharp> L \<Longrightarrow> M[X \<mapsto> N]\<^sub>\<tau>[Y \<mapsto> L]\<^sub>\<tau> = M[Y \<mapsto> L]\<^sub>\<tau>[X \<mapsto> N[Y \<mapsto> L]\<^sub>\<tau>]\<^sub>\<tau>"
 133.524 +  by (nominal_induct M avoiding: X Y N L rule: ty.strong_induct)
 133.525 +    (auto simp add: type_subst_fresh type_subst_identity)
 133.526 +
 133.527 +lemma type_subst_rename:
 133.528 +  "Y \<sharp> T \<Longrightarrow> ([(Y, X)] \<bullet> T)[Y \<mapsto> U]\<^sub>\<tau> = T[X \<mapsto> U]\<^sub>\<tau>"
 133.529 +  by (nominal_induct T avoiding: X Y U rule: ty.strong_induct)
 133.530 +    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux)
 133.531 +
 133.532 +nominal_primrec
 133.533 +  subst_tyb :: "binding \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> binding" ("_[_ \<mapsto> _]\<^sub>b" [100,100,100] 100)
 133.534 +where
 133.535 +  "(TVarB X U)[Y \<mapsto> T]\<^sub>b = TVarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
 133.536 +| "(VarB  X U)[Y \<mapsto> T]\<^sub>b =  VarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
 133.537 +by auto
 133.538 +
 133.539 +lemma binding_subst_fresh[fresh]:
 133.540 +  fixes X::"tyvrs"
 133.541 +  assumes "X \<sharp> a"
 133.542 +  and     "X \<sharp> P"
 133.543 +  shows "X \<sharp> a[Y \<mapsto> P]\<^sub>b"
 133.544 +using assms
 133.545 +by (nominal_induct a rule:binding.strong_induct)
 133.546 +   (auto simp add: freshs)
 133.547 +
 133.548 +lemma binding_subst_identity: "X \<sharp> B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
 133.549 +  by (induct B rule: binding.induct)
 133.550 +    (simp_all add: fresh_atm type_subst_identity)
 133.551 +
 133.552  consts 
 133.553 -  subst_tyc :: "ty_context \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty_context" ("_[_:=_]\<^isub>t\<^isub>y\<^isub>c" [100,100,100] 100)
 133.554 +  subst_tyc :: "env \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> env" ("_[_ \<mapsto> _]\<^sub>e" [100,100,100] 100)
 133.555 +
 133.556  primrec
 133.557 -"([])[Y:=T]\<^isub>t\<^isub>y\<^isub>c= []"
 133.558 -"(XT#\<Gamma>)[Y:=T]\<^isub>t\<^isub>y\<^isub>c = (fst XT,(snd XT)[Y:=T]\<^isub>t\<^isub>y)#(\<Gamma>[Y:=T]\<^isub>t\<^isub>y\<^isub>c)"
 133.559 - 
 133.560 +"([])[Y \<mapsto> T]\<^sub>e= []"
 133.561 +"(B#\<Gamma>)[Y \<mapsto> T]\<^sub>e = (B[Y \<mapsto> T]\<^sub>b)#(\<Gamma>[Y \<mapsto> T]\<^sub>e)"
 133.562 +
 133.563 +lemma ctxt_subst_fresh'[fresh]:
 133.564 +  fixes X::"tyvrs"
 133.565 +  assumes "X \<sharp> \<Gamma>"
 133.566 +  and     "X \<sharp> P"
 133.567 +  shows   "X \<sharp> \<Gamma>[Y \<mapsto> P]\<^sub>e"
 133.568 +using assms
 133.569 +by (induct \<Gamma>)
 133.570 +   (auto simp add: fresh_list_cons freshs)
 133.571 +
 133.572 +lemma ctxt_subst_mem_TVarB: "TVarB X T \<in> set \<Gamma> \<Longrightarrow> TVarB X (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
 133.573 +  by (induct \<Gamma>) auto
 133.574 +
 133.575 +lemma ctxt_subst_mem_VarB: "VarB x T \<in> set \<Gamma> \<Longrightarrow> VarB x (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
 133.576 +  by (induct \<Gamma>) auto
 133.577 +
 133.578 +lemma ctxt_subst_identity: "X \<sharp> \<Gamma> \<Longrightarrow> \<Gamma>[X \<mapsto> U]\<^sub>e = \<Gamma>"
 133.579 +  by (induct \<Gamma>) (simp_all add: fresh_list_cons binding_subst_identity)
 133.580 +
 133.581 +lemma ctxt_subst_append: "(\<Delta> @ \<Gamma>)[X \<mapsto> T]\<^sub>e = \<Delta>[X \<mapsto> T]\<^sub>e @ \<Gamma>[X \<mapsto> T]\<^sub>e"
 133.582 +  by (induct \<Delta>) simp_all
 133.583 +
 133.584 +nominal_primrec
 133.585 +   subst_trm :: "trm \<Rightarrow> vrs \<Rightarrow> trm \<Rightarrow> trm"  ("_[_ \<mapsto> _]" [300, 0, 0] 300)
 133.586 +where
 133.587 +  "(Var x)[y \<mapsto> t'] = (if x=y then t' else (Var x))"
 133.588 +| "(t1 \<cdot> t2)[y \<mapsto> t'] = t1[y \<mapsto> t'] \<cdot> t2[y \<mapsto> t']"
 133.589 +| "(t \<cdot>\<^sub>\<tau> T)[y \<mapsto> t'] = t[y \<mapsto> t'] \<cdot>\<^sub>\<tau> T"
 133.590 +| "X\<sharp>(T,t') \<Longrightarrow> (\<lambda>X<:T. t)[y \<mapsto> t'] = (\<lambda>X<:T. t[y \<mapsto> t'])" 
 133.591 +| "x\<sharp>(y,t') \<Longrightarrow> (\<lambda>x:T. t)[y \<mapsto> t'] = (\<lambda>x:T. t[y \<mapsto> t'])"
 133.592 +apply(finite_guess)+
 133.593 +apply(rule TrueI)+
 133.594 +apply(simp add: abs_fresh)+
 133.595 +apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
 133.596 +done
 133.597 +
 133.598 +lemma subst_trm_fresh_tyvar:
 133.599 +  "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> u \<Longrightarrow> X \<sharp> t[x \<mapsto> u]"
 133.600 +  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
 133.601 +    (auto simp add: trm.fresh abs_fresh)
 133.602 +
 133.603 +lemma subst_trm_fresh_var: "x \<sharp> u \<Longrightarrow> x \<sharp> t[x \<mapsto> u]"
 133.604 +  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
 133.605 +    (simp_all add: abs_fresh fresh_atm ty_vrs_fresh)
 133.606 +
 133.607 +lemma subst_trm_eqvt[eqvt]:
 133.608 +  fixes pi::"tyvrs prm" 
 133.609 +  and   t::"trm"
 133.610 +  shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
 133.611 +  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
 133.612 +     (perm_simp add: fresh_left)+
 133.613 +
 133.614 +lemma subst_trm_eqvt'[eqvt]:
 133.615 +  fixes pi::"vrs prm" 
 133.616 +  and   t::"trm"
 133.617 +  shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
 133.618 +  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
 133.619 +     (perm_simp add: fresh_left)+
 133.620 +
 133.621 +lemma subst_trm_rename:
 133.622 +  "y \<sharp> t \<Longrightarrow> ([(y, x)] \<bullet> t)[y \<mapsto> u] = t[x \<mapsto> u]"
 133.623 +  by (nominal_induct t avoiding: x y u rule: trm.strong_induct)
 133.624 +    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux ty_vrs_fresh perm_fresh_fresh)
 133.625 +
 133.626 +nominal_primrec (freshness_context: "T2::ty")
 133.627 +  subst_trm_ty :: "trm \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> trm"  ("_[_ \<mapsto>\<^sub>\<tau> _]" [300, 0, 0] 300)
 133.628 +where
 133.629 +  "(Var x)[Y \<mapsto>\<^sub>\<tau> T2] = Var x"
 133.630 +| "(t1 \<cdot> t2)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot> t2[Y \<mapsto>\<^sub>\<tau> T2]"
 133.631 +| "(t1 \<cdot>\<^sub>\<tau> T)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot>\<^sub>\<tau> T[Y \<mapsto> T2]\<^sub>\<tau>"
 133.632 +| "X\<sharp>(Y,T,T2) \<Longrightarrow> (\<lambda>X<:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>X<:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])" 
 133.633 +| "(\<lambda>x:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>x:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])"
 133.634 +apply(finite_guess)+
 133.635 +apply(rule TrueI)+
 133.636 +apply(simp add: abs_fresh ty_vrs_fresh)+
 133.637 +apply(simp add: type_subst_fresh)
 133.638 +apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
 133.639 +done
 133.640 +
 133.641 +lemma subst_trm_ty_fresh:
 133.642 +  "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> T \<Longrightarrow> X \<sharp> t[Y \<mapsto>\<^sub>\<tau> T]"
 133.643 +  by (nominal_induct t avoiding: Y T rule: trm.strong_induct)
 133.644 +    (auto simp add: abs_fresh type_subst_fresh)
 133.645 +
 133.646 +lemma subst_trm_ty_fresh':
 133.647 +  "X \<sharp> T \<Longrightarrow> X \<sharp> t[X \<mapsto>\<^sub>\<tau> T]"
 133.648 +  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
 133.649 +    (simp_all add: abs_fresh fresh_type_subst_fresh fresh_atm)
 133.650 +
 133.651 +lemma subst_trm_ty_eqvt[eqvt]:
 133.652 +  fixes pi::"tyvrs prm" 
 133.653 +  and   t::"trm"
 133.654 +  shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
 133.655 +  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
 133.656 +     (perm_simp add: fresh_bij subst_eqvt)+
 133.657 +
 133.658 +lemma subst_trm_ty_eqvt'[eqvt]:
 133.659 +  fixes pi::"vrs prm" 
 133.660 +  and   t::"trm"
 133.661 +  shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
 133.662 +  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
 133.663 +     (perm_simp add: fresh_left subst_eqvt')+
 133.664 +
 133.665 +lemma subst_trm_ty_rename:
 133.666 +  "Y \<sharp> t \<Longrightarrow> ([(Y, X)] \<bullet> t)[Y \<mapsto>\<^sub>\<tau> U] = t[X \<mapsto>\<^sub>\<tau> U]"
 133.667 +  by (nominal_induct t avoiding: X Y U rule: trm.strong_induct)
 133.668 +    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux type_subst_rename)
 133.669 +
 133.670  section {* Subtyping-Relation *}
 133.671  
 133.672  text {* The definition for the subtyping-relation follows quite closely what is written 
 133.673 @@ -269,13 +595,13 @@
 133.674    $\alpha$-equivalence classes.) *}
 133.675  
 133.676  inductive 
 133.677 -  subtype_of :: "ty_context \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"   ("_\<turnstile>_<:_" [100,100,100] 100)
 133.678 +  subtype_of :: "env \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"   ("_\<turnstile>_<:_" [100,100,100] 100)
 133.679  where
 133.680 -  S_Top[intro]:    "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
 133.681 -| S_Var[intro]:    "\<lbrakk>(X,S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
 133.682 -| S_Refl[intro]:   "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
 133.683 -| S_Arrow[intro]:  "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)" 
 133.684 -| S_Forall[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; X\<sharp>\<Gamma>; ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"
 133.685 +  SA_Top[intro]:    "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
 133.686 +| SA_refl_TVar[intro]:   "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> ty_domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
 133.687 +| SA_trans_TVar[intro]:    "\<lbrakk>(TVarB X S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
 133.688 +| SA_arrow[intro]:  "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)" 
 133.689 +| SA_all[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"
 133.690  
 133.691  lemma subtype_implies_ok:
 133.692    fixes X::"tyvrs"
 133.693 @@ -288,15 +614,15 @@
 133.694    shows "S closed_in \<Gamma> \<and> T closed_in \<Gamma>"
 133.695  using a
 133.696  proof (induct)
 133.697 -  case (S_Top \<Gamma> S)
 133.698 +  case (SA_Top \<Gamma> S)
 133.699    have "Top closed_in \<Gamma>" by (simp add: closed_in_def ty.supp)
 133.700    moreover
 133.701    have "S closed_in \<Gamma>" by fact
 133.702    ultimately show "S closed_in \<Gamma> \<and> Top closed_in \<Gamma>" by simp
 133.703  next
 133.704 -  case (S_Var X S \<Gamma> T)
 133.705 -  have "(X,S)\<in>set \<Gamma>" by fact
 133.706 -  hence "X \<in> domain \<Gamma>" by (rule domain_inclusion)
 133.707 +  case (SA_trans_TVar X S \<Gamma> T)
 133.708 +  have "(TVarB X S)\<in>set \<Gamma>" by fact
 133.709 +  hence "X \<in> ty_domain \<Gamma>" by (rule ty_domain_inclusion)
 133.710    hence "(Tvar X) closed_in \<Gamma>" by (simp add: closed_in_def ty.supp supp_atm)
 133.711    moreover
 133.712    have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by fact
 133.713 @@ -311,20 +637,33 @@
 133.714    shows "X\<sharp>S \<and> X\<sharp>T"  
 133.715  proof -
 133.716    from a1 have "\<turnstile> \<Gamma> ok" by (rule subtype_implies_ok)
 133.717 -  with a2 have "X\<sharp>domain(\<Gamma>)" by (simp add: fresh_domain)
 133.718 +  with a2 have "X\<sharp>ty_domain(\<Gamma>)" by (simp add: fresh_domain)
 133.719    moreover
 133.720    from a1 have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by (rule subtype_implies_closed)
 133.721 -  hence "supp S \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)" 
 133.722 -    and "supp T \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)" by (simp_all add: domain_supp closed_in_def)
 133.723 +  hence "supp S \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)" 
 133.724 +    and "supp T \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)" by (simp_all add: ty_domain_supp closed_in_def)
 133.725    ultimately show "X\<sharp>S \<and> X\<sharp>T" by (force simp add: supp_prod fresh_def)
 133.726  qed
 133.727  
 133.728 +lemma valid_ty_domain_fresh:
 133.729 +  fixes X::"tyvrs"
 133.730 +  assumes valid: "\<turnstile> \<Gamma> ok"
 133.731 +  shows "X\<sharp>(ty_domain \<Gamma>) = X\<sharp>\<Gamma>" 
 133.732 +  using valid
 133.733 +  apply induct
 133.734 +  apply (simp add: fresh_list_nil fresh_set_empty)
 133.735 +  apply (simp_all add: binding.fresh fresh_list_cons
 133.736 +     fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains fresh_atm)
 133.737 +  apply (auto simp add: closed_in_fresh)
 133.738 +  done
 133.739 +
 133.740  equivariance subtype_of
 133.741  
 133.742 -nominal_inductive subtype_of  
 133.743 -  by (simp_all add: abs_fresh subtype_implies_fresh)
 133.744 -
 133.745 -thm subtype_of.strong_induct
 133.746 +nominal_inductive subtype_of
 133.747 +  apply (simp_all add: abs_fresh)
 133.748 +  apply (fastsimp simp add: valid_ty_domain_fresh dest: subtype_implies_ok)
 133.749 +  apply (force simp add: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
 133.750 +  done
 133.751  
 133.752  section {* Reflexivity of Subtyping *}
 133.753  
 133.754 @@ -338,17 +677,17 @@
 133.755    have ih_T\<^isub>1: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>1 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>1 <: T\<^isub>1" by fact 
 133.756    have ih_T\<^isub>2: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>2 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" by fact
 133.757    have fresh_cond: "X\<sharp>\<Gamma>" by fact
 133.758 -  hence fresh_domain: "X\<sharp>(domain \<Gamma>)" by (simp add: fresh_domain)
 133.759 -  have "(\<forall>[X<:T\<^isub>2].T\<^isub>1) closed_in \<Gamma>" by fact
 133.760 -  hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((X,T\<^isub>2)#\<Gamma>)" 
 133.761 +  hence fresh_ty_domain: "X\<sharp>(ty_domain \<Gamma>)" by (simp add: fresh_domain)
 133.762 +  have "(\<forall>X<:T\<^isub>2. T\<^isub>1) closed_in \<Gamma>" by fact
 133.763 +  hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((TVarB  X T\<^isub>2)#\<Gamma>)" 
 133.764      by (auto simp add: closed_in_def ty.supp abs_supp)
 133.765    have ok: "\<turnstile> \<Gamma> ok" by fact  
 133.766 -  hence ok': "\<turnstile> ((X,T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_domain by simp
 133.767 +  hence ok': "\<turnstile> ((TVarB X T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_ty_domain by simp
 133.768    have "\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" using ih_T\<^isub>2 closed\<^isub>T\<^isub>2 ok by simp
 133.769    moreover
 133.770 -  have "((X,T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
 133.771 -  ultimately show "\<Gamma> \<turnstile> \<forall>[X<:T\<^isub>2].T\<^isub>1 <: \<forall>[X<:T\<^isub>2].T\<^isub>1" using fresh_cond 
 133.772 -    by (simp add: subtype_of.S_Forall)
 133.773 +  have "((TVarB X T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
 133.774 +  ultimately show "\<Gamma> \<turnstile> (\<forall>X<:T\<^isub>2. T\<^isub>1) <: (\<forall>X<:T\<^isub>2. T\<^isub>1)" using fresh_cond 
 133.775 +    by (simp add: subtype_of.SA_all)
 133.776  qed (auto simp add: closed_in_def ty.supp supp_atm)
 133.777  
 133.778  lemma subtype_reflexivity_semiautomated:
 133.779 @@ -361,11 +700,10 @@
 133.780    --{* Too bad that this instantiation cannot be found automatically by
 133.781    \isakeyword{auto}; \isakeyword{blast} would find it if we had not used 
 133.782    an explicit definition for @{text "closed_in_def"}. *}
 133.783 -apply(drule_tac x="(tyvrs, ty2)#\<Gamma>" in meta_spec)
 133.784 +apply(drule_tac x="(TVarB tyvrs ty2)#\<Gamma>" in meta_spec)
 133.785  apply(force dest: fresh_domain simp add: closed_in_def)
 133.786  done
 133.787  
 133.788 -
 133.789  section {* Weakening *}
 133.790  
 133.791  text {* In order to prove weakening we introduce the notion of a type-context extending 
 133.792 @@ -373,16 +711,16 @@
 133.793    smoother than if we had strictly adhered to the version in the POPLmark-paper. *}
 133.794  
 133.795  constdefs 
 133.796 -  extends :: "ty_context \<Rightarrow> ty_context \<Rightarrow> bool" ("_ extends _" [100,100] 100)
 133.797 -  "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (X,Q)\<in>set \<Gamma> \<longrightarrow> (X,Q)\<in>set \<Delta>"
 133.798 +  extends :: "env \<Rightarrow> env \<Rightarrow> bool" ("_ extends _" [100,100] 100)
 133.799 +  "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (TVarB X Q)\<in>set \<Gamma> \<longrightarrow> (TVarB X Q)\<in>set \<Delta>"
 133.800  
 133.801 -lemma extends_domain:
 133.802 +lemma extends_ty_domain:
 133.803    assumes a: "\<Delta> extends \<Gamma>"
 133.804 -  shows "domain \<Gamma> \<subseteq> domain \<Delta>"
 133.805 +  shows "ty_domain \<Gamma> \<subseteq> ty_domain \<Delta>"
 133.806    using a 
 133.807    apply (auto simp add: extends_def)
 133.808 -  apply (drule domain_existence)
 133.809 -  apply (force simp add: domain_inclusion)
 133.810 +  apply (drule ty_domain_existence)
 133.811 +  apply (force simp add: ty_domain_inclusion)
 133.812    done
 133.813  
 133.814  lemma extends_closed:
 133.815 @@ -390,12 +728,12 @@
 133.816    and     a2: "\<Delta> extends \<Gamma>"
 133.817    shows "T closed_in \<Delta>"
 133.818    using a1 a2
 133.819 -  by (auto dest: extends_domain simp add: closed_in_def)
 133.820 +  by (auto dest: extends_ty_domain simp add: closed_in_def)
 133.821  
 133.822  lemma extends_memb:
 133.823    assumes a: "\<Delta> extends \<Gamma>"
 133.824 -  and b: "(X,T) \<in> set \<Gamma>"
 133.825 -  shows "(X,T) \<in> set \<Delta>"
 133.826 +  and b: "(TVarB X T) \<in> set \<Gamma>"
 133.827 +  shows "(TVarB X T) \<in> set \<Delta>"
 133.828    using a b by (simp add: extends_def)
 133.829  
 133.830  lemma weakening:
 133.831 @@ -405,7 +743,7 @@
 133.832    shows "\<Delta> \<turnstile> S <: T"
 133.833    using a b c 
 133.834  proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
 133.835 -  case (S_Top \<Gamma> S) 
 133.836 +  case (SA_Top \<Gamma> S) 
 133.837    have lh_drv_prem: "S closed_in \<Gamma>" by fact
 133.838    have "\<turnstile> \<Delta> ok" by fact
 133.839    moreover
 133.840 @@ -413,43 +751,43 @@
 133.841    hence "S closed_in \<Delta>" using lh_drv_prem by (simp only: extends_closed)
 133.842    ultimately show "\<Delta> \<turnstile> S <: Top" by force
 133.843  next 
 133.844 -  case (S_Var X S \<Gamma> T)
 133.845 -  have lh_drv_prem: "(X,S) \<in> set \<Gamma>" by fact
 133.846 +  case (SA_trans_TVar X S \<Gamma> T)
 133.847 +  have lh_drv_prem: "(TVarB X S) \<in> set \<Gamma>" by fact
 133.848    have ih: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> S <: T" by fact
 133.849    have ok: "\<turnstile> \<Delta> ok" by fact
 133.850    have extends: "\<Delta> extends \<Gamma>" by fact
 133.851 -  have "(X,S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
 133.852 +  have "(TVarB X S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
 133.853    moreover
 133.854    have "\<Delta> \<turnstile> S <: T" using ok extends ih by simp
 133.855    ultimately show "\<Delta> \<turnstile> Tvar X <: T" using ok by force
 133.856  next
 133.857 -  case (S_Refl \<Gamma> X)
 133.858 -  have lh_drv_prem: "X \<in> domain \<Gamma>" by fact
 133.859 +  case (SA_refl_TVar \<Gamma> X)
 133.860 +  have lh_drv_prem: "X \<in> ty_domain \<Gamma>" by fact
 133.861    have "\<turnstile> \<Delta> ok" by fact
 133.862    moreover
 133.863    have "\<Delta> extends \<Gamma>" by fact
 133.864 -  hence "X \<in> domain \<Delta>" using lh_drv_prem by (force dest: extends_domain)
 133.865 +  hence "X \<in> ty_domain \<Delta>" using lh_drv_prem by (force dest: extends_ty_domain)
 133.866    ultimately show "\<Delta> \<turnstile> Tvar X <: Tvar X" by force
 133.867  next 
 133.868 -  case (S_Arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
 133.869 +  case (SA_arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
 133.870  next
 133.871 -  case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
 133.872 +  case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
 133.873    have fresh_cond: "X\<sharp>\<Delta>" by fact
 133.874 -  hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
 133.875 +  hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
 133.876    have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
 133.877 -  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
 133.878 +  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
 133.879    have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
 133.880    hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
 133.881    have ok: "\<turnstile> \<Delta> ok" by fact
 133.882    have ext: "\<Delta> extends \<Gamma>" by fact
 133.883    have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
 133.884 -  hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
 133.885 +  hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
 133.886    moreover 
 133.887 -  have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
 133.888 -  ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
 133.889 +  have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
 133.890 +  ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
 133.891    moreover
 133.892    have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp 
 133.893 -  ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
 133.894 +  ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
 133.895  qed
 133.896  
 133.897  text {* In fact all ``non-binding" cases can be solved automatically: *}
 133.898 @@ -461,44 +799,41 @@
 133.899    shows "\<Delta> \<turnstile> S <: T"
 133.900    using a b c 
 133.901  proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
 133.902 -  case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
 133.903 +  case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
 133.904    have fresh_cond: "X\<sharp>\<Delta>" by fact
 133.905 -  hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
 133.906 +  hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
 133.907    have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
 133.908 -  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
 133.909 +  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
 133.910    have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
 133.911    hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
 133.912    have ok: "\<turnstile> \<Delta> ok" by fact
 133.913    have ext: "\<Delta> extends \<Gamma>" by fact
 133.914    have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
 133.915 -  hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
 133.916 +  hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
 133.917    moreover
 133.918 -  have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
 133.919 -  ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
 133.920 +  have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
 133.921 +  ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
 133.922    moreover
 133.923    have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp 
 133.924 -  ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
 133.925 -qed (blast intro: extends_closed extends_memb dest: extends_domain)+
 133.926 +  ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
 133.927 +qed (blast intro: extends_closed extends_memb dest: extends_ty_domain)+
 133.928  
 133.929  section {* Transitivity and Narrowing *}
 133.930  
 133.931  text {* Some inversion lemmas that are needed in the transitivity and narrowing proof.*}
 133.932  
 133.933 -lemma S_TopE:
 133.934 -  assumes a: "\<Gamma> \<turnstile> Top <: T"
 133.935 -  shows "T = Top"
 133.936 -using a by (cases, auto) 
 133.937 +declare ty.inject [simp add]
 133.938  
 133.939 -lemma S_ArrowE_left:
 133.940 -  assumes a: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" 
 133.941 -  shows "T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = T\<^isub>1 \<rightarrow> T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2)"
 133.942 -using a by (cases, auto simp add: ty.inject)
 133.943 +inductive_cases S_TopE: "\<Gamma> \<turnstile> Top <: T"
 133.944 +inductive_cases S_ArrowE_left: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" 
 133.945 +
 133.946 +declare ty.inject [simp del]
 133.947  
 133.948  lemma S_ForallE_left:
 133.949 -  shows "\<lbrakk>\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
 133.950 -         \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = \<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
 133.951 +  shows "\<lbrakk>\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
 133.952 +         \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = (\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
 133.953    apply(frule subtype_implies_ok)
 133.954 -  apply(ind_cases "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T")
 133.955 +  apply(ind_cases "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T")
 133.956    apply(auto simp add: ty.inject alpha)
 133.957    apply(rule_tac x="[(X,Xa)]\<bullet>T\<^isub>2" in exI)
 133.958    apply(rule conjI)
 133.959 @@ -509,18 +844,20 @@
 133.960    apply(rule at_ds5[OF at_tyvrs_inst])
 133.961    apply(rule conjI)
 133.962    apply(simp add: pt_fresh_left[OF pt_tyvrs_inst, OF at_tyvrs_inst] calc_atm)
 133.963 -  apply(drule_tac \<Gamma>="((Xa,T\<^isub>1)#\<Gamma>)" in  subtype_implies_closed)+
 133.964 +  apply(drule_tac \<Gamma>="((TVarB Xa T\<^isub>1)#\<Gamma>)" in  subtype_implies_closed)+
 133.965    apply(simp add: closed_in_def)
 133.966    apply(drule fresh_domain)+
 133.967    apply(simp add: fresh_def)
 133.968 -  apply(subgoal_tac "X \<notin> (insert Xa (domain \<Gamma>))")(*A*)
 133.969 +  apply(subgoal_tac "X \<notin> (insert Xa (ty_domain \<Gamma>))")(*A*)
 133.970    apply(force)
 133.971 -  (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domain])
 133.972 +  (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domains(1)])
 133.973    (* 2nd conjunct *)apply(frule_tac X="X" in subtype_implies_fresh)
 133.974    apply(assumption)
 133.975 +  apply (frule_tac \<Gamma>="TVarB Xa T\<^isub>1 # \<Gamma>" in subtype_implies_ok)
 133.976 +  apply (erule validE)
 133.977 +  apply (simp add: valid_ty_domain_fresh)
 133.978    apply(drule_tac X="Xa" in subtype_implies_fresh)
 133.979    apply(assumption)
 133.980 -  apply(simp add: fresh_prod)
 133.981    apply(drule_tac pi="[(X,Xa)]" in subtype_of.eqvt(2))
 133.982    apply(simp add: calc_atm)
 133.983    apply(simp add: pt_fresh_fresh[OF pt_tyvrs_inst, OF at_tyvrs_inst])
 133.984 @@ -556,8 +893,8 @@
 133.985  that of @{term x} the property @{term "P y"} holds. *}
 133.986  
 133.987  lemma 
 133.988 -  shows trans: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T" 
 133.989 -  and narrow: "(\<Delta>@[(X,Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N"
 133.990 +  shows subtype_transitivity: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T" 
 133.991 +  and subtype_narrow: "(\<Delta>@[(TVarB X Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N"
 133.992  proof (induct Q arbitrary: \<Gamma> S T \<Delta> X P M N taking: "size_ty" rule: measure_induct_rule)
 133.993    case (less Q)
 133.994      --{* \begin{minipage}[t]{0.9\textwidth}
 133.995 @@ -566,8 +903,8 @@
 133.996    have IH_trans:  
 133.997      "\<And>Q' \<Gamma> S T. \<lbrakk>size_ty Q' < size_ty Q; \<Gamma>\<turnstile>S<:Q'; \<Gamma>\<turnstile>Q'<:T\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>S<:T" by fact
 133.998    have IH_narrow:
 133.999 -    "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(X,Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk> 
133.1000 -    \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N" by fact
133.1001 +    "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(TVarB X Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk> 
133.1002 +    \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N" by fact
133.1003      --{* \begin{minipage}[t]{0.9\textwidth}
133.1004      We proceed with the transitivity proof as an auxiliary lemma, because it needs 
133.1005      to be referenced in the narrowing proof.\end{minipage}*}
133.1006 @@ -579,37 +916,36 @@
133.1007        and  "\<Gamma>' \<turnstile> Q <: T"  --{* right-hand derivation *}
133.1008      thus "\<Gamma>' \<turnstile> S' <: T"
133.1009      proof (nominal_induct \<Gamma>' S' Q\<equiv>Q rule: subtype_of.strong_induct) 
133.1010 -      case (S_Top \<Gamma> S) 
133.1011 +      case (SA_Top \<Gamma> S) 
133.1012  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1013  	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S <: Top"}, giving
133.1014  	us @{term "\<turnstile> \<Gamma> ok"} and @{term "S closed_in \<Gamma>"}. This case is straightforward, 
133.1015  	because the right-hand derivation must be of the form @{term "\<Gamma> \<turnstile> Top <: Top"} 
133.1016  	giving us the equation @{term "T = Top"}.\end{minipage}*}
133.1017        hence rh_drv: "\<Gamma> \<turnstile> Top <: T" by simp
133.1018 -      hence T_inst: "T = Top" by (simp add: S_TopE)
133.1019 -      have "\<turnstile> \<Gamma> ok" 
133.1020 -	and "S closed_in \<Gamma>" by fact+
133.1021 -      hence "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.S_Top)
133.1022 +      hence T_inst: "T = Top" by (auto elim: S_TopE)
133.1023 +      from `\<turnstile> \<Gamma> ok` and `S closed_in \<Gamma>`
133.1024 +      have "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
133.1025        thus "\<Gamma> \<turnstile> S <: T" using T_inst by simp
133.1026      next
133.1027 -      case (S_Var Y U \<Gamma>) 
133.1028 +      case (SA_trans_TVar Y U \<Gamma>) 
133.1029  	-- {* \begin{minipage}[t]{0.9\textwidth}
133.1030  	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> Tvar Y <: Q"} 
133.1031  	with @{term "S = Tvar Y"}. We have therefore @{term "(Y,U)"} 
133.1032  	is in @{term "\<Gamma>"} and by inner induction hypothesis that @{term "\<Gamma> \<turnstile> U <: T"}. 
133.1033  	By @{text "S_Var"} follows @{term "\<Gamma> \<turnstile> Tvar Y <: T"}.\end{minipage}*}
133.1034        hence IH_inner: "\<Gamma> \<turnstile> U <: T" by simp
133.1035 -      have "(Y,U) \<in> set \<Gamma>" by fact
133.1036 -      with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.S_Var)
133.1037 +      have "(TVarB Y U) \<in> set \<Gamma>" by fact
133.1038 +      with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.SA_trans_TVar)
133.1039      next
133.1040 -      case (S_Refl \<Gamma> X) 
133.1041 +      case (SA_refl_TVar \<Gamma> X) 
133.1042  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1043          In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(Tvar X) <: (Tvar X)"} with
133.1044          @{term "Q=Tvar X"}. The goal then follows immediately from the right-hand 
133.1045  	derivation.\end{minipage}*}
133.1046        thus "\<Gamma> \<turnstile> Tvar X <: T" by simp
133.1047      next
133.1048 -      case (S_Arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2) 
133.1049 +      case (SA_arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2) 
133.1050  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1051  	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: Q\<^isub>1 \<rightarrow> Q\<^isub>2"} with
133.1052          @{term "S\<^isub>1\<rightarrow>S\<^isub>2=S"} and @{term "Q\<^isub>1\<rightarrow>Q\<^isub>2=Q"}. We know that the @{text "size_ty"} of 
133.1053 @@ -629,7 +965,7 @@
133.1054        have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
133.1055        have lh_drv_prm\<^isub>2: "\<Gamma> \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact      
133.1056        from rh_drv have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=T\<^isub>1\<rightarrow>T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> \<Gamma>\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
133.1057 -	by (simp add: S_ArrowE_left)  
133.1058 +	by (auto elim: S_ArrowE_left)  
133.1059        moreover
133.1060        have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in \<Gamma>" 
133.1061  	using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
133.1062 @@ -647,176 +983,1020 @@
133.1063  	moreover
133.1064  	from IH_trans[of "Q\<^isub>2"] 
133.1065  	have "\<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 lh_drv_prm\<^isub>2 by simp
133.1066 -	ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.S_Arrow)
133.1067 +	ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.SA_arrow)
133.1068  	hence "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" using T_inst by simp
133.1069        }
133.1070        ultimately show "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" by blast
133.1071      next
133.1072 -      case (S_Forall \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2) 
133.1073 +      case (SA_all \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2) 
133.1074  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1075 -	In this case the left-hand derivation is @{text "\<Gamma>\<turnstile>\<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:Q\<^isub>1].Q\<^isub>2"} with 
133.1076 -	@{text "\<forall>[X<:S\<^isub>1].S\<^isub>2=S"} and @{text "\<forall>[X<:Q\<^isub>1].Q\<^isub>2=Q"}. We therefore have the sub-derivations  
133.1077 -	@{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((X,Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
133.1078 +	In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:Q\<^isub>1. Q\<^isub>2)"} with 
133.1079 +	@{term "(\<forall>X<:S\<^isub>1. S\<^isub>2)=S"} and @{term "(\<forall>X<:Q\<^isub>1. Q\<^isub>2)=Q"}. We therefore have the sub-derivations  
133.1080 +	@{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((TVarB X Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
133.1081  	assume that it is sufficiently fresh; in particular we have the freshness conditions
133.1082  	@{term "X\<sharp>\<Gamma>"} and @{term "X\<sharp>Q\<^isub>1"} (these assumptions are provided by the strong 
133.1083  	induction-rule @{text "subtype_of_induct"}). We know that the @{text "size_ty"} of 
133.1084  	@{term Q\<^isub>1} and @{term Q\<^isub>2} is smaller than that of @{term Q};
133.1085  	so we can apply the outer induction hypotheses for @{term Q\<^isub>1} and @{term Q\<^isub>2}. 
133.1086 -	The right-hand derivation is @{text "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T"}. Since @{term "X\<sharp>\<Gamma>"} 
133.1087 +	The right-hand derivation is @{term "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T"}. Since @{term "X\<sharp>\<Gamma>"} 
133.1088  	and @{term "X\<sharp>Q\<^isub>1"} there exists types @{text "T\<^isub>1,T\<^isub>2"} such that 
133.1089 -	@{text "T=Top \<or> T=\<forall>[X<:T\<^isub>1].T\<^isub>2"}. The @{term "Top"}-case is straightforward once we know 
133.1090 -	@{text "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have 
133.1091 -	the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer 
133.1092 +	@{term "T=Top \<or> T=(\<forall>X<:T\<^isub>1. T\<^isub>2)"}. The @{term "Top"}-case is straightforward once we know 
133.1093 +	@{term "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have 
133.1094 +	the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer 
133.1095  	induction hypothesis for transitivity we can derive @{term "\<Gamma>\<turnstile>T\<^isub>1<:S\<^isub>1"}. From the outer 
133.1096 -	induction for narrowing we get @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again 
133.1097 -	induction for transitivity we obtain @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule 
133.1098 +	induction for narrowing we get @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again 
133.1099 +	induction for transitivity we obtain @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule 
133.1100  	@{text "S_Forall"} and the freshness condition @{term "X\<sharp>\<Gamma>"} follows 
133.1101 -	@{text "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"}, which is @{text "\<Gamma> \<turnstile>  \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T\<^isub>"}.
133.1102 +	@{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"}, which is @{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T\<^isub>"}.
133.1103  	\end{minipage}*}
133.1104 -      hence rh_drv: "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T" by simp
133.1105 +      hence rh_drv: "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T" by simp
133.1106        have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
133.1107 -      have lh_drv_prm\<^isub>2: "((X,Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
133.1108 -      have "X\<sharp>\<Gamma>" by fact
133.1109 +      have lh_drv_prm\<^isub>2: "((TVarB X Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
133.1110 +      then have "X\<sharp>\<Gamma>" by (force dest: subtype_implies_ok simp add: valid_ty_domain_fresh)
133.1111        then have fresh_cond: "X\<sharp>\<Gamma>" "X\<sharp>Q\<^isub>1" using lh_drv_prm\<^isub>1 by (simp_all add: subtype_implies_fresh)
133.1112 -      from `\<forall>[X<:Q\<^isub>1].Q\<^isub>2 = Q` 
133.1113 +      from `(\<forall>X<:Q\<^isub>1. Q\<^isub>2) = Q` 
133.1114        have Q\<^isub>1\<^isub>2_less: "size_ty Q\<^isub>1 < size_ty Q" "size_ty Q\<^isub>2 < size_ty Q " using fresh_cond by auto
133.1115        from rh_drv 
133.1116 -      have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
133.1117 +      have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
133.1118  	using fresh_cond by (simp add: S_ForallE_left)
133.1119        moreover
133.1120 -      have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((X,Q\<^isub>1)#\<Gamma>)" 
133.1121 +      have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((TVarB X Q\<^isub>1)#\<Gamma>)" 
133.1122  	using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
133.1123 -      hence "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
133.1124 +      hence "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
133.1125        moreover
133.1126        have "\<turnstile> \<Gamma> ok" using rh_drv by (rule subtype_implies_ok)
133.1127        moreover
133.1128 -      { assume "\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
133.1129 +      { assume "\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
133.1130  	then obtain T\<^isub>1 T\<^isub>2 
133.1131 -	  where T_inst: "T = \<forall>[X<:T\<^isub>1].T\<^isub>2" 
133.1132 +	  where T_inst: "T = (\<forall>X<:T\<^isub>1. T\<^isub>2)" 
133.1133  	  and   rh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> T\<^isub>1 <: Q\<^isub>1" 
133.1134 -	  and   rh_drv_prm\<^isub>2:"((X,T\<^isub>1)#\<Gamma>) \<turnstile> Q\<^isub>2 <: T\<^isub>2" by force
133.1135 +	  and   rh_drv_prm\<^isub>2:"((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> Q\<^isub>2 <: T\<^isub>2" by force
133.1136  	from IH_trans[of "Q\<^isub>1"] 
133.1137  	have "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" using lh_drv_prm\<^isub>1 rh_drv_prm\<^isub>1 Q\<^isub>1\<^isub>2_less by blast
133.1138  	moreover
133.1139  	from IH_narrow[of "Q\<^isub>1" "[]"] 
133.1140 -	have "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" using Q\<^isub>1\<^isub>2_less lh_drv_prm\<^isub>2 rh_drv_prm\<^isub>1 by simp
133.1141 +	have "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" using Q\<^isub>1\<^isub>2_less lh_drv_prm\<^isub>2 rh_drv_prm\<^isub>1 by simp
133.1142  	with IH_trans[of "Q\<^isub>2"] 
133.1143 -	have "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 by simp
133.1144 -	ultimately have "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"
133.1145 -	  using fresh_cond by (simp add: subtype_of.S_Forall)
133.1146 -	hence "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T" using T_inst by simp
133.1147 +	have "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 by simp
133.1148 +	ultimately have "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.1149 +	  using fresh_cond by (simp add: subtype_of.SA_all)
133.1150 +	hence "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T" using T_inst by simp
133.1151        }
133.1152 -      ultimately show "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T" by blast
133.1153 +      ultimately show "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T" by blast
133.1154      qed
133.1155    qed
133.1156  
133.1157    { --{* The transitivity proof is now by the auxiliary lemma. *}
133.1158      case 1 
133.1159 -    have  "\<Gamma> \<turnstile> S <: Q" 
133.1160 -      and "\<Gamma> \<turnstile> Q <: T" by fact+
133.1161 -    thus "\<Gamma> \<turnstile> S <: T" by (rule transitivity_aux) 
133.1162 +    from `\<Gamma> \<turnstile> S <: Q` and `\<Gamma> \<turnstile> Q <: T`
133.1163 +    show "\<Gamma> \<turnstile> S <: T" by (rule transitivity_aux) 
133.1164    next 
133.1165 -    --{* The narrowing proof proceeds by an induction over @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> M <: N"}. *}
133.1166 +    --{* The narrowing proof proceeds by an induction over @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N"}. *}
133.1167      case 2
133.1168 -    have  "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> M <: N" --{* left-hand derivation *}
133.1169 -      and "\<Gamma> \<turnstile> P<:Q" by fact+ --{* right-hand derivation *}
133.1170 -    thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> M <: N" 
133.1171 -    proof (nominal_induct \<Gamma>\<equiv>"\<Delta>@[(X,Q)]@\<Gamma>" M N avoiding: \<Delta> \<Gamma> X rule: subtype_of.strong_induct) 
133.1172 -      case (S_Top _ S \<Delta> \<Gamma> X)
133.1173 +    from `(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N` --{* left-hand derivation *}
133.1174 +      and `\<Gamma> \<turnstile> P<:Q` --{* right-hand derivation *}
133.1175 +    show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> M <: N" 
133.1176 +    proof (nominal_induct \<Gamma>\<equiv>"\<Delta>@[(TVarB X Q)]@\<Gamma>" M N avoiding: \<Delta> \<Gamma> X rule: subtype_of.strong_induct) 
133.1177 +      case (SA_Top _ S \<Delta> \<Gamma> X)
133.1178  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1179 -	In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> S <: Top"}. We show
133.1180 -	that the context @{term "\<Delta>@[(X,P)]@\<Gamma>"} is ok and that @{term S} is closed in 
133.1181 -	@{term "\<Delta>@[(X,P)]@\<Gamma>"}. Then we can apply the @{text "S_Top"}-rule.\end{minipage}*}
133.1182 -      hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok" 
133.1183 -	and lh_drv_prm\<^isub>2: "S closed_in (\<Delta>@[(X,Q)]@\<Gamma>)" by simp_all
133.1184 +	In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> S <: Top"}. We show
133.1185 +	that the context @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} is ok and that @{term S} is closed in 
133.1186 +	@{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. Then we can apply the @{text "S_Top"}-rule.\end{minipage}*}
133.1187 +      hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" 
133.1188 +	and lh_drv_prm\<^isub>2: "S closed_in (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp_all
133.1189        have rh_drv: "\<Gamma> \<turnstile> P <: Q" by fact
133.1190        hence "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.1191 -      with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1192 +      with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1193        moreover
133.1194 -      from lh_drv_prm\<^isub>2 have "S closed_in (\<Delta>@[(X,P)]@\<Gamma>)" 
133.1195 -	by (simp add: closed_in_def domain_append)
133.1196 -      ultimately show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: Top" by (simp add: subtype_of.S_Top)
133.1197 +      from lh_drv_prm\<^isub>2 have "S closed_in (\<Delta>@[(TVarB X P)]@\<Gamma>)" 
133.1198 +	by (simp add: closed_in_def domains_append)
133.1199 +      ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
133.1200      next
133.1201 -      case (S_Var Y S _ N \<Delta> \<Gamma> X) 
133.1202 +      case (SA_trans_TVar Y S _ N \<Delta> \<Gamma> X) 
133.1203  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1204 -	In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Tvar Y <: N"} and
133.1205 -	by inner induction hypothesis we have @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: N"}. We therefore 
133.1206 -	know that the contexts @{term "\<Delta>@[(X,Q)]@\<Gamma>"} and @{term "\<Delta>@[(X,P)]@\<Gamma>"} are ok, and that 
133.1207 -	@{term "(Y,S)"} is in @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. We need to show that 
133.1208 -	@{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N"}  holds. In case @{term "X\<noteq>Y"} we know that 
133.1209 -	@{term "(Y,S)"} is in @{term "\<Delta>@[(X,P)]@\<Gamma>"} and can use the inner induction hypothesis 
133.1210 +	In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Tvar Y <: N"} and
133.1211 +	by inner induction hypothesis we have @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: N"}. We therefore 
133.1212 +	know that the contexts @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"} and @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} are ok, and that 
133.1213 +	@{term "(Y,S)"} is in @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. We need to show that 
133.1214 +	@{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N"}  holds. In case @{term "X\<noteq>Y"} we know that 
133.1215 +	@{term "(Y,S)"} is in @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} and can use the inner induction hypothesis 
133.1216  	and rule @{text "S_Var"} to conclude. In case @{term "X=Y"} we can infer that 
133.1217 -	@{term "S=Q"}; moreover we have that  @{term "(\<Delta>@[(X,P)]@\<Gamma>) extends \<Gamma>"} and therefore 
133.1218 -	by @{text "weakening"} that @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: Q"} holds. By transitivity we 
133.1219 -	obtain then @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: N"} and can conclude by applying rule 
133.1220 +	@{term "S=Q"}; moreover we have that  @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) extends \<Gamma>"} and therefore 
133.1221 +	by @{text "weakening"} that @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: Q"} holds. By transitivity we 
133.1222 +	obtain then @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: N"} and can conclude by applying rule 
133.1223  	@{text "S_Var"}.\end{minipage}*}
133.1224 -      hence IH_inner: "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: N"
133.1225 -	and lh_drv_prm: "(Y,S) \<in> set (\<Delta>@[(X,Q)]@\<Gamma>)"
133.1226 +      hence IH_inner: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: N"
133.1227 +	and lh_drv_prm: "(TVarB Y S) \<in> set (\<Delta>@[(TVarB X Q)]@\<Gamma>)"
133.1228  	and rh_drv: "\<Gamma> \<turnstile> P<:Q"
133.1229 -	and ok\<^isub>Q: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
133.1230 -      hence ok\<^isub>P: "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok) 
133.1231 -      show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N"
133.1232 +	and ok\<^isub>Q: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
133.1233 +      hence ok\<^isub>P: "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok) 
133.1234 +      show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N"
133.1235        proof (cases "X=Y")
133.1236  	case False
133.1237  	have "X\<noteq>Y" by fact
133.1238 -	hence "(Y,S)\<in>set (\<Delta>@[(X,P)]@\<Gamma>)" using lh_drv_prm by simp
133.1239 -	with IH_inner show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N" by (simp add: subtype_of.S_Var)
133.1240 +	hence "(TVarB Y S)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" using lh_drv_prm by (simp add:binding.inject)
133.1241 +	with IH_inner show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" by (simp add: subtype_of.SA_trans_TVar)
133.1242        next
133.1243  	case True
133.1244 -	have memb\<^isub>X\<^isub>Q: "(X,Q)\<in>set (\<Delta>@[(X,Q)]@\<Gamma>)" by simp
133.1245 -	have memb\<^isub>X\<^isub>P: "(X,P)\<in>set (\<Delta>@[(X,P)]@\<Gamma>)" by simp
133.1246 +	have memb\<^isub>X\<^isub>Q: "(TVarB X Q)\<in>set (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp
133.1247 +	have memb\<^isub>X\<^isub>P: "(TVarB X P)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" by simp
133.1248  	have eq: "X=Y" by fact 
133.1249  	hence "S=Q" using ok\<^isub>Q lh_drv_prm memb\<^isub>X\<^isub>Q by (simp only: uniqueness_of_ctxt)
133.1250 -	hence "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Q <: N" using IH_inner by simp
133.1251 +	hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q <: N" using IH_inner by simp
133.1252  	moreover
133.1253 -	have "(\<Delta>@[(X,P)]@\<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1254 -	hence "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: Q" using rh_drv ok\<^isub>P by (simp only: weakening)
133.1255 -	ultimately have "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: N" by (simp add: transitivity_aux) 
133.1256 -	thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N" using memb\<^isub>X\<^isub>P eq by (simp only: subtype_of.S_Var)
133.1257 +	have "(\<Delta>@[(TVarB X P)]@\<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1258 +	hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: Q" using rh_drv ok\<^isub>P by (simp only: weakening)
133.1259 +	ultimately have "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: N" by (simp add: transitivity_aux) 
133.1260 +	thus "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" using memb\<^isub>X\<^isub>P eq by (simp only: subtype_of.SA_trans_TVar)
133.1261        qed
133.1262      next
133.1263 -      case (S_Refl _ Y \<Delta> \<Gamma> X)
133.1264 +      case (SA_refl_TVar _ Y \<Delta> \<Gamma> X)
133.1265  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1266 -	In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y"} and we
133.1267 -	therefore know that @{term "\<Delta>@[(X,Q)]@\<Gamma>"} is ok and that @{term "Y"} is in 
133.1268 -	the domain of @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. We therefore know that @{term "\<Delta>@[(X,P)]@\<Gamma>"} is ok
133.1269 -	and that @{term Y} is in the domain of @{term "\<Delta>@[(X,P)]@\<Gamma>"}. We can conclude by applying 
133.1270 +	In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y"} and we
133.1271 +	therefore know that @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"} is ok and that @{term "Y"} is in 
133.1272 +	the domain of @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. We therefore know that @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} is ok
133.1273 +	and that @{term Y} is in the domain of @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. We can conclude by applying 
133.1274  	rule @{text "S_Refl"}.\end{minipage}*}
133.1275 -      hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok" 
133.1276 -	and lh_drv_prm\<^isub>2: "Y \<in> domain (\<Delta>@[(X,Q)]@\<Gamma>)" by simp_all
133.1277 +      hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" 
133.1278 +	and lh_drv_prm\<^isub>2: "Y \<in> ty_domain (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp_all
133.1279        have "\<Gamma> \<turnstile> P <: Q" by fact
133.1280        hence "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.1281 -      with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1282 +      with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1283        moreover
133.1284 -      from lh_drv_prm\<^isub>2 have "Y \<in> domain (\<Delta>@[(X,P)]@\<Gamma>)" by (simp add: domain_append)
133.1285 -      ultimately show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y" by (simp add: subtype_of.S_Refl)
133.1286 +      from lh_drv_prm\<^isub>2 have "Y \<in> ty_domain (\<Delta>@[(TVarB X P)]@\<Gamma>)" by (simp add: domains_append)
133.1287 +      ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y" by (simp add: subtype_of.SA_refl_TVar)
133.1288      next
133.1289 -      case (S_Arrow _ S\<^isub>1 Q\<^isub>1 Q\<^isub>2 S\<^isub>2 \<Delta> \<Gamma> X) 
133.1290 +      case (SA_arrow _ S\<^isub>1 Q\<^isub>1 Q\<^isub>2 S\<^isub>2 \<Delta> \<Gamma> X) 
133.1291  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1292 -	In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2"} 
133.1293 +	In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2"} 
133.1294  	and the proof is trivial.\end{minipage}*}
133.1295 -      thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2" by blast 
133.1296 +      thus "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2" by blast 
133.1297      next
133.1298 -      case (S_Forall _ T\<^isub>1 S\<^isub>1 Y S\<^isub>2 T\<^isub>2 \<Delta> \<Gamma> X)
133.1299 +      case (SA_all \<Gamma>' T\<^isub>1 S\<^isub>1 Y S\<^isub>2 T\<^isub>2 \<Delta> \<Gamma> X)
133.1300  	--{* \begin{minipage}[t]{0.9\textwidth}
133.1301 -	In this case the left-hand derivation is @{text "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> \<forall>[Y<:S\<^isub>1].S\<^isub>2 <: \<forall>[Y<:T\<^isub>1].T\<^isub>2"}
133.1302 -	and therfore we know that the binder @{term Y} is fresh for @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. By
133.1303 -	the inner induction hypothesis we have that @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"} and 
133.1304 -	@{term "((Y,T\<^isub>1)#\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. Since @{term P} is a subtype of @{term Q}
133.1305 +	In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> (\<forall>Y<:S\<^isub>1. S\<^isub>2) <: (\<forall>Y<:T\<^isub>1. T\<^isub>2)"}
133.1306 +	and therfore we know that the binder @{term Y} is fresh for @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. By
133.1307 +	the inner induction hypothesis we have that @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"} and 
133.1308 +	@{term "((TVarB Y T\<^isub>1)#\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. Since @{term P} is a subtype of @{term Q}
133.1309  	we can infer that @{term Y} is fresh for @{term P} and thus also fresh for 
133.1310 -	@{term "\<Delta>@[(X,P)]@\<Gamma>"}. We can then conclude by applying rule @{text "S_Forall"}.
133.1311 +	@{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. We can then conclude by applying rule @{text "S_Forall"}.
133.1312  	\end{minipage}*}
133.1313 -      hence IH_inner\<^isub>1: "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1" 
133.1314 -	and IH_inner\<^isub>2: "((Y,T\<^isub>1)#\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2" 
133.1315 -	and lh_drv_prm: "Y\<sharp>(\<Delta>@[(X,Q)]@\<Gamma>)" by force+
133.1316 -      have rh_drv: "\<Gamma> \<turnstile> P <: Q" by fact
133.1317 -      hence "Y\<sharp>P" using lh_drv_prm by (simp only: fresh_list_append subtype_implies_fresh)
133.1318 -      hence "Y\<sharp>(\<Delta>@[(X,P)]@\<Gamma>)" using lh_drv_prm 
133.1319 -	by (simp add: fresh_list_append fresh_list_cons fresh_prod)
133.1320 +      hence rh_drv: "\<Gamma> \<turnstile> P <: Q"
133.1321 +	and IH_inner\<^isub>1: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1" 
133.1322 +	and "TVarB Y T\<^isub>1 # \<Gamma>' = ((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X Q] @ \<Gamma>" by auto
133.1323 +      moreover have " \<lbrakk>\<Gamma>\<turnstile>P<:Q; TVarB Y T\<^isub>1 # \<Gamma>' = ((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X Q] @ \<Gamma>\<rbrakk> \<Longrightarrow> (((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X P] @ \<Gamma>)\<turnstile>S\<^isub>2<:T\<^isub>2" by fact
133.1324 +      ultimately have IH_inner\<^isub>2: "(((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X P] @ \<Gamma>)\<turnstile>S\<^isub>2<:T\<^isub>2" by auto
133.1325        with IH_inner\<^isub>1 IH_inner\<^isub>2 
133.1326 -      show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> \<forall>[Y<:S\<^isub>1].S\<^isub>2 <: \<forall>[Y<:T\<^isub>1].T\<^isub>2" by (simp add: subtype_of.S_Forall)
133.1327 +      show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> (\<forall>Y<:S\<^isub>1. S\<^isub>2) <: (\<forall>Y<:T\<^isub>1. T\<^isub>2)" by (simp add: subtype_of.SA_all)
133.1328      qed
133.1329    } 
133.1330  qed
133.1331  
133.1332 -end
133.1333 \ No newline at end of file
133.1334 +section {* Typing *}
133.1335 +
133.1336 +inductive
133.1337 +  typing :: "env \<Rightarrow> trm \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _ : _" [60,60,60] 60) 
133.1338 +where
133.1339 +  T_Var[intro]: "\<lbrakk> VarB x T \<in> set \<Gamma>; \<turnstile> \<Gamma> ok \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> Var x : T"
133.1340 +| T_App[intro]: "\<lbrakk> \<Gamma> \<turnstile> t\<^isub>1 : T\<^isub>1 \<rightarrow> T\<^isub>2; \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^isub>1 \<cdot> t\<^isub>2 : T\<^isub>2"
133.1341 +| T_Abs[intro]: "\<lbrakk> VarB x T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>x:T\<^isub>1. t\<^isub>2) : T\<^isub>1 \<rightarrow> T\<^isub>2"
133.1342 +| T_Sub[intro]: "\<lbrakk> \<Gamma> \<turnstile> t : S; \<Gamma> \<turnstile> S <: T \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t : T"
133.1343 +| T_TAbs[intro]:"\<lbrakk> TVarB X T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>X<:T\<^isub>1. t\<^isub>2) : (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.1344 +| T_TApp[intro]:"\<lbrakk> X \<sharp> (\<Gamma>, t\<^isub>1, T\<^isub>2); \<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2); \<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 : (T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>)" 
133.1345 +
133.1346 +equivariance typing
133.1347 +
133.1348 +lemma better_T_TApp:
133.1349 +  assumes H1: "\<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T11. T12)"
133.1350 +  and H2: "\<Gamma> \<turnstile> T2 <: T11"
133.1351 +  shows "\<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T2 : (T12[X \<mapsto> T2]\<^sub>\<tau>)"
133.1352 +proof -
133.1353 +  obtain Y::tyvrs where Y: "Y \<sharp> (X, T12, \<Gamma>, t\<^isub>1, T2)"
133.1354 +    by (rule exists_fresh) (rule fin_supp)
133.1355 +  then have "Y \<sharp> (\<Gamma>, t\<^isub>1, T2)" by simp
133.1356 +  moreover from Y have "(\<forall>X<:T11. T12) = (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)"
133.1357 +    by (auto simp add: ty.inject alpha' fresh_prod fresh_atm)
133.1358 +  with H1 have "\<Gamma> \<turnstile> t\<^isub>1 : (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)" by simp
133.1359 +  ultimately have "\<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T2 : (([(Y, X)] \<bullet> T12)[Y \<mapsto> T2]\<^sub>\<tau>)" using H2
133.1360 +    by (rule T_TApp)
133.1361 +  with Y show ?thesis by (simp add: type_subst_rename)
133.1362 +qed
133.1363 +
133.1364 +lemma typing_ok:
133.1365 +  assumes "\<Gamma> \<turnstile> t : T"
133.1366 +  shows   "\<turnstile> \<Gamma> ok"
133.1367 +using assms by (induct, auto)
133.1368 +
133.1369 +nominal_inductive typing
133.1370 +  by (auto dest!: typing_ok intro: closed_in_fresh fresh_domain
133.1371 +    simp: abs_fresh fresh_prod fresh_atm freshs valid_ty_domain_fresh fresh_trm_domain)
133.1372 +
133.1373 +lemma ok_imp_VarB_closed_in:
133.1374 +  assumes ok: "\<turnstile> \<Gamma> ok"
133.1375 +  shows "VarB x T \<in> set \<Gamma> \<Longrightarrow> T closed_in \<Gamma>" using ok
133.1376 +  by induct (auto simp add: binding.inject closed_in_def)
133.1377 +
133.1378 +lemma tyvrs_of_subst: "tyvrs_of (B[X \<mapsto> T]\<^sub>b) = tyvrs_of B"
133.1379 +  by (nominal_induct B rule: binding.strong_induct) simp_all
133.1380 +
133.1381 +lemma ty_domain_subst: "ty_domain (\<Gamma>[X \<mapsto> T]\<^sub>e) = ty_domain \<Gamma>"
133.1382 +  by (induct \<Gamma>) (simp_all add: tyvrs_of_subst)
133.1383 +
133.1384 +lemma vrs_of_subst: "vrs_of (B[X \<mapsto> T]\<^sub>b) = vrs_of B"
133.1385 +  by (nominal_induct B rule: binding.strong_induct) simp_all
133.1386 +
133.1387 +lemma trm_domain_subst: "trm_domain (\<Gamma>[X \<mapsto> T]\<^sub>e) = trm_domain \<Gamma>"
133.1388 +  by (induct \<Gamma>) (simp_all add: vrs_of_subst)
133.1389 +
133.1390 +lemma subst_closed_in:
133.1391 +  "T closed_in (\<Delta> @ TVarB X S # \<Gamma>) \<Longrightarrow> U closed_in \<Gamma> \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> closed_in (\<Delta>[X \<mapsto> U]\<^sub>e @ \<Gamma>)"
133.1392 +  apply (nominal_induct T avoiding: X U \<Gamma> rule: ty.strong_induct)
133.1393 +  apply (simp add: closed_in_def ty.supp supp_atm domains_append ty_domain_subst)
133.1394 +  apply blast
133.1395 +  apply (simp add: closed_in_def ty.supp)
133.1396 +  apply (simp add: closed_in_def ty.supp)
133.1397 +  apply (simp add: closed_in_def ty.supp abs_supp)
133.1398 +  apply (drule_tac x = X in meta_spec)
133.1399 +  apply (drule_tac x = U in meta_spec)
133.1400 +  apply (drule_tac x = "(TVarB tyvrs ty2) # \<Gamma>" in meta_spec)
133.1401 +  apply (simp add: domains_append ty_domain_subst)
133.1402 +  apply blast
133.1403 +  done
133.1404 +
133.1405 +lemmas subst_closed_in' = subst_closed_in [where \<Delta>="[]", simplified]
133.1406 +
133.1407 +lemma typing_closed_in:
133.1408 +  assumes "\<Gamma> \<turnstile> t : T"
133.1409 +  shows   "T closed_in \<Gamma>"
133.1410 +using assms
133.1411 +proof induct
133.1412 +  case (T_Var x T \<Gamma>)
133.1413 +  from `\<turnstile> \<Gamma> ok` and `VarB x T \<in> set \<Gamma>`
133.1414 +  show ?case by (rule ok_imp_VarB_closed_in)
133.1415 +next
133.1416 +  case (T_App \<Gamma> t\<^isub>1 T\<^isub>1 T\<^isub>2 t\<^isub>2)
133.1417 +  then show ?case by (auto simp add: ty.supp closed_in_def)
133.1418 +next
133.1419 +  case (T_Abs x T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1420 +  from `VarB x T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2`
133.1421 +  have "T\<^isub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
133.1422 +  with T_Abs show ?case by (auto simp add: ty.supp closed_in_def)
133.1423 +next
133.1424 +  case (T_Sub \<Gamma> t S T)
133.1425 +  from `\<Gamma> \<turnstile> S <: T` show ?case by (simp add: subtype_implies_closed)
133.1426 +next
133.1427 +  case (T_TAbs X T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1428 +  from `TVarB X T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2`
133.1429 +  have "T\<^isub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
133.1430 +  with T_TAbs show ?case by (auto simp add: ty.supp closed_in_def abs_supp)
133.1431 +next
133.1432 +  case (T_TApp X \<Gamma> t\<^isub>1 T2 T11 T12)
133.1433 +  then have "T12 closed_in (TVarB X T11 # \<Gamma>)"
133.1434 +    by (auto simp add: closed_in_def ty.supp abs_supp)
133.1435 +  moreover from T_TApp have "T2 closed_in \<Gamma>"
133.1436 +    by (simp add: subtype_implies_closed)
133.1437 +  ultimately show ?case by (rule subst_closed_in')
133.1438 +qed
133.1439 +
133.1440 +
133.1441 +subsection {* Evaluation *}
133.1442 +
133.1443 +inductive
133.1444 +  val :: "trm \<Rightarrow> bool"
133.1445 +where
133.1446 +  Abs[intro]:  "val (\<lambda>x:T. t)"
133.1447 +| TAbs[intro]: "val (\<lambda>X<:T. t)"
133.1448 +
133.1449 +equivariance val
133.1450 +
133.1451 +inductive_cases val_inv_auto[elim]: 
133.1452 +  "val (Var x)" 
133.1453 +  "val (t1 \<cdot> t2)" 
133.1454 +  "val (t1 \<cdot>\<^sub>\<tau> t2)"
133.1455 +
133.1456 +inductive 
133.1457 +  eval :: "trm \<Rightarrow> trm \<Rightarrow> bool" ("_ \<longmapsto> _" [60,60] 60)
133.1458 +where
133.1459 +  E_Abs         : "\<lbrakk> x \<sharp> v\<^isub>2; val v\<^isub>2 \<rbrakk> \<Longrightarrow> (\<lambda>x:T\<^isub>1\<^isub>1. t\<^isub>1\<^isub>2) \<cdot> v\<^isub>2 \<longmapsto> t\<^isub>1\<^isub>2[x \<mapsto> v\<^isub>2]"
133.1460 +| E_App1 [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot> u \<longmapsto> t' \<cdot> u"
133.1461 +| E_App2 [intro]: "\<lbrakk> val v; t \<longmapsto> t' \<rbrakk> \<Longrightarrow> v \<cdot> t \<longmapsto> v \<cdot> t'"
133.1462 +| E_TAbs        : "X \<sharp> (T\<^isub>1\<^isub>1, T\<^isub>2) \<Longrightarrow> (\<lambda>X<:T\<^isub>1\<^isub>1. t\<^isub>1\<^isub>2) \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t\<^isub>1\<^isub>2[X \<mapsto>\<^sub>\<tau> T\<^isub>2]"
133.1463 +| E_TApp [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot>\<^sub>\<tau> T \<longmapsto> t' \<cdot>\<^sub>\<tau> T"
133.1464 +
133.1465 +lemma better_E_Abs[intro]:
133.1466 +  assumes H: "val v2"
133.1467 +  shows "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> t12[x \<mapsto> v2]"
133.1468 +proof -
133.1469 +  obtain y::vrs where y: "y \<sharp> (x, t12, v2)" by (rule exists_fresh) (rule fin_supp)
133.1470 +  then have "y \<sharp> v2" by simp
133.1471 +  then have "(\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]" using H
133.1472 +    by (rule E_Abs)
133.1473 +  moreover from y have "(\<lambda>x:T11. t12) \<cdot> v2 = (\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2"
133.1474 +    by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
133.1475 +  ultimately have "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]"
133.1476 +    by simp
133.1477 +  with y show ?thesis by (simp add: subst_trm_rename)
133.1478 +qed
133.1479 +
133.1480 +lemma better_E_TAbs[intro]: "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> t12[X \<mapsto>\<^sub>\<tau> T2]"
133.1481 +proof -
133.1482 +  obtain Y::tyvrs where Y: "Y \<sharp> (X, t12, T11, T2)" by (rule exists_fresh) (rule fin_supp)
133.1483 +  then have "Y \<sharp> (T11, T2)" by simp
133.1484 +  then have "(\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
133.1485 +    by (rule E_TAbs)
133.1486 +  moreover from Y have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 = (\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2"
133.1487 +    by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
133.1488 +  ultimately have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
133.1489 +    by simp
133.1490 +  with Y show ?thesis by (simp add: subst_trm_ty_rename)
133.1491 +qed
133.1492 +
133.1493 +equivariance eval
133.1494 +
133.1495 +nominal_inductive eval
133.1496 +  by (simp_all add: abs_fresh ty_vrs_fresh subst_trm_fresh_tyvar
133.1497 +    subst_trm_fresh_var subst_trm_ty_fresh')
133.1498 +
133.1499 +inductive_cases eval_inv_auto[elim]: 
133.1500 +  "Var x \<longmapsto> t'" 
133.1501 +  "(\<lambda>x:T. t) \<longmapsto> t'" 
133.1502 +  "(\<lambda>X<:T. t) \<longmapsto> t'" 
133.1503 +
133.1504 +lemma ty_domain_cons:
133.1505 +  shows "ty_domain (\<Gamma>@[VarB X Q]@\<Delta>) = ty_domain (\<Gamma>@\<Delta>)"
133.1506 +by (induct \<Gamma>, auto)
133.1507 +
133.1508 +lemma closed_in_cons: 
133.1509 +  assumes "S closed_in (\<Gamma> @ VarB X Q # \<Delta>)"
133.1510 +  shows "S closed_in (\<Gamma>@\<Delta>)"
133.1511 +using assms ty_domain_cons closed_in_def by auto
133.1512 +
133.1513 +lemma closed_in_weaken: "T closed_in (\<Delta> @ \<Gamma>) \<Longrightarrow> T closed_in (\<Delta> @ B # \<Gamma>)"
133.1514 +  by (auto simp add: closed_in_def domains_append)
133.1515 +
133.1516 +lemma closed_in_weaken': "T closed_in \<Gamma> \<Longrightarrow> T closed_in (\<Delta> @ \<Gamma>)"
133.1517 +  by (auto simp add: closed_in_def domains_append)
133.1518 +
133.1519 +lemma valid_subst:
133.1520 +  assumes ok: "\<turnstile> (\<Delta> @ TVarB X Q # \<Gamma>) ok"
133.1521 +  and closed: "P closed_in \<Gamma>"
133.1522 +  shows "\<turnstile> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using ok closed
133.1523 +  apply (induct \<Delta>)
133.1524 +  apply simp_all
133.1525 +  apply (erule validE)
133.1526 +  apply assumption
133.1527 +  apply (erule validE)
133.1528 +  apply simp
133.1529 +  apply (rule valid_consT)
133.1530 +  apply assumption
133.1531 +  apply (simp add: domains_append ty_domain_subst)
133.1532 +  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)
133.1533 +  apply (rule_tac S=Q in subst_closed_in')
133.1534 +  apply (simp add: closed_in_def domains_append ty_domain_subst)
133.1535 +  apply (simp add: closed_in_def domains_append)
133.1536 +  apply blast
133.1537 +  apply simp
133.1538 +  apply (rule valid_cons)
133.1539 +  apply assumption
133.1540 +  apply (simp add: domains_append trm_domain_subst)
133.1541 +  apply (rule_tac S=Q in subst_closed_in')
133.1542 +  apply (simp add: closed_in_def domains_append ty_domain_subst)
133.1543 +  apply (simp add: closed_in_def domains_append)
133.1544 +  apply blast
133.1545 +  done
133.1546 +
133.1547 +lemma ty_domain_vrs:
133.1548 +  shows "ty_domain (G @ [VarB x Q] @ D) = ty_domain (G @ D)"
133.1549 +by (induct G, auto)
133.1550 +
133.1551 +lemma valid_cons':
133.1552 +  assumes "\<turnstile> (\<Gamma> @ VarB x Q # \<Delta>) ok"
133.1553 +  shows "\<turnstile> (\<Gamma> @ \<Delta>) ok"
133.1554 +  using assms
133.1555 +proof (induct  \<Gamma>' \<equiv> "\<Gamma> @ VarB x Q # \<Delta>" arbitrary: \<Gamma> \<Delta>)
133.1556 +  case valid_nil
133.1557 +  have "[] = \<Gamma> @ VarB x Q # \<Delta>" by fact
133.1558 +  then have "False" by auto
133.1559 +  then show ?case by auto
133.1560 +next
133.1561 +  case (valid_consT G X T)
133.1562 +  then show ?case
133.1563 +  proof (cases \<Gamma>)
133.1564 +    case Nil
133.1565 +    with valid_consT show ?thesis by simp
133.1566 +  next
133.1567 +    case (Cons b bs)
133.1568 +    with valid_consT
133.1569 +    have "\<turnstile> (bs @ \<Delta>) ok" by simp
133.1570 +    moreover from Cons and valid_consT have "X \<sharp> ty_domain (bs @ \<Delta>)"
133.1571 +      by (simp add: domains_append)
133.1572 +    moreover from Cons and valid_consT have "T closed_in (bs @ \<Delta>)"
133.1573 +      by (simp add: closed_in_def domains_append)
133.1574 +    ultimately have "\<turnstile> (TVarB X T # bs @ \<Delta>) ok"
133.1575 +      by (rule valid_rel.valid_consT)
133.1576 +    with Cons and valid_consT show ?thesis by simp
133.1577 +  qed
133.1578 +next
133.1579 +  case (valid_cons G x T)
133.1580 +  then show ?case
133.1581 +  proof (cases \<Gamma>)
133.1582 +    case Nil
133.1583 +    with valid_cons show ?thesis by simp
133.1584 +  next
133.1585 +    case (Cons b bs)
133.1586 +    with valid_cons
133.1587 +    have "\<turnstile> (bs @ \<Delta>) ok" by simp
133.1588 +    moreover from Cons and valid_cons have "x \<sharp> trm_domain (bs @ \<Delta>)"
133.1589 +      by (simp add: domains_append finite_domains
133.1590 +	fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst])
133.1591 +    moreover from Cons and valid_cons have "T closed_in (bs @ \<Delta>)"
133.1592 +      by (simp add: closed_in_def domains_append)
133.1593 +    ultimately have "\<turnstile> (VarB x T # bs @ \<Delta>) ok"
133.1594 +      by (rule valid_rel.valid_cons)
133.1595 +    with Cons and valid_cons show ?thesis by simp
133.1596 +  qed
133.1597 +qed
133.1598 +  
133.1599 +text {* A.5(6) *}
133.1600 +
133.1601 +lemma type_weaken:
133.1602 +  assumes "(\<Delta>@\<Gamma>) \<turnstile> t : T"
133.1603 +  and     "\<turnstile> (\<Delta> @ B # \<Gamma>) ok"
133.1604 +  shows   "(\<Delta> @ B # \<Gamma>) \<turnstile> t : T"
133.1605 +using assms
133.1606 +proof(nominal_induct \<Gamma>'\<equiv> "\<Delta> @ \<Gamma>" t T avoiding: \<Delta> \<Gamma> B rule: typing.strong_induct)
133.1607 +  case (T_Var x' T \<Gamma>' \<Gamma>'' \<Delta>')
133.1608 +  then show ?case by auto
133.1609 +next
133.1610 +  case (T_App \<Gamma> t\<^isub>1 T\<^isub>1 T\<^isub>2 t\<^isub>2 \<Gamma> \<Delta>)
133.1611 +  then show ?case by force
133.1612 +next
133.1613 +  case (T_Abs y T\<^isub>1 \<Gamma>' t\<^isub>2 T\<^isub>2 \<Delta> \<Gamma>)
133.1614 +  then have "VarB y T\<^isub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1615 +  then have closed: "T\<^isub>1 closed_in (\<Delta> @ \<Gamma>)"
133.1616 +    by (auto dest: typing_ok)
133.1617 +  have "\<turnstile> (VarB y T\<^isub>1 # \<Delta> @ B # \<Gamma>) ok"
133.1618 +    apply (rule valid_cons)
133.1619 +    apply (rule T_Abs)
133.1620 +    apply (simp add: domains_append
133.1621 +      fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.1622 +      fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.1623 +      finite_domains finite_vrs fresh_vrs_of T_Abs fresh_trm_domain)
133.1624 +    apply (rule closed_in_weaken)
133.1625 +    apply (rule closed)
133.1626 +    done
133.1627 +  then have "\<turnstile> ((VarB y T\<^isub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
133.1628 +  then have "(VarB y T\<^isub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2"
133.1629 +    by (rule T_Abs) (simp add: T_Abs)
133.1630 +  then have "VarB y T\<^isub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1631 +  then show ?case by (rule typing.T_Abs)
133.1632 +next
133.1633 +  case (T_Sub \<Gamma>' t S T \<Delta> \<Gamma>)
133.1634 +  from `\<turnstile> (\<Delta> @ B # \<Gamma>) ok` and `\<Gamma>' = \<Delta> @ \<Gamma>`
133.1635 +  have "\<Delta> @ B # \<Gamma> \<turnstile> t : S" by (rule T_Sub)
133.1636 +  moreover from  `\<Gamma>'\<turnstile>S<:T` and `\<turnstile> (\<Delta> @ B # \<Gamma>) ok`
133.1637 +  have "(\<Delta> @ B # \<Gamma>)\<turnstile>S<:T"
133.1638 +    by (rule weakening) (simp add: extends_def T_Sub)
133.1639 +  ultimately show ?case by (rule typing.T_Sub)
133.1640 +next
133.1641 +  case (T_TAbs X T\<^isub>1 \<Gamma>' t\<^isub>2 T\<^isub>2 \<Delta> \<Gamma>)
133.1642 +  then have "TVarB X T\<^isub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1643 +  then have closed: "T\<^isub>1 closed_in (\<Delta> @ \<Gamma>)"
133.1644 +    by (auto dest: typing_ok)
133.1645 +  have "\<turnstile> (TVarB X T\<^isub>1 # \<Delta> @ B # \<Gamma>) ok"
133.1646 +    apply (rule valid_consT)
133.1647 +    apply (rule T_TAbs)
133.1648 +    apply (simp add: domains_append
133.1649 +      fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
133.1650 +      fresh_fin_union [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
133.1651 +      finite_domains finite_vrs tyvrs_fresh T_TAbs fresh_domain)
133.1652 +    apply (rule closed_in_weaken)
133.1653 +    apply (rule closed)
133.1654 +    done
133.1655 +  then have "\<turnstile> ((TVarB X T\<^isub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
133.1656 +  then have "(TVarB X T\<^isub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2"
133.1657 +    by (rule T_TAbs) (simp add: T_TAbs)
133.1658 +  then have "TVarB X T\<^isub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1659 +  then show ?case by (rule typing.T_TAbs)
133.1660 +next
133.1661 +  case (T_TApp X \<Gamma>' t\<^isub>1 T2 T11 T12 \<Delta> \<Gamma>)
133.1662 +  have "\<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T11. T12)"
133.1663 +    by (rule T_TApp)+
133.1664 +  moreover from `\<Gamma>'\<turnstile>T2<:T11` and `\<turnstile> (\<Delta> @ B # \<Gamma>) ok`
133.1665 +  have "(\<Delta> @ B # \<Gamma>)\<turnstile>T2<:T11"
133.1666 +    by (rule weakening) (simp add: extends_def T_TApp)
133.1667 +  ultimately show ?case by (rule better_T_TApp)
133.1668 +qed
133.1669 +
133.1670 +lemma type_weaken':
133.1671 + "\<Gamma> \<turnstile> t : T \<Longrightarrow>  \<turnstile> (\<Delta>@\<Gamma>) ok \<Longrightarrow> (\<Delta>@\<Gamma>) \<turnstile> t : T"
133.1672 +  apply (induct \<Delta>)
133.1673 +  apply simp_all
133.1674 +  apply (erule validE)
133.1675 +  apply (insert type_weaken [of "[]", simplified])
133.1676 +  apply simp_all
133.1677 +  done
133.1678 +
133.1679 +text {* A.6 *}
133.1680 +
133.1681 +lemma strengthening:
133.1682 +  assumes "(\<Gamma> @ VarB x Q # \<Delta>) \<turnstile> S <: T"
133.1683 +  shows  "(\<Gamma>@\<Delta>) \<turnstile> S <: T"
133.1684 +  using assms
133.1685 +proof (induct  \<Gamma>' \<equiv> "\<Gamma> @ VarB x Q # \<Delta>" S T arbitrary: \<Gamma>)
133.1686 +  case (SA_Top G' S G)
133.1687 +  then have "\<turnstile> (G @ \<Delta>) ok" by (auto dest: valid_cons')
133.1688 +  moreover have "S closed_in (G @ \<Delta>)" using SA_Top by (auto dest: closed_in_cons)
133.1689 +  ultimately show ?case using subtype_of.SA_Top by auto
133.1690 +next
133.1691 +  case (SA_refl_TVar G X' G')
133.1692 +  then have "\<turnstile> (G' @ VarB x Q # \<Delta>) ok" by simp
133.1693 +  then have h1:"\<turnstile> (G' @ \<Delta>) ok" by (auto dest: valid_cons')
133.1694 +  have "X' \<in> ty_domain (G' @ VarB x Q # \<Delta>)" using SA_refl_TVar by auto
133.1695 +  then have h2:"X' \<in> ty_domain (G' @ \<Delta>)" using ty_domain_vrs by auto
133.1696 +  show ?case using h1 h2 by auto
133.1697 +next
133.1698 +  case (SA_all G T1 S1 X S2 T2 G')
133.1699 +  have ih1:"TVarB X T1 # G = (TVarB X T1 # G') @ VarB x Q # \<Delta> \<Longrightarrow> ((TVarB X T1 # G') @ \<Delta>)\<turnstile>S2<:T2" by fact
133.1700 +  then have h1:"(TVarB X T1 # (G' @ \<Delta>))\<turnstile>S2<:T2" using SA_all by auto
133.1701 +  have ih2:"G = G' @ VarB x Q # \<Delta> \<Longrightarrow> (G' @ \<Delta>)\<turnstile>T1<:S1" by fact
133.1702 +  then have h2:"(G' @ \<Delta>)\<turnstile>T1<:S1" using SA_all by auto
133.1703 +  then show ?case using h1 h2 by auto
133.1704 +qed (auto)
133.1705 +
133.1706 +lemma narrow_type: -- {* A.7 *}
133.1707 +  assumes H: "\<Delta> @ (TVarB X Q) # \<Gamma> \<turnstile> t : T"
133.1708 +  shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> \<Delta> @ (TVarB X P) # \<Gamma> \<turnstile> t : T"
133.1709 +  using H
133.1710 +  proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ (TVarB X Q) # \<Gamma>" t T avoiding: P arbitrary: \<Delta> rule: typing.strong_induct)
133.1711 +    case (T_Var x T G P D)
133.1712 +    then have "VarB x T \<in> set (D @ TVarB X P # \<Gamma>)" 
133.1713 +      and "\<turnstile>  (D @ TVarB X P # \<Gamma>) ok"
133.1714 +      by (auto intro: replace_type dest!: subtype_implies_closed)
133.1715 +    then show ?case by auto
133.1716 +  next
133.1717 +    case (T_App G t1 T1 T2 t2 P D)
133.1718 +    then show ?case by force
133.1719 +  next
133.1720 +    case (T_Abs x T1 G t2 T2 P D)
133.1721 +    then show ?case by (fastsimp dest: typing_ok)
133.1722 +  next
133.1723 +    case (T_Sub G t S T D)
133.1724 +    then show ?case using subtype_narrow by fastsimp
133.1725 +  next
133.1726 +    case (T_TAbs X' T1 G t2 T2 P D)
133.1727 +    then show ?case by (fastsimp dest: typing_ok)
133.1728 +  next
133.1729 +    case (T_TApp X' G t1 T2 T11 T12 P D)
133.1730 +    then have "D @ TVarB X P # \<Gamma> \<turnstile> t1 : Forall X' T12 T11" by fastsimp
133.1731 +    moreover have "(D @ [TVarB X Q] @ \<Gamma>) \<turnstile> T2<:T11" using T_TApp by auto
133.1732 +    then have "(D @ [TVarB X P] @ \<Gamma>) \<turnstile> T2<:T11" using `\<Gamma>\<turnstile>P<:Q`
133.1733 +      by (rule subtype_narrow)
133.1734 +    moreover from T_TApp have "X' \<sharp> (D @ TVarB X P # \<Gamma>, t1, T2)"
133.1735 +      by (simp add: fresh_list_append fresh_list_cons fresh_prod)
133.1736 +    ultimately show ?case by auto
133.1737 +qed
133.1738 +
133.1739 +subsection {* Substitution lemmas *}
133.1740 +
133.1741 +subsubsection {* Substition Preserves Typing *}
133.1742 +
133.1743 +theorem subst_type: -- {* A.8 *}
133.1744 +  assumes H: "(\<Delta> @ (VarB x U) # \<Gamma>) \<turnstile> t : T"
133.1745 +  shows "\<Gamma> \<turnstile> u : U \<Longrightarrow> \<Delta> @ \<Gamma> \<turnstile> t[x \<mapsto> u] : T" using H
133.1746 + proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ (VarB x U) # \<Gamma>" t T avoiding: x u arbitrary: \<Delta> rule: typing.strong_induct)
133.1747 +   case (T_Var y T G x u D)
133.1748 +   show ?case
133.1749 +   proof (cases "x = y")
133.1750 +     assume eq:"x=y"
133.1751 +     then have "T=U" using T_Var uniqueness_of_ctxt' by auto
133.1752 +     then show ?case using eq T_Var
133.1753 +       by (auto intro: type_weaken' dest: valid_cons')
133.1754 +   next
133.1755 +     assume "x\<noteq>y"
133.1756 +     then show ?case using T_Var
133.1757 +       by (auto simp add:binding.inject dest: valid_cons')
133.1758 +   qed
133.1759 + next
133.1760 +   case (T_App G t1 T1 T2 t2 x u D)
133.1761 +   then show ?case by force
133.1762 + next
133.1763 +   case (T_Abs y T1 G t2 T2 x u D)
133.1764 +   then show ?case by force
133.1765 + next
133.1766 +   case (T_Sub G t S T x u D)
133.1767 +   then have "D @ \<Gamma> \<turnstile> t[x \<mapsto> u] : S" by auto
133.1768 +   moreover have "(D @ \<Gamma>) \<turnstile> S<:T" using T_Sub by (auto dest: strengthening)
133.1769 +   ultimately show ?case by auto 
133.1770 + next
133.1771 +   case (T_TAbs X T1 G t2 T2 x u D)
133.1772 +   from `TVarB X T1 # G \<turnstile> t2 : T2` have "X \<sharp> T1"
133.1773 +     by (auto simp add: valid_ty_domain_fresh dest: typing_ok intro!: closed_in_fresh)
133.1774 +   with `X \<sharp> u` and T_TAbs show ?case by fastsimp
133.1775 + next
133.1776 +   case (T_TApp X G t1 T2 T11 T12 x u D)
133.1777 +   then have "(D@\<Gamma>) \<turnstile>T2<:T11" using T_TApp by (auto dest: strengthening)
133.1778 +   then show "((D @ \<Gamma>) \<turnstile> ((t1 \<cdot>\<^sub>\<tau> T2)[x \<mapsto> u]) : (T12[X \<mapsto> T2]\<^sub>\<tau>))" using T_TApp
133.1779 +     by (force simp add: fresh_prod fresh_list_append fresh_list_cons subst_trm_fresh_tyvar)
133.1780 +qed
133.1781 +
133.1782 +subsubsection {* Type Substitution Preserves Subtyping *}
133.1783 +
133.1784 +lemma substT_subtype: -- {* A.10 *}
133.1785 +  assumes H: "(\<Delta> @ ((TVarB X Q) # \<Gamma>)) \<turnstile> S <: T"
133.1786 +  shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>" 
133.1787 +  using H
133.1788 +proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ TVarB X Q # \<Gamma>" S T avoiding: X P arbitrary: \<Delta> rule: subtype_of.strong_induct)
133.1789 +  case (SA_Top G S X P D)
133.1790 +  then have "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by simp
133.1791 +  moreover have closed: "P closed_in \<Gamma>" using SA_Top subtype_implies_closed by auto 
133.1792 +  ultimately have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule valid_subst)
133.1793 +  moreover from SA_Top have "S closed_in (D @ TVarB X Q # \<Gamma>)" by simp
133.1794 +  then have "S[X \<mapsto> P]\<^sub>\<tau> closed_in  (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" using closed by (rule subst_closed_in)
133.1795 +  ultimately show ?case by auto
133.1796 +next
133.1797 +  case (SA_trans_TVar Y S G T X P D)
133.1798 +  have h:"G\<turnstile>S<:T" by fact
133.1799 +  then have ST: "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>" using SA_trans_TVar by auto
133.1800 +  from `G\<turnstile>S<:T` have G_ok: "\<turnstile> G ok" by (rule subtype_implies_ok)
133.1801 +  from G_ok and SA_trans_TVar have X\<Gamma>_ok: "\<turnstile> (TVarB X Q # \<Gamma>) ok"
133.1802 +    by (auto intro: validE_append)
133.1803 +  show "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> Tvar Y[X \<mapsto> P]\<^sub>\<tau><:T[X \<mapsto> P]\<^sub>\<tau>"
133.1804 +  proof (cases "X = Y")
133.1805 +    assume eq: "X = Y"
133.1806 +    from eq and SA_trans_TVar have "TVarB Y Q \<in> set G" by simp
133.1807 +    with G_ok have QS: "Q = S" using `TVarB Y S \<in> set G` by (rule uniqueness_of_ctxt)
133.1808 +    from X\<Gamma>_ok have "X \<sharp> ty_domain \<Gamma>" and "Q closed_in \<Gamma>" by auto
133.1809 +    then have XQ: "X \<sharp> Q" by (rule closed_in_fresh)
133.1810 +    note `\<Gamma>\<turnstile>P<:Q`
133.1811 +    moreover from ST have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule subtype_implies_ok)
133.1812 +    moreover have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1813 +    ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:Q" by (rule weakening)
133.1814 +    with QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:S" by simp
133.1815 +    moreover from XQ and ST and QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1816 +      by (simp add: type_subst_identity)
133.1817 +    ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1818 +      by (rule subtype_transitivity)
133.1819 +    with eq show ?case by simp
133.1820 +  next
133.1821 +    assume neq: "X \<noteq> Y"
133.1822 +    with SA_trans_TVar have "TVarB Y S \<in> set D \<or> TVarB Y S \<in> set \<Gamma>"
133.1823 +      by (simp add: binding.inject)
133.1824 +    then show ?case
133.1825 +    proof
133.1826 +      assume "TVarB Y S \<in> set D"
133.1827 +      then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e)"
133.1828 +	by (rule ctxt_subst_mem_TVarB)
133.1829 +      then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
133.1830 +      with neq and ST show ?thesis by auto
133.1831 +    next
133.1832 +      assume Y: "TVarB Y S \<in> set \<Gamma>"
133.1833 +      from X\<Gamma>_ok have "X \<sharp> ty_domain \<Gamma>" and "\<turnstile> \<Gamma> ok" by auto
133.1834 +      then have "X \<sharp> \<Gamma>" by (simp add: valid_ty_domain_fresh)
133.1835 +      with Y have "X \<sharp> S"
133.1836 +	by (induct \<Gamma>) (auto simp add: fresh_list_nil fresh_list_cons)
133.1837 +      with ST have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1838 +	by (simp add: type_subst_identity)
133.1839 +      moreover from Y have "TVarB Y S \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
133.1840 +      ultimately show ?thesis using neq by auto
133.1841 +    qed
133.1842 +  qed
133.1843 +next
133.1844 +  case (SA_refl_TVar G Y X P D)
133.1845 +  then have "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by simp
133.1846 +  moreover from SA_refl_TVar have closed: "P closed_in \<Gamma>"
133.1847 +    by (auto dest: subtype_implies_closed)
133.1848 +  ultimately have ok: "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using valid_subst by auto
133.1849 +  from closed have closed': "P closed_in (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
133.1850 +    by (simp add: closed_in_weaken')
133.1851 +  show ?case
133.1852 +  proof (cases "X = Y")
133.1853 +    assume "X = Y"
133.1854 +    with closed' and ok show ?thesis
133.1855 +      by (auto intro: subtype_reflexivity)
133.1856 +  next
133.1857 +    assume neq: "X \<noteq> Y"
133.1858 +    with SA_refl_TVar have "Y \<in> ty_domain (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
133.1859 +      by (simp add: ty_domain_subst domains_append)
133.1860 +    with neq and ok show ?thesis by auto
133.1861 +  qed
133.1862 +next
133.1863 +  case (SA_arrow G T1 S1 S2 T2 X P D)
133.1864 +  then have h1:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>T1[X \<mapsto> P]\<^sub>\<tau><:S1[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
133.1865 +  from SA_arrow have h2:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S2[X \<mapsto> P]\<^sub>\<tau><:T2[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
133.1866 +  show ?case using subtype_of.SA_arrow h1 h2 by auto
133.1867 +next
133.1868 +  case (SA_all G T1 S1 Y S2 T2 X P D)
133.1869 +  then have Y: "Y \<sharp> ty_domain (D @ TVarB X Q # \<Gamma>)"
133.1870 +    by (auto dest: subtype_implies_ok intro: fresh_domain)
133.1871 +  moreover from SA_all have "S1 closed_in (D @ TVarB X Q # \<Gamma>)"
133.1872 +    by (auto dest: subtype_implies_closed)
133.1873 +  ultimately have S1: "Y \<sharp> S1" by (rule closed_in_fresh)
133.1874 +  from SA_all have "T1 closed_in (D @ TVarB X Q # \<Gamma>)"
133.1875 +    by (auto dest: subtype_implies_closed)
133.1876 +  with Y have T1: "Y \<sharp> T1" by (rule closed_in_fresh)
133.1877 +  with SA_all and S1 show ?case by force
133.1878 +qed
133.1879 +
133.1880 +subsubsection {* Type Substitution Preserves Typing *}
133.1881 +
133.1882 +theorem substT_type: -- {* A.11 *}
133.1883 +  assumes H: "(D @ TVarB X Q # G) \<turnstile> t : T"
133.1884 +  shows "G \<turnstile> P <: Q \<Longrightarrow>
133.1885 +    (D[X \<mapsto> P]\<^sub>e @ G) \<turnstile> t[X \<mapsto>\<^sub>\<tau> P] : T[X \<mapsto> P]\<^sub>\<tau>" using H
133.1886 +proof (nominal_induct \<Gamma>'\<equiv>"(D @ TVarB X Q # G)" t T avoiding: X P arbitrary: D rule: typing.strong_induct)
133.1887 +  case (T_Var x T G' X P D')
133.1888 +  have "G\<turnstile>P<:Q" by fact
133.1889 +  then have "P closed_in G" using subtype_implies_closed by auto
133.1890 +  moreover have "\<turnstile> (D' @ TVarB X Q # G) ok" using T_Var by auto
133.1891 +  ultimately have "\<turnstile> (D'[X \<mapsto> P]\<^sub>e @ G) ok" using valid_subst by auto
133.1892 +  moreover have "VarB x T \<in> set (D' @ TVarB X Q # G)" using T_Var by auto
133.1893 +  then have "VarB x T \<in> set D' \<or> VarB x T \<in> set G" by simp
133.1894 +  then have "(VarB x (T[X \<mapsto> P]\<^sub>\<tau>)) \<in> set (D'[X \<mapsto> P]\<^sub>e @ G)"
133.1895 +  proof
133.1896 +    assume "VarB x T \<in> set D'"
133.1897 +    then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D'[X \<mapsto> P]\<^sub>e)"
133.1898 +      by (rule ctxt_subst_mem_VarB)
133.1899 +    then show ?thesis by simp
133.1900 +  next
133.1901 +    assume x: "VarB x T \<in> set G"
133.1902 +    from T_Var have ok: "\<turnstile> G ok" by (auto dest: subtype_implies_ok)
133.1903 +    then have "X \<sharp> ty_domain G" using T_Var by (auto dest: validE_append)
133.1904 +    with ok have "X \<sharp> G" by (simp add: valid_ty_domain_fresh)
133.1905 +    moreover from x have "VarB x T \<in> set (D' @ G)" by simp
133.1906 +    then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set ((D' @ G)[X \<mapsto> P]\<^sub>e)"
133.1907 +      by (rule ctxt_subst_mem_VarB)
133.1908 +    ultimately show ?thesis
133.1909 +      by (simp add: ctxt_subst_append ctxt_subst_identity)
133.1910 +  qed
133.1911 +  ultimately show ?case by auto
133.1912 +next
133.1913 +  case (T_App G' t1 T1 T2 t2 X P D')
133.1914 +  then have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (T1 \<rightarrow> T2)[X \<mapsto> P]\<^sub>\<tau>" by auto
133.1915 +  moreover from T_App have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t2[X \<mapsto>\<^sub>\<tau> P] : T1[X \<mapsto> P]\<^sub>\<tau>" by auto
133.1916 +  ultimately show ?case by auto
133.1917 +next
133.1918 +  case (T_Abs x T1 G' t2 T2 X P D')
133.1919 +  then show ?case by force
133.1920 +next
133.1921 +  case (T_Sub G' t S T X P D')
133.1922 +  then show ?case using substT_subtype by force
133.1923 +next
133.1924 +  case (T_TAbs X' G' T1 t2 T2 X P D')
133.1925 +  then have "X' \<sharp> ty_domain (D' @ TVarB X Q # G)"
133.1926 +  and "G' closed_in (D' @ TVarB X Q # G)"
133.1927 +    by (auto dest: typing_ok)
133.1928 +  then have "X' \<sharp> G'" by (rule closed_in_fresh)
133.1929 +  with T_TAbs show ?case by force
133.1930 +next
133.1931 +  case (T_TApp X' G' t1 T2 T11 T12 X P D')
133.1932 +  then have "X' \<sharp> ty_domain (D' @ TVarB X Q # G)"
133.1933 +    by (simp add: fresh_domain)
133.1934 +  moreover from T_TApp have "T11 closed_in (D' @ TVarB X Q # G)"
133.1935 +    by (auto dest: subtype_implies_closed)
133.1936 +  ultimately have X': "X' \<sharp> T11" by (rule closed_in_fresh)
133.1937 +  from T_TApp have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (\<forall>X'<:T11. T12)[X \<mapsto> P]\<^sub>\<tau>"
133.1938 +    by simp
133.1939 +  with X' and T_TApp show ?case
133.1940 +    by (auto simp add: fresh_atm type_substitution_lemma
133.1941 +      fresh_list_append fresh_list_cons
133.1942 +      ctxt_subst_fresh' type_subst_fresh subst_trm_ty_fresh
133.1943 +      intro: substT_subtype)
133.1944 +qed
133.1945 +
133.1946 +lemma Abs_type: -- {* A.13(1) *}
133.1947 +  assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : T"
133.1948 +  and H': "\<Gamma> \<turnstile> T <: U \<rightarrow> U'"
133.1949 +  and H'': "x \<sharp> \<Gamma>"
133.1950 +  obtains S' where "\<Gamma> \<turnstile> U <: S"
133.1951 +             and   "(VarB x S) # \<Gamma> \<turnstile> s : S'"
133.1952 +             and   "\<Gamma> \<turnstile> S' <: U'"
133.1953 +  using H H' H''
133.1954 +proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>x:S. s" T avoiding: x arbitrary: U U' S s rule: typing.strong_induct)
133.1955 +  case (T_Abs y T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1956 +  from `\<Gamma> \<turnstile> T\<^isub>1 \<rightarrow> T\<^isub>2 <: U \<rightarrow> U'`
133.1957 +  obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "\<Gamma> \<turnstile> T\<^isub>2 <: U'" using T_Abs
133.1958 +    by cases (simp_all add: ty.inject trm.inject alpha fresh_atm)
133.1959 +  from T_Abs have "VarB y S # \<Gamma> \<turnstile> [(y, x)] \<bullet> s : T\<^isub>2"
133.1960 +    by (simp add: trm.inject alpha fresh_atm)
133.1961 +  then have "[(y, x)] \<bullet> (VarB y S # \<Gamma>) \<turnstile> [(y, x)] \<bullet> [(y, x)] \<bullet> s : [(y, x)] \<bullet> T\<^isub>2"
133.1962 +    by (rule typing.eqvt)
133.1963 +  moreover from T_Abs have "y \<sharp> \<Gamma>"
133.1964 +    by (auto dest!: typing_ok simp add: fresh_trm_domain)
133.1965 +  ultimately have "VarB x S # \<Gamma> \<turnstile> s : T\<^isub>2" using T_Abs
133.1966 +    by (perm_simp add: ty_vrs_prm_simp)
133.1967 +  with ty1 show ?case using ty2 by (rule T_Abs)
133.1968 +next
133.1969 +  case (T_Sub \<Gamma> t S T)
133.1970 +  then show ?case using subtype_transitivity by blast
133.1971 +qed simp_all
133.1972 +
133.1973 +lemma subtype_reflexivity_from_typing:
133.1974 +  assumes "\<Gamma> \<turnstile> t : T"
133.1975 +  shows "\<Gamma> \<turnstile> T <: T"
133.1976 +using assms subtype_reflexivity typing_ok typing_closed_in by simp
133.1977 +
133.1978 +lemma Abs_type':
133.1979 +  assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : U \<rightarrow> U'"
133.1980 +  and H': "x \<sharp> \<Gamma>"
133.1981 +  obtains S'
133.1982 +  where "\<Gamma> \<turnstile> U <: S"
133.1983 +  and "(VarB x S) # \<Gamma> \<turnstile> s : S'"
133.1984 +  and "\<Gamma> \<turnstile> S' <: U'"
133.1985 +  using H subtype_reflexivity_from_typing [OF H] H'
133.1986 +  by (rule Abs_type)
133.1987 +
133.1988 +lemma TAbs_type: -- {* A.13(2) *}
133.1989 +  assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : T"
133.1990 +  and H': "\<Gamma> \<turnstile> T <: (\<forall>X<:U. U')"
133.1991 +  and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
133.1992 +  obtains S'
133.1993 +  where "\<Gamma> \<turnstile> U <: S"
133.1994 +  and   "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
133.1995 +  and   "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
133.1996 +  using H H' fresh
133.1997 +proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>X<:S. s" T avoiding: X U U' S arbitrary: s rule: typing.strong_induct)
133.1998 +  case (T_TAbs Y T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1999 +  from `TVarB Y T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2` have Y: "Y \<sharp> \<Gamma>"
133.2000 +    by (auto dest!: typing_ok simp add: valid_ty_domain_fresh)
133.2001 +  from `Y \<sharp> U'` and `Y \<sharp> X`
133.2002 +  have "(\<forall>X<:U. U') = (\<forall>Y<:U. [(Y, X)] \<bullet> U')"
133.2003 +    by (simp add: ty.inject alpha' fresh_atm)
133.2004 +  with T_TAbs have "\<Gamma> \<turnstile> (\<forall>Y<:S. T\<^isub>2) <: (\<forall>Y<:U. [(Y, X)] \<bullet> U')" by (simp add: trm.inject)
133.2005 +  then obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "(TVarB Y U # \<Gamma>) \<turnstile> T\<^isub>2 <: ([(Y, X)] \<bullet> U')" using T_TAbs Y
133.2006 +    by (cases rule: subtype_of.strong_cases [where X=Y]) (simp_all add: ty.inject alpha abs_fresh)
133.2007 +  note ty1
133.2008 +  moreover from T_TAbs have "TVarB Y S # \<Gamma> \<turnstile> ([(Y, X)] \<bullet> s) : T\<^isub>2"
133.2009 +    by (simp add: trm.inject alpha fresh_atm)
133.2010 +  then have "[(Y, X)] \<bullet> (TVarB Y S # \<Gamma>) \<turnstile> [(Y, X)] \<bullet> [(Y, X)] \<bullet> s : [(Y, X)] \<bullet> T\<^isub>2"
133.2011 +    by (rule typing.eqvt)
133.2012 +  with `X \<sharp> \<Gamma>` `X \<sharp> S` Y `Y \<sharp> S` have "TVarB X S # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^isub>2"
133.2013 +    by perm_simp
133.2014 +  then have "TVarB X U # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^isub>2" using ty1
133.2015 +    by (rule narrow_type [of "[]", simplified])
133.2016 +  moreover from ty2 have "([(Y, X)] \<bullet> (TVarB Y U # \<Gamma>)) \<turnstile> ([(Y, X)] \<bullet> T\<^isub>2) <: ([(Y, X)] \<bullet> [(Y, X)] \<bullet> U')"
133.2017 +    by (rule subtype_of.eqvt)
133.2018 +  with `X \<sharp> \<Gamma>` `X \<sharp> U` Y `Y \<sharp> U` have "(TVarB X U # \<Gamma>) \<turnstile> ([(Y, X)] \<bullet> T\<^isub>2) <: U'"
133.2019 +    by perm_simp
133.2020 +  ultimately show ?case by (rule T_TAbs)
133.2021 +next
133.2022 +  case (T_Sub \<Gamma> t S T)
133.2023 +  then show ?case using subtype_transitivity by blast 
133.2024 +qed simp_all
133.2025 +
133.2026 +lemma TAbs_type':
133.2027 +  assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : (\<forall>X<:U. U')"
133.2028 +  and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
133.2029 +  obtains S'
133.2030 +  where "\<Gamma> \<turnstile> U <: S"
133.2031 +  and "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
133.2032 +  and "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
133.2033 +  using H subtype_reflexivity_from_typing [OF H] fresh
133.2034 +  by (rule TAbs_type)
133.2035 +
133.2036 +theorem preservation: -- {* A.20 *}
133.2037 +  assumes H: "\<Gamma> \<turnstile> t : T"
133.2038 +  shows "t \<longmapsto> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : T" using H
133.2039 +proof (nominal_induct avoiding: t' rule: typing.strong_induct)
133.2040 +  case (T_App \<Gamma> t\<^isub>1 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2 t\<^isub>2 t')
133.2041 +  obtain x::vrs where x_fresh: "x \<sharp> (\<Gamma>, t\<^isub>1 \<cdot> t\<^isub>2, t')"
133.2042 +    by (rule exists_fresh) (rule fin_supp)
133.2043 +  obtain X::tyvrs where "X \<sharp> (t\<^isub>1 \<cdot> t\<^isub>2, t')"
133.2044 +    by (rule exists_fresh) (rule fin_supp)
133.2045 +  with `t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t'` show ?case
133.2046 +  proof (cases rule: eval.strong_cases [where x=x and X=X])
133.2047 +    case (E_Abs v\<^isub>2 T\<^isub>1\<^isub>1' t\<^isub>1\<^isub>2)
133.2048 +    with T_App and x_fresh have h: "\<Gamma> \<turnstile> (\<lambda>x:T\<^isub>1\<^isub>1'. t\<^isub>1\<^isub>2) : T\<^isub>1\<^isub>1 \<rightarrow> T\<^isub>1\<^isub>2"
133.2049 +      by (simp add: trm.inject fresh_prod)
133.2050 +    moreover from x_fresh have "x \<sharp> \<Gamma>" by simp
133.2051 +    ultimately obtain S'
133.2052 +      where T\<^isub>1\<^isub>1: "\<Gamma> \<turnstile> T\<^isub>1\<^isub>1 <: T\<^isub>1\<^isub>1'"
133.2053 +      and t\<^isub>1\<^isub>2: "(VarB x T\<^isub>1\<^isub>1') # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : S'"
133.2054 +      and S': "\<Gamma> \<turnstile> S' <: T\<^isub>1\<^isub>2"
133.2055 +      by (rule Abs_type') blast
133.2056 +    from `\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1`
133.2057 +    have "\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1'" using T\<^isub>1\<^isub>1 by (rule T_Sub)
133.2058 +    with t\<^isub>1\<^isub>2 have "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[x \<mapsto> t\<^isub>2] : S'" 
133.2059 +      by (rule subst_type [where \<Delta>="[]", simplified])
133.2060 +    hence "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[x \<mapsto> t\<^isub>2] : T\<^isub>1\<^isub>2" using S' by (rule T_Sub)
133.2061 +    with E_Abs and x_fresh show ?thesis by (simp add: trm.inject fresh_prod)
133.2062 +  next
133.2063 +    case (E_App1 t''' t'' u)
133.2064 +    hence "t\<^isub>1 \<longmapsto> t''" by (simp add:trm.inject) 
133.2065 +    hence "\<Gamma> \<turnstile> t'' : T\<^isub>1\<^isub>1 \<rightarrow> T\<^isub>1\<^isub>2" by (rule T_App)
133.2066 +    hence "\<Gamma> \<turnstile> t'' \<cdot> t\<^isub>2 : T\<^isub>1\<^isub>2" using `\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1`
133.2067 +      by (rule typing.T_App)
133.2068 +    with E_App1 show ?thesis by (simp add:trm.inject)
133.2069 +  next
133.2070 +    case (E_App2 v t''' t'')
133.2071 +    hence "t\<^isub>2 \<longmapsto> t''" by (simp add:trm.inject) 
133.2072 +    hence "\<Gamma> \<turnstile> t'' : T\<^isub>1\<^isub>1" by (rule T_App)
133.2073 +    with T_App(1) have "\<Gamma> \<turnstile> t\<^isub>1 \<cdot> t'' : T\<^isub>1\<^isub>2"
133.2074 +      by (rule typing.T_App)
133.2075 +    with E_App2 show ?thesis by (simp add:trm.inject) 
133.2076 +  qed (simp_all add: fresh_prod)
133.2077 +next
133.2078 +  case (T_TApp X \<Gamma> t\<^isub>1 T\<^isub>2  T\<^isub>1\<^isub>1  T\<^isub>1\<^isub>2 t')
133.2079 +  obtain x::vrs where "x \<sharp> (t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2, t')"
133.2080 +    by (rule exists_fresh) (rule fin_supp)
133.2081 +  with `t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t'`
133.2082 +  show ?case
133.2083 +  proof (cases rule: eval.strong_cases [where X=X and x=x])
133.2084 +    case (E_TAbs T\<^isub>1\<^isub>1' T\<^isub>2' t\<^isub>1\<^isub>2)
133.2085 +    with T_TApp have "\<Gamma> \<turnstile> (\<lambda>X<:T\<^isub>1\<^isub>1'. t\<^isub>1\<^isub>2) : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2)" and "X \<sharp> \<Gamma>" and "X \<sharp> T\<^isub>1\<^isub>1'"
133.2086 +      by (simp_all add: trm.inject)
133.2087 +    moreover from `\<Gamma>\<turnstile>T\<^isub>2<:T\<^isub>1\<^isub>1` and `X \<sharp> \<Gamma>` have "X \<sharp> T\<^isub>1\<^isub>1"
133.2088 +      by (blast intro: closed_in_fresh fresh_domain dest: subtype_implies_closed)
133.2089 +    ultimately obtain S'
133.2090 +      where "TVarB X T\<^isub>1\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : S'"
133.2091 +      and "(TVarB X T\<^isub>1\<^isub>1 # \<Gamma>) \<turnstile> S' <: T\<^isub>1\<^isub>2"
133.2092 +      by (rule TAbs_type') blast
133.2093 +    hence "TVarB X T\<^isub>1\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : T\<^isub>1\<^isub>2" by (rule T_Sub)
133.2094 +    hence "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[X \<mapsto>\<^sub>\<tau> T\<^isub>2] : T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>" using `\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1`
133.2095 +      by (rule substT_type [where D="[]", simplified])
133.2096 +    with T_TApp and E_TAbs show ?thesis by (simp add: trm.inject)
133.2097 +  next
133.2098 +    case (E_TApp t''' t'' T)
133.2099 +    from E_TApp have "t\<^isub>1 \<longmapsto> t''" by (simp add: trm.inject)
133.2100 +    then have "\<Gamma> \<turnstile> t'' : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2)" by (rule T_TApp)
133.2101 +    then have "\<Gamma> \<turnstile> t'' \<cdot>\<^sub>\<tau> T\<^isub>2 : T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>" using `\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1`
133.2102 +      by (rule better_T_TApp)
133.2103 +    with E_TApp show ?thesis by (simp add: trm.inject)
133.2104 +  qed (simp_all add: fresh_prod)
133.2105 +next
133.2106 +  case (T_Sub \<Gamma> t S T t')
133.2107 +  have "t \<longmapsto> t'" by fact
133.2108 +  hence "\<Gamma> \<turnstile> t' : S" by (rule T_Sub)
133.2109 +  moreover have "\<Gamma> \<turnstile> S <: T" by fact
133.2110 +  ultimately show ?case by (rule typing.T_Sub)
133.2111 +qed (auto)
133.2112 +
133.2113 +lemma Fun_canonical: -- {* A.14(1) *}
133.2114 +  assumes ty: "[] \<turnstile> v : T\<^isub>1 \<rightarrow> T\<^isub>2"
133.2115 +  shows "val v \<Longrightarrow> \<exists>x t S. v = (\<lambda>x:S. t)" using ty
133.2116 +proof (induct \<Gamma>\<equiv>"[]::env" v T\<equiv>"T\<^isub>1 \<rightarrow> T\<^isub>2" arbitrary: T\<^isub>1 T\<^isub>2)
133.2117 +  case (T_Sub \<Gamma> t S T)
133.2118 +  hence "\<Gamma> \<turnstile> S <: T\<^isub>1 \<rightarrow> T\<^isub>2" by simp
133.2119 +  then obtain S\<^isub>1 S\<^isub>2 where S: "S = S\<^isub>1 \<rightarrow> S\<^isub>2" 
133.2120 +    by cases (auto simp add: T_Sub)
133.2121 +  with `val t` and `\<Gamma> = []` show ?case by (rule T_Sub)
133.2122 +qed (auto)
133.2123 +
133.2124 +lemma TyAll_canonical: -- {* A.14(3) *}
133.2125 +  fixes X::tyvrs
133.2126 +  assumes ty: "[] \<turnstile> v : (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.2127 +  shows "val v \<Longrightarrow> \<exists>X t S. v = (\<lambda>X<:S. t)" using ty
133.2128 +proof (induct \<Gamma>\<equiv>"[]::env" v T\<equiv>"\<forall>X<:T\<^isub>1. T\<^isub>2" arbitrary: X T\<^isub>1 T\<^isub>2)
133.2129 +  case (T_Sub  \<Gamma> t S T)
133.2130 +  hence "\<Gamma> \<turnstile> S <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" by simp
133.2131 +  then obtain X S\<^isub>1 S\<^isub>2 where S: "S = (\<forall>X<:S\<^isub>1. S\<^isub>2)"
133.2132 +    by cases (auto simp add: T_Sub)
133.2133 +  then show ?case using T_Sub by auto 
133.2134 +qed (auto)
133.2135 +
133.2136 +theorem progress:
133.2137 +  assumes "[] \<turnstile> t : T"
133.2138 +  shows "val t \<or> (\<exists>t'. t \<longmapsto> t')" 
133.2139 +using assms
133.2140 +proof (induct \<Gamma> \<equiv> "[]::env" t T)
133.2141 +  case (T_App \<Gamma> t\<^isub>1 T\<^isub>1\<^isub>1  T\<^isub>1\<^isub>2 t\<^isub>2)
133.2142 +  hence "val t\<^isub>1 \<or> (\<exists>t'. t\<^isub>1 \<longmapsto> t')" by simp
133.2143 +  thus ?case
133.2144 +  proof
133.2145 +    assume t\<^isub>1_val: "val t\<^isub>1"
133.2146 +    with T_App obtain x t3 S where t\<^isub>1: "t\<^isub>1 = (\<lambda>x:S. t3)"
133.2147 +      by (auto dest!: Fun_canonical)
133.2148 +    from T_App have "val t\<^isub>2 \<or> (\<exists>t'. t\<^isub>2 \<longmapsto> t')" by simp
133.2149 +    thus ?case
133.2150 +    proof
133.2151 +      assume "val t\<^isub>2"
133.2152 +      with t\<^isub>1 have "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t3[x \<mapsto> t\<^isub>2]" by auto
133.2153 +      thus ?case by auto
133.2154 +    next
133.2155 +      assume "\<exists>t'. t\<^isub>2 \<longmapsto> t'"
133.2156 +      then obtain t' where "t\<^isub>2 \<longmapsto> t'" by auto
133.2157 +      with t\<^isub>1_val have "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t\<^isub>1 \<cdot> t'" by auto
133.2158 +      thus ?case by auto
133.2159 +    qed
133.2160 +  next
133.2161 +    assume "\<exists>t'. t\<^isub>1 \<longmapsto> t'"
133.2162 +    then obtain t' where "t\<^isub>1 \<longmapsto> t'" by auto
133.2163 +    hence "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t' \<cdot> t\<^isub>2" by auto
133.2164 +    thus ?case by auto
133.2165 +  qed
133.2166 +next
133.2167 +  case (T_TApp X \<Gamma> t\<^isub>1 T\<^isub>2 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2)
133.2168 +  hence "val t\<^isub>1 \<or> (\<exists>t'. t\<^isub>1 \<longmapsto> t')" by simp
133.2169 +  thus ?case
133.2170 +  proof
133.2171 +    assume "val t\<^isub>1"
133.2172 +    with T_TApp obtain x t S where "t\<^isub>1 = (\<lambda>x<:S. t)"
133.2173 +      by (auto dest!: TyAll_canonical)
133.2174 +    hence "t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t[x \<mapsto>\<^sub>\<tau> T\<^isub>2]" by auto
133.2175 +    thus ?case by auto
133.2176 +  next
133.2177 +    assume "\<exists>t'. t\<^isub>1 \<longmapsto> t'" thus ?case by auto
133.2178 +  qed
133.2179 +qed (auto)
133.2180 +
133.2181 +end
   134.1 --- a/src/HOL/Nominal/Nominal.thy	Wed Mar 04 10:43:39 2009 +0100
   134.2 +++ b/src/HOL/Nominal/Nominal.thy	Wed Mar 04 10:45:52 2009 +0100
   134.3 @@ -397,6 +397,37 @@
   134.4  
   134.5  lemmas fresh_star_prod = fresh_star_prod_list fresh_star_prod_set
   134.6  
   134.7 +lemma fresh_star_set_eq: "set xs \<sharp>* c = xs \<sharp>* c"
   134.8 +  by (simp add: fresh_star_def)
   134.9 +
  134.10 +lemma fresh_star_Un_elim:
  134.11 +  "((S \<union> T) \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (S \<sharp>* c \<Longrightarrow> T \<sharp>* c \<Longrightarrow> PROP C)"
  134.12 +  apply rule
  134.13 +  apply (simp_all add: fresh_star_def)
  134.14 +  apply (erule meta_mp)
  134.15 +  apply blast
  134.16 +  done
  134.17 +
  134.18 +lemma fresh_star_insert_elim:
  134.19 +  "(insert x S \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (x \<sharp> c \<Longrightarrow> S \<sharp>* c \<Longrightarrow> PROP C)"
  134.20 +  by rule (simp_all add: fresh_star_def)
  134.21 +
  134.22 +lemma fresh_star_empty_elim:
  134.23 +  "({} \<sharp>* c \<Longrightarrow> PROP C) \<equiv> PROP C"
  134.24 +  by (simp add: fresh_star_def)
  134.25 +
  134.26 +text {* Normalization of freshness results; cf.\ @{text nominal_induct} *}
  134.27 +
  134.28 +lemma fresh_star_unit_elim: 
  134.29 +  shows "((a::'a set)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  134.30 +  and "((b::'a list)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
  134.31 +  by (simp_all add: fresh_star_def fresh_def supp_unit)
  134.32 +
  134.33 +lemma fresh_star_prod_elim: 
  134.34 +  shows "((a::'a set)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>*x \<Longrightarrow> a\<sharp>*y \<Longrightarrow> PROP C)"
  134.35 +  and "((b::'a list)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (b\<sharp>*x \<Longrightarrow> b\<sharp>*y \<Longrightarrow> PROP C)"
  134.36 +  by (rule, simp_all add: fresh_star_prod)+
  134.37 +
  134.38  section {* Abstract Properties for Permutations and  Atoms *}
  134.39  (*=========================================================*)
  134.40  
  134.41 @@ -1645,6 +1676,31 @@
  134.42  apply(rule at)
  134.43  done
  134.44  
  134.45 +lemma pt_fresh_star_eqvt:
  134.46 +  fixes  pi :: "'x prm"
  134.47 +  and     x :: "'a"
  134.48 +  and     a :: "'x set"
  134.49 +  and     b :: "'x list"
  134.50 +  assumes pt: "pt TYPE('a) TYPE('x)"
  134.51 +  and     at: "at TYPE('x)"
  134.52 +  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  134.53 +  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  134.54 +  by (simp_all add: perm_bool pt_fresh_star_bij[OF pt, OF at])
  134.55 +
  134.56 +lemma pt_fresh_star_eqvt_ineq:
  134.57 +  fixes pi::"'x prm"
  134.58 +  and   a::"'y set"
  134.59 +  and   b::"'y list"
  134.60 +  and   x::"'a"
  134.61 +  assumes pta: "pt TYPE('a) TYPE('x)"
  134.62 +  and     ptb: "pt TYPE('y) TYPE('x)"
  134.63 +  and     at:  "at TYPE('x)"
  134.64 +  and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
  134.65 +  and     dj:  "disjoint TYPE('y) TYPE('x)"
  134.66 +  shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
  134.67 +  and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
  134.68 +  by (simp_all add: pt_fresh_star_bij_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
  134.69 +
  134.70  lemma pt_fresh_bij1:
  134.71    fixes  pi :: "'x prm"
  134.72    and     x :: "'a"
   135.1 --- a/src/HOL/Nominal/nominal_atoms.ML	Wed Mar 04 10:43:39 2009 +0100
   135.2 +++ b/src/HOL/Nominal/nominal_atoms.ML	Wed Mar 04 10:45:52 2009 +0100
   135.3 @@ -1,5 +1,4 @@
   135.4  (*  title:      HOL/Nominal/nominal_atoms.ML
   135.5 -    ID:         $Id$
   135.6      Author:     Christian Urban and Stefan Berghofer, TU Muenchen
   135.7  
   135.8  Declaration of atom types to be used in nominal datatypes.
   135.9 @@ -784,6 +783,8 @@
  135.10         val fresh_star_bij      = @{thms "Nominal.pt_fresh_star_bij"};
  135.11         val fresh_eqvt          = @{thm "Nominal.pt_fresh_eqvt"};
  135.12         val fresh_eqvt_ineq     = @{thm "Nominal.pt_fresh_eqvt_ineq"};
  135.13 +       val fresh_star_eqvt     = @{thms "Nominal.pt_fresh_star_eqvt"};
  135.14 +       val fresh_star_eqvt_ineq= @{thms "Nominal.pt_fresh_star_eqvt_ineq"};
  135.15         val set_diff_eqvt       = @{thm "Nominal.pt_set_diff_eqvt"};
  135.16         val in_eqvt             = @{thm "Nominal.pt_in_eqvt"};
  135.17         val eq_eqvt             = @{thm "Nominal.pt_eq_eqvt"};
  135.18 @@ -947,13 +948,17 @@
  135.19                in [(("fresh_bij", thms1 @ thms2),[])] end
  135.20              ||>> add_thmss_string
  135.21                let val thms1 = inst_pt_at fresh_star_bij
  135.22 -                  and thms2 = flat (map (fn ti => inst_pt_pt_at_cp [ti]) fresh_star_bij_ineq);
  135.23 +                  and thms2 = maps (fn ti => inst_pt_pt_at_cp [ti]) fresh_star_bij_ineq
  135.24                in [(("fresh_star_bij", thms1 @ thms2),[])] end
  135.25              ||>> add_thmss_string
  135.26                let val thms1 = inst_pt_at [fresh_eqvt]
  135.27                    and thms2 = inst_pt_pt_at_cp_dj [fresh_eqvt_ineq]
  135.28                in [(("fresh_eqvt", thms1 @ thms2),[NominalThmDecls.eqvt_add])] end
  135.29              ||>> add_thmss_string
  135.30 +              let val thms1 = inst_pt_at fresh_star_eqvt
  135.31 +                  and thms2 = maps (fn ti => inst_pt_pt_at_cp_dj [ti]) fresh_star_eqvt_ineq
  135.32 +              in [(("fresh_star_eqvt", thms1 @ thms2),[NominalThmDecls.eqvt_add])] end
  135.33 +            ||>> add_thmss_string
  135.34                let val thms1 = inst_pt_at [in_eqvt]
  135.35                in [(("in_eqvt", thms1),[NominalThmDecls.eqvt_add])] end
  135.36              ||>> add_thmss_string
   136.1 --- a/src/HOL/Nominal/nominal_induct.ML	Wed Mar 04 10:43:39 2009 +0100
   136.2 +++ b/src/HOL/Nominal/nominal_induct.ML	Wed Mar 04 10:45:52 2009 +0100
   136.3 @@ -1,5 +1,4 @@
   136.4 -(*  ID:         $Id$
   136.5 -    Author:     Christian Urban and Makarius
   136.6 +(*  Author:     Christian Urban and Makarius
   136.7  
   136.8  The nominal induct proof method.
   136.9  *)
  136.10 @@ -24,7 +23,8 @@
  136.11  
  136.12  val split_all_tuples =
  136.13    Simplifier.full_simplify (HOL_basic_ss addsimps
  136.14 -    [split_conv, split_paired_all, unit_all_eq1, thm "fresh_unit_elim", thm "fresh_prod_elim"]);
  136.15 +    [split_conv, split_paired_all, unit_all_eq1, @{thm fresh_unit_elim}, @{thm fresh_prod_elim}] @
  136.16 +    @{thms fresh_star_unit_elim} @ @{thms fresh_star_prod_elim});
  136.17  
  136.18  
  136.19  (* prepare rule *)
   137.1 --- a/src/HOL/Nominal/nominal_inductive.ML	Wed Mar 04 10:43:39 2009 +0100
   137.2 +++ b/src/HOL/Nominal/nominal_inductive.ML	Wed Mar 04 10:45:52 2009 +0100
   137.3 @@ -7,8 +7,8 @@
   137.4  
   137.5  signature NOMINAL_INDUCTIVE =
   137.6  sig
   137.7 -  val prove_strong_ind: string -> (string * string list) list -> theory -> Proof.state
   137.8 -  val prove_eqvt: string -> string list -> theory -> theory
   137.9 +  val prove_strong_ind: string -> (string * string list) list -> local_theory -> Proof.state
  137.10 +  val prove_eqvt: string -> string list -> local_theory -> local_theory
  137.11  end
  137.12  
  137.13  structure NominalInductive : NOMINAL_INDUCTIVE =
  137.14 @@ -28,6 +28,8 @@
  137.15  fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
  137.16    (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
  137.17  
  137.18 +fun preds_of ps t = gen_inter (op = o apfst dest_Free) (ps, Term.add_frees t []);
  137.19 +
  137.20  val fresh_prod = thm "fresh_prod";
  137.21  
  137.22  val perm_bool = mk_meta_eq (thm "perm_bool");
  137.23 @@ -142,9 +144,9 @@
  137.24  fun first_order_mrs ths th = ths MRS
  137.25    Thm.instantiate (first_order_matchs (cprems_of th) (map cprop_of ths)) th;
  137.26  
  137.27 -fun prove_strong_ind s avoids thy =
  137.28 +fun prove_strong_ind s avoids ctxt =
  137.29    let
  137.30 -    val ctxt = ProofContext.init thy;
  137.31 +    val thy = ProofContext.theory_of ctxt;
  137.32      val ({names, ...}, {raw_induct, intrs, elims, ...}) =
  137.33        InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
  137.34      val ind_params = InductivePackage.params_of raw_induct;
  137.35 @@ -158,8 +160,7 @@
  137.36            commas_quote xs));
  137.37      val induct_cases = map fst (fst (RuleCases.get (the
  137.38        (Induct.lookup_inductP ctxt (hd names)))));
  137.39 -    val raw_induct' = Logic.unvarify (prop_of raw_induct);
  137.40 -    val elims' = map (Logic.unvarify o prop_of) elims;
  137.41 +    val ([raw_induct'], ctxt') = Variable.import_terms false [prop_of raw_induct] ctxt;
  137.42      val concls = raw_induct' |> Logic.strip_imp_concl |> HOLogic.dest_Trueprop |>
  137.43        HOLogic.dest_conj |> map (HOLogic.dest_imp ##> strip_comb);
  137.44      val ps = map (fst o snd) concls;
  137.45 @@ -199,8 +200,8 @@
  137.46      val ind_sort = if null atomTs then HOLogic.typeS
  137.47        else Sign.certify_sort thy (map (fn T => Sign.intern_class thy
  137.48          ("fs_" ^ Sign.base_name (fst (dest_Type T)))) atomTs);
  137.49 -    val fs_ctxt_tyname = Name.variant (map fst (OldTerm.term_tfrees raw_induct')) "'n";
  137.50 -    val fs_ctxt_name = Name.variant (OldTerm.add_term_names (raw_induct', [])) "z";
  137.51 +    val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
  137.52 +    val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
  137.53      val fsT = TFree (fs_ctxt_tyname, ind_sort);
  137.54  
  137.55      val inductive_forall_def' = Drule.instantiate'
  137.56 @@ -237,7 +238,7 @@
  137.57          val prem = Logic.list_implies
  137.58            (map mk_fresh bvars @ mk_distinct bvars @
  137.59             map (fn prem =>
  137.60 -             if null (OldTerm.term_frees prem inter ps) then prem
  137.61 +             if null (preds_of ps prem) then prem
  137.62               else lift_prem prem) prems,
  137.63             HOLogic.mk_Trueprop (lift_pred p ts));
  137.64          val vs = map (Var o apfst (rpair 0)) (Term.rename_wrt_term prem params')
  137.65 @@ -263,7 +264,7 @@
  137.66      val vc_compat = map (fn (params, bvars, prems, (p, ts)) =>
  137.67        map (fn q => list_all (params, incr_boundvars ~1 (Logic.list_implies
  137.68            (List.mapPartial (fn prem =>
  137.69 -             if null (ps inter OldTerm.term_frees prem) then SOME prem
  137.70 +             if null (preds_of ps prem) then SOME prem
  137.71               else map_term (split_conj (K o I) names) prem prem) prems, q))))
  137.72          (mk_distinct bvars @
  137.73           maps (fn (t, T) => map (fn (u, U) => HOLogic.mk_Trueprop
  137.74 @@ -309,8 +310,8 @@
  137.75            [ex] ctxt
  137.76        in (freshs1 @ [term_of cx], freshs2 @ ths, ctxt') end;
  137.77  
  137.78 -    fun mk_ind_proof thy thss =
  137.79 -      Goal.prove_global thy [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
  137.80 +    fun mk_ind_proof ctxt' thss =
  137.81 +      Goal.prove ctxt' [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
  137.82          let val th = Goal.prove ctxt [] [] concl (fn {context, ...} =>
  137.83            rtac raw_induct 1 THEN
  137.84            EVERY (maps (fn ((((_, bvars, oprems, _), vc_compat_ths), ihyp), (vs, ihypt)) =>
  137.85 @@ -352,7 +353,7 @@
  137.86                           (rev pis' @ pis) th));
  137.87                   val (gprems1, gprems2) = split_list
  137.88                     (map (fn (th, t) =>
  137.89 -                      if null (OldTerm.term_frees t inter ps) then (SOME th, mk_pi th)
  137.90 +                      if null (preds_of ps t) then (SOME th, mk_pi th)
  137.91                        else
  137.92                          (map_thm ctxt (split_conj (K o I) names)
  137.93                             (etac conjunct1 1) monos NONE th,
  137.94 @@ -403,42 +404,42 @@
  137.95            REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
  137.96              etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
  137.97              asm_full_simp_tac (simpset_of thy) 1)
  137.98 -        end);
  137.99 +        end) |> singleton (ProofContext.export ctxt' ctxt);
 137.100  
 137.101      (** strong case analysis rule **)
 137.102  
 137.103      val cases_prems = map (fn ((name, avoids), rule) =>
 137.104        let
 137.105 -        val prem :: prems = Logic.strip_imp_prems rule;
 137.106 -        val concl = Logic.strip_imp_concl rule;
 137.107 -        val used = Term.add_free_names rule [];
 137.108 +        val ([rule'], ctxt') = Variable.import_terms false [prop_of rule] ctxt;
 137.109 +        val prem :: prems = Logic.strip_imp_prems rule';
 137.110 +        val concl = Logic.strip_imp_concl rule'
 137.111        in
 137.112          (prem,
 137.113           List.drop (snd (strip_comb (HOLogic.dest_Trueprop prem)), length ind_params),
 137.114           concl,
 137.115 -         fst (fold_map (fn (prem, (_, avoid)) => fn used =>
 137.116 +         fold_map (fn (prem, (_, avoid)) => fn ctxt =>
 137.117             let
 137.118               val prems = Logic.strip_assums_hyp prem;
 137.119               val params = Logic.strip_params prem;
 137.120               val bnds = fold (add_binders thy 0) prems [] @ mk_avoids params avoid;
 137.121 -             fun mk_subst (p as (s, T)) (i, j, used, ps, qs, is, ts) =
 137.122 +             fun mk_subst (p as (s, T)) (i, j, ctxt, ps, qs, is, ts) =
 137.123                 if member (op = o apsnd fst) bnds (Bound i) then
 137.124                   let
 137.125 -                   val s' = Name.variant used s;
 137.126 +                   val ([s'], ctxt') = Variable.variant_fixes [s] ctxt;
 137.127                     val t = Free (s', T)
 137.128 -                 in (i + 1, j, s' :: used, ps, (t, T) :: qs, i :: is, t :: ts) end
 137.129 -               else (i + 1, j + 1, used, p :: ps, qs, is, Bound j :: ts);
 137.130 -             val (_, _, used', ps, qs, is, ts) = fold_rev mk_subst params
 137.131 -               (0, 0, used, [], [], [], [])
 137.132 +                 in (i + 1, j, ctxt', ps, (t, T) :: qs, i :: is, t :: ts) end
 137.133 +               else (i + 1, j + 1, ctxt, p :: ps, qs, is, Bound j :: ts);
 137.134 +             val (_, _, ctxt', ps, qs, is, ts) = fold_rev mk_subst params
 137.135 +               (0, 0, ctxt, [], [], [], [])
 137.136             in
 137.137 -             ((ps, qs, is, map (curry subst_bounds (rev ts)) prems), used')
 137.138 -           end) (prems ~~ avoids) used))
 137.139 +             ((ps, qs, is, map (curry subst_bounds (rev ts)) prems), ctxt')
 137.140 +           end) (prems ~~ avoids) ctxt')
 137.141        end)
 137.142          (InductivePackage.partition_rules' raw_induct (intrs ~~ avoids') ~~
 137.143 -         elims');
 137.144 +         elims);
 137.145  
 137.146      val cases_prems' =
 137.147 -      map (fn (prem, args, concl, prems) =>
 137.148 +      map (fn (prem, args, concl, (prems, _)) =>
 137.149          let
 137.150            fun mk_prem (ps, [], _, prems) =
 137.151                  list_all (ps, Logic.list_implies (prems, concl))
 137.152 @@ -462,9 +463,9 @@
 137.153      val simp_fresh_atm = map
 137.154        (Simplifier.simplify (HOL_basic_ss addsimps fresh_atm));
 137.155  
 137.156 -    fun mk_cases_proof thy ((((name, thss), elim), (prem, args, concl, prems)),
 137.157 +    fun mk_cases_proof ((((name, thss), elim), (prem, args, concl, (prems, ctxt'))),
 137.158          prems') =
 137.159 -      (name, Goal.prove_global thy [] (prem :: prems') concl
 137.160 +      (name, Goal.prove ctxt' [] (prem :: prems') concl
 137.161          (fn {prems = hyp :: hyps, context = ctxt1} =>
 137.162          EVERY (rtac (hyp RS elim) 1 ::
 137.163            map (fn (((_, vc_compat_ths), case_hyp), (_, qs, is, _)) =>
 137.164 @@ -537,52 +538,54 @@
 137.165                           end) ctxt4 1)
 137.166                    val final = ProofContext.export ctxt3 ctxt2 [th]
 137.167                  in resolve_tac final 1 end) ctxt1 1)
 137.168 -                  (thss ~~ hyps ~~ prems))))
 137.169 +                  (thss ~~ hyps ~~ prems))) |>
 137.170 +                  singleton (ProofContext.export ctxt' ctxt))
 137.171  
 137.172    in
 137.173 -    thy |>
 137.174 -    ProofContext.init |>
 137.175 -    Proof.theorem_i NONE (fn thss => ProofContext.theory (fn thy =>
 137.176 +    ctxt'' |>
 137.177 +    Proof.theorem_i NONE (fn thss => fn ctxt =>
 137.178        let
 137.179 -        val ctxt = ProofContext.init thy;
 137.180          val rec_name = space_implode "_" (map Sign.base_name names);
 137.181 +        val rec_qualified = Binding.qualify false rec_name;
 137.182          val ind_case_names = RuleCases.case_names induct_cases;
 137.183          val induct_cases' = InductivePackage.partition_rules' raw_induct
 137.184            (intrs ~~ induct_cases); 
 137.185          val thss' = map (map atomize_intr) thss;
 137.186          val thsss = InductivePackage.partition_rules' raw_induct (intrs ~~ thss');
 137.187          val strong_raw_induct =
 137.188 -          mk_ind_proof thy thss' |> InductivePackage.rulify;
 137.189 -        val strong_cases = map (mk_cases_proof thy ##> InductivePackage.rulify)
 137.190 +          mk_ind_proof ctxt thss' |> InductivePackage.rulify;
 137.191 +        val strong_cases = map (mk_cases_proof ##> InductivePackage.rulify)
 137.192            (thsss ~~ elims ~~ cases_prems ~~ cases_prems');
 137.193          val strong_induct =
 137.194            if length names > 1 then
 137.195              (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
 137.196            else (strong_raw_induct RSN (2, rev_mp),
 137.197              [ind_case_names, RuleCases.consumes 1]);
 137.198 -        val ([strong_induct'], thy') = thy |>
 137.199 -          Sign.add_path rec_name |>
 137.200 -          PureThy.add_thms [((Binding.name "strong_induct", #1 strong_induct), #2 strong_induct)];
 137.201 +        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
 137.202 +          ((rec_qualified (Binding.name "strong_induct"),
 137.203 +            map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
 137.204 +          ctxt;
 137.205          val strong_inducts =
 137.206            ProjectRule.projects ctxt (1 upto length names) strong_induct'
 137.207        in
 137.208 -        thy' |>
 137.209 -        PureThy.add_thmss [((Binding.name "strong_inducts", strong_inducts),
 137.210 -          [ind_case_names, RuleCases.consumes 1])] |> snd |>
 137.211 -        Sign.parent_path |>
 137.212 -        fold (fn ((name, elim), (_, cases)) =>
 137.213 -          Sign.add_path (Sign.base_name name) #>
 137.214 -          PureThy.add_thms [((Binding.name "strong_cases", elim),
 137.215 -            [RuleCases.case_names (map snd cases),
 137.216 -             RuleCases.consumes 1])] #> snd #>
 137.217 -          Sign.parent_path) (strong_cases ~~ induct_cases')
 137.218 -      end))
 137.219 +        ctxt' |>
 137.220 +        LocalTheory.note Thm.theoremK
 137.221 +          ((rec_qualified (Binding.name "strong_inducts"),
 137.222 +            [Attrib.internal (K ind_case_names),
 137.223 +             Attrib.internal (K (RuleCases.consumes 1))]),
 137.224 +           strong_inducts) |> snd |>
 137.225 +        LocalTheory.notes Thm.theoremK (map (fn ((name, elim), (_, cases)) =>
 137.226 +            ((Binding.name (NameSpace.qualified (Sign.base_name name) "strong_cases"),
 137.227 +              [Attrib.internal (K (RuleCases.case_names (map snd cases))),
 137.228 +               Attrib.internal (K (RuleCases.consumes 1))]), [([elim], [])]))
 137.229 +          (strong_cases ~~ induct_cases')) |> snd
 137.230 +      end)
 137.231        (map (map (rulify_term thy #> rpair [])) vc_compat)
 137.232    end;
 137.233  
 137.234 -fun prove_eqvt s xatoms thy =
 137.235 +fun prove_eqvt s xatoms ctxt =
 137.236    let
 137.237 -    val ctxt = ProofContext.init thy;
 137.238 +    val thy = ProofContext.theory_of ctxt;
 137.239      val ({names, ...}, {raw_induct, intrs, elims, ...}) =
 137.240        InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
 137.241      val raw_induct = atomize_induct ctxt raw_induct;
 137.242 @@ -594,6 +597,7 @@
 137.243             (s, ths ~~ InductivePackage.infer_intro_vars th k ths))
 137.244           (InductivePackage.partition_rules raw_induct intrs ~~
 137.245            InductivePackage.arities_of raw_induct ~~ elims));
 137.246 +    val k = length (InductivePackage.params_of raw_induct);
 137.247      val atoms' = NominalAtoms.atoms_of thy;
 137.248      val atoms =
 137.249        if null xatoms then atoms' else
 137.250 @@ -612,19 +616,21 @@
 137.251        (NominalThmDecls.get_eqvt_thms ctxt @ perm_pi_simp) addsimprocs
 137.252        [mk_perm_bool_simproc names,
 137.253         NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun];
 137.254 -    val t = Logic.unvarify (concl_of raw_induct);
 137.255 -    val pi = Name.variant (OldTerm.add_term_names (t, [])) "pi";
 137.256 +    val (([t], [pi]), ctxt') = ctxt |>
 137.257 +      Variable.import_terms false [concl_of raw_induct] ||>>
 137.258 +      Variable.variant_fixes ["pi"];
 137.259      val ps = map (fst o HOLogic.dest_imp)
 137.260        (HOLogic.dest_conj (HOLogic.dest_Trueprop t));
 137.261 -    fun eqvt_tac pi (intr, vs) st =
 137.262 +    fun eqvt_tac ctxt'' pi (intr, vs) st =
 137.263        let
 137.264 -        fun eqvt_err s = error
 137.265 -          ("Could not prove equivariance for introduction rule\n" ^
 137.266 -           Syntax.string_of_term_global (theory_of_thm intr)
 137.267 -             (Logic.unvarify (prop_of intr)) ^ "\n" ^ s);
 137.268 +        fun eqvt_err s =
 137.269 +          let val ([t], ctxt''') = Variable.import_terms true [prop_of intr] ctxt
 137.270 +          in error ("Could not prove equivariance for introduction rule\n" ^
 137.271 +            Syntax.string_of_term ctxt''' t ^ "\n" ^ s)
 137.272 +          end;
 137.273          val res = SUBPROOF (fn {prems, params, ...} =>
 137.274            let
 137.275 -            val prems' = map (fn th => the_default th (map_thm ctxt
 137.276 +            val prems' = map (fn th => the_default th (map_thm ctxt'
 137.277                (split_conj (K I) names) (etac conjunct2 1) monos NONE th)) prems;
 137.278              val prems'' = map (fn th => Simplifier.simplify eqvt_ss
 137.279                (mk_perm_bool (cterm_of thy pi) th)) prems';
 137.280 @@ -632,29 +638,36 @@
 137.281                 map (cterm_of thy o NominalPackage.mk_perm [] pi o term_of) params)
 137.282                 intr
 137.283            in (rtac intr' THEN_ALL_NEW (TRY o resolve_tac prems'')) 1
 137.284 -          end) ctxt 1 st
 137.285 +          end) ctxt' 1 st
 137.286        in
 137.287          case (Seq.pull res handle THM (s, _, _) => eqvt_err s) of
 137.288            NONE => eqvt_err ("Rule does not match goal\n" ^
 137.289 -            Syntax.string_of_term_global (theory_of_thm st) (hd (prems_of st)))
 137.290 +            Syntax.string_of_term ctxt'' (hd (prems_of st)))
 137.291          | SOME (th, _) => Seq.single th
 137.292        end;
 137.293      val thss = map (fn atom =>
 137.294        let val pi' = Free (pi, NominalAtoms.mk_permT (Type (atom, [])))
 137.295        in map (fn th => zero_var_indexes (th RS mp))
 137.296 -        (DatatypeAux.split_conj_thm (Goal.prove_global thy [] []
 137.297 +        (DatatypeAux.split_conj_thm (Goal.prove ctxt' [] []
 137.298            (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map (fn p =>
 137.299 -            HOLogic.mk_imp (p, list_comb
 137.300 -             (apsnd (map (NominalPackage.mk_perm [] pi')) (strip_comb p)))) ps)))
 137.301 -          (fn _ => EVERY (rtac raw_induct 1 :: map (fn intr_vs =>
 137.302 +            let
 137.303 +              val (h, ts) = strip_comb p;
 137.304 +              val (ts1, ts2) = chop k ts
 137.305 +            in
 137.306 +              HOLogic.mk_imp (p, list_comb (h, ts1 @
 137.307 +                map (NominalPackage.mk_perm [] pi') ts2))
 137.308 +            end) ps)))
 137.309 +          (fn {context, ...} => EVERY (rtac raw_induct 1 :: map (fn intr_vs =>
 137.310                full_simp_tac eqvt_ss 1 THEN
 137.311 -              eqvt_tac pi' intr_vs) intrs'))))
 137.312 +              eqvt_tac context pi' intr_vs) intrs')) |>
 137.313 +          singleton (ProofContext.export ctxt' ctxt)))
 137.314        end) atoms
 137.315    in
 137.316 -    fold (fn (name, ths) =>
 137.317 -      Sign.add_path (Sign.base_name name) #>
 137.318 -      PureThy.add_thmss [((Binding.name "eqvt", ths), [NominalThmDecls.eqvt_add])] #> snd #>
 137.319 -      Sign.parent_path) (names ~~ transp thss) thy
 137.320 +    ctxt |>
 137.321 +    LocalTheory.notes Thm.theoremK (map (fn (name, ths) =>
 137.322 +        ((Binding.name (NameSpace.qualified (Sign.base_name name) "eqvt"),
 137.323 +          [Attrib.internal (K NominalThmDecls.eqvt_add)]), [(ths, [])]))
 137.324 +      (names ~~ transp thss)) |> snd
 137.325    end;
 137.326  
 137.327  
 137.328 @@ -665,17 +678,17 @@
 137.329  val _ = OuterKeyword.keyword "avoids";
 137.330  
 137.331  val _ =
 137.332 -  OuterSyntax.command "nominal_inductive"
 137.333 +  OuterSyntax.local_theory_to_proof "nominal_inductive"
 137.334      "prove equivariance and strong induction theorem for inductive predicate involving nominal datatypes" K.thy_goal
 137.335 -    (P.name -- Scan.optional (P.$$$ "avoids" |-- P.and_list1 (P.name --
 137.336 +    (P.xname -- Scan.optional (P.$$$ "avoids" |-- P.and_list1 (P.name --
 137.337        (P.$$$ ":" |-- Scan.repeat1 P.name))) [] >> (fn (name, avoids) =>
 137.338 -        Toplevel.print o Toplevel.theory_to_proof (prove_strong_ind name avoids)));
 137.339 +        prove_strong_ind name avoids));
 137.340  
 137.341  val _ =
 137.342 -  OuterSyntax.command "equivariance"
 137.343 +  OuterSyntax.local_theory "equivariance"
 137.344      "prove equivariance for inductive predicate involving nominal datatypes" K.thy_decl
 137.345 -    (P.name -- Scan.optional (P.$$$ "[" |-- P.list1 P.name --| P.$$$ "]") [] >>
 137.346 -      (fn (name, atoms) => Toplevel.theory (prove_eqvt name atoms)));
 137.347 +    (P.xname -- Scan.optional (P.$$$ "[" |-- P.list1 P.name --| P.$$$ "]") [] >>
 137.348 +      (fn (name, atoms) => prove_eqvt name atoms));
 137.349  
 137.350  end;
 137.351  
   138.1 --- a/src/HOL/Nominal/nominal_inductive2.ML	Wed Mar 04 10:43:39 2009 +0100
   138.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML	Wed Mar 04 10:45:52 2009 +0100
   138.3 @@ -8,7 +8,7 @@
   138.4  
   138.5  signature NOMINAL_INDUCTIVE2 =
   138.6  sig
   138.7 -  val prove_strong_ind: string -> (string * string list) list -> theory -> Proof.state
   138.8 +  val prove_strong_ind: string -> (string * string list) list -> local_theory -> Proof.state
   138.9  end
  138.10  
  138.11  structure NominalInductive2 : NOMINAL_INDUCTIVE2 =
  138.12 @@ -28,6 +28,13 @@
  138.13  fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
  138.14    (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
  138.15  
  138.16 +val fresh_postprocess =
  138.17 +  Simplifier.full_simplify (HOL_basic_ss addsimps
  138.18 +    [@{thm fresh_star_set_eq}, @{thm fresh_star_Un_elim},
  138.19 +     @{thm fresh_star_insert_elim}, @{thm fresh_star_empty_elim}]);
  138.20 +
  138.21 +fun preds_of ps t = gen_inter (op = o apfst dest_Free) (ps, Term.add_frees t []);
  138.22 +
  138.23  val perm_bool = mk_meta_eq (thm "perm_bool");
  138.24  val perm_boolI = thm "perm_boolI";
  138.25  val (_, [perm_boolI_pi, _]) = Drule.strip_comb (snd (Thm.dest_comb
  138.26 @@ -148,9 +155,9 @@
  138.27      map (Envir.subst_vars env #> cterm_of thy) vs ~~ cts) th
  138.28    end;
  138.29  
  138.30 -fun prove_strong_ind s avoids thy =
  138.31 +fun prove_strong_ind s avoids ctxt =
  138.32    let
  138.33 -    val ctxt = ProofContext.init thy;
  138.34 +    val thy = ProofContext.theory_of ctxt;
  138.35      val ({names, ...}, {raw_induct, intrs, elims, ...}) =
  138.36        InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
  138.37      val ind_params = InductivePackage.params_of raw_induct;
  138.38 @@ -166,8 +173,7 @@
  138.39        (Induct.lookup_inductP ctxt (hd names)))));
  138.40      val induct_cases' = if null induct_cases then replicate (length intrs) ""
  138.41        else induct_cases;
  138.42 -    val raw_induct' = Logic.unvarify (prop_of raw_induct);
  138.43 -    val elims' = map (Logic.unvarify o prop_of) elims;
  138.44 +    val ([raw_induct'], ctxt') = Variable.import_terms false [prop_of raw_induct] ctxt;
  138.45      val concls = raw_induct' |> Logic.strip_imp_concl |> HOLogic.dest_Trueprop |>
  138.46        HOLogic.dest_conj |> map (HOLogic.dest_imp ##> strip_comb);
  138.47      val ps = map (fst o snd) concls;
  138.48 @@ -191,12 +197,15 @@
  138.49            handle TERM _ =>
  138.50              error ("Expression " ^ quote s ^ " to be avoided in case " ^
  138.51                quote name ^ " is not a set type");
  138.52 -        val ps = map mk sets
  138.53 +        fun add_set p [] = [p]
  138.54 +          | add_set (t, T) ((u, U) :: ps) =
  138.55 +              if T = U then
  138.56 +                let val S = HOLogic.mk_setT T
  138.57 +                in (Const (@{const_name "op Un"}, S --> S --> S) $ u $ t, T) :: ps
  138.58 +                end
  138.59 +              else (u, U) :: add_set (t, T) ps
  138.60        in
  138.61 -        case duplicates op = (map snd ps) of
  138.62 -          [] => ps
  138.63 -        | Ts => error ("More than one set in case " ^ quote name ^
  138.64 -            " for type(s) " ^ commas_quote (map (Syntax.string_of_typ ctxt') Ts))
  138.65 +        fold (mk #> add_set) sets []
  138.66        end;
  138.67  
  138.68      val prems = map (fn (prem, name) =>
  138.69 @@ -221,8 +230,8 @@
  138.70      val ind_sort = if null atomTs then HOLogic.typeS
  138.71        else Sign.certify_sort thy (map (fn a => Sign.intern_class thy
  138.72          ("fs_" ^ Sign.base_name a)) atoms);
  138.73 -    val fs_ctxt_tyname = Name.variant (map fst (OldTerm.term_tfrees raw_induct')) "'n";
  138.74 -    val fs_ctxt_name = Name.variant (OldTerm.add_term_names (raw_induct', [])) "z";
  138.75 +    val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
  138.76 +    val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
  138.77      val fsT = TFree (fs_ctxt_tyname, ind_sort);
  138.78  
  138.79      val inductive_forall_def' = Drule.instantiate'
  138.80 @@ -253,7 +262,7 @@
  138.81          val prem = Logic.list_implies
  138.82            (map mk_fresh sets @
  138.83             map (fn prem =>
  138.84 -             if null (OldTerm.term_frees prem inter ps) then prem
  138.85 +             if null (preds_of ps prem) then prem
  138.86               else lift_prem prem) prems,
  138.87             HOLogic.mk_Trueprop (lift_pred p ts));
  138.88        in abs_params params' prem end) prems);
  138.89 @@ -276,7 +285,7 @@
  138.90      val (vc_compat, vc_compat') = map (fn (params, sets, prems, (p, ts)) =>
  138.91        map (fn q => abs_params params (incr_boundvars ~1 (Logic.list_implies
  138.92            (List.mapPartial (fn prem =>
  138.93 -             if null (ps inter OldTerm.term_frees prem) then SOME prem
  138.94 +             if null (preds_of ps prem) then SOME prem
  138.95               else map_term (split_conj (K o I) names) prem prem) prems, q))))
  138.96          (maps (fn (t, T) => map (fn (u, U) => HOLogic.mk_Trueprop
  138.97             (NominalPackage.fresh_star_const U T $ u $ t)) sets)
  138.98 @@ -345,8 +354,8 @@
  138.99           ths1 @ ths, ths2 @ [th1], ths3 @ [th2'], ctxt')
 138.100        end;
 138.101  
 138.102 -    fun mk_ind_proof thy thss =
 138.103 -      Goal.prove_global thy [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
 138.104 +    fun mk_ind_proof ctxt' thss =
 138.105 +      Goal.prove ctxt' [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
 138.106          let val th = Goal.prove ctxt [] [] concl (fn {context, ...} =>
 138.107            rtac raw_induct 1 THEN
 138.108            EVERY (maps (fn (((((_, sets, oprems, _),
 138.109 @@ -363,7 +372,7 @@
 138.110                     fold_rev (NominalPackage.mk_perm []) pis t) sets';
 138.111                   val (P, ts) = strip_comb (HOLogic.dest_Trueprop (term_of concl));
 138.112                   val gprems1 = List.mapPartial (fn (th, t) =>
 138.113 -                   if null (OldTerm.term_frees t inter ps) then SOME th
 138.114 +                   if null (preds_of ps t) then SOME th
 138.115                     else
 138.116                       map_thm ctxt' (split_conj (K o I) names)
 138.117                         (etac conjunct1 1) monos NONE th)
 138.118 @@ -405,7 +414,7 @@
 138.119                         (fold_rev (mk_perm_bool o cterm_of thy)
 138.120                           (pis' @ pis) th));
 138.121                   val gprems2 = map (fn (th, t) =>
 138.122 -                   if null (OldTerm.term_frees t inter ps) then mk_pi th
 138.123 +                   if null (preds_of ps t) then mk_pi th
 138.124                     else
 138.125                       mk_pi (the (map_thm ctxt (inst_conj_all names ps (rev pis''))
 138.126                         (inst_conj_all_tac (length pis'')) monos (SOME t) th)))
 138.127 @@ -435,38 +444,42 @@
 138.128            REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
 138.129              etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
 138.130              asm_full_simp_tac (simpset_of thy) 1)
 138.131 -        end);
 138.132 +        end) |>
 138.133 +        fresh_postprocess |>
 138.134 +        singleton (ProofContext.export ctxt' ctxt);
 138.135  
 138.136    in
 138.137 -    thy |>
 138.138 -    ProofContext.init |>
 138.139 -    Proof.theorem_i NONE (fn thss => ProofContext.theory (fn thy =>
 138.140 +    ctxt'' |>
 138.141 +    Proof.theorem_i NONE (fn thss => fn ctxt =>
 138.142        let
 138.143 -        val ctxt = ProofContext.init thy;
 138.144          val rec_name = space_implode "_" (map Sign.base_name names);
 138.145 +        val rec_qualified = Binding.qualify false rec_name;
 138.146          val ind_case_names = RuleCases.case_names induct_cases;
 138.147          val induct_cases' = InductivePackage.partition_rules' raw_induct
 138.148            (intrs ~~ induct_cases); 
 138.149          val thss' = map (map atomize_intr) thss;
 138.150          val thsss = InductivePackage.partition_rules' raw_induct (intrs ~~ thss');
 138.151          val strong_raw_induct =
 138.152 -          mk_ind_proof thy thss' |> InductivePackage.rulify;
 138.153 +          mk_ind_proof ctxt thss' |> InductivePackage.rulify;
 138.154          val strong_induct =
 138.155            if length names > 1 then
 138.156              (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
 138.157            else (strong_raw_induct RSN (2, rev_mp),
 138.158              [ind_case_names, RuleCases.consumes 1]);
 138.159 -        val ([strong_induct'], thy') = thy |>
 138.160 -          Sign.add_path rec_name |>
 138.161 -          PureThy.add_thms [((Binding.name "strong_induct", #1 strong_induct), #2 strong_induct)];
 138.162 +        val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
 138.163 +          ((rec_qualified (Binding.name "strong_induct"),
 138.164 +            map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
 138.165 +          ctxt;
 138.166          val strong_inducts =
 138.167 -          ProjectRule.projects ctxt (1 upto length names) strong_induct'
 138.168 +          ProjectRule.projects ctxt' (1 upto length names) strong_induct'
 138.169        in
 138.170 -        thy' |>
 138.171 -        PureThy.add_thmss [((Binding.name "strong_inducts", strong_inducts),
 138.172 -          [ind_case_names, RuleCases.consumes 1])] |> snd |>
 138.173 -        Sign.parent_path
 138.174 -      end))
 138.175 +        ctxt' |>
 138.176 +        LocalTheory.note Thm.theoremK
 138.177 +          ((rec_qualified (Binding.name "strong_inducts"),
 138.178 +            [Attrib.internal (K ind_case_names),
 138.179 +             Attrib.internal (K (RuleCases.consumes 1))]),
 138.180 +           strong_inducts) |> snd
 138.181 +      end)
 138.182        (map (map (rulify_term thy #> rpair [])) vc_compat)
 138.183    end;
 138.184  
 138.185 @@ -476,11 +489,11 @@
 138.186  local structure P = OuterParse and K = OuterKeyword in
 138.187  
 138.188  val _ =
 138.189 -  OuterSyntax.command "nominal_inductive2"
 138.190 +  OuterSyntax.local_theory_to_proof "nominal_inductive2"
 138.191      "prove strong induction theorem for inductive predicate involving nominal datatypes" K.thy_goal
 138.192 -    (P.name -- Scan.optional (P.$$$ "avoids" |-- P.enum1 "|" (P.name --
 138.193 +    (P.xname -- Scan.optional (P.$$$ "avoids" |-- P.enum1 "|" (P.name --
 138.194        (P.$$$ ":" |-- P.and_list1 P.term))) [] >> (fn (name, avoids) =>
 138.195 -        Toplevel.print o Toplevel.theory_to_proof (prove_strong_ind name avoids)));
 138.196 +        prove_strong_ind name avoids));
 138.197  
 138.198  end;
 138.199  
   139.1 --- a/src/HOL/Nominal/nominal_package.ML	Wed Mar 04 10:43:39 2009 +0100
   139.2 +++ b/src/HOL/Nominal/nominal_package.ML	Wed Mar 04 10:45:52 2009 +0100
   139.3 @@ -547,10 +547,10 @@
   139.4                    HOLogic.mk_Trueprop (Free (List.nth (rep_set_names, k),
   139.5                      T --> HOLogic.boolT) $ free')) :: prems
   139.6                | _ => prems,
   139.7 -            snd (foldr mk_abs_fun (j', free) Ts) :: ts)
   139.8 +            snd (List.foldr mk_abs_fun (j', free) Ts) :: ts)
   139.9            end;
  139.10  
  139.11 -        val (_, _, prems, ts) = foldr mk_prem (1, 1, [], []) cargs;
  139.12 +        val (_, _, prems, ts) = List.foldr mk_prem (1, 1, [], []) cargs;
  139.13          val concl = HOLogic.mk_Trueprop (Free (s, T --> HOLogic.boolT) $
  139.14            list_comb (Const (cname, map fastype_of ts ---> T), ts))
  139.15        in Logic.list_implies (prems, concl)
  139.16 @@ -716,7 +716,7 @@
  139.17            Type ("Nominal.noption", [U])) $ x $ t
  139.18        end;
  139.19  
  139.20 -    val (ty_idxs, _) = foldl
  139.21 +    val (ty_idxs, _) = List.foldl
  139.22        (fn ((i, ("Nominal.noption", _, _)), p) => p
  139.23          | ((i, _), (ty_idxs, j)) => (ty_idxs @ [(i, j)], j + 1)) ([], 0) descr;
  139.24  
  139.25 @@ -738,7 +738,7 @@
  139.26                 val SOME index = AList.lookup op = ty_idxs i;
  139.27                 val (constrs1, constrs2) = ListPair.unzip
  139.28                   (map (fn (cname, cargs) => apfst (pair (strip_nth_name 2 (strip_nth_name 1 cname)))
  139.29 -                   (foldl_map (fn (dts, dt) =>
  139.30 +                   (Library.foldl_map (fn (dts, dt) =>
  139.31                       let val (dts', dt') = strip_option dt
  139.32                       in (dts @ dts' @ [reindex dt'], (length dts, length dts')) end)
  139.33                         ([], cargs))) constrs)
  139.34 @@ -780,7 +780,7 @@
  139.35            in
  139.36              (j + length dts + 1,
  139.37               xs @ x :: l_args,
  139.38 -             foldr mk_abs_fun
  139.39 +             List.foldr mk_abs_fun
  139.40                 (case dt of
  139.41                    DtRec k => if k < length new_type_names then
  139.42                        Const (List.nth (rep_names, k), typ_of_dtyp descr'' sorts dt -->
  139.43 @@ -789,7 +789,7 @@
  139.44                  | _ => x) xs :: r_args)
  139.45            end
  139.46  
  139.47 -        val (_, l_args, r_args) = foldr constr_arg (1, [], []) cargs;
  139.48 +        val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) cargs;
  139.49          val abs_name = Sign.intern_const thy ("Abs_" ^ tname);
  139.50          val rep_name = Sign.intern_const thy ("Rep_" ^ tname);
  139.51          val constrT = map fastype_of l_args ---> T;
  139.52 @@ -909,7 +909,7 @@
  139.53                 map perm (xs @ [x]) @ r_args)
  139.54              end
  139.55  
  139.56 -          val (_, l_args, r_args) = foldr constr_arg (1, [], []) dts;
  139.57 +          val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) dts;
  139.58            val c = Const (cname, map fastype_of l_args ---> T)
  139.59          in
  139.60            Goal.prove_global thy8 [] []
  139.61 @@ -958,10 +958,10 @@
  139.62                (j + length dts + 1,
  139.63                 xs @ (x :: args1), ys @ (y :: args2),
  139.64                 HOLogic.mk_eq
  139.65 -                 (foldr mk_abs_fun x xs, foldr mk_abs_fun y ys) :: eqs)
  139.66 +                 (List.foldr mk_abs_fun x xs, List.foldr mk_abs_fun y ys) :: eqs)
  139.67              end;
  139.68  
  139.69 -          val (_, args1, args2, eqs) = foldr make_inj (1, [], [], []) dts;
  139.70 +          val (_, args1, args2, eqs) = List.foldr make_inj (1, [], [], []) dts;
  139.71            val Ts = map fastype_of args1;
  139.72            val c = Const (cname, Ts ---> T)
  139.73          in
  139.74 @@ -997,10 +997,10 @@
  139.75                val x = mk_Free "x" (typ_of_dtyp descr'' sorts dt) (j + length dts)
  139.76              in
  139.77                (j + length dts + 1,
  139.78 -               xs @ (x :: args1), foldr mk_abs_fun x xs :: args2)
  139.79 +               xs @ (x :: args1), List.foldr mk_abs_fun x xs :: args2)
  139.80              end;
  139.81  
  139.82 -          val (_, args1, args2) = foldr process_constr (1, [], []) dts;
  139.83 +          val (_, args1, args2) = List.foldr process_constr (1, [], []) dts;
  139.84            val Ts = map fastype_of args1;
  139.85            val c = list_comb (Const (cname, Ts ---> T), args1);
  139.86            fun supp t =
  139.87 @@ -1413,7 +1413,7 @@
  139.88  
  139.89      val _ = warning "defining recursion combinator ...";
  139.90  
  139.91 -    val used = foldr OldTerm.add_typ_tfree_names [] recTs;
  139.92 +    val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
  139.93  
  139.94      val (rec_result_Ts', rec_fn_Ts') = DatatypeProp.make_primrec_Ts descr' sorts used;
  139.95  
   140.1 --- a/src/HOL/Nominal/nominal_primrec.ML	Wed Mar 04 10:43:39 2009 +0100
   140.2 +++ b/src/HOL/Nominal/nominal_primrec.ML	Wed Mar 04 10:45:52 2009 +0100
   140.3 @@ -210,7 +210,7 @@
   140.4      val def_name = Thm.def_name (Sign.base_name fname);
   140.5      val rhs = singleton (Syntax.check_terms ctxt) raw_rhs;
   140.6      val SOME var = get_first (fn ((b, _), mx) =>
   140.7 -      if Binding.base_name b = fname then SOME (b, mx) else NONE) fixes;
   140.8 +      if Binding.name_of b = fname then SOME (b, mx) else NONE) fixes;
   140.9    in
  140.10      ((var, ((Binding.name def_name, []), rhs)),
  140.11       subst_bounds (rev (map Free frees), strip_abs_body rhs))
  140.12 @@ -248,7 +248,7 @@
  140.13      val (names_atts, spec') = split_list spec;
  140.14      val eqns' = map unquantify spec'
  140.15      val eqns = fold_rev (process_eqn lthy (fn v => Variable.is_fixed lthy v
  140.16 -      orelse exists (fn ((w, _), _) => v = Binding.base_name w) fixes)) spec' [];
  140.17 +      orelse exists (fn ((w, _), _) => v = Binding.name_of w) fixes)) spec' [];
  140.18      val dt_info = NominalPackage.get_nominal_datatypes (ProofContext.theory_of lthy);
  140.19      val lsrs :: lsrss = maps (fn (_, (_, _, eqns)) =>
  140.20        map (fn (_, (ls, _, rs, _, _)) => ls @ rs) eqns) eqns
  140.21 @@ -285,7 +285,7 @@
  140.22        set_group ? LocalTheory.set_group (serial_string ()) |>
  140.23        fold_map (apfst (snd o snd) oo
  140.24          LocalTheory.define Thm.definitionK o fst) defs';
  140.25 -    val qualify = Binding.qualify
  140.26 +    val qualify = Binding.qualify false
  140.27        (space_implode "_" (map (Sign.base_name o #1) defs));
  140.28      val names_atts' = map (apfst qualify) names_atts;
  140.29      val cert = cterm_of (ProofContext.theory_of lthy');
   141.1 --- a/src/HOL/Nominal/nominal_thmdecls.ML	Wed Mar 04 10:43:39 2009 +0100
   141.2 +++ b/src/HOL/Nominal/nominal_thmdecls.ML	Wed Mar 04 10:45:52 2009 +0100
   141.3 @@ -1,5 +1,4 @@
   141.4 -(* ID: "$Id$"
   141.5 -   Authors: Julien Narboux and Christian Urban
   141.6 +(* Authors: Julien Narboux and Christian Urban
   141.7  
   141.8     This file introduces the infrastructure for the lemma
   141.9     declaration "eqvts" "bijs" and "freshs".
  141.10 @@ -63,10 +62,11 @@
  141.11      then tac THEN print_tac ("after "^msg)
  141.12      else tac
  141.13  
  141.14 -fun tactic_eqvt ctx orig_thm pi typi =
  141.15 +fun tactic_eqvt ctx orig_thm pi pi' =
  141.16      let
  141.17 -        val mypi = Thm.cterm_of ctx (Var (pi,typi))
  141.18 -        val mypifree = Thm.cterm_of ctx (Const ("List.rev",typi --> typi) $ Free (fst pi,typi))
  141.19 +        val mypi = Thm.cterm_of ctx pi
  141.20 +        val T = fastype_of pi'
  141.21 +        val mypifree = Thm.cterm_of ctx (Const ("List.rev", T --> T) $ pi')
  141.22          val perm_pi_simp = PureThy.get_thms ctx "perm_pi_simp"
  141.23      in
  141.24          EVERY [tactic ("iffI applied",rtac iffI 1),
  141.25 @@ -80,14 +80,19 @@
  141.26                            full_simp_tac (HOL_basic_ss addsimps perm_pi_simp) 1)]
  141.27      end;
  141.28  
  141.29 -fun get_derived_thm thy hyp concl orig_thm pi typi =
  141.30 -   let
  141.31 -       val lhs = (Const("Nominal.perm", typi --> HOLogic.boolT --> HOLogic.boolT) $ Var(pi,typi) $ hyp)
  141.32 -       val goal_term = Logic.unvarify (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,concl)))
  141.33 -       val _ = Display.print_cterm (cterm_of thy goal_term)
  141.34 -   in
  141.35 -     Goal.prove_global thy [] [] goal_term (fn _ => (tactic_eqvt thy orig_thm pi typi))
  141.36 -   end
  141.37 +fun get_derived_thm ctxt hyp concl orig_thm pi typi =
  141.38 +  let
  141.39 +    val thy = ProofContext.theory_of ctxt;
  141.40 +    val pi' = Var (pi, typi);
  141.41 +    val lhs = Const ("Nominal.perm", typi --> HOLogic.boolT --> HOLogic.boolT) $ pi' $ hyp;
  141.42 +    val ([goal_term, pi''], ctxt') = Variable.import_terms false
  141.43 +      [HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, concl)), pi'] ctxt
  141.44 +    val _ = Display.print_cterm (cterm_of thy goal_term)
  141.45 +  in
  141.46 +    Goal.prove ctxt' [] [] goal_term
  141.47 +      (fn _ => tactic_eqvt thy orig_thm pi' pi'') |>
  141.48 +    singleton (ProofContext.export ctxt' ctxt)
  141.49 +  end
  141.50  
  141.51  (* replaces every variable x in t with pi o x *)
  141.52  fun apply_pi trm (pi,typi) =
  141.53 @@ -145,7 +150,8 @@
  141.54               if (apply_pi hyp (pi,typi) = concl)
  141.55               then
  141.56                 (warning ("equivariance lemma of the relational form");
  141.57 -                [orig_thm, get_derived_thm thy hyp concl orig_thm pi typi])
  141.58 +                [orig_thm,
  141.59 +                 get_derived_thm (Context.proof_of context) hyp concl orig_thm pi typi])
  141.60               else raise EQVT_FORM "Type Implication"
  141.61            end
  141.62         (* case: eqvt-lemma is of the equational form *)
   142.1 --- a/src/HOL/NumberTheory/Chinese.thy	Wed Mar 04 10:43:39 2009 +0100
   142.2 +++ b/src/HOL/NumberTheory/Chinese.thy	Wed Mar 04 10:45:52 2009 +0100
   142.3 @@ -90,10 +90,8 @@
   142.4      "k \<le> i --> i \<le> k + l --> mf i dvd funprod mf k l"
   142.5    apply (induct l)
   142.6     apply auto
   142.7 -    apply (rule_tac [1] zdvd_zmult2)
   142.8 -    apply (rule_tac [2] zdvd_zmult)
   142.9 -    apply (subgoal_tac "i = Suc (k + l)")
  142.10 -    apply (simp_all (no_asm_simp))
  142.11 +  apply (subgoal_tac "i = Suc (k + l)")
  142.12 +   apply (simp_all (no_asm_simp))
  142.13    done
  142.14  
  142.15  lemma funsum_mod:
  142.16 @@ -103,7 +101,7 @@
  142.17    apply (rule trans)
  142.18     apply (rule mod_add_eq)
  142.19    apply simp
  142.20 -  apply (rule zmod_zadd_right_eq [symmetric])
  142.21 +  apply (rule mod_add_right_eq [symmetric])
  142.22    done
  142.23  
  142.24  lemma funsum_zero [rule_format (no_asm)]:
  142.25 @@ -196,8 +194,8 @@
  142.26     apply (case_tac [2] "i = n")
  142.27      apply (simp_all (no_asm_simp))
  142.28      apply (case_tac [3] "j < i")
  142.29 -     apply (rule_tac [3] zdvd_zmult2)
  142.30 -     apply (rule_tac [4] zdvd_zmult)
  142.31 +     apply (rule_tac [3] dvd_mult2)
  142.32 +     apply (rule_tac [4] dvd_mult)
  142.33       apply (rule_tac [!] funprod_zdvd)
  142.34       apply arith
  142.35       apply arith
  142.36 @@ -217,8 +215,8 @@
  142.37    apply (subst funsum_mod)
  142.38    apply (subst funsum_oneelem)
  142.39       apply auto
  142.40 -  apply (subst zdvd_iff_zmod_eq_0 [symmetric])
  142.41 -  apply (rule zdvd_zmult)
  142.42 +  apply (subst dvd_eq_mod_eq_0 [symmetric])
  142.43 +  apply (rule dvd_mult)
  142.44    apply (rule x_sol_lin_aux)
  142.45    apply auto
  142.46    done
  142.47 @@ -238,20 +236,20 @@
  142.48    apply safe
  142.49      apply (tactic {* stac (thm "zcong_zmod") 3 *})
  142.50      apply (tactic {* stac (thm "mod_mult_eq") 3 *})
  142.51 -    apply (tactic {* stac (thm "zmod_zdvd_zmod") 3 *})
  142.52 -      apply (tactic {* stac (thm "x_sol_lin") 5 *})
  142.53 -        apply (tactic {* stac (thm "mod_mult_eq" RS sym) 7 *})
  142.54 -        apply (tactic {* stac (thm "zcong_zmod" RS sym) 7 *})
  142.55 -        apply (subgoal_tac [7]
  142.56 +    apply (tactic {* stac (thm "mod_mod_cancel") 3 *})
  142.57 +      apply (tactic {* stac (thm "x_sol_lin") 4 *})
  142.58 +        apply (tactic {* stac (thm "mod_mult_eq" RS sym) 6 *})
  142.59 +        apply (tactic {* stac (thm "zcong_zmod" RS sym) 6 *})
  142.60 +        apply (subgoal_tac [6]
  142.61            "0 \<le> xilin_sol i n kf bf mf \<and> xilin_sol i n kf bf mf < mf i
  142.62            \<and> [kf i * mhf mf n i * xilin_sol i n kf bf mf = bf i] (mod mf i)")
  142.63 -         prefer 7
  142.64 +         prefer 6
  142.65           apply (simp add: zmult_ac)
  142.66          apply (unfold xilin_sol_def)
  142.67 -        apply (tactic {* asm_simp_tac @{simpset} 7 *})
  142.68 -        apply (rule_tac [7] ex1_implies_ex [THEN someI_ex])
  142.69 -        apply (rule_tac [7] unique_xi_sol)
  142.70 -           apply (rule_tac [4] funprod_zdvd)
  142.71 +        apply (tactic {* asm_simp_tac @{simpset} 6 *})
  142.72 +        apply (rule_tac [6] ex1_implies_ex [THEN someI_ex])
  142.73 +        apply (rule_tac [6] unique_xi_sol)
  142.74 +           apply (rule_tac [3] funprod_zdvd)
  142.75              apply (unfold m_cond_def)
  142.76              apply (rule funprod_pos [THEN pos_mod_sign])
  142.77              apply (rule_tac [2] funprod_pos [THEN pos_mod_bound])
   143.1 --- a/src/HOL/NumberTheory/Euler.thy	Wed Mar 04 10:43:39 2009 +0100
   143.2 +++ b/src/HOL/NumberTheory/Euler.thy	Wed Mar 04 10:45:52 2009 +0100
   143.3 @@ -272,7 +272,7 @@
   143.4  text {* \medskip Prove the final part of Euler's Criterion: *}
   143.5  
   143.6  lemma aux__1: "[| ~([x = 0] (mod p)); [y ^ 2 = x] (mod p)|] ==> ~(p dvd y)"
   143.7 -  by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div zdvd_trans)
   143.8 +  by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div dvd_trans)
   143.9  
  143.10  lemma aux__2: "2 * nat((p - 1) div 2) =  nat (2 * ((p - 1) div 2))"
  143.11    by (auto simp add: nat_mult_distrib)
   144.1 --- a/src/HOL/NumberTheory/EulerFermat.thy	Wed Mar 04 10:43:39 2009 +0100
   144.2 +++ b/src/HOL/NumberTheory/EulerFermat.thy	Wed Mar 04 10:45:52 2009 +0100
   144.3 @@ -155,7 +155,7 @@
   144.4      prefer 2
   144.5      apply (subst zdvd_iff_zgcd [symmetric])
   144.6       apply (rule_tac [4] zgcd_zcong_zgcd)
   144.7 -       apply (simp_all add: zdvd_zminus_iff zcong_sym)
   144.8 +       apply (simp_all add: zcong_sym)
   144.9    done
  144.10  
  144.11  
   145.1 --- a/src/HOL/NumberTheory/Gauss.thy	Wed Mar 04 10:43:39 2009 +0100
   145.2 +++ b/src/HOL/NumberTheory/Gauss.thy	Wed Mar 04 10:45:52 2009 +0100
   145.3 @@ -64,14 +64,14 @@
   145.4  qed
   145.5  
   145.6  lemma p_eq: "p = (2 * (p - 1) div 2) + 1"
   145.7 -  using zdiv_zmult_self2 [of 2 "p - 1"] by auto
   145.8 +  using div_mult_self1_is_id [of 2 "p - 1"] by auto
   145.9  
  145.10  
  145.11  lemma (in -) zodd_imp_zdiv_eq: "x \<in> zOdd ==> 2 * (x - 1) div 2 = 2 * ((x - 1) div 2)"
  145.12    apply (frule odd_minus_one_even)
  145.13    apply (simp add: zEven_def)
  145.14    apply (subgoal_tac "2 \<noteq> 0")
  145.15 -  apply (frule_tac b = "2 :: int" and a = "x - 1" in zdiv_zmult_self2)
  145.16 +  apply (frule_tac b = "2 :: int" and a = "x - 1" in div_mult_self1_is_id)
  145.17    apply (auto simp add: even_div_2_prop2)
  145.18    done
  145.19  
   146.1 --- a/src/HOL/NumberTheory/Int2.thy	Wed Mar 04 10:43:39 2009 +0100
   146.2 +++ b/src/HOL/NumberTheory/Int2.thy	Wed Mar 04 10:45:52 2009 +0100
   146.3 @@ -18,7 +18,7 @@
   146.4  
   146.5  lemma zpower_zdvd_prop1:
   146.6    "0 < n \<Longrightarrow> p dvd y \<Longrightarrow> p dvd ((y::int) ^ n)"
   146.7 -  by (induct n) (auto simp add: zdvd_zmult zdvd_zmult2 [of p y])
   146.8 +  by (induct n) (auto simp add: dvd_mult2 [of p y])
   146.9  
  146.10  lemma zdvd_bounds: "n dvd m ==> m \<le> (0::int) | n \<le> m"
  146.11  proof -
  146.12 @@ -42,7 +42,7 @@
  146.13     apply simp
  146.14    apply (frule zprime_zdvd_zmult_better)
  146.15     apply simp
  146.16 -  apply force
  146.17 +  apply (force simp del:dvd_mult)
  146.18    done
  146.19  
  146.20  lemma div_prop1: "[| 0 < z; (x::int) < y * z |] ==> x div z < y"
  146.21 @@ -86,7 +86,7 @@
  146.22    by (auto simp add: zcong_def)
  146.23  
  146.24  lemma zcong_id: "[m = 0] (mod m)"
  146.25 -  by (auto simp add: zcong_def zdvd_0_right)
  146.26 +  by (auto simp add: zcong_def)
  146.27  
  146.28  lemma zcong_shift: "[a = b] (mod m) ==> [a + c = b + c] (mod m)"
  146.29    by (auto simp add: zcong_refl zcong_zadd)
   147.1 --- a/src/HOL/NumberTheory/IntPrimes.thy	Wed Mar 04 10:43:39 2009 +0100
   147.2 +++ b/src/HOL/NumberTheory/IntPrimes.thy	Wed Mar 04 10:45:52 2009 +0100
   147.3 @@ -50,7 +50,7 @@
   147.4  
   147.5  lemma zrelprime_zdvd_zmult_aux:
   147.6       "zgcd n k = 1 ==> k dvd m * n ==> 0 \<le> m ==> k dvd m"
   147.7 -    by (metis abs_of_nonneg zdvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right)
   147.8 +    by (metis abs_of_nonneg dvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right)
   147.9  
  147.10  lemma zrelprime_zdvd_zmult: "zgcd n k = 1 ==> k dvd m * n ==> k dvd m"
  147.11    apply (case_tac "0 \<le> m")
  147.12 @@ -73,7 +73,7 @@
  147.13  lemma zprime_imp_zrelprime:
  147.14      "zprime p ==> \<not> p dvd n ==> zgcd n p = 1"
  147.15    apply (auto simp add: zprime_def)
  147.16 -  apply (metis zgcd_commute zgcd_geq_zero zgcd_zdvd1 zgcd_zdvd2)
  147.17 +  apply (metis zgcd_geq_zero zgcd_zdvd1 zgcd_zdvd2)
  147.18    done
  147.19  
  147.20  lemma zless_zprime_imp_zrelprime:
  147.21 @@ -93,9 +93,7 @@
  147.22    done
  147.23  
  147.24  lemma zgcd_zdvd_zgcd_zmult: "zgcd m n dvd zgcd (k * m) n"
  147.25 -  apply (simp add: zgcd_greatest_iff)
  147.26 -  apply (blast intro: zdvd_trans dvd_triv_right)
  147.27 -  done
  147.28 +by (simp add: zgcd_greatest_iff)
  147.29  
  147.30  lemma zgcd_zmult_zdvd_zgcd:
  147.31      "zgcd k n = 1 ==> zgcd (k * m) n dvd zgcd m n"
  147.32 @@ -127,20 +125,20 @@
  147.33    by (unfold zcong_def, auto)
  147.34  
  147.35  lemma zcong_sym: "[a = b] (mod m) = [b = a] (mod m)"
  147.36 -  unfolding zcong_def minus_diff_eq [of a, symmetric] zdvd_zminus_iff ..
  147.37 +  unfolding zcong_def minus_diff_eq [of a, symmetric] dvd_minus_iff ..
  147.38  
  147.39  lemma zcong_zadd:
  147.40      "[a = b] (mod m) ==> [c = d] (mod m) ==> [a + c = b + d] (mod m)"
  147.41    apply (unfold zcong_def)
  147.42    apply (rule_tac s = "(a - b) + (c - d)" in subst)
  147.43 -   apply (rule_tac [2] zdvd_zadd, auto)
  147.44 +   apply (rule_tac [2] dvd_add, auto)
  147.45    done
  147.46  
  147.47  lemma zcong_zdiff:
  147.48      "[a = b] (mod m) ==> [c = d] (mod m) ==> [a - c = b - d] (mod m)"
  147.49    apply (unfold zcong_def)
  147.50    apply (rule_tac s = "(a - b) - (c - d)" in subst)
  147.51 -   apply (rule_tac [2] zdvd_zdiff, auto)
  147.52 +   apply (rule_tac [2] dvd_diff, auto)
  147.53    done
  147.54  
  147.55  lemma zcong_trans:
  147.56 @@ -151,8 +149,8 @@
  147.57      "[a = b] (mod m) ==> [c = d] (mod m) ==> [a * c = b * d] (mod m)"
  147.58    apply (rule_tac b = "b * c" in zcong_trans)
  147.59     apply (unfold zcong_def)
  147.60 -  apply (metis zdiff_zmult_distrib2 zdvd_zmult zmult_commute)
  147.61 -  apply (metis zdiff_zmult_distrib2 zdvd_zmult)
  147.62 +  apply (metis zdiff_zmult_distrib2 dvd_mult zmult_commute)
  147.63 +  apply (metis zdiff_zmult_distrib2 dvd_mult)
  147.64    done
  147.65  
  147.66  lemma zcong_scalar: "[a = b] (mod m) ==> [a * k = b * k] (mod m)"
  147.67 @@ -163,7 +161,7 @@
  147.68  
  147.69  lemma zcong_zmult_self: "[a * m = b * m] (mod m)"
  147.70    apply (unfold zcong_def)
  147.71 -  apply (rule zdvd_zdiff, simp_all)
  147.72 +  apply (rule dvd_diff, simp_all)
  147.73    done
  147.74  
  147.75  lemma zcong_square:
  147.76 @@ -191,7 +189,7 @@
  147.77       apply (simp_all add: zdiff_zmult_distrib)
  147.78    apply (subgoal_tac "m dvd (-(a * k - b * k))")
  147.79     apply simp
  147.80 -  apply (subst zdvd_zminus_iff, assumption)
  147.81 +  apply (subst dvd_minus_iff, assumption)
  147.82    done
  147.83  
  147.84  lemma zcong_cancel2:
  147.85 @@ -206,10 +204,10 @@
  147.86    apply (subgoal_tac "m dvd n * ka")
  147.87     apply (subgoal_tac "m dvd ka")
  147.88      apply (case_tac [2] "0 \<le> ka")
  147.89 -  apply (metis zdvd_mult_div_cancel zdvd_refl zdvd_zminus2_iff zdvd_zmultD2 zgcd_zminus zmult_commute zmult_zminus zrelprime_zdvd_zmult)
  147.90 -  apply (metis IntDiv.zdvd_abs1 abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute)
  147.91 -  apply (metis abs_eq_0 int_0_neq_1 mult_le_0_iff  zdvd_mono zdvd_mult_cancel zdvd_mult_cancel1 zdvd_refl zdvd_triv_left zdvd_zmult2 zero_le_mult_iff zgcd_greatest_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult)
  147.92 -  apply (metis zdvd_triv_left)
  147.93 +  apply (metis zdvd_mult_div_cancel dvd_refl dvd_mult_left zmult_commute zrelprime_zdvd_zmult)
  147.94 +  apply (metis abs_dvd_iff abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute)
  147.95 +  apply (metis mult_le_0_iff  zdvd_mono zdvd_mult_cancel dvd_triv_left zero_le_mult_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult)
  147.96 +  apply (metis dvd_triv_left)
  147.97    done
  147.98  
  147.99  lemma zcong_zless_imp_eq:
 147.100 @@ -217,7 +215,7 @@
 147.101      a < m ==> 0 \<le> b ==> b < m ==> [a = b] (mod m) ==> a = b"
 147.102    apply (unfold zcong_def dvd_def, auto)
 147.103    apply (drule_tac f = "\<lambda>z. z mod m" in arg_cong)
 147.104 -  apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_commute zmod_eq_0_iff zmod_zadd_right_eq)
 147.105 +  apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_commute zmod_eq_0_iff mod_add_right_eq)
 147.106    done
 147.107  
 147.108  lemma zcong_square_zless:
 147.109 @@ -237,7 +235,7 @@
 147.110  lemma zcong_zless_0:
 147.111      "0 \<le> a ==> a < m ==> [a = 0] (mod m) ==> a = 0"
 147.112    apply (unfold zcong_def dvd_def, auto)
 147.113 -  apply (metis div_pos_pos_trivial linorder_not_less zdiv_zmult_self2 zle_refl zle_trans)
 147.114 +  apply (metis div_pos_pos_trivial linorder_not_less div_mult_self1_is_id)
 147.115    done
 147.116  
 147.117  lemma zcong_zless_unique:
 147.118 @@ -302,7 +300,7 @@
 147.119  
 147.120  lemma zmod_zdvd_zmod:
 147.121      "0 < (m::int) ==> m dvd b ==> (a mod b mod m) = (a mod m)"
 147.122 -  by (rule zmod_zmod_cancel) 
 147.123 +  by (rule mod_mod_cancel) 
 147.124  
 147.125  
 147.126  subsection {* Extended GCD *}
 147.127 @@ -403,7 +401,7 @@
 147.128     prefer 2
 147.129     apply simp
 147.130    apply (unfold zcong_def)
 147.131 -  apply (simp (no_asm) add: zmult_commute zdvd_zminus_iff)
 147.132 +  apply (simp (no_asm) add: zmult_commute)
 147.133    done
 147.134  
 147.135  lemma zcong_lineq_unique:
   148.1 --- a/src/HOL/NumberTheory/Quadratic_Reciprocity.thy	Wed Mar 04 10:43:39 2009 +0100
   148.2 +++ b/src/HOL/NumberTheory/Quadratic_Reciprocity.thy	Wed Mar 04 10:45:52 2009 +0100
   148.3 @@ -322,7 +322,7 @@
   148.4        by (rule zdiv_mono1) (insert p_g_2, auto)
   148.5      then show "b \<le> (q * a) div p"
   148.6        apply (subgoal_tac "p \<noteq> 0")
   148.7 -      apply (frule zdiv_zmult_self2, force)
   148.8 +      apply (frule div_mult_self1_is_id, force)
   148.9        apply (insert p_g_2, auto)
  148.10        done
  148.11    qed
  148.12 @@ -356,7 +356,7 @@
  148.13        by (rule zdiv_mono1) (insert q_g_2, auto)
  148.14      then show "a \<le> (p * b) div q"
  148.15        apply (subgoal_tac "q \<noteq> 0")
  148.16 -      apply (frule zdiv_zmult_self2, force)
  148.17 +      apply (frule div_mult_self1_is_id, force)
  148.18        apply (insert q_g_2, auto)
  148.19        done
  148.20    qed
   149.1 --- a/src/HOL/NumberTheory/Residues.thy	Wed Mar 04 10:43:39 2009 +0100
   149.2 +++ b/src/HOL/NumberTheory/Residues.thy	Wed Mar 04 10:45:52 2009 +0100
   149.3 @@ -48,7 +48,7 @@
   149.4    by (auto simp add: StandardRes_def zcong_zmod_eq)
   149.5  
   149.6  lemma StandardRes_prop3: "(~[x = 0] (mod p)) = (~(StandardRes p x = 0))"
   149.7 -  by (auto simp add: StandardRes_def zcong_def zdvd_iff_zmod_eq_0)
   149.8 +  by (auto simp add: StandardRes_def zcong_def dvd_eq_mod_eq_0)
   149.9  
  149.10  lemma StandardRes_prop4: "2 < m 
  149.11       ==> [StandardRes m x * StandardRes m y = (x * y)] (mod m)"
   150.1 --- a/src/HOL/NumberTheory/WilsonBij.thy	Wed Mar 04 10:43:39 2009 +0100
   150.2 +++ b/src/HOL/NumberTheory/WilsonBij.thy	Wed Mar 04 10:45:52 2009 +0100
   150.3 @@ -57,7 +57,7 @@
   150.4     apply (rule_tac [2] zdvd_not_zless)
   150.5      apply (subgoal_tac "p dvd 1")
   150.6       prefer 2
   150.7 -     apply (subst zdvd_zminus_iff [symmetric])
   150.8 +     apply (subst dvd_minus_iff [symmetric])
   150.9       apply auto
  150.10    done
  150.11  
  150.12 @@ -79,7 +79,7 @@
  150.13    apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2)
  150.14    apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
  150.15     apply (simp add: mult_commute)
  150.16 -  apply (subst zdvd_zminus_iff)
  150.17 +  apply (subst dvd_minus_iff)
  150.18    apply (subst zdvd_reduce)
  150.19    apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
  150.20     apply (subst zdvd_reduce)
   151.1 --- a/src/HOL/NumberTheory/WilsonRuss.thy	Wed Mar 04 10:43:39 2009 +0100
   151.2 +++ b/src/HOL/NumberTheory/WilsonRuss.thy	Wed Mar 04 10:45:52 2009 +0100
   151.3 @@ -68,7 +68,7 @@
   151.4     apply (rule_tac [2] zdvd_not_zless)
   151.5      apply (subgoal_tac "p dvd 1")
   151.6       prefer 2
   151.7 -     apply (subst zdvd_zminus_iff [symmetric], auto)
   151.8 +     apply (subst dvd_minus_iff [symmetric], auto)
   151.9    done
  151.10  
  151.11  lemma inv_not_1:
  151.12 @@ -87,7 +87,7 @@
  151.13    apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2)
  151.14    apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
  151.15     apply (simp add: mult_commute)
  151.16 -  apply (subst zdvd_zminus_iff)
  151.17 +  apply (subst dvd_minus_iff)
  151.18    apply (subst zdvd_reduce)
  151.19    apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
  151.20     apply (subst zdvd_reduce, auto)
   152.1 --- a/src/HOL/Orderings.thy	Wed Mar 04 10:43:39 2009 +0100
   152.2 +++ b/src/HOL/Orderings.thy	Wed Mar 04 10:45:52 2009 +0100
   152.3 @@ -331,7 +331,7 @@
   152.4  
   152.5  fun struct_tac ((s, [eq, le, less]), thms) prems =
   152.6    let
   152.7 -    fun decomp thy (Trueprop $ t) =
   152.8 +    fun decomp thy (@{const Trueprop} $ t) =
   152.9        let
  152.10          fun excluded t =
  152.11            (* exclude numeric types: linear arithmetic subsumes transitivity *)
  152.12 @@ -350,7 +350,8 @@
  152.13  	      of NONE => NONE
  152.14  	       | SOME (t1, rel, t2) => SOME (t1, "~" ^ rel, t2))
  152.15            | dec x = rel x;
  152.16 -      in dec t end;
  152.17 +      in dec t end
  152.18 +      | decomp thy _ = NONE;
  152.19    in
  152.20      case s of
  152.21        "order" => Order_Tac.partial_tac decomp thms prems
   153.1 --- a/src/HOL/Parity.thy	Wed Mar 04 10:43:39 2009 +0100
   153.2 +++ b/src/HOL/Parity.thy	Wed Mar 04 10:45:52 2009 +0100
   153.3 @@ -228,20 +228,9 @@
   153.4  
   153.5  lemma zero_le_odd_power: "odd n ==>
   153.6      (0 <= (x::'a::{recpower,ordered_idom}) ^ n) = (0 <= x)"
   153.7 -  apply (simp add: odd_nat_equiv_def2)
   153.8 -  apply (erule exE)
   153.9 -  apply (erule ssubst)
  153.10 -  apply (subst power_Suc)
  153.11 -  apply (subst power_add)
  153.12 -  apply (subst zero_le_mult_iff)
  153.13 -  apply auto
  153.14 -  apply (subgoal_tac "x = 0 & y > 0")
  153.15 -  apply (erule conjE, assumption)
  153.16 -  apply (subst power_eq_0_iff [symmetric])
  153.17 -  apply (subgoal_tac "0 <= x^y * x^y")
  153.18 -  apply simp
  153.19 -  apply (rule zero_le_square)+
  153.20 -  done
  153.21 +apply (auto simp: odd_nat_equiv_def2 power_Suc power_add zero_le_mult_iff)
  153.22 +apply (metis field_power_not_zero no_zero_divirors_neq0 order_antisym_conv zero_le_square)
  153.23 +done
  153.24  
  153.25  lemma zero_le_power_eq[presburger]: "(0 <= (x::'a::{recpower,ordered_idom}) ^ n) =
  153.26      (even n | (odd n & 0 <= x))"
   154.1 --- a/src/HOL/Plain.thy	Wed Mar 04 10:43:39 2009 +0100
   154.2 +++ b/src/HOL/Plain.thy	Wed Mar 04 10:45:52 2009 +0100
   154.3 @@ -1,7 +1,7 @@
   154.4  header {* Plain HOL *}
   154.5  
   154.6  theory Plain
   154.7 -imports Datatype FunDef Record Extraction Divides Fact
   154.8 +imports Datatype FunDef Record Extraction Divides
   154.9  begin
  154.10  
  154.11  text {*
   155.1 --- a/src/HOL/Power.thy	Wed Mar 04 10:43:39 2009 +0100
   155.2 +++ b/src/HOL/Power.thy	Wed Mar 04 10:45:52 2009 +0100
   155.3 @@ -31,7 +31,7 @@
   155.4    by (induct n) (simp_all add: power_Suc)
   155.5  
   155.6  lemma power_one_right [simp]: "(a::'a::recpower) ^ 1 = a"
   155.7 -  by (simp add: power_Suc)
   155.8 +  unfolding One_nat_def by (simp add: power_Suc)
   155.9  
  155.10  lemma power_commutes: "(a::'a::recpower) ^ n * a = a * a ^ n"
  155.11    by (induct n) (simp_all add: power_Suc mult_assoc)
  155.12 @@ -143,11 +143,13 @@
  155.13  done
  155.14  
  155.15  lemma power_eq_0_iff [simp]:
  155.16 -  "(a^n = 0) = (a = (0::'a::{ring_1_no_zero_divisors,recpower}) & n>0)"
  155.17 +  "(a^n = 0) \<longleftrightarrow>
  155.18 +   (a = (0::'a::{mult_zero,zero_neq_one,no_zero_divisors,recpower}) & n\<noteq>0)"
  155.19  apply (induct "n")
  155.20 -apply (auto simp add: power_Suc zero_neq_one [THEN not_sym])
  155.21 +apply (auto simp add: power_Suc zero_neq_one [THEN not_sym] no_zero_divisors)
  155.22  done
  155.23  
  155.24 +
  155.25  lemma field_power_not_zero:
  155.26    "a \<noteq> (0::'a::{ring_1_no_zero_divisors,recpower}) ==> a^n \<noteq> 0"
  155.27  by force
  155.28 @@ -324,6 +326,24 @@
  155.29    shows "\<lbrakk>a ^ n = b ^ n; 0 \<le> a; 0 \<le> b; 0 < n\<rbrakk> \<Longrightarrow> a = b"
  155.30  by (cases n, simp_all, rule power_inject_base)
  155.31  
  155.32 +text {* The divides relation *}
  155.33 +
  155.34 +lemma le_imp_power_dvd:
  155.35 +  fixes a :: "'a::{comm_semiring_1,recpower}"
  155.36 +  assumes "m \<le> n" shows "a^m dvd a^n"
  155.37 +proof
  155.38 +  have "a^n = a^(m + (n - m))"
  155.39 +    using `m \<le> n` by simp
  155.40 +  also have "\<dots> = a^m * a^(n - m)"
  155.41 +    by (rule power_add)
  155.42 +  finally show "a^n = a^m * a^(n - m)" .
  155.43 +qed
  155.44 +
  155.45 +lemma power_le_dvd:
  155.46 +  fixes a b :: "'a::{comm_semiring_1,recpower}"
  155.47 +  shows "a^n dvd b \<Longrightarrow> m \<le> n \<Longrightarrow> a^m dvd b"
  155.48 +  by (rule dvd_trans [OF le_imp_power_dvd])
  155.49 +
  155.50  
  155.51  subsection{*Exponentiation for the Natural Numbers*}
  155.52  
  155.53 @@ -346,12 +366,19 @@
  155.54    "of_nat (m ^ n) = (of_nat m::'a::{semiring_1,recpower}) ^ n"
  155.55  by (induct n, simp_all add: power_Suc of_nat_mult)
  155.56  
  155.57 -lemma nat_one_le_power [simp]: "1 \<le> i ==> Suc 0 \<le> i^n"
  155.58 -by (insert one_le_power [of i n], simp)
  155.59 +lemma nat_one_le_power [simp]: "Suc 0 \<le> i ==> Suc 0 \<le> i^n"
  155.60 +by (rule one_le_power [of i n, unfolded One_nat_def])
  155.61  
  155.62  lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
  155.63  by (induct "n", auto)
  155.64  
  155.65 +lemma nat_power_eq_Suc_0_iff [simp]: 
  155.66 +  "((x::nat)^m = Suc 0) = (m = 0 | x = Suc 0)"
  155.67 +by (induct_tac m, auto)
  155.68 +
  155.69 +lemma power_Suc_0[simp]: "(Suc 0)^n = Suc 0"
  155.70 +by simp
  155.71 +
  155.72  text{*Valid for the naturals, but what if @{text"0<i<1"}?
  155.73  Premises cannot be weakened: consider the case where @{term "i=0"},
  155.74  @{term "m=1"} and @{term "n=0"}.*}
  155.75 @@ -425,4 +452,3 @@
  155.76  *}
  155.77  
  155.78  end
  155.79 -
   156.1 --- a/src/HOL/Presburger.thy	Wed Mar 04 10:43:39 2009 +0100
   156.2 +++ b/src/HOL/Presburger.thy	Wed Mar 04 10:45:52 2009 +0100
   156.3 @@ -412,19 +412,15 @@
   156.4    "(((number_of v)::int) = (number_of w)) = iszero ((number_of (v + (uminus w)))::int)"
   156.5    by (rule eq_number_of_eq)
   156.6  
   156.7 -lemma mod_eq0_dvd_iff[presburger]: "(m::nat) mod n = 0 \<longleftrightarrow> n dvd m"
   156.8 -unfolding dvd_eq_mod_eq_0[symmetric] ..
   156.9 -
  156.10 -lemma zmod_eq0_zdvd_iff[presburger]: "(m::int) mod n = 0 \<longleftrightarrow> n dvd m"
  156.11 -unfolding zdvd_iff_zmod_eq_0[symmetric] ..
  156.12 +declare dvd_eq_mod_eq_0[symmetric, presburger]
  156.13  declare mod_1[presburger] 
  156.14  declare mod_0[presburger]
  156.15 -declare zmod_1[presburger]
  156.16 +declare mod_by_1[presburger]
  156.17  declare zmod_zero[presburger]
  156.18  declare zmod_self[presburger]
  156.19  declare mod_self[presburger]
  156.20  declare mod_by_0[presburger]
  156.21 -declare nat_mod_div_trivial[presburger]
  156.22 +declare mod_div_trivial[presburger]
  156.23  declare div_mod_equality2[presburger]
  156.24  declare div_mod_equality[presburger]
  156.25  declare mod_div_equality2[presburger]
   157.1 --- a/src/HOL/RComplete.thy	Wed Mar 04 10:43:39 2009 +0100
   157.2 +++ b/src/HOL/RComplete.thy	Wed Mar 04 10:45:52 2009 +0100
   157.3 @@ -1,8 +1,8 @@
   157.4 -(*  Title       : HOL/RComplete.thy
   157.5 -    Author      : Jacques D. Fleuriot, University of Edinburgh
   157.6 -    Author      : Larry Paulson, University of Cambridge
   157.7 -    Author      : Jeremy Avigad, Carnegie Mellon University
   157.8 -    Author      : Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen
   157.9 +(*  Title:      HOL/RComplete.thy
  157.10 +    Author:     Jacques D. Fleuriot, University of Edinburgh
  157.11 +    Author:     Larry Paulson, University of Cambridge
  157.12 +    Author:     Jeremy Avigad, Carnegie Mellon University
  157.13 +    Author:     Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen
  157.14  *)
  157.15  
  157.16  header {* Completeness of the Reals; Floor and Ceiling Functions *}
  157.17 @@ -380,33 +380,28 @@
  157.18    thus "\<exists>(n::nat). x < real n" ..
  157.19  qed
  157.20  
  157.21 +instance real :: archimedean_field
  157.22 +proof
  157.23 +  fix r :: real
  157.24 +  obtain n :: nat where "r < real n"
  157.25 +    using reals_Archimedean2 ..
  157.26 +  then have "r \<le> of_int (int n)"
  157.27 +    unfolding real_eq_of_nat by simp
  157.28 +  then show "\<exists>z. r \<le> of_int z" ..
  157.29 +qed
  157.30 +
  157.31  lemma reals_Archimedean3:
  157.32    assumes x_greater_zero: "0 < x"
  157.33    shows "\<forall>(y::real). \<exists>(n::nat). y < real n * x"
  157.34 -proof
  157.35 -  fix y
  157.36 -  have x_not_zero: "x \<noteq> 0" using x_greater_zero by simp
  157.37 -  obtain n where "y * inverse x < real (n::nat)"
  157.38 -    using reals_Archimedean2 ..
  157.39 -  hence "y * inverse x * x < real n * x"
  157.40 -    using x_greater_zero by (simp add: mult_strict_right_mono)
  157.41 -  hence "x * inverse x * y < x * real n"
  157.42 -    by (simp add: algebra_simps)
  157.43 -  hence "y < real (n::nat) * x"
  157.44 -    using x_not_zero by (simp add: algebra_simps)
  157.45 -  thus "\<exists>(n::nat). y < real n * x" ..
  157.46 -qed
  157.47 +  unfolding real_of_nat_def using `0 < x`
  157.48 +  by (auto intro: ex_less_of_nat_mult)
  157.49  
  157.50  lemma reals_Archimedean6:
  157.51       "0 \<le> r ==> \<exists>(n::nat). real (n - 1) \<le> r & r < real (n)"
  157.52 -apply (insert reals_Archimedean2 [of r], safe)
  157.53 -apply (subgoal_tac "\<exists>x::nat. r < real x \<and> (\<forall>y. r < real y \<longrightarrow> x \<le> y)", auto)
  157.54 -apply (rule_tac x = x in exI)
  157.55 -apply (case_tac x, simp)
  157.56 -apply (rename_tac x')
  157.57 -apply (drule_tac x = x' in spec, simp)
  157.58 -apply (rule_tac x="LEAST n. r < real n" in exI, safe)
  157.59 -apply (erule LeastI, erule Least_le)
  157.60 +unfolding real_of_nat_def
  157.61 +apply (rule exI [where x="nat (floor r + 1)"])
  157.62 +apply (insert floor_correct [of r])
  157.63 +apply (simp add: nat_add_distrib of_nat_nat)
  157.64  done
  157.65  
  157.66  lemma reals_Archimedean6a: "0 \<le> r ==> \<exists>n. real (n) \<le> r & r < real (Suc n)"
  157.67 @@ -414,19 +409,11 @@
  157.68  
  157.69  lemma reals_Archimedean_6b_int:
  157.70       "0 \<le> r ==> \<exists>n::int. real n \<le> r & r < real (n+1)"
  157.71 -apply (drule reals_Archimedean6a, auto)
  157.72 -apply (rule_tac x = "int n" in exI)
  157.73 -apply (simp add: real_of_int_real_of_nat real_of_nat_Suc)
  157.74 -done
  157.75 +  unfolding real_of_int_def by (rule floor_exists)
  157.76  
  157.77  lemma reals_Archimedean_6c_int:
  157.78       "r < 0 ==> \<exists>n::int. real n \<le> r & r < real (n+1)"
  157.79 -apply (rule reals_Archimedean_6b_int [of "-r", THEN exE], simp, auto)
  157.80 -apply (rename_tac n)
  157.81 -apply (drule order_le_imp_less_or_eq, auto)
  157.82 -apply (rule_tac x = "- n - 1" in exI)
  157.83 -apply (rule_tac [2] x = "- n" in exI, auto)
  157.84 -done
  157.85 +  unfolding real_of_int_def by (rule floor_exists)
  157.86  
  157.87  
  157.88  subsection{*Density of the Rational Reals in the Reals*}
  157.89 @@ -485,23 +472,6 @@
  157.90  
  157.91  subsection{*Floor and Ceiling Functions from the Reals to the Integers*}
  157.92  
  157.93 -definition
  157.94 -  floor :: "real => int" where
  157.95 -  [code del]: "floor r = (LEAST n::int. r < real (n+1))"
  157.96 -
  157.97 -definition
  157.98 -  ceiling :: "real => int" where
  157.99 -  "ceiling r = - floor (- r)"
 157.100 -
 157.101 -notation (xsymbols)
 157.102 -  floor  ("\<lfloor>_\<rfloor>") and
 157.103 -  ceiling  ("\<lceil>_\<rceil>")
 157.104 -
 157.105 -notation (HTML output)
 157.106 -  floor  ("\<lfloor>_\<rfloor>") and
 157.107 -  ceiling  ("\<lceil>_\<rceil>")
 157.108 -
 157.109 -
 157.110  lemma number_of_less_real_of_int_iff [simp]:
 157.111       "((number_of n) < real (m::int)) = (number_of n < m)"
 157.112  apply auto
 157.113 @@ -524,51 +494,23 @@
 157.114       "(real (m::int) \<le> (number_of n)) = (m \<le> number_of n)"
 157.115  by (simp add: linorder_not_less [symmetric])
 157.116  
 157.117 -lemma floor_zero [simp]: "floor 0 = 0"
 157.118 -apply (simp add: floor_def del: real_of_int_add)
 157.119 -apply (rule Least_equality)
 157.120 -apply simp_all
 157.121 -done
 157.122 -
 157.123 -lemma floor_real_of_nat_zero [simp]: "floor (real (0::nat)) = 0"
 157.124 -by auto
 157.125 +lemma floor_real_of_nat_zero: "floor (real (0::nat)) = 0"
 157.126 +by auto (* delete? *)
 157.127  
 157.128  lemma floor_real_of_nat [simp]: "floor (real (n::nat)) = int n"
 157.129 -apply (simp only: floor_def)
 157.130 -apply (rule Least_equality)
 157.131 -apply (drule_tac [2] real_of_int_of_nat_eq [THEN ssubst])
 157.132 -apply (drule_tac [2] real_of_int_less_iff [THEN iffD1])
 157.133 -apply simp_all
 157.134 -done
 157.135 +unfolding real_of_nat_def by simp
 157.136  
 157.137  lemma floor_minus_real_of_nat [simp]: "floor (- real (n::nat)) = - int n"
 157.138 -apply (simp only: floor_def)
 157.139 -apply (rule Least_equality)
 157.140 -apply (drule_tac [2] real_of_int_of_nat_eq [THEN ssubst])
 157.141 -apply (drule_tac [2] real_of_int_minus [THEN sym, THEN subst])
 157.142 -apply (drule_tac [2] real_of_int_less_iff [THEN iffD1])
 157.143 -apply simp_all
 157.144 -done
 157.145 +unfolding real_of_nat_def by (simp add: floor_minus)
 157.146  
 157.147  lemma floor_real_of_int [simp]: "floor (real (n::int)) = n"
 157.148 -apply (simp only: floor_def)
 157.149 -apply (rule Least_equality)
 157.150 -apply auto
 157.151 -done
 157.152 +unfolding real_of_int_def by simp
 157.153  
 157.154  lemma floor_minus_real_of_int [simp]: "floor (- real (n::int)) = - n"
 157.155 -apply (simp only: floor_def)
 157.156 -apply (rule Least_equality)
 157.157 -apply (drule_tac [2] real_of_int_minus [THEN sym, THEN subst])
 157.158 -apply auto
 157.159 -done
 157.160 +unfolding real_of_int_def by (simp add: floor_minus)
 157.161  
 157.162  lemma real_lb_ub_int: " \<exists>n::int. real n \<le> r & r < real (n+1)"
 157.163 -apply (case_tac "r < 0")
 157.164 -apply (blast intro: reals_Archimedean_6c_int)
 157.165 -apply (simp only: linorder_not_less)
 157.166 -apply (blast intro: reals_Archimedean_6b_int reals_Archimedean_6c_int)
 157.167 -done
 157.168 +unfolding real_of_int_def by (rule floor_exists)
 157.169  
 157.170  lemma lemma_floor:
 157.171    assumes a1: "real m \<le> r" and a2: "r < real n + 1"
 157.172 @@ -581,48 +523,20 @@
 157.173  qed
 157.174  
 157.175  lemma real_of_int_floor_le [simp]: "real (floor r) \<le> r"
 157.176 -apply (simp add: floor_def Least_def)
 157.177 -apply (insert real_lb_ub_int [of r], safe)
 157.178 -apply (rule theI2)
 157.179 -apply auto
 157.180 -done
 157.181 -
 157.182 -lemma floor_mono: "x < y ==> floor x \<le> floor y"
 157.183 -apply (simp add: floor_def Least_def)
 157.184 -apply (insert real_lb_ub_int [of x])
 157.185 -apply (insert real_lb_ub_int [of y], safe)
 157.186 -apply (rule theI2)
 157.187 -apply (rule_tac [3] theI2)
 157.188 -apply simp
 157.189 -apply (erule conjI)
 157.190 -apply (auto simp add: order_eq_iff int_le_real_less)
 157.191 -done
 157.192 -
 157.193 -lemma floor_mono2: "x \<le> y ==> floor x \<le> floor y"
 157.194 -by (auto dest: order_le_imp_less_or_eq simp add: floor_mono)
 157.195 +unfolding real_of_int_def by (rule of_int_floor_le)
 157.196  
 157.197  lemma lemma_floor2: "real n < real (x::int) + 1 ==> n \<le> x"
 157.198  by (auto intro: lemma_floor)
 157.199  
 157.200  lemma real_of_int_floor_cancel [simp]:
 157.201      "(real (floor x) = x) = (\<exists>n::int. x = real n)"
 157.202 -apply (simp add: floor_def Least_def)
 157.203 -apply (insert real_lb_ub_int [of x], erule exE)
 157.204 -apply (rule theI2)
 157.205 -apply (auto intro: lemma_floor)
 157.206 -done
 157.207 +  using floor_real_of_int by metis
 157.208  
 157.209  lemma floor_eq: "[| real n < x; x < real n + 1 |] ==> floor x = n"
 157.210 -apply (simp add: floor_def)
 157.211 -apply (rule Least_equality)
 157.212 -apply (auto intro: lemma_floor)
 157.213 -done
 157.214 +  unfolding real_of_int_def using floor_unique [of n x] by simp
 157.215  
 157.216  lemma floor_eq2: "[| real n \<le> x; x < real n + 1 |] ==> floor x = n"
 157.217 -apply (simp add: floor_def)
 157.218 -apply (rule Least_equality)
 157.219 -apply (auto intro: lemma_floor)
 157.220 -done
 157.221 +  unfolding real_of_int_def by (rule floor_unique)
 157.222  
 157.223  lemma floor_eq3: "[| real n < x; x < real (Suc n) |] ==> nat(floor x) = n"
 157.224  apply (rule inj_int [THEN injD])
 157.225 @@ -635,353 +549,205 @@
 157.226  apply (auto intro: floor_eq3)
 157.227  done
 157.228  
 157.229 -lemma floor_number_of_eq [simp]:
 157.230 +lemma floor_number_of_eq:
 157.231       "floor(number_of n :: real) = (number_of n :: int)"
 157.232 -apply (subst real_number_of [symmetric])
 157.233 -apply (rule floor_real_of_int)
 157.234 -done
 157.235 -
 157.236 -lemma floor_one [simp]: "floor 1 = 1"
 157.237 -  apply (rule trans)
 157.238 -  prefer 2
 157.239 -  apply (rule floor_real_of_int)
 157.240 -  apply simp
 157.241 -done
 157.242 +  by (rule floor_number_of) (* already declared [simp] *)
 157.243  
 157.244  lemma real_of_int_floor_ge_diff_one [simp]: "r - 1 \<le> real(floor r)"
 157.245 -apply (simp add: floor_def Least_def)
 157.246 -apply (insert real_lb_ub_int [of r], safe)
 157.247 -apply (rule theI2)
 157.248 -apply (auto intro: lemma_floor)
 157.249 -done
 157.250 +  unfolding real_of_int_def using floor_correct [of r] by simp
 157.251  
 157.252  lemma real_of_int_floor_gt_diff_one [simp]: "r - 1 < real(floor r)"
 157.253 -apply (simp add: floor_def Least_def)
 157.254 -apply (insert real_lb_ub_int [of r], safe)
 157.255 -apply (rule theI2)
 157.256 -apply (auto intro: lemma_floor)
 157.257 -done
 157.258 +  unfolding real_of_int_def using floor_correct [of r] by simp
 157.259  
 157.260  lemma real_of_int_floor_add_one_ge [simp]: "r \<le> real(floor r) + 1"
 157.261 -apply (insert real_of_int_floor_ge_diff_one [of r])
 157.262 -apply (auto simp del: real_of_int_floor_ge_diff_one)
 157.263 -done
 157.264 +  unfolding real_of_int_def using floor_correct [of r] by simp
 157.265  
 157.266  lemma real_of_int_floor_add_one_gt [simp]: "r < real(floor r) + 1"
 157.267 -apply (insert real_of_int_floor_gt_diff_one [of r])
 157.268 -apply (auto simp del: real_of_int_floor_gt_diff_one)
 157.269 -done
 157.270 +  unfolding real_of_int_def using floor_correct [of r] by simp
 157.271  
 157.272  lemma le_floor: "real a <= x ==> a <= floor x"
 157.273 -  apply (subgoal_tac "a < floor x + 1")
 157.274 -  apply arith
 157.275 -  apply (subst real_of_int_less_iff [THEN sym])
 157.276 -  apply simp
 157.277 -  apply (insert real_of_int_floor_add_one_gt [of x])
 157.278 -  apply arith
 157.279 -done
 157.280 +  unfolding real_of_int_def by (simp add: le_floor_iff)
 157.281  
 157.282  lemma real_le_floor: "a <= floor x ==> real a <= x"
 157.283 -  apply (rule order_trans)
 157.284 -  prefer 2
 157.285 -  apply (rule real_of_int_floor_le)
 157.286 -  apply (subst real_of_int_le_iff)
 157.287 -  apply assumption
 157.288 -done
 157.289 +  unfolding real_of_int_def by (simp add: le_floor_iff)
 157.290  
 157.291  lemma le_floor_eq: "(a <= floor x) = (real a <= x)"
 157.292 -  apply (rule iffI)
 157.293 -  apply (erule real_le_floor)
 157.294 -  apply (erule le_floor)
 157.295 -done
 157.296 +  unfolding real_of_int_def by (rule le_floor_iff)
 157.297  
 157.298 -lemma le_floor_eq_number_of [simp]:
 157.299 +lemma le_floor_eq_number_of:
 157.300      "(number_of n <= floor x) = (number_of n <= x)"
 157.301 -by (simp add: le_floor_eq)
 157.302 +  by (rule number_of_le_floor) (* already declared [simp] *)
 157.303  
 157.304 -lemma le_floor_eq_zero [simp]: "(0 <= floor x) = (0 <= x)"
 157.305 -by (simp add: le_floor_eq)
 157.306 +lemma le_floor_eq_zero: "(0 <= floor x) = (0 <= x)"
 157.307 +  by (rule zero_le_floor) (* already declared [simp] *)
 157.308  
 157.309 -lemma le_floor_eq_one [simp]: "(1 <= floor x) = (1 <= x)"
 157.310 -by (simp add: le_floor_eq)
 157.311 +lemma le_floor_eq_one: "(1 <= floor x) = (1 <= x)"
 157.312 +  by (rule one_le_floor) (* already declared [simp] *)
 157.313  
 157.314  lemma floor_less_eq: "(floor x < a) = (x < real a)"
 157.315 -  apply (subst linorder_not_le [THEN sym])+
 157.316 -  apply simp
 157.317 -  apply (rule le_floor_eq)
 157.318 -done
 157.319 +  unfolding real_of_int_def by (rule floor_less_iff)
 157.320  
 157.321 -lemma floor_less_eq_number_of [simp]:
 157.322 +lemma floor_less_eq_number_of:
 157.323      "(floor x < number_of n) = (x < number_of n)"
 157.324 -by (simp add: floor_less_eq)
 157.325 +  by (rule floor_less_number_of) (* already declared [simp] *)
 157.326  
 157.327 -lemma floor_less_eq_zero [simp]: "(floor x < 0) = (x < 0)"
 157.328 -by (simp add: floor_less_eq)
 157.329 +lemma floor_less_eq_zero: "(floor x < 0) = (x < 0)"
 157.330 +  by (rule floor_less_zero) (* already declared [simp] *)
 157.331  
 157.332 -lemma floor_less_eq_one [simp]: "(floor x < 1) = (x < 1)"
 157.333 -by (simp add: floor_less_eq)
 157.334 +lemma floor_less_eq_one: "(floor x < 1) = (x < 1)"
 157.335 +  by (rule floor_less_one) (* already declared [simp] *)
 157.336  
 157.337  lemma less_floor_eq: "(a < floor x) = (real a + 1 <= x)"
 157.338 -  apply (insert le_floor_eq [of "a + 1" x])
 157.339 -  apply auto
 157.340 -done
 157.341 +  unfolding real_of_int_def by (rule less_floor_iff)
 157.342  
 157.343 -lemma less_floor_eq_number_of [simp]:
 157.344 +lemma less_floor_eq_number_of:
 157.345      "(number_of n < floor x) = (number_of n + 1 <= x)"
 157.346 -by (simp add: less_floor_eq)
 157.347 +  by (rule number_of_less_floor) (* already declared [simp] *)
 157.348  
 157.349 -lemma less_floor_eq_zero [simp]: "(0 < floor x) = (1 <= x)"
 157.350 -by (simp add: less_floor_eq)
 157.351 +lemma less_floor_eq_zero: "(0 < floor x) = (1 <= x)"
 157.352 +  by (rule zero_less_floor) (* already declared [simp] *)
 157.353  
 157.354 -lemma less_floor_eq_one [simp]: "(1 < floor x) = (2 <= x)"
 157.355 -by (simp add: less_floor_eq)
 157.356 +lemma less_floor_eq_one: "(1 < floor x) = (2 <= x)"
 157.357 +  by (rule one_less_floor) (* already declared [simp] *)
 157.358  
 157.359  lemma floor_le_eq: "(floor x <= a) = (x < real a + 1)"
 157.360 -  apply (insert floor_less_eq [of x "a + 1"])
 157.361 -  apply auto
 157.362 -done
 157.363 +  unfolding real_of_int_def by (rule floor_le_iff)
 157.364  
 157.365 -lemma floor_le_eq_number_of [simp]:
 157.366 +lemma floor_le_eq_number_of:
 157.367      "(floor x <= number_of n) = (x < number_of n + 1)"
 157.368 -by (simp add: floor_le_eq)
 157.369 +  by (rule floor_le_number_of) (* already declared [simp] *)
 157.370  
 157.371 -lemma floor_le_eq_zero [simp]: "(floor x <= 0) = (x < 1)"
 157.372 -by (simp add: floor_le_eq)
 157.373 +lemma floor_le_eq_zero: "(floor x <= 0) = (x < 1)"
 157.374 +  by (rule floor_le_zero) (* already declared [simp] *)
 157.375  
 157.376 -lemma floor_le_eq_one [simp]: "(floor x <= 1) = (x < 2)"
 157.377 -by (simp add: floor_le_eq)
 157.378 +lemma floor_le_eq_one: "(floor x <= 1) = (x < 2)"
 157.379 +  by (rule floor_le_one) (* already declared [simp] *)
 157.380  
 157.381  lemma floor_add [simp]: "floor (x + real a) = floor x + a"
 157.382 -  apply (subst order_eq_iff)
 157.383 -  apply (rule conjI)
 157.384 -  prefer 2
 157.385 -  apply (subgoal_tac "floor x + a < floor (x + real a) + 1")
 157.386 -  apply arith
 157.387 -  apply (subst real_of_int_less_iff [THEN sym])
 157.388 -  apply simp
 157.389 -  apply (subgoal_tac "x + real a < real(floor(x + real a)) + 1")
 157.390 -  apply (subgoal_tac "real (floor x) <= x")
 157.391 -  apply arith
 157.392 -  apply (rule real_of_int_floor_le)
 157.393 -  apply (rule real_of_int_floor_add_one_gt)
 157.394 -  apply (subgoal_tac "floor (x + real a) < floor x + a + 1")
 157.395 -  apply arith
 157.396 -  apply (subst real_of_int_less_iff [THEN sym])
 157.397 -  apply simp
 157.398 -  apply (subgoal_tac "real(floor(x + real a)) <= x + real a")
 157.399 -  apply (subgoal_tac "x < real(floor x) + 1")
 157.400 -  apply arith
 157.401 -  apply (rule real_of_int_floor_add_one_gt)
 157.402 -  apply (rule real_of_int_floor_le)
 157.403 -done
 157.404 -
 157.405 -lemma floor_add_number_of [simp]:
 157.406 -    "floor (x + number_of n) = floor x + number_of n"
 157.407 -  apply (subst floor_add [THEN sym])
 157.408 -  apply simp
 157.409 -done
 157.410 -
 157.411 -lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
 157.412 -  apply (subst floor_add [THEN sym])
 157.413 -  apply simp
 157.414 -done
 157.415 +  unfolding real_of_int_def by (rule floor_add_of_int)
 157.416  
 157.417  lemma floor_subtract [simp]: "floor (x - real a) = floor x - a"
 157.418 -  apply (subst diff_minus)+
 157.419 -  apply (subst real_of_int_minus [THEN sym])
 157.420 -  apply (rule floor_add)
 157.421 -done
 157.422 +  unfolding real_of_int_def by (rule floor_diff_of_int)
 157.423  
 157.424 -lemma floor_subtract_number_of [simp]: "floor (x - number_of n) =
 157.425 +lemma floor_subtract_number_of: "floor (x - number_of n) =
 157.426      floor x - number_of n"
 157.427 -  apply (subst floor_subtract [THEN sym])
 157.428 -  apply simp
 157.429 -done
 157.430 +  by (rule floor_diff_number_of) (* already declared [simp] *)
 157.431  
 157.432 -lemma floor_subtract_one [simp]: "floor (x - 1) = floor x - 1"
 157.433 -  apply (subst floor_subtract [THEN sym])
 157.434 -  apply simp
 157.435 -done
 157.436 -
 157.437 -lemma ceiling_zero [simp]: "ceiling 0 = 0"
 157.438 -by (simp add: ceiling_def)
 157.439 +lemma floor_subtract_one: "floor (x - 1) = floor x - 1"
 157.440 +  by (rule floor_diff_one) (* already declared [simp] *)
 157.441  
 157.442  lemma ceiling_real_of_nat [simp]: "ceiling (real (n::nat)) = int n"
 157.443 -by (simp add: ceiling_def)
 157.444 +  unfolding real_of_nat_def by simp
 157.445  
 157.446 -lemma ceiling_real_of_nat_zero [simp]: "ceiling (real (0::nat)) = 0"
 157.447 -by auto
 157.448 +lemma ceiling_real_of_nat_zero: "ceiling (real (0::nat)) = 0"
 157.449 +by auto (* delete? *)
 157.450  
 157.451  lemma ceiling_floor [simp]: "ceiling (real (floor r)) = floor r"
 157.452 -by (simp add: ceiling_def)
 157.453 +  unfolding real_of_int_def by simp
 157.454  
 157.455  lemma floor_ceiling [simp]: "floor (real (ceiling r)) = ceiling r"
 157.456 -by (simp add: ceiling_def)
 157.457 +  unfolding real_of_int_def by simp
 157.458  
 157.459  lemma real_of_int_ceiling_ge [simp]: "r \<le> real (ceiling r)"
 157.460 -apply (simp add: ceiling_def)
 157.461 -apply (subst le_minus_iff, simp)
 157.462 -done
 157.463 +  unfolding real_of_int_def by (rule le_of_int_ceiling)
 157.464  
 157.465 -lemma ceiling_mono: "x < y ==> ceiling x \<le> ceiling y"
 157.466 -by (simp add: floor_mono ceiling_def)
 157.467 -
 157.468 -lemma ceiling_mono2: "x \<le> y ==> ceiling x \<le> ceiling y"
 157.469 -by (simp add: floor_mono2 ceiling_def)
 157.470 +lemma ceiling_real_of_int [simp]: "ceiling (real (n::int)) = n"
 157.471 +  unfolding real_of_int_def by simp
 157.472  
 157.473  lemma real_of_int_ceiling_cancel [simp]:
 157.474       "(real (ceiling x) = x) = (\<exists>n::int. x = real n)"
 157.475 -apply (auto simp add: ceiling_def)
 157.476 -apply (drule arg_cong [where f = uminus], auto)
 157.477 -apply (rule_tac x = "-n" in exI, auto)
 157.478 -done
 157.479 +  using ceiling_real_of_int by metis
 157.480  
 157.481  lemma ceiling_eq: "[| real n < x; x < real n + 1 |] ==> ceiling x = n + 1"
 157.482 -apply (simp add: ceiling_def)
 157.483 -apply (rule minus_equation_iff [THEN iffD1])
 157.484 -apply (simp add: floor_eq [where n = "-(n+1)"])
 157.485 -done
 157.486 +  unfolding real_of_int_def using ceiling_unique [of "n + 1" x] by simp
 157.487  
 157.488  lemma ceiling_eq2: "[| real n < x; x \<le> real n + 1 |] ==> ceiling x = n + 1"
 157.489 -by (simp add: ceiling_def floor_eq2 [where n = "-(n+1)"])
 157.490 +  unfolding real_of_int_def using ceiling_unique [of "n + 1" x] by simp
 157.491  
 157.492  lemma ceiling_eq3: "[| real n - 1 < x; x \<le> real n  |] ==> ceiling x = n"
 157.493 -by (simp add: ceiling_def floor_eq2 [where n = "-n"])
 157.494 +  unfolding real_of_int_def using ceiling_unique [of n x] by simp
 157.495  
 157.496 -lemma ceiling_real_of_int [simp]: "ceiling (real (n::int)) = n"
 157.497 -by (simp add: ceiling_def)
 157.498 -
 157.499 -lemma ceiling_number_of_eq [simp]:
 157.500 +lemma ceiling_number_of_eq:
 157.501       "ceiling (number_of n :: real) = (number_of n)"
 157.502 -apply (subst real_number_of [symmetric])
 157.503 -apply (rule ceiling_real_of_int)
 157.504 -done
 157.505 -
 157.506 -lemma ceiling_one [simp]: "ceiling 1 = 1"
 157.507 -  by (unfold ceiling_def, simp)
 157.508 +  by (rule ceiling_number_of) (* already declared [simp] *)
 157.509  
 157.510  lemma real_of_int_ceiling_diff_one_le [simp]: "real (ceiling r) - 1 \<le> r"
 157.511 -apply (rule neg_le_iff_le [THEN iffD1])
 157.512 -apply (simp add: ceiling_def diff_minus)
 157.513 -done
 157.514 +  unfolding real_of_int_def using ceiling_correct [of r] by simp
 157.515  
 157.516  lemma real_of_int_ceiling_le_add_one [simp]: "real (ceiling r) \<le> r + 1"
 157.517 -apply (insert real_of_int_ceiling_diff_one_le [of r])
 157.518 -apply (simp del: real_of_int_ceiling_diff_one_le)
 157.519 -done
 157.520 +  unfolding real_of_int_def using ceiling_correct [of r] by simp
 157.521  
 157.522  lemma ceiling_le: "x <= real a ==> ceiling x <= a"
 157.523 -  apply (unfold ceiling_def)
 157.524 -  apply (subgoal_tac "-a <= floor(- x)")
 157.525 -  apply simp
 157.526 -  apply (rule le_floor)
 157.527 -  apply simp
 157.528 -done
 157.529 +  unfolding real_of_int_def by (simp add: ceiling_le_iff)
 157.530  
 157.531  lemma ceiling_le_real: "ceiling x <= a ==> x <= real a"
 157.532 -  apply (unfold ceiling_def)
 157.533 -  apply (subgoal_tac "real(- a) <= - x")
 157.534 -  apply simp
 157.535 -  apply (rule real_le_floor)
 157.536 -  apply simp
 157.537 -done
 157.538 +  unfolding real_of_int_def by (simp add: ceiling_le_iff)
 157.539  
 157.540  lemma ceiling_le_eq: "(ceiling x <= a) = (x <= real a)"
 157.541 -  apply (rule iffI)
 157.542 -  apply (erule ceiling_le_real)
 157.543 -  apply (erule ceiling_le)
 157.544 -done
 157.545 +  unfolding real_of_int_def by (rule ceiling_le_iff)
 157.546  
 157.547 -lemma ceiling_le_eq_number_of [simp]:
 157.548 +lemma ceiling_le_eq_number_of:
 157.549      "(ceiling x <= number_of n) = (x <= number_of n)"
 157.550 -by (simp add: ceiling_le_eq)
 157.551 +  by (rule ceiling_le_number_of) (* already declared [simp] *)
 157.552  
 157.553 -lemma ceiling_le_zero_eq [simp]: "(ceiling x <= 0) = (x <= 0)"
 157.554 -by (simp add: ceiling_le_eq)
 157.555 +lemma ceiling_le_zero_eq: "(ceiling x <= 0) = (x <= 0)"
 157.556 +  by (rule ceiling_le_zero) (* already declared [simp] *)
 157.557  
 157.558 -lemma ceiling_le_eq_one [simp]: "(ceiling x <= 1) = (x <= 1)"
 157.559 -by (simp add: ceiling_le_eq)
 157.560 +lemma ceiling_le_eq_one: "(ceiling x <= 1) = (x <= 1)"
 157.561 +  by (rule ceiling_le_one) (* already declared [simp] *)
 157.562  
 157.563  lemma less_ceiling_eq: "(a < ceiling x) = (real a < x)"
 157.564 -  apply (subst linorder_not_le [THEN sym])+
 157.565 -  apply simp
 157.566 -  apply (rule ceiling_le_eq)
 157.567 -done
 157.568 +  unfolding real_of_int_def by (rule less_ceiling_iff)
 157.569  
 157.570 -lemma less_ceiling_eq_number_of [simp]:
 157.571 +lemma less_ceiling_eq_number_of:
 157.572      "(number_of n < ceiling x) = (number_of n < x)"
 157.573 -by (simp add: less_ceiling_eq)
 157.574 +  by (rule number_of_less_ceiling) (* already declared [simp] *)
 157.575  
 157.576 -lemma less_ceiling_eq_zero [simp]: "(0 < ceiling x) = (0 < x)"
 157.577 -by (simp add: less_ceiling_eq)
 157.578 +lemma less_ceiling_eq_zero: "(0 < ceiling x) = (0 < x)"
 157.579 +  by (rule zero_less_ceiling) (* already declared [simp] *)
 157.580  
 157.581 -lemma less_ceiling_eq_one [simp]: "(1 < ceiling x) = (1 < x)"
 157.582 -by (simp add: less_ceiling_eq)
 157.583 +lemma less_ceiling_eq_one: "(1 < ceiling x) = (1 < x)"
 157.584 +  by (rule one_less_ceiling) (* already declared [simp] *)
 157.585  
 157.586  lemma ceiling_less_eq: "(ceiling x < a) = (x <= real a - 1)"
 157.587 -  apply (insert ceiling_le_eq [of x "a - 1"])
 157.588 -  apply auto
 157.589 -done
 157.590 +  unfolding real_of_int_def by (rule ceiling_less_iff)
 157.591  
 157.592 -lemma ceiling_less_eq_number_of [simp]:
 157.593 +lemma ceiling_less_eq_number_of:
 157.594      "(ceiling x < number_of n) = (x <= number_of n - 1)"
 157.595 -by (simp add: ceiling_less_eq)
 157.596 +  by (rule ceiling_less_number_of) (* already declared [simp] *)
 157.597  
 157.598 -lemma ceiling_less_eq_zero [simp]: "(ceiling x < 0) = (x <= -1)"
 157.599 -by (simp add: ceiling_less_eq)
 157.600 +lemma ceiling_less_eq_zero: "(ceiling x < 0) = (x <= -1)"
 157.601 +  by (rule ceiling_less_zero) (* already declared [simp] *)
 157.602  
 157.603 -lemma ceiling_less_eq_one [simp]: "(ceiling x < 1) = (x <= 0)"
 157.604 -by (simp add: ceiling_less_eq)
 157.605 +lemma ceiling_less_eq_one: "(ceiling x < 1) = (x <= 0)"
 157.606 +  by (rule ceiling_less_one) (* already declared [simp] *)
 157.607  
 157.608  lemma le_ceiling_eq: "(a <= ceiling x) = (real a - 1 < x)"
 157.609 -  apply (insert less_ceiling_eq [of "a - 1" x])
 157.610 -  apply auto
 157.611 -done
 157.612 +  unfolding real_of_int_def by (rule le_ceiling_iff)
 157.613  
 157.614 -lemma le_ceiling_eq_number_of [simp]:
 157.615 +lemma le_ceiling_eq_number_of:
 157.616      "(number_of n <= ceiling x) = (number_of n - 1 < x)"
 157.617 -by (simp add: le_ceiling_eq)
 157.618 +  by (rule number_of_le_ceiling) (* already declared [simp] *)
 157.619  
 157.620 -lemma le_ceiling_eq_zero [simp]: "(0 <= ceiling x) = (-1 < x)"
 157.621 -by (simp add: le_ceiling_eq)
 157.622 +lemma le_ceiling_eq_zero: "(0 <= ceiling x) = (-1 < x)"
 157.623 +  by (rule zero_le_ceiling) (* already declared [simp] *)
 157.624  
 157.625 -lemma le_ceiling_eq_one [simp]: "(1 <= ceiling x) = (0 < x)"
 157.626 -by (simp add: le_ceiling_eq)
 157.627 +lemma le_ceiling_eq_one: "(1 <= ceiling x) = (0 < x)"
 157.628 +  by (rule one_le_ceiling) (* already declared [simp] *)
 157.629  
 157.630  lemma ceiling_add [simp]: "ceiling (x + real a) = ceiling x + a"
 157.631 -  apply (unfold ceiling_def, simp)
 157.632 -  apply (subst real_of_int_minus [THEN sym])
 157.633 -  apply (subst floor_add)
 157.634 -  apply simp
 157.635 -done
 157.636 -
 157.637 -lemma ceiling_add_number_of [simp]: "ceiling (x + number_of n) =
 157.638 -    ceiling x + number_of n"
 157.639 -  apply (subst ceiling_add [THEN sym])
 157.640 -  apply simp
 157.641 -done
 157.642 -
 157.643 -lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
 157.644 -  apply (subst ceiling_add [THEN sym])
 157.645 -  apply simp
 157.646 -done
 157.647 +  unfolding real_of_int_def by (rule ceiling_add_of_int)
 157.648  
 157.649  lemma ceiling_subtract [simp]: "ceiling (x - real a) = ceiling x - a"
 157.650 -  apply (subst diff_minus)+
 157.651 -  apply (subst real_of_int_minus [THEN sym])
 157.652 -  apply (rule ceiling_add)
 157.653 -done
 157.654 +  unfolding real_of_int_def by (rule ceiling_diff_of_int)
 157.655  
 157.656 -lemma ceiling_subtract_number_of [simp]: "ceiling (x - number_of n) =
 157.657 +lemma ceiling_subtract_number_of: "ceiling (x - number_of n) =
 157.658      ceiling x - number_of n"
 157.659 -  apply (subst ceiling_subtract [THEN sym])
 157.660 -  apply simp
 157.661 -done
 157.662 +  by (rule ceiling_diff_number_of) (* already declared [simp] *)
 157.663  
 157.664 -lemma ceiling_subtract_one [simp]: "ceiling (x - 1) = ceiling x - 1"
 157.665 -  apply (subst ceiling_subtract [THEN sym])
 157.666 -  apply simp
 157.667 -done
 157.668 +lemma ceiling_subtract_one: "ceiling (x - 1) = ceiling x - 1"
 157.669 +  by (rule ceiling_diff_one) (* already declared [simp] *)
 157.670 +
 157.671  
 157.672  subsection {* Versions for the natural numbers *}
 157.673  
 157.674 @@ -1015,7 +781,7 @@
 157.675    apply (unfold natfloor_def)
 157.676    apply (subgoal_tac "floor x <= floor 0")
 157.677    apply simp
 157.678 -  apply (erule floor_mono2)
 157.679 +  apply (erule floor_mono)
 157.680  done
 157.681  
 157.682  lemma natfloor_mono: "x <= y ==> natfloor x <= natfloor y"
 157.683 @@ -1023,7 +789,7 @@
 157.684    apply (subst natfloor_def)+
 157.685    apply (subst nat_le_eq_zle)
 157.686    apply force
 157.687 -  apply (erule floor_mono2)
 157.688 +  apply (erule floor_mono)
 157.689    apply (subst natfloor_neg)
 157.690    apply simp
 157.691    apply simp
 157.692 @@ -1144,7 +910,7 @@
 157.693    apply (subst real_nat_eq_real)
 157.694    apply (subgoal_tac "ceiling 0 <= ceiling x")
 157.695    apply simp
 157.696 -  apply (rule ceiling_mono2)
 157.697 +  apply (rule ceiling_mono)
 157.698    apply simp
 157.699    apply simp
 157.700  done
 157.701 @@ -1165,7 +931,7 @@
 157.702    apply simp
 157.703    apply (erule order_trans)
 157.704    apply simp
 157.705 -  apply (erule ceiling_mono2)
 157.706 +  apply (erule ceiling_mono)
 157.707    apply (subst natceiling_neg)
 157.708    apply simp_all
 157.709  done
 157.710 @@ -1215,7 +981,7 @@
 157.711    apply (subst eq_nat_nat_iff)
 157.712    apply (subgoal_tac "ceiling 0 <= ceiling x")
 157.713    apply simp
 157.714 -  apply (rule ceiling_mono2)
 157.715 +  apply (rule ceiling_mono)
 157.716    apply force
 157.717    apply force
 157.718    apply (rule ceiling_eq2)
 157.719 @@ -1233,7 +999,7 @@
 157.720    apply (subst nat_add_distrib)
 157.721    apply (subgoal_tac "0 = ceiling 0")
 157.722    apply (erule ssubst)
 157.723 -  apply (erule ceiling_mono2)
 157.724 +  apply (erule ceiling_mono)
 157.725    apply simp_all
 157.726  done
 157.727  
   158.1 --- a/src/HOL/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   158.2 +++ b/src/HOL/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   158.3 @@ -1,7 +1,5 @@
   158.4  (* Classical Higher-order Logic -- batteries included *)
   158.5  
   158.6 -use_thy "Main";
   158.7 -share_common_data ();
   158.8  use_thy "Complex_Main";
   158.9  
  158.10  val HOL_proofs = ! Proofterm.proofs;
   159.1 --- a/src/HOL/Rational.thy	Wed Mar 04 10:43:39 2009 +0100
   159.2 +++ b/src/HOL/Rational.thy	Wed Mar 04 10:45:52 2009 +0100
   159.3 @@ -5,7 +5,7 @@
   159.4  header {* Rational numbers *}
   159.5  
   159.6  theory Rational
   159.7 -imports GCD
   159.8 +imports GCD Archimedean_Field
   159.9  uses ("Tools/rat_arith.ML")
  159.10  begin
  159.11  
  159.12 @@ -21,8 +21,8 @@
  159.13    "(x, y) \<in> ratrel \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
  159.14    by (simp add: ratrel_def)
  159.15  
  159.16 -lemma refl_ratrel: "refl {x. snd x \<noteq> 0} ratrel"
  159.17 -  by (auto simp add: refl_def ratrel_def)
  159.18 +lemma refl_on_ratrel: "refl_on {x. snd x \<noteq> 0} ratrel"
  159.19 +  by (auto simp add: refl_on_def ratrel_def)
  159.20  
  159.21  lemma sym_ratrel: "sym ratrel"
  159.22    by (simp add: ratrel_def sym_def)
  159.23 @@ -44,7 +44,7 @@
  159.24  qed
  159.25    
  159.26  lemma equiv_ratrel: "equiv {x. snd x \<noteq> 0} ratrel"
  159.27 -  by (rule equiv.intro [OF refl_ratrel sym_ratrel trans_ratrel])
  159.28 +  by (rule equiv.intro [OF refl_on_ratrel sym_ratrel trans_ratrel])
  159.29  
  159.30  lemmas UN_ratrel = UN_equiv_class [OF equiv_ratrel]
  159.31  lemmas UN_ratrel2 = UN_equiv_class2 [OF equiv_ratrel equiv_ratrel]
  159.32 @@ -255,7 +255,6 @@
  159.33    with `b \<noteq> 0` have "a \<noteq> 0" by (simp add: Zero_rat_def eq_rat)
  159.34    with Fract `q = Fract a b` `b \<noteq> 0` show C by auto
  159.35  qed
  159.36 -  
  159.37  
  159.38  
  159.39  subsubsection {* The field of rational numbers *}
  159.40 @@ -532,8 +531,67 @@
  159.41  qed
  159.42  
  159.43  lemma zero_less_Fract_iff:
  159.44 -  "0 < b ==> (0 < Fract a b) = (0 < a)"
  159.45 -by (simp add: Zero_rat_def order_less_imp_not_eq2 zero_less_mult_iff)
  159.46 +  "0 < b \<Longrightarrow> 0 < Fract a b \<longleftrightarrow> 0 < a"
  159.47 +  by (simp add: Zero_rat_def zero_less_mult_iff)
  159.48 +
  159.49 +lemma Fract_less_zero_iff:
  159.50 +  "0 < b \<Longrightarrow> Fract a b < 0 \<longleftrightarrow> a < 0"
  159.51 +  by (simp add: Zero_rat_def mult_less_0_iff)
  159.52 +
  159.53 +lemma zero_le_Fract_iff:
  159.54 +  "0 < b \<Longrightarrow> 0 \<le> Fract a b \<longleftrightarrow> 0 \<le> a"
  159.55 +  by (simp add: Zero_rat_def zero_le_mult_iff)
  159.56 +
  159.57 +lemma Fract_le_zero_iff:
  159.58 +  "0 < b \<Longrightarrow> Fract a b \<le> 0 \<longleftrightarrow> a \<le> 0"
  159.59 +  by (simp add: Zero_rat_def mult_le_0_iff)
  159.60 +
  159.61 +lemma one_less_Fract_iff:
  159.62 +  "0 < b \<Longrightarrow> 1 < Fract a b \<longleftrightarrow> b < a"
  159.63 +  by (simp add: One_rat_def mult_less_cancel_right_disj)
  159.64 +
  159.65 +lemma Fract_less_one_iff:
  159.66 +  "0 < b \<Longrightarrow> Fract a b < 1 \<longleftrightarrow> a < b"
  159.67 +  by (simp add: One_rat_def mult_less_cancel_right_disj)
  159.68 +
  159.69 +lemma one_le_Fract_iff:
  159.70 +  "0 < b \<Longrightarrow> 1 \<le> Fract a b \<longleftrightarrow> b \<le> a"
  159.71 +  by (simp add: One_rat_def mult_le_cancel_right)
  159.72 +
  159.73 +lemma Fract_le_one_iff:
  159.74 +  "0 < b \<Longrightarrow> Fract a b \<le> 1 \<longleftrightarrow> a \<le> b"
  159.75 +  by (simp add: One_rat_def mult_le_cancel_right)
  159.76 +
  159.77 +
  159.78 +subsubsection {* Rationals are an Archimedean field *}
  159.79 +
  159.80 +lemma rat_floor_lemma:
  159.81 +  assumes "0 < b"
  159.82 +  shows "of_int (a div b) \<le> Fract a b \<and> Fract a b < of_int (a div b + 1)"
  159.83 +proof -
  159.84 +  have "Fract a b = of_int (a div b) + Fract (a mod b) b"
  159.85 +    using `0 < b` by (simp add: of_int_rat)
  159.86 +  moreover have "0 \<le> Fract (a mod b) b \<and> Fract (a mod b) b < 1"
  159.87 +    using `0 < b` by (simp add: zero_le_Fract_iff Fract_less_one_iff)
  159.88 +  ultimately show ?thesis by simp
  159.89 +qed
  159.90 +
  159.91 +instance rat :: archimedean_field
  159.92 +proof
  159.93 +  fix r :: rat
  159.94 +  show "\<exists>z. r \<le> of_int z"
  159.95 +  proof (induct r)
  159.96 +    case (Fract a b)
  159.97 +    then have "Fract a b \<le> of_int (a div b + 1)"
  159.98 +      using rat_floor_lemma [of b a] by simp
  159.99 +    then show "\<exists>z. Fract a b \<le> of_int z" ..
 159.100 +  qed
 159.101 +qed
 159.102 +
 159.103 +lemma floor_Fract:
 159.104 +  assumes "0 < b" shows "floor (Fract a b) = a div b"
 159.105 +  using rat_floor_lemma [OF `0 < b`, of a]
 159.106 +  by (simp add: floor_unique)
 159.107  
 159.108  
 159.109  subsection {* Arithmetic setup *}
   160.1 --- a/src/HOL/RealDef.thy	Wed Mar 04 10:43:39 2009 +0100
   160.2 +++ b/src/HOL/RealDef.thy	Wed Mar 04 10:45:52 2009 +0100
   160.3 @@ -94,7 +94,7 @@
   160.4  by (simp add: realrel_def)
   160.5  
   160.6  lemma equiv_realrel: "equiv UNIV realrel"
   160.7 -apply (auto simp add: equiv_def refl_def sym_def trans_def realrel_def)
   160.8 +apply (auto simp add: equiv_def refl_on_def sym_def trans_def realrel_def)
   160.9  apply (blast dest: preal_trans_lemma) 
  160.10  done
  160.11  
  160.12 @@ -655,7 +655,7 @@
  160.13      real(n div d) = real n / real d"
  160.14    apply (frule real_of_int_div_aux [of d n])
  160.15    apply simp
  160.16 -  apply (simp add: zdvd_iff_zmod_eq_0)
  160.17 +  apply (simp add: dvd_eq_mod_eq_0)
  160.18  done
  160.19  
  160.20  lemma real_of_int_div2:
  160.21 @@ -705,6 +705,9 @@
  160.22  lemma real_of_nat_zero [simp]: "real (0::nat) = 0"
  160.23  by (simp add: real_of_nat_def)
  160.24  
  160.25 +lemma real_of_nat_1 [simp]: "real (1::nat) = 1"
  160.26 +by (simp add: real_of_nat_def)
  160.27 +
  160.28  lemma real_of_nat_one [simp]: "real (Suc 0) = (1::real)"
  160.29  by (simp add: real_of_nat_def)
  160.30  
   161.1 --- a/src/HOL/RealPow.thy	Wed Mar 04 10:43:39 2009 +0100
   161.2 +++ b/src/HOL/RealPow.thy	Wed Mar 04 10:45:52 2009 +0100
   161.3 @@ -44,7 +44,8 @@
   161.4  by (insert power_decreasing [of 1 "Suc n" r], simp)
   161.5  
   161.6  lemma realpow_minus_mult [rule_format]:
   161.7 -     "0 < n --> (x::real) ^ (n - 1) * x = x ^ n" 
   161.8 +     "0 < n --> (x::real) ^ (n - 1) * x = x ^ n"
   161.9 +unfolding One_nat_def
  161.10  apply (simp split add: nat_diff_split)
  161.11  done
  161.12  
   162.1 --- a/src/HOL/RealVector.thy	Wed Mar 04 10:43:39 2009 +0100
   162.2 +++ b/src/HOL/RealVector.thy	Wed Mar 04 10:45:52 2009 +0100
   162.3 @@ -46,8 +46,10 @@
   162.4  
   162.5  locale vector_space =
   162.6    fixes scale :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b"
   162.7 -  assumes scale_right_distrib: "scale a (x + y) = scale a x + scale a y"
   162.8 -  and scale_left_distrib: "scale (a + b) x = scale a x + scale b x"
   162.9 +  assumes scale_right_distrib [algebra_simps]:
  162.10 +    "scale a (x + y) = scale a x + scale a y"
  162.11 +  and scale_left_distrib [algebra_simps]:
  162.12 +    "scale (a + b) x = scale a x + scale b x"
  162.13    and scale_scale [simp]: "scale a (scale b x) = scale (a * b) x"
  162.14    and scale_one [simp]: "scale 1 x = x"
  162.15  begin
  162.16 @@ -58,7 +60,8 @@
  162.17  
  162.18  lemma scale_zero_left [simp]: "scale 0 x = 0"
  162.19    and scale_minus_left [simp]: "scale (- a) x = - (scale a x)"
  162.20 -  and scale_left_diff_distrib: "scale (a - b) x = scale a x - scale b x"
  162.21 +  and scale_left_diff_distrib [algebra_simps]:
  162.22 +        "scale (a - b) x = scale a x - scale b x"
  162.23  proof -
  162.24    interpret s: additive "\<lambda>a. scale a x"
  162.25      proof qed (rule scale_left_distrib)
  162.26 @@ -69,7 +72,8 @@
  162.27  
  162.28  lemma scale_zero_right [simp]: "scale a 0 = 0"
  162.29    and scale_minus_right [simp]: "scale a (- x) = - (scale a x)"
  162.30 -  and scale_right_diff_distrib: "scale a (x - y) = scale a x - scale a y"
  162.31 +  and scale_right_diff_distrib [algebra_simps]:
  162.32 +        "scale a (x - y) = scale a x - scale a y"
  162.33  proof -
  162.34    interpret s: additive "\<lambda>x. scale a x"
  162.35      proof qed (rule scale_right_distrib)
  162.36 @@ -135,21 +139,11 @@
  162.37  
  162.38  end
  162.39  
  162.40 -instantiation real :: scaleR
  162.41 -begin
  162.42 -
  162.43 -definition
  162.44 -  real_scaleR_def [simp]: "scaleR a x = a * x"
  162.45 -
  162.46 -instance ..
  162.47 -
  162.48 -end
  162.49 -
  162.50  class real_vector = scaleR + ab_group_add +
  162.51    assumes scaleR_right_distrib: "scaleR a (x + y) = scaleR a x + scaleR a y"
  162.52    and scaleR_left_distrib: "scaleR (a + b) x = scaleR a x + scaleR b x"
  162.53 -  and scaleR_scaleR [simp]: "scaleR a (scaleR b x) = scaleR (a * b) x"
  162.54 -  and scaleR_one [simp]: "scaleR 1 x = x"
  162.55 +  and scaleR_scaleR: "scaleR a (scaleR b x) = scaleR (a * b) x"
  162.56 +  and scaleR_one: "scaleR 1 x = x"
  162.57  
  162.58  interpretation real_vector!:
  162.59    vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a::real_vector"
  162.60 @@ -185,15 +179,16 @@
  162.61  
  162.62  class real_field = real_div_algebra + field
  162.63  
  162.64 -instance real :: real_field
  162.65 -apply (intro_classes, unfold real_scaleR_def)
  162.66 -apply (rule right_distrib)
  162.67 -apply (rule left_distrib)
  162.68 -apply (rule mult_assoc [symmetric])
  162.69 -apply (rule mult_1_left)
  162.70 -apply (rule mult_assoc)
  162.71 -apply (rule mult_left_commute)
  162.72 -done
  162.73 +instantiation real :: real_field
  162.74 +begin
  162.75 +
  162.76 +definition
  162.77 +  real_scaleR_def [simp]: "scaleR a x = a * x"
  162.78 +
  162.79 +instance proof
  162.80 +qed (simp_all add: algebra_simps)
  162.81 +
  162.82 +end
  162.83  
  162.84  interpretation scaleR_left!: additive "(\<lambda>a. scaleR a x::'a::real_vector)"
  162.85  proof qed (rule scaleR_left_distrib)
  162.86 @@ -307,7 +302,7 @@
  162.87  
  162.88  definition
  162.89    Reals :: "'a::real_algebra_1 set" where
  162.90 -  [code del]: "Reals \<equiv> range of_real"
  162.91 +  [code del]: "Reals = range of_real"
  162.92  
  162.93  notation (xsymbols)
  162.94    Reals  ("\<real>")
  162.95 @@ -421,16 +416,6 @@
  162.96  class norm =
  162.97    fixes norm :: "'a \<Rightarrow> real"
  162.98  
  162.99 -instantiation real :: norm
 162.100 -begin
 162.101 -
 162.102 -definition
 162.103 -  real_norm_def [simp]: "norm r \<equiv> \<bar>r\<bar>"
 162.104 -
 162.105 -instance ..
 162.106 -
 162.107 -end
 162.108 -
 162.109  class sgn_div_norm = scaleR + norm + sgn +
 162.110    assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x"
 162.111  
 162.112 @@ -462,7 +447,13 @@
 162.113    thus "norm (1::'a) = 1" by simp
 162.114  qed
 162.115  
 162.116 -instance real :: real_normed_field
 162.117 +instantiation real :: real_normed_field
 162.118 +begin
 162.119 +
 162.120 +definition
 162.121 +  real_norm_def [simp]: "norm r = \<bar>r\<bar>"
 162.122 +
 162.123 +instance
 162.124  apply (intro_classes, unfold real_norm_def real_scaleR_def)
 162.125  apply (simp add: real_sgn_def)
 162.126  apply (rule abs_ge_zero)
 162.127 @@ -472,6 +463,8 @@
 162.128  apply (rule abs_mult)
 162.129  done
 162.130  
 162.131 +end
 162.132 +
 162.133  lemma norm_zero [simp]: "norm (0::'a::real_normed_vector) = 0"
 162.134  by simp
 162.135  
   163.1 --- a/src/HOL/Relation.thy	Wed Mar 04 10:43:39 2009 +0100
   163.2 +++ b/src/HOL/Relation.thy	Wed Mar 04 10:45:52 2009 +0100
   163.3 @@ -34,8 +34,8 @@
   163.4    "Id == {p. EX x. p = (x,x)}"
   163.5  
   163.6  definition
   163.7 -  diag  :: "'a set => ('a * 'a) set" where -- {* diagonal: identity over a set *}
   163.8 -  "diag A == \<Union>x\<in>A. {(x,x)}"
   163.9 +  Id_on  :: "'a set => ('a * 'a) set" where -- {* diagonal: identity over a set *}
  163.10 +  "Id_on A == \<Union>x\<in>A. {(x,x)}"
  163.11  
  163.12  definition
  163.13    Domain :: "('a * 'b) set => 'a set" where
  163.14 @@ -50,12 +50,12 @@
  163.15    "Field r == Domain r \<union> Range r"
  163.16  
  163.17  definition
  163.18 -  refl :: "['a set, ('a * 'a) set] => bool" where -- {* reflexivity over a set *}
  163.19 -  "refl A r == r \<subseteq> A \<times> A & (ALL x: A. (x,x) : r)"
  163.20 +  refl_on :: "['a set, ('a * 'a) set] => bool" where -- {* reflexivity over a set *}
  163.21 +  "refl_on A r == r \<subseteq> A \<times> A & (ALL x: A. (x,x) : r)"
  163.22  
  163.23  abbreviation
  163.24 -  reflexive :: "('a * 'a) set => bool" where -- {* reflexivity over a type *}
  163.25 -  "reflexive == refl UNIV"
  163.26 +  refl :: "('a * 'a) set => bool" where -- {* reflexivity over a type *}
  163.27 +  "refl == refl_on UNIV"
  163.28  
  163.29  definition
  163.30    sym :: "('a * 'a) set => bool" where -- {* symmetry predicate *}
  163.31 @@ -99,8 +99,8 @@
  163.32  lemma pair_in_Id_conv [iff]: "((a, b) : Id) = (a = b)"
  163.33  by (unfold Id_def) blast
  163.34  
  163.35 -lemma reflexive_Id: "reflexive Id"
  163.36 -by (simp add: refl_def)
  163.37 +lemma refl_Id: "refl Id"
  163.38 +by (simp add: refl_on_def)
  163.39  
  163.40  lemma antisym_Id: "antisym Id"
  163.41    -- {* A strange result, since @{text Id} is also symmetric. *}
  163.42 @@ -115,24 +115,24 @@
  163.43  
  163.44  subsection {* Diagonal: identity over a set *}
  163.45  
  163.46 -lemma diag_empty [simp]: "diag {} = {}"
  163.47 -by (simp add: diag_def) 
  163.48 +lemma Id_on_empty [simp]: "Id_on {} = {}"
  163.49 +by (simp add: Id_on_def) 
  163.50  
  163.51 -lemma diag_eqI: "a = b ==> a : A ==> (a, b) : diag A"
  163.52 -by (simp add: diag_def)
  163.53 +lemma Id_on_eqI: "a = b ==> a : A ==> (a, b) : Id_on A"
  163.54 +by (simp add: Id_on_def)
  163.55  
  163.56 -lemma diagI [intro!,noatp]: "a : A ==> (a, a) : diag A"
  163.57 -by (rule diag_eqI) (rule refl)
  163.58 +lemma Id_onI [intro!,noatp]: "a : A ==> (a, a) : Id_on A"
  163.59 +by (rule Id_on_eqI) (rule refl)
  163.60  
  163.61 -lemma diagE [elim!]:
  163.62 -  "c : diag A ==> (!!x. x : A ==> c = (x, x) ==> P) ==> P"
  163.63 +lemma Id_onE [elim!]:
  163.64 +  "c : Id_on A ==> (!!x. x : A ==> c = (x, x) ==> P) ==> P"
  163.65    -- {* The general elimination rule. *}
  163.66 -by (unfold diag_def) (iprover elim!: UN_E singletonE)
  163.67 +by (unfold Id_on_def) (iprover elim!: UN_E singletonE)
  163.68  
  163.69 -lemma diag_iff: "((x, y) : diag A) = (x = y & x : A)"
  163.70 +lemma Id_on_iff: "((x, y) : Id_on A) = (x = y & x : A)"
  163.71  by blast
  163.72  
  163.73 -lemma diag_subset_Times: "diag A \<subseteq> A \<times> A"
  163.74 +lemma Id_on_subset_Times: "Id_on A \<subseteq> A \<times> A"
  163.75  by blast
  163.76  
  163.77  
  163.78 @@ -184,37 +184,37 @@
  163.79  
  163.80  subsection {* Reflexivity *}
  163.81  
  163.82 -lemma reflI: "r \<subseteq> A \<times> A ==> (!!x. x : A ==> (x, x) : r) ==> refl A r"
  163.83 -by (unfold refl_def) (iprover intro!: ballI)
  163.84 +lemma refl_onI: "r \<subseteq> A \<times> A ==> (!!x. x : A ==> (x, x) : r) ==> refl_on A r"
  163.85 +by (unfold refl_on_def) (iprover intro!: ballI)
  163.86  
  163.87 -lemma reflD: "refl A r ==> a : A ==> (a, a) : r"
  163.88 -by (unfold refl_def) blast
  163.89 +lemma refl_onD: "refl_on A r ==> a : A ==> (a, a) : r"
  163.90 +by (unfold refl_on_def) blast
  163.91  
  163.92 -lemma reflD1: "refl A r ==> (x, y) : r ==> x : A"
  163.93 -by (unfold refl_def) blast
  163.94 +lemma refl_onD1: "refl_on A r ==> (x, y) : r ==> x : A"
  163.95 +by (unfold refl_on_def) blast
  163.96  
  163.97 -lemma reflD2: "refl A r ==> (x, y) : r ==> y : A"
  163.98 -by (unfold refl_def) blast
  163.99 +lemma refl_onD2: "refl_on A r ==> (x, y) : r ==> y : A"
 163.100 +by (unfold refl_on_def) blast
 163.101  
 163.102 -lemma refl_Int: "refl A r ==> refl B s ==> refl (A \<inter> B) (r \<inter> s)"
 163.103 -by (unfold refl_def) blast
 163.104 +lemma refl_on_Int: "refl_on A r ==> refl_on B s ==> refl_on (A \<inter> B) (r \<inter> s)"
 163.105 +by (unfold refl_on_def) blast
 163.106  
 163.107 -lemma refl_Un: "refl A r ==> refl B s ==> refl (A \<union> B) (r \<union> s)"
 163.108 -by (unfold refl_def) blast
 163.109 +lemma refl_on_Un: "refl_on A r ==> refl_on B s ==> refl_on (A \<union> B) (r \<union> s)"
 163.110 +by (unfold refl_on_def) blast
 163.111  
 163.112 -lemma refl_INTER:
 163.113 -  "ALL x:S. refl (A x) (r x) ==> refl (INTER S A) (INTER S r)"
 163.114 -by (unfold refl_def) fast
 163.115 +lemma refl_on_INTER:
 163.116 +  "ALL x:S. refl_on (A x) (r x) ==> refl_on (INTER S A) (INTER S r)"
 163.117 +by (unfold refl_on_def) fast
 163.118  
 163.119 -lemma refl_UNION:
 163.120 -  "ALL x:S. refl (A x) (r x) \<Longrightarrow> refl (UNION S A) (UNION S r)"
 163.121 -by (unfold refl_def) blast
 163.122 +lemma refl_on_UNION:
 163.123 +  "ALL x:S. refl_on (A x) (r x) \<Longrightarrow> refl_on (UNION S A) (UNION S r)"
 163.124 +by (unfold refl_on_def) blast
 163.125  
 163.126 -lemma refl_empty[simp]: "refl {} {}"
 163.127 -by(simp add:refl_def)
 163.128 +lemma refl_on_empty[simp]: "refl_on {} {}"
 163.129 +by(simp add:refl_on_def)
 163.130  
 163.131 -lemma refl_diag: "refl A (diag A)"
 163.132 -by (rule reflI [OF diag_subset_Times diagI])
 163.133 +lemma refl_on_Id_on: "refl_on A (Id_on A)"
 163.134 +by (rule refl_onI [OF Id_on_subset_Times Id_onI])
 163.135  
 163.136  
 163.137  subsection {* Antisymmetry *}
 163.138 @@ -232,7 +232,7 @@
 163.139  lemma antisym_empty [simp]: "antisym {}"
 163.140  by (unfold antisym_def) blast
 163.141  
 163.142 -lemma antisym_diag [simp]: "antisym (diag A)"
 163.143 +lemma antisym_Id_on [simp]: "antisym (Id_on A)"
 163.144  by (unfold antisym_def) blast
 163.145  
 163.146  
 163.147 @@ -256,7 +256,7 @@
 163.148  lemma sym_UNION: "ALL x:S. sym (r x) ==> sym (UNION S r)"
 163.149  by (fast intro: symI dest: symD)
 163.150  
 163.151 -lemma sym_diag [simp]: "sym (diag A)"
 163.152 +lemma sym_Id_on [simp]: "sym (Id_on A)"
 163.153  by (rule symI) clarify
 163.154  
 163.155  
 163.156 @@ -275,7 +275,7 @@
 163.157  lemma trans_INTER: "ALL x:S. trans (r x) ==> trans (INTER S r)"
 163.158  by (fast intro: transI elim: transD)
 163.159  
 163.160 -lemma trans_diag [simp]: "trans (diag A)"
 163.161 +lemma trans_Id_on [simp]: "trans (Id_on A)"
 163.162  by (fast intro: transI elim: transD)
 163.163  
 163.164  lemma trans_diff_Id: " trans r \<Longrightarrow> antisym r \<Longrightarrow> trans (r-Id)"
 163.165 @@ -331,11 +331,11 @@
 163.166  lemma converse_Id [simp]: "Id^-1 = Id"
 163.167  by blast
 163.168  
 163.169 -lemma converse_diag [simp]: "(diag A)^-1 = diag A"
 163.170 +lemma converse_Id_on [simp]: "(Id_on A)^-1 = Id_on A"
 163.171  by blast
 163.172  
 163.173 -lemma refl_converse [simp]: "refl A (converse r) = refl A r"
 163.174 -by (unfold refl_def) auto
 163.175 +lemma refl_on_converse [simp]: "refl_on A (converse r) = refl_on A r"
 163.176 +by (unfold refl_on_def) auto
 163.177  
 163.178  lemma sym_converse [simp]: "sym (converse r) = sym r"
 163.179  by (unfold sym_def) blast
 163.180 @@ -382,7 +382,7 @@
 163.181  lemma Domain_Id [simp]: "Domain Id = UNIV"
 163.182  by blast
 163.183  
 163.184 -lemma Domain_diag [simp]: "Domain (diag A) = A"
 163.185 +lemma Domain_Id_on [simp]: "Domain (Id_on A) = A"
 163.186  by blast
 163.187  
 163.188  lemma Domain_Un_eq: "Domain(A \<union> B) = Domain(A) \<union> Domain(B)"
 163.189 @@ -433,7 +433,7 @@
 163.190  lemma Range_Id [simp]: "Range Id = UNIV"
 163.191  by blast
 163.192  
 163.193 -lemma Range_diag [simp]: "Range (diag A) = A"
 163.194 +lemma Range_Id_on [simp]: "Range (Id_on A) = A"
 163.195  by auto
 163.196  
 163.197  lemma Range_Un_eq: "Range(A \<union> B) = Range(A) \<union> Range(B)"
 163.198 @@ -506,7 +506,7 @@
 163.199  lemma Image_Id [simp]: "Id `` A = A"
 163.200  by blast
 163.201  
 163.202 -lemma Image_diag [simp]: "diag A `` B = A \<inter> B"
 163.203 +lemma Image_Id_on [simp]: "Id_on A `` B = A \<inter> B"
 163.204  by blast
 163.205  
 163.206  lemma Image_Int_subset: "R `` (A \<inter> B) \<subseteq> R `` A \<inter> R `` B"
 163.207 @@ -571,7 +571,7 @@
 163.208  lemma single_valued_Id [simp]: "single_valued Id"
 163.209  by (unfold single_valued_def) blast
 163.210  
 163.211 -lemma single_valued_diag [simp]: "single_valued (diag A)"
 163.212 +lemma single_valued_Id_on [simp]: "single_valued (Id_on A)"
 163.213  by (unfold single_valued_def) blast
 163.214  
 163.215  
   164.1 --- a/src/HOL/Relation_Power.thy	Wed Mar 04 10:43:39 2009 +0100
   164.2 +++ b/src/HOL/Relation_Power.thy	Wed Mar 04 10:45:52 2009 +0100
   164.3 @@ -61,16 +61,16 @@
   164.4  
   164.5  lemma funpow_swap1: "f((f^n) x) = (f^n)(f x)"
   164.6  proof -
   164.7 -  have "f((f^n) x) = (f^(n+1)) x" by simp
   164.8 +  have "f((f^n) x) = (f^(n+1)) x" unfolding One_nat_def by simp
   164.9    also have "\<dots>  = (f^n o f^1) x" by (simp only: funpow_add)
  164.10 -  also have "\<dots> = (f^n)(f x)" by simp
  164.11 +  also have "\<dots> = (f^n)(f x)" unfolding One_nat_def by simp
  164.12    finally show ?thesis .
  164.13  qed
  164.14  
  164.15  lemma rel_pow_1 [simp]:
  164.16    fixes R :: "('a*'a)set"
  164.17    shows "R^1 = R"
  164.18 -  by simp
  164.19 +  unfolding One_nat_def by simp
  164.20  
  164.21  lemma rel_pow_0_I: "(x,x) : R^0"
  164.22    by simp
   165.1 --- a/src/HOL/Ring_and_Field.thy	Wed Mar 04 10:43:39 2009 +0100
   165.2 +++ b/src/HOL/Ring_and_Field.thy	Wed Mar 04 10:45:52 2009 +0100
   165.3 @@ -147,10 +147,10 @@
   165.4  lemma one_dvd [simp]: "1 dvd a"
   165.5  by (auto intro!: dvdI)
   165.6  
   165.7 -lemma dvd_mult: "a dvd c \<Longrightarrow> a dvd (b * c)"
   165.8 +lemma dvd_mult[simp]: "a dvd c \<Longrightarrow> a dvd (b * c)"
   165.9  by (auto intro!: mult_left_commute dvdI elim!: dvdE)
  165.10  
  165.11 -lemma dvd_mult2: "a dvd b \<Longrightarrow> a dvd (b * c)"
  165.12 +lemma dvd_mult2[simp]: "a dvd b \<Longrightarrow> a dvd (b * c)"
  165.13    apply (subst mult_commute)
  165.14    apply (erule dvd_mult)
  165.15    done
  165.16 @@ -162,12 +162,12 @@
  165.17  by (rule dvd_mult2) (rule dvd_refl)
  165.18  
  165.19  lemma mult_dvd_mono:
  165.20 -  assumes ab: "a dvd b"
  165.21 -    and "cd": "c dvd d"
  165.22 +  assumes "a dvd b"
  165.23 +    and "c dvd d"
  165.24    shows "a * c dvd b * d"
  165.25  proof -
  165.26 -  from ab obtain b' where "b = a * b'" ..
  165.27 -  moreover from "cd" obtain d' where "d = c * d'" ..
  165.28 +  from `a dvd b` obtain b' where "b = a * b'" ..
  165.29 +  moreover from `c dvd d` obtain d' where "d = c * d'" ..
  165.30    ultimately have "b * d = (a * c) * (b' * d')" by (simp add: mult_ac)
  165.31    then show ?thesis ..
  165.32  qed
  165.33 @@ -310,8 +310,8 @@
  165.34    then show "- x dvd y" ..
  165.35  qed
  165.36  
  165.37 -lemma dvd_diff: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
  165.38 -by (simp add: diff_minus dvd_add dvd_minus_iff)
  165.39 +lemma dvd_diff[simp]: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
  165.40 +by (simp add: diff_minus dvd_minus_iff)
  165.41  
  165.42  end
  165.43  
  165.44 @@ -384,6 +384,26 @@
  165.45    then show "a * a = b * b" by auto
  165.46  qed
  165.47  
  165.48 +lemma dvd_mult_cancel_right [simp]:
  165.49 +  "a * c dvd b * c \<longleftrightarrow> c = 0 \<or> a dvd b"
  165.50 +proof -
  165.51 +  have "a * c dvd b * c \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
  165.52 +    unfolding dvd_def by (simp add: mult_ac)
  165.53 +  also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
  165.54 +    unfolding dvd_def by simp
  165.55 +  finally show ?thesis .
  165.56 +qed
  165.57 +
  165.58 +lemma dvd_mult_cancel_left [simp]:
  165.59 +  "c * a dvd c * b \<longleftrightarrow> c = 0 \<or> a dvd b"
  165.60 +proof -
  165.61 +  have "c * a dvd c * b \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
  165.62 +    unfolding dvd_def by (simp add: mult_ac)
  165.63 +  also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
  165.64 +    unfolding dvd_def by simp
  165.65 +  finally show ?thesis .
  165.66 +qed
  165.67 +
  165.68  end
  165.69  
  165.70  class division_ring = ring_1 + inverse +
   166.1 --- a/src/HOL/SEQ.thy	Wed Mar 04 10:43:39 2009 +0100
   166.2 +++ b/src/HOL/SEQ.thy	Wed Mar 04 10:45:52 2009 +0100
   166.3 @@ -338,10 +338,10 @@
   166.4  done
   166.5  
   166.6  lemma LIMSEQ_Suc: "f ----> l \<Longrightarrow> (\<lambda>n. f (Suc n)) ----> l"
   166.7 -by (drule_tac k="1" in LIMSEQ_ignore_initial_segment, simp)
   166.8 +by (drule_tac k="Suc 0" in LIMSEQ_ignore_initial_segment, simp)
   166.9  
  166.10  lemma LIMSEQ_imp_Suc: "(\<lambda>n. f (Suc n)) ----> l \<Longrightarrow> f ----> l"
  166.11 -by (rule_tac k="1" in LIMSEQ_offset, simp)
  166.12 +by (rule_tac k="Suc 0" in LIMSEQ_offset, simp)
  166.13  
  166.14  lemma LIMSEQ_Suc_iff: "(\<lambda>n. f (Suc n)) ----> l = f ----> l"
  166.15  by (blast intro: LIMSEQ_imp_Suc LIMSEQ_Suc)
  166.16 @@ -646,8 +646,21 @@
  166.17  apply (drule LIMSEQ_minus, auto)
  166.18  done
  166.19  
  166.20 +text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
  166.21  
  166.22 -subsection {* Bounded Monotonic Sequences *}
  166.23 +lemma nat_function_unique: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
  166.24 +  unfolding Ex1_def
  166.25 +  apply (rule_tac x="nat_rec e f" in exI)
  166.26 +  apply (rule conjI)+
  166.27 +apply (rule def_nat_rec_0, simp)
  166.28 +apply (rule allI, rule def_nat_rec_Suc, simp)
  166.29 +apply (rule allI, rule impI, rule ext)
  166.30 +apply (erule conjE)
  166.31 +apply (induct_tac x)
  166.32 +apply (simp add: nat_rec_0)
  166.33 +apply (erule_tac x="n" in allE)
  166.34 +apply (simp)
  166.35 +done
  166.36  
  166.37  text{*Subsequence (alternative definition, (e.g. Hoskins)*}
  166.38  
  166.39 @@ -746,6 +759,136 @@
  166.40    qed auto
  166.41  qed
  166.42  
  166.43 +text{* for any sequence, there is a mootonic subsequence *}
  166.44 +lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
  166.45 +proof-
  166.46 +  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
  166.47 +    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
  166.48 +    from nat_function_unique[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
  166.49 +    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
  166.50 +    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
  166.51 +      using H apply - 
  166.52 +      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
  166.53 +      unfolding order_le_less by blast 
  166.54 +    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
  166.55 +    {fix n
  166.56 +      have "?P (f (Suc n)) (f n)" 
  166.57 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  166.58 +	using H apply - 
  166.59 +      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
  166.60 +      unfolding order_le_less by blast 
  166.61 +    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
  166.62 +  note fSuc = this
  166.63 +    {fix p q assume pq: "p \<ge> f q"
  166.64 +      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
  166.65 +	by (cases q, simp_all) }
  166.66 +    note pqth = this
  166.67 +    {fix q
  166.68 +      have "f (Suc q) > f q" apply (induct q) 
  166.69 +	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
  166.70 +    note fss = this
  166.71 +    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
  166.72 +    {fix a b 
  166.73 +      have "f a \<le> f (a + b)"
  166.74 +      proof(induct b)
  166.75 +	case 0 thus ?case by simp
  166.76 +      next
  166.77 +	case (Suc b)
  166.78 +	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
  166.79 +      qed}
  166.80 +    note fmon0 = this
  166.81 +    have "monoseq (\<lambda>n. s (f n))" 
  166.82 +    proof-
  166.83 +      {fix n
  166.84 +	have "s (f n) \<ge> s (f (Suc n))" 
  166.85 +	proof(cases n)
  166.86 +	  case 0
  166.87 +	  assume n0: "n = 0"
  166.88 +	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
  166.89 +	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
  166.90 +	next
  166.91 +	  case (Suc m)
  166.92 +	  assume m: "n = Suc m"
  166.93 +	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
  166.94 +	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
  166.95 +	qed}
  166.96 +      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
  166.97 +    qed
  166.98 +    with th1 have ?thesis by blast}
  166.99 +  moreover
 166.100 +  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
 166.101 +    {fix p assume p: "p \<ge> Suc N" 
 166.102 +      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
 166.103 +      have "m \<noteq> p" using m(2) by auto 
 166.104 +      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
 166.105 +    note th0 = this
 166.106 +    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
 166.107 +    from nat_function_unique[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
 166.108 +    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
 166.109 +      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
 166.110 +    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
 166.111 +      using N apply - 
 166.112 +      apply (erule allE[where x="Suc N"], clarsimp)
 166.113 +      apply (rule_tac x="m" in exI)
 166.114 +      apply auto
 166.115 +      apply (subgoal_tac "Suc N \<noteq> m")
 166.116 +      apply simp
 166.117 +      apply (rule ccontr, simp)
 166.118 +      done
 166.119 +    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
 166.120 +    {fix n
 166.121 +      have "f n > N \<and> ?P (f (Suc n)) (f n)"
 166.122 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
 166.123 +      proof (induct n)
 166.124 +	case 0 thus ?case
 166.125 +	  using f0 N apply auto 
 166.126 +	  apply (erule allE[where x="f 0"], clarsimp) 
 166.127 +	  apply (rule_tac x="m" in exI, simp)
 166.128 +	  by (subgoal_tac "f 0 \<noteq> m", auto)
 166.129 +      next
 166.130 +	case (Suc n)
 166.131 +	from Suc.hyps have Nfn: "N < f n" by blast
 166.132 +	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
 166.133 +	with Nfn have mN: "m > N" by arith
 166.134 +	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
 166.135 +	
 166.136 +	from key have th0: "f (Suc n) > N" by simp
 166.137 +	from N[rule_format, OF th0]
 166.138 +	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
 166.139 +	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
 166.140 +	hence "m' > f (Suc n)" using m'(1) by simp
 166.141 +	with key m'(2) show ?case by auto
 166.142 +      qed}
 166.143 +    note fSuc = this
 166.144 +    {fix n
 166.145 +      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
 166.146 +      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
 166.147 +    note thf = this
 166.148 +    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
 166.149 +    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
 166.150 +      apply -
 166.151 +      apply (rule disjI1)
 166.152 +      apply auto
 166.153 +      apply (rule order_less_imp_le)
 166.154 +      apply blast
 166.155 +      done
 166.156 +    then have ?thesis  using sqf by blast}
 166.157 +  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
 166.158 +qed
 166.159 +
 166.160 +lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
 166.161 +proof(induct n)
 166.162 +  case 0 thus ?case by simp
 166.163 +next
 166.164 +  case (Suc n)
 166.165 +  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
 166.166 +  have "n < f (Suc n)" by arith 
 166.167 +  thus ?case by arith
 166.168 +qed
 166.169 +
 166.170 +subsection {* Bounded Monotonic Sequences *}
 166.171 +
 166.172 +
 166.173  text{*Bounded Sequence*}
 166.174  
 166.175  lemma BseqD: "Bseq X ==> \<exists>K. 0 < K & (\<forall>n. norm (X n) \<le> K)"
   167.1 --- a/src/HOL/Series.thy	Wed Mar 04 10:43:39 2009 +0100
   167.2 +++ b/src/HOL/Series.thy	Wed Mar 04 10:45:52 2009 +0100
   167.3 @@ -312,6 +312,7 @@
   167.4    shows "\<lbrakk>summable f;
   167.5          \<forall>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
   167.6        \<Longrightarrow> setsum f {0..<k} < suminf f"
   167.7 +unfolding One_nat_def
   167.8  apply (subst suminf_split_initial_segment [where k="k"])
   167.9  apply assumption
  167.10  apply simp
  167.11 @@ -537,7 +538,7 @@
  167.12  apply (safe, subgoal_tac "\<forall>n. N < n --> f (n) = 0")
  167.13   prefer 2
  167.14   apply clarify
  167.15 - apply(erule_tac x = "n - 1" in allE)
  167.16 + apply(erule_tac x = "n - Suc 0" in allE)
  167.17   apply (simp add:diff_Suc split:nat.splits)
  167.18   apply (blast intro: norm_ratiotest_lemma)
  167.19  apply (rule_tac x = "Suc N" in exI, clarify)
   168.1 --- a/src/HOL/SetInterval.thy	Wed Mar 04 10:43:39 2009 +0100
   168.2 +++ b/src/HOL/SetInterval.thy	Wed Mar 04 10:45:52 2009 +0100
   168.3 @@ -66,10 +66,10 @@
   168.4    "@INTER_less" :: "nat => nat => 'b set => 'b set"       ("(3\<Inter> _<_./ _)" 10)
   168.5  
   168.6  syntax (xsymbols)
   168.7 -  "@UNION_le"   :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Union>(00\<^bsub>_ \<le> _\<^esub>)/ _)" 10)
   168.8 -  "@UNION_less" :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Union>(00\<^bsub>_ < _\<^esub>)/ _)" 10)
   168.9 -  "@INTER_le"   :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Inter>(00\<^bsub>_ \<le> _\<^esub>)/ _)" 10)
  168.10 -  "@INTER_less" :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Inter>(00\<^bsub>_ < _\<^esub>)/ _)" 10)
  168.11 +  "@UNION_le"   :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Union>(00_ \<le> _)/ _)" 10)
  168.12 +  "@UNION_less" :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Union>(00_ < _)/ _)" 10)
  168.13 +  "@INTER_le"   :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Inter>(00_ \<le> _)/ _)" 10)
  168.14 +  "@INTER_less" :: "nat \<Rightarrow> nat => 'b set => 'b set"       ("(3\<Inter>(00_ < _)/ _)" 10)
  168.15  
  168.16  translations
  168.17    "UN i<=n. A"  == "UN i:{..n}. A"
  168.18 @@ -352,11 +352,11 @@
  168.19  
  168.20  corollary image_Suc_atLeastAtMost[simp]:
  168.21    "Suc ` {i..j} = {Suc i..Suc j}"
  168.22 -using image_add_atLeastAtMost[where k=1] by simp
  168.23 +using image_add_atLeastAtMost[where k="Suc 0"] by simp
  168.24  
  168.25  corollary image_Suc_atLeastLessThan[simp]:
  168.26    "Suc ` {i..<j} = {Suc i..<Suc j}"
  168.27 -using image_add_atLeastLessThan[where k=1] by simp
  168.28 +using image_add_atLeastLessThan[where k="Suc 0"] by simp
  168.29  
  168.30  lemma image_add_int_atLeastLessThan:
  168.31      "(%x. x + (l::int)) ` {0..<u-l} = {l..<u}"
  168.32 @@ -556,7 +556,7 @@
  168.33  qed
  168.34  
  168.35  lemma card_less_Suc2: "0 \<notin> M \<Longrightarrow> card {k. Suc k \<in> M \<and> k < i} = card {k \<in> M. k < Suc i}"
  168.36 -apply (rule card_bij_eq [of "Suc" _ _ "\<lambda>x. x - 1"])
  168.37 +apply (rule card_bij_eq [of "Suc" _ _ "\<lambda>x. x - Suc 0"])
  168.38  apply simp
  168.39  apply fastsimp
  168.40  apply auto
  168.41 @@ -803,7 +803,7 @@
  168.42  
  168.43  lemma setsum_head_upt_Suc:
  168.44    "m < n \<Longrightarrow> setsum f {m..<n} = f m + setsum f {Suc m..<n}"
  168.45 -apply(insert setsum_head_Suc[of m "n - 1" f])
  168.46 +apply(insert setsum_head_Suc[of m "n - Suc 0" f])
  168.47  apply (simp add: atLeastLessThanSuc_atLeastAtMost[symmetric] algebra_simps)
  168.48  done
  168.49  
  168.50 @@ -835,11 +835,11 @@
  168.51  
  168.52  corollary setsum_shift_bounds_cl_Suc_ivl:
  168.53    "setsum f {Suc m..Suc n} = setsum (%i. f(Suc i)){m..n}"
  168.54 -by (simp add:setsum_shift_bounds_cl_nat_ivl[where k=1,simplified])
  168.55 +by (simp add:setsum_shift_bounds_cl_nat_ivl[where k="Suc 0", simplified])
  168.56  
  168.57  corollary setsum_shift_bounds_Suc_ivl:
  168.58    "setsum f {Suc m..<Suc n} = setsum (%i. f(Suc i)){m..<n}"
  168.59 -by (simp add:setsum_shift_bounds_nat_ivl[where k=1,simplified])
  168.60 +by (simp add:setsum_shift_bounds_nat_ivl[where k="Suc 0", simplified])
  168.61  
  168.62  lemma setsum_shift_lb_Suc0_0:
  168.63    "f(0::nat) = (0::nat) \<Longrightarrow> setsum f {Suc 0..k} = setsum f {0..k}"
  168.64 @@ -883,6 +883,7 @@
  168.65      by (rule setsum_addf)
  168.66    also from ngt1 have "\<dots> = ?n*a + (\<Sum>i\<in>{..<n}. ?I i*d)" by simp
  168.67    also from ngt1 have "\<dots> = (?n*a + d*(\<Sum>i\<in>{1..<n}. ?I i))"
  168.68 +    unfolding One_nat_def
  168.69      by (simp add: setsum_right_distrib atLeast0LessThan[symmetric] setsum_shift_lb_Suc0_0_upt mult_ac)
  168.70    also have "(1+1)*\<dots> = (1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..<n}. ?I i)"
  168.71      by (simp add: left_distrib right_distrib)
  168.72 @@ -890,7 +891,7 @@
  168.73      by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost)
  168.74    also from ngt1
  168.75    have "(1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..n - 1}. ?I i) = ((1+1)*?n*a + d*?I (n - 1)*?I n)"
  168.76 -    by (simp only: mult_ac gauss_sum [of "n - 1"])
  168.77 +    by (simp only: mult_ac gauss_sum [of "n - 1"], unfold One_nat_def)
  168.78         (simp add:  mult_ac trans [OF add_commute of_nat_Suc [symmetric]])
  168.79    finally show ?thesis by (simp add: algebra_simps)
  168.80  next
  168.81 @@ -906,7 +907,8 @@
  168.82      "((1::nat) + 1) * (\<Sum>i\<in>{..<n::nat}. a + of_nat(i)*d) =
  168.83      of_nat(n) * (a + (a + of_nat(n - 1)*d))"
  168.84      by (rule arith_series_general)
  168.85 -  thus ?thesis by (auto simp add: of_nat_id)
  168.86 +  thus ?thesis
  168.87 +    unfolding One_nat_def by (auto simp add: of_nat_id)
  168.88  qed
  168.89  
  168.90  lemma arith_series_int:
  168.91 @@ -946,4 +948,37 @@
  168.92    show ?case by simp
  168.93  qed
  168.94  
  168.95 +subsection {* Products indexed over intervals *}
  168.96 +
  168.97 +syntax
  168.98 +  "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _ = _.._./ _)" [0,0,0,10] 10)
  168.99 +  "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _ = _..<_./ _)" [0,0,0,10] 10)
 168.100 +  "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _<_./ _)" [0,0,10] 10)
 168.101 +  "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _<=_./ _)" [0,0,10] 10)
 168.102 +syntax (xsymbols)
 168.103 +  "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
 168.104 +  "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
 168.105 +  "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_<_./ _)" [0,0,10] 10)
 168.106 +  "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
 168.107 +syntax (HTML output)
 168.108 +  "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
 168.109 +  "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
 168.110 +  "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_<_./ _)" [0,0,10] 10)
 168.111 +  "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
 168.112 +syntax (latex_prod output)
 168.113 +  "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
 168.114 + ("(3\<^raw:$\prod_{>_ = _\<^raw:}^{>_\<^raw:}$> _)" [0,0,0,10] 10)
 168.115 +  "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
 168.116 + ("(3\<^raw:$\prod_{>_ = _\<^raw:}^{<>_\<^raw:}$> _)" [0,0,0,10] 10)
 168.117 +  "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
 168.118 + ("(3\<^raw:$\prod_{>_ < _\<^raw:}$> _)" [0,0,10] 10)
 168.119 +  "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
 168.120 + ("(3\<^raw:$\prod_{>_ \<le> _\<^raw:}$> _)" [0,0,10] 10)
 168.121 +
 168.122 +translations
 168.123 +  "\<Prod>x=a..b. t" == "CONST setprod (%x. t) {a..b}"
 168.124 +  "\<Prod>x=a..<b. t" == "CONST setprod (%x. t) {a..<b}"
 168.125 +  "\<Prod>i\<le>n. t" == "CONST setprod (\<lambda>i. t) {..n}"
 168.126 +  "\<Prod>i<n. t" == "CONST setprod (\<lambda>i. t) {..<n}"
 168.127 +
 168.128  end
   169.1 --- a/src/HOL/Tools/Qelim/langford.ML	Wed Mar 04 10:43:39 2009 +0100
   169.2 +++ b/src/HOL/Tools/Qelim/langford.ML	Wed Mar 04 10:45:52 2009 +0100
   169.3 @@ -113,11 +113,6 @@
   169.4    val eqI = instantiate' [] [SOME ll, SOME rr] @{thm iffI}
   169.5   in implies_elim (implies_elim eqI thl) thr |> mk_meta_eq end;
   169.6  
   169.7 -fun partition f [] = ([],[])
   169.8 -  | partition f (x::xs) = 
   169.9 -      let val (yes,no) = partition f xs 
  169.10 -      in if f x then (x::yes,no) else (yes, x::no) end;
  169.11 -
  169.12  fun contains x ct = member (op aconv) (OldTerm.term_frees (term_of ct)) (term_of x);
  169.13  
  169.14  fun is_eqx x eq = case term_of eq of
  169.15 @@ -132,11 +127,11 @@
  169.16      val e = Thm.dest_fun ct
  169.17      val (x,p) = Thm.dest_abs (SOME xn) (Thm.dest_arg ct)
  169.18      val Pp = Thm.capply @{cterm "Trueprop"} p 
  169.19 -    val (eqs,neqs) = partition (is_eqx x) (all_conjuncts p)
  169.20 +    val (eqs,neqs) = List.partition (is_eqx x) (all_conjuncts p)
  169.21     in case eqs of
  169.22        [] => 
  169.23          let 
  169.24 -         val (dx,ndx) = partition (contains x) neqs
  169.25 +         val (dx,ndx) = List.partition (contains x) neqs
  169.26           in case ndx of [] => NONE
  169.27                        | _ =>
  169.28              conj_aci_rule (Thm.mk_binop @{cterm "op == :: prop => _"} Pp 
   170.1 --- a/src/HOL/Tools/Qelim/presburger.ML	Wed Mar 04 10:43:39 2009 +0100
   170.2 +++ b/src/HOL/Tools/Qelim/presburger.ML	Wed Mar 04 10:45:52 2009 +0100
   170.3 @@ -122,14 +122,13 @@
   170.4    addcongs [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
   170.5  val div_mod_ss = HOL_basic_ss addsimps simp_thms 
   170.6    @ map (symmetric o mk_meta_eq) 
   170.7 -    [@{thm "dvd_eq_mod_eq_0"}, @{thm "zdvd_iff_zmod_eq_0"}, @{thm "mod_add1_eq"}, 
   170.8 +    [@{thm "dvd_eq_mod_eq_0"},
   170.9       @{thm "mod_add_left_eq"}, @{thm "mod_add_right_eq"}, 
  170.10 -     @{thm "mod_add_eq"}, @{thm "zmod_zadd_left_eq"}, 
  170.11 -     @{thm "zmod_zadd_right_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
  170.12 +     @{thm "mod_add_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
  170.13    @ [@{thm "mod_self"}, @{thm "zmod_self"}, @{thm "mod_by_0"}, 
  170.14       @{thm "div_by_0"}, @{thm "DIVISION_BY_ZERO"} RS conjunct1, 
  170.15       @{thm "DIVISION_BY_ZERO"} RS conjunct2, @{thm "zdiv_zero"}, @{thm "zmod_zero"}, 
  170.16 -     @{thm "div_0"}, @{thm "mod_0"}, @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, 
  170.17 +     @{thm "div_0"}, @{thm "mod_0"}, @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, 
  170.18       @{thm "mod_1"}, @{thm "Suc_plus1"}]
  170.19    @ @{thms add_ac}
  170.20   addsimprocs [cancel_div_mod_proc]
  170.21 @@ -170,14 +169,14 @@
  170.22    THEN_ALL_NEW simp_tac ss
  170.23    THEN_ALL_NEW (TRY o generalize_tac (int_nat_terms ctxt))
  170.24    THEN_ALL_NEW ObjectLogic.full_atomize_tac
  170.25 -  THEN_ALL_NEW (TRY o thin_prems_tac (is_relevant ctxt))
  170.26 +  THEN_ALL_NEW (thin_prems_tac (is_relevant ctxt))
  170.27    THEN_ALL_NEW ObjectLogic.full_atomize_tac
  170.28    THEN_ALL_NEW div_mod_tac ctxt
  170.29    THEN_ALL_NEW splits_tac ctxt
  170.30    THEN_ALL_NEW simp_tac ss
  170.31    THEN_ALL_NEW CONVERSION Thm.eta_long_conversion
  170.32    THEN_ALL_NEW nat_to_int_tac ctxt
  170.33 -  THEN_ALL_NEW core_cooper_tac ctxt
  170.34 +  THEN_ALL_NEW (core_cooper_tac ctxt)
  170.35    THEN_ALL_NEW finish_tac elim
  170.36  end;
  170.37  
   171.1 --- a/src/HOL/Tools/TFL/post.ML	Wed Mar 04 10:43:39 2009 +0100
   171.2 +++ b/src/HOL/Tools/TFL/post.ML	Wed Mar 04 10:45:52 2009 +0100
   171.3 @@ -1,5 +1,4 @@
   171.4  (*  Title:      HOL/Tools/TFL/post.ML
   171.5 -    ID:         $Id$
   171.6      Author:     Konrad Slind, Cambridge University Computer Laboratory
   171.7      Copyright   1997  University of Cambridge
   171.8  
   171.9 @@ -31,7 +30,7 @@
  171.10   *--------------------------------------------------------------------------*)
  171.11  fun termination_goals rules =
  171.12      map (Type.freeze o HOLogic.dest_Trueprop)
  171.13 -      (foldr (fn (th,A) => gen_union (op aconv) (prems_of th, A)) [] rules);
  171.14 +      (List.foldr (fn (th,A) => gen_union (op aconv) (prems_of th, A)) [] rules);
  171.15  
  171.16  (*---------------------------------------------------------------------------
  171.17   * Finds the termination conditions in (highly massaged) definition and
   172.1 --- a/src/HOL/Tools/TFL/rules.ML	Wed Mar 04 10:43:39 2009 +0100
   172.2 +++ b/src/HOL/Tools/TFL/rules.ML	Wed Mar 04 10:45:52 2009 +0100
   172.3 @@ -131,7 +131,7 @@
   172.4  
   172.5  fun FILTER_DISCH_ALL P thm =
   172.6   let fun check tm = P (#t (Thm.rep_cterm tm))
   172.7 - in  foldr (fn (tm,th) => if check tm then DISCH tm th else th)
   172.8 + in  List.foldr (fn (tm,th) => if check tm then DISCH tm th else th)
   172.9                thm (chyps thm)
  172.10   end;
  172.11  
   173.1 --- a/src/HOL/Tools/TFL/tfl.ML	Wed Mar 04 10:43:39 2009 +0100
   173.2 +++ b/src/HOL/Tools/TFL/tfl.ML	Wed Mar 04 10:45:52 2009 +0100
   173.3 @@ -330,7 +330,7 @@
   173.4       val dummy = map (no_repeat_vars thy) pats
   173.5       val rows = ListPair.zip (map (fn x => ([]:term list,[x])) pats,
   173.6                                map (fn (t,i) => (t,(i,true))) (enumerate R))
   173.7 -     val names = foldr OldTerm.add_term_names [] R
   173.8 +     val names = List.foldr OldTerm.add_term_names [] R
   173.9       val atype = type_of(hd pats)
  173.10       and aname = Name.variant names "a"
  173.11       val a = Free(aname,atype)
  173.12 @@ -492,7 +492,7 @@
  173.13       val tych = Thry.typecheck thy
  173.14       val WFREC_THM0 = R.ISPEC (tych functional) Thms.WFREC_COROLLARY
  173.15       val Const("All",_) $ Abs(Rname,Rtype,_) = concl WFREC_THM0
  173.16 -     val R = Free (Name.variant (foldr OldTerm.add_term_names [] eqns) Rname,
  173.17 +     val R = Free (Name.variant (List.foldr OldTerm.add_term_names [] eqns) Rname,
  173.18                     Rtype)
  173.19       val WFREC_THM = R.ISPECL [tych R, tych g] WFREC_THM0
  173.20       val ([proto_def, WFR],_) = S.strip_imp(concl WFREC_THM)
  173.21 @@ -533,7 +533,7 @@
  173.22                         Display.prths extractants;
  173.23                         ())
  173.24                   else ()
  173.25 -     val TCs = foldr (gen_union (op aconv)) [] TCl
  173.26 +     val TCs = List.foldr (gen_union (op aconv)) [] TCl
  173.27       val full_rqt = WFR::TCs
  173.28       val R' = S.mk_select{Bvar=R1, Body=S.list_mk_conj full_rqt}
  173.29       val R'abs = S.rand R'
  173.30 @@ -690,7 +690,7 @@
  173.31   let val tych = Thry.typecheck thy
  173.32       val ty_info = Thry.induct_info thy
  173.33   in fn pats =>
  173.34 - let val names = foldr OldTerm.add_term_names [] pats
  173.35 + let val names = List.foldr OldTerm.add_term_names [] pats
  173.36       val T = type_of (hd pats)
  173.37       val aname = Name.variant names "a"
  173.38       val vname = Name.variant (aname::names) "v"
  173.39 @@ -843,7 +843,7 @@
  173.40      val (pats,TCsl) = ListPair.unzip pat_TCs_list
  173.41      val case_thm = complete_cases thy pats
  173.42      val domain = (type_of o hd) pats
  173.43 -    val Pname = Name.variant (foldr (Library.foldr OldTerm.add_term_names)
  173.44 +    val Pname = Name.variant (List.foldr (Library.foldr OldTerm.add_term_names)
  173.45                                [] (pats::TCsl)) "P"
  173.46      val P = Free(Pname, domain --> HOLogic.boolT)
  173.47      val Sinduct = R.SPEC (tych P) Sinduction
  173.48 @@ -854,7 +854,7 @@
  173.49      val cases = map (fn pat => Term.betapply (Sinduct_assumf, pat)) pats
  173.50      val tasks = U.zip3 cases TCl' (R.CONJUNCTS Rinduct_assum)
  173.51      val proved_cases = map (prove_case fconst thy) tasks
  173.52 -    val v = Free (Name.variant (foldr OldTerm.add_term_names [] (map concl proved_cases))
  173.53 +    val v = Free (Name.variant (List.foldr OldTerm.add_term_names [] (map concl proved_cases))
  173.54                      "v",
  173.55                    domain)
  173.56      val vtyped = tych v
   174.1 --- a/src/HOL/Tools/atp_wrapper.ML	Wed Mar 04 10:43:39 2009 +0100
   174.2 +++ b/src/HOL/Tools/atp_wrapper.ML	Wed Mar 04 10:45:52 2009 +0100
   174.3 @@ -78,10 +78,14 @@
   174.4      val failure = find_failure proof
   174.5      val success = rc = 0 andalso is_none failure
   174.6      val message =
   174.7 -      if isSome failure then "Could not prove: " ^ the failure
   174.8 -      else if rc <> 0
   174.9 -      then "Exited with return code " ^ string_of_int rc ^ ": " ^ proof 
  174.10 -      else "Try this command: " ^ produce_answer (proof, thm_names, ctxt, goal, subgoalno)
  174.11 +      if success then "Try this command: " ^ produce_answer (proof, thm_names, ctxt, goal, subgoalno)
  174.12 +      else "Could not prove goal."
  174.13 +    val _ = if isSome failure
  174.14 +      then Output.debug (fn () => "Sledgehammer failure: " ^ the failure ^ "\nOutput: " ^ proof)
  174.15 +      else ()
  174.16 +    val _ = if rc <> 0
  174.17 +      then Output.debug (fn () => "Sledgehammer exited with return code " ^ string_of_int rc ^ ":\n" ^ proof)
  174.18 +      else ()
  174.19    in (success, message) end;
  174.20  
  174.21  
  174.22 @@ -92,7 +96,7 @@
  174.23  
  174.24  fun tptp_prover_opts_full max_new theory_const full command =
  174.25    external_prover
  174.26 -    (ResAtp.write_problem_files ResHolClause.tptp_write_file max_new theory_const)
  174.27 +    (ResAtp.write_problem_files false max_new theory_const)
  174.28      command
  174.29      ResReconstruct.find_failure_e_vamp_spass
  174.30      (if full then ResReconstruct.structured_proof else ResReconstruct.lemma_list_tstp);
  174.31 @@ -149,7 +153,7 @@
  174.32  (* SPASS *)
  174.33  
  174.34  fun spass_opts max_new theory_const = external_prover
  174.35 -  (ResAtp.write_problem_files ResHolClause.dfg_write_file max_new theory_const)
  174.36 +  (ResAtp.write_problem_files true max_new theory_const)
  174.37    (Path.explode "$SPASS_HOME/SPASS", "-Auto -SOS=1 -PGiven=0 -PProblem=0 -Splits=0 -FullRed=0 -DocProof")
  174.38    ResReconstruct.find_failure_e_vamp_spass
  174.39    ResReconstruct.lemma_list_dfg;
   175.1 --- a/src/HOL/Tools/datatype_abs_proofs.ML	Wed Mar 04 10:43:39 2009 +0100
   175.2 +++ b/src/HOL/Tools/datatype_abs_proofs.ML	Wed Mar 04 10:45:52 2009 +0100
   175.3 @@ -96,7 +96,7 @@
   175.4  
   175.5      val descr' = List.concat descr;
   175.6      val recTs = get_rec_types descr' sorts;
   175.7 -    val used = foldr OldTerm.add_typ_tfree_names [] recTs;
   175.8 +    val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
   175.9      val newTs = Library.take (length (hd descr), recTs);
  175.10  
  175.11      val induct_Ps = map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of induct)));
  175.12 @@ -140,7 +140,7 @@
  175.13            end;
  175.14  
  175.15          val Ts = map (typ_of_dtyp descr' sorts) cargs;
  175.16 -        val (_, _, prems, t1s, t2s) = foldr mk_prem (1, 1, [], [], []) (cargs ~~ Ts)
  175.17 +        val (_, _, prems, t1s, t2s) = List.foldr mk_prem (1, 1, [], [], []) (cargs ~~ Ts)
  175.18  
  175.19        in (rec_intr_ts @ [Logic.list_implies (prems, HOLogic.mk_Trueprop
  175.20          (rec_set $ list_comb (Const (cname, Ts ---> T), t1s) $
  175.21 @@ -280,7 +280,7 @@
  175.22  
  175.23      val descr' = List.concat descr;
  175.24      val recTs = get_rec_types descr' sorts;
  175.25 -    val used = foldr OldTerm.add_typ_tfree_names [] recTs;
  175.26 +    val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
  175.27      val newTs = Library.take (length (hd descr), recTs);
  175.28      val T' = TFree (Name.variant used "'t", HOLogic.typeS);
  175.29  
   176.1 --- a/src/HOL/Tools/datatype_aux.ML	Wed Mar 04 10:43:39 2009 +0100
   176.2 +++ b/src/HOL/Tools/datatype_aux.ML	Wed Mar 04 10:45:52 2009 +0100
   176.3 @@ -155,7 +155,7 @@
   176.4      val prem' = hd (prems_of exhaustion);
   176.5      val _ $ (_ $ lhs $ _) = hd (rev (Logic.strip_assums_hyp prem'));
   176.6      val exhaustion' = cterm_instantiate [(cterm_of thy (head_of lhs),
   176.7 -      cterm_of thy (foldr (fn ((_, T), t) => Abs ("z", T, t))
   176.8 +      cterm_of thy (List.foldr (fn ((_, T), t) => Abs ("z", T, t))
   176.9          (Bound 0) params))] exhaustion
  176.10    in compose_tac (false, exhaustion', nprems_of exhaustion) i state
  176.11    end;
   177.1 --- a/src/HOL/Tools/datatype_codegen.ML	Wed Mar 04 10:43:39 2009 +0100
   177.2 +++ b/src/HOL/Tools/datatype_codegen.ML	Wed Mar 04 10:45:52 2009 +0100
   177.3 @@ -6,8 +6,8 @@
   177.4  
   177.5  signature DATATYPE_CODEGEN =
   177.6  sig
   177.7 -  val get_eq: theory -> string -> thm list
   177.8 -  val get_case_cert: theory -> string -> thm
   177.9 +  val mk_eq: theory -> string -> thm list
  177.10 +  val mk_case_cert: theory -> string -> thm
  177.11    val setup: theory -> theory
  177.12  end;
  177.13  
  177.14 @@ -85,7 +85,7 @@
  177.15              val dts' = map (DatatypeAux.typ_of_dtyp descr sorts) dts;
  177.16              val T = Type (tname, dts');
  177.17              val rest = mk_term_of_def gr "and " xs;
  177.18 -            val (_, eqs) = foldl_map (fn (prfx, (cname, Ts)) =>
  177.19 +            val (_, eqs) = Library.foldl_map (fn (prfx, (cname, Ts)) =>
  177.20                let val args = map (fn i =>
  177.21                  str ("x" ^ string_of_int i)) (1 upto length Ts)
  177.22                in ("  | ", Pretty.blk (4,
  177.23 @@ -216,8 +216,8 @@
  177.24        let
  177.25          val ts1 = Library.take (i, ts);
  177.26          val t :: ts2 = Library.drop (i, ts);
  177.27 -        val names = foldr OldTerm.add_term_names
  177.28 -          (map (fst o fst o dest_Var) (foldr OldTerm.add_term_vars [] ts1)) ts1;
  177.29 +        val names = List.foldr OldTerm.add_term_names
  177.30 +          (map (fst o fst o dest_Var) (List.foldr OldTerm.add_term_vars [] ts1)) ts1;
  177.31          val (Ts, dT) = split_last (Library.take (i+1, fst (strip_type T)));
  177.32  
  177.33          fun pcase [] [] [] gr = ([], gr)
  177.34 @@ -323,7 +323,7 @@
  177.35  
  177.36  (* case certificates *)
  177.37  
  177.38 -fun get_case_cert thy tyco =
  177.39 +fun mk_case_cert thy tyco =
  177.40    let
  177.41      val raw_thms =
  177.42        (#case_rewrites o DatatypePackage.the_datatype thy) tyco;
  177.43 @@ -357,10 +357,13 @@
  177.44  fun add_datatype_cases dtco thy =
  177.45    let
  177.46      val {case_rewrites, ...} = DatatypePackage.the_datatype thy dtco;
  177.47 -    val certs = get_case_cert thy dtco;
  177.48 +    val cert = mk_case_cert thy dtco;
  177.49 +    fun add_case_liberal thy = thy
  177.50 +      |> try (Code.add_case cert)
  177.51 +      |> the_default thy;
  177.52    in
  177.53      thy
  177.54 -    |> Code.add_case certs
  177.55 +    |> add_case_liberal
  177.56      |> fold_rev Code.add_default_eqn case_rewrites
  177.57    end;
  177.58  
  177.59 @@ -369,10 +372,10 @@
  177.60  
  177.61  local
  177.62  
  177.63 -val not_sym = thm "HOL.not_sym";
  177.64 -val not_false_true = iffD2 OF [nth (thms "HOL.simp_thms") 7, TrueI];
  177.65 -val refl = thm "refl";
  177.66 -val eqTrueI = thm "eqTrueI";
  177.67 +val not_sym = @{thm HOL.not_sym};
  177.68 +val not_false_true = iffD2 OF [nth @{thms HOL.simp_thms} 7, TrueI];
  177.69 +val refl = @{thm refl};
  177.70 +val eqTrueI = @{thm eqTrueI};
  177.71  
  177.72  fun mk_distinct cos =
  177.73    let
  177.74 @@ -397,7 +400,7 @@
  177.75  
  177.76  in
  177.77  
  177.78 -fun get_eq thy dtco =
  177.79 +fun mk_eq thy dtco =
  177.80    let
  177.81      val (vs, cs) = DatatypePackage.the_datatype_spec thy dtco;
  177.82      fun mk_triv_inject co =
  177.83 @@ -445,7 +448,7 @@
  177.84        in (thm', lthy') end;
  177.85      fun tac thms = Class.intro_classes_tac []
  177.86        THEN ALLGOALS (ProofContext.fact_tac thms);
  177.87 -    fun get_eq' thy dtco = get_eq thy dtco
  177.88 +    fun mk_eq' thy dtco = mk_eq thy dtco
  177.89        |> map (Code_Unit.constrain_thm thy [HOLogic.class_eq])
  177.90        |> map Simpdata.mk_eq
  177.91        |> map (MetaSimplifier.rewrite_rule [Thm.transfer thy @{thm equals_eq}])
  177.92 @@ -460,10 +463,10 @@
  177.93                ([pairself (Thm.ctyp_of thy) (TVar (("'a", 0), @{sort eq}), Logic.varifyT ty)], [])
  177.94            |> Simpdata.mk_eq
  177.95            |> AxClass.unoverload thy;
  177.96 -        fun get_thms () = (eq_refl, false)
  177.97 -          :: rev (map (rpair true) (get_eq' (Theory.deref thy_ref) dtco));
  177.98 +        fun mk_thms () = (eq_refl, false)
  177.99 +          :: rev (map (rpair true) (mk_eq' (Theory.deref thy_ref) dtco));
 177.100        in
 177.101 -        Code.add_eqnl (const, Lazy.lazy get_thms) thy
 177.102 +        Code.add_eqnl (const, Lazy.lazy mk_thms) thy
 177.103        end;
 177.104    in
 177.105      thy
   178.1 --- a/src/HOL/Tools/datatype_package.ML	Wed Mar 04 10:43:39 2009 +0100
   178.2 +++ b/src/HOL/Tools/datatype_package.ML	Wed Mar 04 10:45:52 2009 +0100
   178.3 @@ -631,8 +631,8 @@
   178.4  
   178.5  local
   178.6  
   178.7 -val sym_datatype = Pretty.str "\\isacommand{datatype}";
   178.8 -val sym_binder = Pretty.str "\\ {\\isacharequal}";
   178.9 +val sym_datatype = Pretty.command "datatype";
  178.10 +val sym_binder = Pretty.str "\\ {\\isacharequal}"; (*FIXME use proper symbol*)
  178.11  val sym_sep = Pretty.str "{\\isacharbar}\\ ";
  178.12  
  178.13  in
  178.14 @@ -659,7 +659,7 @@
  178.15        | pretty_constr (co, [ty']) =
  178.16            (Pretty.block o Pretty.breaks)
  178.17              [Syntax.pretty_term ctxt (Const (co, ty' --> ty)),
  178.18 -              Syntax.pretty_typ ctxt ty']
  178.19 +              pretty_typ_br ty']
  178.20        | pretty_constr (co, tys) =
  178.21            (Pretty.block o Pretty.breaks)
  178.22              (Syntax.pretty_term ctxt (Const (co, tys ---> ty)) ::
   179.1 --- a/src/HOL/Tools/datatype_prop.ML	Wed Mar 04 10:43:39 2009 +0100
   179.2 +++ b/src/HOL/Tools/datatype_prop.ML	Wed Mar 04 10:45:52 2009 +0100
   179.3 @@ -205,7 +205,7 @@
   179.4    let
   179.5      val descr' = List.concat descr;
   179.6      val recTs = get_rec_types descr' sorts;
   179.7 -    val used = foldr OldTerm.add_typ_tfree_names [] recTs;
   179.8 +    val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
   179.9  
  179.10      val (rec_result_Ts, reccomb_fn_Ts) = make_primrec_Ts descr sorts used;
  179.11  
  179.12 @@ -255,7 +255,7 @@
  179.13    let
  179.14      val descr' = List.concat descr;
  179.15      val recTs = get_rec_types descr' sorts;
  179.16 -    val used = foldr OldTerm.add_typ_tfree_names [] recTs;
  179.17 +    val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
  179.18      val newTs = Library.take (length (hd descr), recTs);
  179.19      val T' = TFree (Name.variant used "'t", HOLogic.typeS);
  179.20  
  179.21 @@ -302,7 +302,7 @@
  179.22    let
  179.23      val descr' = List.concat descr;
  179.24      val recTs = get_rec_types descr' sorts;
  179.25 -    val used' = foldr OldTerm.add_typ_tfree_names [] recTs;
  179.26 +    val used' = List.foldr OldTerm.add_typ_tfree_names [] recTs;
  179.27      val newTs = Library.take (length (hd descr), recTs);
  179.28      val T' = TFree (Name.variant used' "'t", HOLogic.typeS);
  179.29      val P = Free ("P", T' --> HOLogic.boolT);
  179.30 @@ -319,13 +319,13 @@
  179.31              val eqn = HOLogic.mk_eq (Free ("x", T),
  179.32                list_comb (Const (cname, Ts ---> T), frees));
  179.33              val P' = P $ list_comb (f, frees)
  179.34 -          in ((foldr (fn (Free (s, T), t) => HOLogic.mk_all (s, T, t))
  179.35 +          in ((List.foldr (fn (Free (s, T), t) => HOLogic.mk_all (s, T, t))
  179.36                  (HOLogic.imp $ eqn $ P') frees)::t1s,
  179.37 -              (foldr (fn (Free (s, T), t) => HOLogic.mk_exists (s, T, t))
  179.38 +              (List.foldr (fn (Free (s, T), t) => HOLogic.mk_exists (s, T, t))
  179.39                  (HOLogic.conj $ eqn $ (HOLogic.Not $ P')) frees)::t2s)
  179.40            end;
  179.41  
  179.42 -        val (t1s, t2s) = foldr process_constr ([], []) (constrs ~~ fs);
  179.43 +        val (t1s, t2s) = List.foldr process_constr ([], []) (constrs ~~ fs);
  179.44          val lhs = P $ (comb_t $ Free ("x", T))
  179.45        in
  179.46          (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, mk_conj t1s)),
  179.47 @@ -422,7 +422,7 @@
  179.48          val tnames = Name.variant_list ["v"] (make_tnames Ts);
  179.49          val frees = tnames ~~ Ts
  179.50        in
  179.51 -        foldr (fn ((s, T'), t) => HOLogic.mk_exists (s, T', t))
  179.52 +        List.foldr (fn ((s, T'), t) => HOLogic.mk_exists (s, T', t))
  179.53            (HOLogic.mk_eq (Free ("v", T),
  179.54              list_comb (Const (cname, Ts ---> T), map Free frees))) frees
  179.55        end
   180.1 --- a/src/HOL/Tools/datatype_realizer.ML	Wed Mar 04 10:43:39 2009 +0100
   180.2 +++ b/src/HOL/Tools/datatype_realizer.ML	Wed Mar 04 10:45:52 2009 +0100
   180.3 @@ -1,5 +1,4 @@
   180.4  (*  Title:      HOL/Tools/datatype_realizer.ML
   180.5 -    ID:         $Id$
   180.6      Author:     Stefan Berghofer, TU Muenchen
   180.7  
   180.8  Porgram extraction from proofs involving datatypes:
   180.9 @@ -57,8 +56,8 @@
  180.10      fun mk_all i s T t =
  180.11        if i mem is then list_all_free ([(s, T)], t) else t;
  180.12  
  180.13 -    val (prems, rec_fns) = split_list (List.concat (snd (foldl_map
  180.14 -      (fn (j, ((i, (_, _, constrs)), T)) => foldl_map (fn (j, (cname, cargs)) =>
  180.15 +    val (prems, rec_fns) = split_list (List.concat (snd (Library.foldl_map
  180.16 +      (fn (j, ((i, (_, _, constrs)), T)) => Library.foldl_map (fn (j, (cname, cargs)) =>
  180.17          let
  180.18            val Ts = map (typ_of_dtyp descr sorts) cargs;
  180.19            val tnames = Name.variant_list pnames (DatatypeProp.make_tnames Ts);
  180.20 @@ -139,8 +138,8 @@
  180.21        tname_of (body_type T) mem ["set", "bool"]) ivs);
  180.22      val ivs2 = map (fn (ixn, _) => Var (ixn, valOf (AList.lookup (op =) rvs ixn))) ivs;
  180.23  
  180.24 -    val prf = foldr forall_intr_prf
  180.25 -     (foldr (fn ((f, p), prf) =>
  180.26 +    val prf = List.foldr forall_intr_prf
  180.27 +     (List.foldr (fn ((f, p), prf) =>
  180.28          (case head_of (strip_abs_body f) of
  180.29             Free (s, T) =>
  180.30               let val T' = Logic.varifyT T
  180.31 @@ -151,7 +150,7 @@
  180.32             (Proofterm.proof_combP
  180.33               (prf_of thm', map PBound (length prems - 1 downto 0))) (rec_fns ~~ prems_of thm)) ivs2;
  180.34  
  180.35 -    val r' = if null is then r else Logic.varify (foldr (uncurry lambda)
  180.36 +    val r' = if null is then r else Logic.varify (List.foldr (uncurry lambda)
  180.37        r (map Logic.unvarify ivs1 @ filter_out is_unit
  180.38            (map (head_of o strip_abs_body) rec_fns)));
  180.39  
  180.40 @@ -201,7 +200,7 @@
  180.41  
  180.42      val P = Var (("P", 0), rT' --> HOLogic.boolT);
  180.43      val prf = forall_intr_prf (y, forall_intr_prf (P,
  180.44 -      foldr (fn ((p, r), prf) =>
  180.45 +      List.foldr (fn ((p, r), prf) =>
  180.46          forall_intr_prf (Logic.legacy_varify r, AbsP ("H", SOME (Logic.varify p),
  180.47            prf))) (Proofterm.proof_combP (prf_of thm',
  180.48              map PBound (length prems - 1 downto 0))) (prems ~~ rs)));
   181.1 --- a/src/HOL/Tools/datatype_rep_proofs.ML	Wed Mar 04 10:43:39 2009 +0100
   181.2 +++ b/src/HOL/Tools/datatype_rep_proofs.ML	Wed Mar 04 10:45:52 2009 +0100
   181.3 @@ -83,7 +83,7 @@
   181.4      val branchT = if null branchTs then HOLogic.unitT
   181.5        else BalancedTree.make (fn (T, U) => Type ("+", [T, U])) branchTs;
   181.6      val arities = get_arities descr' \ 0;
   181.7 -    val unneeded_vars = hd tyvars \\ foldr OldTerm.add_typ_tfree_names [] (leafTs' @ branchTs);
   181.8 +    val unneeded_vars = hd tyvars \\ List.foldr OldTerm.add_typ_tfree_names [] (leafTs' @ branchTs);
   181.9      val leafTs = leafTs' @ (map (fn n => TFree (n, (the o AList.lookup (op =) sorts) n)) unneeded_vars);
  181.10      val recTs = get_rec_types descr' sorts;
  181.11      val newTs = Library.take (length (hd descr), recTs);
  181.12 @@ -143,7 +143,7 @@
  181.13        in mk_inj branchT (length branchTs) (1 + find_index_eq T' branchTs)
  181.14        end;
  181.15  
  181.16 -    val mk_lim = foldr (fn (T, t) => Lim $ mk_fun_inj T (Abs ("x", T, t)));
  181.17 +    val mk_lim = List.foldr (fn (T, t) => Lim $ mk_fun_inj T (Abs ("x", T, t)));
  181.18  
  181.19      (************** generate introduction rules for representing set **********)
  181.20  
  181.21 @@ -169,7 +169,7 @@
  181.22                in (j + 1, prems, (Leaf $ mk_inj T (mk_Free "x" T j))::ts)
  181.23                end);
  181.24  
  181.25 -        val (_, prems, ts) = foldr mk_prem (1, [], []) cargs;
  181.26 +        val (_, prems, ts) = List.foldr mk_prem (1, [], []) cargs;
  181.27          val concl = HOLogic.mk_Trueprop
  181.28            (Free (s, UnivT') $ mk_univ_inj ts n i)
  181.29        in Logic.list_implies (prems, concl)
  181.30 @@ -229,7 +229,7 @@
  181.31              | _ => (j + 1, free_t::l_args, (Leaf $ mk_inj T free_t)::r_args))
  181.32            end;
  181.33  
  181.34 -        val (_, l_args, r_args) = foldr constr_arg (1, [], []) cargs;
  181.35 +        val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) cargs;
  181.36          val constrT = (map (typ_of_dtyp descr' sorts) cargs) ---> T;
  181.37          val abs_name = Sign.intern_const thy ("Abs_" ^ tname);
  181.38          val rep_name = Sign.intern_const thy ("Rep_" ^ tname);
  181.39 @@ -357,7 +357,7 @@
  181.40  
  181.41        in (thy', char_thms' @ char_thms) end;
  181.42  
  181.43 -    val (thy5, iso_char_thms) = apfst Theory.checkpoint (foldr make_iso_defs
  181.44 +    val (thy5, iso_char_thms) = apfst Theory.checkpoint (List.foldr make_iso_defs
  181.45        (add_path flat_names big_name thy4, []) (tl descr));
  181.46  
  181.47      (* prove isomorphism properties *)
  181.48 @@ -447,7 +447,7 @@
  181.49        in (inj_thms'' @ inj_thms, elem_thms @ (split_conj_thm elem_thm))
  181.50        end;
  181.51  
  181.52 -    val (iso_inj_thms_unfolded, iso_elem_thms) = foldr prove_iso_thms
  181.53 +    val (iso_inj_thms_unfolded, iso_elem_thms) = List.foldr prove_iso_thms
  181.54        ([], map #3 newT_iso_axms) (tl descr);
  181.55      val iso_inj_thms = map snd newT_iso_inj_thms @
  181.56        map (fn r => r RS @{thm injD}) iso_inj_thms_unfolded;
   182.1 --- a/src/HOL/Tools/function_package/fundef_common.ML	Wed Mar 04 10:43:39 2009 +0100
   182.2 +++ b/src/HOL/Tools/function_package/fundef_common.ML	Wed Mar 04 10:45:52 2009 +0100
   182.3 @@ -82,7 +82,7 @@
   182.4                                        psimps, pinducts, termination, defname}) phi =
   182.5      let
   182.6        val term = Morphism.term phi val thm = Morphism.thm phi val fact = Morphism.fact phi
   182.7 -      val name = Binding.base_name o Morphism.binding phi o Binding.name
   182.8 +      val name = Binding.name_of o Morphism.binding phi o Binding.name
   182.9      in
  182.10        FundefCtxData { add_simps = add_simps, case_names = case_names,
  182.11                        fs = map term fs, R = term R, psimps = fact psimps, 
   183.1 --- a/src/HOL/Tools/function_package/fundef_package.ML	Wed Mar 04 10:43:39 2009 +0100
   183.2 +++ b/src/HOL/Tools/function_package/fundef_package.ML	Wed Mar 04 10:45:52 2009 +0100
   183.3 @@ -99,8 +99,8 @@
   183.4        val constrn_fxs = map (fn (b, T, mx) => (b, SOME (the_default default_constraint T), mx))
   183.5        val ((fixes0, spec0), ctxt') = 
   183.6          prep (constrn_fxs fixspec) (map (single o apsnd single) eqnss) lthy
   183.7 -      val fixes = map (apfst (apfst Binding.base_name)) fixes0;
   183.8 -      val spec = map (apfst (apfst Binding.base_name)) spec0;
   183.9 +      val fixes = map (apfst (apfst Binding.name_of)) fixes0;
  183.10 +      val spec = map (apfst (apfst Binding.name_of)) spec0;
  183.11        val (eqs, post, sort_cont, cnames) = FundefCommon.get_preproc lthy config flags ctxt' fixes spec
  183.12  
  183.13        val defname = mk_defname fixes
   184.1 --- a/src/HOL/Tools/function_package/scnp_solve.ML	Wed Mar 04 10:43:39 2009 +0100
   184.2 +++ b/src/HOL/Tools/function_package/scnp_solve.ML	Wed Mar 04 10:45:52 2009 +0100
   184.3 @@ -46,7 +46,7 @@
   184.4  fun num_prog_pts (GP (arities, _)) = length arities ;
   184.5  fun num_graphs (GP (_, gs)) = length gs ;
   184.6  fun arity (GP (arities, gl)) i = nth arities i ;
   184.7 -fun ndigits (GP (arities, _)) = IntInf.log2 (foldl (op +) 0 arities) + 1
   184.8 +fun ndigits (GP (arities, _)) = IntInf.log2 (List.foldl (op +) 0 arities) + 1
   184.9  
  184.10  
  184.11  (** Propositional formulas **)
  184.12 @@ -79,7 +79,7 @@
  184.13  fun var_constrs (gp as GP (arities, gl)) =
  184.14    let
  184.15      val n = Int.max (num_graphs gp, num_prog_pts gp)
  184.16 -    val k = foldl Int.max 1 arities
  184.17 +    val k = List.foldl Int.max 1 arities
  184.18  
  184.19      (* Injective, provided  a < 8, x < n, and i < k. *)
  184.20      fun prod a x i j = ((j * k + i) * n + x) * 8 + a + 1
   185.1 --- a/src/HOL/Tools/function_package/size.ML	Wed Mar 04 10:43:39 2009 +0100
   185.2 +++ b/src/HOL/Tools/function_package/size.ML	Wed Mar 04 10:45:52 2009 +0100
   185.3 @@ -115,7 +115,7 @@
   185.4            then HOLogic.zero
   185.5            else foldl1 plus (ts @ [HOLogic.Suc_zero])
   185.6        in
   185.7 -        foldr (fn (T, t') => Abs ("x", T, t')) t (Ts @ replicate k HOLogic.natT)
   185.8 +        List.foldr (fn (T, t') => Abs ("x", T, t')) t (Ts @ replicate k HOLogic.natT)
   185.9        end;
  185.10  
  185.11      val fs = maps (fn (_, (name, _, constrs)) =>
   186.1 --- a/src/HOL/Tools/inductive_codegen.ML	Wed Mar 04 10:43:39 2009 +0100
   186.2 +++ b/src/HOL/Tools/inductive_codegen.ML	Wed Mar 04 10:45:52 2009 +0100
   186.3 @@ -71,7 +71,7 @@
   186.4            {intros = intros |>
   186.5             Symtab.update (s, (AList.update Thm.eq_thm_prop
   186.6               (thm, (thyname_of s, nparms)) rules)),
   186.7 -           graph = foldr (uncurry (Graph.add_edge o pair s))
   186.8 +           graph = List.foldr (uncurry (Graph.add_edge o pair s))
   186.9               (Library.foldl add_node (graph, s :: cs)) cs,
  186.10             eqns = eqns} thy
  186.11          end
  186.12 @@ -152,7 +152,7 @@
  186.13  fun cprod ([], ys) = []
  186.14    | cprod (x :: xs, ys) = map (pair x) ys @ cprod (xs, ys);
  186.15  
  186.16 -fun cprods xss = foldr (map op :: o cprod) [[]] xss;
  186.17 +fun cprods xss = List.foldr (map op :: o cprod) [[]] xss;
  186.18  
  186.19  datatype mode = Mode of (int list option list * int list) * int list * mode option list;
  186.20  
  186.21 @@ -357,7 +357,7 @@
  186.22  
  186.23      val (in_ts, out_ts) = get_args is 1 ts;
  186.24      val ((all_vs', eqs), in_ts') =
  186.25 -      foldl_map check_constrt ((all_vs, []), in_ts);
  186.26 +      Library.foldl_map check_constrt ((all_vs, []), in_ts);
  186.27  
  186.28      fun compile_prems out_ts' vs names [] gr =
  186.29            let
  186.30 @@ -365,8 +365,8 @@
  186.31                (invoke_codegen thy defs dep module false) out_ts gr;
  186.32              val (eq_ps, gr3) = fold_map compile_eq eqs gr2;
  186.33              val ((names', eqs'), out_ts'') =
  186.34 -              foldl_map check_constrt ((names, []), out_ts');
  186.35 -            val (nvs, out_ts''') = foldl_map distinct_v
  186.36 +              Library.foldl_map check_constrt ((names, []), out_ts');
  186.37 +            val (nvs, out_ts''') = Library.foldl_map distinct_v
  186.38                ((names', map (fn x => (x, [x])) vs), out_ts'');
  186.39              val (out_ps', gr4) = fold_map
  186.40                (invoke_codegen thy defs dep module false) (out_ts''') gr3;
  186.41 @@ -383,8 +383,8 @@
  186.42                select_mode_prem thy modes' vs' ps;
  186.43              val ps' = filter_out (equal p) ps;
  186.44              val ((names', eqs), out_ts') =
  186.45 -              foldl_map check_constrt ((names, []), out_ts);
  186.46 -            val (nvs, out_ts'') = foldl_map distinct_v
  186.47 +              Library.foldl_map check_constrt ((names, []), out_ts);
  186.48 +            val (nvs, out_ts'') = Library.foldl_map distinct_v
  186.49                ((names', map (fn x => (x, [x])) vs), out_ts');
  186.50              val (out_ps, gr0) = fold_map
  186.51                (invoke_codegen thy defs dep module false) out_ts'' gr;
   187.1 --- a/src/HOL/Tools/inductive_package.ML	Wed Mar 04 10:43:39 2009 +0100
   187.2 +++ b/src/HOL/Tools/inductive_package.ML	Wed Mar 04 10:45:52 2009 +0100
   187.3 @@ -260,7 +260,7 @@
   187.4  
   187.5  fun check_rule ctxt cs params ((binding, att), rule) =
   187.6    let
   187.7 -    val err_name = Binding.display binding;
   187.8 +    val err_name = Binding.str_of binding;
   187.9      val params' = Term.variant_frees rule (Logic.strip_params rule);
  187.10      val frees = rev (map Free params');
  187.11      val concl = subst_bounds (frees, Logic.strip_assums_concl rule);
  187.12 @@ -517,7 +517,7 @@
  187.13            (HOLogic.dest_Trueprop (Logic.strip_assums_concl r))
  187.14  
  187.15        in list_all_free (Logic.strip_params r,
  187.16 -        Logic.list_implies (map HOLogic.mk_Trueprop (foldr mk_prem
  187.17 +        Logic.list_implies (map HOLogic.mk_Trueprop (List.foldr mk_prem
  187.18            [] (map HOLogic.dest_Trueprop (Logic.strip_assums_hyp r))),
  187.19              HOLogic.mk_Trueprop (list_comb (List.nth (preds, i), ys))))
  187.20        end;
  187.21 @@ -541,7 +541,7 @@
  187.22      (* make predicate for instantiation of abstract induction rule *)
  187.23  
  187.24      val ind_pred = fold_rev lambda (bs @ xs) (foldr1 HOLogic.mk_conj
  187.25 -      (map_index (fn (i, P) => foldr HOLogic.mk_imp
  187.26 +      (map_index (fn (i, P) => List.foldr HOLogic.mk_imp
  187.27           (list_comb (P, make_args' argTs xs (binder_types (fastype_of P))))
  187.28           (make_bool_args HOLogic.mk_not I bs i)) preds));
  187.29  
  187.30 @@ -624,7 +624,7 @@
  187.31            map HOLogic.mk_eq (make_args' argTs xs Ts ~~ ts) @
  187.32            map (subst o HOLogic.dest_Trueprop)
  187.33              (Logic.strip_assums_hyp r)
  187.34 -      in foldr (fn ((x, T), P) => HOLogic.exists_const T $ (Abs (x, T, P)))
  187.35 +      in List.foldr (fn ((x, T), P) => HOLogic.exists_const T $ (Abs (x, T, P)))
  187.36          (if null ps then HOLogic.true_const else foldr1 HOLogic.mk_conj ps)
  187.37          (Logic.strip_params r)
  187.38        end
  187.39 @@ -639,7 +639,7 @@
  187.40  
  187.41      val rec_name =
  187.42        if Binding.is_empty alt_name then
  187.43 -        Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
  187.44 +        Binding.name (space_implode "_" (map (Binding.name_of o fst) cnames_syn))
  187.45        else alt_name;
  187.46  
  187.47      val ((rec_const, (_, fp_def)), ctxt') = ctxt |>
  187.48 @@ -674,9 +674,9 @@
  187.49  fun declare_rules kind rec_binding coind no_ind cnames intrs intr_bindings intr_atts
  187.50        elims raw_induct ctxt =
  187.51    let
  187.52 -    val rec_name = Binding.base_name rec_binding;
  187.53 -    val rec_qualified = Binding.qualify rec_name;
  187.54 -    val intr_names = map Binding.base_name intr_bindings;
  187.55 +    val rec_name = Binding.name_of rec_binding;
  187.56 +    val rec_qualified = Binding.qualify false rec_name;
  187.57 +    val intr_names = map Binding.name_of intr_bindings;
  187.58      val ind_case_names = RuleCases.case_names intr_names;
  187.59      val induct =
  187.60        if coind then
  187.61 @@ -734,11 +734,11 @@
  187.62      cs intros monos params cnames_syn ctxt =
  187.63    let
  187.64      val _ = null cnames_syn andalso error "No inductive predicates given";
  187.65 -    val names = map (Binding.base_name o fst) cnames_syn;
  187.66 +    val names = map (Binding.name_of o fst) cnames_syn;
  187.67      val _ = message (quiet_mode andalso not verbose)
  187.68        ("Proofs for " ^ coind_prefix coind ^ "inductive predicate(s) " ^ commas_quote names);
  187.69  
  187.70 -    val cnames = map (Sign.full_name (ProofContext.theory_of ctxt) o #1) cnames_syn;  (* FIXME *)
  187.71 +    val cnames = map (LocalTheory.full_name ctxt o #1) cnames_syn;  (* FIXME *)
  187.72      val ((intr_names, intr_atts), intr_ts) =
  187.73        apfst split_list (split_list (map (check_rule ctxt cs params) intros));
  187.74  
  187.75 @@ -749,7 +749,7 @@
  187.76      val (intrs, unfold) = prove_intrs quiet_mode coind mono fp_def (length bs + length xs)
  187.77        params intr_ts rec_preds_defs ctxt1;
  187.78      val elims = if no_elim then [] else
  187.79 -      prove_elims quiet_mode cs params intr_ts (map Binding.base_name intr_names)
  187.80 +      prove_elims quiet_mode cs params intr_ts (map Binding.name_of intr_names)
  187.81          unfold rec_preds_defs ctxt1;
  187.82      val raw_induct = zero_var_indexes
  187.83        (if no_ind then Drule.asm_rl else
  187.84 @@ -793,7 +793,7 @@
  187.85  
  187.86      (* abbrevs *)
  187.87  
  187.88 -    val (_, ctxt1) = Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn) lthy;
  187.89 +    val (_, ctxt1) = Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn) lthy;
  187.90  
  187.91      fun get_abbrev ((name, atts), t) =
  187.92        if can (Logic.strip_assums_concl #> Logic.dest_equals) t then
  187.93 @@ -802,7 +802,7 @@
  187.94              error "Abbreviations may not have names or attributes";
  187.95            val ((x, T), rhs) = LocalDefs.abs_def (snd (LocalDefs.cert_def ctxt1 t));
  187.96            val var =
  187.97 -            (case find_first (fn ((c, _), _) => Binding.base_name c = x) cnames_syn of
  187.98 +            (case find_first (fn ((c, _), _) => Binding.name_of c = x) cnames_syn of
  187.99                NONE => error ("Undeclared head of abbreviation " ^ quote x)
 187.100              | SOME ((b, T'), mx) =>
 187.101                  if T <> T' then error ("Bad type specification for abbreviation " ^ quote x)
 187.102 @@ -811,17 +811,17 @@
 187.103        else NONE;
 187.104  
 187.105      val abbrevs = map_filter get_abbrev spec;
 187.106 -    val bs = map (Binding.base_name o fst o fst) abbrevs;
 187.107 +    val bs = map (Binding.name_of o fst o fst) abbrevs;
 187.108  
 187.109  
 187.110      (* predicates *)
 187.111  
 187.112      val pre_intros = filter_out (is_some o get_abbrev) spec;
 187.113 -    val cnames_syn' = filter_out (member (op =) bs o Binding.base_name o fst o fst) cnames_syn;
 187.114 -    val cs = map (Free o apfst Binding.base_name o fst) cnames_syn';
 187.115 +    val cnames_syn' = filter_out (member (op =) bs o Binding.name_of o fst o fst) cnames_syn;
 187.116 +    val cs = map (Free o apfst Binding.name_of o fst) cnames_syn';
 187.117      val ps = map Free pnames;
 187.118  
 187.119 -    val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn');
 187.120 +    val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn');
 187.121      val _ = map (fn abbr => LocalDefs.fixed_abbrev abbr ctxt2) abbrevs;
 187.122      val ctxt3 = ctxt2 |> fold (snd oo LocalDefs.fixed_abbrev) abbrevs;
 187.123      val expand = Assumption.export_term ctxt3 lthy #> ProofContext.cert_term lthy;
 187.124 @@ -854,7 +854,7 @@
 187.125    in
 187.126      lthy
 187.127      |> LocalTheory.set_group (serial_string ())
 187.128 -    |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.base_name o fst) ps) intrs monos
 187.129 +    |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.name_of o fst) ps) intrs monos
 187.130    end;
 187.131  
 187.132  val add_inductive_i = gen_add_inductive_i add_ind_def;
 187.133 @@ -954,7 +954,7 @@
 187.134                else if Binding.is_empty b then ((a, atts), B)
 187.135                else error "Illegal nested case names"
 187.136            | ((b, _), _) => error "Illegal simultaneous specification")
 187.137 -    | (a, _) => error ("Illegal local specification parameters for " ^ quote (Binding.base_name a)));
 187.138 +    | (a, _) => error ("Illegal local specification parameters for " ^ quote (Binding.str_of a)));
 187.139  
 187.140  fun gen_ind_decl mk_def coind =
 187.141    P.fixes -- P.for_fixes --
   188.1 --- a/src/HOL/Tools/inductive_realizer.ML	Wed Mar 04 10:43:39 2009 +0100
   188.2 +++ b/src/HOL/Tools/inductive_realizer.ML	Wed Mar 04 10:45:52 2009 +0100
   188.3 @@ -55,7 +55,7 @@
   188.4        (subst_bound (Free (name, T), P), subst_bound (Free (name, T), Q))
   188.5    | strip_one _ (Const ("==>", _) $ P $ Q) = (P, Q);
   188.6  
   188.7 -fun relevant_vars prop = foldr (fn
   188.8 +fun relevant_vars prop = List.foldr (fn
   188.9        (Var ((a, i), T), vs) => (case strip_type T of
  188.10          (_, Type (s, _)) => if s mem ["bool"] then (a, T) :: vs else vs
  188.11        | _ => vs)
  188.12 @@ -264,7 +264,7 @@
  188.13      val rlz'' = fold_rev Logic.all vs2 rlz
  188.14    in (name, (vs,
  188.15      if rt = Extraction.nullt then rt else
  188.16 -      foldr (uncurry lambda) rt vs1,
  188.17 +      List.foldr (uncurry lambda) rt vs1,
  188.18      ProofRewriteRules.un_hhf_proof rlz' rlz''
  188.19        (fold_rev forall_intr_prf (vs2 @ rs) (prf_of rrule))))
  188.20    end;
  188.21 @@ -315,7 +315,7 @@
  188.22      fun get f = (these oo Option.map) f;
  188.23      val rec_names = distinct (op =) (map (fst o dest_Const o head_of o fst o
  188.24        HOLogic.dest_eq o HOLogic.dest_Trueprop o prop_of) (get #rec_thms dt_info));
  188.25 -    val (_, constrss) = foldl_map (fn ((recs, dummies), (s, rs)) =>
  188.26 +    val (_, constrss) = Library.foldl_map (fn ((recs, dummies), (s, rs)) =>
  188.27        if s mem rsets then
  188.28          let
  188.29            val (d :: dummies') = dummies;
   189.1 --- a/src/HOL/Tools/inductive_set_package.ML	Wed Mar 04 10:43:39 2009 +0100
   189.2 +++ b/src/HOL/Tools/inductive_set_package.ML	Wed Mar 04 10:45:52 2009 +0100
   189.3 @@ -464,7 +464,7 @@
   189.4             | NONE => u)) |>
   189.5          Pattern.rewrite_term thy [] [to_pred_proc thy eqns'] |>
   189.6          eta_contract (member op = cs' orf is_pred pred_arities))) intros;
   189.7 -    val cnames_syn' = map (fn (b, _) => (Binding.map_base (suffix "p") b, NoSyn)) cnames_syn;
   189.8 +    val cnames_syn' = map (fn (b, _) => (Binding.map_name (suffix "p") b, NoSyn)) cnames_syn;
   189.9      val monos' = map (to_pred [] (Context.Proof ctxt)) monos;
  189.10      val ({preds, intrs, elims, raw_induct, ...}, ctxt1) =
  189.11        InductivePackage.add_ind_def
  189.12 @@ -501,9 +501,9 @@
  189.13      (* convert theorems to set notation *)
  189.14      val rec_name =
  189.15        if Binding.is_empty alt_name then
  189.16 -        Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
  189.17 +        Binding.name (space_implode "_" (map (Binding.name_of o fst) cnames_syn))
  189.18        else alt_name;
  189.19 -    val cnames = map (Sign.full_name (ProofContext.theory_of ctxt3) o #1) cnames_syn;  (* FIXME *)
  189.20 +    val cnames = map (LocalTheory.full_name ctxt3 o #1) cnames_syn;  (* FIXME *)
  189.21      val (intr_names, intr_atts) = split_list (map fst intros);
  189.22      val raw_induct' = to_set [] (Context.Proof ctxt3) raw_induct;
  189.23      val (intrs', elims', induct, ctxt4) =
   190.1 --- a/src/HOL/Tools/int_factor_simprocs.ML	Wed Mar 04 10:43:39 2009 +0100
   190.2 +++ b/src/HOL/Tools/int_factor_simprocs.ML	Wed Mar 04 10:45:52 2009 +0100
   190.3 @@ -216,7 +216,7 @@
   190.4  
   190.5  (** Final simplification for the CancelFactor simprocs **)
   190.6  val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq  
   190.7 -  [@{thm mult_1_left}, @{thm mult_1_right}, @{thm zdiv_1}, @{thm numeral_1_eq_1}];
   190.8 +  [@{thm mult_1_left}, @{thm mult_1_right}, @{thm div_by_1}, @{thm numeral_1_eq_1}];
   190.9  
  190.10  fun cancel_simplify_meta_eq cancel_th ss th =
  190.11      simplify_one ss (([th, cancel_th]) MRS trans);
  190.12 @@ -263,8 +263,8 @@
  190.13   (open CancelFactorCommon
  190.14    val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
  190.15    val mk_bal   = HOLogic.mk_binrel @{const_name Ring_and_Field.dvd}
  190.16 -  val dest_bal = HOLogic.dest_bin @{const_name Ring_and_Field.dvd} HOLogic.intT
  190.17 -  val simplify_meta_eq  = cancel_simplify_meta_eq @{thm zdvd_zmult_cancel_disj}
  190.18 +  val dest_bal = HOLogic.dest_bin @{const_name Ring_and_Field.dvd} Term.dummyT
  190.19 +  val simplify_meta_eq  = cancel_simplify_meta_eq @{thm dvd_mult_cancel_left}
  190.20  );
  190.21  
  190.22  (*Version for all fields, including unordered ones (type complex).*)
  190.23 @@ -288,8 +288,8 @@
  190.24      ("int_mod_cancel_factor",
  190.25       ["((l::int) * m) mod n", "(l::int) mod (m * n)"],
  190.26       K IntModCancelFactor.proc),
  190.27 -    ("int_dvd_cancel_factor",
  190.28 -     ["((l::int) * m) dvd n", "(l::int) dvd (m * n)"],
  190.29 +    ("dvd_cancel_factor",
  190.30 +     ["((l::'a::idom) * m) dvd n", "(l::'a::idom) dvd (m * n)"],
  190.31       K IntDvdCancelFactor.proc),
  190.32      ("divide_cancel_factor",
  190.33       ["((l::'a::{division_by_zero,field}) * m) / n",
   191.1 --- a/src/HOL/Tools/lin_arith.ML	Wed Mar 04 10:43:39 2009 +0100
   191.2 +++ b/src/HOL/Tools/lin_arith.ML	Wed Mar 04 10:45:52 2009 +0100
   191.3 @@ -672,7 +672,7 @@
   191.4  let
   191.5    fun filter_prems (t, (left, right)) =
   191.6      if  p t  then  (left, right @ [t])  else  (left @ right, [])
   191.7 -  val (left, right) = foldl filter_prems ([], []) terms
   191.8 +  val (left, right) = List.foldl filter_prems ([], []) terms
   191.9  in
  191.10    right @ left
  191.11  end;
   192.1 --- a/src/HOL/Tools/meson.ML	Wed Mar 04 10:43:39 2009 +0100
   192.2 +++ b/src/HOL/Tools/meson.ML	Wed Mar 04 10:45:52 2009 +0100
   192.3 @@ -92,7 +92,7 @@
   192.4      | pairs =>
   192.5          let val thy = theory_of_thm th
   192.6              val (tyenv,tenv) =
   192.7 -                  foldl (uncurry (Pattern.first_order_match thy)) (tyenv0,tenv0) pairs
   192.8 +                  List.foldl (uncurry (Pattern.first_order_match thy)) (tyenv0,tenv0) pairs
   192.9              val t_pairs = map term_pair_of (Vartab.dest tenv)
  192.10              val th' = Thm.instantiate ([], map (pairself (cterm_of thy)) t_pairs) th
  192.11          in  th'  end
  192.12 @@ -428,7 +428,7 @@
  192.13  fun name_thms label =
  192.14      let fun name1 (th, (k,ths)) =
  192.15            (k-1, Thm.put_name_hint (label ^ string_of_int k) th :: ths)
  192.16 -    in  fn ths => #2 (foldr name1 (length ths, []) ths)  end;
  192.17 +    in  fn ths => #2 (List.foldr name1 (length ths, []) ths)  end;
  192.18  
  192.19  (*Is the given disjunction an all-negative support clause?*)
  192.20  fun is_negative th = forall (not o #1) (literals (prop_of th));
  192.21 @@ -477,7 +477,7 @@
  192.22  (*Sums the sizes of the subgoals, ignoring hypotheses (ancestors)*)
  192.23  fun addconcl(prem,sz) = size_of_term(Logic.strip_assums_concl prem) + sz
  192.24  
  192.25 -fun size_of_subgoals st = foldr addconcl 0 (prems_of st);
  192.26 +fun size_of_subgoals st = List.foldr addconcl 0 (prems_of st);
  192.27  
  192.28  
  192.29  (*Negation Normal Form*)
  192.30 @@ -544,12 +544,12 @@
  192.31  
  192.32  (*Make clauses from a list of theorems, previously Skolemized and put into nnf.
  192.33    The resulting clauses are HOL disjunctions.*)
  192.34 -fun make_clauses ths = sort_clauses (foldr add_clauses [] ths);
  192.35 +fun make_clauses ths = sort_clauses (List.foldr add_clauses [] ths);
  192.36  
  192.37  (*Convert a list of clauses (disjunctions) to Horn clauses (contrapositives)*)
  192.38  fun make_horns ths =
  192.39      name_thms "Horn#"
  192.40 -      (distinct Thm.eq_thm_prop (foldr (add_contras clause_rules) [] ths));
  192.41 +      (distinct Thm.eq_thm_prop (List.foldr (add_contras clause_rules) [] ths));
  192.42  
  192.43  (*Could simply use nprems_of, which would count remaining subgoals -- no
  192.44    discrimination as to their size!  With BEST_FIRST, fails for problem 41.*)
   193.1 --- a/src/HOL/Tools/metis_tools.ML	Wed Mar 04 10:43:39 2009 +0100
   193.2 +++ b/src/HOL/Tools/metis_tools.ML	Wed Mar 04 10:45:52 2009 +0100
   193.3 @@ -543,9 +543,9 @@
   193.4          val all_thms_FO = forall (Meson.is_fol_term thy o prop_of)
   193.5          val isFO = (mode = ResAtp.Fol) orelse
   193.6                     (mode <> ResAtp.Hol andalso all_thms_FO (cls @ ths))
   193.7 -        val lmap0 = foldl (add_thm true ctxt)
   193.8 +        val lmap0 = List.foldl (add_thm true ctxt)
   193.9                            {isFO = isFO, axioms = [], tfrees = init_tfrees ctxt} cls
  193.10 -        val lmap = foldl (add_thm false ctxt) (add_tfrees lmap0) ths
  193.11 +        val lmap = List.foldl (add_thm false ctxt) (add_tfrees lmap0) ths
  193.12          val clause_lists = map (Metis.Thm.clause o #1) (#axioms lmap)
  193.13          fun used c = exists (Metis.LiteralSet.exists (const_in_metis c)) clause_lists
  193.14          (*Now check for the existence of certain combinators*)
  193.15 @@ -556,7 +556,7 @@
  193.16          val thS   = if used "c_COMBS" then [comb_S] else []
  193.17          val thEQ  = if used "c_fequal" then [fequal_imp_equal', equal_imp_fequal'] else []
  193.18          val lmap' = if isFO then lmap
  193.19 -                    else foldl (add_thm false ctxt) lmap (thEQ @ thS @ thC @ thB @ thK @ thI)
  193.20 +                    else List.foldl (add_thm false ctxt) lmap (thEQ @ thS @ thC @ thB @ thK @ thI)
  193.21      in
  193.22          add_type_thm (type_ext thy (map prop_of (cls @ ths))) lmap'
  193.23      end;
   194.1 --- a/src/HOL/Tools/old_primrec_package.ML	Wed Mar 04 10:43:39 2009 +0100
   194.2 +++ b/src/HOL/Tools/old_primrec_package.ML	Wed Mar 04 10:45:52 2009 +0100
   194.3 @@ -37,8 +37,8 @@
   194.4      fun varify (t, (i, ts)) =
   194.5        let val t' = map_types (Logic.incr_tvar (i + 1)) (snd (Type.varify [] t))
   194.6        in (maxidx_of_term t', t'::ts) end;
   194.7 -    val (i, cs') = foldr varify (~1, []) cs;
   194.8 -    val (i', intr_ts') = foldr varify (i, []) intr_ts;
   194.9 +    val (i, cs') = List.foldr varify (~1, []) cs;
  194.10 +    val (i', intr_ts') = List.foldr varify (i, []) intr_ts;
  194.11      val rec_consts = fold Term.add_consts cs' [];
  194.12      val intr_consts = fold Term.add_consts intr_ts' [];
  194.13      fun unify (cname, cT) =
   195.1 --- a/src/HOL/Tools/primrec_package.ML	Wed Mar 04 10:43:39 2009 +0100
   195.2 +++ b/src/HOL/Tools/primrec_package.ML	Wed Mar 04 10:45:52 2009 +0100
   195.3 @@ -194,7 +194,7 @@
   195.4      val def_name = Thm.def_name (Sign.base_name fname);
   195.5      val rhs = singleton (Syntax.check_terms ctxt) raw_rhs;
   195.6      val SOME var = get_first (fn ((b, _), mx) =>
   195.7 -      if Binding.base_name b = fname then SOME (b, mx) else NONE) fixes;
   195.8 +      if Binding.name_of b = fname then SOME (b, mx) else NONE) fixes;
   195.9    in (var, ((Binding.name def_name, []), rhs)) end;
  195.10  
  195.11  
  195.12 @@ -231,7 +231,7 @@
  195.13    let
  195.14      val (fixes, spec) = prepare_spec prep_spec lthy raw_fixes raw_spec;
  195.15      val eqns = fold_rev (process_eqn (fn v => Variable.is_fixed lthy v
  195.16 -      orelse exists (fn ((w, _), _) => v = Binding.base_name w) fixes) o snd) spec [];
  195.17 +      orelse exists (fn ((w, _), _) => v = Binding.name_of w) fixes) o snd) spec [];
  195.18      val tnames = distinct (op =) (map (#1 o snd) eqns);
  195.19      val dts = find_dts (DatatypePackage.get_datatypes (ProofContext.theory_of lthy)) tnames tnames;
  195.20      val main_fns = map (fn (tname, {index, ...}) =>
  195.21 @@ -248,7 +248,7 @@
  195.22        else primrec_error ("functions " ^ commas_quote names2 ^
  195.23          "\nare not mutually recursive");
  195.24      val prefix = space_implode "_" (map (Sign.base_name o #1) defs);
  195.25 -    val qualify = Binding.qualify prefix;
  195.26 +    val qualify = Binding.qualify false prefix;
  195.27      val spec' = (map o apfst)
  195.28        (fn (b, attrs) => (qualify b, Code.add_default_eqn_attrib :: attrs)) spec;
  195.29      val simp_atts = map (Attrib.internal o K)
  195.30 @@ -299,7 +299,7 @@
  195.31        P.name >> pair false) --| P.$$$ ")")) (false, "");
  195.32  
  195.33  val old_primrec_decl =
  195.34 -  opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop);
  195.35 +  opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop);
  195.36  
  195.37  fun pipe_error t = P.!!! (Scan.fail_with (K
  195.38    (cat_lines ["Equations must be separated by " ^ quote "|", quote t])));
   196.1 --- a/src/HOL/Tools/recdef_package.ML	Wed Mar 04 10:43:39 2009 +0100
   196.2 +++ b/src/HOL/Tools/recdef_package.ML	Wed Mar 04 10:45:52 2009 +0100
   196.3 @@ -320,7 +320,7 @@
   196.4  val _ =
   196.5    OuterSyntax.local_theory_to_proof' "recdef_tc" "recommence proof of termination condition (TFL)"
   196.6      K.thy_goal
   196.7 -    ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.xname --
   196.8 +    ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.xname --
   196.9          Scan.option (P.$$$ "(" |-- P.nat --| P.$$$ ")")
  196.10        >> (fn ((thm_name, name), i) => recdef_tc thm_name name i));
  196.11  
   197.1 --- a/src/HOL/Tools/recfun_codegen.ML	Wed Mar 04 10:43:39 2009 +0100
   197.2 +++ b/src/HOL/Tools/recfun_codegen.ML	Wed Mar 04 10:45:52 2009 +0100
   197.3 @@ -143,7 +143,7 @@
   197.4                   val eqs'' = map (dest_eq o prop_of) (List.concat (map fst thmss));
   197.5                   val (fundef', gr3) = mk_fundef module' "" true eqs''
   197.6                     (add_edge (dname, dep)
   197.7 -                     (foldr (uncurry new_node) (del_nodes xs gr2)
   197.8 +                     (List.foldr (uncurry new_node) (del_nodes xs gr2)
   197.9                         (map (fn k =>
  197.10                           (k, (SOME (EQN ("", dummyT, dname)), module', ""))) xs)))
  197.11                 in (module', put_code module' fundef' gr3) end
   198.1 --- a/src/HOL/Tools/record_package.ML	Wed Mar 04 10:43:39 2009 +0100
   198.2 +++ b/src/HOL/Tools/record_package.ML	Wed Mar 04 10:45:52 2009 +0100
   198.3 @@ -1778,7 +1778,7 @@
   198.4      val names = map fst fields;
   198.5      val extN = full bname;
   198.6      val types = map snd fields;
   198.7 -    val alphas_fields = foldr OldTerm.add_typ_tfree_names [] types;
   198.8 +    val alphas_fields = List.foldr OldTerm.add_typ_tfree_names [] types;
   198.9      val alphas_ext = alphas inter alphas_fields;
  198.10      val len = length fields;
  198.11      val variants = Name.variant_list (moreN::rN::rN ^ "'"::wN::parent_variants) (map fst bfields);
  198.12 @@ -1835,7 +1835,7 @@
  198.13        let val (args',more) = chop_last args;
  198.14            fun mk_ext' (((name,T),args),more) = mk_ext (name,T) (args@[more]);
  198.15            fun build Ts =
  198.16 -           foldr mk_ext' more (prune n (extension_names ~~ Ts ~~ (chunks parent_chunks args')))
  198.17 +           List.foldr mk_ext' more (prune n (extension_names ~~ Ts ~~ (chunks parent_chunks args')))
  198.18        in
  198.19          if more = HOLogic.unit
  198.20          then build (map recT (0 upto parent_len))
  198.21 @@ -2003,13 +2003,13 @@
  198.22        end;
  198.23  
  198.24      val split_object_prop =
  198.25 -      let fun ALL vs t = foldr (fn ((v,T),t) => HOLogic.mk_all (v,T,t)) t vs
  198.26 +      let fun ALL vs t = List.foldr (fn ((v,T),t) => HOLogic.mk_all (v,T,t)) t vs
  198.27        in (ALL [dest_Free r0] (P $ r0)) === (ALL (map dest_Free all_vars_more) (P $ r_rec0))
  198.28        end;
  198.29  
  198.30  
  198.31      val split_ex_prop =
  198.32 -      let fun EX vs t = foldr (fn ((v,T),t) => HOLogic.mk_exists (v,T,t)) t vs
  198.33 +      let fun EX vs t = List.foldr (fn ((v,T),t) => HOLogic.mk_exists (v,T,t)) t vs
  198.34        in (EX [dest_Free r0] (P $ r0)) === (EX (map dest_Free all_vars_more) (P $ r_rec0))
  198.35        end;
  198.36  
  198.37 @@ -2228,7 +2228,7 @@
  198.38      val init_env =
  198.39        (case parent of
  198.40          NONE => []
  198.41 -      | SOME (types, _) => foldr OldTerm.add_typ_tfrees [] types);
  198.42 +      | SOME (types, _) => List.foldr OldTerm.add_typ_tfrees [] types);
  198.43  
  198.44  
  198.45      (* fields *)
   199.1 --- a/src/HOL/Tools/refute.ML	Wed Mar 04 10:43:39 2009 +0100
   199.2 +++ b/src/HOL/Tools/refute.ML	Wed Mar 04 10:45:52 2009 +0100
   199.3 @@ -63,7 +63,6 @@
   199.4  
   199.5    val close_form : Term.term -> Term.term
   199.6    val get_classdef : theory -> string -> (string * Term.term) option
   199.7 -  val norm_rhs : Term.term -> Term.term
   199.8    val get_def : theory -> string * Term.typ -> (string * Term.term) option
   199.9    val get_typedef : theory -> Term.typ -> (string * Term.term) option
  199.10    val is_IDT_constructor : theory -> string * Term.typ -> bool
  199.11 @@ -549,21 +548,6 @@
  199.12    end;
  199.13  
  199.14  (* ------------------------------------------------------------------------- *)
  199.15 -(* norm_rhs: maps  f ?t1 ... ?tn == rhs  to  %t1...tn. rhs                   *)
  199.16 -(* ------------------------------------------------------------------------- *)
  199.17 -
  199.18 -  (* Term.term -> Term.term *)
  199.19 -  fun norm_rhs eqn =
  199.20 -  let
  199.21 -    fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
  199.22 -      | lambda v t                      = raise TERM ("lambda", [v, t])
  199.23 -    val (lhs, rhs) = Logic.dest_equals eqn
  199.24 -    val (_, args)  = Term.strip_comb lhs
  199.25 -  in
  199.26 -    fold lambda (rev args) rhs
  199.27 -  end
  199.28 -
  199.29 -(* ------------------------------------------------------------------------- *)
  199.30  (* get_def: looks up the definition of a constant, as created by "constdefs" *)
  199.31  (* ------------------------------------------------------------------------- *)
  199.32  
  199.33 @@ -571,6 +555,16 @@
  199.34  
  199.35    fun get_def thy (s, T) =
  199.36    let
  199.37 +    (* maps  f ?t1 ... ?tn == rhs  to  %t1...tn. rhs *)
  199.38 +    fun norm_rhs eqn =
  199.39 +    let
  199.40 +      fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
  199.41 +        | lambda v t                      = raise TERM ("lambda", [v, t])
  199.42 +      val (lhs, rhs) = Logic.dest_equals eqn
  199.43 +      val (_, args)  = Term.strip_comb lhs
  199.44 +    in
  199.45 +      fold lambda (rev args) rhs
  199.46 +    end
  199.47      (* (string * Term.term) list -> (string * Term.term) option *)
  199.48      fun get_def_ax [] = NONE
  199.49        | get_def_ax ((axname, ax) :: axioms) =
  199.50 @@ -991,7 +985,7 @@
  199.51                  DatatypeAux.DtTFree _ =>
  199.52                  collect_types dT acc
  199.53                | DatatypeAux.DtType (_, ds) =>
  199.54 -                collect_types dT (foldr collect_dtyp acc ds)
  199.55 +                collect_types dT (List.foldr collect_dtyp acc ds)
  199.56                | DatatypeAux.DtRec i =>
  199.57                  if dT mem acc then
  199.58                    acc  (* prevent infinite recursion *)
  199.59 @@ -1005,9 +999,9 @@
  199.60                          insert (op =) dT acc
  199.61                        else acc
  199.62                      (* collect argument types *)
  199.63 -                    val acc_dtyps = foldr collect_dtyp acc_dT dtyps
  199.64 +                    val acc_dtyps = List.foldr collect_dtyp acc_dT dtyps
  199.65                      (* collect constructor types *)
  199.66 -                    val acc_dconstrs = foldr collect_dtyp acc_dtyps
  199.67 +                    val acc_dconstrs = List.foldr collect_dtyp acc_dtyps
  199.68                        (List.concat (map snd dconstrs))
  199.69                    in
  199.70                      acc_dconstrs
  199.71 @@ -1108,7 +1102,7 @@
  199.72      case next (maxsize-minsize) 0 0 diffs of
  199.73        SOME diffs' =>
  199.74        (* merge with those types for which the size is fixed *)
  199.75 -      SOME (snd (foldl_map (fn (ds, (T, _)) =>
  199.76 +      SOME (snd (Library.foldl_map (fn (ds, (T, _)) =>
  199.77          case AList.lookup (op =) sizes (string_of_typ T) of
  199.78          (* return the fixed size *)
  199.79            SOME n => (ds, (T, n))
  199.80 @@ -1202,7 +1196,7 @@
  199.81          val _          = Output.immediate_output ("Translating term (sizes: "
  199.82            ^ commas (map (fn (_, n) => string_of_int n) universe) ^ ") ...")
  199.83          (* translate 'u' and all axioms *)
  199.84 -        val ((model, args), intrs) = foldl_map (fn ((m, a), t') =>
  199.85 +        val ((model, args), intrs) = Library.foldl_map (fn ((m, a), t') =>
  199.86            let
  199.87              val (i, m', a') = interpret thy m a t'
  199.88            in
  199.89 @@ -1618,7 +1612,7 @@
  199.90      val Ts = Term.binder_types (Term.fastype_of t)
  199.91      val t' = Term.incr_boundvars i t
  199.92    in
  199.93 -    foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
  199.94 +    List.foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
  199.95        (Term.list_comb (t', map Bound (i-1 downto 0))) (List.take (Ts, i))
  199.96    end;
  199.97  
  199.98 @@ -1628,7 +1622,7 @@
  199.99  
 199.100    (* int list -> int *)
 199.101  
 199.102 -  fun sum xs = foldl op+ 0 xs;
 199.103 +  fun sum xs = List.foldl op+ 0 xs;
 199.104  
 199.105  (* ------------------------------------------------------------------------- *)
 199.106  (* product: returns the product of a list 'xs' of integers                   *)
 199.107 @@ -1636,7 +1630,7 @@
 199.108  
 199.109    (* int list -> int *)
 199.110  
 199.111 -  fun product xs = foldl op* 1 xs;
 199.112 +  fun product xs = List.foldl op* 1 xs;
 199.113  
 199.114  (* ------------------------------------------------------------------------- *)
 199.115  (* size_of_dtyp: the size of (an initial fragment of) an inductive data type *)
 199.116 @@ -1756,7 +1750,7 @@
 199.117            (* create all constants of type 'T' *)
 199.118            val constants = make_constants thy model T
 199.119            (* interpret the 'body' separately for each constant *)
 199.120 -          val ((model', args'), bodies) = foldl_map
 199.121 +          val ((model', args'), bodies) = Library.foldl_map
 199.122              (fn ((m, a), c) =>
 199.123                let
 199.124                  (* add 'c' to 'bounds' *)
 199.125 @@ -2100,7 +2094,7 @@
 199.126              Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
 199.127          in
 199.128            (* functions as graphs, i.e. as a (HOL) set of pairs "(x, y)" *)
 199.129 -          map (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
 199.130 +          map (List.foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
 199.131              HOLogic_empty_set) pairss
 199.132          end
 199.133        | Type (s, Ts) =>
 199.134 @@ -2292,7 +2286,7 @@
 199.135                              | search [] _ = ()
 199.136                          in  search terms' terms  end
 199.137                        (* int * interpretation list *)
 199.138 -                      val (new_offset, intrs) = foldl_map (fn (off, t_elem) =>
 199.139 +                      val (new_offset, intrs) = Library.foldl_map (fn (off, t_elem) =>
 199.140                          (* if 't_elem' existed at the previous depth,    *)
 199.141                          (* proceed recursively, otherwise map the entire *)
 199.142                          (* subtree to "undefined"                        *)
 199.143 @@ -2358,7 +2352,7 @@
 199.144                else  (* mconstrs_count = length params *)
 199.145                  let
 199.146                    (* interpret each parameter separately *)
 199.147 -                  val ((model', args'), p_intrs) = foldl_map (fn ((m, a), p) =>
 199.148 +                  val ((model', args'), p_intrs) = Library.foldl_map (fn ((m, a), p) =>
 199.149                      let
 199.150                        val (i, m', a') = interpret thy m a p
 199.151                      in
 199.152 @@ -2470,7 +2464,7 @@
 199.153                      end) descr
 199.154                    (* associate constructors with corresponding parameters *)
 199.155                    (* (int * (interpretation * interpretation) list) list *)
 199.156 -                  val (p_intrs', mc_p_intrs) = foldl_map
 199.157 +                  val (p_intrs', mc_p_intrs) = Library.foldl_map
 199.158                      (fn (p_intrs', (idx, c_intrs)) =>
 199.159                        let
 199.160                          val len = length c_intrs
 199.161 @@ -2636,7 +2630,7 @@
 199.162                          (* interpretation list *)
 199.163                          val arg_intrs = map (uncurry rec_intr) rec_dtyps_intrs
 199.164                          (* apply 'intr' to all recursive arguments *)
 199.165 -                        val result = foldl (fn (arg_i, i) =>
 199.166 +                        val result = List.foldl (fn (arg_i, i) =>
 199.167                            interpretation_apply (i, arg_i)) intr arg_intrs
 199.168                          (* update 'REC_OPERATORS' *)
 199.169                          val _ = Array.update (arr, elem, (true, result))
 199.170 @@ -2916,7 +2910,7 @@
 199.171          (* of width 'size_elem' and depth 'length_list' (with 'size_list'    *)
 199.172          (* nodes total)                                                      *)
 199.173          (* (int * (int * int)) list *)
 199.174 -        val (_, lenoff_lists) = foldl_map (fn ((offsets, off), elem) =>
 199.175 +        val (_, lenoff_lists) = Library.foldl_map (fn ((offsets, off), elem) =>
 199.176            (* corresponds to a pre-order traversal of the tree *)
 199.177            let
 199.178              val len = length offsets
 199.179 @@ -3010,7 +3004,7 @@
 199.180              "intersection: interpretation for set is not a node")
 199.181          (* interpretation -> interpretaion *)
 199.182          fun lfp (Node resultsets) =
 199.183 -          foldl (fn ((set, resultset), acc) =>
 199.184 +          List.foldl (fn ((set, resultset), acc) =>
 199.185              if is_subset (resultset, set) then
 199.186                intersection (acc, set)
 199.187              else
 199.188 @@ -3061,7 +3055,7 @@
 199.189              "union: interpretation for set is not a node")
 199.190          (* interpretation -> interpretaion *)
 199.191          fun gfp (Node resultsets) =
 199.192 -          foldl (fn ((set, resultset), acc) =>
 199.193 +          List.foldl (fn ((set, resultset), acc) =>
 199.194              if is_subset (set, resultset) then
 199.195                union (acc, set)
 199.196              else
 199.197 @@ -3164,7 +3158,7 @@
 199.198          val HOLogic_insert    =
 199.199            Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
 199.200        in
 199.201 -        SOME (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
 199.202 +        SOME (List.foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
 199.203            HOLogic_empty_set pairs)
 199.204        end
 199.205      | Type ("prop", [])      =>
 199.206 @@ -3299,8 +3293,6 @@
 199.207  (*       subterms that are then passed to other interpreters!                *)
 199.208  (* ------------------------------------------------------------------------- *)
 199.209  
 199.210 -  (* (theory -> theory) list *)
 199.211 -
 199.212    val setup =
 199.213       add_interpreter "stlc"    stlc_interpreter #>
 199.214       add_interpreter "Pure"    Pure_interpreter #>
   200.1 --- a/src/HOL/Tools/res_atp.ML	Wed Mar 04 10:43:39 2009 +0100
   200.2 +++ b/src/HOL/Tools/res_atp.ML	Wed Mar 04 10:45:52 2009 +0100
   200.3 @@ -6,10 +6,7 @@
   200.4    val tvar_classes_of_terms : term list -> string list
   200.5    val tfree_classes_of_terms : term list -> string list
   200.6    val type_consts_of_terms : theory -> term list -> string list
   200.7 -  val write_problem_files : (theory -> bool -> Thm.thm list -> string ->
   200.8 -  (thm * (ResHolClause.axiom_name * ResHolClause.clause_id)) list * ResClause.classrelClause list *
   200.9 -    ResClause.arityClause list -> string list -> ResHolClause.axiom_name list)
  200.10 -    -> int -> bool
  200.11 +  val write_problem_files : bool -> int -> bool
  200.12      -> (int -> Path.T) -> Proof.context * thm list * thm
  200.13      -> string list * ResHolClause.axiom_name Vector.vector list
  200.14  end;
  200.15 @@ -118,9 +115,9 @@
  200.16  fun add_standard_const (s,tab) = Symtab.update (s,[]) tab;
  200.17  
  200.18  val null_const_tab : const_typ list list Symtab.table = 
  200.19 -    foldl add_standard_const Symtab.empty standard_consts;
  200.20 +    List.foldl add_standard_const Symtab.empty standard_consts;
  200.21  
  200.22 -fun get_goal_consts_typs thy = foldl (add_term_consts_typs_rm thy) null_const_tab;
  200.23 +fun get_goal_consts_typs thy = List.foldl (add_term_consts_typs_rm thy) null_const_tab;
  200.24  
  200.25  (*Inserts a dummy "constant" referring to the theory name, so that relevance
  200.26    takes the given theory into account.*)
  200.27 @@ -193,7 +190,7 @@
  200.28      end;
  200.29      
  200.30  (*Multiplies out to a list of pairs: 'a * 'b list -> ('a * 'b) list -> ('a * 'b) list*)
  200.31 -fun add_expand_pairs (x,ys) xys = foldl (fn (y,acc) => (x,y)::acc) xys ys;
  200.32 +fun add_expand_pairs (x,ys) xys = List.foldl (fn (y,acc) => (x,y)::acc) xys ys;
  200.33  
  200.34  fun consts_typs_of_term thy t = 
  200.35    let val tab = add_term_consts_typs_rm thy (t, null_const_tab)
  200.36 @@ -253,7 +250,7 @@
  200.37  	| relevant (newpairs,rejects) [] =
  200.38  	    let val (newrels,more_rejects) = take_best max_new newpairs
  200.39  		val new_consts = List.concat (map #2 newrels)
  200.40 -		val rel_consts' = foldl add_const_typ_table rel_consts new_consts
  200.41 +		val rel_consts' = List.foldl add_const_typ_table rel_consts new_consts
  200.42  		val newp = p + (1.0-p) / convergence
  200.43  	    in
  200.44                Output.debug (fn () => ("relevant this iteration: " ^ Int.toString (length newrels)));
  200.45 @@ -379,7 +376,7 @@
  200.46  
  200.47  fun add_single_names ((a, []), pairs) = pairs
  200.48    | add_single_names ((a, [th]), pairs) = (a,th)::pairs
  200.49 -  | add_single_names ((a, ths), pairs) = #2 (foldl (multi_name a) (1,pairs) ths);
  200.50 +  | add_single_names ((a, ths), pairs) = #2 (List.foldl (multi_name a) (1,pairs) ths);
  200.51  
  200.52  (*Ignore blacklisted basenames*)
  200.53  fun add_multi_names ((a, ths), pairs) =
  200.54 @@ -396,7 +393,7 @@
  200.55    in
  200.56        app (fn th => ignore (Polyhash.peekInsert ht (th,()))) (ResBlacklist.get ctxt);
  200.57        filter (not o blacklisted o #2)
  200.58 -        (foldl add_single_names (foldl add_multi_names [] mults) singles)
  200.59 +        (List.foldl add_single_names (List.foldl add_multi_names [] mults) singles)
  200.60    end;
  200.61  
  200.62  fun check_named ("",th) = (warning ("No name for theorem " ^ Display.string_of_thm th); false)
  200.63 @@ -434,18 +431,18 @@
  200.64  (* Type Classes Present in the Axiom or Conjecture Clauses     *)
  200.65  (***************************************************************)
  200.66  
  200.67 -fun add_classes (sorts, cset) = foldl setinsert cset (List.concat sorts);
  200.68 +fun add_classes (sorts, cset) = List.foldl setinsert cset (List.concat sorts);
  200.69  
  200.70  (*Remove this trivial type class*)
  200.71  fun delete_type cset = Symtab.delete_safe "HOL.type" cset;
  200.72  
  200.73  fun tvar_classes_of_terms ts =
  200.74    let val sorts_list = map (map #2 o OldTerm.term_tvars) ts
  200.75 -  in  Symtab.keys (delete_type (foldl add_classes Symtab.empty sorts_list))  end;
  200.76 +  in  Symtab.keys (delete_type (List.foldl add_classes Symtab.empty sorts_list))  end;
  200.77  
  200.78  fun tfree_classes_of_terms ts =
  200.79    let val sorts_list = map (map #2 o OldTerm.term_tfrees) ts
  200.80 -  in  Symtab.keys (delete_type (foldl add_classes Symtab.empty sorts_list))  end;
  200.81 +  in  Symtab.keys (delete_type (List.foldl add_classes Symtab.empty sorts_list))  end;
  200.82  
  200.83  (*fold type constructors*)
  200.84  fun fold_type_consts f (Type (a, Ts)) x = fold (fold_type_consts f) Ts (f (a,x))
  200.85 @@ -524,11 +521,10 @@
  200.86  (* TODO: problem file for *one* subgoal would be sufficient *)
  200.87  (*Write out problem files for each subgoal.
  200.88    Argument probfile generates filenames from subgoal-number
  200.89 -  Argument writer is either a tptp_write_file or dfg_write_file from ResHolClause
  200.90    Arguments max_new and theory_const are booleans controlling relevance_filter
  200.91      (necessary for different provers)
  200.92 -  *)
  200.93 -fun write_problem_files writer max_new theory_const probfile (ctxt, chain_ths, th) =
  200.94 +*)
  200.95 +fun write_problem_files dfg max_new theory_const probfile (ctxt, chain_ths, th) =
  200.96    let val goals = Thm.prems_of th
  200.97        val thy = ProofContext.theory_of ctxt
  200.98        fun get_neg_subgoals [] _ = []
  200.99 @@ -548,6 +544,7 @@
 200.100        val white_cls = ResAxioms.cnf_rules_pairs thy white_thms
 200.101        (*clauses relevant to goal gl*)
 200.102        val axcls_list = map (fn ngcls => white_cls @ relevance_filter max_new theory_const thy included_cls (map prop_of ngcls)) goal_cls
 200.103 +      val writer = if dfg then ResHolClause.dfg_write_file else ResHolClause.tptp_write_file
 200.104        fun write_all [] [] _ = []
 200.105          | write_all (ccls::ccls_list) (axcls::axcls_list) k =
 200.106              let val fname = File.platform_path (probfile k)
 200.107 @@ -561,7 +558,7 @@
 200.108                  and supers = tvar_classes_of_terms axtms
 200.109                  and tycons = type_consts_of_terms thy (ccltms@axtms)
 200.110                  (*TFrees in conjecture clauses; TVars in axiom clauses*)
 200.111 -                val (supers',arity_clauses) = ResClause.make_arity_clauses thy tycons supers
 200.112 +                val (supers',arity_clauses) = ResClause.make_arity_clauses_dfg dfg thy tycons supers
 200.113                  val classrel_clauses = ResClause.make_classrel_clauses thy subs supers'
 200.114                  val clnames = writer thy isFO ccls fname (axcls,classrel_clauses,arity_clauses) []
 200.115                  val thm_names = Vector.fromList clnames
   201.1 --- a/src/HOL/Tools/res_axioms.ML	Wed Mar 04 10:43:39 2009 +0100
   201.2 +++ b/src/HOL/Tools/res_axioms.ML	Wed Mar 04 10:45:52 2009 +0100
   201.3 @@ -494,7 +494,7 @@
   201.4        val remaining_hyps = filter_out (member (op aconv) (map Thm.term_of defs))
   201.5                                        (map Thm.term_of hyps)
   201.6        val fixed = OldTerm.term_frees (concl_of st) @
   201.7 -                  foldl (gen_union (op aconv)) [] (map OldTerm.term_frees remaining_hyps)
   201.8 +                  List.foldl (gen_union (op aconv)) [] (map OldTerm.term_frees remaining_hyps)
   201.9    in Seq.of_list [LocalDefs.expand (filter (is_okdef fixed o Thm.term_of) defs) st] end;
  201.10  
  201.11  
   202.1 --- a/src/HOL/Tools/res_clause.ML	Wed Mar 04 10:43:39 2009 +0100
   202.2 +++ b/src/HOL/Tools/res_clause.ML	Wed Mar 04 10:45:52 2009 +0100
   202.3 @@ -1,5 +1,4 @@
   202.4  (*  Author: Jia Meng, Cambridge University Computer Laboratory
   202.5 -    ID: $Id$
   202.6      Copyright 2004 University of Cambridge
   202.7  
   202.8  Storing/printing FOL clauses and arity clauses.
   202.9 @@ -27,9 +26,8 @@
  202.10    val make_fixed_var : string -> string
  202.11    val make_schematic_type_var : string * int -> string
  202.12    val make_fixed_type_var : string -> string
  202.13 -  val dfg_format: bool ref
  202.14 -  val make_fixed_const : string -> string
  202.15 -  val make_fixed_type_const : string -> string
  202.16 +  val make_fixed_const : bool -> string -> string
  202.17 +  val make_fixed_type_const : bool -> string -> string
  202.18    val make_type_class : string -> string
  202.19    datatype kind = Axiom | Conjecture
  202.20    type axiom_name = string
  202.21 @@ -50,6 +48,7 @@
  202.22    datatype classrelClause = ClassrelClause of
  202.23     {axiom_name: axiom_name, subclass: class, superclass: class}
  202.24    val make_classrel_clauses: theory -> class list -> class list -> classrelClause list
  202.25 +  val make_arity_clauses_dfg: bool -> theory -> string list -> class list -> class list * arityClause list
  202.26    val make_arity_clauses: theory -> string list -> class list -> class list * arityClause list
  202.27    val add_type_sort_preds: typ * int Symtab.table -> int Symtab.table
  202.28    val add_classrelClause_preds : classrelClause * int Symtab.table -> int Symtab.table
  202.29 @@ -95,7 +94,7 @@
  202.30  val tconst_prefix = "tc_";
  202.31  val class_prefix = "class_";
  202.32  
  202.33 -fun union_all xss = foldl (op union) [] xss;
  202.34 +fun union_all xss = List.foldl (op union) [] xss;
  202.35  
  202.36  (*Provide readable names for the more common symbolic functions*)
  202.37  val const_trans_table =
  202.38 @@ -197,28 +196,26 @@
  202.39  fun make_fixed_type_var x = tfree_prefix ^ (ascii_of (trim_type_var x));
  202.40  
  202.41  (*HACK because SPASS truncates identifiers to 63 characters :-(( *)
  202.42 -val dfg_format = ref false;
  202.43 -
  202.44  (*32-bit hash,so we expect no collisions unless there are around 65536 long identifiers...*)
  202.45 -fun controlled_length s =
  202.46 -  if size s > 60 andalso !dfg_format
  202.47 +fun controlled_length dfg_format s =
  202.48 +  if size s > 60 andalso dfg_format
  202.49    then Word.toString (Polyhash.hashw_string(s,0w0))
  202.50    else s;
  202.51  
  202.52 -fun lookup_const c =
  202.53 +fun lookup_const dfg c =
  202.54      case Symtab.lookup const_trans_table c of
  202.55          SOME c' => c'
  202.56 -      | NONE => controlled_length (ascii_of c);
  202.57 +      | NONE => controlled_length dfg (ascii_of c);
  202.58  
  202.59 -fun lookup_type_const c =
  202.60 +fun lookup_type_const dfg c =
  202.61      case Symtab.lookup type_const_trans_table c of
  202.62          SOME c' => c'
  202.63 -      | NONE => controlled_length (ascii_of c);
  202.64 +      | NONE => controlled_length dfg (ascii_of c);
  202.65  
  202.66 -fun make_fixed_const "op =" = "equal"   (*MUST BE "equal" because it's built-in to ATPs*)
  202.67 -  | make_fixed_const c      = const_prefix ^ lookup_const c;
  202.68 +fun make_fixed_const _ "op =" = "equal"   (*MUST BE "equal" because it's built-in to ATPs*)
  202.69 +  | make_fixed_const dfg c      = const_prefix ^ lookup_const dfg c;
  202.70  
  202.71 -fun make_fixed_type_const c = tconst_prefix ^ lookup_type_const c;
  202.72 +fun make_fixed_type_const dfg c = tconst_prefix ^ lookup_type_const dfg c;
  202.73  
  202.74  fun make_type_class clas = class_prefix ^ ascii_of clas;
  202.75  
  202.76 @@ -251,13 +248,13 @@
  202.77  
  202.78  (*Flatten a type to a fol_type while accumulating sort constraints on the TFrees and
  202.79    TVars it contains.*)
  202.80 -fun type_of (Type (a, Ts)) =
  202.81 -      let val (folTyps, ts) = types_of Ts
  202.82 -          val t = make_fixed_type_const a
  202.83 +fun type_of dfg (Type (a, Ts)) =
  202.84 +      let val (folTyps, ts) = types_of dfg Ts
  202.85 +          val t = make_fixed_type_const dfg a
  202.86        in (Comp(t,folTyps), ts) end
  202.87 -  | type_of T = (atomic_type T, [T])
  202.88 -and types_of Ts =
  202.89 -      let val (folTyps,ts) = ListPair.unzip (map type_of Ts)
  202.90 +  | type_of dfg T = (atomic_type T, [T])
  202.91 +and types_of dfg Ts =
  202.92 +      let val (folTyps,ts) = ListPair.unzip (map (type_of dfg) Ts)
  202.93        in (folTyps, union_all ts) end;
  202.94  
  202.95  (*Make literals for sorted type variables*)
  202.96 @@ -277,7 +274,7 @@
  202.97    | pred_of_sort (LTFree (s,ty)) = (s,1)
  202.98  
  202.99  (*Given a list of sorted type variables, return a list of type literals.*)
 202.100 -fun add_typs Ts = foldl (op union) [] (map sorts_on_typs Ts);
 202.101 +fun add_typs Ts = List.foldl (op union) [] (map sorts_on_typs Ts);
 202.102  
 202.103  (*The correct treatment of TFrees like 'a in lemmas (axiom clauses) is not clear.
 202.104    * Ignoring them leads to unsound proofs, since we do nothing to ensure that 'a
 202.105 @@ -317,12 +314,12 @@
 202.106    | pack_sort(tvar, cls::srt) =  (cls, tvar) :: pack_sort(tvar, srt);
 202.107  
 202.108  (*Arity of type constructor tcon :: (arg1,...,argN)res*)
 202.109 -fun make_axiom_arity_clause (tcons, axiom_name, (cls,args)) =
 202.110 +fun make_axiom_arity_clause dfg (tcons, axiom_name, (cls,args)) =
 202.111     let val tvars = gen_TVars (length args)
 202.112         val tvars_srts = ListPair.zip (tvars,args)
 202.113     in
 202.114        ArityClause {axiom_name = axiom_name, 
 202.115 -                   conclLit = TConsLit (cls, make_fixed_type_const tcons, tvars),
 202.116 +                   conclLit = TConsLit (cls, make_fixed_type_const dfg tcons, tvars),
 202.117                     premLits = map TVarLit (union_all(map pack_sort tvars_srts))}
 202.118     end;
 202.119  
 202.120 @@ -340,8 +337,8 @@
 202.121        let val class_less = Sorts.class_less(Sign.classes_of thy)
 202.122            fun add_super sub (super,pairs) =
 202.123                  if class_less (sub,super) then (sub,super)::pairs else pairs
 202.124 -          fun add_supers (sub,pairs) = foldl (add_super sub) pairs supers
 202.125 -      in  foldl add_supers [] subs  end;
 202.126 +          fun add_supers (sub,pairs) = List.foldl (add_super sub) pairs supers
 202.127 +      in  List.foldl add_supers [] subs  end;
 202.128  
 202.129  fun make_classrelClause (sub,super) =
 202.130    ClassrelClause {axiom_name = clrelclause_prefix ^ ascii_of sub ^ "_" ^ ascii_of super,
 202.131 @@ -354,20 +351,20 @@
 202.132  
 202.133  (** Isabelle arities **)
 202.134  
 202.135 -fun arity_clause _ _ (tcons, []) = []
 202.136 -  | arity_clause seen n (tcons, ("HOL.type",_)::ars) =  (*ignore*)
 202.137 -      arity_clause seen n (tcons,ars)
 202.138 -  | arity_clause seen n (tcons, (ar as (class,_)) :: ars) =
 202.139 +fun arity_clause dfg _ _ (tcons, []) = []
 202.140 +  | arity_clause dfg seen n (tcons, ("HOL.type",_)::ars) =  (*ignore*)
 202.141 +      arity_clause dfg seen n (tcons,ars)
 202.142 +  | arity_clause dfg seen n (tcons, (ar as (class,_)) :: ars) =
 202.143        if class mem_string seen then (*multiple arities for the same tycon, class pair*)
 202.144 -          make_axiom_arity_clause (tcons, lookup_type_const tcons ^ "_" ^ class ^ "_" ^ Int.toString n, ar) ::
 202.145 -          arity_clause seen (n+1) (tcons,ars)
 202.146 +          make_axiom_arity_clause dfg (tcons, lookup_type_const dfg tcons ^ "_" ^ class ^ "_" ^ Int.toString n, ar) ::
 202.147 +          arity_clause dfg seen (n+1) (tcons,ars)
 202.148        else
 202.149 -          make_axiom_arity_clause (tcons, lookup_type_const tcons ^ "_" ^ class, ar) ::
 202.150 -          arity_clause (class::seen) n (tcons,ars)
 202.151 +          make_axiom_arity_clause dfg (tcons, lookup_type_const dfg tcons ^ "_" ^ class, ar) ::
 202.152 +          arity_clause dfg (class::seen) n (tcons,ars)
 202.153  
 202.154 -fun multi_arity_clause [] = []
 202.155 -  | multi_arity_clause ((tcons,ars) :: tc_arlists) =
 202.156 -      arity_clause [] 1 (tcons, ars)  @  multi_arity_clause tc_arlists
 202.157 +fun multi_arity_clause dfg [] = []
 202.158 +  | multi_arity_clause dfg ((tcons,ars) :: tc_arlists) =
 202.159 +      arity_clause dfg [] 1 (tcons, ars)  @  multi_arity_clause dfg tc_arlists
 202.160  
 202.161  (*Generate all pairs (tycon,class,sorts) such that tycon belongs to class in theory thy
 202.162    provided its arguments have the corresponding sorts.*)
 202.163 @@ -377,7 +374,7 @@
 202.164        fun add_class tycon (class,pairs) =
 202.165              (class, domain_sorts(tycon,class))::pairs
 202.166              handle Sorts.CLASS_ERROR _ => pairs
 202.167 -      fun try_classes tycon = (tycon, foldl (add_class tycon) [] classes)
 202.168 +      fun try_classes tycon = (tycon, List.foldl (add_class tycon) [] classes)
 202.169    in  map try_classes tycons  end;
 202.170  
 202.171  (*Proving one (tycon, class) membership may require proving others, so iterate.*)
 202.172 @@ -390,17 +387,17 @@
 202.173            val (classes', cpairs') = iter_type_class_pairs thy tycons newclasses
 202.174        in  (classes' union classes, cpairs' union cpairs)  end;
 202.175  
 202.176 -fun make_arity_clauses thy tycons classes =
 202.177 +fun make_arity_clauses_dfg dfg thy tycons classes =
 202.178    let val (classes', cpairs) = iter_type_class_pairs thy tycons classes
 202.179 -  in  (classes', multi_arity_clause cpairs)  end;
 202.180 -
 202.181 +  in  (classes', multi_arity_clause dfg cpairs)  end;
 202.182 +val make_arity_clauses = make_arity_clauses_dfg false;
 202.183  
 202.184  (**** Find occurrences of predicates in clauses ****)
 202.185  
 202.186  (*FIXME: multiple-arity checking doesn't work, as update_new is the wrong
 202.187    function (it flags repeated declarations of a function, even with the same arity)*)
 202.188  
 202.189 -fun update_many (tab, keypairs) = foldl (uncurry Symtab.update) tab keypairs;
 202.190 +fun update_many (tab, keypairs) = List.foldl (uncurry Symtab.update) tab keypairs;
 202.191  
 202.192  fun add_type_sort_preds (T, preds) =
 202.193        update_many (preds, map pred_of_sort (sorts_on_typs T));
 202.194 @@ -414,14 +411,14 @@
 202.195  fun add_arityClause_preds (ArityClause {conclLit,premLits,...}, preds) =
 202.196    let val classes = map (make_type_class o class_of_arityLit) (conclLit::premLits)
 202.197        fun upd (class,preds) = Symtab.update (class,1) preds
 202.198 -  in  foldl upd preds classes  end;
 202.199 +  in  List.foldl upd preds classes  end;
 202.200  
 202.201  (*** Find occurrences of functions in clauses ***)
 202.202  
 202.203  fun add_foltype_funcs (AtomV _, funcs) = funcs
 202.204    | add_foltype_funcs (AtomF a, funcs) = Symtab.update (a,0) funcs
 202.205    | add_foltype_funcs (Comp(a,tys), funcs) =
 202.206 -      foldl add_foltype_funcs (Symtab.update (a, length tys) funcs) tys;
 202.207 +      List.foldl add_foltype_funcs (Symtab.update (a, length tys) funcs) tys;
 202.208  
 202.209  (*TFrees are recorded as constants*)
 202.210  fun add_type_sort_funcs (TVar _, funcs) = funcs
   203.1 --- a/src/HOL/Tools/res_hol_clause.ML	Wed Mar 04 10:43:39 2009 +0100
   203.2 +++ b/src/HOL/Tools/res_hol_clause.ML	Wed Mar 04 10:45:52 2009 +0100
   203.3 @@ -1,4 +1,4 @@
   203.4 -(* ID: $Id$
   203.5 +(*
   203.6     Author: Jia Meng, NICTA
   203.7  
   203.8  FOL clauses translated from HOL formulae.
   203.9 @@ -13,8 +13,8 @@
  203.10    val comb_C: thm
  203.11    val comb_S: thm
  203.12    datatype type_level = T_FULL | T_CONST
  203.13 -  val typ_level: type_level ref
  203.14 -  val minimize_applies: bool ref
  203.15 +  val typ_level: type_level
  203.16 +  val minimize_applies: bool
  203.17    type axiom_name = string
  203.18    type polarity = bool
  203.19    type clause_id = int
  203.20 @@ -53,22 +53,18 @@
  203.21  (*The different translations of types*)
  203.22  datatype type_level = T_FULL | T_CONST;
  203.23  
  203.24 -val typ_level = ref T_CONST;
  203.25 +val typ_level = T_CONST;
  203.26  
  203.27  (*If true, each function will be directly applied to as many arguments as possible, avoiding
  203.28    use of the "apply" operator. Use of hBOOL is also minimized.*)
  203.29 -val minimize_applies = ref true;
  203.30 +val minimize_applies = true;
  203.31  
  203.32 -val const_min_arity = ref (Symtab.empty : int Symtab.table);
  203.33 -
  203.34 -val const_needs_hBOOL = ref (Symtab.empty : bool Symtab.table);
  203.35 -
  203.36 -fun min_arity_of c = getOpt (Symtab.lookup(!const_min_arity) c, 0);
  203.37 +fun min_arity_of const_min_arity c = getOpt (Symtab.lookup const_min_arity c, 0);
  203.38  
  203.39  (*True if the constant ever appears outside of the top-level position in literals.
  203.40    If false, the constant always receives all of its arguments and is used as a predicate.*)
  203.41 -fun needs_hBOOL c = not (!minimize_applies) orelse
  203.42 -                    getOpt (Symtab.lookup(!const_needs_hBOOL) c, false);
  203.43 +fun needs_hBOOL const_needs_hBOOL c = not minimize_applies orelse
  203.44 +                    getOpt (Symtab.lookup const_needs_hBOOL c, false);
  203.45  
  203.46  
  203.47  (******************************************************)
  203.48 @@ -110,67 +106,68 @@
  203.49  
  203.50  fun isTaut (Clause {literals,...}) = exists isTrue literals;
  203.51  
  203.52 -fun type_of (Type (a, Ts)) =
  203.53 -      let val (folTypes,ts) = types_of Ts
  203.54 -      in  (RC.Comp(RC.make_fixed_type_const a, folTypes), ts)  end
  203.55 -  | type_of (tp as (TFree(a,s))) =
  203.56 +fun type_of dfg (Type (a, Ts)) =
  203.57 +      let val (folTypes,ts) = types_of dfg Ts
  203.58 +      in  (RC.Comp(RC.make_fixed_type_const dfg a, folTypes), ts)  end
  203.59 +  | type_of dfg (tp as (TFree(a,s))) =
  203.60        (RC.AtomF (RC.make_fixed_type_var a), [tp])
  203.61 -  | type_of (tp as (TVar(v,s))) =
  203.62 +  | type_of dfg (tp as (TVar(v,s))) =
  203.63        (RC.AtomV (RC.make_schematic_type_var v), [tp])
  203.64 -and types_of Ts =
  203.65 -      let val (folTyps,ts) = ListPair.unzip (map type_of Ts)
  203.66 +and types_of dfg Ts =
  203.67 +      let val (folTyps,ts) = ListPair.unzip (map (type_of dfg) Ts)
  203.68        in  (folTyps, RC.union_all ts)  end;
  203.69  
  203.70  (* same as above, but no gathering of sort information *)
  203.71 -fun simp_type_of (Type (a, Ts)) =
  203.72 -      RC.Comp(RC.make_fixed_type_const a, map simp_type_of Ts)
  203.73 -  | simp_type_of (TFree (a,s)) = RC.AtomF(RC.make_fixed_type_var a)
  203.74 -  | simp_type_of (TVar (v,s)) = RC.AtomV(RC.make_schematic_type_var v);
  203.75 +fun simp_type_of dfg (Type (a, Ts)) =
  203.76 +      RC.Comp(RC.make_fixed_type_const dfg a, map (simp_type_of dfg) Ts)
  203.77 +  | simp_type_of dfg (TFree (a,s)) = RC.AtomF(RC.make_fixed_type_var a)
  203.78 +  | simp_type_of dfg (TVar (v,s)) = RC.AtomV(RC.make_schematic_type_var v);
  203.79  
  203.80  
  203.81 -fun const_type_of thy (c,t) =
  203.82 -      let val (tp,ts) = type_of t
  203.83 -      in  (tp, ts, map simp_type_of (Sign.const_typargs thy (c,t))) end;
  203.84 +fun const_type_of dfg thy (c,t) =
  203.85 +      let val (tp,ts) = type_of dfg t
  203.86 +      in  (tp, ts, map (simp_type_of dfg) (Sign.const_typargs thy (c,t))) end;
  203.87  
  203.88  (* convert a Term.term (with combinators) into a combterm, also accummulate sort info *)
  203.89 -fun combterm_of thy (Const(c,t)) =
  203.90 -      let val (tp,ts,tvar_list) = const_type_of thy (c,t)
  203.91 -          val c' = CombConst(RC.make_fixed_const c, tp, tvar_list)
  203.92 +fun combterm_of dfg thy (Const(c,t)) =
  203.93 +      let val (tp,ts,tvar_list) = const_type_of dfg thy (c,t)
  203.94 +          val c' = CombConst(RC.make_fixed_const dfg c, tp, tvar_list)
  203.95        in  (c',ts)  end
  203.96 -  | combterm_of thy (Free(v,t)) =
  203.97 -      let val (tp,ts) = type_of t
  203.98 +  | combterm_of dfg thy (Free(v,t)) =
  203.99 +      let val (tp,ts) = type_of dfg t
 203.100            val v' = CombConst(RC.make_fixed_var v, tp, [])
 203.101        in  (v',ts)  end
 203.102 -  | combterm_of thy (Var(v,t)) =
 203.103 -      let val (tp,ts) = type_of t
 203.104 +  | combterm_of dfg thy (Var(v,t)) =
 203.105 +      let val (tp,ts) = type_of dfg t
 203.106            val v' = CombVar(RC.make_schematic_var v,tp)
 203.107        in  (v',ts)  end
 203.108 -  | combterm_of thy (P $ Q) =
 203.109 -      let val (P',tsP) = combterm_of thy P
 203.110 -          val (Q',tsQ) = combterm_of thy Q
 203.111 +  | combterm_of dfg thy (P $ Q) =
 203.112 +      let val (P',tsP) = combterm_of dfg thy P
 203.113 +          val (Q',tsQ) = combterm_of dfg thy Q
 203.114        in  (CombApp(P',Q'), tsP union tsQ)  end
 203.115 -  | combterm_of thy (t as Abs _) = raise RC.CLAUSE("HOL CLAUSE",t);
 203.116 +  | combterm_of _ thy (t as Abs _) = raise RC.CLAUSE("HOL CLAUSE",t);
 203.117  
 203.118 -fun predicate_of thy ((Const("Not",_) $ P), polarity) = predicate_of thy (P, not polarity)
 203.119 -  | predicate_of thy (t,polarity) = (combterm_of thy (Envir.eta_contract t), polarity);
 203.120 +fun predicate_of dfg thy ((Const("Not",_) $ P), polarity) = predicate_of dfg thy (P, not polarity)
 203.121 +  | predicate_of dfg thy (t,polarity) = (combterm_of dfg thy (Envir.eta_contract t), polarity);
 203.122  
 203.123 -fun literals_of_term1 thy args (Const("Trueprop",_) $ P) = literals_of_term1 thy args P
 203.124 -  | literals_of_term1 thy args (Const("op |",_) $ P $ Q) =
 203.125 -      literals_of_term1 thy (literals_of_term1 thy args P) Q
 203.126 -  | literals_of_term1 thy (lits,ts) P =
 203.127 -      let val ((pred,ts'),pol) = predicate_of thy (P,true)
 203.128 +fun literals_of_term1 dfg thy args (Const("Trueprop",_) $ P) = literals_of_term1 dfg thy args P
 203.129 +  | literals_of_term1 dfg thy args (Const("op |",_) $ P $ Q) =
 203.130 +      literals_of_term1 dfg thy (literals_of_term1 dfg thy args P) Q
 203.131 +  | literals_of_term1 dfg thy (lits,ts) P =
 203.132 +      let val ((pred,ts'),pol) = predicate_of dfg thy (P,true)
 203.133        in
 203.134            (Literal(pol,pred)::lits, ts union ts')
 203.135        end;
 203.136  
 203.137 -fun literals_of_term thy P = literals_of_term1 thy ([],[]) P;
 203.138 +fun literals_of_term_dfg dfg thy P = literals_of_term1 dfg thy ([],[]) P;
 203.139 +val literals_of_term = literals_of_term_dfg false;
 203.140  
 203.141  (* Problem too trivial for resolution (empty clause) *)
 203.142  exception TOO_TRIVIAL;
 203.143  
 203.144  (* making axiom and conjecture clauses *)
 203.145 -fun make_clause thy (clause_id,axiom_name,kind,th) =
 203.146 -    let val (lits,ctypes_sorts) = literals_of_term thy (prop_of th)
 203.147 +fun make_clause dfg thy (clause_id,axiom_name,kind,th) =
 203.148 +    let val (lits,ctypes_sorts) = literals_of_term_dfg dfg thy (prop_of th)
 203.149      in
 203.150          if forall isFalse lits
 203.151          then raise TOO_TRIVIAL
 203.152 @@ -180,20 +177,20 @@
 203.153      end;
 203.154  
 203.155  
 203.156 -fun add_axiom_clause thy ((th,(name,id)), pairs) =
 203.157 -  let val cls = make_clause thy (id, name, RC.Axiom, th)
 203.158 +fun add_axiom_clause dfg thy ((th,(name,id)), pairs) =
 203.159 +  let val cls = make_clause dfg thy (id, name, RC.Axiom, th)
 203.160    in
 203.161        if isTaut cls then pairs else (name,cls)::pairs
 203.162    end;
 203.163  
 203.164 -fun make_axiom_clauses thy = foldl (add_axiom_clause thy) [];
 203.165 +fun make_axiom_clauses dfg thy = List.foldl (add_axiom_clause dfg thy) [];
 203.166  
 203.167 -fun make_conjecture_clauses_aux _ _ [] = []
 203.168 -  | make_conjecture_clauses_aux thy n (th::ths) =
 203.169 -      make_clause thy (n,"conjecture", RC.Conjecture, th) ::
 203.170 -      make_conjecture_clauses_aux thy (n+1) ths;
 203.171 +fun make_conjecture_clauses_aux dfg _ _ [] = []
 203.172 +  | make_conjecture_clauses_aux dfg thy n (th::ths) =
 203.173 +      make_clause dfg thy (n,"conjecture", RC.Conjecture, th) ::
 203.174 +      make_conjecture_clauses_aux dfg thy (n+1) ths;
 203.175  
 203.176 -fun make_conjecture_clauses thy = make_conjecture_clauses_aux thy 0;
 203.177 +fun make_conjecture_clauses dfg thy = make_conjecture_clauses_aux dfg thy 0;
 203.178  
 203.179  
 203.180  (**********************************************************************)
 203.181 @@ -218,11 +215,11 @@
 203.182  
 203.183  val type_wrapper = "ti";
 203.184  
 203.185 -fun head_needs_hBOOL (CombConst(c,_,_)) = needs_hBOOL c
 203.186 -  | head_needs_hBOOL _ = true;
 203.187 +fun head_needs_hBOOL const_needs_hBOOL (CombConst(c,_,_)) = needs_hBOOL const_needs_hBOOL c
 203.188 +  | head_needs_hBOOL const_needs_hBOOL _ = true;
 203.189  
 203.190  fun wrap_type (s, tp) =
 203.191 -  if !typ_level=T_FULL then
 203.192 +  if typ_level=T_FULL then
 203.193        type_wrapper ^ RC.paren_pack [s, RC.string_of_fol_type tp]
 203.194    else s;
 203.195  
 203.196 @@ -235,43 +232,43 @@
 203.197  
 203.198  (*Apply an operator to the argument strings, using either the "apply" operator or
 203.199    direct function application.*)
 203.200 -fun string_of_applic (CombConst(c,tp,tvars), args) =
 203.201 +fun string_of_applic cma (CombConst(c,tp,tvars), args) =
 203.202        let val c = if c = "equal" then "c_fequal" else c
 203.203 -          val nargs = min_arity_of c
 203.204 +          val nargs = min_arity_of cma c
 203.205            val args1 = List.take(args, nargs)
 203.206              handle Subscript => error ("string_of_applic: " ^ c ^ " has arity " ^
 203.207                                           Int.toString nargs ^ " but is applied to " ^
 203.208                                           space_implode ", " args)
 203.209            val args2 = List.drop(args, nargs)
 203.210 -          val targs = if !typ_level = T_CONST then map RC.string_of_fol_type tvars
 203.211 +          val targs = if typ_level = T_CONST then map RC.string_of_fol_type tvars
 203.212                        else []
 203.213        in
 203.214            string_apply (c ^ RC.paren_pack (args1@targs), args2)
 203.215        end
 203.216 -  | string_of_applic (CombVar(v,tp), args) = string_apply (v, args)
 203.217 -  | string_of_applic _ = error "string_of_applic";
 203.218 +  | string_of_applic cma (CombVar(v,tp), args) = string_apply (v, args)
 203.219 +  | string_of_applic _ _ = error "string_of_applic";
 203.220  
 203.221 -fun wrap_type_if (head, s, tp) = if head_needs_hBOOL head then wrap_type (s, tp) else s;
 203.222 +fun wrap_type_if cnh (head, s, tp) = if head_needs_hBOOL cnh head then wrap_type (s, tp) else s;
 203.223  
 203.224 -fun string_of_combterm t =
 203.225 +fun string_of_combterm cma cnh t =
 203.226    let val (head, args) = strip_comb t
 203.227 -  in  wrap_type_if (head,
 203.228 -                    string_of_applic (head, map string_of_combterm args),
 203.229 +  in  wrap_type_if cnh (head,
 203.230 +                    string_of_applic cma (head, map (string_of_combterm cma cnh) args),
 203.231                      type_of_combterm t)
 203.232    end;
 203.233  
 203.234  (*Boolean-valued terms are here converted to literals.*)
 203.235 -fun boolify t = "hBOOL" ^ RC.paren_pack [string_of_combterm t];
 203.236 +fun boolify cma cnh t = "hBOOL" ^ RC.paren_pack [string_of_combterm cma cnh t];
 203.237  
 203.238 -fun string_of_predicate t =
 203.239 +fun string_of_predicate cma cnh t =
 203.240    case t of
 203.241        (CombApp(CombApp(CombConst("equal",_,_), t1), t2)) =>
 203.242            (*DFG only: new TPTP prefers infix equality*)
 203.243 -          ("equal" ^ RC.paren_pack [string_of_combterm t1, string_of_combterm t2])
 203.244 +          ("equal" ^ RC.paren_pack [string_of_combterm cma cnh t1, string_of_combterm cma cnh t2])
 203.245      | _ =>
 203.246            case #1 (strip_comb t) of
 203.247 -              CombConst(c,_,_) => if needs_hBOOL c then boolify t else string_of_combterm t
 203.248 -            | _ => boolify t;
 203.249 +              CombConst(c,_,_) => if needs_hBOOL cnh c then boolify cma cnh t else string_of_combterm cma cnh t
 203.250 +            | _ => boolify cma cnh t;
 203.251  
 203.252  fun string_of_clausename (cls_id,ax_name) =
 203.253      RC.clause_prefix ^ RC.ascii_of ax_name ^ "_" ^ Int.toString cls_id;
 203.254 @@ -282,23 +279,23 @@
 203.255  
 203.256  (*** tptp format ***)
 203.257  
 203.258 -fun tptp_of_equality pol (t1,t2) =
 203.259 +fun tptp_of_equality cma cnh pol (t1,t2) =
 203.260    let val eqop = if pol then " = " else " != "
 203.261 -  in  string_of_combterm t1 ^ eqop ^ string_of_combterm t2  end;
 203.262 +  in  string_of_combterm cma cnh t1 ^ eqop ^ string_of_combterm cma cnh t2  end;
 203.263  
 203.264 -fun tptp_literal (Literal(pol, CombApp(CombApp(CombConst("equal",_,_), t1), t2))) =
 203.265 -      tptp_of_equality pol (t1,t2)
 203.266 -  | tptp_literal (Literal(pol,pred)) =
 203.267 -      RC.tptp_sign pol (string_of_predicate pred);
 203.268 +fun tptp_literal cma cnh (Literal(pol, CombApp(CombApp(CombConst("equal",_,_), t1), t2))) =
 203.269 +      tptp_of_equality cma cnh pol (t1,t2)
 203.270 +  | tptp_literal cma cnh (Literal(pol,pred)) =
 203.271 +      RC.tptp_sign pol (string_of_predicate cma cnh pred);
 203.272  
 203.273  (*Given a clause, returns its literals paired with a list of literals concerning TFrees;
 203.274    the latter should only occur in conjecture clauses.*)
 203.275 -fun tptp_type_lits pos (Clause{literals, ctypes_sorts, ...}) =
 203.276 -      (map tptp_literal literals, 
 203.277 +fun tptp_type_lits cma cnh pos (Clause{literals, ctypes_sorts, ...}) =
 203.278 +      (map (tptp_literal cma cnh) literals, 
 203.279         map (RC.tptp_of_typeLit pos) (RC.add_typs ctypes_sorts));
 203.280  
 203.281 -fun clause2tptp (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
 203.282 -  let val (lits,tylits) = tptp_type_lits (kind = RC.Conjecture) cls
 203.283 +fun clause2tptp cma cnh (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
 203.284 +  let val (lits,tylits) = tptp_type_lits cma cnh (kind = RC.Conjecture) cls
 203.285    in
 203.286        (RC.gen_tptp_cls(clause_id,axiom_name,kind,lits,tylits), tylits)
 203.287    end;
 203.288 @@ -306,10 +303,10 @@
 203.289  
 203.290  (*** dfg format ***)
 203.291  
 203.292 -fun dfg_literal (Literal(pol,pred)) = RC.dfg_sign pol (string_of_predicate pred);
 203.293 +fun dfg_literal cma cnh (Literal(pol,pred)) = RC.dfg_sign pol (string_of_predicate cma cnh pred);
 203.294  
 203.295 -fun dfg_type_lits pos (Clause{literals, ctypes_sorts, ...}) =
 203.296 -      (map dfg_literal literals, 
 203.297 +fun dfg_type_lits cma cnh pos (Clause{literals, ctypes_sorts, ...}) =
 203.298 +      (map (dfg_literal cma cnh) literals, 
 203.299         map (RC.dfg_of_typeLit pos) (RC.add_typs ctypes_sorts));
 203.300  
 203.301  fun get_uvars (CombConst _) vars = vars
 203.302 @@ -320,8 +317,8 @@
 203.303  
 203.304  fun dfg_vars (Clause {literals,...}) = RC.union_all (map get_uvars_l literals);
 203.305  
 203.306 -fun clause2dfg (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
 203.307 -  let val (lits,tylits) = dfg_type_lits (kind = RC.Conjecture) cls
 203.308 +fun clause2dfg cma cnh (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
 203.309 +  let val (lits,tylits) = dfg_type_lits cma cnh (kind = RC.Conjecture) cls
 203.310        val vars = dfg_vars cls
 203.311        val tvars = RC.get_tvar_strs ctypes_sorts
 203.312    in
 203.313 @@ -331,47 +328,47 @@
 203.314  
 203.315  (** For DFG format: accumulate function and predicate declarations **)
 203.316  
 203.317 -fun addtypes tvars tab = foldl RC.add_foltype_funcs tab tvars;
 203.318 +fun addtypes tvars tab = List.foldl RC.add_foltype_funcs tab tvars;
 203.319  
 203.320 -fun add_decls (CombConst(c,tp,tvars), (funcs,preds)) =
 203.321 +fun add_decls cma cnh (CombConst(c,tp,tvars), (funcs,preds)) =
 203.322        if c = "equal" then (addtypes tvars funcs, preds)
 203.323        else
 203.324 -	let val arity = min_arity_of c
 203.325 -	    val ntys = if !typ_level = T_CONST then length tvars else 0
 203.326 +	let val arity = min_arity_of cma c
 203.327 +	    val ntys = if typ_level = T_CONST then length tvars else 0
 203.328  	    val addit = Symtab.update(c, arity+ntys)
 203.329  	in
 203.330 -	    if needs_hBOOL c then (addtypes tvars (addit funcs), preds)
 203.331 +	    if needs_hBOOL cnh c then (addtypes tvars (addit funcs), preds)
 203.332  	    else (addtypes tvars funcs, addit preds)
 203.333  	end
 203.334 -  | add_decls (CombVar(_,ctp), (funcs,preds)) =
 203.335 +  | add_decls _ _ (CombVar(_,ctp), (funcs,preds)) =
 203.336        (RC.add_foltype_funcs (ctp,funcs), preds)
 203.337 -  | add_decls (CombApp(P,Q),decls) = add_decls(P,add_decls (Q,decls));
 203.338 +  | add_decls cma cnh (CombApp(P,Q),decls) = add_decls cma cnh (P,add_decls cma cnh (Q,decls));
 203.339  
 203.340 -fun add_literal_decls (Literal(_,c), decls) = add_decls (c,decls);
 203.341 +fun add_literal_decls cma cnh (Literal(_,c), decls) = add_decls cma cnh (c,decls);
 203.342  
 203.343 -fun add_clause_decls (Clause {literals, ...}, decls) =
 203.344 -    foldl add_literal_decls decls literals
 203.345 +fun add_clause_decls cma cnh (Clause {literals, ...}, decls) =
 203.346 +    List.foldl (add_literal_decls cma cnh) decls literals
 203.347      handle Symtab.DUP a => error ("function " ^ a ^ " has multiple arities")
 203.348  
 203.349 -fun decls_of_clauses clauses arity_clauses =
 203.350 +fun decls_of_clauses cma cnh clauses arity_clauses =
 203.351    let val init_functab = Symtab.update (type_wrapper,2) (Symtab.update ("hAPP",2) RC.init_functab)
 203.352        val init_predtab = Symtab.update ("hBOOL",1) Symtab.empty
 203.353 -      val (functab,predtab) = (foldl add_clause_decls (init_functab, init_predtab) clauses)
 203.354 +      val (functab,predtab) = (List.foldl (add_clause_decls cma cnh) (init_functab, init_predtab) clauses)
 203.355    in
 203.356 -      (Symtab.dest (foldl RC.add_arityClause_funcs functab arity_clauses),
 203.357 +      (Symtab.dest (List.foldl RC.add_arityClause_funcs functab arity_clauses),
 203.358         Symtab.dest predtab)
 203.359    end;
 203.360  
 203.361  fun add_clause_preds (Clause {ctypes_sorts, ...}, preds) =
 203.362 -  foldl RC.add_type_sort_preds preds ctypes_sorts
 203.363 +  List.foldl RC.add_type_sort_preds preds ctypes_sorts
 203.364    handle Symtab.DUP a => error ("predicate " ^ a ^ " has multiple arities")
 203.365  
 203.366  (*Higher-order clauses have only the predicates hBOOL and type classes.*)
 203.367  fun preds_of_clauses clauses clsrel_clauses arity_clauses =
 203.368      Symtab.dest
 203.369 -        (foldl RC.add_classrelClause_preds
 203.370 -               (foldl RC.add_arityClause_preds
 203.371 -                      (foldl add_clause_preds Symtab.empty clauses)
 203.372 +        (List.foldl RC.add_classrelClause_preds
 203.373 +               (List.foldl RC.add_arityClause_preds
 203.374 +                      (List.foldl add_clause_preds Symtab.empty clauses)
 203.375                        arity_clauses)
 203.376                 clsrel_clauses)
 203.377  
 203.378 @@ -393,20 +390,20 @@
 203.379  
 203.380  fun count_literal (Literal(_,t), ct) = count_combterm(t,ct);
 203.381  
 203.382 -fun count_clause (Clause{literals,...}, ct) = foldl count_literal ct literals;
 203.383 +fun count_clause (Clause{literals,...}, ct) = List.foldl count_literal ct literals;
 203.384  
 203.385  fun count_user_clause user_lemmas (Clause{axiom_name,literals,...}, ct) =
 203.386 -  if axiom_name mem_string user_lemmas then foldl count_literal ct literals
 203.387 +  if axiom_name mem_string user_lemmas then List.foldl count_literal ct literals
 203.388    else ct;
 203.389  
 203.390  fun cnf_helper_thms thy =
 203.391    ResAxioms.cnf_rules_pairs thy o map ResAxioms.pairname
 203.392  
 203.393 -fun get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas) =
 203.394 +fun get_helper_clauses dfg thy isFO (conjectures, axclauses, user_lemmas) =
 203.395    if isFO then []  (*first-order*)
 203.396    else
 203.397 -    let val ct0 = foldl count_clause init_counters conjectures
 203.398 -        val ct = foldl (count_user_clause user_lemmas) ct0 axclauses
 203.399 +    let val ct0 = List.foldl count_clause init_counters conjectures
 203.400 +        val ct = List.foldl (count_user_clause user_lemmas) ct0 axclauses
 203.401          fun needed c = valOf (Symtab.lookup ct c) > 0
 203.402          val IK = if needed "c_COMBI" orelse needed "c_COMBK"
 203.403                   then (Output.debug (fn () => "Include combinator I K"); cnf_helper_thms thy [comb_I,comb_K])
 203.404 @@ -419,66 +416,67 @@
 203.405                  else []
 203.406          val other = cnf_helper_thms thy [ext,fequal_imp_equal,equal_imp_fequal]
 203.407      in
 203.408 -        map #2 (make_axiom_clauses thy (other @ IK @ BC @ S))
 203.409 +        map #2 (make_axiom_clauses dfg thy (other @ IK @ BC @ S))
 203.410      end;
 203.411  
 203.412  (*Find the minimal arity of each function mentioned in the term. Also, note which uses
 203.413    are not at top level, to see if hBOOL is needed.*)
 203.414 -fun count_constants_term toplev t =
 203.415 +fun count_constants_term toplev t (const_min_arity, const_needs_hBOOL) =
 203.416    let val (head, args) = strip_comb t
 203.417        val n = length args
 203.418 -      val _ = List.app (count_constants_term false) args
 203.419 +      val (const_min_arity, const_needs_hBOOL) = fold (count_constants_term false) args (const_min_arity, const_needs_hBOOL)
 203.420    in
 203.421        case head of
 203.422            CombConst (a,_,_) => (*predicate or function version of "equal"?*)
 203.423              let val a = if a="equal" andalso not toplev then "c_fequal" else a
 203.424 +            val const_min_arity = Symtab.map_default (a,n) (curry Int.min n) const_min_arity
 203.425              in
 203.426 -              const_min_arity := Symtab.map_default (a,n) (curry Int.min n) (!const_min_arity);
 203.427 -              if toplev then ()
 203.428 -              else const_needs_hBOOL := Symtab.update (a,true) (!const_needs_hBOOL)
 203.429 +              if toplev then (const_min_arity, const_needs_hBOOL)
 203.430 +              else (const_min_arity, Symtab.update (a,true) (const_needs_hBOOL))
 203.431              end
 203.432 -        | ts => ()
 203.433 +        | ts => (const_min_arity, const_needs_hBOOL)
 203.434    end;
 203.435  
 203.436  (*A literal is a top-level term*)
 203.437 -fun count_constants_lit (Literal (_,t)) = count_constants_term true t;
 203.438 +fun count_constants_lit (Literal (_,t)) (const_min_arity, const_needs_hBOOL) =
 203.439 +  count_constants_term true t (const_min_arity, const_needs_hBOOL);
 203.440  
 203.441 -fun count_constants_clause (Clause{literals,...}) = List.app count_constants_lit literals;
 203.442 +fun count_constants_clause (Clause{literals,...}) (const_min_arity, const_needs_hBOOL) =
 203.443 +  fold count_constants_lit literals (const_min_arity, const_needs_hBOOL);
 203.444  
 203.445 -fun display_arity (c,n) =
 203.446 +fun display_arity const_needs_hBOOL (c,n) =
 203.447    Output.debug (fn () => "Constant: " ^ c ^ " arity:\t" ^ Int.toString n ^
 203.448 -                (if needs_hBOOL c then " needs hBOOL" else ""));
 203.449 +                (if needs_hBOOL const_needs_hBOOL c then " needs hBOOL" else ""));
 203.450  
 203.451  fun count_constants (conjectures, axclauses, helper_clauses) =
 203.452 -  if !minimize_applies then
 203.453 -    (const_min_arity := Symtab.empty;
 203.454 -     const_needs_hBOOL := Symtab.empty;
 203.455 -     List.app count_constants_clause conjectures;
 203.456 -     List.app count_constants_clause axclauses;
 203.457 -     List.app count_constants_clause helper_clauses;
 203.458 -     List.app display_arity (Symtab.dest (!const_min_arity)))
 203.459 -  else ();
 203.460 +  if minimize_applies then
 203.461 +     let val (const_min_arity, const_needs_hBOOL) =
 203.462 +          fold count_constants_clause conjectures (Symtab.empty, Symtab.empty)
 203.463 +       |> fold count_constants_clause axclauses
 203.464 +       |> fold count_constants_clause helper_clauses
 203.465 +     val _ = List.app (display_arity const_needs_hBOOL) (Symtab.dest (const_min_arity))
 203.466 +     in (const_min_arity, const_needs_hBOOL) end
 203.467 +  else (Symtab.empty, Symtab.empty);
 203.468  
 203.469  (* tptp format *)
 203.470  
 203.471  (* write TPTP format to a single file *)
 203.472  fun tptp_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
 203.473      let val _ = Output.debug (fn () => ("Preparing to write the TPTP file " ^ filename))
 203.474 -        val _ = RC.dfg_format := false
 203.475 -        val conjectures = make_conjecture_clauses thy thms
 203.476 -        val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
 203.477 -        val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
 203.478 -        val _ = count_constants (conjectures, axclauses, helper_clauses);
 203.479 -        val (tptp_clss,tfree_litss) = ListPair.unzip (map clause2tptp conjectures)
 203.480 -        val tfree_clss = map RC.tptp_tfree_clause (foldl (op union_string) [] tfree_litss)
 203.481 +        val conjectures = make_conjecture_clauses false thy thms
 203.482 +        val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses false thy ax_tuples)
 203.483 +        val helper_clauses = get_helper_clauses false thy isFO (conjectures, axclauses, user_lemmas)
 203.484 +        val (const_min_arity, const_needs_hBOOL) = count_constants (conjectures, axclauses, helper_clauses);
 203.485 +        val (tptp_clss,tfree_litss) = ListPair.unzip (map (clause2tptp const_min_arity const_needs_hBOOL) conjectures)
 203.486 +        val tfree_clss = map RC.tptp_tfree_clause (List.foldl (op union_string) [] tfree_litss)
 203.487          val out = TextIO.openOut filename
 203.488      in
 203.489 -        List.app (curry TextIO.output out o #1 o clause2tptp) axclauses;
 203.490 +        List.app (curry TextIO.output out o #1 o (clause2tptp const_min_arity const_needs_hBOOL)) axclauses;
 203.491          RC.writeln_strs out tfree_clss;
 203.492          RC.writeln_strs out tptp_clss;
 203.493          List.app (curry TextIO.output out o RC.tptp_classrelClause) classrel_clauses;
 203.494          List.app (curry TextIO.output out o RC.tptp_arity_clause) arity_clauses;
 203.495 -        List.app (curry TextIO.output out o #1 o clause2tptp) helper_clauses;
 203.496 +        List.app (curry TextIO.output out o #1 o (clause2tptp const_min_arity const_needs_hBOOL)) helper_clauses;
 203.497          TextIO.closeOut out;
 203.498          clnames
 203.499      end;
 203.500 @@ -488,18 +486,17 @@
 203.501  
 203.502  fun dfg_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
 203.503      let val _ = Output.debug (fn () => ("Preparing to write the DFG file " ^ filename))
 203.504 -        val _ = RC.dfg_format := true
 203.505 -        val conjectures = make_conjecture_clauses thy thms
 203.506 -        val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
 203.507 -        val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
 203.508 -        val _ = count_constants (conjectures, axclauses, helper_clauses);
 203.509 -        val (dfg_clss, tfree_litss) = ListPair.unzip (map clause2dfg conjectures)
 203.510 +        val conjectures = make_conjecture_clauses true thy thms
 203.511 +        val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses true thy ax_tuples)
 203.512 +        val helper_clauses = get_helper_clauses true thy isFO (conjectures, axclauses, user_lemmas)
 203.513 +        val (const_min_arity, const_needs_hBOOL) = count_constants (conjectures, axclauses, helper_clauses);
 203.514 +        val (dfg_clss, tfree_litss) = ListPair.unzip (map (clause2dfg const_min_arity const_needs_hBOOL) conjectures)
 203.515          and probname = Path.implode (Path.base (Path.explode filename))
 203.516 -        val axstrs = map (#1 o clause2dfg) axclauses
 203.517 +        val axstrs = map (#1 o (clause2dfg const_min_arity const_needs_hBOOL)) axclauses
 203.518          val tfree_clss = map RC.dfg_tfree_clause (RC.union_all tfree_litss)
 203.519          val out = TextIO.openOut filename
 203.520 -        val helper_clauses_strs = map (#1 o clause2dfg) helper_clauses
 203.521 -        val (funcs,cl_preds) = decls_of_clauses (helper_clauses @ conjectures @ axclauses) arity_clauses
 203.522 +        val helper_clauses_strs = map (#1 o (clause2dfg const_min_arity const_needs_hBOOL)) helper_clauses
 203.523 +        val (funcs,cl_preds) = decls_of_clauses const_min_arity const_needs_hBOOL (helper_clauses @ conjectures @ axclauses) arity_clauses
 203.524          and ty_preds = preds_of_clauses axclauses classrel_clauses arity_clauses
 203.525      in
 203.526          TextIO.output (out, RC.string_of_start probname);
   204.1 --- a/src/HOL/Tools/res_reconstruct.ML	Wed Mar 04 10:43:39 2009 +0100
   204.2 +++ b/src/HOL/Tools/res_reconstruct.ML	Wed Mar 04 10:45:52 2009 +0100
   204.3 @@ -51,7 +51,7 @@
   204.4  fun atom x = Br(x,[]);
   204.5  
   204.6  fun scons (x,y) = Br("cons", [x,y]);
   204.7 -val listof = foldl scons (atom "nil");
   204.8 +val listof = List.foldl scons (atom "nil");
   204.9  
  204.10  (*Strings enclosed in single quotes, e.g. filenames*)
  204.11  val quoted = $$"'" |-- Scan.repeat (~$$"'") --| $$"'" >> implode;
  204.12 @@ -243,7 +243,7 @@
  204.13  fun gen_all_vars t = fold_rev Logic.all (OldTerm.term_vars t) t;
  204.14  
  204.15  fun ints_of_stree_aux (Int n, ns) = n::ns
  204.16 -  | ints_of_stree_aux (Br(_,ts), ns) = foldl ints_of_stree_aux ns ts;
  204.17 +  | ints_of_stree_aux (Br(_,ts), ns) = List.foldl ints_of_stree_aux ns ts;
  204.18  
  204.19  fun ints_of_stree t = ints_of_stree_aux (t, []);
  204.20  
  204.21 @@ -362,7 +362,7 @@
  204.22  fun replace_dep (old:int, new) dep = if dep=old then new else [dep];
  204.23  
  204.24  fun replace_deps (old:int, new) (lno, t, deps) =
  204.25 -      (lno, t, foldl (op union_int) [] (map (replace_dep (old, new)) deps));
  204.26 +      (lno, t, List.foldl (op union_int) [] (map (replace_dep (old, new)) deps));
  204.27  
  204.28  (*Discard axioms; consolidate adjacent lines that prove the same clause, since they differ
  204.29    only in type information.*)
  204.30 @@ -392,7 +392,7 @@
  204.31       then delete_dep lno lines
  204.32       else (lno, t, []) :: lines
  204.33    | add_nonnull_prfline ((lno, t, deps), lines) = (lno, t, deps) :: lines
  204.34 -and delete_dep lno lines = foldr add_nonnull_prfline [] (map (replace_deps (lno, [])) lines);
  204.35 +and delete_dep lno lines = List.foldr add_nonnull_prfline [] (map (replace_deps (lno, [])) lines);
  204.36  
  204.37  fun bad_free (Free (a,_)) = String.isPrefix "sko_" a
  204.38    | bad_free _ = false;
  204.39 @@ -435,11 +435,11 @@
  204.40        val tuples = map (dest_tstp o tstp_line o explode) cnfs
  204.41        val _ = trace (Int.toString (length tuples) ^ " tuples extracted\n")
  204.42        val ctxt = ProofContext.set_mode ProofContext.mode_schematic ctxt
  204.43 -      val raw_lines = foldr add_prfline [] (decode_tstp_list ctxt tuples)
  204.44 +      val raw_lines = List.foldr add_prfline [] (decode_tstp_list ctxt tuples)
  204.45        val _ = trace (Int.toString (length raw_lines) ^ " raw_lines extracted\n")
  204.46 -      val nonnull_lines = foldr add_nonnull_prfline [] raw_lines
  204.47 +      val nonnull_lines = List.foldr add_nonnull_prfline [] raw_lines
  204.48        val _ = trace (Int.toString (length nonnull_lines) ^ " nonnull_lines extracted\n")
  204.49 -      val (_,lines) = foldr (add_wanted_prfline ctxt) (0,[]) nonnull_lines
  204.50 +      val (_,lines) = List.foldr (add_wanted_prfline ctxt) (0,[]) nonnull_lines
  204.51        val _ = trace (Int.toString (length lines) ^ " lines extracted\n")
  204.52        val (ccls,fixes) = ResAxioms.neg_conjecture_clauses th sgno
  204.53        val _ = trace (Int.toString (length ccls) ^ " conjecture clauses\n")
   205.1 --- a/src/HOL/Tools/sat_solver.ML	Wed Mar 04 10:43:39 2009 +0100
   205.2 +++ b/src/HOL/Tools/sat_solver.ML	Wed Mar 04 10:45:52 2009 +0100
   205.3 @@ -914,6 +914,10 @@
   205.4    fun zchaff fm =
   205.5    let
   205.6      val _          = if (getenv "ZCHAFF_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
   205.7 +    val _          = if (getenv "ZCHAFF_VERSION") <> "2004.5.13" andalso
   205.8 +                        (getenv "ZCHAFF_VERSION") <> "2004.11.15" then raise SatSolver.NOT_CONFIGURED else ()
   205.9 +      (* both versions of zChaff appear to have the same interface, so we do *)
  205.10 +      (* not actually need to distinguish between them in the following code *)
  205.11      val serial_str = serial_string ()
  205.12      val inpath     = File.tmp_path (Path.explode ("isabelle" ^ serial_str ^ ".cnf"))
  205.13      val outpath    = File.tmp_path (Path.explode ("result" ^ serial_str))
  205.14 @@ -939,12 +943,11 @@
  205.15  let
  205.16    fun berkmin fm =
  205.17    let
  205.18 -    val _          = if (getenv "BERKMIN_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
  205.19 +    val _          = if (getenv "BERKMIN_HOME") = "" orelse (getenv "BERKMIN_EXE") = "" then raise SatSolver.NOT_CONFIGURED else ()
  205.20      val serial_str = serial_string ()
  205.21      val inpath     = File.tmp_path (Path.explode ("isabelle" ^ serial_str ^ ".cnf"))
  205.22      val outpath    = File.tmp_path (Path.explode ("result" ^ serial_str))
  205.23 -    val exec       = getenv "BERKMIN_EXE"
  205.24 -    val cmd        = (getenv "BERKMIN_HOME") ^ "/" ^ (if exec = "" then "BerkMin561" else exec) ^ " " ^ (Path.implode inpath) ^ " > " ^ (Path.implode outpath)
  205.25 +    val cmd        = (getenv "BERKMIN_HOME") ^ "/" ^ (getenv "BERKMIN_EXE") ^ " " ^ (Path.implode inpath) ^ " > " ^ (Path.implode outpath)
  205.26      fun writefn fm = SatSolver.write_dimacs_cnf_file inpath (PropLogic.defcnf fm)
  205.27      fun readfn ()  = SatSolver.read_std_result_file outpath ("Satisfiable          !!", "solution =", "UNSATISFIABLE          !!")
  205.28      val _          = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
   206.1 --- a/src/HOL/Tools/simpdata.ML	Wed Mar 04 10:43:39 2009 +0100
   206.2 +++ b/src/HOL/Tools/simpdata.ML	Wed Mar 04 10:45:52 2009 +0100
   206.3 @@ -1,5 +1,4 @@
   206.4  (*  Title:      HOL/simpdata.ML
   206.5 -    ID:         $Id$
   206.6      Author:     Tobias Nipkow
   206.7      Copyright   1991  University of Cambridge
   206.8  
   206.9 @@ -65,7 +64,7 @@
  206.10      else
  206.11        let
  206.12          val Ps = map (fn k => Free ("P" ^ string_of_int k, propT)) (1 upto j);
  206.13 -        fun mk_simp_implies Q = foldr (fn (R, S) =>
  206.14 +        fun mk_simp_implies Q = List.foldr (fn (R, S) =>
  206.15            Const ("HOL.simp_implies", propT --> propT --> propT) $ R $ S) Q Ps
  206.16          val aT = TFree ("'a", HOLogic.typeS);
  206.17          val x = Free ("x", aT);
   207.1 --- a/src/HOL/Tools/specification_package.ML	Wed Mar 04 10:43:39 2009 +0100
   207.2 +++ b/src/HOL/Tools/specification_package.ML	Wed Mar 04 10:45:52 2009 +0100
   207.3 @@ -120,7 +120,7 @@
   207.4                  val frees = OldTerm.term_frees prop
   207.5                  val _ = forall (fn v => Sign.of_sort thy (type_of v,HOLogic.typeS)) frees
   207.6                    orelse error "Specificaton: Only free variables of sort 'type' allowed"
   207.7 -                val prop_closed = foldr (fn ((vname,T),prop) => HOLogic.mk_all (vname,T,prop)) prop (map dest_Free frees)
   207.8 +                val prop_closed = List.foldr (fn ((vname,T),prop) => HOLogic.mk_all (vname,T,prop)) prop (map dest_Free frees)
   207.9              in
  207.10                  (prop_closed,frees)
  207.11              end
  207.12 @@ -161,7 +161,7 @@
  207.13              in
  207.14                  HOLogic.exists_const T $ Abs(vname,T,Term.abstract_over (c,prop))
  207.15              end
  207.16 -        val ex_prop = foldr mk_exist prop proc_consts
  207.17 +        val ex_prop = List.foldr mk_exist prop proc_consts
  207.18          val cnames = map (fst o dest_Const) proc_consts
  207.19          fun post_process (arg as (thy,thm)) =
  207.20              let
  207.21 @@ -232,7 +232,7 @@
  207.22  
  207.23  val specification_decl =
  207.24    P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
  207.25 -          Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop)
  207.26 +          Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop)
  207.27  
  207.28  val _ =
  207.29    OuterSyntax.command "specification" "define constants by specification" K.thy_goal
  207.30 @@ -243,7 +243,7 @@
  207.31  val ax_specification_decl =
  207.32      P.name --
  207.33      (P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
  207.34 -           Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop))
  207.35 +           Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop))
  207.36  
  207.37  val _ =
  207.38    OuterSyntax.command "ax_specification" "define constants by specification" K.thy_goal
   208.1 --- a/src/HOL/Transcendental.thy	Wed Mar 04 10:43:39 2009 +0100
   208.2 +++ b/src/HOL/Transcendental.thy	Wed Mar 04 10:45:52 2009 +0100
   208.3 @@ -120,7 +120,7 @@
   208.4    case (Suc n)
   208.5    have "(\<Sum> i = 0 ..< 2 * Suc n. if even i then f i else g i) = 
   208.6          (\<Sum> i = 0 ..< n. f (2 * i)) + (\<Sum> i = 0 ..< n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
   208.7 -    using Suc.hyps by auto
   208.8 +    using Suc.hyps unfolding One_nat_def by auto
   208.9    also have "\<dots> = (\<Sum> i = 0 ..< Suc n. f (2 * i)) + (\<Sum> i = 0 ..< Suc n. g (2 * i + 1))" by auto
  208.10    finally show ?case .
  208.11  qed auto
  208.12 @@ -187,16 +187,18 @@
  208.13               ((\<forall>n. l \<le> (\<Sum>i=0..<2*n + 1. -1^i*a i)) \<and> (\<lambda> n. \<Sum>i=0..<2*n + 1. -1^i*a i) ----> l)"
  208.14    (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
  208.15  proof -
  208.16 -  have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" by auto
  208.17 +  have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" unfolding One_nat_def by auto
  208.18  
  208.19    have "\<forall> n. ?f n \<le> ?f (Suc n)"
  208.20    proof fix n show "?f n \<le> ?f (Suc n)" using mono[of "2*n"] by auto qed
  208.21    moreover
  208.22    have "\<forall> n. ?g (Suc n) \<le> ?g n"
  208.23 -  proof fix n show "?g (Suc n) \<le> ?g n" using mono[of "Suc (2*n)"] by auto qed
  208.24 +  proof fix n show "?g (Suc n) \<le> ?g n" using mono[of "Suc (2*n)"]
  208.25 +    unfolding One_nat_def by auto qed
  208.26    moreover
  208.27    have "\<forall> n. ?f n \<le> ?g n" 
  208.28 -  proof fix n show "?f n \<le> ?g n" using fg_diff a_pos by auto qed
  208.29 +  proof fix n show "?f n \<le> ?g n" using fg_diff a_pos
  208.30 +    unfolding One_nat_def by auto qed
  208.31    moreover
  208.32    have "(\<lambda> n. ?f n - ?g n) ----> 0" unfolding fg_diff
  208.33    proof (rule LIMSEQ_I)
  208.34 @@ -904,7 +906,7 @@
  208.35  proof -
  208.36    have "(\<Sum>n = 0..<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
  208.37      by (rule sums_unique [OF series_zero], simp add: power_0_left)
  208.38 -  thus ?thesis by simp
  208.39 +  thus ?thesis unfolding One_nat_def by simp
  208.40  qed
  208.41  
  208.42  lemma exp_zero [simp]: "exp 0 = 1"
  208.43 @@ -1234,10 +1236,11 @@
  208.44        show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1" using `0 < x` `x < 2` by auto
  208.45        { fix x :: real assume "x \<in> {- 1<..<1}" hence "norm (-x) < 1" by auto
  208.46  	show "summable (\<lambda>n. -1 ^ n * (1 / real (n + 1)) * real (Suc n) * x ^ n)"
  208.47 +          unfolding One_nat_def
  208.48  	  by (auto simp del: power_mult_distrib simp add: power_mult_distrib[symmetric] summable_geometric[OF `norm (-x) < 1`])
  208.49        }
  208.50      qed
  208.51 -    hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)" by auto
  208.52 +    hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)" unfolding One_nat_def by auto
  208.53      hence "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)" unfolding DERIV_iff repos .
  208.54      ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> (suminf (?f' x) - suminf (?f' x))"
  208.55        by (rule DERIV_diff)
  208.56 @@ -1514,6 +1517,7 @@
  208.57  
  208.58  lemma DERIV_fun_pow: "DERIV g x :> m ==>  
  208.59        DERIV (%x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  208.60 +unfolding One_nat_def
  208.61  apply (rule lemma_DERIV_subst)
  208.62  apply (rule_tac f = "(%x. x ^ n)" in DERIV_chain2)
  208.63  apply (rule DERIV_pow, auto)
  208.64 @@ -1635,7 +1639,7 @@
  208.65  	sums sin x"
  208.66      unfolding sin_def
  208.67      by (rule sin_converges [THEN sums_summable, THEN sums_group], simp) 
  208.68 -  thus ?thesis by (simp add: mult_ac)
  208.69 +  thus ?thesis unfolding One_nat_def by (simp add: mult_ac)
  208.70  qed
  208.71  
  208.72  lemma sin_gt_zero: "[|0 < x; x < 2 |] ==> 0 < sin x"
  208.73 @@ -1647,6 +1651,7 @@
  208.74   apply (rule sin_paired [THEN sums_summable, THEN sums_group], simp) 
  208.75  apply (rotate_tac 2)
  208.76  apply (drule sin_paired [THEN sums_unique, THEN ssubst])
  208.77 +unfolding One_nat_def
  208.78  apply (auto simp del: fact_Suc realpow_Suc)
  208.79  apply (frule sums_unique)
  208.80  apply (auto simp del: fact_Suc realpow_Suc)
  208.81 @@ -1720,6 +1725,7 @@
  208.82  apply (simp (no_asm) add: mult_assoc del: setsum_op_ivl_Suc)
  208.83  apply (rule sumr_pos_lt_pair)
  208.84  apply (erule sums_summable, safe)
  208.85 +unfolding One_nat_def
  208.86  apply (simp (no_asm) add: divide_inverse real_0_less_add_iff mult_assoc [symmetric] 
  208.87              del: fact_Suc)
  208.88  apply (rule real_mult_inverse_cancel2)
  208.89 @@ -2792,7 +2798,7 @@
  208.90  
  208.91  lemma monoseq_arctan_series: fixes x :: real
  208.92    assumes "\<bar>x\<bar> \<le> 1" shows "monoseq (\<lambda> n. 1 / real (n*2+1) * x^(n*2+1))" (is "monoseq ?a")
  208.93 -proof (cases "x = 0") case True thus ?thesis unfolding monoseq_def by auto
  208.94 +proof (cases "x = 0") case True thus ?thesis unfolding monoseq_def One_nat_def by auto
  208.95  next
  208.96    case False
  208.97    have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  208.98 @@ -2823,7 +2829,7 @@
  208.99  
 208.100  lemma zeroseq_arctan_series: fixes x :: real
 208.101    assumes "\<bar>x\<bar> \<le> 1" shows "(\<lambda> n. 1 / real (n*2+1) * x^(n*2+1)) ----> 0" (is "?a ----> 0")
 208.102 -proof (cases "x = 0") case True thus ?thesis by (auto simp add: LIMSEQ_const)
 208.103 +proof (cases "x = 0") case True thus ?thesis unfolding One_nat_def by (auto simp add: LIMSEQ_const)
 208.104  next
 208.105    case False
 208.106    have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
 208.107 @@ -2831,12 +2837,14 @@
 208.108    proof (cases "\<bar>x\<bar> < 1")
 208.109      case True hence "norm x < 1" by auto
 208.110      from LIMSEQ_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF `norm x < 1`, THEN LIMSEQ_Suc]]
 208.111 -    show ?thesis unfolding inverse_eq_divide Suc_plus1 using LIMSEQ_linear[OF _ pos2] by auto
 208.112 +    have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) ----> 0"
 208.113 +      unfolding inverse_eq_divide Suc_plus1 by simp
 208.114 +    then show ?thesis using pos2 by (rule LIMSEQ_linear)
 208.115    next
 208.116      case False hence "x = -1 \<or> x = 1" using `\<bar>x\<bar> \<le> 1` by auto
 208.117 -    hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x" by auto
 208.118 +    hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x" unfolding One_nat_def by auto
 208.119      from LIMSEQ_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] LIMSEQ_const[of x]]
 208.120 -    show ?thesis unfolding n_eq by auto
 208.121 +    show ?thesis unfolding n_eq Suc_plus1 by auto
 208.122    qed
 208.123  qed
 208.124  
 208.125 @@ -2989,7 +2997,7 @@
 208.126  	  from `even n` obtain m where "2 * m = n" unfolding even_mult_two_ex by auto
 208.127  	  from bounds[of m, unfolded this atLeastAtMost_iff]
 208.128  	  have "\<bar>arctan x - (\<Sum>i = 0..<n. (?c x i))\<bar> \<le> (\<Sum>i = 0..<n + 1. (?c x i)) - (\<Sum>i = 0..<n. (?c x i))" by auto
 208.129 -	  also have "\<dots> = ?c x n" by auto
 208.130 +	  also have "\<dots> = ?c x n" unfolding One_nat_def by auto
 208.131  	  also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
 208.132  	  finally show ?thesis .
 208.133  	next
 208.134 @@ -2998,7 +3006,7 @@
 208.135  	  hence m_plus: "2 * (m + 1) = n + 1" by auto
 208.136  	  from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
 208.137  	  have "\<bar>arctan x - (\<Sum>i = 0..<n. (?c x i))\<bar> \<le> (\<Sum>i = 0..<n. (?c x i)) - (\<Sum>i = 0..<n+1. (?c x i))" by auto
 208.138 -	  also have "\<dots> = - ?c x n" by auto
 208.139 +	  also have "\<dots> = - ?c x n" unfolding One_nat_def by auto
 208.140  	  also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
 208.141  	  finally show ?thesis .
 208.142  	qed
 208.143 @@ -3011,7 +3019,9 @@
 208.144        ultimately have "0 \<le> ?a 1 n - ?diff 1 n" by (rule LIM_less_bound)
 208.145        hence "?diff 1 n \<le> ?a 1 n" by auto
 208.146      }
 208.147 -    have "?a 1 ----> 0" unfolding LIMSEQ_rabs_zero power_one divide_inverse by (auto intro!: LIMSEQ_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
 208.148 +    have "?a 1 ----> 0"
 208.149 +      unfolding LIMSEQ_rabs_zero power_one divide_inverse One_nat_def
 208.150 +      by (auto intro!: LIMSEQ_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
 208.151      have "?diff 1 ----> 0"
 208.152      proof (rule LIMSEQ_I)
 208.153        fix r :: real assume "0 < r"
 208.154 @@ -3031,7 +3041,7 @@
 208.155        have "- (pi / 2) < 0" using pi_gt_zero by auto
 208.156        have "- (2 * pi) < 0" using pi_gt_zero by auto
 208.157        
 208.158 -      have c_minus_minus: "\<And> i. ?c (- 1) i = - ?c 1 i" by auto
 208.159 +      have c_minus_minus: "\<And> i. ?c (- 1) i = - ?c 1 i" unfolding One_nat_def by auto
 208.160      
 208.161        have "arctan (- 1) = arctan (tan (-(pi / 4)))" unfolding tan_45 tan_minus ..
 208.162        also have "\<dots> = - (pi / 4)" by (rule arctan_tan, auto simp add: order_less_trans[OF `- (pi / 2) < 0` pi_gt_zero])
 208.163 @@ -3179,4 +3189,4 @@
 208.164  apply (erule polar_ex2)
 208.165  done
 208.166  
 208.167 -end 
 208.168 +end
   209.1 --- a/src/HOL/Transitive_Closure.thy	Wed Mar 04 10:43:39 2009 +0100
   209.2 +++ b/src/HOL/Transitive_Closure.thy	Wed Mar 04 10:45:52 2009 +0100
   209.3 @@ -64,8 +64,8 @@
   209.4  
   209.5  subsection {* Reflexive closure *}
   209.6  
   209.7 -lemma reflexive_reflcl[simp]: "reflexive(r^=)"
   209.8 -by(simp add:refl_def)
   209.9 +lemma refl_reflcl[simp]: "refl(r^=)"
  209.10 +by(simp add:refl_on_def)
  209.11  
  209.12  lemma antisym_reflcl[simp]: "antisym(r^=) = antisym r"
  209.13  by(simp add:antisym_def)
  209.14 @@ -118,8 +118,8 @@
  209.15    rtrancl_induct[of "(ax,ay)" "(bx,by)", split_format (complete),
  209.16                   consumes 1, case_names refl step]
  209.17  
  209.18 -lemma reflexive_rtrancl: "reflexive (r^*)"
  209.19 -  by (unfold refl_def) fast
  209.20 +lemma refl_rtrancl: "refl (r^*)"
  209.21 +by (unfold refl_on_def) fast
  209.22  
  209.23  text {* Transitivity of transitive closure. *}
  209.24  lemma trans_rtrancl: "trans (r^*)"
  209.25 @@ -646,7 +646,7 @@
  209.26      val trancl_rtrancl_trancl = @{thm trancl_rtrancl_trancl};
  209.27      val rtrancl_trans = @{thm rtrancl_trans};
  209.28  
  209.29 -  fun decomp (Trueprop $ t) =
  209.30 +  fun decomp (@{const Trueprop} $ t) =
  209.31      let fun dec (Const ("op :", _) $ (Const ("Pair", _) $ a $ b) $ rel ) =
  209.32          let fun decr (Const ("Transitive_Closure.rtrancl", _ ) $ r) = (r,"r*")
  209.33                | decr (Const ("Transitive_Closure.trancl", _ ) $ r)  = (r,"r+")
  209.34 @@ -654,7 +654,8 @@
  209.35              val (rel,r) = decr (Envir.beta_eta_contract rel);
  209.36          in SOME (a,b,rel,r) end
  209.37        | dec _ =  NONE
  209.38 -    in dec t end;
  209.39 +    in dec t end
  209.40 +    | decomp _ = NONE;
  209.41  
  209.42    end);
  209.43  
  209.44 @@ -669,7 +670,7 @@
  209.45      val trancl_rtrancl_trancl = @{thm tranclp_rtranclp_tranclp};
  209.46      val rtrancl_trans = @{thm rtranclp_trans};
  209.47  
  209.48 -  fun decomp (Trueprop $ t) =
  209.49 +  fun decomp (@{const Trueprop} $ t) =
  209.50      let fun dec (rel $ a $ b) =
  209.51          let fun decr (Const ("Transitive_Closure.rtranclp", _ ) $ r) = (r,"r*")
  209.52                | decr (Const ("Transitive_Closure.tranclp", _ ) $ r)  = (r,"r+")
  209.53 @@ -677,7 +678,8 @@
  209.54              val (rel,r) = decr rel;
  209.55          in SOME (a, b, rel, r) end
  209.56        | dec _ =  NONE
  209.57 -    in dec t end;
  209.58 +    in dec t end
  209.59 +    | decomp _ = NONE;
  209.60  
  209.61    end);
  209.62  *}
   210.1 --- a/src/HOL/UNITY/ListOrder.thy	Wed Mar 04 10:43:39 2009 +0100
   210.2 +++ b/src/HOL/UNITY/ListOrder.thy	Wed Mar 04 10:45:52 2009 +0100
   210.3 @@ -90,16 +90,15 @@
   210.4  
   210.5  subsection{*genPrefix is a partial order*}
   210.6  
   210.7 -lemma refl_genPrefix: "reflexive r ==> reflexive (genPrefix r)"
   210.8 -
   210.9 -apply (unfold refl_def, auto)
  210.10 +lemma refl_genPrefix: "refl r ==> refl (genPrefix r)"
  210.11 +apply (unfold refl_on_def, auto)
  210.12  apply (induct_tac "x")
  210.13  prefer 2 apply (blast intro: genPrefix.prepend)
  210.14  apply (blast intro: genPrefix.Nil)
  210.15  done
  210.16  
  210.17 -lemma genPrefix_refl [simp]: "reflexive r ==> (l,l) : genPrefix r"
  210.18 -by (erule reflD [OF refl_genPrefix UNIV_I])
  210.19 +lemma genPrefix_refl [simp]: "refl r ==> (l,l) : genPrefix r"
  210.20 +by (erule refl_onD [OF refl_genPrefix UNIV_I])
  210.21  
  210.22  lemma genPrefix_mono: "r<=s ==> genPrefix r <= genPrefix s"
  210.23  apply clarify
  210.24 @@ -178,8 +177,8 @@
  210.25  done
  210.26  
  210.27  lemma same_genPrefix_genPrefix [simp]: 
  210.28 -    "reflexive r ==> ((xs@ys, xs@zs) : genPrefix r) = ((ys,zs) : genPrefix r)"
  210.29 -apply (unfold refl_def)
  210.30 +    "refl r ==> ((xs@ys, xs@zs) : genPrefix r) = ((ys,zs) : genPrefix r)"
  210.31 +apply (unfold refl_on_def)
  210.32  apply (induct_tac "xs")
  210.33  apply (simp_all (no_asm_simp))
  210.34  done
  210.35 @@ -190,7 +189,7 @@
  210.36  by (case_tac "xs", auto)
  210.37  
  210.38  lemma genPrefix_take_append:
  210.39 -     "[| reflexive r;  (xs,ys) : genPrefix r |]  
  210.40 +     "[| refl r;  (xs,ys) : genPrefix r |]  
  210.41        ==>  (xs@zs, take (length xs) ys @ zs) : genPrefix r"
  210.42  apply (erule genPrefix.induct)
  210.43  apply (frule_tac [3] genPrefix_length_le)
  210.44 @@ -198,7 +197,7 @@
  210.45  done
  210.46  
  210.47  lemma genPrefix_append_both:
  210.48 -     "[| reflexive r;  (xs,ys) : genPrefix r;  length xs = length ys |]  
  210.49 +     "[| refl r;  (xs,ys) : genPrefix r;  length xs = length ys |]  
  210.50        ==>  (xs@zs, ys @ zs) : genPrefix r"
  210.51  apply (drule genPrefix_take_append, assumption)
  210.52  apply (simp add: take_all)
  210.53 @@ -210,7 +209,7 @@
  210.54  by auto
  210.55  
  210.56  lemma aolemma:
  210.57 -     "[| (xs,ys) : genPrefix r;  reflexive r |]  
  210.58 +     "[| (xs,ys) : genPrefix r;  refl r |]  
  210.59        ==> length xs < length ys --> (xs @ [ys ! length xs], ys) : genPrefix r"
  210.60  apply (erule genPrefix.induct)
  210.61    apply blast
  210.62 @@ -225,7 +224,7 @@
  210.63  done
  210.64  
  210.65  lemma append_one_genPrefix:
  210.66 -     "[| (xs,ys) : genPrefix r;  length xs < length ys;  reflexive r |]  
  210.67 +     "[| (xs,ys) : genPrefix r;  length xs < length ys;  refl r |]  
  210.68        ==> (xs @ [ys ! length xs], ys) : genPrefix r"
  210.69  by (blast intro: aolemma [THEN mp])
  210.70  
  210.71 @@ -259,7 +258,7 @@
  210.72  
  210.73  subsection{*The type of lists is partially ordered*}
  210.74  
  210.75 -declare reflexive_Id [iff] 
  210.76 +declare refl_Id [iff] 
  210.77          antisym_Id [iff] 
  210.78          trans_Id [iff]
  210.79  
  210.80 @@ -383,8 +382,8 @@
  210.81  
  210.82  (** pfixLe **)
  210.83  
  210.84 -lemma reflexive_Le [iff]: "reflexive Le"
  210.85 -by (unfold refl_def Le_def, auto)
  210.86 +lemma refl_Le [iff]: "refl Le"
  210.87 +by (unfold refl_on_def Le_def, auto)
  210.88  
  210.89  lemma antisym_Le [iff]: "antisym Le"
  210.90  by (unfold antisym_def Le_def, auto)
  210.91 @@ -406,8 +405,8 @@
  210.92  apply (blast intro: genPrefix_mono [THEN [2] rev_subsetD])
  210.93  done
  210.94  
  210.95 -lemma reflexive_Ge [iff]: "reflexive Ge"
  210.96 -by (unfold refl_def Ge_def, auto)
  210.97 +lemma refl_Ge [iff]: "refl Ge"
  210.98 +by (unfold refl_on_def Ge_def, auto)
  210.99  
 210.100  lemma antisym_Ge [iff]: "antisym Ge"
 210.101  by (unfold antisym_def Ge_def, auto)
   211.1 --- a/src/HOL/UNITY/ProgressSets.thy	Wed Mar 04 10:43:39 2009 +0100
   211.2 +++ b/src/HOL/UNITY/ProgressSets.thy	Wed Mar 04 10:45:52 2009 +0100
   211.3 @@ -344,8 +344,8 @@
   211.4  apply (blast intro: clD cl_in_lattice)
   211.5  done
   211.6  
   211.7 -lemma refl_relcl: "lattice L ==> refl UNIV (relcl L)"
   211.8 -by (simp add: reflI relcl_def subset_cl [THEN subsetD])
   211.9 +lemma refl_relcl: "lattice L ==> refl (relcl L)"
  211.10 +by (simp add: refl_onI relcl_def subset_cl [THEN subsetD])
  211.11  
  211.12  lemma trans_relcl: "lattice L ==> trans (relcl L)"
  211.13  by (blast intro: relcl_trans transI)
  211.14 @@ -362,12 +362,12 @@
  211.15  
  211.16  text{*Equation (4.71) of Meier's thesis.  He gives no proof.*}
  211.17  lemma cl_latticeof:
  211.18 -     "[|refl UNIV r; trans r|] 
  211.19 +     "[|refl r; trans r|] 
  211.20        ==> cl (latticeof r) X = {t. \<exists>s. s\<in>X & (s,t) \<in> r}" 
  211.21  apply (rule equalityI) 
  211.22   apply (rule cl_least) 
  211.23    apply (simp (no_asm_use) add: latticeof_def trans_def, blast)
  211.24 - apply (simp add: latticeof_def refl_def, blast)
  211.25 + apply (simp add: latticeof_def refl_on_def, blast)
  211.26  apply (simp add: latticeof_def, clarify)
  211.27  apply (unfold cl_def, blast) 
  211.28  done
  211.29 @@ -400,7 +400,7 @@
  211.30  done
  211.31  
  211.32  theorem relcl_latticeof_eq:
  211.33 -     "[|refl UNIV r; trans r|] ==> relcl (latticeof r) = r"
  211.34 +     "[|refl r; trans r|] ==> relcl (latticeof r) = r"
  211.35  by (simp add: relcl_def cl_latticeof)
  211.36  
  211.37  
   212.1 --- a/src/HOL/UNITY/UNITY.thy	Wed Mar 04 10:43:39 2009 +0100
   212.2 +++ b/src/HOL/UNITY/UNITY.thy	Wed Mar 04 10:45:52 2009 +0100
   212.3 @@ -359,7 +359,7 @@
   212.4  
   212.5  constdefs
   212.6    totalize_act :: "('a * 'a)set => ('a * 'a)set"
   212.7 -    "totalize_act act == act \<union> diag (-(Domain act))"
   212.8 +    "totalize_act act == act \<union> Id_on (-(Domain act))"
   212.9  
  212.10    totalize :: "'a program => 'a program"
  212.11      "totalize F == mk_program (Init F,
   213.1 --- a/src/HOL/Word/BinGeneral.thy	Wed Mar 04 10:43:39 2009 +0100
   213.2 +++ b/src/HOL/Word/BinGeneral.thy	Wed Mar 04 10:45:52 2009 +0100
   213.3 @@ -433,7 +433,7 @@
   213.4    "!!w. sbintrunc n w = ((w + 2 ^ n) mod 2 ^ (Suc n) - 2 ^ n :: int)"
   213.5    apply (induct n)
   213.6     apply clarsimp
   213.7 -   apply (subst zmod_zadd_left_eq)
   213.8 +   apply (subst mod_add_left_eq)
   213.9     apply (simp add: bin_last_mod)
  213.10     apply (simp add: number_of_eq)
  213.11    apply clarsimp
  213.12 @@ -767,23 +767,23 @@
  213.13  lemmas zpower_zmod' = zpower_zmod [where m="c" and y="k", standard]
  213.14  
  213.15  lemmas brdmod1s' [symmetric] = 
  213.16 -  zmod_zadd_left_eq zmod_zadd_right_eq 
  213.17 +  mod_add_left_eq mod_add_right_eq 
  213.18    zmod_zsub_left_eq zmod_zsub_right_eq 
  213.19    zmod_zmult1_eq zmod_zmult1_eq_rev 
  213.20  
  213.21  lemmas brdmods' [symmetric] = 
  213.22    zpower_zmod' [symmetric]
  213.23 -  trans [OF zmod_zadd_left_eq zmod_zadd_right_eq] 
  213.24 +  trans [OF mod_add_left_eq mod_add_right_eq] 
  213.25    trans [OF zmod_zsub_left_eq zmod_zsub_right_eq] 
  213.26    trans [OF zmod_zmult1_eq zmod_zmult1_eq_rev] 
  213.27    zmod_uminus' [symmetric]
  213.28 -  zmod_zadd_left_eq [where b = "1"]
  213.29 +  mod_add_left_eq [where b = "1::int"]
  213.30    zmod_zsub_left_eq [where b = "1"]
  213.31  
  213.32  lemmas bintr_arith1s =
  213.33 -  brdmod1s' [where c="2^n", folded pred_def succ_def bintrunc_mod2p, standard]
  213.34 +  brdmod1s' [where c="2^n::int", folded pred_def succ_def bintrunc_mod2p, standard]
  213.35  lemmas bintr_ariths =
  213.36 -  brdmods' [where c="2^n", folded pred_def succ_def bintrunc_mod2p, standard]
  213.37 +  brdmods' [where c="2^n::int", folded pred_def succ_def bintrunc_mod2p, standard]
  213.38  
  213.39  lemmas m2pths = pos_mod_sign pos_mod_bound [OF zless2p, standard] 
  213.40  
   214.1 --- a/src/HOL/Word/Num_Lemmas.thy	Wed Mar 04 10:43:39 2009 +0100
   214.2 +++ b/src/HOL/Word/Num_Lemmas.thy	Wed Mar 04 10:45:52 2009 +0100
   214.3 @@ -95,7 +95,7 @@
   214.4  lemma z1pdiv2:
   214.5    "(2 * b + 1) div 2 = (b::int)" by arith
   214.6  
   214.7 -lemmas zdiv_le_dividend = xtr3 [OF zdiv_1 [symmetric] zdiv_mono2,
   214.8 +lemmas zdiv_le_dividend = xtr3 [OF div_by_1 [symmetric] zdiv_mono2,
   214.9    simplified int_one_le_iff_zero_less, simplified, standard]
  214.10    
  214.11  lemma axxbyy:
  214.12 @@ -127,12 +127,12 @@
  214.13  
  214.14  lemma zmod_zsub_right_eq: "((a::int) - b) mod c = (a - b mod c) mod c"
  214.15    apply (unfold diff_int_def)
  214.16 -  apply (rule trans [OF _ zmod_zadd_right_eq [symmetric]])
  214.17 -  apply (simp add : zmod_uminus zmod_zadd_right_eq [symmetric])
  214.18 +  apply (rule trans [OF _ mod_add_right_eq [symmetric]])
  214.19 +  apply (simp add : zmod_uminus mod_add_right_eq [symmetric])
  214.20    done
  214.21  
  214.22  lemma zmod_zsub_left_eq: "((a::int) - b) mod c = (a mod c - b) mod c"
  214.23 -  by (rule zmod_zadd_left_eq [where b = "- b", simplified diff_int_def [symmetric]])
  214.24 +  by (rule mod_add_left_eq [where b = "- b", simplified diff_int_def [symmetric]])
  214.25  
  214.26  lemma zmod_zsub_self [simp]: 
  214.27    "((b :: int) - a) mod a = b mod a"
  214.28 @@ -146,8 +146,8 @@
  214.29    done
  214.30  
  214.31  lemmas rdmods [symmetric] = zmod_uminus [symmetric]
  214.32 -  zmod_zsub_left_eq zmod_zsub_right_eq zmod_zadd_left_eq
  214.33 -  zmod_zadd_right_eq zmod_zmult1_eq zmod_zmult1_eq_rev
  214.34 +  zmod_zsub_left_eq zmod_zsub_right_eq mod_add_left_eq
  214.35 +  mod_add_right_eq zmod_zmult1_eq zmod_zmult1_eq_rev
  214.36  
  214.37  lemma mod_plus_right:
  214.38    "((a + x) mod m = (b + x) mod m) = (a mod m = b mod (m :: nat))"
  214.39 @@ -169,7 +169,8 @@
  214.40  lemmas push_mods = push_mods' [THEN eq_reflection, standard]
  214.41  lemmas pull_mods = push_mods [symmetric] rdmods [THEN eq_reflection, standard]
  214.42  lemmas mod_simps = 
  214.43 -  zmod_zmult_self1 [THEN eq_reflection] zmod_zmult_self2 [THEN eq_reflection]
  214.44 +  mod_mult_self2_is_0 [THEN eq_reflection]
  214.45 +  mod_mult_self1_is_0 [THEN eq_reflection]
  214.46    mod_mod_trivial [THEN eq_reflection]
  214.47  
  214.48  lemma nat_mod_eq:
  214.49 @@ -259,7 +260,7 @@
  214.50  
  214.51  (** Rep_Integ **)
  214.52  lemma eqne: "equiv A r ==> X : A // r ==> X ~= {}"
  214.53 -  unfolding equiv_def refl_def quotient_def Image_def by auto
  214.54 +  unfolding equiv_def refl_on_def quotient_def Image_def by auto
  214.55  
  214.56  lemmas Rep_Integ_ne = Integ.Rep_Integ 
  214.57    [THEN equiv_intrel [THEN eqne, simplified Integ_def [symmetric]], standard]
  214.58 @@ -313,7 +314,7 @@
  214.59    "a > 1 ==> a ^ n mod a ^ m = (if m <= n then 0 else (a :: int) ^ n)"
  214.60    apply clarsimp
  214.61    apply safe
  214.62 -   apply (simp add: zdvd_iff_zmod_eq_0 [symmetric])
  214.63 +   apply (simp add: dvd_eq_mod_eq_0 [symmetric])
  214.64     apply (drule le_iff_add [THEN iffD1])
  214.65     apply (force simp: zpower_zadd_distrib)
  214.66    apply (rule mod_pos_pos_trivial)
   215.1 --- a/src/HOL/Word/WordGenLib.thy	Wed Mar 04 10:43:39 2009 +0100
   215.2 +++ b/src/HOL/Word/WordGenLib.thy	Wed Mar 04 10:45:52 2009 +0100
   215.3 @@ -273,7 +273,7 @@
   215.4    have x: "2^len_of TYPE('a) - i = -i + 2^len_of TYPE('a)" by simp
   215.5    show ?thesis
   215.6      apply (subst x)
   215.7 -    apply (subst word_uint.Abs_norm [symmetric], subst zmod_zadd_self2)
   215.8 +    apply (subst word_uint.Abs_norm [symmetric], subst mod_add_self2)
   215.9      apply simp
  215.10      done
  215.11  qed
   216.1 --- a/src/HOL/Word/WordShift.thy	Wed Mar 04 10:43:39 2009 +0100
   216.2 +++ b/src/HOL/Word/WordShift.thy	Wed Mar 04 10:45:52 2009 +0100
   216.3 @@ -530,7 +530,7 @@
   216.4    done
   216.5  
   216.6  lemma and_mask_dvd: "2 ^ n dvd uint w = (w AND mask n = 0)"
   216.7 -  apply (simp add: zdvd_iff_zmod_eq_0 and_mask_mod_2p)
   216.8 +  apply (simp add: dvd_eq_mod_eq_0 and_mask_mod_2p)
   216.9    apply (simp add: word_uint.norm_eq_iff [symmetric] word_of_int_homs)
  216.10    apply (subst word_uint.norm_Rep [symmetric])
  216.11    apply (simp only: bintrunc_bintrunc_min bintrunc_mod2p [symmetric] min_def)
   217.1 --- a/src/HOL/ZF/Games.thy	Wed Mar 04 10:43:39 2009 +0100
   217.2 +++ b/src/HOL/ZF/Games.thy	Wed Mar 04 10:45:52 2009 +0100
   217.3 @@ -847,7 +847,7 @@
   217.4    by (auto simp add: quotient_def)
   217.5  
   217.6  lemma equiv_eq_game[simp]: "equiv UNIV eq_game_rel"
   217.7 -  by (auto simp add: equiv_def refl_def sym_def trans_def eq_game_rel_def
   217.8 +  by (auto simp add: equiv_def refl_on_def sym_def trans_def eq_game_rel_def
   217.9      eq_game_sym intro: eq_game_refl eq_game_trans)
  217.10  
  217.11  instantiation Pg :: "{ord, zero, plus, minus, uminus}"
   218.1 --- a/src/HOL/ex/ApproximationEx.thy	Wed Mar 04 10:43:39 2009 +0100
   218.2 +++ b/src/HOL/ex/ApproximationEx.thy	Wed Mar 04 10:45:52 2009 +0100
   218.3 @@ -1,6 +1,7 @@
   218.4 -(* Title:    HOL/ex/ApproximationEx.thy
   218.5 -   Author:   Johannes Hoelzl <hoelzl@in.tum.de> 2009
   218.6 +(*  Title:      HOL/ex/ApproximationEx.thy
   218.7 +    Author:     Johannes Hoelzl <hoelzl@in.tum.de> 2009
   218.8  *)
   218.9 +
  218.10  theory ApproximationEx
  218.11  imports "~~/src/HOL/Reflection/Approximation"
  218.12  begin
   219.1 --- a/src/HOL/ex/Eval_Examples.thy	Wed Mar 04 10:43:39 2009 +0100
   219.2 +++ b/src/HOL/ex/Eval_Examples.thy	Wed Mar 04 10:45:52 2009 +0100
   219.3 @@ -1,6 +1,4 @@
   219.4 -(*  ID:         $Id$
   219.5 -    Author:     Florian Haftmann, TU Muenchen
   219.6 -*)
   219.7 +(* Author: Florian Haftmann, TU Muenchen *)
   219.8  
   219.9  header {* Small examples for evaluation mechanisms *}
  219.10  
   220.1 --- a/src/HOL/ex/Numeral.thy	Wed Mar 04 10:43:39 2009 +0100
   220.2 +++ b/src/HOL/ex/Numeral.thy	Wed Mar 04 10:45:52 2009 +0100
   220.3 @@ -157,6 +157,18 @@
   220.4    by (simp_all add: num_eq_iff nat_of_num_add nat_of_num_mult
   220.5                      left_distrib right_distrib)
   220.6  
   220.7 +lemma Dig_eq:
   220.8 +  "One = One \<longleftrightarrow> True"
   220.9 +  "One = Dig0 n \<longleftrightarrow> False"
  220.10 +  "One = Dig1 n \<longleftrightarrow> False"
  220.11 +  "Dig0 m = One \<longleftrightarrow> False"
  220.12 +  "Dig1 m = One \<longleftrightarrow> False"
  220.13 +  "Dig0 m = Dig0 n \<longleftrightarrow> m = n"
  220.14 +  "Dig0 m = Dig1 n \<longleftrightarrow> False"
  220.15 +  "Dig1 m = Dig0 n \<longleftrightarrow> False"
  220.16 +  "Dig1 m = Dig1 n \<longleftrightarrow> m = n"
  220.17 +  by simp_all
  220.18 +
  220.19  lemma less_eq_num_code [numeral, simp, code]:
  220.20    "One \<le> n \<longleftrightarrow> True"
  220.21    "Dig0 m \<le> One \<longleftrightarrow> False"
  220.22 @@ -433,21 +445,12 @@
  220.23  
  220.24  text {*  Could be perhaps more general than here. *}
  220.25  
  220.26 -lemma (in ordered_semidom) of_num_pos: "0 < of_num n"
  220.27 -proof -
  220.28 -  have "(0::nat) < of_num n"
  220.29 -    by (induct n) (simp_all add: semiring_numeral_class.of_num.simps)
  220.30 -  then have "of_nat 0 \<noteq> of_nat (of_num n)" 
  220.31 -    by (cases n) (simp_all only: semiring_numeral_class.of_num.simps of_nat_eq_iff)
  220.32 -  then have "0 \<noteq> of_num n"
  220.33 -    by (simp add: of_nat_of_num)
  220.34 -  moreover have "0 \<le> of_nat (of_num n)" by simp
  220.35 -  ultimately show ?thesis by (simp add: of_nat_of_num)
  220.36 -qed
  220.37 -
  220.38  context ordered_semidom
  220.39  begin
  220.40  
  220.41 +lemma of_num_pos [numeral]: "0 < of_num n"
  220.42 +  by (induct n) (simp_all add: of_num.simps add_pos_pos)
  220.43 +
  220.44  lemma of_num_less_eq_iff [numeral]: "of_num m \<le> of_num n \<longleftrightarrow> m \<le> n"
  220.45  proof -
  220.46    have "of_nat (of_num m) \<le> of_nat (of_num n) \<longleftrightarrow> m \<le> n"
  220.47 @@ -490,6 +493,68 @@
  220.48    then show ?thesis by (simp add: of_num_one)
  220.49  qed
  220.50  
  220.51 +lemma of_num_nonneg [numeral]: "0 \<le> of_num n"
  220.52 +  by (induct n) (simp_all add: of_num.simps add_nonneg_nonneg)
  220.53 +
  220.54 +lemma of_num_less_zero_iff [numeral]: "\<not> of_num n < 0"
  220.55 +  by (simp add: not_less of_num_nonneg)
  220.56 +
  220.57 +lemma of_num_le_zero_iff [numeral]: "\<not> of_num n \<le> 0"
  220.58 +  by (simp add: not_le of_num_pos)
  220.59 +
  220.60 +end
  220.61 +
  220.62 +context ordered_idom
  220.63 +begin
  220.64 +
  220.65 +lemma minus_of_num_less_of_num_iff [numeral]: "- of_num m < of_num n"
  220.66 +proof -
  220.67 +  have "- of_num m < 0" by (simp add: of_num_pos)
  220.68 +  also have "0 < of_num n" by (simp add: of_num_pos)
  220.69 +  finally show ?thesis .
  220.70 +qed
  220.71 +
  220.72 +lemma minus_of_num_less_one_iff [numeral]: "- of_num n < 1"
  220.73 +proof -
  220.74 +  have "- of_num n < 0" by (simp add: of_num_pos)
  220.75 +  also have "0 < 1" by simp
  220.76 +  finally show ?thesis .
  220.77 +qed
  220.78 +
  220.79 +lemma minus_one_less_of_num_iff [numeral]: "- 1 < of_num n"
  220.80 +proof -
  220.81 +  have "- 1 < 0" by simp
  220.82 +  also have "0 < of_num n" by (simp add: of_num_pos)
  220.83 +  finally show ?thesis .
  220.84 +qed
  220.85 +
  220.86 +lemma minus_of_num_le_of_num_iff [numeral]: "- of_num m \<le> of_num n"
  220.87 +  by (simp add: less_imp_le minus_of_num_less_of_num_iff)
  220.88 +
  220.89 +lemma minus_of_num_le_one_iff [numeral]: "- of_num n \<le> 1"
  220.90 +  by (simp add: less_imp_le minus_of_num_less_one_iff)
  220.91 +
  220.92 +lemma minus_one_le_of_num_iff [numeral]: "- 1 \<le> of_num n"
  220.93 +  by (simp add: less_imp_le minus_one_less_of_num_iff)
  220.94 +
  220.95 +lemma of_num_le_minus_of_num_iff [numeral]: "\<not> of_num m \<le> - of_num n"
  220.96 +  by (simp add: not_le minus_of_num_less_of_num_iff)
  220.97 +
  220.98 +lemma one_le_minus_of_num_iff [numeral]: "\<not> 1 \<le> - of_num n"
  220.99 +  by (simp add: not_le minus_of_num_less_one_iff)
 220.100 +
 220.101 +lemma of_num_le_minus_one_iff [numeral]: "\<not> of_num n \<le> - 1"
 220.102 +  by (simp add: not_le minus_one_less_of_num_iff)
 220.103 +
 220.104 +lemma of_num_less_minus_of_num_iff [numeral]: "\<not> of_num m < - of_num n"
 220.105 +  by (simp add: not_less minus_of_num_le_of_num_iff)
 220.106 +
 220.107 +lemma one_less_minus_of_num_iff [numeral]: "\<not> 1 < - of_num n"
 220.108 +  by (simp add: not_less minus_of_num_le_one_iff)
 220.109 +
 220.110 +lemma of_num_less_minus_one_iff [numeral]: "\<not> of_num n < - 1"
 220.111 +  by (simp add: not_less minus_one_le_of_num_iff)
 220.112 +
 220.113  end
 220.114  
 220.115  subsubsection {*
   221.1 --- a/src/HOL/ex/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   221.2 +++ b/src/HOL/ex/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   221.3 @@ -93,4 +93,5 @@
   221.4    use_thy "Sudoku"
   221.5  else ();
   221.6  
   221.7 -HTML.with_charset "utf-8" (no_document use_thys) ["Hebrew", "Chinese"];
   221.8 +HTML.with_charset "utf-8" (no_document use_thys)
   221.9 +  ["Hebrew", "Chinese", "Serbian"];
   222.1 --- a/src/HOL/ex/Tarski.thy	Wed Mar 04 10:43:39 2009 +0100
   222.2 +++ b/src/HOL/ex/Tarski.thy	Wed Mar 04 10:45:52 2009 +0100
   222.3 @@ -73,7 +73,7 @@
   222.4  
   222.5  definition
   222.6    PartialOrder :: "('a potype) set" where
   222.7 -  "PartialOrder = {P. refl (pset P) (order P) & antisym (order P) &
   222.8 +  "PartialOrder = {P. refl_on (pset P) (order P) & antisym (order P) &
   222.9                         trans (order P)}"
  222.10  
  222.11  definition
  222.12 @@ -158,7 +158,7 @@
  222.13  unfolding PartialOrder_def dual_def
  222.14  by auto
  222.15  
  222.16 -lemma (in PO) PO_imp_refl [simp]: "refl A r"
  222.17 +lemma (in PO) PO_imp_refl_on [simp]: "refl_on A r"
  222.18  apply (insert cl_po)
  222.19  apply (simp add: PartialOrder_def A_def r_def)
  222.20  done
  222.21 @@ -175,7 +175,7 @@
  222.22  
  222.23  lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
  222.24  apply (insert cl_po)
  222.25 -apply (simp add: PartialOrder_def refl_def A_def r_def)
  222.26 +apply (simp add: PartialOrder_def refl_on_def A_def r_def)
  222.27  done
  222.28  
  222.29  lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
  222.30 @@ -198,7 +198,7 @@
  222.31  apply (simp (no_asm) add: PartialOrder_def)
  222.32  apply auto
  222.33  -- {* refl *}
  222.34 -apply (simp add: refl_def induced_def)
  222.35 +apply (simp add: refl_on_def induced_def)
  222.36  apply (blast intro: reflE)
  222.37  -- {* antisym *}
  222.38  apply (simp add: antisym_def induced_def)
  222.39 @@ -235,7 +235,7 @@
  222.40  
  222.41  lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
  222.42  apply (insert cl_po)
  222.43 -apply (simp add: PartialOrder_def dual_def refl_converse
  222.44 +apply (simp add: PartialOrder_def dual_def refl_on_converse
  222.45                   trans_converse antisym_converse)
  222.46  done
  222.47  
  222.48 @@ -266,8 +266,8 @@
  222.49  declare CL_imp_PO [THEN PO.PO_imp_sym, simp]
  222.50  declare CL_imp_PO [THEN PO.PO_imp_trans, simp]*)
  222.51  
  222.52 -lemma (in CL) CO_refl: "refl A r"
  222.53 -by (rule PO_imp_refl)
  222.54 +lemma (in CL) CO_refl_on: "refl_on A r"
  222.55 +by (rule PO_imp_refl_on)
  222.56  
  222.57  lemma (in CL) CO_antisym: "antisym r"
  222.58  by (rule PO_imp_sym)
  222.59 @@ -533,7 +533,7 @@
  222.60  
  222.61  lemma (in CLF) fix_in_H:
  222.62       "[| H = {x. (x, f x) \<in> r & x \<in> A};  x \<in> P |] ==> x \<in> H"
  222.63 -by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl
  222.64 +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
  222.65                      fix_subset [of f A, THEN subsetD])
  222.66  
  222.67  lemma (in CLF) fixf_le_lubH:
  222.68 @@ -583,8 +583,8 @@
  222.69  subsection {* interval *}
  222.70  
  222.71  lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
  222.72 -apply (insert CO_refl)
  222.73 -apply (simp add: refl_def, blast)
  222.74 +apply (insert CO_refl_on)
  222.75 +apply (simp add: refl_on_def, blast)
  222.76  done
  222.77  
  222.78  lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
  222.79 @@ -754,7 +754,7 @@
  222.80  apply (rule notI)
  222.81  apply (drule_tac a = "Top cl" in equals0D)
  222.82  apply (simp add: interval_def)
  222.83 -apply (simp add: refl_def Top_in_lattice Top_prop)
  222.84 +apply (simp add: refl_on_def Top_in_lattice Top_prop)
  222.85  done
  222.86  
  222.87  lemma (in CLF) Bot_intv_not_empty: "x \<in> A ==> interval r (Bot cl) x \<noteq> {}"
   223.1 --- a/src/HOL/ex/ThreeDivides.thy	Wed Mar 04 10:43:39 2009 +0100
   223.2 +++ b/src/HOL/ex/ThreeDivides.thy	Wed Mar 04 10:45:52 2009 +0100
   223.3 @@ -187,9 +187,8 @@
   223.4      "nd = nlen (m div 10) \<Longrightarrow>
   223.5      m div 10 = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x)"
   223.6      by blast
   223.7 -  have "\<exists>c. m = 10*(m div 10) + c \<and> c < 10" by presburger
   223.8 -  then obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10" ..
   223.9 -  then have cdef: "c = m mod 10" by arith
  223.10 +  obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10"
  223.11 +    and cdef: "c = m mod 10" by simp
  223.12    show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)"
  223.13    proof -
  223.14      from `Suc nd = nlen m`
   224.1 --- a/src/HOLCF/ConvexPD.thy	Wed Mar 04 10:43:39 2009 +0100
   224.2 +++ b/src/HOLCF/ConvexPD.thy	Wed Mar 04 10:45:52 2009 +0100
   224.3 @@ -291,22 +291,26 @@
   224.4  apply (simp add: PDPlus_commute)
   224.5  done
   224.6  
   224.7 -lemma convex_plus_absorb: "xs +\<natural> xs = xs"
   224.8 +lemma convex_plus_absorb [simp]: "xs +\<natural> xs = xs"
   224.9  apply (induct xs rule: convex_pd.principal_induct, simp)
  224.10  apply (simp add: PDPlus_absorb)
  224.11  done
  224.12  
  224.13 -interpretation aci_convex_plus!: ab_semigroup_idem_mult "op +\<natural>"
  224.14 -  proof qed (rule convex_plus_assoc convex_plus_commute convex_plus_absorb)+
  224.15 +lemma convex_plus_left_commute: "xs +\<natural> (ys +\<natural> zs) = ys +\<natural> (xs +\<natural> zs)"
  224.16 +by (rule mk_left_commute
  224.17 +    [of "op +\<natural>", OF convex_plus_assoc convex_plus_commute])
  224.18  
  224.19 -lemma convex_plus_left_commute: "xs +\<natural> (ys +\<natural> zs) = ys +\<natural> (xs +\<natural> zs)"
  224.20 -by (rule aci_convex_plus.mult_left_commute)
  224.21 +lemma convex_plus_left_absorb [simp]: "xs +\<natural> (xs +\<natural> ys) = xs +\<natural> ys"
  224.22 +by (simp only: convex_plus_assoc [symmetric] convex_plus_absorb)
  224.23  
  224.24 -lemma convex_plus_left_absorb: "xs +\<natural> (xs +\<natural> ys) = xs +\<natural> ys"
  224.25 -by (rule aci_convex_plus.mult_left_idem)
  224.26 -(*
  224.27 -lemmas convex_plus_aci = aci_convex_plus.mult_ac_idem
  224.28 -*)
  224.29 +text {* Useful for @{text "simp add: convex_plus_ac"} *}
  224.30 +lemmas convex_plus_ac =
  224.31 +  convex_plus_assoc convex_plus_commute convex_plus_left_commute
  224.32 +
  224.33 +text {* Useful for @{text "simp only: convex_plus_aci"} *}
  224.34 +lemmas convex_plus_aci =
  224.35 +  convex_plus_ac convex_plus_absorb convex_plus_left_absorb
  224.36 +
  224.37  lemma convex_unit_less_plus_iff [simp]:
  224.38    "{x}\<natural> \<sqsubseteq> ys +\<natural> zs \<longleftrightarrow> {x}\<natural> \<sqsubseteq> ys \<and> {x}\<natural> \<sqsubseteq> zs"
  224.39   apply (rule iffI)
  224.40 @@ -413,7 +417,7 @@
  224.41  apply unfold_locales
  224.42  apply (simp add: convex_plus_assoc)
  224.43  apply (simp add: convex_plus_commute)
  224.44 -apply (simp add: convex_plus_absorb eta_cfun)
  224.45 +apply (simp add: eta_cfun)
  224.46  done
  224.47  
  224.48  lemma convex_bind_basis_simps [simp]:
   225.1 --- a/src/HOLCF/Fixrec.thy	Wed Mar 04 10:43:39 2009 +0100
   225.2 +++ b/src/HOLCF/Fixrec.thy	Wed Mar 04 10:45:52 2009 +0100
   225.3 @@ -583,6 +583,20 @@
   225.4  
   225.5  use "Tools/fixrec_package.ML"
   225.6  
   225.7 +setup {* FixrecPackage.setup *}
   225.8 +
   225.9 +setup {*
  225.10 +  FixrecPackage.add_matchers
  225.11 +    [ (@{const_name up}, @{const_name match_up}),
  225.12 +      (@{const_name sinl}, @{const_name match_sinl}),
  225.13 +      (@{const_name sinr}, @{const_name match_sinr}),
  225.14 +      (@{const_name spair}, @{const_name match_spair}),
  225.15 +      (@{const_name cpair}, @{const_name match_cpair}),
  225.16 +      (@{const_name ONE}, @{const_name match_ONE}),
  225.17 +      (@{const_name TT}, @{const_name match_TT}),
  225.18 +      (@{const_name FF}, @{const_name match_FF}) ]
  225.19 +*}
  225.20 +
  225.21  hide (open) const return bind fail run cases
  225.22  
  225.23  end
   226.1 --- a/src/HOLCF/IsaMakefile	Wed Mar 04 10:43:39 2009 +0100
   226.2 +++ b/src/HOLCF/IsaMakefile	Wed Mar 04 10:45:52 2009 +0100
   226.3 @@ -89,6 +89,7 @@
   226.4  
   226.5  $(LOG)/HOLCF-ex.gz: $(OUT)/HOLCF ex/Stream.thy ex/Dagstuhl.thy \
   226.6    ex/Dnat.thy ex/Fix2.thy ex/Focus_ex.thy ex/Hoare.thy ex/Loop.thy \
   226.7 +  ex/Powerdomain_ex.thy \
   226.8    ex/ROOT.ML ex/Fixrec_ex.thy ../HOL/Library/Nat_Infinity.thy
   226.9  	@$(ISABELLE_TOOL) usedir $(OUT)/HOLCF ex
  226.10  
   227.1 --- a/src/HOLCF/LowerPD.thy	Wed Mar 04 10:43:39 2009 +0100
   227.2 +++ b/src/HOLCF/LowerPD.thy	Wed Mar 04 10:45:52 2009 +0100
   227.3 @@ -245,22 +245,25 @@
   227.4  apply (simp add: PDPlus_commute)
   227.5  done
   227.6  
   227.7 -lemma lower_plus_absorb: "xs +\<flat> xs = xs"
   227.8 +lemma lower_plus_absorb [simp]: "xs +\<flat> xs = xs"
   227.9  apply (induct xs rule: lower_pd.principal_induct, simp)
  227.10  apply (simp add: PDPlus_absorb)
  227.11  done
  227.12  
  227.13 -interpretation aci_lower_plus!: ab_semigroup_idem_mult "op +\<flat>"
  227.14 -  proof qed (rule lower_plus_assoc lower_plus_commute lower_plus_absorb)+
  227.15 +lemma lower_plus_left_commute: "xs +\<flat> (ys +\<flat> zs) = ys +\<flat> (xs +\<flat> zs)"
  227.16 +by (rule mk_left_commute [of "op +\<flat>", OF lower_plus_assoc lower_plus_commute])
  227.17  
  227.18 -lemma lower_plus_left_commute: "xs +\<flat> (ys +\<flat> zs) = ys +\<flat> (xs +\<flat> zs)"
  227.19 -by (rule aci_lower_plus.mult_left_commute)
  227.20 +lemma lower_plus_left_absorb [simp]: "xs +\<flat> (xs +\<flat> ys) = xs +\<flat> ys"
  227.21 +by (simp only: lower_plus_assoc [symmetric] lower_plus_absorb)
  227.22  
  227.23 -lemma lower_plus_left_absorb: "xs +\<flat> (xs +\<flat> ys) = xs +\<flat> ys"
  227.24 -by (rule aci_lower_plus.mult_left_idem)
  227.25 -(*
  227.26 -lemmas lower_plus_aci = aci_lower_plus.mult_ac_idem
  227.27 -*)
  227.28 +text {* Useful for @{text "simp add: lower_plus_ac"} *}
  227.29 +lemmas lower_plus_ac =
  227.30 +  lower_plus_assoc lower_plus_commute lower_plus_left_commute
  227.31 +
  227.32 +text {* Useful for @{text "simp only: lower_plus_aci"} *}
  227.33 +lemmas lower_plus_aci =
  227.34 +  lower_plus_ac lower_plus_absorb lower_plus_left_absorb
  227.35 +
  227.36  lemma lower_plus_less1: "xs \<sqsubseteq> xs +\<flat> ys"
  227.37  apply (induct xs ys rule: lower_pd.principal_induct2, simp, simp)
  227.38  apply (simp add: PDPlus_lower_less)
  227.39 @@ -315,14 +318,8 @@
  227.40    lower_plus_less_iff
  227.41    lower_unit_less_plus_iff
  227.42  
  227.43 -lemma fooble:
  227.44 -  fixes f :: "'a::po \<Rightarrow> 'b::po"
  227.45 -  assumes f: "\<And>x y. f x \<sqsubseteq> f y \<longleftrightarrow> x \<sqsubseteq> y"
  227.46 -  shows "f x = f y \<longleftrightarrow> x = y"
  227.47 -unfolding po_eq_conv by (simp add: f)
  227.48 -
  227.49  lemma lower_unit_eq_iff [simp]: "{x}\<flat> = {y}\<flat> \<longleftrightarrow> x = y"
  227.50 -by (rule lower_unit_less_iff [THEN fooble])
  227.51 +by (simp add: po_eq_conv)
  227.52  
  227.53  lemma lower_unit_strict [simp]: "{\<bottom>}\<flat> = \<bottom>"
  227.54  unfolding inst_lower_pd_pcpo Rep_compact_bot [symmetric] by simp
  227.55 @@ -399,7 +396,7 @@
  227.56  apply unfold_locales
  227.57  apply (simp add: lower_plus_assoc)
  227.58  apply (simp add: lower_plus_commute)
  227.59 -apply (simp add: lower_plus_absorb eta_cfun)
  227.60 +apply (simp add: eta_cfun)
  227.61  done
  227.62  
  227.63  lemma lower_bind_basis_simps [simp]:
   228.1 --- a/src/HOLCF/Tools/domain/domain_axioms.ML	Wed Mar 04 10:43:39 2009 +0100
   228.2 +++ b/src/HOLCF/Tools/domain/domain_axioms.ML	Wed Mar 04 10:45:52 2009 +0100
   228.3 @@ -1,5 +1,4 @@
   228.4  (*  Title:      HOLCF/Tools/domain/domain_axioms.ML
   228.5 -    ID:         $Id$
   228.6      Author:     David von Oheimb
   228.7  
   228.8  Syntax generator for domain command.
   228.9 @@ -29,7 +28,7 @@
  228.10    val rep_iso_ax = ("rep_iso", mk_trp(dc_abs`(dc_rep`%x_name') === %:x_name'));
  228.11  
  228.12    val when_def = ("when_def",%%:(dname^"_when") == 
  228.13 -     foldr (uncurry /\ ) (/\x_name'((when_body cons (fn (x,y) =>
  228.14 +     List.foldr (uncurry /\ ) (/\x_name'((when_body cons (fn (x,y) =>
  228.15  				Bound(1+length cons+x-y)))`(dc_rep`Bound 0))) (when_funs cons));
  228.16    
  228.17    val copy_def = let
  228.18 @@ -37,9 +36,9 @@
  228.19  			 then (cproj (Bound z) eqs (rec_of arg))`Bound(z-x)
  228.20  			 else Bound(z-x);
  228.21      fun one_con (con,args) =
  228.22 -        foldr /\# (list_ccomb (%%:con, mapn (idxs (length args)) 1 args)) args;
  228.23 +        List.foldr /\# (list_ccomb (%%:con, mapn (idxs (length args)) 1 args)) args;
  228.24    in ("copy_def", %%:(dname^"_copy") ==
  228.25 -       /\"f" (list_ccomb (%%:(dname^"_when"), map one_con cons))) end;
  228.26 +       /\ "f" (list_ccomb (%%:(dname^"_when"), map one_con cons))) end;
  228.27  
  228.28  (* -- definitions concerning the constructors, discriminators and selectors - *)
  228.29  
  228.30 @@ -49,7 +48,7 @@
  228.31      fun inj y 1 _ = y
  228.32      |   inj y _ 0 = mk_sinl y
  228.33      |   inj y i j = mk_sinr (inj y (i-1) (j-1));
  228.34 -  in foldr /\# (dc_abs`(inj (parms args) m n)) args end;
  228.35 +  in List.foldr /\# (dc_abs`(inj (parms args) m n)) args end;
  228.36    
  228.37    val con_defs = mapn (fn n => fn (con,args) =>
  228.38      (extern_name con ^"_def", %%:con == con_def (length cons) n (con,args))) 0 cons;
  228.39 @@ -57,14 +56,14 @@
  228.40    val dis_defs = let
  228.41  	fun ddef (con,_) = (dis_name con ^"_def",%%:(dis_name con) == 
  228.42  		 list_ccomb(%%:(dname^"_when"),map 
  228.43 -			(fn (con',args) => (foldr /\#
  228.44 +			(fn (con',args) => (List.foldr /\#
  228.45  			   (if con'=con then TT else FF) args)) cons))
  228.46  	in map ddef cons end;
  228.47  
  228.48    val mat_defs = let
  228.49  	fun mdef (con,_) = (mat_name con ^"_def",%%:(mat_name con) == 
  228.50  		 list_ccomb(%%:(dname^"_when"),map 
  228.51 -			(fn (con',args) => (foldr /\#
  228.52 +			(fn (con',args) => (List.foldr /\#
  228.53  			   (if con'=con
  228.54                                 then mk_return (mk_ctuple (map (bound_arg args) args))
  228.55                                 else mk_fail) args)) cons))
  228.56 @@ -79,7 +78,7 @@
  228.57            val r = Bound (length args);
  228.58            val rhs = case args of [] => mk_return HOLogic.unit
  228.59                                  | _ => mk_ctuple_pat ps ` mk_ctuple xs;
  228.60 -          fun one_con (con',args') = foldr /\# (if con'=con then rhs else mk_fail) args';
  228.61 +          fun one_con (con',args') = List.foldr /\# (if con'=con then rhs else mk_fail) args';
  228.62          in (pat_name con ^"_def", list_comb (%%:(pat_name con), ps) == 
  228.63                 list_ccomb(%%:(dname^"_when"), map one_con cons))
  228.64          end
  228.65 @@ -89,7 +88,7 @@
  228.66  	fun sdef con n arg = Option.map (fn sel => (sel^"_def",%%:sel == 
  228.67  		 list_ccomb(%%:(dname^"_when"),map 
  228.68  			(fn (con',args) => if con'<>con then UU else
  228.69 -			 foldr /\# (Bound (length args - n)) args) cons))) (sel_of arg);
  228.70 +			 List.foldr /\# (Bound (length args - n)) args) cons))) (sel_of arg);
  228.71  	in List.mapPartial I (List.concat(map (fn (con,args) => mapn (sdef con) 1 args) cons)) end;
  228.72  
  228.73  
  228.74 @@ -107,7 +106,7 @@
  228.75      [when_def, copy_def] @
  228.76       con_defs @ dis_defs @ mat_defs @ pat_defs @ sel_defs @
  228.77      [take_def, finite_def])
  228.78 -end; (* let *)
  228.79 +end; (* let (calc_axioms) *)
  228.80  
  228.81  fun infer_props thy = map (apsnd (FixrecPackage.legacy_infer_prop thy));
  228.82  
  228.83 @@ -117,6 +116,14 @@
  228.84  fun add_defs_i x = snd o (PureThy.add_defs false) (map (Thm.no_attributes o apfst Binding.name) x);
  228.85  fun add_defs_infer defs thy = add_defs_i (infer_props thy defs) thy;
  228.86  
  228.87 +fun add_matchers (((dname,_),cons) : eq) thy =
  228.88 +  let
  228.89 +    val con_names = map fst cons;
  228.90 +    val mat_names = map mat_name con_names;
  228.91 +    fun qualify n = Sign.full_name thy (Binding.name n);
  228.92 +    val ms = map qualify con_names ~~ map qualify mat_names;
  228.93 +  in FixrecPackage.add_matchers ms thy end;
  228.94 +
  228.95  in (* local *)
  228.96  
  228.97  fun add_axioms (comp_dnam, eqs : eq list) thy' = let
  228.98 @@ -125,7 +132,7 @@
  228.99    val x_name = idx_name dnames "x"; 
 228.100    fun copy_app dname = %%:(dname^"_copy")`Bound 0;
 228.101    val copy_def = ("copy_def" , %%:(comp_dname^"_copy") ==
 228.102 -				    /\"f"(mk_ctuple (map copy_app dnames)));
 228.103 +				    /\ "f"(mk_ctuple (map copy_app dnames)));
 228.104    val bisim_def = ("bisim_def",%%:(comp_dname^"_bisim")==mk_lam("R",
 228.105      let
 228.106        fun one_con (con,args) = let
 228.107 @@ -144,11 +151,11 @@
 228.108  					 (allargs~~((allargs_cnt-1) downto 0)));
 228.109  	fun rel_app i ra = proj (Bound(allargs_cnt+2)) eqs (rec_of ra) $ 
 228.110  			   Bound (2*recs_cnt-i) $ Bound (recs_cnt-i);
 228.111 -	val capps = foldr mk_conj (mk_conj(
 228.112 +	val capps = List.foldr mk_conj (mk_conj(
 228.113  	   Bound(allargs_cnt+1)===list_ccomb(%%:con,map (bound_arg allvns) vns1),
 228.114  	   Bound(allargs_cnt+0)===list_ccomb(%%:con,map (bound_arg allvns) vns2)))
 228.115             (mapn rel_app 1 rec_args);
 228.116 -        in foldr mk_ex (Library.foldr mk_conj 
 228.117 +        in List.foldr mk_ex (Library.foldr mk_conj 
 228.118  			      (map (defined o Bound) nonlazy_idxs,capps)) allvns end;
 228.119        fun one_comp n (_,cons) =mk_all(x_name(n+1),mk_all(x_name(n+1)^"'",mk_imp(
 228.120  	 		proj (Bound 2) eqs n $ Bound 1 $ Bound 0,
 228.121 @@ -164,7 +171,8 @@
 228.122  in thy |> Sign.add_path comp_dnam  
 228.123         |> add_defs_infer (bisim_def::(if length eqs>1 then [copy_def] else []))
 228.124         |> Sign.parent_path
 228.125 -end;
 228.126 +       |> fold add_matchers eqs
 228.127 +end; (* let (add_axioms) *)
 228.128  
 228.129  end; (* local *)
 228.130  end; (* struct *)
   229.1 --- a/src/HOLCF/Tools/domain/domain_library.ML	Wed Mar 04 10:43:39 2009 +0100
   229.2 +++ b/src/HOLCF/Tools/domain/domain_library.ML	Wed Mar 04 10:45:52 2009 +0100
   229.3 @@ -1,5 +1,4 @@
   229.4  (*  Title:      HOLCF/Tools/domain/domain_library.ML
   229.5 -    ID:         $Id$
   229.6      Author:     David von Oheimb
   229.7  
   229.8  Library for domain command.
   229.9 @@ -15,7 +14,7 @@
  229.10  			     | itr [a] = f2 a
  229.11  			     | itr (a::l) = f(a, itr l)
  229.12  in  itr l  end;
  229.13 -fun map_cumulr f start xs = foldr (fn (x,(ys,res))=>case f(x,res) of (y,res2) =>
  229.14 +fun map_cumulr f start xs = List.foldr (fn (x,(ys,res))=>case f(x,res) of (y,res2) =>
  229.15  						  (y::ys,res2)) ([],start) xs;
  229.16  
  229.17  
   230.1 --- a/src/HOLCF/Tools/domain/domain_syntax.ML	Wed Mar 04 10:43:39 2009 +0100
   230.2 +++ b/src/HOLCF/Tools/domain/domain_syntax.ML	Wed Mar 04 10:45:52 2009 +0100
   230.3 @@ -1,5 +1,4 @@
   230.4  (*  Title:      HOLCF/Tools/domain/domain_syntax.ML
   230.5 -    ID:         $Id$
   230.6      Author:     David von Oheimb
   230.7  
   230.8  Syntax generator for domain command.
   230.9 @@ -22,14 +21,14 @@
  230.10  			    else foldr1 mk_sprodT (map opt_lazy args);
  230.11    fun freetvar s = let val tvar = mk_TFree s in
  230.12  		   if tvar mem typevars then freetvar ("t"^s) else tvar end;
  230.13 -  fun when_type (_   ,_,args) = foldr (op ->>) (freetvar "t") (map third args);
  230.14 +  fun when_type (_   ,_,args) = List.foldr (op ->>) (freetvar "t") (map third args);
  230.15  in
  230.16    val dtype  = Type(dname,typevars);
  230.17    val dtype2 = foldr1 mk_ssumT (map prod cons');
  230.18    val dnam = Sign.base_name dname;
  230.19    val const_rep  = (dnam^"_rep" ,              dtype  ->> dtype2, NoSyn);
  230.20    val const_abs  = (dnam^"_abs" ,              dtype2 ->> dtype , NoSyn);
  230.21 -  val const_when = (dnam^"_when",foldr (op ->>) (dtype ->> freetvar "t") (map when_type cons'), NoSyn);
  230.22 +  val const_when = (dnam^"_when", List.foldr (op ->>) (dtype ->> freetvar "t") (map when_type cons'), NoSyn);
  230.23    val const_copy = (dnam^"_copy", dtypeprod ->> dtype  ->> dtype , NoSyn);
  230.24  end;
  230.25  
  230.26 @@ -41,7 +40,7 @@
  230.27  							 else      c::esc cs
  230.28  	|   esc []      = []
  230.29  	in implode o esc o Symbol.explode end;
  230.30 -  fun con (name,s,args) = (name,foldr (op ->>) dtype (map third args),s);
  230.31 +  fun con (name,s,args) = (name, List.foldr (op ->>) dtype (map third args),s);
  230.32    fun dis (con ,s,_   ) = (dis_name_ con, dtype->>trT,
  230.33  			   Mixfix(escape ("is_" ^ con), [], Syntax.max_pri));
  230.34  			(* strictly speaking, these constants have one argument,
  230.35 @@ -86,7 +85,7 @@
  230.36      val capp = app "Rep_CFun";
  230.37      fun con1 n (con,mx,args) = Library.foldl capp (c_ast con mx, argvars n args);
  230.38      fun case1 n (con,mx,args) = app "_case1" (con1 n (con,mx,args), expvar n);
  230.39 -    fun arg1 n (con,_,args) = foldr cabs (expvar n) (argvars n args);
  230.40 +    fun arg1 n (con,_,args) = List.foldr cabs (expvar n) (argvars n args);
  230.41      fun when1 n m = if n = m then arg1 n else K (Constant "UU");
  230.42  
  230.43      fun app_var x = mk_appl (Constant "_variable") [x, Variable "rhs"];
   231.1 --- a/src/HOLCF/Tools/fixrec_package.ML	Wed Mar 04 10:43:39 2009 +0100
   231.2 +++ b/src/HOLCF/Tools/fixrec_package.ML	Wed Mar 04 10:45:52 2009 +0100
   231.3 @@ -8,17 +8,24 @@
   231.4  sig
   231.5    val legacy_infer_term: theory -> term -> term
   231.6    val legacy_infer_prop: theory -> term -> term
   231.7 -  val add_fixrec: bool -> (Attrib.binding * string) list list -> theory -> theory
   231.8 -  val add_fixrec_i: bool -> ((binding * attribute list) * term) list list -> theory -> theory
   231.9 +
  231.10 +  val add_fixrec: bool -> (binding * string option * mixfix) list
  231.11 +    -> (Attrib.binding * string) list -> local_theory -> local_theory
  231.12 +
  231.13 +  val add_fixrec_i: bool -> (binding * typ option * mixfix) list
  231.14 +    -> (Attrib.binding * term) list -> local_theory -> local_theory
  231.15 +
  231.16    val add_fixpat: Attrib.binding * string list -> theory -> theory
  231.17 -  val add_fixpat_i: (binding * attribute list) * term list -> theory -> theory
  231.18 +  val add_fixpat_i: Thm.binding * term list -> theory -> theory
  231.19 +  val add_matchers: (string * string) list -> theory -> theory
  231.20 +  val setup: theory -> theory
  231.21  end;
  231.22  
  231.23  structure FixrecPackage: FIXREC_PACKAGE =
  231.24  struct
  231.25  
  231.26  (* legacy type inference *)
  231.27 -
  231.28 +(* used by the domain package *)
  231.29  fun legacy_infer_term thy t =
  231.30    singleton (Syntax.check_terms (ProofContext.init thy)) (Sign.intern_term thy t);
  231.31  
  231.32 @@ -33,15 +40,41 @@
  231.33  fun fixrec_eq_err thy s eq =
  231.34    fixrec_err (s ^ "\nin\n" ^ quote (Syntax.string_of_term_global thy eq));
  231.35  
  231.36 +(*************************************************************************)
  231.37 +(***************************** building types ****************************)
  231.38 +(*************************************************************************)
  231.39 +
  231.40  (* ->> is taken from holcf_logic.ML *)
  231.41 -(* TODO: fix dependencies so we can import HOLCFLogic here *)
  231.42 -infixr 6 ->>;
  231.43 -fun S ->> T = Type (@{type_name "->"},[S,T]);
  231.44 +fun cfunT (T, U) = Type(@{type_name "->"}, [T, U]);
  231.45  
  231.46 -(* extern_name is taken from domain/library.ML *)
  231.47 -fun extern_name con = case Symbol.explode con of 
  231.48 -		   ("o"::"p"::" "::rest) => implode rest
  231.49 -		   | _ => con;
  231.50 +infixr 6 ->>; val (op ->>) = cfunT;
  231.51 +
  231.52 +fun dest_cfunT (Type(@{type_name "->"}, [T, U])) = (T, U)
  231.53 +  | dest_cfunT T = raise TYPE ("dest_cfunT", [T], []);
  231.54 +
  231.55 +fun binder_cfun (Type(@{type_name "->"},[T, U])) = T :: binder_cfun U
  231.56 +  | binder_cfun _   =  [];
  231.57 +
  231.58 +fun body_cfun (Type(@{type_name "->"},[T, U])) = body_cfun U
  231.59 +  | body_cfun T   =  T;
  231.60 +
  231.61 +fun strip_cfun T : typ list * typ =
  231.62 +  (binder_cfun T, body_cfun T);
  231.63 +
  231.64 +fun maybeT T = Type(@{type_name "maybe"}, [T]);
  231.65 +
  231.66 +fun dest_maybeT (Type(@{type_name "maybe"}, [T])) = T
  231.67 +  | dest_maybeT T = raise TYPE ("dest_maybeT", [T], []);
  231.68 +
  231.69 +fun tupleT [] = @{typ "unit"}
  231.70 +  | tupleT [T] = T
  231.71 +  | tupleT (T :: Ts) = HOLogic.mk_prodT (T, tupleT Ts);
  231.72 +
  231.73 +fun matchT T = body_cfun T ->> maybeT (tupleT (binder_cfun T));
  231.74 +
  231.75 +(*************************************************************************)
  231.76 +(***************************** building terms ****************************)
  231.77 +(*************************************************************************)
  231.78  
  231.79  val mk_trp = HOLogic.mk_Trueprop;
  231.80  
  231.81 @@ -52,60 +85,119 @@
  231.82  fun chead_of (Const(@{const_name Rep_CFun},_)$f$t) = chead_of f
  231.83    | chead_of u = u;
  231.84  
  231.85 -(* these are helpful functions copied from HOLCF/domain/library.ML *)
  231.86 -fun %: s = Free(s,dummyT);
  231.87 -fun %%: s = Const(s,dummyT);
  231.88 -infix 0 ==;  fun S ==  T = %%:"==" $ S $ T;
  231.89 -infix 1 ===; fun S === T = %%:"op =" $ S $ T;
  231.90 -infix 9 `  ; fun f ` x = %%:@{const_name Rep_CFun} $ f $ x;
  231.91 +fun capply_const (S, T) =
  231.92 +  Const(@{const_name Rep_CFun}, (S ->> T) --> (S --> T));
  231.93 +
  231.94 +fun cabs_const (S, T) =
  231.95 +  Const(@{const_name Abs_CFun}, (S --> T) --> (S ->> T));
  231.96 +
  231.97 +fun mk_capply (t, u) =
  231.98 +  let val (S, T) =
  231.99 +    case Term.fastype_of t of
 231.100 +        Type(@{type_name "->"}, [S, T]) => (S, T)
 231.101 +      | _ => raise TERM ("mk_capply " ^ ML_Syntax.print_list ML_Syntax.print_term [t, u], [t, u]);
 231.102 +  in capply_const (S, T) $ t $ u end;
 231.103 +
 231.104 +infix 0 ==;  val (op ==) = Logic.mk_equals;
 231.105 +infix 1 ===; val (op ===) = HOLogic.mk_eq;
 231.106 +infix 9 `  ; val (op `) = mk_capply;
 231.107 +
 231.108 +
 231.109 +fun mk_cpair (t, u) =
 231.110 +  let val T = Term.fastype_of t
 231.111 +      val U = Term.fastype_of u
 231.112 +      val cpairT = T ->> U ->> HOLogic.mk_prodT (T, U)
 231.113 +  in Const(@{const_name cpair}, cpairT) ` t ` u end;
 231.114 +
 231.115 +fun mk_cfst t =
 231.116 +  let val T = Term.fastype_of t;
 231.117 +      val (U, _) = HOLogic.dest_prodT T;
 231.118 +  in Const(@{const_name cfst}, T ->> U) ` t end;
 231.119 +
 231.120 +fun mk_csnd t =
 231.121 +  let val T = Term.fastype_of t;
 231.122 +      val (_, U) = HOLogic.dest_prodT T;
 231.123 +  in Const(@{const_name csnd}, T ->> U) ` t end;
 231.124 +
 231.125 +fun mk_csplit t =
 231.126 +  let val (S, TU) = dest_cfunT (Term.fastype_of t);
 231.127 +      val (T, U) = dest_cfunT TU;
 231.128 +      val csplitT = (S ->> T ->> U) ->> HOLogic.mk_prodT (S, T) ->> U;
 231.129 +  in Const(@{const_name csplit}, csplitT) ` t end;
 231.130  
 231.131  (* builds the expression (LAM v. rhs) *)
 231.132 -fun big_lambda v rhs = %%:@{const_name Abs_CFun}$(Term.lambda v rhs);
 231.133 +fun big_lambda v rhs =
 231.134 +  cabs_const (Term.fastype_of v, Term.fastype_of rhs) $ Term.lambda v rhs;
 231.135  
 231.136  (* builds the expression (LAM v1 v2 .. vn. rhs) *)
 231.137  fun big_lambdas [] rhs = rhs
 231.138    | big_lambdas (v::vs) rhs = big_lambda v (big_lambdas vs rhs);
 231.139  
 231.140  (* builds the expression (LAM <v1,v2,..,vn>. rhs) *)
 231.141 -fun lambda_ctuple [] rhs = big_lambda (%:"unit") rhs
 231.142 +fun lambda_ctuple [] rhs = big_lambda (Free("unit", HOLogic.unitT)) rhs
 231.143    | lambda_ctuple (v::[]) rhs = big_lambda v rhs
 231.144    | lambda_ctuple (v::vs) rhs =
 231.145 -      %%:@{const_name csplit}`(big_lambda v (lambda_ctuple vs rhs));
 231.146 +      mk_csplit (big_lambda v (lambda_ctuple vs rhs));
 231.147  
 231.148  (* builds the expression <v1,v2,..,vn> *)
 231.149 -fun mk_ctuple [] = %%:"UU"
 231.150 +fun mk_ctuple [] = @{term "UU::unit"}
 231.151  |   mk_ctuple (t::[]) = t
 231.152 -|   mk_ctuple (t::ts) = %%:@{const_name cpair}`t`(mk_ctuple ts);
 231.153 +|   mk_ctuple (t::ts) = mk_cpair (t, mk_ctuple ts);
 231.154 +
 231.155 +fun mk_return t =
 231.156 +  let val T = Term.fastype_of t
 231.157 +  in Const(@{const_name Fixrec.return}, T ->> maybeT T) ` t end;
 231.158 +
 231.159 +fun mk_bind (t, u) =
 231.160 +  let val (T, mU) = dest_cfunT (Term.fastype_of u);
 231.161 +      val bindT = maybeT T ->> (T ->> mU) ->> mU;
 231.162 +  in Const(@{const_name Fixrec.bind}, bindT) ` t ` u end;
 231.163 +
 231.164 +fun mk_mplus (t, u) =
 231.165 +  let val mT = Term.fastype_of t
 231.166 +  in Const(@{const_name Fixrec.mplus}, mT ->> mT ->> mT) ` t ` u end;
 231.167 +
 231.168 +fun mk_run t =
 231.169 +  let val mT = Term.fastype_of t
 231.170 +      val T = dest_maybeT mT
 231.171 +  in Const(@{const_name Fixrec.run}, mT ->> T) ` t end;
 231.172 +
 231.173 +fun mk_fix t =
 231.174 +  let val (T, _) = dest_cfunT (Term.fastype_of t)
 231.175 +  in Const(@{const_name fix}, (T ->> T) ->> T) ` t end;
 231.176  
 231.177  (*************************************************************************)
 231.178  (************* fixed-point definitions and unfolding theorems ************)
 231.179  (*************************************************************************)
 231.180  
 231.181 -fun add_fixdefs eqs thy =
 231.182 +fun add_fixdefs
 231.183 +  (fixes : ((binding * typ) * mixfix) list)
 231.184 +  (spec : (Attrib.binding * term) list)
 231.185 +  (lthy : local_theory) =
 231.186    let
 231.187 -    val (lhss,rhss) = ListPair.unzip (map dest_eqs eqs);
 231.188 -    val fixpoint = %%:@{const_name fix}`lambda_ctuple lhss (mk_ctuple rhss);
 231.189 +    val names = map (Binding.name_of o fst o fst) fixes;
 231.190 +    val all_names = space_implode "_" names;
 231.191 +    val (lhss,rhss) = ListPair.unzip (map (dest_eqs o snd) spec);
 231.192 +    val fixpoint = mk_fix (lambda_ctuple lhss (mk_ctuple rhss));
 231.193      
 231.194 -    fun one_def (l as Const(n,T)) r =
 231.195 -          let val b = Sign.base_name n in (b, (b^"_def", l == r)) end
 231.196 +    fun one_def (l as Free(n,_)) r =
 231.197 +          let val b = Sign.base_name n
 231.198 +          in ((Binding.name (b^"_def"), []), r) end
 231.199        | one_def _ _ = fixrec_err "fixdefs: lhs not of correct form";
 231.200      fun defs [] _ = []
 231.201        | defs (l::[]) r = [one_def l r]
 231.202 -      | defs (l::ls) r = one_def l (%%:@{const_name cfst}`r) :: defs ls (%%:@{const_name csnd}`r);
 231.203 -    val (names, pre_fixdefs) = ListPair.unzip (defs lhss fixpoint);
 231.204 -    
 231.205 -    val fixdefs = map (apsnd (legacy_infer_prop thy)) pre_fixdefs;
 231.206 -    val (fixdef_thms, thy') =
 231.207 -      PureThy.add_defs false (map (Thm.no_attributes o apfst Binding.name) fixdefs) thy;
 231.208 -    val ctuple_fixdef_thm = foldr1 (fn (x,y) => @{thm cpair_equalI} OF [x,y]) fixdef_thms;
 231.209 -    
 231.210 -    val ctuple_unfold = legacy_infer_term thy' (mk_trp (mk_ctuple lhss === mk_ctuple rhss));
 231.211 -    val ctuple_unfold_thm = Goal.prove_global thy' [] [] ctuple_unfold
 231.212 -          (fn _ => EVERY [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
 231.213 -                    simp_tac (simpset_of thy') 1]);
 231.214 -    val ctuple_induct_thm =
 231.215 -          (space_implode "_" names ^ "_induct", ctuple_fixdef_thm RS def_fix_ind);
 231.216 -    
 231.217 +      | defs (l::ls) r = one_def l (mk_cfst r) :: defs ls (mk_csnd r);
 231.218 +    val fixdefs = defs lhss fixpoint;
 231.219 +    val define_all = fold_map (LocalTheory.define Thm.definitionK);
 231.220 +    val (fixdef_thms : (term * (string * thm)) list, lthy') = lthy
 231.221 +      |> define_all (map (apfst fst) fixes ~~ fixdefs);
 231.222 +    fun cpair_equalI (thm1, thm2) = @{thm cpair_equalI} OF [thm1, thm2];
 231.223 +    val ctuple_fixdef_thm = foldr1 cpair_equalI (map (snd o snd) fixdef_thms);
 231.224 +    val ctuple_induct_thm = ctuple_fixdef_thm RS def_fix_ind;
 231.225 +    val ctuple_unfold_thm =
 231.226 +      Goal.prove lthy' [] [] (mk_trp (mk_ctuple lhss === mk_ctuple rhss))
 231.227 +        (fn _ => EVERY [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
 231.228 +                   simp_tac (local_simpset_of lthy') 1]);
 231.229      fun unfolds [] thm = []
 231.230        | unfolds (n::[]) thm = [(n^"_unfold", thm)]
 231.231        | unfolds (n::ns) thm = let
 231.232 @@ -113,93 +205,117 @@
 231.233            val thmR = thm RS @{thm cpair_eqD2};
 231.234          in (n^"_unfold", thmL) :: unfolds ns thmR end;
 231.235      val unfold_thms = unfolds names ctuple_unfold_thm;
 231.236 -    val thms = ctuple_induct_thm :: unfold_thms;
 231.237 -    val (_, thy'') = PureThy.add_thms (map (Thm.no_attributes o apfst Binding.name) thms) thy';
 231.238 +    fun mk_note (n, thm) = ((Binding.name n, []), [thm]);
 231.239 +    val (thmss, lthy'') = lthy'
 231.240 +      |> fold_map (LocalTheory.note Thm.theoremK o mk_note)
 231.241 +        ((all_names ^ "_induct", ctuple_induct_thm) :: unfold_thms);
 231.242    in
 231.243 -    (thy'', names, fixdef_thms, map snd unfold_thms)
 231.244 +    (lthy'', names, fixdef_thms, map snd unfold_thms)
 231.245    end;
 231.246  
 231.247  (*************************************************************************)
 231.248  (*********** monadic notation and pattern matching compilation ***********)
 231.249  (*************************************************************************)
 231.250  
 231.251 -fun add_names (Const(a,_), bs) = insert (op =) (Sign.base_name a) bs
 231.252 -  | add_names (Free(a,_) , bs) = insert (op =) a bs
 231.253 -  | add_names (f $ u     , bs) = add_names (f, add_names(u, bs))
 231.254 -  | add_names (Abs(a,_,t), bs) = add_names (t, insert (op =) a bs)
 231.255 -  | add_names (_         , bs) = bs;
 231.256 +structure FixrecMatchData = TheoryDataFun (
 231.257 +  type T = string Symtab.table;
 231.258 +  val empty = Symtab.empty;
 231.259 +  val copy = I;
 231.260 +  val extend = I;
 231.261 +  fun merge _ tabs : T = Symtab.merge (K true) tabs;
 231.262 +);
 231.263  
 231.264 -fun add_terms ts xs = foldr add_names xs ts;
 231.265 +(* associate match functions with pattern constants *)
 231.266 +fun add_matchers ms = FixrecMatchData.map (fold Symtab.update ms);
 231.267 +
 231.268 +fun taken_names (t : term) : bstring list =
 231.269 +  let
 231.270 +    fun taken (Const(a,_), bs) = insert (op =) (Sign.base_name a) bs
 231.271 +      | taken (Free(a,_) , bs) = insert (op =) a bs
 231.272 +      | taken (f $ u     , bs) = taken (f, taken (u, bs))
 231.273 +      | taken (Abs(a,_,t), bs) = taken (t, insert (op =) a bs)
 231.274 +      | taken (_         , bs) = bs;
 231.275 +  in
 231.276 +    taken (t, [])
 231.277 +  end;
 231.278  
 231.279  (* builds a monadic term for matching a constructor pattern *)
 231.280 -fun pre_build pat rhs vs taken =
 231.281 +fun pre_build match_name pat rhs vs taken =
 231.282    case pat of
 231.283      Const(@{const_name Rep_CFun},_)$f$(v as Free(n,T)) =>
 231.284 -      pre_build f rhs (v::vs) taken
 231.285 +      pre_build match_name f rhs (v::vs) taken
 231.286    | Const(@{const_name Rep_CFun},_)$f$x =>
 231.287 -      let val (rhs', v, taken') = pre_build x rhs [] taken;
 231.288 -      in pre_build f rhs' (v::vs) taken' end
 231.289 +      let val (rhs', v, taken') = pre_build match_name x rhs [] taken;
 231.290 +      in pre_build match_name f rhs' (v::vs) taken' end
 231.291    | Const(c,T) =>
 231.292        let
 231.293          val n = Name.variant taken "v";
 231.294          fun result_type (Type(@{type_name "->"},[_,T])) (x::xs) = result_type T xs
 231.295            | result_type T _ = T;
 231.296          val v = Free(n, result_type T vs);
 231.297 -        val m = "match_"^(extern_name(Sign.base_name c));
 231.298 +        val m = Const(match_name c, matchT T);
 231.299          val k = lambda_ctuple vs rhs;
 231.300        in
 231.301 -        (%%:@{const_name Fixrec.bind}`(%%:m`v)`k, v, n::taken)
 231.302 +        (mk_bind (m`v, k), v, n::taken)
 231.303        end
 231.304    | Free(n,_) => fixrec_err ("expected constructor, found free variable " ^ quote n)
 231.305    | _ => fixrec_err "pre_build: invalid pattern";
 231.306  
 231.307  (* builds a monadic term for matching a function definition pattern *)
 231.308  (* returns (name, arity, matcher) *)
 231.309 -fun building pat rhs vs taken =
 231.310 +fun building match_name pat rhs vs taken =
 231.311    case pat of
 231.312      Const(@{const_name Rep_CFun}, _)$f$(v as Free(n,T)) =>
 231.313 -      building f rhs (v::vs) taken
 231.314 +      building match_name f rhs (v::vs) taken
 231.315    | Const(@{const_name Rep_CFun}, _)$f$x =>
 231.316 -      let val (rhs', v, taken') = pre_build x rhs [] taken;
 231.317 -      in building f rhs' (v::vs) taken' end
 231.318 -  | Const(name,_) => (name, length vs, big_lambdas vs rhs)
 231.319 -  | _ => fixrec_err "function is not declared as constant in theory";
 231.320 +      let val (rhs', v, taken') = pre_build match_name x rhs [] taken;
 231.321 +      in building match_name f rhs' (v::vs) taken' end
 231.322 +  | Free(_,_) => ((pat, length vs), big_lambdas vs rhs)
 231.323 +  | Const(_,_) => ((pat, length vs), big_lambdas vs rhs)
 231.324 +  | _ => fixrec_err ("function is not declared as constant in theory: "
 231.325 +                    ^ ML_Syntax.print_term pat);
 231.326  
 231.327 -fun match_eq eq = 
 231.328 -  let val (lhs,rhs) = dest_eqs eq;
 231.329 -  in building lhs (%%:@{const_name Fixrec.return}`rhs) [] (add_terms [eq] []) end;
 231.330 +fun strip_alls t =
 231.331 +  if Logic.is_all t then strip_alls (snd (Logic.dest_all t)) else t;
 231.332 +
 231.333 +fun match_eq match_name eq =
 231.334 +  let
 231.335 +    val (lhs,rhs) = dest_eqs (Logic.strip_imp_concl (strip_alls eq));
 231.336 +  in
 231.337 +    building match_name lhs (mk_return rhs) [] (taken_names eq)
 231.338 +  end;
 231.339  
 231.340  (* returns the sum (using +++) of the terms in ms *)
 231.341  (* also applies "run" to the result! *)
 231.342  fun fatbar arity ms =
 231.343    let
 231.344 +    fun LAM_Ts 0 t = ([], Term.fastype_of t)
 231.345 +      | LAM_Ts n (_ $ Abs(_,T,t)) =
 231.346 +          let val (Ts, U) = LAM_Ts (n-1) t in (T::Ts, U) end
 231.347 +      | LAM_Ts _ _ = fixrec_err "fatbar: internal error, not enough LAMs";
 231.348      fun unLAM 0 t = t
 231.349        | unLAM n (_$Abs(_,_,t)) = unLAM (n-1) t
 231.350        | unLAM _ _ = fixrec_err "fatbar: internal error, not enough LAMs";
 231.351 -    fun reLAM 0 t = t
 231.352 -      | reLAM n t = reLAM (n-1) (%%:@{const_name Abs_CFun} $ Abs("",dummyT,t));
 231.353 -    fun mplus (x,y) = %%:@{const_name Fixrec.mplus}`x`y;
 231.354 -    val msum = foldr1 mplus (map (unLAM arity) ms);
 231.355 +    fun reLAM ([], U) t = t
 231.356 +      | reLAM (T::Ts, U) t = reLAM (Ts, T ->> U) (cabs_const(T,U)$Abs("",T,t));
 231.357 +    val msum = foldr1 mk_mplus (map (unLAM arity) ms);
 231.358 +    val (Ts, U) = LAM_Ts arity (hd ms)
 231.359    in
 231.360 -    reLAM arity (%%:@{const_name Fixrec.run}`msum)
 231.361 +    reLAM (rev Ts, dest_maybeT U) (mk_run msum)
 231.362    end;
 231.363  
 231.364 -fun unzip3 [] = ([],[],[])
 231.365 -  | unzip3 ((x,y,z)::ts) =
 231.366 -      let val (xs,ys,zs) = unzip3 ts
 231.367 -      in (x::xs, y::ys, z::zs) end;
 231.368 -
 231.369  (* this is the pattern-matching compiler function *)
 231.370 -fun compile_pats eqs = 
 231.371 +fun compile_pats match_name eqs =
 231.372    let
 231.373 -    val ((n::names),(a::arities),mats) = unzip3 (map match_eq eqs);
 231.374 +    val (((n::names),(a::arities)),mats) =
 231.375 +      apfst ListPair.unzip (ListPair.unzip (map (match_eq match_name) eqs));
 231.376      val cname = if forall (fn x => n=x) names then n
 231.377            else fixrec_err "all equations in block must define the same function";
 231.378      val arity = if forall (fn x => a=x) arities then a
 231.379            else fixrec_err "all equations in block must have the same arity";
 231.380      val rhs = fatbar arity mats;
 231.381    in
 231.382 -    mk_trp (%%:cname === rhs)
 231.383 +    mk_trp (cname === rhs)
 231.384    end;
 231.385  
 231.386  (*************************************************************************)
 231.387 @@ -207,11 +323,13 @@
 231.388  (*************************************************************************)
 231.389  
 231.390  (* proves a block of pattern matching equations as theorems, using unfold *)
 231.391 -fun make_simps thy (unfold_thm, eqns) =
 231.392 +fun make_simps lthy (unfold_thm, eqns : (Attrib.binding * term) list) =
 231.393    let
 231.394 -    val tacs = [rtac (unfold_thm RS @{thm ssubst_lhs}) 1, asm_simp_tac (simpset_of thy) 1];
 231.395 -    fun prove_term t = Goal.prove_global thy [] [] t (K (EVERY tacs));
 231.396 -    fun prove_eqn ((name, eqn_t), atts) = ((name, prove_term eqn_t), atts);
 231.397 +    val tacs =
 231.398 +      [rtac (unfold_thm RS @{thm ssubst_lhs}) 1,
 231.399 +       asm_simp_tac (local_simpset_of lthy) 1];
 231.400 +    fun prove_term t = Goal.prove lthy [] [] t (K (EVERY tacs));
 231.401 +    fun prove_eqn (bind, eqn_t) = (bind, prove_term eqn_t);
 231.402    in
 231.403      map prove_eqn eqns
 231.404    end;
 231.405 @@ -220,42 +338,77 @@
 231.406  (************************* Main fixrec function **************************)
 231.407  (*************************************************************************)
 231.408  
 231.409 -fun gen_add_fixrec prep_prop prep_attrib strict blocks thy =
 231.410 +local
 231.411 +(* code adapted from HOL/Tools/primrec_package.ML *)
 231.412 +
 231.413 +fun prepare_spec prep_spec ctxt raw_fixes raw_spec =
 231.414    let
 231.415 -    val eqns = List.concat blocks;
 231.416 -    val lengths = map length blocks;
 231.417 -    
 231.418 -    val ((bindings, srcss), strings) = apfst split_list (split_list eqns);
 231.419 -    val names = map Binding.base_name bindings;
 231.420 -    val atts = map (map (prep_attrib thy)) srcss;
 231.421 -    val eqn_ts = map (prep_prop thy) strings;
 231.422 -    val rec_ts = map (fn eq => chead_of (fst (dest_eqs (Logic.strip_imp_concl eq)))
 231.423 -      handle TERM _ => fixrec_eq_err thy "not a proper equation" eq) eqn_ts;
 231.424 -    val (_, eqn_ts') = OldPrimrecPackage.unify_consts thy rec_ts eqn_ts;
 231.425 -    
 231.426 -    fun unconcat [] _ = []
 231.427 -      | unconcat (n::ns) xs = List.take (xs,n) :: unconcat ns (List.drop (xs,n));
 231.428 -    val pattern_blocks = unconcat lengths (map Logic.strip_imp_concl eqn_ts');
 231.429 -    val compiled_ts = map (legacy_infer_term thy o compile_pats) pattern_blocks;
 231.430 -    val (thy', cnames, fixdef_thms, unfold_thms) = add_fixdefs compiled_ts thy;
 231.431 +    val ((fixes, spec), _) = prep_spec
 231.432 +      raw_fixes (map (single o apsnd single) raw_spec) ctxt
 231.433 +  in (fixes, map (apsnd the_single) spec) end;
 231.434 +
 231.435 +fun gen_fixrec
 231.436 +  (set_group : bool)
 231.437 +  (prep_spec : (binding * 'a option * mixfix) list ->
 231.438 +       (Attrib.binding * 'b list) list list ->
 231.439 +      Proof.context ->
 231.440 +   (((binding * typ) * mixfix) list * (Attrib.binding * term list) list)
 231.441 +    * Proof.context
 231.442 +  )
 231.443 +  (strict : bool)
 231.444 +  raw_fixes
 231.445 +  raw_spec
 231.446 +  (lthy : local_theory) =
 231.447 +  let
 231.448 +    val (fixes : ((binding * typ) * mixfix) list,
 231.449 +         spec : (Attrib.binding * term) list) =
 231.450 +          prepare_spec prep_spec lthy raw_fixes raw_spec;
 231.451 +    val chead_of_spec =
 231.452 +      chead_of o fst o dest_eqs o Logic.strip_imp_concl o strip_alls o snd;
 231.453 +    fun name_of (Free (n, _)) = n
 231.454 +      | name_of t = fixrec_err ("unknown term");
 231.455 +    val all_names = map (name_of o chead_of_spec) spec;
 231.456 +    val names = distinct (op =) all_names;
 231.457 +    fun block_of_name n =
 231.458 +      map_filter
 231.459 +        (fn (m,eq) => if m = n then SOME eq else NONE)
 231.460 +        (all_names ~~ spec);
 231.461 +    val blocks = map block_of_name names;
 231.462 +
 231.463 +    val matcher_tab = FixrecMatchData.get (ProofContext.theory_of lthy);
 231.464 +    fun match_name c =
 231.465 +      case Symtab.lookup matcher_tab c of SOME m => m
 231.466 +        | NONE => fixrec_err ("unknown pattern constructor: " ^ c);
 231.467 +
 231.468 +    val matches = map (compile_pats match_name) (map (map snd) blocks);
 231.469 +    val spec' = map (pair Attrib.empty_binding) matches;
 231.470 +    val (lthy', cnames, fixdef_thms, unfold_thms) =
 231.471 +      add_fixdefs fixes spec' lthy;
 231.472    in
 231.473      if strict then let (* only prove simp rules if strict = true *)
 231.474 -      val eqn_blocks = unconcat lengths ((names ~~ eqn_ts') ~~ atts);
 231.475 -      val simps = maps (make_simps thy') (unfold_thms ~~ eqn_blocks);
 231.476 -      val (simp_thms, thy'') = PureThy.add_thms ((map o apfst o apfst) Binding.name simps) thy';
 231.477 -      
 231.478 -      val simp_names = map (fn name => name^"_simps") cnames;
 231.479 -      val simp_attribute = rpair [Simplifier.simp_add];
 231.480 -      val simps' = map simp_attribute (simp_names ~~ unconcat lengths simp_thms);
 231.481 +      val simps : (Attrib.binding * thm) list list =
 231.482 +        map (make_simps lthy') (unfold_thms ~~ blocks);
 231.483 +      fun mk_bind n : Attrib.binding =
 231.484 +       (Binding.name (n ^ "_simps"),
 231.485 +         [Attrib.internal (K Simplifier.simp_add)]);
 231.486 +      val simps1 : (Attrib.binding * thm list) list =
 231.487 +        map (fn (n,xs) => (mk_bind n, map snd xs)) (names ~~ simps);
 231.488 +      val simps2 : (Attrib.binding * thm list) list =
 231.489 +        map (apsnd (fn thm => [thm])) (List.concat simps);
 231.490 +      val (_, lthy'') = lthy'
 231.491 +        |> fold_map (LocalTheory.note Thm.theoremK) (simps1 @ simps2);
 231.492      in
 231.493 -      (snd o PureThy.add_thmss ((map o apfst o apfst) Binding.name simps')) thy''
 231.494 +      lthy''
 231.495      end
 231.496 -    else thy'
 231.497 +    else lthy'
 231.498    end;
 231.499  
 231.500 -val add_fixrec = gen_add_fixrec Syntax.read_prop_global Attrib.attribute;
 231.501 -val add_fixrec_i = gen_add_fixrec Sign.cert_prop (K I);
 231.502 +in
 231.503  
 231.504 +val add_fixrec_i = gen_fixrec false Specification.check_specification;
 231.505 +val add_fixrec = gen_fixrec true Specification.read_specification;
 231.506 +
 231.507 +end; (* local *)
 231.508  
 231.509  (*************************************************************************)
 231.510  (******************************** Fixpat *********************************)
 231.511 @@ -291,17 +444,34 @@
 231.512  
 231.513  local structure P = OuterParse and K = OuterKeyword in
 231.514  
 231.515 -val fixrec_eqn = SpecParse.opt_thm_name ":" -- P.prop;
 231.516 -
 231.517 +(* bool parser *)
 231.518  val fixrec_strict = P.opt_keyword "permissive" >> not;
 231.519  
 231.520 -val fixrec_decl = fixrec_strict -- P.and_list1 (Scan.repeat1 fixrec_eqn);
 231.521 +fun pipe_error t = P.!!! (Scan.fail_with (K
 231.522 +  (cat_lines ["Equations must be separated by " ^ quote "|", quote t])));
 231.523 +
 231.524 +(* (Attrib.binding * string) parser *)
 231.525 +val statement = SpecParse.opt_thm_name ":" -- P.prop --| Scan.ahead
 231.526 +  ((P.term :-- pipe_error) || Scan.succeed ("",""));
 231.527 +
 231.528 +(* ((Attrib.binding * string) list) parser *)
 231.529 +val statements = P.enum1 "|" statement;
 231.530 +
 231.531 +(* (((xstring option * bool) * (Binding.binding * string option * Mixfix.mixfix) list)
 231.532 +   * (Attrib.binding * string) list) parser *)
 231.533 +val fixrec_decl =
 231.534 +  P.opt_target -- fixrec_strict -- P.fixes --| P.$$$ "where" -- statements;
 231.535  
 231.536  (* this builds a parser for a new keyword, fixrec, whose functionality 
 231.537  is defined by add_fixrec *)
 231.538  val _ =
 231.539 -  OuterSyntax.command "fixrec" "define recursive functions (HOLCF)" K.thy_decl
 231.540 -    (fixrec_decl >> (Toplevel.theory o uncurry add_fixrec));
 231.541 +  let
 231.542 +    val desc = "define recursive functions (HOLCF)";
 231.543 +    fun fixrec (((opt_target, strict), raw_fixes), raw_spec) =
 231.544 +      Toplevel.local_theory opt_target (add_fixrec strict raw_fixes raw_spec);
 231.545 +  in
 231.546 +    OuterSyntax.command "fixrec" desc K.thy_decl (fixrec_decl >> fixrec)
 231.547 +  end;
 231.548  
 231.549  (* fixpat parser *)
 231.550  val fixpat_decl = SpecParse.opt_thm_name ":" -- Scan.repeat1 P.prop;
 231.551 @@ -309,7 +479,9 @@
 231.552  val _ =
 231.553    OuterSyntax.command "fixpat" "define rewrites for fixrec functions" K.thy_decl
 231.554      (fixpat_decl >> (Toplevel.theory o add_fixpat));
 231.555 -
 231.556 +  
 231.557  end; (* local structure *)
 231.558  
 231.559 +val setup = FixrecMatchData.init;
 231.560 +
 231.561  end;
   232.1 --- a/src/HOLCF/UpperPD.thy	Wed Mar 04 10:43:39 2009 +0100
   232.2 +++ b/src/HOLCF/UpperPD.thy	Wed Mar 04 10:45:52 2009 +0100
   232.3 @@ -243,22 +243,25 @@
   232.4  apply (simp add: PDPlus_commute)
   232.5  done
   232.6  
   232.7 -lemma upper_plus_absorb: "xs +\<sharp> xs = xs"
   232.8 +lemma upper_plus_absorb [simp]: "xs +\<sharp> xs = xs"
   232.9  apply (induct xs rule: upper_pd.principal_induct, simp)
  232.10  apply (simp add: PDPlus_absorb)
  232.11  done
  232.12  
  232.13 -interpretation aci_upper_plus!: ab_semigroup_idem_mult "op +\<sharp>"
  232.14 -  proof qed (rule upper_plus_assoc upper_plus_commute upper_plus_absorb)+
  232.15 +lemma upper_plus_left_commute: "xs +\<sharp> (ys +\<sharp> zs) = ys +\<sharp> (xs +\<sharp> zs)"
  232.16 +by (rule mk_left_commute [of "op +\<sharp>", OF upper_plus_assoc upper_plus_commute])
  232.17  
  232.18 -lemma upper_plus_left_commute: "xs +\<sharp> (ys +\<sharp> zs) = ys +\<sharp> (xs +\<sharp> zs)"
  232.19 -by (rule aci_upper_plus.mult_left_commute)
  232.20 +lemma upper_plus_left_absorb [simp]: "xs +\<sharp> (xs +\<sharp> ys) = xs +\<sharp> ys"
  232.21 +by (simp only: upper_plus_assoc [symmetric] upper_plus_absorb)
  232.22  
  232.23 -lemma upper_plus_left_absorb: "xs +\<sharp> (xs +\<sharp> ys) = xs +\<sharp> ys"
  232.24 -by (rule aci_upper_plus.mult_left_idem)
  232.25 -(*
  232.26 -lemmas upper_plus_aci = aci_upper_plus.mult_ac_idem
  232.27 -*)
  232.28 +text {* Useful for @{text "simp add: upper_plus_ac"} *}
  232.29 +lemmas upper_plus_ac =
  232.30 +  upper_plus_assoc upper_plus_commute upper_plus_left_commute
  232.31 +
  232.32 +text {* Useful for @{text "simp only: upper_plus_aci"} *}
  232.33 +lemmas upper_plus_aci =
  232.34 +  upper_plus_ac upper_plus_absorb upper_plus_left_absorb
  232.35 +
  232.36  lemma upper_plus_less1: "xs +\<sharp> ys \<sqsubseteq> xs"
  232.37  apply (induct xs ys rule: upper_pd.principal_induct2, simp, simp)
  232.38  apply (simp add: PDPlus_upper_less)
  232.39 @@ -388,7 +391,7 @@
  232.40  apply unfold_locales
  232.41  apply (simp add: upper_plus_assoc)
  232.42  apply (simp add: upper_plus_commute)
  232.43 -apply (simp add: upper_plus_absorb eta_cfun)
  232.44 +apply (simp add: eta_cfun)
  232.45  done
  232.46  
  232.47  lemma upper_bind_basis_simps [simp]:
   233.1 --- a/src/HOLCF/ex/Fixrec_ex.thy	Wed Mar 04 10:43:39 2009 +0100
   233.2 +++ b/src/HOLCF/ex/Fixrec_ex.thy	Wed Mar 04 10:45:52 2009 +0100
   233.3 @@ -1,5 +1,4 @@
   233.4  (*  Title:      HOLCF/ex/Fixrec_ex.thy
   233.5 -    ID:         $Id$
   233.6      Author:     Brian Huffman
   233.7  *)
   233.8  
   233.9 @@ -19,18 +18,18 @@
  233.10  
  233.11  text {* typical usage is with lazy constructors *}
  233.12  
  233.13 -consts down :: "'a u \<rightarrow> 'a"
  233.14 -fixrec "down\<cdot>(up\<cdot>x) = x"
  233.15 +fixrec down :: "'a u \<rightarrow> 'a"
  233.16 +where "down\<cdot>(up\<cdot>x) = x"
  233.17  
  233.18  text {* with strict constructors, rewrite rules may require side conditions *}
  233.19  
  233.20 -consts from_sinl :: "'a \<oplus> 'b \<rightarrow> 'a"
  233.21 -fixrec "x \<noteq> \<bottom> \<Longrightarrow> from_sinl\<cdot>(sinl\<cdot>x) = x"
  233.22 +fixrec from_sinl :: "'a \<oplus> 'b \<rightarrow> 'a"
  233.23 +where "x \<noteq> \<bottom> \<Longrightarrow> from_sinl\<cdot>(sinl\<cdot>x) = x"
  233.24  
  233.25  text {* lifting can turn a strict constructor into a lazy one *}
  233.26  
  233.27 -consts from_sinl_up :: "'a u \<oplus> 'b \<rightarrow> 'a"
  233.28 -fixrec "from_sinl_up\<cdot>(sinl\<cdot>(up\<cdot>x)) = x"
  233.29 +fixrec from_sinl_up :: "'a u \<oplus> 'b \<rightarrow> 'a"
  233.30 +where "from_sinl_up\<cdot>(sinl\<cdot>(up\<cdot>x)) = x"
  233.31  
  233.32  
  233.33  subsection {* fixpat examples *}
  233.34 @@ -41,13 +40,13 @@
  233.35  
  233.36  text {* zip function for lazy lists *}
  233.37  
  233.38 -consts lzip :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
  233.39 -
  233.40  text {* notice that the patterns are not exhaustive *}
  233.41  
  233.42  fixrec
  233.43 +  lzip :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
  233.44 +where
  233.45    "lzip\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)"
  233.46 -  "lzip\<cdot>lNil\<cdot>lNil = lNil"
  233.47 +| "lzip\<cdot>lNil\<cdot>lNil = lNil"
  233.48  
  233.49  text {* fixpat is useful for producing strictness theorems *}
  233.50  text {* note that pattern matching is done in left-to-right order *}
  233.51 @@ -68,8 +67,6 @@
  233.52  
  233.53  text {* another zip function for lazy lists *}
  233.54  
  233.55 -consts lzip2 :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
  233.56 -
  233.57  text {*
  233.58    Notice that this version has overlapping patterns.
  233.59    The second equation cannot be proved as a theorem
  233.60 @@ -77,8 +74,10 @@
  233.61  *}
  233.62  
  233.63  fixrec (permissive)
  233.64 +  lzip2 :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
  233.65 +where
  233.66    "lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)"
  233.67 -  "lzip2\<cdot>xs\<cdot>ys = lNil"
  233.68 +| "lzip2\<cdot>xs\<cdot>ys = lNil"
  233.69  
  233.70  text {*
  233.71    Usually fixrec tries to prove all equations as theorems.
  233.72 @@ -105,21 +104,20 @@
  233.73  domain 'a tree = Leaf (lazy 'a) | Branch (lazy "'a forest")
  233.74  and    'a forest = Empty | Trees (lazy "'a tree") "'a forest"
  233.75  
  233.76 -consts
  233.77 -  map_tree :: "('a \<rightarrow> 'b) \<rightarrow> ('a tree \<rightarrow> 'b tree)"
  233.78 -  map_forest :: "('a \<rightarrow> 'b) \<rightarrow> ('a forest \<rightarrow> 'b forest)"
  233.79 -
  233.80  text {*
  233.81    To define mutually recursive functions, separate the equations
  233.82    for each function using the keyword "and".
  233.83  *}
  233.84  
  233.85  fixrec
  233.86 +  map_tree :: "('a \<rightarrow> 'b) \<rightarrow> ('a tree \<rightarrow> 'b tree)"
  233.87 +and
  233.88 +  map_forest :: "('a \<rightarrow> 'b) \<rightarrow> ('a forest \<rightarrow> 'b forest)"
  233.89 +where
  233.90    "map_tree\<cdot>f\<cdot>(Leaf\<cdot>x) = Leaf\<cdot>(f\<cdot>x)"
  233.91 -  "map_tree\<cdot>f\<cdot>(Branch\<cdot>ts) = Branch\<cdot>(map_forest\<cdot>f\<cdot>ts)"
  233.92 -and
  233.93 -  "map_forest\<cdot>f\<cdot>Empty = Empty"
  233.94 -  "ts \<noteq> \<bottom> \<Longrightarrow>
  233.95 +| "map_tree\<cdot>f\<cdot>(Branch\<cdot>ts) = Branch\<cdot>(map_forest\<cdot>f\<cdot>ts)"
  233.96 +| "map_forest\<cdot>f\<cdot>Empty = Empty"
  233.97 +| "ts \<noteq> \<bottom> \<Longrightarrow>
  233.98      map_forest\<cdot>f\<cdot>(Trees\<cdot>t\<cdot>ts) = Trees\<cdot>(map_tree\<cdot>f\<cdot>t)\<cdot>(map_forest\<cdot>f\<cdot>ts)"
  233.99  
 233.100  fixpat map_tree_strict [simp]: "map_tree\<cdot>f\<cdot>\<bottom>"
   234.1 --- a/src/HOLCF/ex/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   234.2 +++ b/src/HOLCF/ex/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   234.3 @@ -1,8 +1,7 @@
   234.4  (*  Title:      HOLCF/ex/ROOT.ML
   234.5 -    ID:         $Id$
   234.6  
   234.7  Misc HOLCF examples.
   234.8  *)
   234.9  
  234.10  use_thys ["Dnat", "Stream", "Dagstuhl", "Focus_ex", "Fix2", "Hoare",
  234.11 -  "Loop", "Fixrec_ex"];
  234.12 +  "Loop", "Fixrec_ex", "Powerdomain_ex"];
   235.1 --- a/src/Provers/README	Wed Mar 04 10:43:39 2009 +0100
   235.2 +++ b/src/Provers/README	Wed Mar 04 10:45:52 2009 +0100
   235.3 @@ -2,19 +2,13 @@
   235.4  
   235.5  This directory contains ML sources of generic theorem proving tools.
   235.6  Typically, they can be applied to various logics, provided rules of a
   235.7 -certain form are derivable.  Some of these are documented in the
   235.8 -Reference Manual.
   235.9 +certain form are derivable.
  235.10  
  235.11    blast.ML              generic tableau prover with proof reconstruction
  235.12    clasimp.ML		combination of classical reasoner and simplifier
  235.13    classical.ML          theorem prover for classical logics
  235.14    hypsubst.ML           tactic to substitute in the hypotheses
  235.15 -  ind.ML                a simple induction package
  235.16 -  induct_method.ML      proof by cases and induction on sets and types (Isar)
  235.17 -  linorder.ML		transitivity reasoner for linear (total) orders
  235.18    quantifier1.ML	simplification procedures for "1 point rules"
  235.19 -  simp.ML               powerful but slow simplifier
  235.20 -  split_paired_all.ML	turn surjective pairing into split rule
  235.21    splitter.ML           performs case splits for simplifier
  235.22    typedsimp.ML          basic simplifier for explicitly typed logics
  235.23  
   236.1 --- a/src/Provers/blast.ML	Wed Mar 04 10:43:39 2009 +0100
   236.2 +++ b/src/Provers/blast.ML	Wed Mar 04 10:45:52 2009 +0100
   236.3 @@ -1,5 +1,4 @@
   236.4  (*  Title:      Provers/blast.ML
   236.5 -    ID:         $Id$
   236.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
   236.7      Copyright   1997  University of Cambridge
   236.8  
   236.9 @@ -764,8 +763,8 @@
  236.10              end
  236.11        (*substitute throughout "stack frame"; extract affected formulae*)
  236.12        fun subFrame ((Gs,Hs), (changed, frames)) =
  236.13 -            let val (changed', Gs') = foldr subForm (changed, []) Gs
  236.14 -                val (changed'', Hs') = foldr subForm (changed', []) Hs
  236.15 +            let val (changed', Gs') = List.foldr subForm (changed, []) Gs
  236.16 +                val (changed'', Hs') = List.foldr subForm (changed', []) Hs
  236.17              in  (changed'', (Gs',Hs')::frames)  end
  236.18        (*substitute throughout literals; extract affected ones*)
  236.19        fun subLit (lit, (changed, nlits)) =
  236.20 @@ -773,8 +772,8 @@
  236.21              in  if nlit aconv lit then (changed, nlit::nlits)
  236.22                                    else ((nlit,true)::changed, nlits)
  236.23              end
  236.24 -      val (changed, lits') = foldr subLit ([], []) lits
  236.25 -      val (changed', pairs') = foldr subFrame (changed, []) pairs
  236.26 +      val (changed, lits') = List.foldr subLit ([], []) lits
  236.27 +      val (changed', pairs') = List.foldr subFrame (changed, []) pairs
  236.28    in  if !trace then writeln ("Substituting " ^ traceTerm thy u ^
  236.29                                " for " ^ traceTerm thy t ^ " in branch" )
  236.30        else ();
  236.31 @@ -913,7 +912,7 @@
  236.32  
  236.33  fun printStats (State {ntried, nclosed, ...}) (b, start, tacs) =
  236.34    if b then
  236.35 -    writeln (end_timing start ^ " for search.  Closed: "
  236.36 +    writeln (#message (end_timing start) ^ " for search.  Closed: "
  236.37               ^ Int.toString (!nclosed) ^
  236.38               " tried: " ^ Int.toString (!ntried) ^
  236.39               " tactics: " ^ Int.toString (length tacs))
  236.40 @@ -971,7 +970,7 @@
  236.41                                      then lim - (1+log(length rules))
  236.42                                      else lim   (*discourage branching updates*)
  236.43                           val vars  = vars_in_vars vars
  236.44 -                         val vars' = foldr add_terms_vars vars prems
  236.45 +                         val vars' = List.foldr add_terms_vars vars prems
  236.46                           val choices' = (ntrl, nbrs, PRV) :: choices
  236.47                           val tacs' = (tac(updated,false,true))
  236.48                                       :: tacs  (*no duplication; rotate*)
  236.49 @@ -1098,7 +1097,7 @@
  236.50                      then
  236.51                       let val updated = ntrl < !ntrail (*branch updated*)
  236.52                           val vars  = vars_in_vars vars
  236.53 -                         val vars' = foldr add_terms_vars vars prems
  236.54 +                         val vars' = List.foldr add_terms_vars vars prems
  236.55                              (*duplicate H if md permits*)
  236.56                           val dup = md (*earlier had "andalso vars' <> vars":
  236.57                                    duplicate only if the subgoal has new vars*)
  236.58 @@ -1264,7 +1263,7 @@
  236.59                         else ();
  236.60                         backtrack choices)
  236.61              | cell => (if (!trace orelse !stats)
  236.62 -                       then writeln (end_timing start ^ " for reconstruction")
  236.63 +                       then writeln (#message (end_timing start) ^ " for reconstruction")
  236.64                         else ();
  236.65                         Seq.make(fn()=> cell))
  236.66            end
   237.1 --- a/src/Provers/clasimp.ML	Wed Mar 04 10:43:39 2009 +0100
   237.2 +++ b/src/Provers/clasimp.ML	Wed Mar 04 10:45:52 2009 +0100
   237.3 @@ -1,5 +1,4 @@
   237.4  (*  Title:      Provers/clasimp.ML
   237.5 -    ID:         $Id$
   237.6      Author:     David von Oheimb, TU Muenchen
   237.7  
   237.8  Combination of classical reasoner and simplifier (depends on
   237.9 @@ -153,7 +152,7 @@
  237.10    end;
  237.11  
  237.12  fun modifier att (x, ths) =
  237.13 -  fst (foldl_map (Library.apply [att]) (x, rev ths));
  237.14 +  fst (Library.foldl_map (Library.apply [att]) (x, rev ths));
  237.15  
  237.16  val addXIs = modifier (ContextRules.intro_query NONE);
  237.17  val addXEs = modifier (ContextRules.elim_query NONE);
   238.1 --- a/src/Provers/classical.ML	Wed Mar 04 10:43:39 2009 +0100
   238.2 +++ b/src/Provers/classical.ML	Wed Mar 04 10:45:52 2009 +0100
   238.3 @@ -223,7 +223,7 @@
   238.4      let fun addrl (rl,brls) = (false, rl) :: (true, rl RSN (2, Data.swap)) :: brls
   238.5      in  assume_tac      ORELSE'
   238.6          contr_tac       ORELSE'
   238.7 -        biresolve_tac (foldr addrl [] rls)
   238.8 +        biresolve_tac (List.foldr addrl [] rls)
   238.9      end;
  238.10  
  238.11  (*Duplication of hazardous rules, for complete provers*)
   239.1 --- a/src/Provers/order.ML	Wed Mar 04 10:43:39 2009 +0100
   239.2 +++ b/src/Provers/order.ML	Wed Mar 04 10:45:52 2009 +0100
   239.3 @@ -639,7 +639,7 @@
   239.4  
   239.5     (* Compute, for each adjacency list, the list with reversed edges,
   239.6        and concatenate these lists. *)
   239.7 -   val flipped = foldr (op @) nil (map flip g)
   239.8 +   val flipped = List.foldr (op @) nil (map flip g)
   239.9   
  239.10   in assemble g flipped end    
  239.11        
  239.12 @@ -677,7 +677,7 @@
  239.13        let
  239.14     val _ = visited := u :: !visited
  239.15     val descendents =
  239.16 -       foldr (fn ((v,l),ds) => if been_visited v then ds
  239.17 +       List.foldr (fn ((v,l),ds) => if been_visited v then ds
  239.18              else v :: dfs_visit g v @ ds)
  239.19          nil (adjacent (op aconv) g u)
  239.20        in
  239.21 @@ -727,7 +727,7 @@
  239.22        let
  239.23     val _ = visited := u :: !visited
  239.24     val descendents =
  239.25 -       foldr (fn ((v,l),ds) => if been_visited v then ds
  239.26 +       List.foldr (fn ((v,l),ds) => if been_visited v then ds
  239.27              else v :: dfs_visit g v @ ds)
  239.28          nil (adjacent (op =) g u)
  239.29     in  descendents end
   240.1 --- a/src/Provers/trancl.ML	Wed Mar 04 10:43:39 2009 +0100
   240.2 +++ b/src/Provers/trancl.ML	Wed Mar 04 10:45:52 2009 +0100
   240.3 @@ -1,8 +1,6 @@
   240.4  (*
   240.5 -  Title:	Transitivity reasoner for transitive closures of relations
   240.6 -  Id:		$Id$
   240.7 -  Author:	Oliver Kutter
   240.8 -  Copyright:	TU Muenchen
   240.9 +    Title:      Transitivity reasoner for transitive closures of relations
  240.10 +    Author:     Oliver Kutter, TU Muenchen
  240.11  *)
  240.12  
  240.13  (*
  240.14 @@ -335,7 +333,7 @@
  240.15  
  240.16     (* Compute, for each adjacency list, the list with reversed edges,
  240.17        and concatenate these lists. *)
  240.18 -   val flipped = foldr (op @) nil (map flip g)
  240.19 +   val flipped = List.foldr (op @) nil (map flip g)
  240.20   
  240.21   in assemble g flipped end    
  240.22   
  240.23 @@ -359,7 +357,7 @@
  240.24        let
  240.25     val _ = visited := u :: !visited
  240.26     val descendents =
  240.27 -       foldr (fn ((v,l),ds) => if been_visited v then ds
  240.28 +       List.foldr (fn ((v,l),ds) => if been_visited v then ds
  240.29              else v :: dfs_visit g v @ ds)
  240.30          nil (adjacent eq_comp g u)
  240.31     in  descendents end
   241.1 --- a/src/Provers/typedsimp.ML	Wed Mar 04 10:43:39 2009 +0100
   241.2 +++ b/src/Provers/typedsimp.ML	Wed Mar 04 10:45:52 2009 +0100
   241.3 @@ -1,5 +1,4 @@
   241.4  (*  Title: 	typedsimp
   241.5 -    ID:         $Id$
   241.6      Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   241.7      Copyright   1993  University of Cambridge
   241.8  
   241.9 @@ -70,7 +69,7 @@
  241.10      handle THM _ => (simp_rls, rl :: other_rls);
  241.11  
  241.12  (*Given the list rls, return the pair (simp_rls, other_rls).*)
  241.13 -fun process_rules rls = foldr add_rule ([],[]) rls;
  241.14 +fun process_rules rls = List.foldr add_rule ([],[]) rls;
  241.15  
  241.16  (*Given list of rewrite rules, return list of both forms, reject others*)
  241.17  fun process_rewrites rls = 
   242.1 --- a/src/Pure/General/binding.ML	Wed Mar 04 10:43:39 2009 +0100
   242.2 +++ b/src/Pure/General/binding.ML	Wed Mar 04 10:45:52 2009 +0100
   242.3 @@ -1,98 +1,104 @@
   242.4  (*  Title:      Pure/General/binding.ML
   242.5      Author:     Florian Haftmann, TU Muenchen
   242.6 +    Author:     Makarius
   242.7  
   242.8  Structured name bindings.
   242.9  *)
  242.10  
  242.11 -signature BASIC_BINDING =
  242.12 -sig
  242.13 -  type binding
  242.14 -  val long_names: bool ref
  242.15 -  val short_names: bool ref
  242.16 -  val unique_names: bool ref
  242.17 -end;
  242.18 +type bstring = string;    (*primitive names to be bound*)
  242.19  
  242.20  signature BINDING =
  242.21  sig
  242.22 -  include BASIC_BINDING
  242.23 -  val name_pos: string * Position.T -> binding
  242.24 -  val name: string -> binding
  242.25 +  type binding
  242.26 +  val dest: binding -> (string * bool) list * (string * bool) list * bstring
  242.27 +  val verbose: bool ref
  242.28 +  val str_of: binding -> string
  242.29 +  val make: bstring * Position.T -> binding
  242.30 +  val name: bstring -> binding
  242.31 +  val pos_of: binding -> Position.T
  242.32 +  val name_of: binding -> string
  242.33 +  val map_name: (bstring -> bstring) -> binding -> binding
  242.34    val empty: binding
  242.35 -  val map_base: (string -> string) -> binding -> binding
  242.36 -  val qualify: string -> binding -> binding
  242.37 +  val is_empty: binding -> bool
  242.38 +  val qualify: bool -> string -> binding -> binding
  242.39 +  val map_prefix: ((string * bool) list -> (string * bool) list) -> binding -> binding
  242.40    val add_prefix: bool -> string -> binding -> binding
  242.41 -  val map_prefix: ((string * bool) list -> binding -> binding) -> binding -> binding
  242.42 -  val is_empty: binding -> bool
  242.43 -  val base_name: binding -> string
  242.44 -  val pos_of: binding -> Position.T
  242.45 -  val dest: binding -> (string * bool) list * string
  242.46 -  val separator: string
  242.47 -  val is_qualified: string -> bool
  242.48 -  val display: binding -> string
  242.49  end;
  242.50  
  242.51 -structure Binding : BINDING =
  242.52 +structure Binding: BINDING =
  242.53  struct
  242.54  
  242.55 -(** global flags **)
  242.56 +(** representation **)
  242.57  
  242.58 -val long_names = ref false;
  242.59 -val short_names = ref false;
  242.60 -val unique_names = ref true;
  242.61 +(* datatype *)
  242.62  
  242.63 +type component = string * bool;   (*name with mandatory flag*)
  242.64  
  242.65 -(** qualification **)
  242.66 +datatype binding = Binding of
  242.67 + {prefix: component list,         (*system prefix*)
  242.68 +  qualifier: component list,      (*user qualifier*)
  242.69 +  name: bstring,                  (*base name*)
  242.70 +  pos: Position.T};               (*source position*)
  242.71  
  242.72 -val separator = ".";
  242.73 -val is_qualified = exists_string (fn s => s = separator);
  242.74 +fun make_binding (prefix, qualifier, name, pos) =
  242.75 +  Binding {prefix = prefix, qualifier = qualifier, name = name, pos = pos};
  242.76  
  242.77 -fun reject_qualified kind s =
  242.78 -  if is_qualified s then
  242.79 -    error ("Attempt to declare qualified " ^ kind ^ " " ^ quote s)
  242.80 -  else s;
  242.81 +fun map_binding f (Binding {prefix, qualifier, name, pos}) =
  242.82 +  make_binding (f (prefix, qualifier, name, pos));
  242.83  
  242.84 +fun dest (Binding {prefix, qualifier, name, ...}) = (prefix, qualifier, name);
  242.85  
  242.86 -(** binding representation **)
  242.87  
  242.88 -datatype binding = Binding of ((string * bool) list * string) * Position.T;
  242.89 -  (* (prefix components (with mandatory flag), base name, position) *)
  242.90 +(* diagnostic output *)
  242.91  
  242.92 -fun name_pos (name, pos) = Binding (([], name), pos);
  242.93 -fun name name = name_pos (name, Position.none);
  242.94 +val verbose = ref false;
  242.95 +
  242.96 +val str_of_components = implode o map (fn (s, true) => s ^ "!" | (s, false) => s ^ "?");
  242.97 +
  242.98 +fun str_of (Binding {prefix, qualifier, name, pos}) =
  242.99 +  let
 242.100 +    val text =
 242.101 +      if ! verbose then
 242.102 +        (if null prefix then "" else enclose "(" ")" (str_of_components prefix)) ^
 242.103 +          str_of_components qualifier ^ name
 242.104 +      else name;
 242.105 +    val props = Position.properties_of pos;
 242.106 +  in Markup.markup (Markup.properties props (Markup.binding name)) text end;
 242.107 +
 242.108 +
 242.109 +
 242.110 +(** basic operations **)
 242.111 +
 242.112 +(* name and position *)
 242.113 +
 242.114 +fun make (name, pos) = make_binding ([], [], name, pos);
 242.115 +fun name name = make (name, Position.none);
 242.116 +
 242.117 +fun pos_of (Binding {pos, ...}) = pos;
 242.118 +fun name_of (Binding {name, ...}) = name;
 242.119 +
 242.120 +fun map_name f = map_binding (fn (prefix, qualifier, name, pos) => (prefix, qualifier, f name, pos));
 242.121 +
 242.122  val empty = name "";
 242.123 +fun is_empty b = name_of b = "";
 242.124  
 242.125 -fun map_binding f (Binding (prefix_name, pos)) = Binding (f prefix_name, pos);
 242.126  
 242.127 -val map_base = map_binding o apsnd;
 242.128 +(* user qualifier *)
 242.129  
 242.130 -fun qualify_base path name =
 242.131 -  if path = "" orelse name = "" then name
 242.132 -  else path ^ separator ^ name;
 242.133 +fun qualify _ "" = I
 242.134 +  | qualify mandatory qual = map_binding (fn (prefix, qualifier, name, pos) =>
 242.135 +      (prefix, (qual, mandatory) :: qualifier, name, pos));
 242.136  
 242.137 -val qualify = map_base o qualify_base;
 242.138 -  (*FIXME should all operations on bare names move here from name_space.ML ?*)
 242.139  
 242.140 -fun add_prefix sticky "" b = b
 242.141 -  | add_prefix sticky prfx b = (map_binding o apfst)
 242.142 -      (cons ((*reject_qualified "prefix"*) prfx, sticky)) b;
 242.143 +(* system prefix *)
 242.144  
 242.145 -fun map_prefix f (Binding ((prefix, name), pos)) =
 242.146 -  f prefix (name_pos (name, pos));
 242.147 +fun map_prefix f = map_binding (fn (prefix, qualifier, name, pos) =>
 242.148 +  (f prefix, qualifier, name, pos));
 242.149  
 242.150 -fun is_empty (Binding ((_, name), _)) = name = "";
 242.151 -fun base_name (Binding ((_, name), _)) = name;
 242.152 -fun pos_of (Binding (_, pos)) = pos;
 242.153 -fun dest (Binding (prefix_name, _)) = prefix_name;
 242.154 -
 242.155 -fun display (Binding ((prefix, name), _)) =
 242.156 -  let
 242.157 -    fun mk_prefix (prfx, true) = prfx
 242.158 -      | mk_prefix (prfx, false) = enclose "(" ")" prfx
 242.159 -  in if not (! long_names) orelse null prefix orelse name = "" then name
 242.160 -    else space_implode "." (map mk_prefix prefix) ^ ":" ^ name
 242.161 -  end;
 242.162 +fun add_prefix _ "" = I
 242.163 +  | add_prefix mandatory prfx = map_prefix (cons (prfx, mandatory));
 242.164  
 242.165  end;
 242.166  
 242.167 -structure Basic_Binding : BASIC_BINDING = Binding;
 242.168 -open Basic_Binding;
 242.169 +type binding = Binding.binding;
 242.170 +
   243.1 --- a/src/Pure/General/markup.ML	Wed Mar 04 10:43:39 2009 +0100
   243.2 +++ b/src/Pure/General/markup.ML	Wed Mar 04 10:45:52 2009 +0100
   243.3 @@ -12,9 +12,9 @@
   243.4    val properties: (string * string) list -> T -> T
   243.5    val nameN: string
   243.6    val name: string -> T -> T
   243.7 +  val bindingN: string val binding: string -> T
   243.8    val groupN: string
   243.9    val theory_nameN: string
  243.10 -  val idN: string
  243.11    val kindN: string
  243.12    val internalK: string
  243.13    val property_internal: Properties.property
  243.14 @@ -25,6 +25,7 @@
  243.15    val end_columnN: string
  243.16    val end_offsetN: string
  243.17    val fileN: string
  243.18 +  val idN: string
  243.19    val position_properties': string list
  243.20    val position_properties: string list
  243.21    val positionN: string val position: T
  243.22 @@ -107,6 +108,8 @@
  243.23  structure Markup: MARKUP =
  243.24  struct
  243.25  
  243.26 +(** markup elements **)
  243.27 +
  243.28  (* basic markup *)
  243.29  
  243.30  type T = string * Properties.T;
  243.31 @@ -130,6 +133,8 @@
  243.32  val nameN = "name";
  243.33  fun name a = properties [(nameN, a)];
  243.34  
  243.35 +val (bindingN, binding) = markup_string "binding" nameN;
  243.36 +
  243.37  val groupN = "group";
  243.38  val theory_nameN = "theory_name";
  243.39  
  243.40 @@ -278,7 +283,7 @@
  243.41  
  243.42  
  243.43  
  243.44 -(* print mode operations *)
  243.45 +(** print mode operations **)
  243.46  
  243.47  val no_output = ("", "");
  243.48  fun default_output (_: T) = no_output;
   244.1 --- a/src/Pure/General/name_space.ML	Wed Mar 04 10:43:39 2009 +0100
   244.2 +++ b/src/Pure/General/name_space.ML	Wed Mar 04 10:45:52 2009 +0100
   244.3 @@ -3,15 +3,20 @@
   244.4  
   244.5  Generic name spaces with declared and hidden entries.  Unknown names
   244.6  are considered global; no support for absolute addressing.
   244.7 -Cf. Pure/General/binding.ML
   244.8  *)
   244.9  
  244.10 -type bstring = string;    (*simple names to be bound -- legacy*)
  244.11  type xstring = string;    (*external names*)
  244.12  
  244.13 +signature BASIC_NAME_SPACE =
  244.14 +sig
  244.15 +  val long_names: bool ref
  244.16 +  val short_names: bool ref
  244.17 +  val unique_names: bool ref
  244.18 +end;
  244.19 +
  244.20  signature NAME_SPACE =
  244.21  sig
  244.22 -  include BASIC_BINDING
  244.23 +  include BASIC_NAME_SPACE
  244.24    val hidden: string -> string
  244.25    val is_hidden: string -> bool
  244.26    val separator: string                 (*single char*)
  244.27 @@ -27,8 +32,9 @@
  244.28    val empty: T
  244.29    val intern: T -> xstring -> string
  244.30    val extern: T -> string -> xstring
  244.31 +  val extern_flags: {long_names: bool, short_names: bool, unique_names: bool} ->
  244.32 +    T -> string -> xstring
  244.33    val hide: bool -> string -> T -> T
  244.34 -  val get_accesses: T -> string -> xstring list
  244.35    val merge: T * T -> T
  244.36    type naming
  244.37    val default_naming: naming
  244.38 @@ -41,12 +47,11 @@
  244.39    val qualified_names: naming -> naming
  244.40    val sticky_prefix: string -> naming -> naming
  244.41    type 'a table = T * 'a Symtab.table
  244.42 +  val bind: naming -> binding * 'a -> 'a table -> string * 'a table       (*exception Symtab.DUP*)
  244.43    val empty_table: 'a table
  244.44 -  val bind: naming -> binding * 'a
  244.45 -    -> 'a table -> string * 'a table (*exception Symtab.DUP*)
  244.46 -  val merge_tables: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table
  244.47 -  val join_tables: (string -> 'a * 'a -> 'a)
  244.48 -    -> 'a table * 'a table -> 'a table
  244.49 +  val merge_tables: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table  (*exception Symtab.DUP*)
  244.50 +  val join_tables: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*) ->
  244.51 +    'a table * 'a table -> 'a table                                       (*exception Symtab.DUP*)
  244.52    val dest_table: 'a table -> (string * 'a) list
  244.53    val extern_table: 'a table -> (xstring * 'a) list
  244.54  end;
  244.55 @@ -54,16 +59,13 @@
  244.56  structure NameSpace: NAME_SPACE =
  244.57  struct
  244.58  
  244.59 -open Basic_Binding;
  244.60 -
  244.61 -
  244.62  (** long identifiers **)
  244.63  
  244.64  fun hidden name = "??." ^ name;
  244.65  val is_hidden = String.isPrefix "??.";
  244.66  
  244.67 -val separator = Binding.separator;
  244.68 -val is_qualified = Binding.is_qualified;
  244.69 +val separator = ".";
  244.70 +val is_qualified = exists_string (fn s => s = separator);
  244.71  
  244.72  val implode_name = space_implode separator;
  244.73  val explode_name = space_explode separator;
  244.74 @@ -120,37 +122,28 @@
  244.75  
  244.76  datatype T =
  244.77    NameSpace of
  244.78 -    ((string list * string list) * stamp) Symtab.table *   (*internals, hidden internals*)
  244.79 -    (string list * stamp) Symtab.table;                    (*externals*)
  244.80 +    (string list * string list) Symtab.table *   (*internals, hidden internals*)
  244.81 +    string list Symtab.table;                    (*externals*)
  244.82  
  244.83  val empty = NameSpace (Symtab.empty, Symtab.empty);
  244.84  
  244.85  fun lookup (NameSpace (tab, _)) xname =
  244.86    (case Symtab.lookup tab xname of
  244.87      NONE => (xname, true)
  244.88 -  | SOME (([], []), _) => (xname, true)
  244.89 -  | SOME (([name], _), _) => (name, true)
  244.90 -  | SOME ((name :: _, _), _) => (name, false)
  244.91 -  | SOME (([], name' :: _), _) => (hidden name', true));
  244.92 +  | SOME ([], []) => (xname, true)
  244.93 +  | SOME ([name], _) => (name, true)
  244.94 +  | SOME (name :: _, _) => (name, false)
  244.95 +  | SOME ([], name' :: _) => (hidden name', true));
  244.96  
  244.97 -fun ex_mapsto_in (NameSpace (tab, _)) name xname =
  244.98 -    (case Symtab.lookup tab xname of
  244.99 -      SOME ((name'::_, _), _) => name' = name
 244.100 -    | _ => false);
 244.101 -
 244.102 -fun get_accesses' valid_only (ns as (NameSpace (_, tab))) name =
 244.103 -  (case Symtab.lookup tab name of
 244.104 +fun get_accesses (NameSpace (_, xtab)) name =
 244.105 +  (case Symtab.lookup xtab name of
 244.106      NONE => [name]
 244.107 -  | SOME (xnames, _) => if valid_only
 244.108 -                        then filter (ex_mapsto_in ns name) xnames
 244.109 -                        else xnames);
 244.110 -
 244.111 -val get_accesses = get_accesses' true;
 244.112 +  | SOME xnames => xnames);
 244.113  
 244.114  fun put_accesses name xnames (NameSpace (tab, xtab)) =
 244.115 -  NameSpace (tab, Symtab.update (name, (xnames, stamp ())) xtab);
 244.116 +  NameSpace (tab, Symtab.update (name, xnames) xtab);
 244.117  
 244.118 -fun valid_accesses (NameSpace (tab, _)) name = Symtab.fold (fn (xname, ((names, _), _)) =>
 244.119 +fun valid_accesses (NameSpace (tab, _)) name = Symtab.fold (fn (xname, (names, _)) =>
 244.120    if not (null names) andalso hd names = name then cons xname else I) tab [];
 244.121  
 244.122  
 244.123 @@ -158,28 +151,37 @@
 244.124  
 244.125  fun intern space xname = #1 (lookup space xname);
 244.126  
 244.127 -fun extern space name =
 244.128 +fun extern_flags {long_names, short_names, unique_names} space name =
 244.129    let
 244.130      fun valid unique xname =
 244.131        let val (name', uniq) = lookup space xname
 244.132        in name = name' andalso (uniq orelse not unique) end;
 244.133  
 244.134      fun ext [] = if valid false name then name else hidden name
 244.135 -      | ext (nm :: nms) = if valid (! unique_names) nm then nm else ext nms;
 244.136 +      | ext (nm :: nms) = if valid unique_names nm then nm else ext nms;
 244.137    in
 244.138 -    if ! long_names then name
 244.139 -    else if ! short_names then base name
 244.140 -    else ext (get_accesses' false space name)
 244.141 +    if long_names then name
 244.142 +    else if short_names then base name
 244.143 +    else ext (get_accesses space name)
 244.144    end;
 244.145  
 244.146 +val long_names = ref false;
 244.147 +val short_names = ref false;
 244.148 +val unique_names = ref true;
 244.149 +
 244.150 +fun extern space name =
 244.151 +  extern_flags
 244.152 +   {long_names = ! long_names,
 244.153 +    short_names = ! short_names,
 244.154 +    unique_names = ! unique_names} space name;
 244.155 +
 244.156  
 244.157  (* basic operations *)
 244.158  
 244.159  local
 244.160  
 244.161  fun map_space f xname (NameSpace (tab, xtab)) =
 244.162 -  NameSpace (Symtab.map_default (xname, (([], []), stamp ()))
 244.163 -    (fn (entry, _) => (f entry, stamp ())) tab, xtab);
 244.164 +  NameSpace (Symtab.map_default (xname, ([], [])) f tab, xtab);
 244.165  
 244.166  in
 244.167  
 244.168 @@ -203,7 +205,7 @@
 244.169        space
 244.170        |> add_name' name name
 244.171        |> fold (del_name name) (if fully then names else names inter_string [base name])
 244.172 -      |> fold (del_name_extra name) (get_accesses' false space name)
 244.173 +      |> fold (del_name_extra name) (get_accesses space name)
 244.174      end;
 244.175  
 244.176  
 244.177 @@ -212,15 +214,13 @@
 244.178  fun merge (NameSpace (tab1, xtab1), NameSpace (tab2, xtab2)) =
 244.179    let
 244.180      val tab' = (tab1, tab2) |> Symtab.join
 244.181 -      (K (fn (((names1, names1'), stamp1), ((names2, names2'), stamp2)) =>
 244.182 -        if stamp1 = stamp2 then raise Symtab.SAME
 244.183 -        else
 244.184 -          ((Library.merge (op =) (names1, names2),
 244.185 -            Library.merge (op =) (names1', names2')), stamp ())));
 244.186 +      (K (fn names as ((names1, names1'), (names2, names2')) =>
 244.187 +        if pointer_eq names then raise Symtab.SAME
 244.188 +        else (Library.merge (op =) (names1, names2), Library.merge (op =) (names1', names2'))));
 244.189      val xtab' = (xtab1, xtab2) |> Symtab.join
 244.190 -      (K (fn ((xnames1, stamp1), (xnames2, stamp2)) =>
 244.191 -        if stamp1 = stamp2 then raise Symtab.SAME
 244.192 -        else (Library.merge (op =) (xnames1, xnames2), stamp ())));
 244.193 +      (K (fn xnames =>
 244.194 +        if pointer_eq xnames then raise Symtab.SAME
 244.195 +        else (Library.merge (op =) xnames)));
 244.196    in NameSpace (tab', xtab') end;
 244.197  
 244.198  
 244.199 @@ -272,32 +272,33 @@
 244.200    in fold mk_prefix end;
 244.201  
 244.202  
 244.203 -(* declarations *)
 244.204 +(* full name *)
 244.205  
 244.206 -fun full_internal (Naming (path, (qualify, _))) = qualify path;
 244.207 +fun full (Naming (path, (qualify, _))) = qualify path;
 244.208  
 244.209 -fun declare_internal naming name space =
 244.210 -  if is_hidden name then
 244.211 -    error ("Attempt to declare hidden name " ^ quote name)
 244.212 -  else
 244.213 -    let
 244.214 -      val names = explode_name name;
 244.215 -      val _ = (null names orelse exists (fn s => s = "") names
 244.216 -          orelse exists_string (fn s => s = "\"") name) andalso
 244.217 -        error ("Bad name declaration " ^ quote name);
 244.218 -      val (accs, accs') = pairself (map implode_name) (accesses naming names);
 244.219 -    in space |> fold (add_name name) accs |> put_accesses name accs' end;
 244.220 +fun full_name naming binding =
 244.221 +  let
 244.222 +    val (prefix, qualifier, bname) = Binding.dest binding;
 244.223 +    val naming' = apply_prefix (prefix @ qualifier) naming;
 244.224 +  in full naming' bname end;
 244.225  
 244.226 -fun full_name naming b =
 244.227 -  let val (prefix, bname) = Binding.dest b
 244.228 -  in full_internal (apply_prefix prefix naming) bname end;
 244.229  
 244.230 -fun declare bnaming b =
 244.231 +(* declaration *)
 244.232 +
 244.233 +fun declare naming binding space =
 244.234    let
 244.235 -    val (prefix, bname) = Binding.dest b;
 244.236 -    val naming = apply_prefix prefix bnaming;
 244.237 -    val name = full_internal naming bname;
 244.238 -  in declare_internal naming name #> pair name end;
 244.239 +    val (prefix, qualifier, bname) = Binding.dest binding;
 244.240 +    val naming' = apply_prefix (prefix @ qualifier) naming;
 244.241 +    val name = full naming' bname;
 244.242 +    val names = explode_name name;
 244.243 +
 244.244 +    val _ = (null names orelse exists (fn s => s = "" orelse s = "??") names
 244.245 +        orelse exists_string (fn s => s = "\"") name) andalso
 244.246 +      error ("Bad name declaration " ^ quote (Binding.str_of binding));
 244.247 +
 244.248 +    val (accs, accs') = pairself (map implode_name) (accesses naming' names);
 244.249 +    val space' = space |> fold (add_name name) accs |> put_accesses name accs';
 244.250 +  in (name, space') end;
 244.251  
 244.252  
 244.253  
 244.254 @@ -305,13 +306,12 @@
 244.255  
 244.256  type 'a table = T * 'a Symtab.table;
 244.257  
 244.258 +fun bind naming (binding, x) (space, tab) =
 244.259 +  let val (name, space') = declare naming binding space
 244.260 +  in (name, (space', Symtab.update_new (name, x) tab)) end;
 244.261 +
 244.262  val empty_table = (empty, Symtab.empty);
 244.263  
 244.264 -fun bind naming (b, x) (space, tab) =
 244.265 -  let
 244.266 -    val (name, space') = declare naming b space;
 244.267 -  in (name, (space', Symtab.update_new (name, x) tab)) end;
 244.268 -
 244.269  fun merge_tables eq ((space1, tab1), (space2, tab2)) =
 244.270    (merge (space1, space2), Symtab.merge eq (tab1, tab2));
 244.271  
 244.272 @@ -331,3 +331,7 @@
 244.273  val explode = explode_name;
 244.274  
 244.275  end;
 244.276 +
 244.277 +structure BasicNameSpace: BASIC_NAME_SPACE = NameSpace;
 244.278 +open BasicNameSpace;
 244.279 +
   245.1 --- a/src/Pure/General/output.ML	Wed Mar 04 10:43:39 2009 +0100
   245.2 +++ b/src/Pure/General/output.ML	Wed Mar 04 10:45:52 2009 +0100
   245.3 @@ -135,7 +135,7 @@
   245.4      let
   245.5        val start = start_timing ();
   245.6        val result = Exn.capture e ();
   245.7 -      val end_msg = end_timing start;
   245.8 +      val end_msg = #message (end_timing start);
   245.9        val _ = warning (if msg = "" then end_msg else msg ^ "\n" ^ end_msg);
  245.10      in Exn.release result end
  245.11    else e ();
   246.1 --- a/src/Pure/General/swing.scala	Wed Mar 04 10:43:39 2009 +0100
   246.2 +++ b/src/Pure/General/swing.scala	Wed Mar 04 10:45:52 2009 +0100
   246.3 @@ -10,9 +10,11 @@
   246.4  
   246.5  object Swing
   246.6  {
   246.7 -  def now(body: => Unit) {
   246.8 -    if (SwingUtilities.isEventDispatchThread) body
   246.9 -    else SwingUtilities.invokeAndWait(new Runnable { def run = body })
  246.10 +  def now[A](body: => A): A = {
  246.11 +    var result: Option[A] = None
  246.12 +    if (SwingUtilities.isEventDispatchThread) { result = Some(body) }
  246.13 +    else SwingUtilities.invokeAndWait(new Runnable { def run = { result = Some(body) } })
  246.14 +    result.get
  246.15    }
  246.16  
  246.17    def later(body: => Unit) {
   247.1 --- a/src/Pure/IsaMakefile	Wed Mar 04 10:43:39 2009 +0100
   247.2 +++ b/src/Pure/IsaMakefile	Wed Mar 04 10:45:52 2009 +0100
   247.3 @@ -19,9 +19,29 @@
   247.4  
   247.5  ## Pure
   247.6  
   247.7 +BOOTSTRAP_FILES = ML-Systems/exn.ML ML-Systems/ml_name_space.ML		\
   247.8 +  ML-Systems/mosml.ML ML-Systems/multithreading.ML			\
   247.9 +  ML-Systems/multithreading_polyml.ML ML-Systems/overloading_smlnj.ML	\
  247.10 +  ML-Systems/polyml-4.1.3.ML ML-Systems/polyml-4.1.4.ML			\
  247.11 +  ML-Systems/polyml-4.2.0.ML ML-Systems/polyml-5.0.ML			\
  247.12 +  ML-Systems/polyml-5.1.ML ML-Systems/polyml-experimental.ML		\
  247.13 +  ML-Systems/polyml.ML ML-Systems/polyml_common.ML			\
  247.14 +  ML-Systems/polyml_old_compiler4.ML					\
  247.15 +  ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML		\
  247.16 +  ML-Systems/smlnj.ML ML-Systems/system_shell.ML			\
  247.17 +  ML-Systems/thread_dummy.ML ML-Systems/time_limit.ML			\
  247.18 +  ML-Systems/universal.ML
  247.19 +
  247.20 +RAW: $(OUT)/RAW
  247.21 +
  247.22 +$(OUT)/RAW: $(BOOTSTRAP_FILES)
  247.23 +	@./mk -r
  247.24 +
  247.25 +
  247.26  Pure: $(OUT)/Pure
  247.27  
  247.28 -$(OUT)/Pure: Concurrent/ROOT.ML Concurrent/future.ML			\
  247.29 +$(OUT)/Pure: $(BOOTSTRAP_FILES) ../Tools/auto_solve.ML			\
  247.30 +  ../Tools/quickcheck.ML Concurrent/ROOT.ML Concurrent/future.ML	\
  247.31    Concurrent/mailbox.ML Concurrent/par_list.ML				\
  247.32    Concurrent/par_list_dummy.ML Concurrent/simple_thread.ML		\
  247.33    Concurrent/synchronized.ML Concurrent/task_queue.ML General/ROOT.ML	\
  247.34 @@ -38,33 +58,21 @@
  247.35    Isar/attrib.ML Isar/auto_bind.ML Isar/calculation.ML Isar/class.ML	\
  247.36    Isar/class_target.ML Isar/code.ML Isar/code_unit.ML			\
  247.37    Isar/constdefs.ML Isar/context_rules.ML Isar/element.ML		\
  247.38 -  Isar/expression.ML Isar/find_theorems.ML Isar/find_consts.ML          \
  247.39 -  Isar/isar.ML Isar/isar_document.ML Isar/isar_cmd.ML Isar/isar_syn.ML	\
  247.40 -  Isar/local_defs.ML Isar/local_syntax.ML Isar/local_theory.ML		\
  247.41 -  Isar/locale.ML Isar/method.ML Isar/net_rules.ML			\
  247.42 +  Isar/expression.ML Isar/isar_cmd.ML Isar/isar_document.ML		\
  247.43 +  Isar/isar_syn.ML Isar/local_defs.ML Isar/local_syntax.ML		\
  247.44 +  Isar/local_theory.ML Isar/locale.ML Isar/method.ML Isar/net_rules.ML	\
  247.45    Isar/object_logic.ML Isar/obtain.ML Isar/outer_keyword.ML		\
  247.46    Isar/outer_lex.ML Isar/outer_parse.ML Isar/outer_syntax.ML		\
  247.47    Isar/overloading.ML Isar/proof.ML Isar/proof_context.ML		\
  247.48    Isar/proof_display.ML Isar/proof_node.ML Isar/rule_cases.ML		\
  247.49 -  Isar/rule_insts.ML Isar/session.ML Isar/skip_proof.ML			\
  247.50 -  Isar/spec_parse.ML Isar/specification.ML Isar/theory_target.ML	\
  247.51 -  Isar/toplevel.ML Isar/value_parse.ML ML-Systems/alice.ML		\
  247.52 -  ML-Systems/exn.ML ML-Systems/install_pp_polyml.ML			\
  247.53 -  ML-Systems/ml_name_space.ML ML-Systems/multithreading.ML		\
  247.54 -  ML-Systems/mosml.ML ML-Systems/multithreading_polyml.ML		\
  247.55 -  ML-Systems/overloading_smlnj.ML ML-Systems/polyml-4.1.3.ML		\
  247.56 -  ML-Systems/polyml-4.1.4.ML ML-Systems/polyml-4.2.0.ML			\
  247.57 -  ML-Systems/polyml-5.0.ML ML-Systems/polyml-5.1.ML			\
  247.58 -  ML-Systems/polyml_common.ML ML-Systems/polyml.ML			\
  247.59 -  ML-Systems/polyml_old_compiler4.ML					\
  247.60 -  ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML		\
  247.61 -  ML-Systems/smlnj.ML ML-Systems/system_shell.ML			\
  247.62 -  ML-Systems/time_limit.ML ML-Systems/thread_dummy.ML			\
  247.63 -  ML-Systems/universal.ML ML/ml_context.ML ML/ml_antiquote.ML		\
  247.64 -  ML/ml_lex.ML ML/ml_parse.ML ML/ml_syntax.ML ML/ml_thms.ML		\
  247.65 -  Proof/extraction.ML Proof/proof_rewrite_rules.ML			\
  247.66 -  Proof/proof_syntax.ML Proof/proofchecker.ML Proof/reconstruct.ML	\
  247.67 -  ProofGeneral/ROOT.ML ProofGeneral/pgip.ML ProofGeneral/pgip_input.ML	\
  247.68 +  Isar/rule_insts.ML Isar/skip_proof.ML Isar/spec_parse.ML		\
  247.69 +  Isar/specification.ML Isar/theory_target.ML Isar/toplevel.ML		\
  247.70 +  Isar/value_parse.ML ML/ml_antiquote.ML ML/ml_context.ML ML/ml_lex.ML	\
  247.71 +  ML/ml_parse.ML ML/ml_syntax.ML ML/ml_thms.ML				\
  247.72 +  ML-Systems/install_pp_polyml.ML Proof/extraction.ML			\
  247.73 +  Proof/proof_rewrite_rules.ML Proof/proof_syntax.ML			\
  247.74 +  Proof/proofchecker.ML Proof/reconstruct.ML ProofGeneral/ROOT.ML	\
  247.75 +  ProofGeneral/pgip.ML ProofGeneral/pgip_input.ML			\
  247.76    ProofGeneral/pgip_isabelle.ML ProofGeneral/pgip_markup.ML		\
  247.77    ProofGeneral/pgip_output.ML ProofGeneral/pgip_parser.ML		\
  247.78    ProofGeneral/pgip_tests.ML ProofGeneral/pgip_types.ML			\
  247.79 @@ -72,24 +80,25 @@
  247.80    ProofGeneral/proof_general_pgip.ML Pure.thy ROOT.ML Syntax/ast.ML	\
  247.81    Syntax/lexicon.ML Syntax/mixfix.ML Syntax/parser.ML			\
  247.82    Syntax/printer.ML Syntax/simple_syntax.ML Syntax/syn_ext.ML		\
  247.83 -  Syntax/syn_trans.ML Syntax/syntax.ML Syntax/type_ext.ML Thy/html.ML	\
  247.84 -  Thy/latex.ML Thy/present.ML Thy/term_style.ML Thy/thm_deps.ML		\
  247.85 -  Thy/thy_header.ML Thy/thy_info.ML Thy/thy_load.ML Thy/thy_output.ML	\
  247.86 -  Thy/thy_syntax.ML Tools/ROOT.ML			\
  247.87 -  Tools/isabelle_process.ML Tools/named_thms.ML Tools/xml_syntax.ML	\
  247.88 -  assumption.ML axclass.ML codegen.ML config.ML conjunction.ML		\
  247.89 -  consts.ML context.ML context_position.ML conv.ML defs.ML display.ML	\
  247.90 -  drule.ML envir.ML facts.ML goal.ML interpretation.ML library.ML	\
  247.91 -  logic.ML meta_simplifier.ML more_thm.ML morphism.ML name.ML net.ML	\
  247.92 -  old_goals.ML old_term.ML pattern.ML primitive_defs.ML proofterm.ML	\
  247.93 -  pure_setup.ML pure_thy.ML search.ML sign.ML simplifier.ML sorts.ML	\
  247.94 -  subgoal.ML tactic.ML tctical.ML term.ML term_ord.ML term_subst.ML	\
  247.95 -  theory.ML thm.ML type.ML type_infer.ML unify.ML variable.ML		\
  247.96 -  ../Tools/quickcheck.ML ../Tools/auto_solve.ML
  247.97 +  Syntax/syn_trans.ML Syntax/syntax.ML Syntax/type_ext.ML		\
  247.98 +  System/isabelle_process.ML System/isar.ML System/session.ML		\
  247.99 +  Thy/html.ML Thy/latex.ML Thy/present.ML Thy/term_style.ML		\
 247.100 +  Thy/thm_deps.ML Thy/thy_header.ML Thy/thy_info.ML Thy/thy_load.ML	\
 247.101 +  Thy/thy_output.ML Thy/thy_syntax.ML Tools/ROOT.ML			\
 247.102 +  Tools/find_consts.ML Tools/find_theorems.ML Tools/named_thms.ML	\
 247.103 +  Tools/xml_syntax.ML assumption.ML axclass.ML codegen.ML config.ML	\
 247.104 +  conjunction.ML consts.ML context.ML context_position.ML conv.ML	\
 247.105 +  defs.ML display.ML drule.ML envir.ML facts.ML goal.ML			\
 247.106 +  interpretation.ML library.ML logic.ML meta_simplifier.ML more_thm.ML	\
 247.107 +  morphism.ML name.ML net.ML old_goals.ML old_term.ML pattern.ML	\
 247.108 +  primitive_defs.ML proofterm.ML pure_setup.ML pure_thy.ML search.ML	\
 247.109 +  sign.ML simplifier.ML sorts.ML subgoal.ML tactic.ML tctical.ML	\
 247.110 +  term.ML term_ord.ML term_subst.ML theory.ML thm.ML type.ML		\
 247.111 +  type_infer.ML unify.ML variable.ML
 247.112  	@./mk
 247.113  
 247.114  
 247.115 -## special targets
 247.116 +## Proof General keywords
 247.117  
 247.118  Pure-ProofGeneral: Pure $(LOG)/Pure-ProofGeneral.gz
 247.119  
 247.120 @@ -97,28 +106,11 @@
 247.121  	@$(ISABELLE_TOOL) usedir -f proof_general_keywords.ML $(OUT)/Pure ProofGeneral
 247.122  
 247.123  
 247.124 -RAW: $(OUT)/RAW
 247.125 -
 247.126 -$(OUT)/RAW: ML-Systems/alice.ML ML-Systems/exn.ML		\
 247.127 -  ML-Systems/ml_name_space.ML ML-Systems/multithreading.ML	\
 247.128 -  ML-Systems/mosml.ML ML-Systems/multithreading_polyml.ML	\
 247.129 -  ML-Systems/overloading_smlnj.ML ML-Systems/polyml-4.1.3.ML	\
 247.130 -  ML-Systems/polyml-4.1.4.ML ML-Systems/polyml-4.2.0.ML		\
 247.131 -  ML-Systems/polyml-5.0.ML ML-Systems/polyml-5.1.ML		\
 247.132 -  ML-Systems/polyml_common.ML ML-Systems/polyml.ML		\
 247.133 -  ML-Systems/polyml_old_compiler4.ML				\
 247.134 -  ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML	\
 247.135 -  ML-Systems/smlnj.ML ML-Systems/system_shell.ML		\
 247.136 -  ML-Systems/time_limit.ML ML-Systems/thread_dummy.ML		\
 247.137 -  ML-Systems/universal.ML
 247.138 -	@./mk -r
 247.139 -
 247.140 -
 247.141  ## clean
 247.142  
 247.143  clean:
 247.144 -	@rm -f $(OUT)/Pure $(LOG)/Pure.gz $(LOG)/Pure-ProofGeneral.gz \
 247.145 -          $(OUT)/RAW $(LOG)/RAW.gz
 247.146 +	@rm -f $(OUT)/Pure $(LOG)/Pure.gz $(OUT)/RAW $(LOG)/RAW.gz \
 247.147 +          $(LOG)/Pure-ProofGeneral.gz
 247.148  
 247.149  
 247.150  ## Scala material
 247.151 @@ -127,8 +119,8 @@
 247.152    General/position.scala General/swing.scala General/symbol.scala	\
 247.153    General/xml.scala General/yxml.scala Isar/isar.scala			\
 247.154    Isar/isar_document.scala Isar/outer_keyword.scala			\
 247.155 -  Thy/thy_header.scala Tools/isabelle_process.scala			\
 247.156 -  Tools/isabelle_syntax.scala Tools/isabelle_system.scala
 247.157 +  System/isabelle_process.scala System/isabelle_system.scala		\
 247.158 +  Thy/thy_header.scala Tools/isabelle_syntax.scala
 247.159  
 247.160  
 247.161  SCALA_TARGET = $(ISABELLE_HOME)/lib/classes/Pure.jar
   248.1 --- a/src/Pure/Isar/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   248.2 +++ b/src/Pure/Isar/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   248.3 @@ -82,14 +82,12 @@
   248.4  use "../old_goals.ML";
   248.5  use "outer_syntax.ML";
   248.6  use "../Thy/thy_info.ML";
   248.7 -use "session.ML";
   248.8 -use "isar.ML";
   248.9  use "isar_document.ML";
  248.10  
  248.11  (*theory and proof operations*)
  248.12  use "rule_insts.ML";
  248.13  use "../Thy/thm_deps.ML";
  248.14 -use "find_theorems.ML";
  248.15 -use "find_consts.ML";
  248.16  use "isar_cmd.ML";
  248.17  use "isar_syn.ML";
  248.18 +
  248.19 +
   249.1 --- a/src/Pure/Isar/args.ML	Wed Mar 04 10:43:39 2009 +0100
   249.2 +++ b/src/Pure/Isar/args.ML	Wed Mar 04 10:45:52 2009 +0100
   249.3 @@ -170,7 +170,7 @@
   249.4  val name_source_position = named >> T.source_position_of;
   249.5  
   249.6  val name = named >> T.content_of;
   249.7 -val binding = P.position name >> Binding.name_pos;
   249.8 +val binding = P.position name >> Binding.make;
   249.9  val alt_name = alt_string >> T.content_of;
  249.10  val symbol = symbolic >> T.content_of;
  249.11  val liberal_name = symbol || name;
   250.1 --- a/src/Pure/Isar/attrib.ML	Wed Mar 04 10:43:39 2009 +0100
   250.2 +++ b/src/Pure/Isar/attrib.ML	Wed Mar 04 10:45:52 2009 +0100
   250.3 @@ -118,8 +118,7 @@
   250.4  fun attribute thy = attribute_i thy o intern_src thy;
   250.5  
   250.6  fun eval_thms ctxt args = ProofContext.note_thmss Thm.theoremK
   250.7 -    [((Binding.empty, []),
   250.8 -      map (apsnd (map (attribute (ProofContext.theory_of ctxt)))) args)] ctxt
   250.9 +    [(Thm.empty_binding, map (apsnd (map (attribute (ProofContext.theory_of ctxt)))) args)] ctxt
  250.10    |> fst |> maps snd;
  250.11  
  250.12  
  250.13 @@ -198,7 +197,7 @@
  250.14        let
  250.15          val ths = Facts.select thmref fact;
  250.16          val atts = map (attribute_i thy) srcs;
  250.17 -        val (context', ths') = foldl_map (Library.apply atts) (context, ths);
  250.18 +        val (context', ths') = Library.foldl_map (Library.apply atts) (context, ths);
  250.19        in (context', pick name ths') end)
  250.20    end);
  250.21  
   251.1 --- a/src/Pure/Isar/calculation.ML	Wed Mar 04 10:43:39 2009 +0100
   251.2 +++ b/src/Pure/Isar/calculation.ML	Wed Mar 04 10:45:52 2009 +0100
   251.3 @@ -15,7 +15,7 @@
   251.4    val symmetric: attribute
   251.5    val also: (Facts.ref * Attrib.src list) list option -> bool -> Proof.state -> Proof.state Seq.seq
   251.6    val also_i: thm list option -> bool -> Proof.state -> Proof.state Seq.seq
   251.7 -  val finally_: (Facts.ref * Attrib.src list) list option -> bool ->
   251.8 +  val finally: (Facts.ref * Attrib.src list) list option -> bool ->
   251.9      Proof.state -> Proof.state Seq.seq
  251.10    val finally_i: thm list option -> bool -> Proof.state -> Proof.state Seq.seq
  251.11    val moreover: bool -> Proof.state -> Proof.state
  251.12 @@ -150,7 +150,7 @@
  251.13  
  251.14  val also = calculate Proof.get_thmss false;
  251.15  val also_i = calculate (K I) false;
  251.16 -val finally_ = calculate Proof.get_thmss true;
  251.17 +val finally = calculate Proof.get_thmss true;
  251.18  val finally_i = calculate (K I) true;
  251.19  
  251.20  
   252.1 --- a/src/Pure/Isar/class.ML	Wed Mar 04 10:43:39 2009 +0100
   252.2 +++ b/src/Pure/Isar/class.ML	Wed Mar 04 10:45:52 2009 +0100
   252.3 @@ -201,7 +201,7 @@
   252.4        | check_element e = [()];
   252.5      val _ = map check_element syntax_elems;
   252.6      fun fork_syn (Element.Fixes xs) =
   252.7 -          fold_map (fn (c, ty, syn) => cons (Binding.base_name c, syn) #> pair (c, ty, NoSyn)) xs
   252.8 +          fold_map (fn (c, ty, syn) => cons (Binding.name_of c, syn) #> pair (c, ty, NoSyn)) xs
   252.9            #>> Element.Fixes
  252.10        | fork_syn x = pair x;
  252.11      val (elems, global_syntax) = fold_map fork_syn syntax_elems [];
  252.12 @@ -228,7 +228,7 @@
  252.13      val raw_params = (snd o chop (length supparams)) all_params;
  252.14      fun add_const (b, SOME raw_ty, _) thy =
  252.15        let
  252.16 -        val v = Binding.base_name b;
  252.17 +        val v = Binding.name_of b;
  252.18          val c = Sign.full_bname thy v;
  252.19          val ty = map_atyps (K (TFree (Name.aT, base_sort))) raw_ty;
  252.20          val ty0 = Type.strip_sorts ty;
  252.21 @@ -265,8 +265,7 @@
  252.22      |> add_consts bname class base_sort sups supparams global_syntax
  252.23      |-> (fn (param_map, params) => AxClass.define_class (bname, supsort)
  252.24            (map (fst o snd) params)
  252.25 -          [((Binding.empty, []),
  252.26 -            Option.map (globalize param_map) raw_pred |> the_list)]
  252.27 +          [(Thm.empty_binding, Option.map (globalize param_map) raw_pred |> the_list)]
  252.28      #> snd
  252.29      #> `get_axiom
  252.30      #-> (fn assm_axiom => fold (Sign.add_const_constraint o apsnd SOME o snd) params
   253.1 --- a/src/Pure/Isar/class_target.ML	Wed Mar 04 10:43:39 2009 +0100
   253.2 +++ b/src/Pure/Isar/class_target.ML	Wed Mar 04 10:45:52 2009 +0100
   253.3 @@ -493,7 +493,7 @@
   253.4  fun init_instantiation (tycos, vs, sort) thy =
   253.5    let
   253.6      val _ = if null tycos then error "At least one arity must be given" else ();
   253.7 -    val params = these_params thy sort;
   253.8 +    val params = these_params thy (filter (can (AxClass.get_info thy)) sort);
   253.9      fun get_param tyco (param, (_, (c, ty))) =
  253.10        if can (AxClass.param_of_inst thy) (c, tyco)
  253.11        then NONE else SOME ((c, tyco),
  253.12 @@ -513,7 +513,8 @@
  253.13        | SOME ts' => SOME (ts', ctxt);
  253.14      fun improve (c, ty) = case AxClass.inst_tyco_of thy (c, ty)
  253.15       of SOME tyco => (case AList.lookup (op =) inst_params (c, tyco)
  253.16 -         of SOME (_, ty') => if Type.raw_instance (ty', ty) then SOME (ty, ty') else NONE
  253.17 +         of SOME (_, ty') => if Type.typ_instance (Sign.tsig_of thy) (ty', ty)
  253.18 +              then SOME (ty, ty') else NONE
  253.19            | NONE => NONE)
  253.20        | NONE => NONE;
  253.21    in
  253.22 @@ -523,8 +524,7 @@
  253.23      |> fold (Variable.declare_typ o TFree) vs
  253.24      |> fold (Variable.declare_names o Free o snd) inst_params
  253.25      |> (Overloading.map_improvable_syntax o apfst)
  253.26 -         (fn ((_, _), ((_, subst), unchecks)) =>
  253.27 -            ((primary_constraints, []), (((improve, K NONE), false), [])))
  253.28 +         (K ((primary_constraints, []), (((improve, K NONE), false), [])))
  253.29      |> Overloading.add_improvable_syntax
  253.30      |> Context.proof_map (Syntax.add_term_check 0 "resorting" resort_check)
  253.31      |> synchronize_inst_syntax
   254.1 --- a/src/Pure/Isar/code.ML	Wed Mar 04 10:43:39 2009 +0100
   254.2 +++ b/src/Pure/Isar/code.ML	Wed Mar 04 10:45:52 2009 +0100
   254.3 @@ -35,7 +35,7 @@
   254.4    val these_raw_eqns: theory -> string -> (thm * bool) list
   254.5    val get_datatype: theory -> string -> ((string * sort) list * (string * typ list) list)
   254.6    val get_datatype_of_constr: theory -> string -> string option
   254.7 -  val get_case_data: theory -> string -> (int * string list) option
   254.8 +  val get_case_scheme: theory -> string -> (int * (int * string list)) option
   254.9    val is_undefined: theory -> string -> bool
  254.10    val default_typscheme: theory -> string -> (string * sort) list * typ
  254.11  
  254.12 @@ -111,7 +111,7 @@
  254.13  
  254.14  (** logical and syntactical specification of executable code **)
  254.15  
  254.16 -(* defining equations *)
  254.17 +(* code equations *)
  254.18  
  254.19  type eqns = bool * (thm * bool) list lazy;
  254.20    (*default flag, theorems with linear flag (perhaps lazy)*)
  254.21 @@ -136,7 +136,7 @@
  254.22        Pattern.matchess thy (args, (map incr_idx o curry Library.take (length args)) args');
  254.23      fun drop (thm', linear') = if (linear orelse not linear')
  254.24        andalso matches_args (args_of thm') then 
  254.25 -        (warning ("Code generator: dropping redundant defining equation\n" ^ Display.string_of_thm thm'); true)
  254.26 +        (warning ("Code generator: dropping redundant code equation\n" ^ Display.string_of_thm thm'); true)
  254.27        else false;
  254.28    in (thm, linear) :: filter_out drop thms end;
  254.29  
  254.30 @@ -157,7 +157,7 @@
  254.31      (*with explicit history*),
  254.32    dtyps: ((serial * ((string * sort) list * (string * typ list) list)) list) Symtab.table
  254.33      (*with explicit history*),
  254.34 -  cases: (int * string list) Symtab.table * unit Symtab.table
  254.35 +  cases: (int * (int * string list)) Symtab.table * unit Symtab.table
  254.36  };
  254.37  
  254.38  fun mk_spec ((concluded_history, eqns), (dtyps, cases)) =
  254.39 @@ -409,7 +409,7 @@
  254.40    in
  254.41      (Pretty.writeln o Pretty.chunks) [
  254.42        Pretty.block (
  254.43 -        Pretty.str "defining equations:"
  254.44 +        Pretty.str "code equations:"
  254.45          :: Pretty.fbrk
  254.46          :: (Pretty.fbreaks o map pretty_eqn) eqns
  254.47        ),
  254.48 @@ -452,7 +452,7 @@
  254.49          val ty1 :: tys = map (snd o Code_Unit.const_typ_eqn) thms';
  254.50          fun unify ty env = Sign.typ_unify thy (ty1, ty) env
  254.51            handle Type.TUNIFY =>
  254.52 -            error ("Type unificaton failed, while unifying defining equations\n"
  254.53 +            error ("Type unificaton failed, while unifying code equations\n"
  254.54              ^ (cat_lines o map Display.string_of_thm) thms
  254.55              ^ "\nwith types\n"
  254.56              ^ (cat_lines o map (Code_Unit.string_of_typ thy)) (ty1 :: tys));
  254.57 @@ -463,7 +463,7 @@
  254.58  
  254.59  fun check_linear (eqn as (thm, linear)) =
  254.60    if linear then eqn else Code_Unit.bad_thm
  254.61 -    ("Duplicate variables on left hand side of defining equation:\n"
  254.62 +    ("Duplicate variables on left hand side of code equation:\n"
  254.63        ^ Display.string_of_thm thm);
  254.64  
  254.65  fun mk_eqn thy linear =
  254.66 @@ -489,7 +489,7 @@
  254.67  
  254.68  fun retrieve_algebra thy operational =
  254.69    Sorts.subalgebra (Syntax.pp_global thy) operational
  254.70 -    (arity_constraints thy (Sign.classes_of thy))
  254.71 +    (SOME o arity_constraints thy (Sign.classes_of thy))
  254.72      (Sign.classes_of thy);
  254.73  
  254.74  in
  254.75 @@ -525,22 +525,13 @@
  254.76         then SOME tyco else NONE
  254.77      | _ => NONE;
  254.78  
  254.79 -fun get_constr_typ thy c =
  254.80 -  case get_datatype_of_constr thy c
  254.81 -   of SOME tyco => let
  254.82 -          val (vs, cos) = get_datatype thy tyco;
  254.83 -          val SOME tys = AList.lookup (op =) cos c;
  254.84 -          val ty = tys ---> Type (tyco, map TFree vs);
  254.85 -        in SOME (Logic.varifyT ty) end
  254.86 -    | NONE => NONE;
  254.87 -
  254.88  fun recheck_eqn thy = Code_Unit.error_thm
  254.89    (Code_Unit.assert_linear (is_some o get_datatype_of_constr thy) o apfst (Code_Unit.assert_eqn thy));
  254.90  
  254.91  fun recheck_eqns_const thy c eqns =
  254.92    let
  254.93      fun cert (eqn as (thm, _)) = if c = Code_Unit.const_eqn thm
  254.94 -      then eqn else error ("Wrong head of defining equation,\nexpected constant "
  254.95 +      then eqn else error ("Wrong head of code equation,\nexpected constant "
  254.96          ^ Code_Unit.string_of_const thy c ^ "\n" ^ Display.string_of_thm thm)
  254.97    in map (cert o recheck_eqn thy) eqns end;
  254.98  
  254.99 @@ -554,11 +545,11 @@
 254.100          let
 254.101            val c = Code_Unit.const_eqn thm;
 254.102            val _ = if not default andalso (is_some o AxClass.class_of_param thy) c
 254.103 -            then error ("Rejected polymorphic equation for overloaded constant:\n"
 254.104 +            then error ("Rejected polymorphic code equation for overloaded constant:\n"
 254.105                ^ Display.string_of_thm thm)
 254.106              else ();
 254.107            val _ = if not default andalso (is_some o get_datatype_of_constr thy) c
 254.108 -            then error ("Rejected equation for datatype constructor:\n"
 254.109 +            then error ("Rejected code equation for datatype constructor:\n"
 254.110                ^ Display.string_of_thm thm)
 254.111              else ();
 254.112          in change_eqns false c (add_thm thy default (thm, linear)) thy end
 254.113 @@ -583,7 +574,7 @@
 254.114  
 254.115  fun del_eqns c = change_eqns true c (K (false, Lazy.value []));
 254.116  
 254.117 -val get_case_data = Symtab.lookup o fst o the_cases o the_exec;
 254.118 +fun get_case_scheme thy = Symtab.lookup ((fst o the_cases o the_exec) thy);
 254.119  
 254.120  val is_undefined = Symtab.defined o snd o the_cases o the_exec;
 254.121  
 254.122 @@ -593,11 +584,17 @@
 254.123    let
 254.124      val cs = map (fn c_ty as (_, ty) => (AxClass.unoverload_const thy c_ty, ty)) raw_cs;
 254.125      val (tyco, vs_cos) = Code_Unit.constrset_of_consts thy cs;
 254.126 +    val old_cs = (map fst o snd o get_datatype thy) tyco;
 254.127 +    fun drop_outdated_cases cases = fold Symtab.delete_safe
 254.128 +      (Symtab.fold (fn (c, (_, (_, cos))) =>
 254.129 +        if exists (member (op =) old_cs) cos
 254.130 +          then insert (op =) c else I) cases []) cases;
 254.131    in
 254.132      thy
 254.133      |> map_exec_purge NONE
 254.134          ((map_dtyps o Symtab.map_default (tyco, [])) (cons (serial (), vs_cos))
 254.135 -        #> map_eqns (fold (Symtab.delete_safe o fst) cs))
 254.136 +        #> map_eqns (fold (Symtab.delete_safe o fst) cs)
 254.137 +        #> (map_cases o apfst) drop_outdated_cases)
 254.138      |> TypeInterpretation.data (tyco, serial ())
 254.139    end;
 254.140  
 254.141 @@ -611,10 +608,12 @@
 254.142  
 254.143  fun add_case thm thy =
 254.144    let
 254.145 -    val entry as (c, _) = Code_Unit.case_cert thm;
 254.146 -  in
 254.147 -    (map_exec_purge (SOME [c]) o map_cases o apfst) (Symtab.update entry) thy
 254.148 -  end;
 254.149 +    val (c, (k, case_pats)) = Code_Unit.case_cert thm;
 254.150 +    val _ = case filter (is_none o get_datatype_of_constr thy) case_pats
 254.151 +     of [] => ()
 254.152 +      | cs => error ("Non-constructor(s) in case certificate: " ^ commas (map quote cs));
 254.153 +    val entry = (1 + Int.max (1, length case_pats), (k, case_pats))
 254.154 +  in (map_exec_purge (SOME [c]) o map_cases o apfst) (Symtab.update (c, entry)) thy end;
 254.155  
 254.156  fun add_undefined c thy =
 254.157    (map_exec_purge (SOME [c]) o map_cases o apsnd) (Symtab.update (c, ())) thy;
 254.158 @@ -727,18 +726,16 @@
 254.159  
 254.160  fun default_typscheme thy c =
 254.161    let
 254.162 -    val typscheme = curry (Code_Unit.typscheme thy) c
 254.163 -    val the_const_type = snd o dest_Const o TermSubst.zero_var_indexes
 254.164 -      o curry Const "" o Sign.the_const_type thy;
 254.165 +    fun the_const_typscheme c = (curry (Code_Unit.typscheme thy) c o snd o dest_Const
 254.166 +      o TermSubst.zero_var_indexes o curry Const "" o Sign.the_const_type thy) c;
 254.167 +    fun strip_sorts (vs, ty) = (map (fn (v, _) => (v, [])) vs, ty);
 254.168    in case AxClass.class_of_param thy c
 254.169 -   of SOME class => the_const_type c
 254.170 -        |> Term.map_type_tvar (K (TVar ((Name.aT, 0), [class])))
 254.171 -        |> typscheme
 254.172 -    | NONE => (case get_constr_typ thy c
 254.173 -       of SOME ty => typscheme ty
 254.174 -        | NONE => (case get_eqns thy c
 254.175 -           of (thm, _) :: _ => snd (Code_Unit.head_eqn thy (Drule.zero_var_indexes thm))
 254.176 -            | [] => typscheme (the_const_type c))) end;
 254.177 +   of SOME class => ([(Name.aT, [class])], snd (the_const_typscheme c))
 254.178 +    | NONE => if is_some (get_datatype_of_constr thy c)
 254.179 +        then strip_sorts (the_const_typscheme c)
 254.180 +        else case get_eqns thy c
 254.181 +         of (thm, _) :: _ => snd (Code_Unit.head_eqn thy (Drule.zero_var_indexes thm))
 254.182 +          | [] => strip_sorts (the_const_typscheme c) end;
 254.183  
 254.184  end; (*local*)
 254.185  
   255.1 --- a/src/Pure/Isar/code_unit.ML	Wed Mar 04 10:43:39 2009 +0100
   255.2 +++ b/src/Pure/Isar/code_unit.ML	Wed Mar 04 10:45:52 2009 +0100
   255.3 @@ -34,7 +34,7 @@
   255.4    val constrset_of_consts: theory -> (string * typ) list
   255.5      -> string * ((string * sort) list * (string * typ list) list)
   255.6  
   255.7 -  (*defining equations*)
   255.8 +  (*code equations*)
   255.9    val assert_eqn: theory -> thm -> thm
  255.10    val mk_eqn: theory -> thm -> thm * bool
  255.11    val assert_linear: (string -> bool) -> thm * bool -> thm * bool
  255.12 @@ -76,10 +76,11 @@
  255.13  
  255.14  fun typscheme thy (c, ty) =
  255.15    let
  255.16 -    fun dest (TVar ((v, 0), sort)) = (v, sort)
  255.17 +    val ty' = Logic.unvarifyT ty;
  255.18 +    fun dest (TFree (v, sort)) = (v, sort)
  255.19        | dest ty = error ("Illegal type parameter in type scheme: " ^ Syntax.string_of_typ_global thy ty);
  255.20 -    val vs = map dest (Sign.const_typargs thy (c, ty));
  255.21 -  in (vs, ty) end;
  255.22 +    val vs = map dest (Sign.const_typargs thy (c, ty'));
  255.23 +  in (vs, Type.strip_sorts ty') end;
  255.24  
  255.25  fun inst_thm thy tvars' thm =
  255.26    let
  255.27 @@ -313,10 +314,10 @@
  255.28      val ((tyco, sorts), cs'') = fold add cs' (apsnd single c');
  255.29      val vs = Name.names Name.context Name.aT sorts;
  255.30      val cs''' = map (inst vs) cs'';
  255.31 -  in (tyco, (vs, cs''')) end;
  255.32 +  in (tyco, (vs, rev cs''')) end;
  255.33  
  255.34  
  255.35 -(* defining equations *)
  255.36 +(* code equations *)
  255.37  
  255.38  fun assert_eqn thy thm =
  255.39    let
  255.40 @@ -351,7 +352,7 @@
  255.41              ^ Display.string_of_thm thm)
  255.42        | check 0 (Var _) = ()
  255.43        | check _ (Var _) = bad_thm
  255.44 -          ("Variable with application on left hand side of defining equation\n"
  255.45 +          ("Variable with application on left hand side of code equation\n"
  255.46              ^ Display.string_of_thm thm)
  255.47        | check n (t1 $ t2) = (check (n+1) t1; check 0 t2)
  255.48        | check n (Const (_, ty)) = if n <> (length o fst o strip_type) ty
  255.49 @@ -363,7 +364,7 @@
  255.50      val ty_decl = Sign.the_const_type thy c;
  255.51      val _ = if Sign.typ_equiv thy (Type.strip_sorts ty_decl, Type.strip_sorts ty)
  255.52        then () else bad_thm ("Type\n" ^ string_of_typ thy ty
  255.53 -           ^ "\nof defining equation\n"
  255.54 +           ^ "\nof code equation\n"
  255.55             ^ Display.string_of_thm thm
  255.56             ^ "\nis incompatible with declared function type\n"
  255.57             ^ string_of_typ thy ty_decl)
  255.58 @@ -388,7 +389,7 @@
  255.59  fun assert_linear is_cons (thm, false) = (thm, false)
  255.60    | assert_linear is_cons (thm, true) = if snd (add_linear (assert_pat is_cons thm)) then (thm, true)
  255.61        else bad_thm
  255.62 -        ("Duplicate variables on left hand side of defining equation:\n"
  255.63 +        ("Duplicate variables on left hand side of code equation:\n"
  255.64            ^ Display.string_of_thm thm);
  255.65  
  255.66  
   256.1 --- a/src/Pure/Isar/constdefs.ML	Wed Mar 04 10:43:39 2009 +0100
   256.2 +++ b/src/Pure/Isar/constdefs.ML	Wed Mar 04 10:45:52 2009 +0100
   256.3 @@ -9,11 +9,9 @@
   256.4  signature CONSTDEFS =
   256.5  sig
   256.6    val add_constdefs: (binding * string option) list *
   256.7 -    ((binding * string option * mixfix) option *
   256.8 -      (Attrib.binding * string)) list -> theory -> theory
   256.9 +    ((binding * string option * mixfix) option * (Attrib.binding * string)) list -> theory -> theory
  256.10    val add_constdefs_i: (binding * typ option) list *
  256.11 -    ((binding * typ option * mixfix) option *
  256.12 -      ((binding * attribute list) * term)) list -> theory -> theory
  256.13 +    ((binding * typ option * mixfix) option * (Thm.binding * term)) list -> theory -> theory
  256.14  end;
  256.15  
  256.16  structure Constdefs: CONSTDEFS =
  256.17 @@ -38,7 +36,7 @@
  256.18      val prop = prep_prop var_ctxt raw_prop;
  256.19      val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (Logic.strip_imp_concl prop));
  256.20      val _ =
  256.21 -      (case Option.map Binding.base_name d of
  256.22 +      (case Option.map Binding.name_of d of
  256.23          NONE => ()
  256.24        | SOME c' =>
  256.25            if c <> c' then
  256.26 @@ -46,7 +44,7 @@
  256.27            else ());
  256.28  
  256.29      val def = Term.subst_atomic [(Free (c, T), Const (Sign.full_bname thy c, T))] prop;
  256.30 -    val name = Thm.def_name_optional c (Binding.base_name raw_name);
  256.31 +    val name = Thm.def_name_optional c (Binding.name_of raw_name);
  256.32      val atts = map (prep_att thy) raw_atts;
  256.33  
  256.34      val thy' =
   257.1 --- a/src/Pure/Isar/element.ML	Wed Mar 04 10:43:39 2009 +0100
   257.2 +++ b/src/Pure/Isar/element.ML	Wed Mar 04 10:45:52 2009 +0100
   257.3 @@ -96,7 +96,7 @@
   257.4  fun map_ctxt {binding, typ, term, pattern, fact, attrib} =
   257.5    fn Fixes fixes => Fixes (fixes |> map (fn (x, T, mx) => (binding x, Option.map typ T, mx)))
   257.6     | Constrains xs => Constrains (xs |> map (fn (x, T) =>
   257.7 -      (Binding.base_name (binding (Binding.name x)), typ T)))
   257.8 +      (Binding.name_of (binding (Binding.name x)), typ T)))
   257.9     | Assumes asms => Assumes (asms |> map (fn ((a, atts), propps) =>
  257.10        ((binding a, map attrib atts), propps |> map (fn (t, ps) => (term t, map pattern ps)))))
  257.11     | Defines defs => Defines (defs |> map (fn ((a, atts), (t, ps)) =>
  257.12 @@ -125,11 +125,9 @@
  257.13          map (fn y => Pretty.block [Pretty.str "  ", Pretty.keyword sep, Pretty.brk 1, y]) ys;
  257.14  
  257.15  fun pretty_name_atts ctxt (b, atts) sep =
  257.16 -  let val name = Binding.display b in
  257.17 -    if name = "" andalso null atts then []
  257.18 -    else [Pretty.block
  257.19 -      (Pretty.breaks (Pretty.str name :: Attrib.pretty_attribs ctxt atts @ [Pretty.str sep]))]
  257.20 -  end;
  257.21 +  if Binding.is_empty b andalso null atts then []
  257.22 +  else [Pretty.block (Pretty.breaks
  257.23 +    (Pretty.str (Binding.str_of b) :: Attrib.pretty_attribs ctxt atts @ [Pretty.str sep]))];
  257.24  
  257.25  
  257.26  (* pretty_stmt *)
  257.27 @@ -145,8 +143,8 @@
  257.28        Pretty.block (Pretty.breaks (prt_name_atts a ":" @ prt_terms (map fst ts)));
  257.29  
  257.30      fun prt_var (x, SOME T) = Pretty.block
  257.31 -          [Pretty.str (Binding.base_name x ^ " ::"), Pretty.brk 1, prt_typ T]
  257.32 -      | prt_var (x, NONE) = Pretty.str (Binding.base_name x);
  257.33 +          [Pretty.str (Binding.name_of x ^ " ::"), Pretty.brk 1, prt_typ T]
  257.34 +      | prt_var (x, NONE) = Pretty.str (Binding.name_of x);
  257.35      val prt_vars = separate (Pretty.keyword "and") o map prt_var;
  257.36  
  257.37      fun prt_obtain (_, ([], ts)) = Pretty.block (Pretty.breaks (prt_terms ts))
  257.38 @@ -170,9 +168,9 @@
  257.39      fun prt_mixfix NoSyn = []
  257.40        | prt_mixfix mx = [Pretty.brk 2, Syntax.pretty_mixfix mx];
  257.41  
  257.42 -    fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.base_name x ^ " ::") ::
  257.43 +    fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.name_of x ^ " ::") ::
  257.44            Pretty.brk 1 :: prt_typ T :: Pretty.brk 1 :: prt_mixfix mx)
  257.45 -      | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.base_name x) ::
  257.46 +      | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.name_of x) ::
  257.47            Pretty.brk 1 :: prt_mixfix mx);
  257.48      fun prt_constrain (x, T) = prt_fix (Binding.name x, SOME T, NoSyn);
  257.49  
  257.50 @@ -296,7 +294,7 @@
  257.51    gen_witness_proof (fn after_qed' => fn propss =>
  257.52      Proof.map_context (K goal_ctxt)
  257.53      #> Proof.local_goal (ProofDisplay.print_results int) (K I) ProofContext.bind_propp_i
  257.54 -      cmd NONE after_qed' (map (pair (Binding.empty, [])) propss))
  257.55 +      cmd NONE after_qed' (map (pair Thm.empty_binding) propss))
  257.56      (fn wits => fn _ => after_qed wits) wit_propss [];
  257.57  
  257.58  end;
  257.59 @@ -504,7 +502,7 @@
  257.60          val defs' = Attrib.map_specs (Attrib.attribute_i (ProofContext.theory_of ctxt)) defs;
  257.61          val asms = defs' |> map (fn ((name, atts), (t, ps)) =>
  257.62              let val ((c, _), t') = LocalDefs.cert_def ctxt t
  257.63 -            in (t', ((Binding.map_base (Thm.def_name_optional c) name, atts), [(t', ps)])) end);
  257.64 +            in (t', ((Binding.map_name (Thm.def_name_optional c) name, atts), [(t', ps)])) end);
  257.65          val (_, ctxt') =
  257.66            ctxt |> fold (Variable.auto_fixes o #1) asms
  257.67            |> ProofContext.add_assms_i LocalDefs.def_export (map #2 asms);
  257.68 @@ -529,7 +527,7 @@
  257.69  
  257.70  fun prep_facts prep_name get intern ctxt =
  257.71    map_ctxt
  257.72 -   {binding = Binding.map_base prep_name,
  257.73 +   {binding = Binding.map_name prep_name,
  257.74      typ = I,
  257.75      term = I,
  257.76      pattern = I,
   258.1 --- a/src/Pure/Isar/expression.ML	Wed Mar 04 10:43:39 2009 +0100
   258.2 +++ b/src/Pure/Isar/expression.ML	Wed Mar 04 10:45:52 2009 +0100
   258.3 @@ -88,17 +88,13 @@
   258.4          if null dups then () else error (message ^ commas dups)
   258.5        end;
   258.6  
   258.7 -    fun match_bind (n, b) = (n = Binding.base_name b);
   258.8 +    fun match_bind (n, b) = (n = Binding.name_of b);
   258.9      fun parm_eq ((b1, mx1: mixfix), (b2, mx2)) =
  258.10        (* FIXME: cannot compare bindings for equality, instead check for equal name and syntax *)
  258.11 -      (Binding.base_name b1 = Binding.base_name b2) andalso
  258.12 -      (if mx1 = mx2 then true
  258.13 -      else error ("Conflicting syntax for parameter" ^ quote (Binding.display b1) ^
  258.14 -                    " in expression."));
  258.15 +      Binding.name_of b1 = Binding.name_of b2 andalso
  258.16 +        (mx1 = mx2 orelse
  258.17 +          error ("Conflicting syntax for parameter " ^ quote (Binding.str_of b1) ^ " in expression"));
  258.18        
  258.19 -    fun bind_eq (b1, b2) = (Binding.base_name b1 = Binding.base_name b2);
  258.20 -      (* FIXME: cannot compare bindings for equality. *)
  258.21 -
  258.22      fun params_loc loc =
  258.23        (Locale.params_of thy loc |> map (fn (p, _, mx) => (p, mx)), loc);
  258.24      fun params_inst (expr as (loc, (prfx, Positional insts))) =
  258.25 @@ -133,8 +129,8 @@
  258.26  
  258.27      val (implicit, expr') = params_expr expr;
  258.28  
  258.29 -    val implicit' = map (#1 #> Binding.base_name) implicit;
  258.30 -    val fixed' = map (#1 #> Binding.base_name) fixed;
  258.31 +    val implicit' = map (#1 #> Binding.name_of) implicit;
  258.32 +    val fixed' = map (#1 #> Binding.name_of) fixed;
  258.33      val _ = reject_dups "Duplicate fixed parameter(s): " fixed';
  258.34      val implicit'' = if strict then []
  258.35        else let val _ = reject_dups
  258.36 @@ -310,14 +306,12 @@
  258.37              (a, map (fn (t, ps) => (close_frees t, no_binds ps)) propps)))
  258.38          | Defines defs => Defines (defs |> map (fn ((name, atts), (t, ps)) =>
  258.39              let val ((c, _), t') = LocalDefs.cert_def ctxt (close_frees t)
  258.40 -            in
  258.41 -              ((Binding.map_base (Thm.def_name_optional c) name, atts), (t', no_binds ps))
  258.42 -            end))
  258.43 +            in ((Binding.map_name (Thm.def_name_optional c) name, atts), (t', no_binds ps)) end))
  258.44          | e => e)
  258.45        end;
  258.46  
  258.47  fun finish_primitive parms _ (Fixes fixes) = Fixes (map (fn (binding, _, mx) =>
  258.48 -      let val x = Binding.base_name binding
  258.49 +      let val x = Binding.name_of binding
  258.50        in (binding, AList.lookup (op =) parms x, mx) end) fixes)
  258.51    | finish_primitive _ _ (Constrains _) = Constrains []
  258.52    | finish_primitive _ close (Assumes asms) = close (Assumes asms)
  258.53 @@ -328,7 +322,7 @@
  258.54    let
  258.55      val thy = ProofContext.theory_of ctxt;
  258.56      val (parm_names, parm_types) = Locale.params_of thy loc |>
  258.57 -      map_split (fn (b, SOME T, _) => (Binding.base_name b, T));
  258.58 +      map_split (fn (b, SOME T, _) => (Binding.name_of b, T));
  258.59      val (morph, _) = inst_morph (parm_names, parm_types) (prfx, inst) ctxt;
  258.60    in (loc, morph) end;
  258.61  
  258.62 @@ -360,7 +354,7 @@
  258.63      fun prep_insts (loc, (prfx, inst)) (i, insts, ctxt) =
  258.64        let
  258.65          val (parm_names, parm_types) = Locale.params_of thy loc |>
  258.66 -          map_split (fn (b, SOME T, _) => (Binding.base_name b, T))
  258.67 +          map_split (fn (b, SOME T, _) => (Binding.name_of b, T))
  258.68              (*FIXME return value of Locale.params_of has strange type*)
  258.69          val inst' = prep_inst ctxt parm_names inst;
  258.70          val parm_types' = map (TypeInfer.paramify_vars o
  258.71 @@ -394,7 +388,7 @@
  258.72        prep_concl raw_concl (insts', elems, ctxt5);
  258.73  
  258.74      (* Retrieve parameter types *)
  258.75 -    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.base_name o #1) fixes)
  258.76 +    val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.name_of o #1) fixes)
  258.77        | _ => fn ps => ps) (Fixes fors :: elems') [];
  258.78      val (Ts, ctxt7) = fold_map ProofContext.inferred_param xs ctxt6; 
  258.79      val parms = xs ~~ Ts;  (* params from expression and elements *)
  258.80 @@ -726,14 +720,14 @@
  258.81    | defines_to_notes _ e = e;
  258.82  
  258.83  fun gen_add_locale prep_decl
  258.84 -    bname raw_predicate_bname raw_imprt raw_body thy =
  258.85 +    bname raw_predicate_bname raw_import raw_body thy =
  258.86    let
  258.87      val name = Sign.full_bname thy bname;
  258.88      val _ = Locale.defined thy name andalso
  258.89        error ("Duplicate definition of locale " ^ quote name);
  258.90  
  258.91      val ((fixed, deps, body_elems), (parms, ctxt')) =
  258.92 -      prep_decl raw_imprt I raw_body (ProofContext.init thy);
  258.93 +      prep_decl raw_import I raw_body (ProofContext.init thy);
  258.94      val text as (((_, exts'), _), defs) = eval ctxt' deps body_elems;
  258.95  
  258.96      val predicate_bname = if raw_predicate_bname = "" then bname
   259.1 --- a/src/Pure/Isar/isar_cmd.ML	Wed Mar 04 10:43:39 2009 +0100
   259.2 +++ b/src/Pure/Isar/isar_cmd.ML	Wed Mar 04 10:45:52 2009 +0100
   259.3 @@ -32,7 +32,6 @@
   259.4    val skip_proof: Toplevel.transition -> Toplevel.transition
   259.5    val init_theory: string * string list * (string * bool) list ->
   259.6      Toplevel.transition -> Toplevel.transition
   259.7 -  val welcome: Toplevel.transition -> Toplevel.transition
   259.8    val exit: Toplevel.transition -> Toplevel.transition
   259.9    val quit: Toplevel.transition -> Toplevel.transition
  259.10    val pr: string list * (int option * int option) -> Toplevel.transition -> Toplevel.transition
  259.11 @@ -62,10 +61,6 @@
  259.12    val class_deps: Toplevel.transition -> Toplevel.transition
  259.13    val thy_deps: Toplevel.transition -> Toplevel.transition
  259.14    val thm_deps: (Facts.ref * Attrib.src list) list -> Toplevel.transition -> Toplevel.transition
  259.15 -  val find_theorems: (int option * bool) * (bool * string FindTheorems.criterion) list
  259.16 -    -> Toplevel.transition -> Toplevel.transition
  259.17 -  val find_consts: (bool * FindConsts.criterion) list ->
  259.18 -                   Toplevel.transition -> Toplevel.transition
  259.19    val unused_thms: (string list * string list option) option ->
  259.20      Toplevel.transition -> Toplevel.transition
  259.21    val print_binds: Toplevel.transition -> Toplevel.transition
  259.22 @@ -166,7 +161,7 @@
  259.23  (* axioms *)
  259.24  
  259.25  fun add_axms f args thy =
  259.26 -  f (map (fn ((b, ax), srcs) => ((Binding.base_name b, ax), map (Attrib.attribute thy) srcs)) args) thy;
  259.27 +  f (map (fn ((b, ax), srcs) => ((Binding.name_of b, ax), map (Attrib.attribute thy) srcs)) args) thy;
  259.28  
  259.29  val add_axioms = add_axms (snd oo PureThy.add_axioms_cmd);
  259.30  
  259.31 @@ -269,8 +264,6 @@
  259.32        if ThyInfo.check_known_thy (Context.theory_name thy)
  259.33        then ThyInfo.end_theory thy else ());
  259.34  
  259.35 -val welcome = Toplevel.imperative (writeln o Session.welcome);
  259.36 -
  259.37  val exit = Toplevel.keep (fn state =>
  259.38   (Context.set_thread_data (try Toplevel.generic_theory_of state);
  259.39    raise Toplevel.TERMINATE));
  259.40 @@ -403,20 +396,9 @@
  259.41        |> sort (int_ord o pairself #1) |> map #2;
  259.42    in Present.display_graph gr end);
  259.43  
  259.44 -
  259.45 -(* retrieve theorems *)
  259.46 -
  259.47  fun thm_deps args = Toplevel.unknown_theory o Toplevel.keep (fn state =>
  259.48    ThmDeps.thm_deps (Proof.get_thmss (Toplevel.enter_proof_body state) args));
  259.49  
  259.50 -fun find_theorems ((opt_lim, rem_dups), spec) =
  259.51 -  Toplevel.unknown_theory o Toplevel.keep (fn state =>
  259.52 -  let
  259.53 -    val proof_state = Toplevel.enter_proof_body state;
  259.54 -    val ctxt = Proof.context_of proof_state;
  259.55 -    val opt_goal = try Proof.get_goal proof_state |> Option.map (#2 o #2);
  259.56 -  in FindTheorems.print_theorems ctxt opt_goal opt_lim rem_dups spec end);
  259.57 -
  259.58  
  259.59  (* find unused theorems *)
  259.60  
  259.61 @@ -434,12 +416,6 @@
  259.62      |> map pretty_thm |> Pretty.chunks |> Pretty.writeln
  259.63    end);
  259.64  
  259.65 -(* retrieve constants *)
  259.66 -
  259.67 -fun find_consts spec =
  259.68 -  Toplevel.unknown_theory o Toplevel.keep (fn state =>
  259.69 -  let val ctxt = (Proof.context_of o Toplevel.enter_proof_body) state
  259.70 -  in FindConsts.find_consts ctxt spec end);
  259.71  
  259.72  (* print proof context contents *)
  259.73  
   260.1 --- a/src/Pure/Isar/isar_syn.ML	Wed Mar 04 10:43:39 2009 +0100
   260.2 +++ b/src/Pure/Isar/isar_syn.ML	Wed Mar 04 10:45:52 2009 +0100
   260.3 @@ -37,6 +37,7 @@
   260.4      (Scan.succeed (Toplevel.exit o Toplevel.end_local_theory));
   260.5  
   260.6  
   260.7 +
   260.8  (** markup commands **)
   260.9  
  260.10  val _ = OuterSyntax.markup_command ThyOutput.Markup "header" "theory header" K.diag
  260.11 @@ -79,7 +80,7 @@
  260.12  
  260.13  
  260.14  
  260.15 -(** theory sections **)
  260.16 +(** theory commands **)
  260.17  
  260.18  (* classes and sorts *)
  260.19  
  260.20 @@ -692,7 +693,7 @@
  260.21  val _ =
  260.22    OuterSyntax.command "finally" "combine calculation and current facts, exhibit result"
  260.23      (K.tag_proof K.prf_chain)
  260.24 -    (calc_args >> (Toplevel.proofs' o Calculation.finally_));
  260.25 +    (calc_args >> (Toplevel.proofs' o Calculation.finally));
  260.26  
  260.27  val _ =
  260.28    OuterSyntax.command "moreover" "augment calculation by current facts"
  260.29 @@ -728,39 +729,6 @@
  260.30        handle ERROR msg => Scan.fail_with (K msg)));
  260.31  
  260.32  
  260.33 -(* global history commands *)
  260.34 -
  260.35 -val _ =
  260.36 -  OuterSyntax.improper_command "init_toplevel" "init toplevel point-of-interest" K.control
  260.37 -    (Scan.succeed (Toplevel.no_timing o Toplevel.imperative Isar.init));
  260.38 -
  260.39 -val _ =
  260.40 -  OuterSyntax.improper_command "linear_undo" "undo commands" K.control
  260.41 -    (Scan.optional P.nat 1 >>
  260.42 -      (fn n => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.linear_undo n)));
  260.43 -
  260.44 -val _ =
  260.45 -  OuterSyntax.improper_command "undo" "undo commands (skipping closed proofs)" K.control
  260.46 -    (Scan.optional P.nat 1 >>
  260.47 -      (fn n => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.undo n)));
  260.48 -
  260.49 -val _ =
  260.50 -  OuterSyntax.improper_command "undos_proof" "undo commands (skipping closed proofs)" K.control
  260.51 -    (Scan.optional P.nat 1 >> (fn n => Toplevel.no_timing o
  260.52 -      Toplevel.keep (fn state =>
  260.53 -        if Toplevel.is_proof state then (Isar.undo n; Isar.print ()) else raise Toplevel.UNDEF)));
  260.54 -
  260.55 -val _ =
  260.56 -  OuterSyntax.improper_command "cannot_undo" "partial undo -- Proof General legacy" K.control
  260.57 -    (P.name >>
  260.58 -      (fn "end" => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.undo 1)
  260.59 -        | txt => Toplevel.imperative (fn () => error ("Cannot undo " ^ quote txt))));
  260.60 -
  260.61 -val _ =
  260.62 -  OuterSyntax.improper_command "kill" "kill partial proof or theory development" K.control
  260.63 -    (Scan.succeed (Toplevel.no_timing o Toplevel.imperative Isar.kill));
  260.64 -
  260.65 -
  260.66  
  260.67  (** diagnostic commands (for interactive mode only) **)
  260.68  
  260.69 @@ -853,47 +821,6 @@
  260.70    OuterSyntax.improper_command "thm_deps" "visualize theorem dependencies"
  260.71      K.diag (SpecParse.xthms1 >> (Toplevel.no_timing oo IsarCmd.thm_deps));
  260.72  
  260.73 -local
  260.74 -
  260.75 -val criterion =
  260.76 -  P.reserved "name" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindTheorems.Name ||
  260.77 -  P.reserved "intro" >> K FindTheorems.Intro ||
  260.78 -  P.reserved "elim" >> K FindTheorems.Elim ||
  260.79 -  P.reserved "dest" >> K FindTheorems.Dest ||
  260.80 -  P.reserved "solves" >> K FindTheorems.Solves ||
  260.81 -  P.reserved "simp" |-- P.!!! (P.$$$ ":" |-- P.term) >> FindTheorems.Simp ||
  260.82 -  P.term >> FindTheorems.Pattern;
  260.83 -
  260.84 -val options =
  260.85 -  Scan.optional
  260.86 -    (P.$$$ "(" |--
  260.87 -      P.!!! (Scan.option P.nat -- Scan.optional (P.reserved "with_dups" >> K false) true
  260.88 -        --| P.$$$ ")")) (NONE, true);
  260.89 -in
  260.90 -
  260.91 -val _ =
  260.92 -  OuterSyntax.improper_command "find_theorems" "print theorems meeting specified criteria" K.diag
  260.93 -    (options -- Scan.repeat (((Scan.option P.minus >> is_none) -- criterion))
  260.94 -      >> (Toplevel.no_timing oo IsarCmd.find_theorems));
  260.95 -
  260.96 -end;
  260.97 -
  260.98 -local
  260.99 -
 260.100 -val criterion =
 260.101 -  P.reserved "strict" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindConsts.Strict ||
 260.102 -  P.reserved "name" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindConsts.Name ||
 260.103 -  P.xname >> FindConsts.Loose;
 260.104 -
 260.105 -in
 260.106 -
 260.107 -val _ =
 260.108 -  OuterSyntax.improper_command "find_consts" "search constants by type pattern"
 260.109 -    K.diag (Scan.repeat (((Scan.option P.minus >> is_none) -- criterion))
 260.110 -            >> (Toplevel.no_timing oo IsarCmd.find_consts));
 260.111 -
 260.112 -end;
 260.113 -
 260.114  val _ =
 260.115    OuterSyntax.improper_command "print_binds" "print term bindings of proof context" K.diag
 260.116      (Scan.succeed (Toplevel.no_timing o IsarCmd.print_binds));
 260.117 @@ -948,6 +875,7 @@
 260.118           (Toplevel.no_timing oo IsarCmd.unused_thms));
 260.119  
 260.120  
 260.121 +
 260.122  (** system commands (for interactive mode only) **)
 260.123  
 260.124  val _ =
 260.125 @@ -1013,9 +941,5 @@
 260.126    OuterSyntax.improper_command "exit" "exit Isar loop" K.control
 260.127      (Scan.succeed (Toplevel.no_timing o IsarCmd.exit));
 260.128  
 260.129 -val _ =
 260.130 -  OuterSyntax.improper_command "welcome" "print welcome message" K.diag
 260.131 -    (Scan.succeed (Toplevel.no_timing o IsarCmd.welcome));
 260.132 -
 260.133  end;
 260.134  
   261.1 --- a/src/Pure/Isar/local_defs.ML	Wed Mar 04 10:43:39 2009 +0100
   261.2 +++ b/src/Pure/Isar/local_defs.ML	Wed Mar 04 10:45:52 2009 +0100
   261.3 @@ -11,8 +11,8 @@
   261.4    val mk_def: Proof.context -> (string * term) list -> term list
   261.5    val expand: cterm list -> thm -> thm
   261.6    val def_export: Assumption.export
   261.7 -  val add_defs: ((binding * mixfix) * ((binding * attribute list) * term)) list ->
   261.8 -    Proof.context -> (term * (string * thm)) list * Proof.context
   261.9 +  val add_defs: ((binding * mixfix) * (Thm.binding * term)) list -> Proof.context ->
  261.10 +    (term * (string * thm)) list * Proof.context
  261.11    val add_def: (binding * mixfix) * term -> Proof.context -> (term * thm) * Proof.context
  261.12    val fixed_abbrev: (binding * mixfix) * term -> Proof.context ->
  261.13      (term * term) * Proof.context
  261.14 @@ -90,8 +90,8 @@
  261.15    let
  261.16      val ((bvars, mxs), specs) = defs |> split_list |>> split_list;
  261.17      val ((bfacts, atts), rhss) = specs |> split_list |>> split_list;
  261.18 -    val xs = map Binding.base_name bvars;
  261.19 -    val names = map2 (Binding.map_base o Thm.def_name_optional) xs bfacts;
  261.20 +    val xs = map Binding.name_of bvars;
  261.21 +    val names = map2 (Binding.map_name o Thm.def_name_optional) xs bfacts;
  261.22      val eqs = mk_def ctxt (xs ~~ rhss);
  261.23      val lhss = map (fst o Logic.dest_equals) eqs;
  261.24    in
  261.25 @@ -104,7 +104,7 @@
  261.26    end;
  261.27  
  261.28  fun add_def (var, rhs) ctxt =
  261.29 -  let val ([(lhs, (_, th))], ctxt') = add_defs [(var, ((Binding.empty, []), rhs))] ctxt
  261.30 +  let val ([(lhs, (_, th))], ctxt') = add_defs [(var, (Thm.empty_binding, rhs))] ctxt
  261.31    in ((lhs, th), ctxt') end;
  261.32  
  261.33  
   262.1 --- a/src/Pure/Isar/locale.ML	Wed Mar 04 10:43:39 2009 +0100
   262.2 +++ b/src/Pure/Isar/locale.ML	Wed Mar 04 10:45:52 2009 +0100
   262.3 @@ -194,7 +194,7 @@
   262.4  fun axioms_of thy = #axioms o the_locale thy;
   262.5  
   262.6  fun instance_of thy name morph = params_of thy name |>
   262.7 -  map ((fn (b, T, _) => Free (Binding.base_name b, the T)) #> Morphism.term morph);
   262.8 +  map ((fn (b, T, _) => Free (Binding.name_of b, the T)) #> Morphism.term morph);
   262.9  
  262.10  fun specification_of thy = #spec o the_locale thy;
  262.11  
  262.12 @@ -464,8 +464,7 @@
  262.13  fun decl_attrib decl phi = Thm.declaration_attribute (K (decl phi));
  262.14  
  262.15  fun add_decls add loc decl =
  262.16 -  ProofContext.theory ((change_locale loc o apfst o apfst) (add (decl, stamp ())))
  262.17 -    #>
  262.18 +  ProofContext.theory ((change_locale loc o apfst o apfst) (add (decl, stamp ()))) #>
  262.19    add_thmss loc Thm.internalK
  262.20      [((Binding.empty, [Attrib.internal (decl_attrib decl)]), [([Drule.dummy_thm], [])])];
  262.21  
   263.1 --- a/src/Pure/Isar/method.ML	Wed Mar 04 10:43:39 2009 +0100
   263.2 +++ b/src/Pure/Isar/method.ML	Wed Mar 04 10:45:52 2009 +0100
   263.3 @@ -38,7 +38,7 @@
   263.4    val atomize: bool -> method
   263.5    val this: method
   263.6    val fact: thm list -> Proof.context -> method
   263.7 -  val assumption_tac: Proof.context -> int -> tactic
   263.8 +  val assm_tac: Proof.context -> int -> tactic
   263.9    val assumption: Proof.context -> method
  263.10    val close: bool -> Proof.context -> method
  263.11    val trace: Proof.context -> thm list -> unit
  263.12 @@ -49,7 +49,6 @@
  263.13    val erule: int -> thm list -> method
  263.14    val drule: int -> thm list -> method
  263.15    val frule: int -> thm list -> method
  263.16 -  val iprover_tac: Proof.context -> int option -> int -> tactic
  263.17    val set_tactic: (thm list -> tactic) -> Proof.context -> Proof.context
  263.18    val tactic: string * Position.T -> Proof.context -> method
  263.19    val raw_tactic: string * Position.T -> Proof.context -> method
  263.20 @@ -225,20 +224,20 @@
  263.21  
  263.22  in
  263.23  
  263.24 -fun assumption_tac ctxt =
  263.25 +fun assm_tac ctxt =
  263.26    assume_tac APPEND'
  263.27    Goal.assume_rule_tac ctxt APPEND'
  263.28    cond_rtac (can Logic.dest_equals) Drule.reflexive_thm APPEND'
  263.29    cond_rtac (can Logic.dest_term) Drule.termI;
  263.30  
  263.31  fun assumption ctxt = METHOD (HEADGOAL o
  263.32 -  (fn [] => assumption_tac ctxt
  263.33 +  (fn [] => assm_tac ctxt
  263.34      | [fact] => solve_tac [fact]
  263.35      | _ => K no_tac));
  263.36  
  263.37  fun close immed ctxt = METHOD (K
  263.38    (FILTER Thm.no_prems
  263.39 -    ((if immed then ALLGOALS (assumption_tac ctxt) else all_tac) THEN flexflex_tac)));
  263.40 +    ((if immed then ALLGOALS (assm_tac ctxt) else all_tac) THEN flexflex_tac)));
  263.41  
  263.42  end;
  263.43  
  263.44 @@ -296,55 +295,6 @@
  263.45      THEN Tactic.distinct_subgoals_tac;
  263.46  
  263.47  
  263.48 -(* iprover -- intuitionistic proof search *)
  263.49 -
  263.50 -local
  263.51 -
  263.52 -val remdups_tac = SUBGOAL (fn (g, i) =>
  263.53 -  let val prems = Logic.strip_assums_hyp g in
  263.54 -    REPEAT_DETERM_N (length prems - length (distinct op aconv prems))
  263.55 -    (Tactic.ematch_tac [Drule.remdups_rl] i THEN Tactic.eq_assume_tac i)
  263.56 -  end);
  263.57 -
  263.58 -fun REMDUPS tac = tac THEN_ALL_NEW remdups_tac;
  263.59 -
  263.60 -val bires_tac = Tactic.biresolution_from_nets_tac ContextRules.orderlist;
  263.61 -
  263.62 -fun safe_step_tac ctxt =
  263.63 -  ContextRules.Swrap ctxt
  263.64 -   (eq_assume_tac ORELSE'
  263.65 -    bires_tac true (ContextRules.netpair_bang ctxt));
  263.66 -
  263.67 -fun unsafe_step_tac ctxt =
  263.68 -  ContextRules.wrap ctxt
  263.69 -   (assume_tac APPEND'
  263.70 -    bires_tac false (ContextRules.netpair_bang ctxt) APPEND'
  263.71 -    bires_tac false (ContextRules.netpair ctxt));
  263.72 -
  263.73 -fun step_tac ctxt i =
  263.74 -  REPEAT_DETERM1 (REMDUPS (safe_step_tac ctxt) i) ORELSE
  263.75 -  REMDUPS (unsafe_step_tac ctxt) i;
  263.76 -
  263.77 -fun intprover_tac ctxt gs d lim = SUBGOAL (fn (g, i) => if d > lim then no_tac else
  263.78 -  let
  263.79 -    val ps = Logic.strip_assums_hyp g;
  263.80 -    val c = Logic.strip_assums_concl g;
  263.81 -  in
  263.82 -    if member (fn ((ps1, c1), (ps2, c2)) =>
  263.83 -        c1 aconv c2 andalso
  263.84 -        length ps1 = length ps2 andalso
  263.85 -        gen_eq_set (op aconv) (ps1, ps2)) gs (ps, c) then no_tac
  263.86 -    else (step_tac ctxt THEN_ALL_NEW intprover_tac ctxt ((ps, c) :: gs) (d + 1) lim) i
  263.87 -  end);
  263.88 -
  263.89 -in
  263.90 -
  263.91 -fun iprover_tac ctxt opt_lim =
  263.92 -  SELECT_GOAL (DEEPEN (2, the_default 20 opt_lim) (intprover_tac ctxt [] 0) 4 1);
  263.93 -
  263.94 -end;
  263.95 -
  263.96 -
  263.97  (* ML tactics *)
  263.98  
  263.99  structure TacticData = ProofDataFun
 263.100 @@ -486,7 +436,7 @@
 263.101  local
 263.102  
 263.103  fun thms ss = Scan.repeat (Scan.unless (Scan.lift (Scan.first ss)) Attrib.multi_thm) >> flat;
 263.104 -fun app (f, att) (context, ths) = foldl_map att (Context.map_proof f context, ths);
 263.105 +fun app (f, att) (context, ths) = Library.foldl_map att (Context.map_proof f context, ths);
 263.106  
 263.107  fun section ss = Scan.depend (fn context => (Scan.first ss -- Scan.pass context (thms ss)) :|--
 263.108    (fn (m, ths) => Scan.succeed (app m (context, ths))));
 263.109 @@ -511,39 +461,6 @@
 263.110  end;
 263.111  
 263.112  
 263.113 -(* iprover syntax *)
 263.114 -
 263.115 -local
 263.116 -
 263.117 -val introN = "intro";
 263.118 -val elimN = "elim";
 263.119 -val destN = "dest";
 263.120 -val ruleN = "rule";
 263.121 -
 263.122 -fun modifier name kind kind' att =
 263.123 -  Args.$$$ name |-- (kind >> K NONE || kind' |-- P.nat --| Args.colon >> SOME)
 263.124 -    >> (pair (I: Proof.context -> Proof.context) o att);
 263.125 -
 263.126 -val iprover_modifiers =
 263.127 - [modifier destN Args.bang_colon Args.bang ContextRules.dest_bang,
 263.128 -  modifier destN Args.colon (Scan.succeed ()) ContextRules.dest,
 263.129 -  modifier elimN Args.bang_colon Args.bang ContextRules.elim_bang,
 263.130 -  modifier elimN Args.colon (Scan.succeed ()) ContextRules.elim,
 263.131 -  modifier introN Args.bang_colon Args.bang ContextRules.intro_bang,
 263.132 -  modifier introN Args.colon (Scan.succeed ()) ContextRules.intro,
 263.133 -  Args.del -- Args.colon >> K (I, ContextRules.rule_del)];
 263.134 -
 263.135 -in
 263.136 -
 263.137 -val iprover_meth =
 263.138 -  bang_sectioned_args' iprover_modifiers (Scan.lift (Scan.option P.nat))
 263.139 -    (fn n => fn prems => fn ctxt => METHOD (fn facts =>
 263.140 -      HEADGOAL (insert_tac (prems @ facts) THEN'
 263.141 -      ObjectLogic.atomize_prems_tac THEN' iprover_tac ctxt n)));
 263.142 -
 263.143 -end;
 263.144 -
 263.145 -
 263.146  (* tactic syntax *)
 263.147  
 263.148  fun nat_thms_args f = uncurry f oo
 263.149 @@ -599,7 +516,6 @@
 263.150      ("fold", thms_ctxt_args fold_meth, "fold definitions"),
 263.151      ("atomize", (atomize o fst) oo syntax (Args.mode "full"),
 263.152        "present local premises as object-level statements"),
 263.153 -    ("iprover", iprover_meth, "intuitionistic proof search"),
 263.154      ("rule", thms_ctxt_args some_rule, "apply some intro/elim rule"),
 263.155      ("erule", nat_thms_args erule, "apply rule in elimination manner (improper)"),
 263.156      ("drule", nat_thms_args drule, "apply rule in destruct manner (improper)"),
   264.1 --- a/src/Pure/Isar/obtain.ML	Wed Mar 04 10:43:39 2009 +0100
   264.2 +++ b/src/Pure/Isar/obtain.ML	Wed Mar 04 10:45:52 2009 +0100
   264.3 @@ -40,11 +40,9 @@
   264.4  sig
   264.5    val thatN: string
   264.6    val obtain: string -> (binding * string option * mixfix) list ->
   264.7 -    (Attrib.binding * (string * string list) list) list ->
   264.8 -    bool -> Proof.state -> Proof.state
   264.9 +    (Attrib.binding * (string * string list) list) list -> bool -> Proof.state -> Proof.state
  264.10    val obtain_i: string -> (binding * typ option * mixfix) list ->
  264.11 -    ((binding * attribute list) * (term * term list) list) list ->
  264.12 -    bool -> Proof.state -> Proof.state
  264.13 +    (Thm.binding * (term * term list) list) list -> bool -> Proof.state -> Proof.state
  264.14    val result: (Proof.context -> tactic) -> thm list -> Proof.context ->
  264.15      (cterm list * thm list) * Proof.context
  264.16    val guess: (binding * string option * mixfix) list -> bool -> Proof.state -> Proof.state
  264.17 @@ -121,7 +119,7 @@
  264.18      (*obtain vars*)
  264.19      val (vars, vars_ctxt) = prep_vars raw_vars ctxt;
  264.20      val (_, fix_ctxt) = vars_ctxt |> ProofContext.add_fixes_i vars;
  264.21 -    val xs = map (Binding.base_name o #1) vars;
  264.22 +    val xs = map (Binding.name_of o #1) vars;
  264.23  
  264.24      (*obtain asms*)
  264.25      val (asms_ctxt, proppss) = prep_propp (fix_ctxt, map snd raw_asms);
  264.26 @@ -155,14 +153,14 @@
  264.27    in
  264.28      state
  264.29      |> Proof.enter_forward
  264.30 -    |> Proof.have_i NONE (K I) [((Binding.empty, []), [(obtain_prop, [])])] int
  264.31 +    |> Proof.have_i NONE (K I) [(Thm.empty_binding, [(obtain_prop, [])])] int
  264.32      |> Proof.proof (SOME Method.succeed_text) |> Seq.hd
  264.33      |> Proof.fix_i [(Binding.name thesisN, NONE, NoSyn)]
  264.34      |> Proof.assume_i
  264.35        [((Binding.name that_name, [ContextRules.intro_query NONE]), [(that_prop, [])])]
  264.36      |> `Proof.the_facts
  264.37      ||> Proof.chain_facts chain_facts
  264.38 -    ||> Proof.show_i NONE after_qed [((Binding.empty, []), [(thesis, [])])] false
  264.39 +    ||> Proof.show_i NONE after_qed [(Thm.empty_binding, [(thesis, [])])] false
  264.40      |-> Proof.refine_insert
  264.41    end;
  264.42  
  264.43 @@ -260,7 +258,7 @@
  264.44  
  264.45  fun inferred_type (binding, _, mx) ctxt =
  264.46    let
  264.47 -    val x = Binding.base_name binding;
  264.48 +    val x = Binding.name_of binding;
  264.49      val (T, ctxt') = ProofContext.inferred_param x ctxt
  264.50    in ((x, T, mx), ctxt') end;
  264.51  
  264.52 @@ -295,7 +293,7 @@
  264.53          |> Proof.map_context (K ctxt')
  264.54          |> Proof.fix_i (map (fn ((x, T), mx) => (Binding.name x, SOME T, mx)) parms)
  264.55          |> `Proof.context_of |-> (fn fix_ctxt => Proof.assm_i
  264.56 -          (obtain_export fix_ctxt rule (map cert ts)) [((Binding.empty, []), asms)])
  264.57 +          (obtain_export fix_ctxt rule (map cert ts)) [(Thm.empty_binding, asms)])
  264.58          |> Proof.add_binds_i AutoBind.no_facts
  264.59        end;
  264.60  
  264.61 @@ -313,7 +311,7 @@
  264.62      |> Proof.fix_i [(Binding.name AutoBind.thesisN, NONE, NoSyn)]
  264.63      |> Proof.chain_facts chain_facts
  264.64      |> Proof.local_goal print_result (K I) (apsnd (rpair I))
  264.65 -      "guess" before_qed after_qed [((Binding.empty, []), [Logic.mk_term goal, goal])]
  264.66 +      "guess" before_qed after_qed [(Thm.empty_binding, [Logic.mk_term goal, goal])]
  264.67      |> Proof.refine (Method.primitive_text (K (Goal.init (cert thesis)))) |> Seq.hd
  264.68    end;
  264.69  
   265.1 --- a/src/Pure/Isar/outer_parse.ML	Wed Mar 04 10:43:39 2009 +0100
   265.2 +++ b/src/Pure/Isar/outer_parse.ML	Wed Mar 04 10:45:52 2009 +0100
   265.3 @@ -228,7 +228,7 @@
   265.4  (* names and text *)
   265.5  
   265.6  val name = group "name declaration" (short_ident || sym_ident || string || number);
   265.7 -val binding = position name >> Binding.name_pos;
   265.8 +val binding = position name >> Binding.make;
   265.9  val xname = group "name reference" (short_ident || long_ident || sym_ident || string || number);
  265.10  val text = group "text" (short_ident || long_ident || sym_ident || string || number || verbatim);
  265.11  val path = group "file name/path specification" name >> Path.explode;
   266.1 --- a/src/Pure/Isar/proof.ML	Wed Mar 04 10:43:39 2009 +0100
   266.2 +++ b/src/Pure/Isar/proof.ML	Wed Mar 04 10:45:52 2009 +0100
   266.3 @@ -48,23 +48,18 @@
   266.4    val assm: Assumption.export ->
   266.5      (Attrib.binding * (string * string list) list) list -> state -> state
   266.6    val assm_i: Assumption.export ->
   266.7 -    ((binding * attribute list) * (term * term list) list) list -> state -> state
   266.8 +    (Thm.binding * (term * term list) list) list -> state -> state
   266.9    val assume: (Attrib.binding * (string * string list) list) list -> state -> state
  266.10 -  val assume_i: ((binding * attribute list) * (term * term list) list) list ->
  266.11 -    state -> state
  266.12 +  val assume_i: (Thm.binding * (term * term list) list) list -> state -> state
  266.13    val presume: (Attrib.binding * (string * string list) list) list -> state -> state
  266.14 -  val presume_i: ((binding * attribute list) * (term * term list) list) list ->
  266.15 -    state -> state
  266.16 -  val def: (Attrib.binding * ((binding * mixfix) * (string * string list))) list ->
  266.17 -    state -> state
  266.18 -  val def_i: ((binding * attribute list) *
  266.19 -    ((binding * mixfix) * (term * term list))) list -> state -> state
  266.20 +  val presume_i: (Thm.binding * (term * term list) list) list -> state -> state
  266.21 +  val def: (Attrib.binding * ((binding * mixfix) * (string * string list))) list -> state -> state
  266.22 +  val def_i: (Thm.binding * ((binding * mixfix) * (term * term list))) list -> state -> state
  266.23    val chain: state -> state
  266.24    val chain_facts: thm list -> state -> state
  266.25    val get_thmss: state -> (Facts.ref * Attrib.src list) list -> thm list
  266.26    val note_thmss: (Attrib.binding * (Facts.ref * Attrib.src list) list) list -> state -> state
  266.27 -  val note_thmss_i: ((binding * attribute list) *
  266.28 -    (thm list * attribute list) list) list -> state -> state
  266.29 +  val note_thmss_i: (Thm.binding * (thm list * attribute list) list) list -> state -> state
  266.30    val from_thmss: ((Facts.ref * Attrib.src list) list) list -> state -> state
  266.31    val from_thmss_i: ((thm list * attribute list) list) list -> state -> state
  266.32    val with_thmss: ((Facts.ref * Attrib.src list) list) list -> state -> state
  266.33 @@ -107,11 +102,11 @@
  266.34    val have: Method.text option -> (thm list list -> state -> state) ->
  266.35      (Attrib.binding * (string * string list) list) list -> bool -> state -> state
  266.36    val have_i: Method.text option -> (thm list list -> state -> state) ->
  266.37 -    ((binding * attribute list) * (term * term list) list) list -> bool -> state -> state
  266.38 +    (Thm.binding * (term * term list) list) list -> bool -> state -> state
  266.39    val show: Method.text option -> (thm list list -> state -> state) ->
  266.40      (Attrib.binding * (string * string list) list) list -> bool -> state -> state
  266.41    val show_i: Method.text option -> (thm list list -> state -> state) ->
  266.42 -    ((binding * attribute list) * (term * term list) list) list -> bool -> state -> state
  266.43 +    (Thm.binding * (term * term list) list) list -> bool -> state -> state
  266.44    val schematic_goal: state -> bool
  266.45    val is_relevant: state -> bool
  266.46    val local_future_proof: (state -> ('a * state) Future.future) ->
   267.1 --- a/src/Pure/Isar/proof_context.ML	Wed Mar 04 10:43:39 2009 +0100
   267.2 +++ b/src/Pure/Isar/proof_context.ML	Wed Mar 04 10:45:52 2009 +0100
   267.3 @@ -103,12 +103,10 @@
   267.4    val sticky_prefix: string -> Proof.context -> Proof.context
   267.5    val restore_naming: Proof.context -> Proof.context -> Proof.context
   267.6    val reset_naming: Proof.context -> Proof.context
   267.7 -  val note_thmss: string ->
   267.8 -    ((binding * attribute list) * (Facts.ref * attribute list) list) list ->
   267.9 -      Proof.context -> (string * thm list) list * Proof.context
  267.10 -  val note_thmss_i: string ->
  267.11 -    ((binding * attribute list) * (thm list * attribute list) list) list ->
  267.12 -      Proof.context -> (string * thm list) list * Proof.context
  267.13 +  val note_thmss: string -> (Thm.binding * (Facts.ref * attribute list) list) list ->
  267.14 +    Proof.context -> (string * thm list) list * Proof.context
  267.15 +  val note_thmss_i: string -> (Thm.binding * (thm list * attribute list) list) list ->
  267.16 +    Proof.context -> (string * thm list) list * Proof.context
  267.17    val put_thms: bool -> string * thm list option -> Proof.context -> Proof.context
  267.18    val read_vars: (binding * string option * mixfix) list -> Proof.context ->
  267.19      (binding * typ option * mixfix) list * Proof.context
  267.20 @@ -121,10 +119,10 @@
  267.21    val auto_fixes: Proof.context * (term list list * 'a) -> Proof.context * (term list list * 'a)
  267.22    val bind_fixes: string list -> Proof.context -> (term -> term) * Proof.context
  267.23    val add_assms: Assumption.export ->
  267.24 -    ((binding * attribute list) * (string * string list) list) list ->
  267.25 +    (Thm.binding * (string * string list) list) list ->
  267.26      Proof.context -> (string * thm list) list * Proof.context
  267.27    val add_assms_i: Assumption.export ->
  267.28 -    ((binding * attribute list) * (term * term list) list) list ->
  267.29 +    (Thm.binding * (term * term list) list) list ->
  267.30      Proof.context -> (string * thm list) list * Proof.context
  267.31    val add_cases: bool -> (string * RuleCases.T option) list -> Proof.context -> Proof.context
  267.32    val apply_case: RuleCases.T -> Proof.context -> (string * term list) list * Proof.context
  267.33 @@ -975,7 +973,7 @@
  267.34  
  267.35      val facts = PureThy.name_thmss false pos name (map (apfst (get ctxt)) raw_facts);
  267.36      fun app (th, attrs) x =
  267.37 -      swap (foldl_map (Thm.proof_attributes (surround (Thm.kind k) (attrs @ more_attrs))) (x, th));
  267.38 +      swap (Library.foldl_map (Thm.proof_attributes (surround (Thm.kind k) (attrs @ more_attrs))) (x, th));
  267.39      val (res, ctxt') = fold_map app facts ctxt;
  267.40      val thms = PureThy.name_thms false false pos name (flat res);
  267.41      val Mode {stmt, ...} = get_mode ctxt;
  267.42 @@ -1010,7 +1008,7 @@
  267.43  fun prep_vars prep_typ internal =
  267.44    fold_map (fn (raw_b, raw_T, raw_mx) => fn ctxt =>
  267.45      let
  267.46 -      val raw_x = Binding.base_name raw_b;
  267.47 +      val raw_x = Binding.name_of raw_b;
  267.48        val (x, mx) = Syntax.const_mixfix raw_x raw_mx;
  267.49        val _ = Syntax.is_identifier (no_skolem internal x) orelse
  267.50          error ("Illegal variable name: " ^ quote x);
  267.51 @@ -1019,7 +1017,7 @@
  267.52          if internal then T
  267.53          else Type.no_tvars T handle TYPE (msg, _, _) => error msg;
  267.54        val opt_T = Option.map (cond_tvars o cert_typ ctxt o prep_typ ctxt) raw_T;
  267.55 -      val var = (Binding.map_base (K x) raw_b, opt_T, mx);
  267.56 +      val var = (Binding.map_name (K x) raw_b, opt_T, mx);
  267.57      in (var, ctxt |> declare_var (x, opt_T, mx) |> #2) end);
  267.58  
  267.59  in
  267.60 @@ -1093,7 +1091,7 @@
  267.61  fun add_abbrev mode tags (b, raw_t) ctxt =
  267.62    let
  267.63      val t0 = cert_term (ctxt |> set_mode mode_abbrev) raw_t
  267.64 -      handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.display b));
  267.65 +      handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b));
  267.66      val [t] = Variable.exportT_terms (Variable.declare_term t0 ctxt) ctxt [t0];
  267.67      val ((lhs, rhs), consts') = consts_of ctxt
  267.68        |> Consts.abbreviate (Syntax.pp ctxt) (tsig_of ctxt) (naming_of ctxt) mode tags (b, t);
  267.69 @@ -1120,7 +1118,7 @@
  267.70  fun gen_fixes prep raw_vars ctxt =
  267.71    let
  267.72      val (vars, _) = prep raw_vars ctxt;
  267.73 -    val (xs', ctxt') = Variable.add_fixes (map (Binding.base_name o #1) vars) ctxt;
  267.74 +    val (xs', ctxt') = Variable.add_fixes (map (Binding.name_of o #1) vars) ctxt;
  267.75      val ctxt'' =
  267.76        ctxt'
  267.77        |> fold_map declare_var (map2 (fn x' => fn (_, T, mx) => (x', T, mx)) xs' vars)
   268.1 --- a/src/Pure/Isar/specification.ML	Wed Mar 04 10:43:39 2009 +0100
   268.2 +++ b/src/Pure/Isar/specification.ML	Wed Mar 04 10:45:52 2009 +0100
   268.3 @@ -140,7 +140,7 @@
   268.4  fun gen_axioms do_print prep raw_vars raw_specs thy =
   268.5    let
   268.6      val ((vars, specs), _) = prep raw_vars [raw_specs] (ProofContext.init thy);
   268.7 -    val xs = map (fn ((b, T), _) => (Binding.base_name b, T)) vars;
   268.8 +    val xs = map (fn ((b, T), _) => (Binding.name_of b, T)) vars;
   268.9  
  268.10      (*consts*)
  268.11      val (consts, consts_thy) = thy |> fold_map (Theory.specify_const []) vars;
  268.12 @@ -148,8 +148,8 @@
  268.13  
  268.14      (*axioms*)
  268.15      val (axioms, axioms_thy) = consts_thy |> fold_map (fn ((b, atts), props) =>
  268.16 -        fold_map Thm.add_axiom
  268.17 -          ((map o apfst) Binding.name (PureThy.name_multi (Binding.base_name b) (map subst props)))
  268.18 +        fold_map Thm.add_axiom  (* FIXME proper use of binding!? *)
  268.19 +          ((map o apfst) Binding.name (PureThy.name_multi (Binding.name_of b) (map subst props)))
  268.20          #>> (fn ths => ((b, atts), [(map Drule.standard' ths, [])]))) specs;
  268.21      val (facts, thy') = axioms_thy |> PureThy.note_thmss Thm.axiomK
  268.22        (Attrib.map_facts (Attrib.attribute_i axioms_thy) axioms);
  268.23 @@ -169,19 +169,19 @@
  268.24      val (vars, [((raw_name, atts), [prop])]) =
  268.25        fst (prep (the_list raw_var) [(raw_a, [raw_prop])] lthy);
  268.26      val (((x, T), rhs), prove) = LocalDefs.derived_def lthy true prop;
  268.27 -    val name = Binding.map_base (Thm.def_name_optional x) raw_name;
  268.28 +    val name = Binding.map_name (Thm.def_name_optional x) raw_name;
  268.29      val var =
  268.30        (case vars of
  268.31          [] => (Binding.name x, NoSyn)
  268.32        | [((b, _), mx)] =>
  268.33            let
  268.34 -            val y = Binding.base_name b;
  268.35 +            val y = Binding.name_of b;
  268.36              val _ = x = y orelse
  268.37                error ("Head of definition " ^ quote x ^ " differs from declaration " ^ quote y ^
  268.38                  Position.str_of (Binding.pos_of b));
  268.39            in (b, mx) end);
  268.40      val ((lhs, (_, th)), lthy2) = lthy |> LocalTheory.define Thm.definitionK
  268.41 -        (var, ((Binding.map_base (suffix "_raw") name, []), rhs));
  268.42 +        (var, ((Binding.map_name (suffix "_raw") name, []), rhs));
  268.43      val ((def_name, [th']), lthy3) = lthy2 |> LocalTheory.note Thm.definitionK
  268.44          ((name, Code.add_default_eqn_attrib :: atts), [prove lthy2 th]);
  268.45  
  268.46 @@ -208,7 +208,7 @@
  268.47          [] => (Binding.name x, NoSyn)
  268.48        | [((b, _), mx)] =>
  268.49            let
  268.50 -            val y = Binding.base_name b;
  268.51 +            val y = Binding.name_of b;
  268.52              val _ = x = y orelse
  268.53                error ("Head of abbreviation " ^ quote x ^ " differs from declaration " ^ quote y ^
  268.54                  Position.str_of (Binding.pos_of b));
  268.55 @@ -269,11 +269,10 @@
  268.56    | Element.Obtains obtains =>
  268.57        let
  268.58          val case_names = obtains |> map_index (fn (i, (b, _)) =>
  268.59 -          let val name = Binding.base_name b
  268.60 -          in if name = "" then string_of_int (i + 1) else name end);
  268.61 +          if Binding.is_empty b then string_of_int (i + 1) else Binding.name_of b);
  268.62          val constraints = obtains |> map (fn (_, (vars, _)) =>
  268.63            Element.Constrains
  268.64 -            (vars |> map_filter (fn (x, SOME T) => SOME (Binding.base_name x, T) | _ => NONE)));
  268.65 +            (vars |> map_filter (fn (x, SOME T) => SOME (Binding.name_of x, T) | _ => NONE)));
  268.66  
  268.67          val raw_propp = obtains |> map (fn (_, (_, props)) => map (rpair []) props);
  268.68          val (propp, elems_ctxt) = prep_stmt (elems @ constraints) raw_propp ctxt;
  268.69 @@ -283,7 +282,7 @@
  268.70          fun assume_case ((name, (vars, _)), asms) ctxt' =
  268.71            let
  268.72              val bs = map fst vars;
  268.73 -            val xs = map Binding.base_name bs;
  268.74 +            val xs = map Binding.name_of bs;
  268.75              val props = map fst asms;
  268.76              val (Ts, _) = ctxt'
  268.77                |> fold Variable.declare_term props
   269.1 --- a/src/Pure/Isar/theory_target.ML	Wed Mar 04 10:43:39 2009 +0100
   269.2 +++ b/src/Pure/Isar/theory_target.ML	Wed Mar 04 10:45:52 2009 +0100
   269.3 @@ -13,7 +13,7 @@
   269.4    val begin: string -> Proof.context -> local_theory
   269.5    val context: xstring -> theory -> local_theory
   269.6    val instantiation: string list * (string * sort) list * sort -> theory -> local_theory
   269.7 -  val instantiation_cmd: xstring list * sort * xstring -> theory -> local_theory
   269.8 +  val instantiation_cmd: xstring list * xstring list * xstring -> theory -> local_theory
   269.9    val overloading: (string * (string * typ) * bool) list -> theory -> local_theory
  269.10    val overloading_cmd: (string * string * bool) list -> theory -> local_theory
  269.11  end;
  269.12 @@ -188,8 +188,8 @@
  269.13      val arg = (b', Term.close_schematic_term rhs');
  269.14      val similar_body = Type.similar_types (rhs, rhs');
  269.15      (* FIXME workaround based on educated guess *)
  269.16 -    val (prefix', _) = Binding.dest b';
  269.17 -    val class_global = Binding.base_name b = Binding.base_name b'
  269.18 +    val (prefix', _, _) = Binding.dest b';
  269.19 +    val class_global = Binding.name_of b = Binding.name_of b'
  269.20        andalso not (null prefix')
  269.21        andalso (fst o snd o split_last) prefix' = Class_Target.class_prefix target;
  269.22    in
  269.23 @@ -206,14 +206,15 @@
  269.24               Morphism.form (ProofContext.target_notation true prmode [(lhs', mx)]))))
  269.25    end;
  269.26  
  269.27 +fun syntax_error c = error ("Illegal mixfix syntax for overloaded constant " ^ quote c);
  269.28 +
  269.29  fun declare_const (ta as Target {target, is_locale, is_class, ...}) depends ((b, T), mx) lthy =
  269.30    let
  269.31 -    val c = Binding.base_name b;
  269.32 +    val c = Binding.name_of b;
  269.33      val tags = LocalTheory.group_position_of lthy;
  269.34      val xs = filter depends (#1 (ProofContext.inferred_fixes (LocalTheory.target_of lthy)));
  269.35      val U = map #2 xs ---> T;
  269.36      val (mx1, mx2, mx3) = fork_mixfix ta mx;
  269.37 -    fun syntax_error c = error ("Illegal mixfix syntax for overloaded constant " ^ quote c);
  269.38      val declare_const =
  269.39        (case Class_Target.instantiation_param lthy c of
  269.40          SOME c' =>
  269.41 @@ -241,7 +242,7 @@
  269.42  
  269.43  fun abbrev (ta as Target {target, is_locale, is_class, ...}) prmode ((b, mx), t) lthy =
  269.44    let
  269.45 -    val c = Binding.base_name b;
  269.46 +    val c = Binding.name_of b;
  269.47      val tags = LocalTheory.group_position_of lthy;
  269.48      val thy_ctxt = ProofContext.init (ProofContext.theory_of lthy);
  269.49      val target_ctxt = LocalTheory.target_of lthy;
  269.50 @@ -278,8 +279,8 @@
  269.51      val thy = ProofContext.theory_of lthy;
  269.52      val thy_ctxt = ProofContext.init thy;
  269.53  
  269.54 -    val c = Binding.base_name b;
  269.55 -    val name' = Binding.map_base (Thm.def_name_optional c) name;
  269.56 +    val c = Binding.name_of b;
  269.57 +    val name' = Binding.map_name (Thm.def_name_optional c) name;
  269.58      val (rhs', rhs_conv) =
  269.59        LocalDefs.export_cterm lthy thy_ctxt (Thm.cterm_of thy rhs) |>> Thm.term_of;
  269.60      val xs = Variable.add_fixed (LocalTheory.target_of lthy) rhs' [];
  269.61 @@ -299,7 +300,7 @@
  269.62            then (fn name => fn eq => Thm.add_def false false (Binding.name name, Logic.mk_equals eq))
  269.63            else (fn name => fn (Const (c, _), rhs) => AxClass.define_overloaded name (c, rhs)));
  269.64      val (global_def, lthy3) = lthy2
  269.65 -      |> LocalTheory.theory_result (define_const (Binding.base_name name') (lhs', rhs'));
  269.66 +      |> LocalTheory.theory_result (define_const (Binding.name_of name') (lhs', rhs'));
  269.67      val def = LocalDefs.trans_terms lthy3
  269.68        [(*c == global.c xs*)     local_def,
  269.69         (*global.c xs == rhs'*)  global_def,
   270.1 --- a/src/Pure/ML-Systems/mosml.ML	Wed Mar 04 10:43:39 2009 +0100
   270.2 +++ b/src/Pure/ML-Systems/mosml.ML	Wed Mar 04 10:45:52 2009 +0100
   270.3 @@ -141,19 +141,19 @@
   270.4  load "Timer";
   270.5  
   270.6  fun start_timing () =
   270.7 -  let val CPUtimer = Timer.startCPUTimer();
   270.8 -      val time = Timer.checkCPUTimer(CPUtimer)
   270.9 -  in  (CPUtimer,time)  end;
  270.10 +  let
  270.11 +    val timer = Timer.startCPUTimer ();
  270.12 +    val time = Timer.checkCPUTimer timer;
  270.13 +  in (timer, time) end;
  270.14  
  270.15 -fun end_timing (CPUtimer, {gc,sys,usr}) =
  270.16 -  let open Time  (*...for Time.toString, Time.+ and Time.- *)
  270.17 -      val {gc=gc2,sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
  270.18 -  in  "User " ^ toString (usr2-usr) ^
  270.19 -      "  GC " ^ toString (gc2-gc) ^
  270.20 -      "  All "^ toString (sys2-sys + usr2-usr + gc2-gc) ^
  270.21 -      " secs"
  270.22 -      handle Time => ""
  270.23 -  end;
  270.24 +fun end_timing (timer, {gc, sys, usr}) =
  270.25 +  let
  270.26 +    open Time;  (*...for Time.toString, Time.+ and Time.- *)
  270.27 +    val {gc = gc2, sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
  270.28 +    val user = usr2 - usr + gc2 - gc;
  270.29 +    val all = user + sys2 - sys;
  270.30 +    val message = "User " ^ toString user ^ "  All "^ toString all ^ " secs" handle Time => "";
  270.31 +  in {message = message, user = user, all = all} end;
  270.32  
  270.33  fun check_timer timer =
  270.34    let val {sys, usr, gc} = Timer.checkCPUTimer timer
   271.1 --- a/src/Pure/ML-Systems/polyml-experimental.ML	Wed Mar 04 10:43:39 2009 +0100
   271.2 +++ b/src/Pure/ML-Systems/polyml-experimental.ML	Wed Mar 04 10:45:52 2009 +0100
   271.3 @@ -49,16 +49,17 @@
   271.4        | c :: cs =>
   271.5            (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
   271.6      fun put s = out_buffer := s :: ! out_buffer;
   271.7 -    fun put_message (prt, is_err, {file, line, offset}) =
   271.8 -     (put (if is_err then "Error: " else "Warning: ");
   271.9 -      PolyML.prettyPrint (put, 76) prt;
  271.10 +    fun put_message {message, hard, location = {startLine = line, ...}, context} =
  271.11 +     (put (if hard then "Error: " else "Warning: ");
  271.12 +      PolyML.prettyPrint (put, 76) message;
  271.13        put (str_of_pos line name ^ "\n"));
  271.14  
  271.15      val parameters =
  271.16       [PolyML.Compiler.CPOutStream put,
  271.17        PolyML.Compiler.CPLineNo (fn () => ! current_line),
  271.18        PolyML.Compiler.CPErrorMessageProc put_message,
  271.19 -      PolyML.Compiler.CPNameSpace name_space];
  271.20 +      PolyML.Compiler.CPNameSpace name_space,
  271.21 +      PolyML.Compiler.CPPrintInAlphabeticalOrder false];
  271.22      val _ =
  271.23        (while not (List.null (! in_buffer)) do
  271.24          PolyML.compiler (get, parameters) ())
   272.1 --- a/src/Pure/ML-Systems/polyml_common.ML	Wed Mar 04 10:43:39 2009 +0100
   272.2 +++ b/src/Pure/ML-Systems/polyml_common.ML	Wed Mar 04 10:45:52 2009 +0100
   272.3 @@ -47,18 +47,19 @@
   272.4  (* compiler-independent timing functions *)
   272.5  
   272.6  fun start_timing () =
   272.7 -  let val CPUtimer = Timer.startCPUTimer();
   272.8 -      val time = Timer.checkCPUTimer(CPUtimer)
   272.9 -  in  (CPUtimer,time)  end;
  272.10 +  let
  272.11 +    val timer = Timer.startCPUTimer ();
  272.12 +    val time = Timer.checkCPUTimer timer;
  272.13 +  in (timer, time) end;
  272.14  
  272.15 -fun end_timing (CPUtimer, {sys,usr}) =
  272.16 -  let open Time  (*...for Time.toString, Time.+ and Time.- *)
  272.17 -      val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
  272.18 -  in  "User " ^ toString (usr2-usr) ^
  272.19 -      "  All "^ toString (sys2-sys + usr2-usr) ^
  272.20 -      " secs"
  272.21 -      handle Time => ""
  272.22 -  end;
  272.23 +fun end_timing (timer, {sys, usr}) =
  272.24 +  let
  272.25 +    open Time;  (*...for Time.toString, Time.+ and Time.- *)
  272.26 +    val {sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
  272.27 +    val user = usr2 - usr;
  272.28 +    val all = user + sys2 - sys;
  272.29 +    val message = "User " ^ toString user ^ "  All "^ toString all ^ " secs" handle Time => "";
  272.30 +  in {message = message, user = user, all = all} end;
  272.31  
  272.32  fun check_timer timer =
  272.33    let
   273.1 --- a/src/Pure/ML-Systems/smlnj.ML	Wed Mar 04 10:43:39 2009 +0100
   273.2 +++ b/src/Pure/ML-Systems/smlnj.ML	Wed Mar 04 10:45:52 2009 +0100
   273.3 @@ -59,18 +59,19 @@
   273.4  (* compiler-independent timing functions *)
   273.5  
   273.6  fun start_timing () =
   273.7 -  let val CPUtimer = Timer.startCPUTimer();
   273.8 -      val time = Timer.checkCPUTimer(CPUtimer)
   273.9 -  in  (CPUtimer,time)  end;
  273.10 +  let
  273.11 +    val timer = Timer.startCPUTimer ();
  273.12 +    val time = Timer.checkCPUTimer timer;
  273.13 +  in (timer, time) end;
  273.14  
  273.15 -fun end_timing (CPUtimer, {sys,usr}) =
  273.16 -  let open Time  (*...for Time.toString, Time.+ and Time.- *)
  273.17 -      val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
  273.18 -  in  "User " ^ toString (usr2-usr) ^
  273.19 -      "  All "^ toString (sys2-sys + usr2-usr) ^
  273.20 -      " secs"
  273.21 -      handle Time => ""
  273.22 -  end;
  273.23 +fun end_timing (timer, {sys, usr}) =
  273.24 +  let
  273.25 +    open Time;  (*...for Time.toString, Time.+ and Time.- *)
  273.26 +    val {sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
  273.27 +    val user = usr2 - usr;
  273.28 +    val all = user + sys2 - sys;
  273.29 +    val message = "User " ^ toString user ^ "  All "^ toString all ^ " secs" handle Time => "";
  273.30 +  in {message = message, user = user, all = all} end;
  273.31  
  273.32  fun check_timer timer =
  273.33    let
   274.1 --- a/src/Pure/ML/ml_antiquote.ML	Wed Mar 04 10:43:39 2009 +0100
   274.2 +++ b/src/Pure/ML/ml_antiquote.ML	Wed Mar 04 10:45:52 2009 +0100
   274.3 @@ -59,12 +59,13 @@
   274.4  
   274.5  
   274.6  
   274.7 -(** concrete antiquotations **)
   274.8 +(** misc antiquotations **)
   274.9  
  274.10  structure P = OuterParse;
  274.11  
  274.12 -
  274.13 -(* misc *)
  274.14 +val _ = inline "binding" (Scan.lift (P.position Args.name) >> (fn b =>
  274.15 +  ML_Syntax.atomic ("Binding.make " ^
  274.16 +    ML_Syntax.print_pair ML_Syntax.print_string ML_Syntax.print_position b)));
  274.17  
  274.18  val _ = value "theory"
  274.19    (Scan.lift Args.name >> (fn name => "ThyInfo.get_theory " ^ ML_Syntax.print_string name)
   275.1 --- a/src/Pure/ML/ml_syntax.ML	Wed Mar 04 10:43:39 2009 +0100
   275.2 +++ b/src/Pure/ML/ml_syntax.ML	Wed Mar 04 10:45:52 2009 +0100
   275.3 @@ -18,6 +18,8 @@
   275.4    val print_char: string -> string
   275.5    val print_string: string -> string
   275.6    val print_strings: string list -> string
   275.7 +  val print_properties: Properties.T -> string
   275.8 +  val print_position: Position.T -> string
   275.9    val print_indexname: indexname -> string
  275.10    val print_class: class -> string
  275.11    val print_sort: sort -> string
  275.12 @@ -68,6 +70,9 @@
  275.13  val print_string = quote o translate_string print_char;
  275.14  val print_strings = print_list print_string;
  275.15  
  275.16 +val print_properties = print_list (print_pair print_string print_string);
  275.17 +fun print_position pos = "Position.of_properties " ^ print_properties (Position.properties_of pos);
  275.18 +
  275.19  val print_indexname = print_pair print_string print_int;
  275.20  
  275.21  val print_class = print_string;
   276.1 --- a/src/Pure/Proof/proofchecker.ML	Wed Mar 04 10:43:39 2009 +0100
   276.2 +++ b/src/Pure/Proof/proofchecker.ML	Wed Mar 04 10:45:52 2009 +0100
   276.3 @@ -56,7 +56,7 @@
   276.4        | thm_of _ _ (PAxm (name, _, SOME Ts)) =
   276.5            thm_of_atom (Thm.axiom thy name) Ts
   276.6  
   276.7 -      | thm_of _ Hs (PBound i) = List.nth (Hs, i)
   276.8 +      | thm_of _ Hs (PBound i) = nth Hs i
   276.9  
  276.10        | thm_of (vs, names) Hs (Abst (s, SOME T, prf)) =
  276.11            let
   277.1 --- a/src/Pure/Proof/reconstruct.ML	Wed Mar 04 10:43:39 2009 +0100
   277.2 +++ b/src/Pure/Proof/reconstruct.ML	Wed Mar 04 10:45:52 2009 +0100
   277.3 @@ -98,7 +98,7 @@
   277.4            let val (env3, V) = mk_tvar (env2, [])
   277.5            in (t' $ u', V, vTs2, unifyT thy env3 T (U --> V)) end)
   277.6        end
   277.7 -  | infer_type thy env Ts vTs (t as Bound i) = ((t, List.nth (Ts, i), vTs, env)
   277.8 +  | infer_type thy env Ts vTs (t as Bound i) = ((t, nth Ts i, vTs, env)
   277.9        handle Subscript => error ("infer_type: bad variable index " ^ string_of_int i));
  277.10  
  277.11  fun cantunify thy (t, u) = error ("Non-unifiable terms:\n" ^
  277.12 @@ -106,7 +106,7 @@
  277.13  
  277.14  fun decompose thy Ts (env, p as (t, u)) =
  277.15    let fun rigrig (a, T) (b, U) uT ts us = if a <> b then cantunify thy p
  277.16 -    else apsnd flat (foldl_map (decompose thy Ts) (uT env T U, ts ~~ us))
  277.17 +    else apsnd flat (Library.foldl_map (decompose thy Ts) (uT env T U, ts ~~ us))
  277.18    in case pairself (strip_comb o Envir.head_norm env) p of
  277.19        ((Const c, ts), (Const d, us)) => rigrig c d (unifyT thy) ts us
  277.20      | ((Free c, ts), (Free d, us)) => rigrig c d (unifyT thy) ts us
  277.21 @@ -141,7 +141,7 @@
  277.22              val tvars = OldTerm.term_tvars prop;
  277.23              val tfrees = OldTerm.term_tfrees prop;
  277.24              val (env', Ts) = (case opTs of
  277.25 -                NONE => foldl_map mk_tvar (env, map snd tvars @ map snd tfrees)
  277.26 +                NONE => Library.foldl_map mk_tvar (env, map snd tvars @ map snd tfrees)
  277.27                | SOME Ts => (env, Ts));
  277.28              val prop' = subst_atomic_types (map TVar tvars @ map TFree tfrees ~~ Ts)
  277.29                (forall_intr_vfs prop) handle Library.UnequalLengths =>
  277.30 @@ -152,7 +152,7 @@
  277.31      fun head_norm (prop, prf, cnstrts, env, vTs) =
  277.32        (Envir.head_norm env prop, prf, cnstrts, env, vTs);
  277.33  
  277.34 -    fun mk_cnstrts env _ Hs vTs (PBound i) = ((List.nth (Hs, i), PBound i, [], env, vTs)
  277.35 +    fun mk_cnstrts env _ Hs vTs (PBound i) = ((nth Hs i, PBound i, [], env, vTs)
  277.36            handle Subscript => error ("mk_cnstrts: bad variable index " ^ string_of_int i))
  277.37        | mk_cnstrts env Ts Hs vTs (Abst (s, opT, cprf)) =
  277.38            let
  277.39 @@ -304,7 +304,7 @@
  277.40  
  277.41  val head_norm = Envir.head_norm (Envir.empty 0);
  277.42  
  277.43 -fun prop_of0 Hs (PBound i) = List.nth (Hs, i)
  277.44 +fun prop_of0 Hs (PBound i) = nth Hs i
  277.45    | prop_of0 Hs (Abst (s, SOME T, prf)) =
  277.46        Term.all T $ (Abs (s, T, prop_of0 Hs prf))
  277.47    | prop_of0 Hs (AbsP (s, SOME t, prf)) =
   278.1 --- a/src/Pure/ProofGeneral/README	Wed Mar 04 10:43:39 2009 +0100
   278.2 +++ b/src/Pure/ProofGeneral/README	Wed Mar 04 10:45:52 2009 +0100
   278.3 @@ -34,4 +34,4 @@
   278.4     http://proofgeneral.inf.ed.ac.uk/wiki/Main/PGIP
   278.5  
   278.6  David Aspinall, Dec. 2006.
   278.7 -$Id$
   278.8 +
   279.1 --- a/src/Pure/README	Wed Mar 04 10:43:39 2009 +0100
   279.2 +++ b/src/Pure/README	Wed Mar 04 10:45:52 2009 +0100
   279.3 @@ -19,5 +19,3 @@
   279.4  
   279.5  See ROOT.ML for further information.
   279.6  
   279.7 -
   279.8 -$Id$
   280.1 --- a/src/Pure/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   280.2 +++ b/src/Pure/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   280.3 @@ -81,12 +81,18 @@
   280.4  use "goal.ML";
   280.5  use "axclass.ML";
   280.6  
   280.7 -(*the main Isar system*)
   280.8 +(*main Isar stuff*)
   280.9  cd "Isar"; use "ROOT.ML"; cd "..";
  280.10  use "subgoal.ML";
  280.11  
  280.12  use "Proof/extraction.ML";
  280.13  
  280.14 +(*Isabelle/Isar system*)
  280.15 +use "System/session.ML";
  280.16 +use "System/isar.ML";
  280.17 +use "System/isabelle_process.ML";
  280.18 +
  280.19 +(*additional tools*)
  280.20  cd "Tools"; use "ROOT.ML"; cd "..";
  280.21  
  280.22  use "codegen.ML";
   281.1 --- a/src/Pure/Syntax/parser.ML	Wed Mar 04 10:43:39 2009 +0100
   281.2 +++ b/src/Pure/Syntax/parser.ML	Wed Mar 04 10:45:52 2009 +0100
   281.3 @@ -73,10 +73,10 @@
   281.4        val chain_from = case (pri, rhs) of (~1, [Nonterminal (id, ~1)]) => SOME id | _ => NONE;
   281.5  
   281.6        (*store chain if it does not already exist*)
   281.7 -      val (new_chain, chains') = case chain_from of NONE => (NONE, chains) | SOME from_ =>
   281.8 -        let val old_tos = these (AList.lookup (op =) chains from_) in
   281.9 +      val (new_chain, chains') = case chain_from of NONE => (NONE, chains) | SOME from =>
  281.10 +        let val old_tos = these (AList.lookup (op =) chains from) in
  281.11            if member (op =) old_tos lhs then (NONE, chains)
  281.12 -          else (SOME from_, AList.update (op =) (from_, insert (op =) lhs old_tos) chains)
  281.13 +          else (SOME from, AList.update (op =) (from, insert (op =) lhs old_tos) chains)
  281.14          end;
  281.15  
  281.16        (*propagate new chain in lookahead and lambda lists;
  281.17 @@ -410,7 +410,7 @@
  281.18  
  281.19      fun pretty_nt (name, tag) =
  281.20        let
  281.21 -        fun prod_of_chain from_ = ([Nonterminal (from_, ~1)], "", ~1);
  281.22 +        fun prod_of_chain from = ([Nonterminal (from, ~1)], "", ~1);
  281.23  
  281.24          val nt_prods =
  281.25            Library.foldl (gen_union op =) ([], map snd (snd (Array.sub (prods, tag)))) @
  281.26 @@ -552,8 +552,8 @@
  281.27            val to_tag = convert_tag to;
  281.28  
  281.29            fun make [] result = result
  281.30 -            | make (from_ :: froms) result = make froms ((to_tag,
  281.31 -                ([Nonterminal (convert_tag from_, ~1)], "", ~1)) :: result);
  281.32 +            | make (from :: froms) result = make froms ((to_tag,
  281.33 +                ([Nonterminal (convert_tag from, ~1)], "", ~1)) :: result);
  281.34          in mk_chain_prods cs (make froms [] @ result) end;
  281.35  
  281.36      val chain_prods = mk_chain_prods chains2 [];
   282.1 --- a/src/Pure/Syntax/syn_ext.ML	Wed Mar 04 10:43:39 2009 +0100
   282.2 +++ b/src/Pure/Syntax/syn_ext.ML	Wed Mar 04 10:45:52 2009 +0100
   282.3 @@ -26,7 +26,7 @@
   282.4    val logic: string
   282.5    val args: string
   282.6    val cargs: string
   282.7 -  val any_: string
   282.8 +  val any: string
   282.9    val sprop: string
  282.10    val typ_to_nonterm: typ -> string
  282.11    datatype xsymb =
  282.12 @@ -108,8 +108,8 @@
  282.13  val sprop = "#prop";
  282.14  val spropT = Type (sprop, []);
  282.15  
  282.16 -val any_ = "any";
  282.17 -val anyT = Type (any_, []);
  282.18 +val any = "any";
  282.19 +val anyT = Type (any, []);
  282.20  
  282.21  
  282.22  
  282.23 @@ -181,7 +181,7 @@
  282.24    | typ_to_nt default _ = default;
  282.25  
  282.26  (*get nonterminal for rhs*)
  282.27 -val typ_to_nonterm = typ_to_nt any_;
  282.28 +val typ_to_nonterm = typ_to_nt any;
  282.29  
  282.30  (*get nonterminal for lhs*)
  282.31  val typ_to_nonterm1 = typ_to_nt logic;
   283.1 --- a/src/Pure/Syntax/syn_trans.ML	Wed Mar 04 10:43:39 2009 +0100
   283.2 +++ b/src/Pure/Syntax/syn_trans.ML	Wed Mar 04 10:45:52 2009 +0100
   283.3 @@ -222,7 +222,7 @@
   283.4  (* implicit structures *)
   283.5  
   283.6  fun the_struct structs i =
   283.7 -  if 1 <= i andalso i <= length structs then List.nth (structs, i - 1)
   283.8 +  if 1 <= i andalso i <= length structs then nth structs (i - 1)
   283.9    else raise error ("Illegal reference to implicit structure #" ^ string_of_int i);
  283.10  
  283.11  fun struct_tr structs (*"_struct"*) [Const ("_indexdefault", _)] =
   284.1 --- a/src/Pure/Syntax/syntax.ML	Wed Mar 04 10:43:39 2009 +0100
   284.2 +++ b/src/Pure/Syntax/syntax.ML	Wed Mar 04 10:45:52 2009 +0100
   284.3 @@ -390,7 +390,7 @@
   284.4  val basic_nonterms =
   284.5    (Lexicon.terminals @ [SynExt.logic, "type", "types", "sort", "classes",
   284.6      SynExt.args, SynExt.cargs, "pttrn", "pttrns", "idt", "idts", "aprop",
   284.7 -    "asms", SynExt.any_, SynExt.sprop, "num_const", "float_const",
   284.8 +    "asms", SynExt.any, SynExt.sprop, "num_const", "float_const",
   284.9      "index", "struct"]);
  284.10  
  284.11  
   285.1 --- a/src/Pure/Thy/thy_output.ML	Wed Mar 04 10:43:39 2009 +0100
   285.2 +++ b/src/Pure/Thy/thy_output.ML	Wed Mar 04 10:45:52 2009 +0100
   285.3 @@ -519,9 +519,9 @@
   285.4  fun ml_type txt = "val _ = NONE : (" ^ txt ^ ") option;";
   285.5  fun ml_struct txt = "functor DUMMY_FUNCTOR() = struct structure DUMMY = " ^ txt ^ " end;"
   285.6  
   285.7 -fun output_ml ml src ctxt (txt, pos) =
   285.8 +fun output_ml ml _ ctxt (txt, pos) =
   285.9   (ML_Context.eval_in (SOME ctxt) false pos (ml txt);
  285.10 -  (if ! source then str_of_source src else SymbolPos.content (SymbolPos.explode (txt, pos)))
  285.11 +  SymbolPos.content (SymbolPos.explode (txt, pos))
  285.12    |> (if ! quotes then quote else I)
  285.13    |> (if ! display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
  285.14    else
   286.1 --- a/src/Pure/Tools/ROOT.ML	Wed Mar 04 10:43:39 2009 +0100
   286.2 +++ b/src/Pure/Tools/ROOT.ML	Wed Mar 04 10:45:52 2009 +0100
   286.3 @@ -4,11 +4,13 @@
   286.4  *)
   286.5  
   286.6  use "named_thms.ML";
   286.7 -use "isabelle_process.ML";
   286.8  
   286.9  (*basic XML support*)
  286.10  use "xml_syntax.ML";
  286.11  
  286.12 +use "find_theorems.ML";
  286.13 +use "find_consts.ML";
  286.14 +
  286.15  (*quickcheck/autosolve needed here because of pg preferences*)
  286.16  use "../../Tools/quickcheck.ML";
  286.17  use "../../Tools/auto_solve.ML";
   287.1 --- a/src/Pure/axclass.ML	Wed Mar 04 10:43:39 2009 +0100
   287.2 +++ b/src/Pure/axclass.ML	Wed Mar 04 10:45:52 2009 +0100
   287.3 @@ -8,7 +8,7 @@
   287.4  signature AX_CLASS =
   287.5  sig
   287.6    val define_class: bstring * class list -> string list ->
   287.7 -    ((binding * attribute list) * term list) list -> theory -> class * theory
   287.8 +    (Thm.binding * term list) list -> theory -> class * theory
   287.9    val add_classrel: thm -> theory -> theory
  287.10    val add_arity: thm -> theory -> theory
  287.11    val prove_classrel: class * class -> tactic -> theory -> theory
   288.1 --- a/src/Pure/conv.ML	Wed Mar 04 10:43:39 2009 +0100
   288.2 +++ b/src/Pure/conv.ML	Wed Mar 04 10:45:52 2009 +0100
   288.3 @@ -7,12 +7,17 @@
   288.4  infix 1 then_conv;
   288.5  infix 0 else_conv;
   288.6  
   288.7 +signature BASIC_CONV =
   288.8 +sig
   288.9 +  val then_conv: conv * conv -> conv
  288.10 +  val else_conv: conv * conv -> conv
  288.11 +end;
  288.12 +
  288.13  signature CONV =
  288.14  sig
  288.15 +  include BASIC_CONV
  288.16    val no_conv: conv
  288.17    val all_conv: conv
  288.18 -  val then_conv: conv * conv -> conv
  288.19 -  val else_conv: conv * conv -> conv
  288.20    val first_conv: conv list -> conv
  288.21    val every_conv: conv list -> conv
  288.22    val try_conv: conv -> conv
  288.23 @@ -171,3 +176,6 @@
  288.24    | NONE => raise THM ("gconv_rule", i, [th]));
  288.25  
  288.26  end;
  288.27 +
  288.28 +structure BasicConv: BASIC_CONV = Conv;
  288.29 +open BasicConv;
   289.1 --- a/src/Pure/display.ML	Wed Mar 04 10:43:39 2009 +0100
   289.2 +++ b/src/Pure/display.ML	Wed Mar 04 10:45:52 2009 +0100
   289.3 @@ -20,7 +20,6 @@
   289.4    val pretty_thm_aux: Pretty.pp -> bool -> bool -> term list -> thm -> Pretty.T
   289.5    val pretty_thm: thm -> Pretty.T
   289.6    val string_of_thm: thm -> string
   289.7 -  val pretty_fact: Facts.ref * thm -> Pretty.T
   289.8    val pretty_thms: thm list -> Pretty.T
   289.9    val pretty_thm_sg: theory -> thm -> Pretty.T
  289.10    val pretty_thms_sg: theory -> thm list -> Pretty.T
  289.11 @@ -93,10 +92,6 @@
  289.12  
  289.13  val string_of_thm = Pretty.string_of o pretty_thm;
  289.14  
  289.15 -fun pretty_fact (thmref, thm) = Pretty.block
  289.16 -  [Pretty.str (Facts.string_of_ref thmref), Pretty.str ":", Pretty.brk 1,
  289.17 -   pretty_thm thm];
  289.18 -
  289.19  fun pretty_thms [th] = pretty_thm th
  289.20    | pretty_thms ths = Pretty.block (Pretty.fbreaks (map pretty_thm ths));
  289.21  
   290.1 --- a/src/Pure/envir.ML	Wed Mar 04 10:43:39 2009 +0100
   290.2 +++ b/src/Pure/envir.ML	Wed Mar 04 10:45:52 2009 +0100
   290.3 @@ -265,7 +265,7 @@
   290.4        | fast Ts (Const (_, T)) = T
   290.5        | fast Ts (Free (_, T)) = T
   290.6        | fast Ts (Bound i) =
   290.7 -        (List.nth (Ts, i)
   290.8 +        (nth Ts i
   290.9           handle Subscript => raise TERM ("fastype: Bound", [Bound i]))
  290.10        | fast Ts (Var (_, T)) = T
  290.11        | fast Ts (Abs (_, T, u)) = T --> fast (T :: Ts) u
   291.1 --- a/src/Pure/library.ML	Wed Mar 04 10:43:39 2009 +0100
   291.2 +++ b/src/Pure/library.ML	Wed Mar 04 10:45:52 2009 +0100
   291.3 @@ -76,7 +76,6 @@
   291.4    val perhaps_loop: ('a -> 'a option) -> 'a -> 'a option
   291.5    val foldl1: ('a * 'a -> 'a) -> 'a list -> 'a
   291.6    val foldr1: ('a * 'a -> 'a) -> 'a list -> 'a
   291.7 -  val foldl_map: ('a * 'b -> 'a * 'c) -> 'a * 'b list -> 'a * 'c list
   291.8    val flat: 'a list list -> 'a list
   291.9    val unflat: 'a list list -> 'b list -> 'b list list
  291.10    val burrow: ('a list -> 'b list) -> 'a list list -> 'b list list
  291.11 @@ -238,6 +237,7 @@
  291.12    include BASIC_LIBRARY
  291.13    val foldl: ('a * 'b -> 'a) -> 'a * 'b list -> 'a
  291.14    val foldr: ('a * 'b -> 'b) -> 'a list * 'b -> 'b
  291.15 +  val foldl_map: ('a * 'b -> 'a * 'c) -> 'a * 'b list -> 'a * 'c list
  291.16    val take: int * 'a list -> 'a list
  291.17    val drop: int * 'a list -> 'a list
  291.18    val last_elem: 'a list -> 'a
   292.1 --- a/src/Pure/mk	Wed Mar 04 10:43:39 2009 +0100
   292.2 +++ b/src/Pure/mk	Wed Mar 04 10:45:52 2009 +0100
   292.3 @@ -1,6 +1,5 @@
   292.4  #!/usr/bin/env bash
   292.5  #
   292.6 -# $Id$
   292.7  # Author: Markus Wenzel, TU Muenchen
   292.8  #
   292.9  # mk - build Pure Isabelle.
   293.1 --- a/src/Pure/more_thm.ML	Wed Mar 04 10:43:39 2009 +0100
   293.2 +++ b/src/Pure/more_thm.ML	Wed Mar 04 10:45:52 2009 +0100
   293.3 @@ -40,6 +40,8 @@
   293.4    val close_derivation: thm -> thm
   293.5    val add_axiom: binding * term -> theory -> thm * theory
   293.6    val add_def: bool -> bool -> binding * term -> theory -> thm * theory
   293.7 +  type binding = binding * attribute list
   293.8 +  val empty_binding: binding
   293.9    val rule_attribute: (Context.generic -> thm -> thm) -> attribute
  293.10    val declaration_attribute: (thm -> Context.generic -> Context.generic) -> attribute
  293.11    val theory_attributes: attribute list -> theory * thm -> theory * thm
  293.12 @@ -301,6 +303,9 @@
  293.13  
  293.14  (** attributes **)
  293.15  
  293.16 +type binding = binding * attribute list;
  293.17 +val empty_binding: binding = (Binding.empty, []);
  293.18 +
  293.19  fun rule_attribute f (x, th) = (x, f x th);
  293.20  fun declaration_attribute f (x, th) = (f th x, th);
  293.21  
   294.1 --- a/src/Pure/proofterm.ML	Wed Mar 04 10:43:39 2009 +0100
   294.2 +++ b/src/Pure/proofterm.ML	Wed Mar 04 10:45:52 2009 +0100
   294.3 @@ -470,8 +470,8 @@
   294.4      val n = length args;
   294.5      fun subst' lev (Bound i) =
   294.6           (if i<lev then raise SAME    (*var is locally bound*)
   294.7 -          else  incr_boundvars lev (List.nth (args, i-lev))
   294.8 -                  handle Subscript => Bound (i-n)  (*loose: change it*))
   294.9 +          else  incr_boundvars lev (nth args (i-lev))
  294.10 +                  handle Subscript => Bound (i-n))  (*loose: change it*)
  294.11        | subst' lev (Abs (a, T, body)) = Abs (a, T,  subst' (lev+1) body)
  294.12        | subst' lev (f $ t) = (subst' lev f $ substh' lev t
  294.13            handle SAME => f $ subst' lev t)
  294.14 @@ -494,7 +494,7 @@
  294.15      val n = length args;
  294.16      fun subst (PBound i) Plev tlev =
  294.17           (if i < Plev then raise SAME    (*var is locally bound*)
  294.18 -          else incr_pboundvars Plev tlev (List.nth (args, i-Plev))
  294.19 +          else incr_pboundvars Plev tlev (nth args (i-Plev))
  294.20                   handle Subscript => PBound (i-n)  (*loose: change it*))
  294.21        | subst (AbsP (a, t, body)) Plev tlev = AbsP (a, t, subst body (Plev+1) tlev)
  294.22        | subst (Abst (a, T, body)) Plev tlev = Abst (a, T, subst body Plev (tlev+1))
  294.23 @@ -935,7 +935,7 @@
  294.24            in (is, ch orelse ch', ts',
  294.25                if ch orelse ch' then prf' % t' else prf) end
  294.26        | shrink' ls lev ts prfs (prf as PBound i) =
  294.27 -          (if exists (fn SOME (Bound j) => lev-j <= List.nth (ls, i) | _ => true) ts
  294.28 +          (if exists (fn SOME (Bound j) => lev-j <= nth ls i | _ => true) ts
  294.29               orelse has_duplicates (op =)
  294.30                 (Library.foldl (fn (js, SOME (Bound j)) => j :: js | (js, _) => js) ([], ts))
  294.31               orelse exists #1 prfs then [i] else [], false, map (pair false) ts, prf)
   295.1 --- a/src/Pure/pure_setup.ML	Wed Mar 04 10:43:39 2009 +0100
   295.2 +++ b/src/Pure/pure_setup.ML	Wed Mar 04 10:45:52 2009 +0100
   295.3 @@ -33,7 +33,7 @@
   295.4    map (fn (x, y) => Pretty.str (x ^ "=" ^ y)) o Position.properties_of));
   295.5  install_pp (make_pp ["Thm", "thm"] ProofDisplay.pprint_thm);
   295.6  install_pp (make_pp ["Thm", "cterm"] ProofDisplay.pprint_cterm);
   295.7 -install_pp (make_pp ["Binding", "binding"] (Pretty.pprint o Pretty.str o Binding.display));
   295.8 +install_pp (make_pp ["Binding", "binding"] (Pretty.pprint o Pretty.str o Binding.str_of));
   295.9  install_pp (make_pp ["Thm", "ctyp"] ProofDisplay.pprint_ctyp);
  295.10  install_pp (make_pp ["Context", "theory"] Context.pprint_thy);
  295.11  install_pp (make_pp ["Context", "theory_ref"] Context.pprint_thy_ref);
   296.1 --- a/src/Pure/pure_thy.ML	Wed Mar 04 10:43:39 2009 +0100
   296.2 +++ b/src/Pure/pure_thy.ML	Wed Mar 04 10:45:52 2009 +0100
   296.3 @@ -31,10 +31,10 @@
   296.4    val add_thm: (binding * thm) * attribute list -> theory -> thm * theory
   296.5    val add_thmss: ((binding * thm list) * attribute list) list -> theory -> thm list list * theory
   296.6    val add_thms_dynamic: binding * (Context.generic -> thm list) -> theory -> theory
   296.7 -  val note_thmss: string -> ((binding * attribute list) *
   296.8 -    (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
   296.9 -  val note_thmss_grouped: string -> string -> ((binding * attribute list) *
  296.10 -    (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
  296.11 +  val note_thmss: string -> (Thm.binding *
  296.12 +      (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
  296.13 +  val note_thmss_grouped: string -> string -> (Thm.binding *
  296.14 +      (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
  296.15    val add_axioms: ((binding * term) * attribute list) list -> theory -> thm list * theory
  296.16    val add_axioms_cmd: ((bstring * string) * attribute list) list -> theory -> thm list * theory
  296.17    val add_defs: bool -> ((binding * term) * attribute list) list ->
  296.18 @@ -151,14 +151,15 @@
  296.19  fun enter_thms pre_name post_name app_att (b, thms) thy =
  296.20    if Binding.is_empty b
  296.21    then swap (enter_proofs (app_att (thy, thms)))
  296.22 -  else let
  296.23 -    val naming = Sign.naming_of thy;
  296.24 -    val name = NameSpace.full_name naming b;
  296.25 -    val (thy', thms') =
  296.26 -      enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
  296.27 -    val thms'' = map (Thm.transfer thy') thms';
  296.28 -    val thy'' = thy' |> (FactsData.map o apfst) (Facts.add_global naming (b, thms'') #> snd);
  296.29 -  in (thms'', thy'') end;
  296.30 +  else
  296.31 +    let
  296.32 +      val naming = Sign.naming_of thy;
  296.33 +      val name = NameSpace.full_name naming b;
  296.34 +      val (thy', thms') =
  296.35 +        enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
  296.36 +      val thms'' = map (Thm.transfer thy') thms';
  296.37 +      val thy'' = thy' |> (FactsData.map o apfst) (Facts.add_global naming (b, thms'') #> snd);
  296.38 +    in (thms'', thy'') end;
  296.39  
  296.40  
  296.41  (* store_thm(s) *)
  296.42 @@ -177,7 +178,7 @@
  296.43  
  296.44  fun add_thms_atts pre_name ((b, thms), atts) =
  296.45    enter_thms pre_name (name_thms false true Position.none)
  296.46 -    (foldl_map (Thm.theory_attributes atts)) (b, thms);
  296.47 +    (Library.foldl_map (Thm.theory_attributes atts)) (b, thms);
  296.48  
  296.49  fun gen_add_thmss pre_name =
  296.50    fold_map (add_thms_atts pre_name);
  296.51 @@ -207,9 +208,9 @@
  296.52      val name = Sign.full_name thy b;
  296.53      val _ = Position.report (Markup.fact_decl name) pos;
  296.54  
  296.55 -    fun app (x, (ths, atts)) = foldl_map (Thm.theory_attributes atts) (x, ths);
  296.56 +    fun app (x, (ths, atts)) = Library.foldl_map (Thm.theory_attributes atts) (x, ths);
  296.57      val (thms, thy') = thy |> enter_thms
  296.58 -      (name_thmss true pos) (name_thms false true pos) (apsnd flat o foldl_map app)
  296.59 +      (name_thmss true pos) (name_thms false true pos) (apsnd flat o Library.foldl_map app)
  296.60        (b, map (fn (ths, atts) => (ths, surround tag (atts @ more_atts))) ths_atts);
  296.61    in ((name, thms), thy') end);
  296.62  
   297.1 --- a/src/Pure/sign.ML	Wed Mar 04 10:43:39 2009 +0100
   297.2 +++ b/src/Pure/sign.ML	Wed Mar 04 10:45:52 2009 +0100
   297.3 @@ -338,7 +338,7 @@
   297.4      fun typ_of (_, Const (_, T)) = T
   297.5        | typ_of (_, Free  (_, T)) = T
   297.6        | typ_of (_, Var (_, T)) = T
   297.7 -      | typ_of (bs, Bound i) = snd (List.nth (bs, i) handle Subscript =>
   297.8 +      | typ_of (bs, Bound i) = snd (nth bs i handle Subscript =>
   297.9            raise TYPE ("Loose bound variable: B." ^ string_of_int i, [], [Bound i]))
  297.10        | typ_of (bs, Abs (x, T, body)) = T --> typ_of ((x, T) :: bs, body)
  297.11        | typ_of (bs, t $ u) =
  297.12 @@ -507,12 +507,12 @@
  297.13      val prepT = Type.no_tvars o Term.no_dummyT o certify_typ thy o parse_typ ctxt;
  297.14      fun prep (raw_b, raw_T, raw_mx) =
  297.15        let
  297.16 -        val (mx_name, mx) = Syntax.const_mixfix (Binding.base_name raw_b) raw_mx;
  297.17 -        val b = Binding.map_base (K mx_name) raw_b;
  297.18 +        val (mx_name, mx) = Syntax.const_mixfix (Binding.name_of raw_b) raw_mx;
  297.19 +        val b = Binding.map_name (K mx_name) raw_b;
  297.20          val c = full_name thy b;
  297.21 -        val c_syn = if authentic then Syntax.constN ^ c else Binding.base_name b;
  297.22 +        val c_syn = if authentic then Syntax.constN ^ c else Binding.name_of b;
  297.23          val T = (prepT raw_T handle TYPE (msg, _, _) => error msg) handle ERROR msg =>
  297.24 -          cat_error msg ("in declaration of constant " ^ quote (Binding.display b));
  297.25 +          cat_error msg ("in declaration of constant " ^ quote (Binding.str_of b));
  297.26          val T' = Logic.varifyT T;
  297.27        in ((b, T'), (c_syn, T', mx), Const (c, T)) end;
  297.28      val args = map prep raw_args;
  297.29 @@ -549,7 +549,7 @@
  297.30      val pp = Syntax.pp_global thy;
  297.31      val prep_tm = no_frees pp o Term.no_dummy_patterns o cert_term_abbrev thy;
  297.32      val t = (prep_tm raw_t handle TYPE (msg, _, _) => error msg | TERM (msg, _) => error msg)
  297.33 -      handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.display b));
  297.34 +      handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b));
  297.35      val (res, consts') = consts_of thy
  297.36        |> Consts.abbreviate pp (tsig_of thy) (naming_of thy) mode tags (b, t);
  297.37    in (res, thy |> map_consts (K consts')) end;
   298.1 --- a/src/Pure/sorts.ML	Wed Mar 04 10:43:39 2009 +0100
   298.2 +++ b/src/Pure/sorts.ML	Wed Mar 04 10:45:52 2009 +0100
   298.3 @@ -46,9 +46,7 @@
   298.4    val add_arities: Pretty.pp -> string * (class * sort list) list -> algebra -> algebra
   298.5    val empty_algebra: algebra
   298.6    val merge_algebra: Pretty.pp -> algebra * algebra -> algebra
   298.7 -  val classrels_of: algebra -> (class * class list) list
   298.8 -  val instances_of: algebra -> (string * class) list
   298.9 -  val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list)
  298.10 +  val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list option)
  298.11      -> algebra -> (sort -> sort) * algebra
  298.12    type class_error
  298.13    val class_error: Pretty.pp -> class_error -> string
  298.14 @@ -302,19 +300,14 @@
  298.15  
  298.16  (* algebra projections *)
  298.17  
  298.18 -fun classrels_of (Algebra {classes, ...}) =
  298.19 -  map (fn [c] => (c, Graph.imm_succs classes c)) (rev (Graph.strong_conn classes));
  298.20 -
  298.21 -fun instances_of (Algebra {arities, ...}) =
  298.22 -  Symtab.fold (fn (a, cs) => append (map (pair a o fst) cs)) arities [];
  298.23 -
  298.24  fun subalgebra pp P sargs (algebra as Algebra {classes, arities}) =
  298.25    let
  298.26      val restrict_sort = minimize_sort algebra o filter P o Graph.all_succs classes;
  298.27      fun restrict_arity tyco (c, (_, Ss)) =
  298.28 -      if P c then
  298.29 -        SOME (c, (c, Ss |> map2 (curry (inter_sort algebra)) (sargs (c, tyco))
  298.30 +      if P c then case sargs (c, tyco)
  298.31 +       of SOME sorts => SOME (c, (c, Ss |> map2 (curry (inter_sort algebra)) sorts
  298.32            |> map restrict_sort))
  298.33 +        | NONE => NONE
  298.34        else NONE;
  298.35      val classes' = classes |> Graph.subgraph P;
  298.36      val arities' = arities |> Symtab.map' (map_filter o restrict_arity);
   299.1 --- a/src/Pure/tctical.ML	Wed Mar 04 10:43:39 2009 +0100
   299.2 +++ b/src/Pure/tctical.ML	Wed Mar 04 10:45:52 2009 +0100
   299.3 @@ -349,15 +349,13 @@
   299.4  (*Returns all states that have changed in subgoal i, counted from the LAST
   299.5    subgoal.  For stac, for example.*)
   299.6  fun CHANGED_GOAL tac i st =
   299.7 -    let val np = nprems_of st
   299.8 +    let val np = Thm.nprems_of st
   299.9          val d = np-i                 (*distance from END*)
  299.10 -        val t = List.nth(prems_of st, i-1)
  299.11 +        val t = Thm.term_of (Thm.cprem_of st i)
  299.12          fun diff st' =
  299.13 -            nprems_of st' - d <= 0   (*the subgoal no longer exists*)
  299.14 +            Thm.nprems_of st' - d <= 0   (*the subgoal no longer exists*)
  299.15              orelse
  299.16 -             not (Pattern.aeconv (t,
  299.17 -                                  List.nth(prems_of st',
  299.18 -                                           nprems_of st' - d - 1)))
  299.19 +             not (Pattern.aeconv (t, Thm.term_of (Thm.cprem_of st' (Thm.nprems_of st' - d))))
  299.20      in  Seq.filter diff (tac i st)  end
  299.21      handle Subscript => Seq.empty  (*no subgoal i*);
  299.22  
   300.1 --- a/src/Pure/term.ML	Wed Mar 04 10:43:39 2009 +0100
   300.2 +++ b/src/Pure/term.ML	Wed Mar 04 10:45:52 2009 +0100
   300.3 @@ -297,7 +297,7 @@
   300.4    Ts = [T0,T1,...] holds types of bound variables 0, 1, ...*)
   300.5  fun type_of1 (Ts, Const (_,T)) = T
   300.6    | type_of1 (Ts, Free  (_,T)) = T
   300.7 -  | type_of1 (Ts, Bound i) = (List.nth (Ts,i)
   300.8 +  | type_of1 (Ts, Bound i) = (nth Ts i
   300.9          handle Subscript => raise TYPE("type_of: bound variable", [], [Bound i]))
  300.10    | type_of1 (Ts, Var (_,T)) = T
  300.11    | type_of1 (Ts, Abs (_,T,body)) = T --> type_of1(T::Ts, body)
  300.12 @@ -322,7 +322,7 @@
  300.13          | _ => raise TERM("fastype_of: expected function type", [f$u]))
  300.14    | fastype_of1 (_, Const (_,T)) = T
  300.15    | fastype_of1 (_, Free (_,T)) = T
  300.16 -  | fastype_of1 (Ts, Bound i) = (List.nth(Ts,i)
  300.17 +  | fastype_of1 (Ts, Bound i) = (nth Ts i
  300.18           handle Subscript => raise TERM("fastype_of: Bound", [Bound i]))
  300.19    | fastype_of1 (_, Var (_,T)) = T
  300.20    | fastype_of1 (Ts, Abs (_,T,u)) = T --> fastype_of1 (T::Ts, u);
  300.21 @@ -387,17 +387,17 @@
  300.22  (*number of atoms and abstractions in a term*)
  300.23  fun size_of_term tm =
  300.24    let
  300.25 -    fun add_size (t $ u, n) = add_size (t, add_size (u, n))
  300.26 -      | add_size (Abs (_ ,_, t), n) = add_size (t, n + 1)
  300.27 -      | add_size (_, n) = n + 1;
  300.28 -  in add_size (tm, 0) end;
  300.29 +    fun add_size (t $ u) n = add_size t (add_size u n)
  300.30 +      | add_size (Abs (_ ,_, t)) n = add_size t (n + 1)
  300.31 +      | add_size _ n = n + 1;
  300.32 +  in add_size tm 0 end;
  300.33  
  300.34 -(*number of tfrees, tvars, and constructors in a type*)
  300.35 +(*number of atoms and constructors in a type*)
  300.36  fun size_of_typ ty =
  300.37    let
  300.38 -    fun add_size (Type (_, ars), n) = foldl add_size (n + 1) ars
  300.39 -      | add_size (_, n) = n + 1;
  300.40 -  in add_size (ty, 0) end;
  300.41 +    fun add_size (Type (_, tys)) n = fold add_size tys (n + 1)
  300.42 +      | add_size _ n = n + 1;
  300.43 +  in add_size ty 0 end;
  300.44  
  300.45  fun map_atyps f (Type (a, Ts)) = Type (a, map (map_atyps f) Ts)
  300.46    | map_atyps f T = f T;
  300.47 @@ -638,7 +638,7 @@
  300.48      val n = length args;
  300.49      fun subst (t as Bound i, lev) =
  300.50           (if i < lev then raise SAME   (*var is locally bound*)
  300.51 -          else incr_boundvars lev (List.nth (args, i - lev))
  300.52 +          else incr_boundvars lev (nth args (i - lev))
  300.53              handle Subscript => Bound (i - n))  (*loose: change it*)
  300.54        | subst (Abs (a, T, body), lev) = Abs (a, T, subst (body, lev + 1))
  300.55        | subst (f $ t, lev) =
   301.1 --- a/src/Pure/theory.ML	Wed Mar 04 10:43:39 2009 +0100
   301.2 +++ b/src/Pure/theory.ML	Wed Mar 04 10:45:52 2009 +0100
   301.3 @@ -258,7 +258,7 @@
   301.4      val _ = check_overloading thy overloaded lhs_const;
   301.5    in defs |> dependencies thy unchecked true name lhs_const rhs_consts end
   301.6    handle ERROR msg => cat_error msg (Pretty.string_of (Pretty.block
   301.7 -   [Pretty.str ("The error(s) above occurred in definition " ^ quote (Binding.display b) ^ ":"),
   301.8 +   [Pretty.str ("The error(s) above occurred in definition " ^ quote (Binding.str_of b) ^ ":"),
   301.9      Pretty.fbrk, Pretty.quote (Syntax.pretty_term_global thy tm)]));
  301.10  
  301.11  
   302.1 --- a/src/Pure/type_infer.ML	Wed Mar 04 10:43:39 2009 +0100
   302.2 +++ b/src/Pure/type_infer.ML	Wed Mar 04 10:45:52 2009 +0100
   302.3 @@ -369,7 +369,7 @@
   302.4      fun inf _ (PConst (_, T)) = T
   302.5        | inf _ (PFree (_, T)) = T
   302.6        | inf _ (PVar (_, T)) = T
   302.7 -      | inf bs (PBound i) = snd (List.nth (bs, i) handle Subscript => err_loose i)
   302.8 +      | inf bs (PBound i) = snd (nth bs i handle Subscript => err_loose i)
   302.9        | inf bs (PAbs (x, T, t)) = PType ("fun", [T, inf ((x, T) :: bs) t])
  302.10        | inf bs (PAppl (t, u)) =
  302.11            let
   303.1 --- a/src/Tools/Compute_Oracle/Compute_Oracle.thy	Wed Mar 04 10:43:39 2009 +0100
   303.2 +++ b/src/Tools/Compute_Oracle/Compute_Oracle.thy	Wed Mar 04 10:45:52 2009 +0100
   303.3 @@ -1,5 +1,4 @@
   303.4  (*  Title:      Tools/Compute_Oracle/Compute_Oracle.thy
   303.5 -    ID:         $Id$
   303.6      Author:     Steven Obua, TU Munich
   303.7  
   303.8  Steven Obua's evaluator.
   304.1 --- a/src/Tools/Compute_Oracle/am_compiler.ML	Wed Mar 04 10:43:39 2009 +0100
   304.2 +++ b/src/Tools/Compute_Oracle/am_compiler.ML	Wed Mar 04 10:45:52 2009 +0100
   304.3 @@ -1,5 +1,4 @@
   304.4  (*  Title:      Tools/Compute_Oracle/am_compiler.ML
   304.5 -    ID:         $Id$
   304.6      Author:     Steven Obua
   304.7  *)
   304.8  
   305.1 --- a/src/Tools/Compute_Oracle/am_ghc.ML	Wed Mar 04 10:43:39 2009 +0100
   305.2 +++ b/src/Tools/Compute_Oracle/am_ghc.ML	Wed Mar 04 10:45:52 2009 +0100
   305.3 @@ -1,5 +1,4 @@
   305.4  (*  Title:      Tools/Compute_Oracle/am_ghc.ML
   305.5 -    ID:         $Id$
   305.6      Author:     Steven Obua
   305.7  *)
   305.8  
   306.1 --- a/src/Tools/Compute_Oracle/am_interpreter.ML	Wed Mar 04 10:43:39 2009 +0100
   306.2 +++ b/src/Tools/Compute_Oracle/am_interpreter.ML	Wed Mar 04 10:45:52 2009 +0100
   306.3 @@ -1,5 +1,4 @@
   306.4  (*  Title:      Tools/Compute_Oracle/am_interpreter.ML
   306.5 -    ID:         $Id$
   306.6      Author:     Steven Obua
   306.7  *)
   306.8  
   307.1 --- a/src/Tools/Compute_Oracle/am_sml.ML	Wed Mar 04 10:43:39 2009 +0100
   307.2 +++ b/src/Tools/Compute_Oracle/am_sml.ML	Wed Mar 04 10:45:52 2009 +0100
   307.3 @@ -1,5 +1,4 @@
   307.4  (*  Title:      Tools/Compute_Oracle/am_sml.ML
   307.5 -    ID:         $Id$
   307.6      Author:     Steven Obua
   307.7  
   307.8      ToDO: "parameterless rewrite cannot be used in pattern": In a lot of cases it CAN be used, and these cases should be handled properly; 
   308.1 --- a/src/Tools/Compute_Oracle/report.ML	Wed Mar 04 10:43:39 2009 +0100
   308.2 +++ b/src/Tools/Compute_Oracle/report.ML	Wed Mar 04 10:45:52 2009 +0100
   308.3 @@ -13,7 +13,7 @@
   308.4      let
   308.5  	val t1 = start_timing ()
   308.6  	val x = f ()
   308.7 -	val t2 = end_timing t1
   308.8 +	val t2 = #message (end_timing t1)
   308.9  	val _ = writeln ((report_space ()) ^ "--> "^t2)
  308.10      in
  308.11  	x	
   309.1 --- a/src/Tools/IsaPlanner/README	Wed Mar 04 10:43:39 2009 +0100
   309.2 +++ b/src/Tools/IsaPlanner/README	Wed Mar 04 10:45:52 2009 +0100
   309.3 @@ -1,4 +1,3 @@
   309.4 -ID:         $Id$
   309.5  Author:     Lucas Dixon, University of Edinburgh
   309.6  
   309.7  Support files for IsaPlanner (see http://isaplanner.sourceforge.net).
   310.1 --- a/src/Tools/IsaPlanner/isand.ML	Wed Mar 04 10:43:39 2009 +0100
   310.2 +++ b/src/Tools/IsaPlanner/isand.ML	Wed Mar 04 10:45:52 2009 +0100
   310.3 @@ -132,7 +132,7 @@
   310.4        fun allify_prem_var (vt as (n,ty),t)  = 
   310.5            (Term.all ty) $ (Abs(n,ty,Term.abstract_over (Free vt, t)))
   310.6  
   310.7 -      fun allify_prem Ts p = foldr allify_prem_var p Ts
   310.8 +      fun allify_prem Ts p = List.foldr allify_prem_var p Ts
   310.9  
  310.10        val cTs = map (ctermify o Free) Ts
  310.11        val cterm_asms = map (ctermify o allify_prem Ts) premts
  310.12 @@ -306,7 +306,7 @@
  310.13      in (Term.all ty) $ (Abs(n,ty,Term.abstract_over (vt, t))) end;
  310.14  
  310.15  fun allify_for_sg_term ctermify vs t =
  310.16 -    let val t_alls = foldr allify_term t vs;
  310.17 +    let val t_alls = List.foldr allify_term t vs;
  310.18          val ct_alls = ctermify t_alls; 
  310.19      in 
  310.20        (ct_alls, Drule.forall_elim_list vs (Thm.assume ct_alls))
  310.21 @@ -394,7 +394,7 @@
  310.22                  |> Drule.forall_intr_list cfvs
  310.23      in Drule.compose_single (solth', i, gth) end;
  310.24  
  310.25 -fun export_solutions (xs,th) = foldr (uncurry export_solution) th xs;
  310.26 +fun export_solutions (xs,th) = List.foldr (uncurry export_solution) th xs;
  310.27  
  310.28  
  310.29  (* fix parameters of a subgoal "i", as free variables, and create an
   311.1 --- a/src/Tools/IsaPlanner/rw_inst.ML	Wed Mar 04 10:43:39 2009 +0100
   311.2 +++ b/src/Tools/IsaPlanner/rw_inst.ML	Wed Mar 04 10:45:52 2009 +0100
   311.3 @@ -136,7 +136,7 @@
   311.4  fun mk_renamings tgt rule_inst = 
   311.5      let
   311.6        val rule_conds = Thm.prems_of rule_inst
   311.7 -      val names = foldr OldTerm.add_term_names [] (tgt :: rule_conds);
   311.8 +      val names = List.foldr OldTerm.add_term_names [] (tgt :: rule_conds);
   311.9        val (conds_tyvs,cond_vs) = 
  311.10            Library.foldl (fn ((tyvs, vs), t) => 
  311.11                      (Library.union
  311.12 @@ -147,7 +147,7 @@
  311.13        val termvars = map Term.dest_Var (OldTerm.term_vars tgt); 
  311.14        val vars_to_fix = Library.union (termvars, cond_vs);
  311.15        val (renamings, names2) = 
  311.16 -          foldr (fn (((n,i),ty), (vs, names')) => 
  311.17 +          List.foldr (fn (((n,i),ty), (vs, names')) => 
  311.18                      let val n' = Name.variant names' n in
  311.19                        ((((n,i),ty), Free (n', ty)) :: vs, n'::names')
  311.20                      end)
  311.21 @@ -166,13 +166,13 @@
  311.22      let 
  311.23        val ignore_ixs = map fst ignore_insts;
  311.24        val (tvars, tfrees) = 
  311.25 -            foldr (fn (t, (varixs, tfrees)) => 
  311.26 +            List.foldr (fn (t, (varixs, tfrees)) => 
  311.27                        (OldTerm.add_term_tvars (t,varixs),
  311.28                         OldTerm.add_term_tfrees (t,tfrees)))
  311.29                    ([],[]) ts;
  311.30          val unfixed_tvars = 
  311.31              List.filter (fn (ix,s) => not (member (op =) ignore_ixs ix)) tvars;
  311.32 -        val (fixtyinsts, _) = foldr new_tfree ([], map fst tfrees) unfixed_tvars
  311.33 +        val (fixtyinsts, _) = List.foldr new_tfree ([], map fst tfrees) unfixed_tvars
  311.34      in (fixtyinsts, tfrees) end;
  311.35  
  311.36  
  311.37 @@ -248,7 +248,7 @@
  311.38                            Ts;
  311.39  
  311.40        (* type-instantiate the var instantiations *)
  311.41 -      val insts_tyinst = foldr (fn ((ix,(ty,t)),insts_tyinst) => 
  311.42 +      val insts_tyinst = List.foldr (fn ((ix,(ty,t)),insts_tyinst) => 
  311.43                              (ix, (Term.typ_subst_TVars term_typ_inst ty, 
  311.44                                    Term.subst_TVars term_typ_inst t))
  311.45                              :: insts_tyinst)
   312.1 --- a/src/Tools/IsaPlanner/rw_tools.ML	Wed Mar 04 10:43:39 2009 +0100
   312.2 +++ b/src/Tools/IsaPlanner/rw_tools.ML	Wed Mar 04 10:45:52 2009 +0100
   312.3 @@ -1,5 +1,4 @@
   312.4  (*  Title:      Tools/IsaPlanner/rw_tools.ML
   312.5 -    ID:		$Id$
   312.6      Author:     Lucas Dixon, University of Edinburgh
   312.7  
   312.8  Term related tools used for rewriting.
   313.1 --- a/src/Tools/IsaPlanner/zipper.ML	Wed Mar 04 10:43:39 2009 +0100
   313.2 +++ b/src/Tools/IsaPlanner/zipper.ML	Wed Mar 04 10:45:52 2009 +0100
   313.3 @@ -1,5 +1,4 @@
   313.4  (*  Title:      Tools/IsaPlanner/zipper.ML
   313.5 -    ID:		$Id$
   313.6      Author:     Lucas Dixon, University of Edinburgh
   313.7  
   313.8  A notion roughly based on Huet's Zippers for Isabelle terms.
   314.1 --- a/src/Tools/Metis/make-metis	Wed Mar 04 10:43:39 2009 +0100
   314.2 +++ b/src/Tools/Metis/make-metis	Wed Mar 04 10:45:52 2009 +0100
   314.3 @@ -1,7 +1,5 @@
   314.4  #!/usr/bin/env bash
   314.5  #
   314.6 -# $Id$
   314.7 -#
   314.8  # make-metis - turn original Metis files into Isabelle ML source.
   314.9  #
  314.10  # Structure declarations etc. are made local by wrapping into a
  314.11 @@ -11,8 +9,6 @@
  314.12  THIS=$(cd "$(dirname "$0")"; echo $PWD)
  314.13  
  314.14  (
  314.15 -  echo -n '(* $'
  314.16 -  echo 'Id$ *)'
  314.17    cat <<EOF
  314.18  (******************************************************************)
  314.19  (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
   315.1 --- a/src/Tools/Metis/metis.ML	Wed Mar 04 10:43:39 2009 +0100
   315.2 +++ b/src/Tools/Metis/metis.ML	Wed Mar 04 10:45:52 2009 +0100
   315.3 @@ -1,4 +1,3 @@
   315.4 -(* $Id$ *)
   315.5  (******************************************************************)
   315.6  (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
   315.7  (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
   316.1 --- a/src/Tools/README	Wed Mar 04 10:43:39 2009 +0100
   316.2 +++ b/src/Tools/README	Wed Mar 04 10:45:52 2009 +0100
   316.3 @@ -4,5 +4,3 @@
   316.4  This directory contains ML sources of generic tools.  Typically, they
   316.5  can be applied to various logics.
   316.6  
   316.7 -
   316.8 -$Id$
   317.1 --- a/src/Tools/atomize_elim.ML	Wed Mar 04 10:43:39 2009 +0100
   317.2 +++ b/src/Tools/atomize_elim.ML	Wed Mar 04 10:45:52 2009 +0100
   317.3 @@ -1,5 +1,4 @@
   317.4  (*  Title:      Tools/atomize_elim.ML
   317.5 -    ID:         $Id$
   317.6      Author:     Alexander Krauss, TU Muenchen
   317.7  
   317.8  Turn elimination rules into atomic expressions in the object logic.
   318.1 --- a/src/Tools/auto_solve.ML	Wed Mar 04 10:43:39 2009 +0100
   318.2 +++ b/src/Tools/auto_solve.ML	Wed Mar 04 10:45:52 2009 +0100
   318.3 @@ -1,89 +1,91 @@
   318.4 -(*  Title:      auto_solve.ML
   318.5 +(*  Title:      Pure/Tools/auto_solve.ML
   318.6      Author:     Timothy Bourke and Gerwin Klein, NICTA
   318.7  
   318.8 -    Check whether a newly stated theorem can be solved directly
   318.9 -    by an existing theorem. Duplicate lemmas can be detected in
  318.10 -    this way.
  318.11 +Check whether a newly stated theorem can be solved directly by an
  318.12 +existing theorem. Duplicate lemmas can be detected in this way.
  318.13  
  318.14 -    The implemenation is based in part on Berghofer and
  318.15 -    Haftmann's Pure/codegen.ML. It relies critically on
  318.16 -    the FindTheorems solves feature.
  318.17 +The implemenation is based in part on Berghofer and Haftmann's
  318.18 +Pure/codegen.ML. It relies critically on the FindTheorems solves
  318.19 +feature.
  318.20  *)
  318.21  
  318.22  signature AUTO_SOLVE =
  318.23  sig
  318.24 -  val auto : bool ref;
  318.25 -  val auto_time_limit : int ref;
  318.26 +  val auto : bool ref
  318.27 +  val auto_time_limit : int ref
  318.28  
  318.29 -  val seek_solution : bool -> Proof.state -> Proof.state;
  318.30 +  val seek_solution : bool -> Proof.state -> Proof.state
  318.31  end;
  318.32  
  318.33  structure AutoSolve : AUTO_SOLVE =
  318.34  struct
  318.35 -  structure FT = FindTheorems;
  318.36  
  318.37 -  val auto = ref false;
  318.38 -  val auto_time_limit = ref 5000;
  318.39 +val auto = ref false;
  318.40 +val auto_time_limit = ref 2500;
  318.41  
  318.42 -  fun seek_solution int state = let
  318.43 -      val ctxt = Proof.context_of state;
  318.44 +fun seek_solution int state =
  318.45 +  let
  318.46 +    val ctxt = Proof.context_of state;
  318.47  
  318.48 -      fun conj_to_list [] = []
  318.49 -        | conj_to_list (t::ts) =
  318.50 -          (Conjunction.dest_conjunction t
  318.51 -           |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
  318.52 -          handle TERM _ => t::conj_to_list ts;
  318.53 +    fun conj_to_list [] = []
  318.54 +      | conj_to_list (t::ts) =
  318.55 +        (Conjunction.dest_conjunction t
  318.56 +         |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
  318.57 +        handle TERM _ => t::conj_to_list ts;
  318.58  
  318.59 -      val crits = [(true, FT.Solves)];
  318.60 -      fun find g = (NONE, FT.find_theorems ctxt g true crits);
  318.61 -      fun find_cterm g = (SOME g, FT.find_theorems ctxt
  318.62 -                                    (SOME (Goal.init g)) true crits);
  318.63 +    val crits = [(true, FindTheorems.Solves)];
  318.64 +    fun find g = (NONE, FindTheorems.find_theorems ctxt g true crits);
  318.65 +    fun find_cterm g = (SOME g, FindTheorems.find_theorems ctxt
  318.66 +                                  (SOME (Goal.init g)) true crits);
  318.67  
  318.68 -      fun prt_result (goal, results) = let
  318.69 -          val msg = case goal of
  318.70 -                      NONE => "The current goal"
  318.71 -                    | SOME g => Syntax.string_of_term ctxt (term_of g);
  318.72 -        in
  318.73 -          Pretty.big_list (msg ^ " could be solved directly with:")
  318.74 -                          (map Display.pretty_fact results)
  318.75 -        end;
  318.76 +    fun prt_result (goal, results) =
  318.77 +      let
  318.78 +        val msg = case goal of
  318.79 +                    NONE => "The current goal"
  318.80 +                  | SOME g => Syntax.string_of_term ctxt (term_of g);
  318.81 +      in
  318.82 +        Pretty.big_list (msg ^ " could be solved directly with:")
  318.83 +                        (map (FindTheorems.pretty_thm ctxt) results)
  318.84 +      end;
  318.85  
  318.86 -      fun seek_against_goal () = let
  318.87 -          val goal = try Proof.get_goal state
  318.88 -                     |> Option.map (#2 o #2);
  318.89 +    fun seek_against_goal () =
  318.90 +      let
  318.91 +        val goal = try Proof.get_goal state
  318.92 +                   |> Option.map (#2 o #2);
  318.93  
  318.94 -          val goals = goal
  318.95 -                      |> Option.map (fn g => cprem_of g 1)
  318.96 -                      |> the_list
  318.97 -                      |> conj_to_list;
  318.98 +        val goals = goal
  318.99 +                    |> Option.map (fn g => cprem_of g 1)
 318.100 +                    |> the_list
 318.101 +                    |> conj_to_list;
 318.102  
 318.103 -          val rs = if length goals = 1
 318.104 -                   then [find goal]
 318.105 -                   else map find_cterm goals;
 318.106 -          val frs = filter_out (null o snd) rs;
 318.107 +        val rs = if length goals = 1
 318.108 +                 then [find goal]
 318.109 +                 else map find_cterm goals;
 318.110 +        val frs = filter_out (null o snd) rs;
 318.111  
 318.112 -        in if null frs then NONE else SOME frs end;
 318.113 +      in if null frs then NONE else SOME frs end;
 318.114  
 318.115 -      fun go () = let
 318.116 -          val res = TimeLimit.timeLimit
 318.117 -                      (Time.fromMilliseconds (!auto_time_limit))
 318.118 -                      (try seek_against_goal) ();
 318.119 -        in
 318.120 -          case Option.join res of
 318.121 -            NONE => state
 318.122 -          | SOME results => (Proof.goal_message
 318.123 -                              (fn () => Pretty.chunks [Pretty.str "",
 318.124 -                                Pretty.markup Markup.hilite
 318.125 -                                (Library.separate (Pretty.brk 0)
 318.126 -                                                  (map prt_result results))])
 318.127 -                                state)
 318.128 -        end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
 318.129 -    in
 318.130 -      if int andalso !auto andalso not (!Toplevel.quiet)
 318.131 -      then go ()
 318.132 -      else state
 318.133 -    end;
 318.134 -    
 318.135 +    fun go () =
 318.136 +      let
 318.137 +        val res = TimeLimit.timeLimit
 318.138 +                    (Time.fromMilliseconds (! auto_time_limit))
 318.139 +                    (try seek_against_goal) ();
 318.140 +      in
 318.141 +        case Option.join res of
 318.142 +          NONE => state
 318.143 +        | SOME results => (Proof.goal_message
 318.144 +                            (fn () => Pretty.chunks [Pretty.str "",
 318.145 +                              Pretty.markup Markup.hilite
 318.146 +                              (Library.separate (Pretty.brk 0)
 318.147 +                                                (map prt_result results))])
 318.148 +                              state)
 318.149 +      end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
 318.150 +  in
 318.151 +    if int andalso ! auto andalso not (! Toplevel.quiet)
 318.152 +    then go ()
 318.153 +    else state
 318.154 +  end;
 318.155 +
 318.156  end;
 318.157  
 318.158  val _ = Context.>> (Specification.add_theorem_hook AutoSolve.seek_solution);
   319.1 --- a/src/Tools/code/code_funcgr.ML	Wed Mar 04 10:43:39 2009 +0100
   319.2 +++ b/src/Tools/code/code_funcgr.ML	Wed Mar 04 10:45:52 2009 +0100
   319.3 @@ -1,12 +1,13 @@
   319.4  (*  Title:      Tools/code/code_funcgr.ML
   319.5 -    ID:         $Id$
   319.6      Author:     Florian Haftmann, TU Muenchen
   319.7  
   319.8 -Retrieving, normalizing and structuring defining equations in graph
   319.9 +Retrieving, normalizing and structuring code equations in graph
  319.10  with explicit dependencies.
  319.11 +
  319.12 +Legacy.  To be replaced by Tools/code/code_wellsorted.ML
  319.13  *)
  319.14  
  319.15 -signature CODE_FUNCGR =
  319.16 +signature CODE_WELLSORTED =
  319.17  sig
  319.18    type T
  319.19    val eqns: T -> string -> (thm * bool) list
  319.20 @@ -22,7 +23,7 @@
  319.21    val timing: bool ref
  319.22  end
  319.23  
  319.24 -structure Code_Funcgr : CODE_FUNCGR =
  319.25 +structure Code_Wellsorted : CODE_WELLSORTED =
  319.26  struct
  319.27  
  319.28  (** the graph type **)
  319.29 @@ -318,13 +319,13 @@
  319.30  in
  319.31  
  319.32  val _ =
  319.33 -  OuterSyntax.improper_command "code_thms" "print system of defining equations for code" OuterKeyword.diag
  319.34 +  OuterSyntax.improper_command "code_thms" "print system of code equations for code" OuterKeyword.diag
  319.35      (Scan.repeat P.term_group
  319.36        >> (fn cs => Toplevel.no_timing o Toplevel.unknown_theory
  319.37          o Toplevel.keep ((fn thy => code_thms_cmd thy cs) o Toplevel.theory_of)));
  319.38  
  319.39  val _ =
  319.40 -  OuterSyntax.improper_command "code_deps" "visualize dependencies of defining equations for code" OuterKeyword.diag
  319.41 +  OuterSyntax.improper_command "code_deps" "visualize dependencies of code equations for code" OuterKeyword.diag
  319.42      (Scan.repeat P.term_group
  319.43        >> (fn cs => Toplevel.no_timing o Toplevel.unknown_theory
  319.44          o Toplevel.keep ((fn thy => code_deps_cmd thy cs) o Toplevel.theory_of)));
   320.1 --- a/src/Tools/code/code_haskell.ML	Wed Mar 04 10:43:39 2009 +0100
   320.2 +++ b/src/Tools/code/code_haskell.ML	Wed Mar 04 10:45:52 2009 +0100
   320.3 @@ -1,5 +1,4 @@
   320.4  (*  Title:      Tools/code/code_haskell.ML
   320.5 -    ID:         $Id$
   320.6      Author:     Florian Haftmann, TU Muenchen
   320.7  
   320.8  Serializer for Haskell.
   321.1 --- a/src/Tools/code/code_name.ML	Wed Mar 04 10:43:39 2009 +0100
   321.2 +++ b/src/Tools/code/code_name.ML	Wed Mar 04 10:45:52 2009 +0100
   321.3 @@ -1,5 +1,4 @@
   321.4  (*  Title:      Tools/code/code_name.ML
   321.5 -    ID:         $Id$
   321.6      Author:     Florian Haftmann, TU Muenchen
   321.7  
   321.8  Some code generator infrastructure concerning names.
   322.1 --- a/src/Tools/code/code_printer.ML	Wed Mar 04 10:43:39 2009 +0100
   322.2 +++ b/src/Tools/code/code_printer.ML	Wed Mar 04 10:45:52 2009 +0100
   322.3 @@ -1,5 +1,4 @@
   322.4  (*  Title:      Tools/code/code_printer.ML
   322.5 -    ID:         $Id$
   322.6      Author:     Florian Haftmann, TU Muenchen
   322.7  
   322.8  Generic operations for pretty printing of target language code.
   323.1 --- a/src/Tools/code/code_target.ML	Wed Mar 04 10:43:39 2009 +0100
   323.2 +++ b/src/Tools/code/code_target.ML	Wed Mar 04 10:45:52 2009 +0100
   323.3 @@ -1,5 +1,4 @@
   323.4  (*  Title:      Tools/code/code_target.ML
   323.5 -    ID:         $Id$
   323.6      Author:     Florian Haftmann, TU Muenchen
   323.7  
   323.8  Serializer from intermediate language ("Thin-gol") to target languages.
   323.9 @@ -418,7 +417,7 @@
  323.10      val program4 = Graph.subgraph (member (op =) names_all) program3;
  323.11      val empty_funs = filter_out (member (op =) abortable)
  323.12        (Code_Thingol.empty_funs program3);
  323.13 -    val _ = if null empty_funs then () else error ("No defining equations for "
  323.14 +    val _ = if null empty_funs then () else error ("No code equations for "
  323.15        ^ commas (map (Sign.extern_const thy) empty_funs));
  323.16    in
  323.17      serializer module args (labelled_name thy program2) reserved includes
   324.1 --- a/src/Tools/code/code_thingol.ML	Wed Mar 04 10:43:39 2009 +0100
   324.2 +++ b/src/Tools/code/code_thingol.ML	Wed Mar 04 10:45:52 2009 +0100
   324.3 @@ -109,7 +109,7 @@
   324.4          let val (xs', x') = unfoldr dest x2 in (x1::xs', x') end;
   324.5  
   324.6  
   324.7 -(** language core - types, patterns, expressions **)
   324.8 +(** language core - types, terms **)
   324.9  
  324.10  type vname = string;
  324.11  
  324.12 @@ -131,31 +131,6 @@
  324.13    | ICase of ((iterm * itype) * (iterm * iterm) list) * iterm;
  324.14      (*see also signature*)
  324.15  
  324.16 -(*
  324.17 -  variable naming conventions
  324.18 -
  324.19 -  bare names:
  324.20 -    variable names          v
  324.21 -    class names             class
  324.22 -    type constructor names  tyco
  324.23 -    datatype names          dtco
  324.24 -    const names (general)   c (const)
  324.25 -    constructor names       co
  324.26 -    class parameter names   classparam
  324.27 -    arbitrary name          s
  324.28 -
  324.29 -    v, c, co, classparam also annotated with types etc.
  324.30 -
  324.31 -  constructs:
  324.32 -    sort                    sort
  324.33 -    type parameters         vs
  324.34 -    type                    ty
  324.35 -    type schemes            tysm
  324.36 -    term                    t
  324.37 -    (term as pattern)       p
  324.38 -    instance (class, tyco)  inst
  324.39 - *)
  324.40 -
  324.41  val op `$$ = Library.foldl (op `$);
  324.42  val op `|--> = Library.foldr (op `|->);
  324.43  
  324.44 @@ -478,7 +453,7 @@
  324.45    let
  324.46      val err_class = Sorts.class_error (Syntax.pp_global thy) e;
  324.47      val err_thm = case thm
  324.48 -     of SOME thm => "\n(in defining equation " ^ Display.string_of_thm thm ^ ")" | NONE => "";
  324.49 +     of SOME thm => "\n(in code equation " ^ Display.string_of_thm thm ^ ")" | NONE => "";
  324.50      val err_typ = "Type " ^ Syntax.string_of_typ_global thy ty ^ " not of sort "
  324.51        ^ Syntax.string_of_sort_global thy sort;
  324.52    in error ("Wellsortedness error" ^ err_thm ^ ":\n" ^ err_typ ^ "\n" ^ err_class) end;
  324.53 @@ -486,12 +461,6 @@
  324.54  
  324.55  (* translation *)
  324.56  
  324.57 -(*FIXME move to code(_unit).ML*)
  324.58 -fun get_case_scheme thy c = case Code.get_case_data thy c
  324.59 - of SOME (proto_case_scheme as (_, case_pats)) => 
  324.60 -      SOME (1 + (if null case_pats then 1 else length case_pats), proto_case_scheme)
  324.61 -  | NONE => NONE
  324.62 -
  324.63  fun ensure_class thy (algbr as (_, algebra)) funcgr class =
  324.64    let
  324.65      val superclasses = (Sorts.minimize_sort algebra o Sorts.super_classes algebra) class;
  324.66 @@ -526,9 +495,8 @@
  324.67  and translate_tyvar_sort thy (algbr as (proj_sort, _)) funcgr (v, sort) =
  324.68    fold_map (ensure_class thy algbr funcgr) (proj_sort sort)
  324.69    #>> (fn sort => (unprefix "'" v, sort))
  324.70 -and translate_typ thy algbr funcgr (TFree v_sort) =
  324.71 -      translate_tyvar_sort thy algbr funcgr v_sort
  324.72 -      #>> (fn (v, sort) => ITyVar v)
  324.73 +and translate_typ thy algbr funcgr (TFree (v, _)) =
  324.74 +      pair (ITyVar (unprefix "'" v))
  324.75    | translate_typ thy algbr funcgr (Type (tyco, tys)) =
  324.76        ensure_tyco thy algbr funcgr tyco
  324.77        ##>> fold_map (translate_typ thy algbr funcgr) tys
  324.78 @@ -543,16 +511,8 @@
  324.79            Global ((class, tyco), yss)
  324.80        | class_relation (Local (classrels, v), subclass) superclass =
  324.81            Local ((subclass, superclass) :: classrels, v);
  324.82 -    fun norm_typargs ys =
  324.83 -      let
  324.84 -        val raw_sort = map snd ys;
  324.85 -        val sort = Sorts.minimize_sort algebra raw_sort;
  324.86 -      in
  324.87 -        map_filter (fn (y, class) =>
  324.88 -          if member (op =) sort class then SOME y else NONE) ys
  324.89 -      end;
  324.90      fun type_constructor tyco yss class =
  324.91 -      Global ((class, tyco), map norm_typargs yss);
  324.92 +      Global ((class, tyco), (map o map) fst yss);
  324.93      fun type_variable (TFree (v, sort)) =
  324.94        let
  324.95          val sort' = proj_sort sort;
  324.96 @@ -622,9 +582,8 @@
  324.97      fun stmt_classparam class =
  324.98        ensure_class thy algbr funcgr class
  324.99        #>> (fn class => Classparam (c, class));
 324.100 -    fun stmt_fun ((vs, raw_ty), raw_thms) =
 324.101 +    fun stmt_fun ((vs, ty), raw_thms) =
 324.102        let
 324.103 -        val ty = Logic.unvarifyT raw_ty;
 324.104          val thms = if null (Term.add_tfreesT ty []) orelse (null o fst o strip_type) ty
 324.105            then raw_thms
 324.106            else (map o apfst) (Code_Unit.expand_eta thy 1) raw_thms;
 324.107 @@ -638,7 +597,7 @@
 324.108       of SOME tyco => stmt_datatypecons tyco
 324.109        | NONE => (case AxClass.class_of_param thy c
 324.110           of SOME class => stmt_classparam class
 324.111 -          | NONE => stmt_fun (Code_Funcgr.typ funcgr c, Code_Funcgr.eqns funcgr c))
 324.112 +          | NONE => stmt_fun (Code_Wellsorted.typ funcgr c, Code_Wellsorted.eqns funcgr c))
 324.113    in ensure_stmt lookup_const (declare_const thy) stmt_const c end
 324.114  and translate_term thy algbr funcgr thm (Const (c, ty)) =
 324.115        translate_app thy algbr funcgr thm ((c, ty), [])
 324.116 @@ -663,7 +622,7 @@
 324.117  and translate_const thy algbr funcgr thm (c, ty) =
 324.118    let
 324.119      val tys = Sign.const_typargs thy (c, ty);
 324.120 -    val sorts = (map snd o fst o Code_Funcgr.typ funcgr) c;
 324.121 +    val sorts = (map snd o fst o Code_Wellsorted.typ funcgr) c;
 324.122      val tys_args = (fst o Term.strip_type) ty;
 324.123    in
 324.124      ensure_const thy algbr funcgr c
 324.125 @@ -671,7 +630,7 @@
 324.126      ##>> fold_map (translate_typ thy algbr funcgr) tys_args
 324.127      #>> (fn ((c, iss), tys) => IConst (c, (iss, tys)))
 324.128    end
 324.129 -and translate_app_default thy algbr funcgr thm (c_ty, ts) =
 324.130 +and translate_app_const thy algbr funcgr thm (c_ty, ts) =
 324.131    translate_const thy algbr funcgr thm c_ty
 324.132    ##>> fold_map (translate_term thy algbr funcgr thm) ts
 324.133    #>> (fn (t, ts) => t `$$ ts)
 324.134 @@ -683,11 +642,6 @@
 324.135      val ts_clause = nth_drop t_pos ts;
 324.136      fun mk_clause (co, num_co_args) t =
 324.137        let
 324.138 -        val _ = if (is_some o Code.get_datatype_of_constr thy) co then ()
 324.139 -          else error ("Non-constructor " ^ quote co
 324.140 -            ^ " encountered in case pattern"
 324.141 -            ^ (case thm of NONE => ""
 324.142 -              | SOME thm => ", in equation\n" ^ Display.string_of_thm thm))
 324.143          val (vs, body) = Term.strip_abs_eta num_co_args t;
 324.144          val not_undefined = case body
 324.145           of (Const (c, _)) => not (Code.is_undefined thy c)
 324.146 @@ -722,26 +676,28 @@
 324.147        #>> pair b) clauses
 324.148      #>> (fn (((const, t), ty), ds) => mk_icase const t ty ds)
 324.149    end
 324.150 -and translate_app thy algbr funcgr thm ((c, ty), ts) = case get_case_scheme thy c
 324.151 - of SOME (case_scheme as (num_args, _)) =>
 324.152 -      if length ts < num_args then
 324.153 -        let
 324.154 -          val k = length ts;
 324.155 -          val tys = (curry Library.take (num_args - k) o curry Library.drop k o fst o strip_type) ty;
 324.156 -          val ctxt = (fold o fold_aterms) Term.declare_term_frees ts Name.context;
 324.157 -          val vs = Name.names ctxt "a" tys;
 324.158 -        in
 324.159 -          fold_map (translate_typ thy algbr funcgr) tys
 324.160 -          ##>> translate_case thy algbr funcgr thm case_scheme ((c, ty), ts @ map Free vs)
 324.161 -          #>> (fn (tys, t) => map2 (fn (v, _) => pair v) vs tys `|--> t)
 324.162 -        end
 324.163 -      else if length ts > num_args then
 324.164 -        translate_case thy algbr funcgr thm case_scheme ((c, ty), Library.take (num_args, ts))
 324.165 -        ##>> fold_map (translate_term thy algbr funcgr thm) (Library.drop (num_args, ts))
 324.166 -        #>> (fn (t, ts) => t `$$ ts)
 324.167 -      else
 324.168 -        translate_case thy algbr funcgr thm case_scheme ((c, ty), ts)
 324.169 -  | NONE => translate_app_default thy algbr funcgr thm ((c, ty), ts);
 324.170 +and translate_app_case thy algbr funcgr thm (case_scheme as (num_args, _)) ((c, ty), ts) =
 324.171 +  if length ts < num_args then
 324.172 +    let
 324.173 +      val k = length ts;
 324.174 +      val tys = (curry Library.take (num_args - k) o curry Library.drop k o fst o strip_type) ty;
 324.175 +      val ctxt = (fold o fold_aterms) Term.declare_term_frees ts Name.context;
 324.176 +      val vs = Name.names ctxt "a" tys;
 324.177 +    in
 324.178 +      fold_map (translate_typ thy algbr funcgr) tys
 324.179 +      ##>> translate_case thy algbr funcgr thm case_scheme ((c, ty), ts @ map Free vs)
 324.180 +      #>> (fn (tys, t) => map2 (fn (v, _) => pair v) vs tys `|--> t)
 324.181 +    end
 324.182 +  else if length ts > num_args then
 324.183 +    translate_case thy algbr funcgr thm case_scheme ((c, ty), Library.take (num_args, ts))
 324.184 +    ##>> fold_map (translate_term thy algbr funcgr thm) (Library.drop (num_args, ts))
 324.185 +    #>> (fn (t, ts) => t `$$ ts)
 324.186 +  else
 324.187 +    translate_case thy algbr funcgr thm case_scheme ((c, ty), ts)
 324.188 +and translate_app thy algbr funcgr thm (c_ty_ts as ((c, _), _)) =
 324.189 +  case Code.get_case_scheme thy c
 324.190 +   of SOME case_scheme => translate_app_case thy algbr funcgr thm case_scheme c_ty_ts
 324.191 +    | NONE => translate_app_const thy algbr funcgr thm c_ty_ts;
 324.192  
 324.193  
 324.194  (* store *)
 324.195 @@ -779,7 +735,7 @@
 324.196      fun generate_consts thy algebra funcgr =
 324.197        fold_map (ensure_const thy algebra funcgr);
 324.198    in
 324.199 -    invoke_generation thy (Code_Funcgr.make thy cs) generate_consts cs
 324.200 +    invoke_generation thy (Code_Wellsorted.make thy cs) generate_consts cs
 324.201      |-> project_consts
 324.202    end;
 324.203  
 324.204 @@ -822,8 +778,8 @@
 324.205        in evaluator'' naming program vs_ty_t deps end;
 324.206    in (t', evaluator') end
 324.207  
 324.208 -fun eval_conv thy = Code_Funcgr.eval_conv thy o eval thy;
 324.209 -fun eval_term thy = Code_Funcgr.eval_term thy o eval thy;
 324.210 +fun eval_conv thy = Code_Wellsorted.eval_conv thy o eval thy;
 324.211 +fun eval_term thy = Code_Wellsorted.eval_term thy o eval thy;
 324.212  
 324.213  end; (*struct*)
 324.214  
   325.1 --- a/src/Tools/float.ML	Wed Mar 04 10:43:39 2009 +0100
   325.2 +++ b/src/Tools/float.ML	Wed Mar 04 10:45:52 2009 +0100
   325.3 @@ -1,5 +1,4 @@
   325.4  (*  Title:      Tools/float.ML
   325.5 -    ID:         $Id$
   325.6      Author:     Steven Obua, Florian Haftmann, TU Muenchen
   325.7  
   325.8  Implementation of real numbers as mantisse-exponent pairs.
   326.1 --- a/src/Tools/induct.ML	Wed Mar 04 10:43:39 2009 +0100
   326.2 +++ b/src/Tools/induct.ML	Wed Mar 04 10:45:52 2009 +0100
   326.3 @@ -552,7 +552,7 @@
   326.4    let
   326.5      fun add (SOME (SOME x, t)) ctxt =
   326.6            let val ([(lhs, (_, th))], ctxt') =
   326.7 -            LocalDefs.add_defs [((x, NoSyn), ((Binding.empty, []), t))] ctxt
   326.8 +            LocalDefs.add_defs [((x, NoSyn), (Thm.empty_binding, t))] ctxt
   326.9            in ((SOME lhs, [th]), ctxt') end
  326.10        | add (SOME (NONE, t)) ctxt = ((SOME t, []), ctxt)
  326.11        | add NONE ctxt = ((NONE, []), ctxt);
   327.1 --- a/src/Tools/induct_tacs.ML	Wed Mar 04 10:43:39 2009 +0100
   327.2 +++ b/src/Tools/induct_tacs.ML	Wed Mar 04 10:45:52 2009 +0100
   327.3 @@ -1,5 +1,4 @@
   327.4  (*  Title:      Tools/induct_tacs.ML
   327.5 -    ID:         $Id$
   327.6      Author:     Makarius
   327.7  
   327.8  Unstructured induction and cases analysis.
   328.1 --- a/src/Tools/nbe.ML	Wed Mar 04 10:43:39 2009 +0100
   328.2 +++ b/src/Tools/nbe.ML	Wed Mar 04 10:45:52 2009 +0100
   328.3 @@ -389,8 +389,8 @@
   328.4              val ts' = take_until is_dict ts;
   328.5              val c = const_of_idx idx;
   328.6              val (_, T) = Code.default_typscheme thy c;
   328.7 -            val T' = map_type_tvar (fn ((v, i), S) => TypeInfer.param (typidx + i) (v, [])) T;
   328.8 -            val typidx' = typidx + maxidx_of_typ T' + 1;
   328.9 +            val T' = map_type_tfree (fn (v, _) => TypeInfer.param typidx (v, [])) T;
  328.10 +            val typidx' = typidx + 1;
  328.11            in of_apps bounds (Term.Const (c, T'), ts') typidx' end
  328.12        | of_univ bounds (Free (name, ts)) typidx =
  328.13            of_apps bounds (Term.Free (name, dummyT), ts) typidx
   329.1 --- a/src/Tools/random_word.ML	Wed Mar 04 10:43:39 2009 +0100
   329.2 +++ b/src/Tools/random_word.ML	Wed Mar 04 10:45:52 2009 +0100
   329.3 @@ -1,5 +1,4 @@
   329.4  (*  Title:      Tools/random_word.ML
   329.5 -    ID:         $Id$
   329.6      Author:     Makarius
   329.7  
   329.8  Simple generator for pseudo-random numbers, using unboxed word
   330.1 --- a/src/Tools/rat.ML	Wed Mar 04 10:43:39 2009 +0100
   330.2 +++ b/src/Tools/rat.ML	Wed Mar 04 10:45:52 2009 +0100
   330.3 @@ -1,5 +1,4 @@
   330.4  (*  Title:      Tools/rat.ML
   330.5 -    ID:         $Id$
   330.6      Author:     Tobias Nipkow, Florian Haftmann, TU Muenchen
   330.7  
   330.8  Canonical implementation of exact rational numbers.
   331.1 --- a/src/ZF/Tools/datatype_package.ML	Wed Mar 04 10:43:39 2009 +0100
   331.2 +++ b/src/ZF/Tools/datatype_package.ML	Wed Mar 04 10:45:52 2009 +0100
   331.3 @@ -1,5 +1,4 @@
   331.4  (*  Title:      ZF/Tools/datatype_package.ML
   331.5 -    ID:         $Id$
   331.6      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
   331.7      Copyright   1994  University of Cambridge
   331.8  
   331.9 @@ -140,11 +139,11 @@
  331.10    (*Treatment of a list of constructors, for one part
  331.11      Result adds a list of terms, each a function variable with arguments*)
  331.12    fun add_case_list (con_ty_list, (opno, case_lists)) =
  331.13 -    let val (opno', case_list) = foldr add_case (opno, []) con_ty_list
  331.14 +    let val (opno', case_list) = List.foldr add_case (opno, []) con_ty_list
  331.15      in (opno', case_list :: case_lists) end;
  331.16  
  331.17    (*Treatment of all parts*)
  331.18 -  val (_, case_lists) = foldr add_case_list (1,[]) con_ty_lists;
  331.19 +  val (_, case_lists) = List.foldr add_case_list (1,[]) con_ty_lists;
  331.20  
  331.21    (*extract the types of all the variables*)
  331.22    val case_typ = List.concat (map (map (#2 o #1)) con_ty_lists) ---> @{typ "i => i"};
  331.23 @@ -184,7 +183,7 @@
  331.24            val rec_args = map (make_rec_call (rev case_args,0))
  331.25                           (List.drop(recursor_args, ncase_args))
  331.26        in
  331.27 -          foldr add_abs
  331.28 +          List.foldr add_abs
  331.29              (list_comb (recursor_var,
  331.30                          bound_args @ rec_args)) case_args
  331.31        end
  331.32 @@ -216,7 +215,7 @@
  331.33    val rec_ty_lists = (map (map rec_ty_elem) con_ty_lists);
  331.34  
  331.35    (*Treatment of all parts*)
  331.36 -  val (_, recursor_lists) = foldr add_case_list (1,[]) rec_ty_lists;
  331.37 +  val (_, recursor_lists) = List.foldr add_case_list (1,[]) rec_ty_lists;
  331.38  
  331.39    (*extract the types of all the variables*)
  331.40    val recursor_typ = List.concat (map (map (#2 o #1)) rec_ty_lists) ---> @{typ "i => i"};
   332.1 --- a/src/ZF/Tools/inductive_package.ML	Wed Mar 04 10:43:39 2009 +0100
   332.2 +++ b/src/ZF/Tools/inductive_package.ML	Wed Mar 04 10:45:52 2009 +0100
   332.3 @@ -65,7 +65,7 @@
   332.4    val _ = Theory.requires thy "Inductive_ZF" "(co)inductive definitions";
   332.5    val ctxt = ProofContext.init thy;
   332.6  
   332.7 -  val intr_specs = map (apfst (apfst Binding.base_name)) raw_intr_specs;
   332.8 +  val intr_specs = map (apfst (apfst Binding.name_of)) raw_intr_specs;
   332.9    val (intr_names, intr_tms) = split_list (map fst intr_specs);
  332.10    val case_names = RuleCases.case_names intr_names;
  332.11  
  332.12 @@ -99,7 +99,7 @@
  332.13                 Syntax.string_of_term ctxt t);
  332.14  
  332.15    (*** Construct the fixedpoint definition ***)
  332.16 -  val mk_variant = Name.variant (foldr OldTerm.add_term_names [] intr_tms);
  332.17 +  val mk_variant = Name.variant (List.foldr OldTerm.add_term_names [] intr_tms);
  332.18  
  332.19    val z' = mk_variant"z" and X' = mk_variant"X" and w' = mk_variant"w";
  332.20  
  332.21 @@ -113,7 +113,7 @@
  332.22          val dummy = List.app (fn rec_hd => List.app (chk_prem rec_hd) prems) rec_hds
  332.23          val exfrees = OldTerm.term_frees intr \\ rec_params
  332.24          val zeq = FOLogic.mk_eq (Free(z',iT), #1 (rule_concl intr))
  332.25 -    in foldr FOLogic.mk_exists
  332.26 +    in List.foldr FOLogic.mk_exists
  332.27               (BalancedTree.make FOLogic.mk_conj (zeq::prems)) exfrees
  332.28      end;
  332.29  
  332.30 @@ -303,7 +303,7 @@
  332.31       (*Make a premise of the induction rule.*)
  332.32       fun induct_prem ind_alist intr =
  332.33         let val quantfrees = map dest_Free (OldTerm.term_frees intr \\ rec_params)
  332.34 -           val iprems = foldr (add_induct_prem ind_alist) []
  332.35 +           val iprems = List.foldr (add_induct_prem ind_alist) []
  332.36                                (Logic.strip_imp_prems intr)
  332.37             val (t,X) = Ind_Syntax.rule_concl intr
  332.38             val (SOME pred) = AList.lookup (op aconv) ind_alist X
  332.39 @@ -380,7 +380,7 @@
  332.40             val pfree = Free(pred_name ^ "_" ^ Sign.base_name rec_name,
  332.41                              elem_factors ---> FOLogic.oT)
  332.42             val qconcl =
  332.43 -             foldr FOLogic.mk_all
  332.44 +             List.foldr FOLogic.mk_all
  332.45                 (FOLogic.imp $
  332.46                  (@{const mem} $ elem_tuple $ rec_tm)
  332.47                        $ (list_comb (pfree, elem_frees))) elem_frees
   333.1 --- a/src/ZF/Tools/primrec_package.ML	Wed Mar 04 10:43:39 2009 +0100
   333.2 +++ b/src/ZF/Tools/primrec_package.ML	Wed Mar 04 10:45:52 2009 +0100
   333.3 @@ -120,7 +120,7 @@
   333.4                | SOME (rhs, cargs', eq) =>
   333.5                      (rhs, inst_recursor (recursor_pair, cargs'), eq)
   333.6            val allowed_terms = map use_fabs (#2 (strip_comb recursor_rhs))
   333.7 -          val abs = foldr absterm rhs allowed_terms
   333.8 +          val abs = List.foldr absterm rhs allowed_terms
   333.9        in
  333.10            if !Ind_Syntax.trace then
  333.11                writeln ("recursor_rhs = " ^
  333.12 @@ -145,7 +145,7 @@
  333.13      val def_tm = Logic.mk_equals
  333.14                      (subst_bound (rec_arg, fabs),
  333.15                       list_comb (recursor,
  333.16 -                                foldr add_case [] (cnames ~~ recursor_pairs))
  333.17 +                                List.foldr add_case [] (cnames ~~ recursor_pairs))
  333.18                       $ rec_arg)
  333.19  
  333.20    in
  333.21 @@ -164,7 +164,7 @@
  333.22    let
  333.23      val ((eqn_names, eqn_terms), eqn_atts) = apfst split_list (split_list args);
  333.24      val SOME (fname, ftype, ls, rs, con_info, eqns) =
  333.25 -      foldr (process_eqn thy) NONE eqn_terms;
  333.26 +      List.foldr (process_eqn thy) NONE eqn_terms;
  333.27      val def = process_fun thy (fname, ftype, ls, rs, con_info, eqns);
  333.28  
  333.29      val ([def_thm], thy1) = thy