Merged.
authorballarin
Thu Oct 01 20:52:18 2009 +0200 (2009-10-01)
changeset 3284788b58880d52c
parent 32846 29941e925c82
parent 32837 3a2fa964ad08
child 32848 484863ae9b98
Merged.
src/Pure/Concurrent/par_list_dummy.ML
src/Pure/Concurrent/synchronized_dummy.ML
src/Pure/General/lazy.ML
src/Pure/Isar/expression.ML
     1.1 --- a/doc-src/Codegen/Thy/Setup.thy	Thu Oct 01 20:49:46 2009 +0200
     1.2 +++ b/doc-src/Codegen/Thy/Setup.thy	Thu Oct 01 20:52:18 2009 +0200
     1.3 @@ -10,6 +10,6 @@
     1.4     "~~/src/HOL/Decision_Procs/Ferrack"] *}
     1.5  
     1.6  ML_command {* Code_Target.code_width := 74 *}
     1.7 -ML_command {* reset unique_names *}
     1.8 +ML_command {* Unsynchronized.reset unique_names *}
     1.9  
    1.10  end
     2.1 --- a/doc-src/IsarImplementation/Thy/Integration.thy	Thu Oct 01 20:49:46 2009 +0200
     2.2 +++ b/doc-src/IsarImplementation/Thy/Integration.thy	Thu Oct 01 20:52:18 2009 +0200
     2.3 @@ -59,9 +59,9 @@
     2.4    @{index_ML Toplevel.is_toplevel: "Toplevel.state -> bool"} \\
     2.5    @{index_ML Toplevel.theory_of: "Toplevel.state -> theory"} \\
     2.6    @{index_ML Toplevel.proof_of: "Toplevel.state -> Proof.state"} \\
     2.7 -  @{index_ML Toplevel.debug: "bool ref"} \\
     2.8 -  @{index_ML Toplevel.timing: "bool ref"} \\
     2.9 -  @{index_ML Toplevel.profiling: "int ref"} \\
    2.10 +  @{index_ML Toplevel.debug: "bool Unsynchronized.ref"} \\
    2.11 +  @{index_ML Toplevel.timing: "bool Unsynchronized.ref"} \\
    2.12 +  @{index_ML Toplevel.profiling: "int Unsynchronized.ref"} \\
    2.13    \end{mldecls}
    2.14  
    2.15    \begin{description}
    2.16 @@ -85,11 +85,11 @@
    2.17    \item @{ML Toplevel.proof_of}~@{text "state"} selects the Isar proof
    2.18    state if available, otherwise raises @{ML Toplevel.UNDEF}.
    2.19  
    2.20 -  \item @{ML "set Toplevel.debug"} makes the toplevel print further
    2.21 +  \item @{ML "Toplevel.debug := true"} makes the toplevel print further
    2.22    details about internal error conditions, exceptions being raised
    2.23    etc.
    2.24  
    2.25 -  \item @{ML "set Toplevel.timing"} makes the toplevel print timing
    2.26 +  \item @{ML "Toplevel.timing := true"} makes the toplevel print timing
    2.27    information for each Isar command being executed.
    2.28  
    2.29    \item @{ML Toplevel.profiling}~@{verbatim ":="}~@{text "n"} controls
     3.1 --- a/doc-src/IsarImplementation/Thy/Logic.thy	Thu Oct 01 20:49:46 2009 +0200
     3.2 +++ b/doc-src/IsarImplementation/Thy/Logic.thy	Thu Oct 01 20:52:18 2009 +0200
     3.3 @@ -547,7 +547,7 @@
     3.4    \end{mldecls}
     3.5    \begin{mldecls}
     3.6    @{index_ML_type thm} \\
     3.7 -  @{index_ML proofs: "int ref"} \\
     3.8 +  @{index_ML proofs: "int Unsynchronized.ref"} \\
     3.9    @{index_ML Thm.assume: "cterm -> thm"} \\
    3.10    @{index_ML Thm.forall_intr: "cterm -> thm -> thm"} \\
    3.11    @{index_ML Thm.forall_elim: "cterm -> thm -> thm"} \\
     4.1 --- a/doc-src/IsarImplementation/Thy/ML.thy	Thu Oct 01 20:49:46 2009 +0200
     4.2 +++ b/doc-src/IsarImplementation/Thy/ML.thy	Thu Oct 01 20:52:18 2009 +0200
     4.3 @@ -258,7 +258,7 @@
     4.4    \begin{mldecls}
     4.5    @{index_ML NAMED_CRITICAL: "string -> (unit -> 'a) -> 'a"} \\
     4.6    @{index_ML CRITICAL: "(unit -> 'a) -> 'a"} \\
     4.7 -  @{index_ML setmp: "'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c"} \\
     4.8 +  @{index_ML setmp: "'a Unsynchronized.ref -> 'a -> ('b -> 'c) -> 'b -> 'c"} \\
     4.9    \end{mldecls}
    4.10  
    4.11    \begin{description}
     5.1 --- a/doc-src/IsarImplementation/Thy/document/Integration.tex	Thu Oct 01 20:49:46 2009 +0200
     5.2 +++ b/doc-src/IsarImplementation/Thy/document/Integration.tex	Thu Oct 01 20:52:18 2009 +0200
     5.3 @@ -86,9 +86,9 @@
     5.4    \indexdef{}{ML}{Toplevel.is\_toplevel}\verb|Toplevel.is_toplevel: Toplevel.state -> bool| \\
     5.5    \indexdef{}{ML}{Toplevel.theory\_of}\verb|Toplevel.theory_of: Toplevel.state -> theory| \\
     5.6    \indexdef{}{ML}{Toplevel.proof\_of}\verb|Toplevel.proof_of: Toplevel.state -> Proof.state| \\
     5.7 -  \indexdef{}{ML}{Toplevel.debug}\verb|Toplevel.debug: bool ref| \\
     5.8 -  \indexdef{}{ML}{Toplevel.timing}\verb|Toplevel.timing: bool ref| \\
     5.9 -  \indexdef{}{ML}{Toplevel.profiling}\verb|Toplevel.profiling: int ref| \\
    5.10 +  \indexdef{}{ML}{Toplevel.debug}\verb|Toplevel.debug: bool Unsynchronized.ref| \\
    5.11 +  \indexdef{}{ML}{Toplevel.timing}\verb|Toplevel.timing: bool Unsynchronized.ref| \\
    5.12 +  \indexdef{}{ML}{Toplevel.profiling}\verb|Toplevel.profiling: int Unsynchronized.ref| \\
    5.13    \end{mldecls}
    5.14  
    5.15    \begin{description}
    5.16 @@ -112,11 +112,11 @@
    5.17    \item \verb|Toplevel.proof_of|~\isa{state} selects the Isar proof
    5.18    state if available, otherwise raises \verb|Toplevel.UNDEF|.
    5.19  
    5.20 -  \item \verb|set Toplevel.debug| makes the toplevel print further
    5.21 +  \item \verb|Toplevel.debug := true| makes the toplevel print further
    5.22    details about internal error conditions, exceptions being raised
    5.23    etc.
    5.24  
    5.25 -  \item \verb|set Toplevel.timing| makes the toplevel print timing
    5.26 +  \item \verb|Toplevel.timing := true| makes the toplevel print timing
    5.27    information for each Isar command being executed.
    5.28  
    5.29    \item \verb|Toplevel.profiling|~\verb|:=|~\isa{n} controls
     6.1 --- a/doc-src/IsarImplementation/Thy/document/Logic.tex	Thu Oct 01 20:49:46 2009 +0200
     6.2 +++ b/doc-src/IsarImplementation/Thy/document/Logic.tex	Thu Oct 01 20:52:18 2009 +0200
     6.3 @@ -546,7 +546,7 @@
     6.4    \end{mldecls}
     6.5    \begin{mldecls}
     6.6    \indexdef{}{ML type}{thm}\verb|type thm| \\
     6.7 -  \indexdef{}{ML}{proofs}\verb|proofs: int ref| \\
     6.8 +  \indexdef{}{ML}{proofs}\verb|proofs: int Unsynchronized.ref| \\
     6.9    \indexdef{}{ML}{Thm.assume}\verb|Thm.assume: cterm -> thm| \\
    6.10    \indexdef{}{ML}{Thm.forall\_intr}\verb|Thm.forall_intr: cterm -> thm -> thm| \\
    6.11    \indexdef{}{ML}{Thm.forall\_elim}\verb|Thm.forall_elim: cterm -> thm -> thm| \\
     7.1 --- a/doc-src/IsarImplementation/Thy/document/ML.tex	Thu Oct 01 20:49:46 2009 +0200
     7.2 +++ b/doc-src/IsarImplementation/Thy/document/ML.tex	Thu Oct 01 20:52:18 2009 +0200
     7.3 @@ -277,7 +277,7 @@
     7.4  \begin{mldecls}
     7.5    \indexdef{}{ML}{NAMED\_CRITICAL}\verb|NAMED_CRITICAL: string -> (unit -> 'a) -> 'a| \\
     7.6    \indexdef{}{ML}{CRITICAL}\verb|CRITICAL: (unit -> 'a) -> 'a| \\
     7.7 -  \indexdef{}{ML}{setmp}\verb|setmp: 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
     7.8 +  \indexdef{}{ML}{setmp}\verb|setmp: 'a Unsynchronized.ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
     7.9    \end{mldecls}
    7.10  
    7.11    \begin{description}
     8.1 --- a/doc-src/IsarOverview/Isar/Logic.thy	Thu Oct 01 20:49:46 2009 +0200
     8.2 +++ b/doc-src/IsarOverview/Isar/Logic.thy	Thu Oct 01 20:52:18 2009 +0200
     8.3 @@ -526,7 +526,6 @@
     8.4  tendency to use the default introduction and elimination rules to
     8.5  decompose goals and facts. This can lead to very tedious proofs:
     8.6  *}
     8.7 -(*<*)ML"set quick_and_dirty"(*>*)
     8.8  lemma "\<forall>x y. A x y \<and> B x y \<longrightarrow> C x y"
     8.9  proof
    8.10    fix x show "\<forall>y. A x y \<and> B x y \<longrightarrow> C x y"
     9.1 --- a/doc-src/IsarOverview/Isar/ROOT.ML	Thu Oct 01 20:49:46 2009 +0200
     9.2 +++ b/doc-src/IsarOverview/Isar/ROOT.ML	Thu Oct 01 20:52:18 2009 +0200
     9.3 @@ -1,2 +1,3 @@
     9.4 -use_thy "Logic";
     9.5 -use_thy "Induction"
     9.6 +Unsynchronized.set quick_and_dirty;
     9.7 +
     9.8 +use_thys ["Logic", "Induction"];
    10.1 --- a/doc-src/IsarOverview/Isar/document/Logic.tex	Thu Oct 01 20:49:46 2009 +0200
    10.2 +++ b/doc-src/IsarOverview/Isar/document/Logic.tex	Thu Oct 01 20:52:18 2009 +0200
    10.3 @@ -1228,19 +1228,6 @@
    10.4  decompose goals and facts. This can lead to very tedious proofs:%
    10.5  \end{isamarkuptext}%
    10.6  \isamarkuptrue%
    10.7 -%
    10.8 -\isadelimML
    10.9 -%
   10.10 -\endisadelimML
   10.11 -%
   10.12 -\isatagML
   10.13 -%
   10.14 -\endisatagML
   10.15 -{\isafoldML}%
   10.16 -%
   10.17 -\isadelimML
   10.18 -%
   10.19 -\endisadelimML
   10.20  \isacommand{lemma}\isamarkupfalse%
   10.21  \ {\isachardoublequoteopen}{\isasymforall}x\ y{\isachardot}\ A\ x\ y\ {\isasymand}\ B\ x\ y\ {\isasymlongrightarrow}\ C\ x\ y{\isachardoublequoteclose}\isanewline
   10.22  %
    11.1 --- a/doc-src/IsarRef/Thy/Inner_Syntax.thy	Thu Oct 01 20:49:46 2009 +0200
    11.2 +++ b/doc-src/IsarRef/Thy/Inner_Syntax.thy	Thu Oct 01 20:52:18 2009 +0200
    11.3 @@ -96,19 +96,19 @@
    11.4  
    11.5  text {*
    11.6    \begin{mldecls} 
    11.7 -    @{index_ML show_types: "bool ref"} & default @{ML false} \\
    11.8 -    @{index_ML show_sorts: "bool ref"} & default @{ML false} \\
    11.9 -    @{index_ML show_consts: "bool ref"} & default @{ML false} \\
   11.10 -    @{index_ML long_names: "bool ref"} & default @{ML false} \\
   11.11 -    @{index_ML short_names: "bool ref"} & default @{ML false} \\
   11.12 -    @{index_ML unique_names: "bool ref"} & default @{ML true} \\
   11.13 -    @{index_ML show_brackets: "bool ref"} & default @{ML false} \\
   11.14 -    @{index_ML eta_contract: "bool ref"} & default @{ML true} \\
   11.15 -    @{index_ML goals_limit: "int ref"} & default @{ML 10} \\
   11.16 -    @{index_ML Proof.show_main_goal: "bool ref"} & default @{ML false} \\
   11.17 -    @{index_ML show_hyps: "bool ref"} & default @{ML false} \\
   11.18 -    @{index_ML show_tags: "bool ref"} & default @{ML false} \\
   11.19 -    @{index_ML show_question_marks: "bool ref"} & default @{ML true} \\
   11.20 +    @{index_ML show_types: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.21 +    @{index_ML show_sorts: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.22 +    @{index_ML show_consts: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.23 +    @{index_ML long_names: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.24 +    @{index_ML short_names: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.25 +    @{index_ML unique_names: "bool Unsynchronized.ref"} & default @{ML true} \\
   11.26 +    @{index_ML show_brackets: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.27 +    @{index_ML eta_contract: "bool Unsynchronized.ref"} & default @{ML true} \\
   11.28 +    @{index_ML goals_limit: "int Unsynchronized.ref"} & default @{ML 10} \\
   11.29 +    @{index_ML Proof.show_main_goal: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.30 +    @{index_ML show_hyps: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.31 +    @{index_ML show_tags: "bool Unsynchronized.ref"} & default @{ML false} \\
   11.32 +    @{index_ML show_question_marks: "bool Unsynchronized.ref"} & default @{ML true} \\
   11.33    \end{mldecls}
   11.34  
   11.35    These global ML variables control the detail of information that is
    12.1 --- a/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Thu Oct 01 20:49:46 2009 +0200
    12.2 +++ b/doc-src/IsarRef/Thy/ROOT-HOLCF.ML	Thu Oct 01 20:52:18 2009 +0200
    12.3 @@ -1,4 +1,4 @@
    12.4 -set ThyOutput.source;
    12.5 +Unsynchronized.set ThyOutput.source;
    12.6  use "../../antiquote_setup.ML";
    12.7  
    12.8  use_thy "HOLCF_Specific";
    13.1 --- a/doc-src/IsarRef/Thy/ROOT-ZF.ML	Thu Oct 01 20:49:46 2009 +0200
    13.2 +++ b/doc-src/IsarRef/Thy/ROOT-ZF.ML	Thu Oct 01 20:52:18 2009 +0200
    13.3 @@ -1,4 +1,4 @@
    13.4 -set ThyOutput.source;
    13.5 +Unsynchronized.set ThyOutput.source;
    13.6  use "../../antiquote_setup.ML";
    13.7  
    13.8  use_thy "ZF_Specific";
    14.1 --- a/doc-src/IsarRef/Thy/ROOT.ML	Thu Oct 01 20:49:46 2009 +0200
    14.2 +++ b/doc-src/IsarRef/Thy/ROOT.ML	Thu Oct 01 20:52:18 2009 +0200
    14.3 @@ -1,5 +1,5 @@
    14.4 -set quick_and_dirty;
    14.5 -set ThyOutput.source;
    14.6 +Unsynchronized.set quick_and_dirty;
    14.7 +Unsynchronized.set ThyOutput.source;
    14.8  use "../../antiquote_setup.ML";
    14.9  
   14.10  use_thys [
    15.1 --- a/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Thu Oct 01 20:49:46 2009 +0200
    15.2 +++ b/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Thu Oct 01 20:52:18 2009 +0200
    15.3 @@ -118,19 +118,19 @@
    15.4  %
    15.5  \begin{isamarkuptext}%
    15.6  \begin{mldecls} 
    15.7 -    \indexdef{}{ML}{show\_types}\verb|show_types: bool ref| & default \verb|false| \\
    15.8 -    \indexdef{}{ML}{show\_sorts}\verb|show_sorts: bool ref| & default \verb|false| \\
    15.9 -    \indexdef{}{ML}{show\_consts}\verb|show_consts: bool ref| & default \verb|false| \\
   15.10 -    \indexdef{}{ML}{long\_names}\verb|long_names: bool ref| & default \verb|false| \\
   15.11 -    \indexdef{}{ML}{short\_names}\verb|short_names: bool ref| & default \verb|false| \\
   15.12 -    \indexdef{}{ML}{unique\_names}\verb|unique_names: bool ref| & default \verb|true| \\
   15.13 -    \indexdef{}{ML}{show\_brackets}\verb|show_brackets: bool ref| & default \verb|false| \\
   15.14 -    \indexdef{}{ML}{eta\_contract}\verb|eta_contract: bool ref| & default \verb|true| \\
   15.15 -    \indexdef{}{ML}{goals\_limit}\verb|goals_limit: int ref| & default \verb|10| \\
   15.16 -    \indexdef{}{ML}{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool ref| & default \verb|false| \\
   15.17 -    \indexdef{}{ML}{show\_hyps}\verb|show_hyps: bool ref| & default \verb|false| \\
   15.18 -    \indexdef{}{ML}{show\_tags}\verb|show_tags: bool ref| & default \verb|false| \\
   15.19 -    \indexdef{}{ML}{show\_question\_marks}\verb|show_question_marks: bool ref| & default \verb|true| \\
   15.20 +    \indexdef{}{ML}{show\_types}\verb|show_types: bool Unsynchronized.ref| & default \verb|false| \\
   15.21 +    \indexdef{}{ML}{show\_sorts}\verb|show_sorts: bool Unsynchronized.ref| & default \verb|false| \\
   15.22 +    \indexdef{}{ML}{show\_consts}\verb|show_consts: bool Unsynchronized.ref| & default \verb|false| \\
   15.23 +    \indexdef{}{ML}{long\_names}\verb|long_names: bool Unsynchronized.ref| & default \verb|false| \\
   15.24 +    \indexdef{}{ML}{short\_names}\verb|short_names: bool Unsynchronized.ref| & default \verb|false| \\
   15.25 +    \indexdef{}{ML}{unique\_names}\verb|unique_names: bool Unsynchronized.ref| & default \verb|true| \\
   15.26 +    \indexdef{}{ML}{show\_brackets}\verb|show_brackets: bool Unsynchronized.ref| & default \verb|false| \\
   15.27 +    \indexdef{}{ML}{eta\_contract}\verb|eta_contract: bool Unsynchronized.ref| & default \verb|true| \\
   15.28 +    \indexdef{}{ML}{goals\_limit}\verb|goals_limit: int Unsynchronized.ref| & default \verb|10| \\
   15.29 +    \indexdef{}{ML}{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool Unsynchronized.ref| & default \verb|false| \\
   15.30 +    \indexdef{}{ML}{show\_hyps}\verb|show_hyps: bool Unsynchronized.ref| & default \verb|false| \\
   15.31 +    \indexdef{}{ML}{show\_tags}\verb|show_tags: bool Unsynchronized.ref| & default \verb|false| \\
   15.32 +    \indexdef{}{ML}{show\_question\_marks}\verb|show_question_marks: bool Unsynchronized.ref| & default \verb|true| \\
   15.33    \end{mldecls}
   15.34  
   15.35    These global ML variables control the detail of information that is
    16.1 --- a/doc-src/LaTeXsugar/IsaMakefile	Thu Oct 01 20:49:46 2009 +0200
    16.2 +++ b/doc-src/LaTeXsugar/IsaMakefile	Thu Oct 01 20:52:18 2009 +0200
    16.3 @@ -14,7 +14,7 @@
    16.4  OUT = $(ISABELLE_OUTPUT)
    16.5  LOG = $(OUT)/log
    16.6  
    16.7 -USEDIR = $(ISABELLE_TOOL) usedir -v true -i false -g false -d false -D document
    16.8 +USEDIR = $(ISABELLE_TOOL) usedir -v true -i false -g false -d false -D document -M 1
    16.9  
   16.10  
   16.11  ## Sugar
    17.1 --- a/doc-src/LaTeXsugar/Sugar/Sugar.thy	Thu Oct 01 20:49:46 2009 +0200
    17.2 +++ b/doc-src/LaTeXsugar/Sugar/Sugar.thy	Thu Oct 01 20:52:18 2009 +0200
    17.3 @@ -143,7 +143,7 @@
    17.4  internal index. This can be avoided by turning the last digit into a
    17.5  subscript: write \verb!x\<^isub>1! and obtain the much nicer @{text"x\<^isub>1"}. *}
    17.6  
    17.7 -(*<*)ML"reset show_question_marks"(*>*)
    17.8 +(*<*)ML"Unsynchronized.reset show_question_marks"(*>*)
    17.9  
   17.10  subsection {*Qualified names*}
   17.11  
    18.1 --- a/doc-src/Locales/Locales/document/Examples3.tex	Thu Oct 01 20:49:46 2009 +0200
    18.2 +++ b/doc-src/Locales/Locales/document/Examples3.tex	Thu Oct 01 20:52:18 2009 +0200
    18.3 @@ -42,7 +42,7 @@
    18.4  \isatagvisible
    18.5  \isacommand{interpretation}\isamarkupfalse%
    18.6  \ nat{\isacharcolon}\ partial{\isacharunderscore}order\ {\isachardoublequoteopen}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
    18.7 -\ \ \isakeyword{where}\ nat{\isacharunderscore}less{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
    18.8 +\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
    18.9  \isacommand{proof}\isamarkupfalse%
   18.10  \ {\isacharminus}\isanewline
   18.11  \ \ \isacommand{show}\isamarkupfalse%
   18.12 @@ -101,13 +101,12 @@
   18.13  \isatagvisible
   18.14  \isacommand{interpretation}\isamarkupfalse%
   18.15  \ nat{\isacharcolon}\ lattice\ {\isachardoublequoteopen}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
   18.16 -\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
   18.17 -\ \ \ \ \isakeyword{and}\ nat{\isacharunderscore}meet{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ min\ x\ y{\isachardoublequoteclose}\isanewline
   18.18 -\ \ \ \ \isakeyword{and}\ nat{\isacharunderscore}join{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}lattice{\isachardot}join\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ max\ x\ y{\isachardoublequoteclose}\isanewline
   18.19 +\ \ \isakeyword{where}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ min\ x\ y{\isachardoublequoteclose}\isanewline
   18.20 +\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}join\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ max\ x\ y{\isachardoublequoteclose}\isanewline
   18.21  \isacommand{proof}\isamarkupfalse%
   18.22  \ {\isacharminus}\isanewline
   18.23  \ \ \isacommand{show}\isamarkupfalse%
   18.24 -\ lattice{\isacharcolon}\ {\isachardoublequoteopen}lattice\ {\isacharparenleft}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}{\isachardoublequoteclose}%
   18.25 +\ {\isachardoublequoteopen}lattice\ {\isacharparenleft}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}{\isachardoublequoteclose}%
   18.26  \begin{isamarkuptxt}%
   18.27  We have already shown that this is a partial order,%
   18.28  \end{isamarkuptxt}%
   18.29 @@ -134,21 +133,12 @@
   18.30  \ \ \ \ \isacommand{by}\isamarkupfalse%
   18.31  \ arith{\isacharplus}%
   18.32  \begin{isamarkuptxt}%
   18.33 -For the first of the equations, we refer to the theorem
   18.34 -  shown in the previous interpretation.%
   18.35 -\end{isamarkuptxt}%
   18.36 -\isamarkuptrue%
   18.37 -\ \ \isacommand{show}\isamarkupfalse%
   18.38 -\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
   18.39 -\ \ \ \ \isacommand{by}\isamarkupfalse%
   18.40 -\ {\isacharparenleft}rule\ nat{\isacharunderscore}less{\isacharunderscore}eq{\isacharparenright}%
   18.41 -\begin{isamarkuptxt}%
   18.42 -In order to show the remaining equations, we put ourselves in a
   18.43 +In order to show the equations, we put ourselves in a
   18.44      situation where the lattice theorems can be used in a convenient way.%
   18.45  \end{isamarkuptxt}%
   18.46  \isamarkuptrue%
   18.47 -\ \ \isacommand{from}\isamarkupfalse%
   18.48 -\ lattice\ \isacommand{interpret}\isamarkupfalse%
   18.49 +\ \ \isacommand{then}\isamarkupfalse%
   18.50 +\ \isacommand{interpret}\isamarkupfalse%
   18.51  \ nat{\isacharcolon}\ lattice\ {\isachardoublequoteopen}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\ \isacommand{{\isachardot}}\isamarkupfalse%
   18.52  \isanewline
   18.53  \ \ \isacommand{show}\isamarkupfalse%
   18.54 @@ -180,45 +170,8 @@
   18.55  \isatagvisible
   18.56  \isacommand{interpretation}\isamarkupfalse%
   18.57  \ nat{\isacharcolon}\ total{\isacharunderscore}order\ {\isachardoublequoteopen}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
   18.58 -\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
   18.59 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ min\ x\ y{\isachardoublequoteclose}\isanewline
   18.60 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}join\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ max\ x\ y{\isachardoublequoteclose}\isanewline
   18.61 -\isacommand{proof}\isamarkupfalse%
   18.62 -\ {\isacharminus}\isanewline
   18.63 -\ \ \isacommand{show}\isamarkupfalse%
   18.64 -\ {\isachardoublequoteopen}total{\isacharunderscore}order\ {\isacharparenleft}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}{\isachardoublequoteclose}\isanewline
   18.65 -\ \ \ \ \isacommand{by}\isamarkupfalse%
   18.66 -\ unfold{\isacharunderscore}locales\ arith\isanewline
   18.67 -\isacommand{qed}\isamarkupfalse%
   18.68 -\ {\isacharparenleft}rule\ nat{\isacharunderscore}less{\isacharunderscore}eq\ nat{\isacharunderscore}meet{\isacharunderscore}eq\ nat{\isacharunderscore}join{\isacharunderscore}eq{\isacharparenright}{\isacharplus}%
   18.69 -\endisatagvisible
   18.70 -{\isafoldvisible}%
   18.71 -%
   18.72 -\isadelimvisible
   18.73 -%
   18.74 -\endisadelimvisible
   18.75 -%
   18.76 -\begin{isamarkuptext}%
   18.77 -Since the locale hierarchy reflects that total
   18.78 -  orders are distributive lattices, an explicit interpretation of
   18.79 -  distributive lattices for the order relation on natural numbers is
   18.80 -  only necessary for mapping the definitions to the right operators on
   18.81 -  \isa{nat}.%
   18.82 -\end{isamarkuptext}%
   18.83 -\isamarkuptrue%
   18.84 -%
   18.85 -\isadelimvisible
   18.86 -%
   18.87 -\endisadelimvisible
   18.88 -%
   18.89 -\isatagvisible
   18.90 -\isacommand{interpretation}\isamarkupfalse%
   18.91 -\ nat{\isacharcolon}\ distrib{\isacharunderscore}lattice\ {\isachardoublequoteopen}op\ {\isasymle}\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
   18.92 -\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ {\isacharless}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
   18.93 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ min\ x\ y{\isachardoublequoteclose}\isanewline
   18.94 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}join\ op\ {\isasymle}\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ max\ x\ y{\isachardoublequoteclose}\isanewline
   18.95  \ \ \isacommand{by}\isamarkupfalse%
   18.96 -\ unfold{\isacharunderscore}locales\ {\isacharbrackleft}{\isadigit{1}}{\isacharbrackright}\ {\isacharparenleft}rule\ nat{\isacharunderscore}less{\isacharunderscore}eq\ nat{\isacharunderscore}meet{\isacharunderscore}eq\ nat{\isacharunderscore}join{\isacharunderscore}eq{\isacharparenright}{\isacharplus}%
   18.97 +\ unfold{\isacharunderscore}locales\ arith%
   18.98  \endisatagvisible
   18.99  {\isafoldvisible}%
  18.100  %
  18.101 @@ -248,7 +201,30 @@
  18.102  \hrule
  18.103  \caption{Interpreted theorems for \isa{{\isasymle}} on the natural numbers.}
  18.104  \label{tab:nat-lattice}
  18.105 -\end{table}%
  18.106 +\end{table}
  18.107 +
  18.108 +  Note that since the locale hierarchy reflects that total orders are
  18.109 +  distributive lattices, an explicit interpretation of distributive
  18.110 +  lattices for the order relation on natural numbers is not neccessary.
  18.111 +
  18.112 +  Why not push this idea further and just give the last interpretation
  18.113 +  as a single interpretation instead of the sequence of three?  The
  18.114 +  reasons for this are twofold:
  18.115 +\begin{itemize}
  18.116 +\item
  18.117 +  Often it is easier to work in an incremental fashion, because later
  18.118 +  interpretations require theorems provided by earlier
  18.119 +  interpretations.
  18.120 +\item
  18.121 +  Assume that a definition is made in some locale $l_1$, and that $l_2$
  18.122 +  imports $l_1$.  Let an equation for the definition be
  18.123 +  proved in an interpretation of $l_2$.  The equation will be unfolded
  18.124 +  in interpretations of theorems added to $l_2$ or below in the import
  18.125 +  hierarchy, but not for theorems added above $l_2$.
  18.126 +  Hence, an equation interpreting a definition should always be given in
  18.127 +  an interpretation of the locale where the definition is made, not in
  18.128 +  an interpretation of a locale further down the hierarchy.
  18.129 +\end{itemize}%
  18.130  \end{isamarkuptext}%
  18.131  \isamarkuptrue%
  18.132  %
  18.133 @@ -264,8 +240,7 @@
  18.134  \isamarkuptrue%
  18.135  \isacommand{interpretation}\isamarkupfalse%
  18.136  \ nat{\isacharunderscore}dvd{\isacharcolon}\ partial{\isacharunderscore}order\ {\isachardoublequoteopen}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
  18.137 -\ \ \isakeyword{where}\ nat{\isacharunderscore}dvd{\isacharunderscore}less{\isacharunderscore}eq{\isacharcolon}\isanewline
  18.138 -\ \ \ \ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ dvd\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ dvd\ y\ {\isasymand}\ x\ {\isasymnoteq}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.139 +\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ dvd\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ dvd\ y\ {\isasymand}\ x\ {\isasymnoteq}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.140  %
  18.141  \isadelimproof
  18.142  %
  18.143 @@ -306,8 +281,7 @@
  18.144  \isamarkuptrue%
  18.145  \isacommand{interpretation}\isamarkupfalse%
  18.146  \ nat{\isacharunderscore}dvd{\isacharcolon}\ lattice\ {\isachardoublequoteopen}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
  18.147 -\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ dvd\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ dvd\ y\ {\isasymand}\ x\ {\isasymnoteq}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.148 -\ \ \ \ \isakeyword{and}\ nat{\isacharunderscore}dvd{\isacharunderscore}meet{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ gcd{\isachardoublequoteclose}\isanewline
  18.149 +\ \ \isakeyword{where}\ nat{\isacharunderscore}dvd{\isacharunderscore}meet{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ gcd{\isachardoublequoteclose}\isanewline
  18.150  \ \ \ \ \isakeyword{and}\ nat{\isacharunderscore}dvd{\isacharunderscore}join{\isacharunderscore}eq{\isacharcolon}\ {\isachardoublequoteopen}lattice{\isachardot}join\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ lcm{\isachardoublequoteclose}\isanewline
  18.151  %
  18.152  \isadelimproof
  18.153 @@ -338,10 +312,6 @@
  18.154  \ nat{\isacharunderscore}dvd{\isacharcolon}\ lattice\ {\isachardoublequoteopen}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\ \isacommand{{\isachardot}}\isamarkupfalse%
  18.155  \isanewline
  18.156  \ \ \isacommand{show}\isamarkupfalse%
  18.157 -\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ dvd\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ dvd\ y\ {\isasymand}\ x\ {\isasymnoteq}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.158 -\ \ \ \ \isacommand{by}\isamarkupfalse%
  18.159 -\ {\isacharparenleft}rule\ nat{\isacharunderscore}dvd{\isacharunderscore}less{\isacharunderscore}eq{\isacharparenright}\isanewline
  18.160 -\ \ \isacommand{show}\isamarkupfalse%
  18.161  \ {\isachardoublequoteopen}lattice{\isachardot}meet\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ gcd{\isachardoublequoteclose}\isanewline
  18.162  \ \ \ \ \isacommand{apply}\isamarkupfalse%
  18.163  \ {\isacharparenleft}auto\ simp\ add{\isacharcolon}\ expand{\isacharunderscore}fun{\isacharunderscore}eq{\isacharparenright}\isanewline
  18.164 @@ -408,14 +378,7 @@
  18.165  \isacommand{interpretation}\isamarkupfalse%
  18.166  \ nat{\isacharunderscore}dvd{\isacharcolon}\isanewline
  18.167  \ \ distrib{\isacharunderscore}lattice\ {\isachardoublequoteopen}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isachardoublequoteclose}\isanewline
  18.168 -\ \ \isakeyword{where}\ {\isachardoublequoteopen}partial{\isacharunderscore}order{\isachardot}less\ op\ dvd\ {\isacharparenleft}x{\isacharcolon}{\isacharcolon}nat{\isacharparenright}\ y\ {\isacharequal}\ {\isacharparenleft}x\ dvd\ y\ {\isasymand}\ x\ {\isasymnoteq}\ y{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.169 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}meet\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ gcd{\isachardoublequoteclose}\isanewline
  18.170 -\ \ \ \ \isakeyword{and}\ {\isachardoublequoteopen}lattice{\isachardot}join\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isacharequal}\ lcm{\isachardoublequoteclose}\isanewline
  18.171 -\isacommand{proof}\isamarkupfalse%
  18.172 -\ {\isacharminus}\isanewline
  18.173 -\ \ \isacommand{show}\isamarkupfalse%
  18.174 -\ {\isachardoublequoteopen}distrib{\isacharunderscore}lattice\ {\isacharparenleft}op\ dvd\ {\isacharcolon}{\isacharcolon}\ nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ bool{\isacharparenright}{\isachardoublequoteclose}\isanewline
  18.175 -\ \ \ \ \isacommand{apply}\isamarkupfalse%
  18.176 +\ \ \isacommand{apply}\isamarkupfalse%
  18.177  \ unfold{\isacharunderscore}locales%
  18.178  \begin{isamarkuptxt}%
  18.179  \begin{isabelle}%
  18.180 @@ -426,7 +389,7 @@
  18.181  \end{isabelle}%
  18.182  \end{isamarkuptxt}%
  18.183  \isamarkuptrue%
  18.184 -\ \ \ \ \isacommand{apply}\isamarkupfalse%
  18.185 +\ \ \isacommand{apply}\isamarkupfalse%
  18.186  \ {\isacharparenleft}unfold\ nat{\isacharunderscore}dvd{\isacharunderscore}meet{\isacharunderscore}eq\ nat{\isacharunderscore}dvd{\isacharunderscore}join{\isacharunderscore}eq{\isacharparenright}%
  18.187  \begin{isamarkuptxt}%
  18.188  \begin{isabelle}%
  18.189 @@ -434,12 +397,9 @@
  18.190  \end{isabelle}%
  18.191  \end{isamarkuptxt}%
  18.192  \isamarkuptrue%
  18.193 -\ \ \ \ \isacommand{apply}\isamarkupfalse%
  18.194 -\ {\isacharparenleft}rule\ gcd{\isacharunderscore}lcm{\isacharunderscore}distr{\isacharparenright}\isanewline
  18.195 -\ \ \ \ \isacommand{done}\isamarkupfalse%
  18.196 -\isanewline
  18.197 -\isacommand{qed}\isamarkupfalse%
  18.198 -\ {\isacharparenleft}rule\ nat{\isacharunderscore}dvd{\isacharunderscore}less{\isacharunderscore}eq\ nat{\isacharunderscore}dvd{\isacharunderscore}meet{\isacharunderscore}eq\ nat{\isacharunderscore}dvd{\isacharunderscore}join{\isacharunderscore}eq{\isacharparenright}{\isacharplus}%
  18.199 +\ \ \isacommand{apply}\isamarkupfalse%
  18.200 +\ {\isacharparenleft}rule\ gcd{\isacharunderscore}lcm{\isacharunderscore}distr{\isacharparenright}\ \isacommand{done}\isamarkupfalse%
  18.201 +%
  18.202  \endisatagvisible
  18.203  {\isafoldvisible}%
  18.204  %
    19.1 --- a/doc-src/Main/Docs/document/Main_Doc.tex	Thu Oct 01 20:49:46 2009 +0200
    19.2 +++ b/doc-src/Main/Docs/document/Main_Doc.tex	Thu Oct 01 20:52:18 2009 +0200
    19.3 @@ -519,7 +519,7 @@
    19.4  \isa{takeWhile} & \isa{{\isacharparenleft}{\isacharprime}a\ {\isasymRightarrow}\ bool{\isacharparenright}\ {\isasymRightarrow}\ {\isacharprime}a\ list\ {\isasymRightarrow}\ {\isacharprime}a\ list}\\
    19.5  \isa{tl} & \isa{{\isacharprime}a\ list\ {\isasymRightarrow}\ {\isacharprime}a\ list}\\
    19.6  \isa{upt} & \isa{nat\ {\isasymRightarrow}\ nat\ {\isasymRightarrow}\ nat\ list}\\
    19.7 -\isa{upto} & \isa{{\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a\ {\isasymRightarrow}\ {\isacharprime}a\ list}\\
    19.8 +\isa{upto} & \isa{int\ {\isasymRightarrow}\ int\ {\isasymRightarrow}\ int\ list}\\
    19.9  \isa{zip} & \isa{{\isacharprime}a\ list\ {\isasymRightarrow}\ {\isacharprime}b\ list\ {\isasymRightarrow}\ {\isacharparenleft}{\isacharprime}a\ {\isasymtimes}\ {\isacharprime}b{\isacharparenright}\ list}\\
   19.10  \end{supertabular}
   19.11  
    20.1 --- a/doc-src/System/Thy/ROOT.ML	Thu Oct 01 20:49:46 2009 +0200
    20.2 +++ b/doc-src/System/Thy/ROOT.ML	Thu Oct 01 20:52:18 2009 +0200
    20.3 @@ -1,7 +1,4 @@
    20.4 -set ThyOutput.source;
    20.5 +Unsynchronized.set ThyOutput.source;
    20.6  use "../../antiquote_setup.ML";
    20.7  
    20.8 -use_thy "Basics";
    20.9 -use_thy "Interfaces";
   20.10 -use_thy "Presentation";
   20.11 -use_thy "Misc";
   20.12 +use_thys ["Basics", "Interfaces", "Presentation", "Misc"];
    21.1 --- a/doc-src/TutorialI/Inductive/document/Advanced.tex	Thu Oct 01 20:49:46 2009 +0200
    21.2 +++ b/doc-src/TutorialI/Inductive/document/Advanced.tex	Thu Oct 01 20:52:18 2009 +0200
    21.3 @@ -362,7 +362,7 @@
    21.4  subgoal may look uninviting, but fortunately 
    21.5  \isa{lists} distributes over intersection:
    21.6  \begin{isabelle}%
    21.7 -lists\ {\isacharparenleft}A\ {\isasyminter}\ B{\isacharparenright}\ {\isacharequal}\ lists\ A\ {\isasyminter}\ lists\ B\rulename{lists{\isacharunderscore}Int{\isacharunderscore}eq}%
    21.8 +listsp\ {\isacharparenleft}{\isacharparenleft}{\isasymlambda}x{\isachardot}\ x\ {\isasymin}\ A{\isacharparenright}\ {\isasyminter}\ {\isacharparenleft}{\isasymlambda}x{\isachardot}\ x\ {\isasymin}\ B{\isacharparenright}{\isacharparenright}\ {\isacharequal}\ {\isacharparenleft}{\isasymlambda}x{\isachardot}\ x\ {\isasymin}\ lists\ A{\isacharparenright}\ {\isasyminter}\ {\isacharparenleft}{\isasymlambda}x{\isachardot}\ x\ {\isasymin}\ lists\ B{\isacharparenright}\rulename{lists{\isacharunderscore}Int{\isacharunderscore}eq}%
    21.9  \end{isabelle}
   21.10  Thanks to this default simplification rule, the induction hypothesis 
   21.11  is quickly replaced by its two parts:
    22.1 --- a/doc-src/TutorialI/IsaMakefile	Thu Oct 01 20:49:46 2009 +0200
    22.2 +++ b/doc-src/TutorialI/IsaMakefile	Thu Oct 01 20:52:18 2009 +0200
    22.3 @@ -17,7 +17,7 @@
    22.4  SRC = $(ISABELLE_HOME)/src
    22.5  OUT = $(ISABELLE_OUTPUT)
    22.6  LOG = $(OUT)/log
    22.7 -OPTIONS = -m brackets -i true -d "" -D document
    22.8 +OPTIONS = -m brackets -i true -d "" -D document -M 1
    22.9  USEDIR = @$(ISABELLE_TOOL) usedir $(OPTIONS) $(OUT)/HOL
   22.10  
   22.11  
    23.1 --- a/doc-src/TutorialI/Misc/Itrev.thy	Thu Oct 01 20:49:46 2009 +0200
    23.2 +++ b/doc-src/TutorialI/Misc/Itrev.thy	Thu Oct 01 20:52:18 2009 +0200
    23.3 @@ -2,7 +2,7 @@
    23.4  theory Itrev
    23.5  imports Main
    23.6  begin
    23.7 -ML"reset NameSpace.unique_names"
    23.8 +ML"Unsynchronized.reset NameSpace.unique_names"
    23.9  (*>*)
   23.10  
   23.11  section{*Induction Heuristics*}
   23.12 @@ -141,6 +141,6 @@
   23.13  \index{induction heuristics|)}
   23.14  *}
   23.15  (*<*)
   23.16 -ML"set NameSpace.unique_names"
   23.17 +ML"Unsynchronized.set NameSpace.unique_names"
   23.18  end
   23.19  (*>*)
    24.1 --- a/doc-src/TutorialI/Rules/Basic.thy	Thu Oct 01 20:49:46 2009 +0200
    24.2 +++ b/doc-src/TutorialI/Rules/Basic.thy	Thu Oct 01 20:52:18 2009 +0200
    24.3 @@ -188,7 +188,7 @@
    24.4  
    24.5  text{*unification failure trace *}
    24.6  
    24.7 -ML "set trace_unify_fail"
    24.8 +ML "Unsynchronized.set trace_unify_fail"
    24.9  
   24.10  lemma "P(a, f(b, g(e,a), b), a) \<Longrightarrow> P(a, f(b, g(c,a), b), a)"
   24.11  txt{*
   24.12 @@ -213,7 +213,7 @@
   24.13  *}
   24.14  oops
   24.15  
   24.16 -ML "reset trace_unify_fail"
   24.17 +ML "Unsynchronized.reset trace_unify_fail"
   24.18  
   24.19  
   24.20  text{*Quantifiers*}
    25.1 --- a/doc-src/TutorialI/Sets/Examples.thy	Thu Oct 01 20:49:46 2009 +0200
    25.2 +++ b/doc-src/TutorialI/Sets/Examples.thy	Thu Oct 01 20:52:18 2009 +0200
    25.3 @@ -1,7 +1,7 @@
    25.4  (* ID:         $Id$ *)
    25.5  theory Examples imports Main Binomial begin
    25.6  
    25.7 -ML "reset eta_contract"
    25.8 +ML "Unsynchronized.reset eta_contract"
    25.9  ML "Pretty.setmargin 64"
   25.10  
   25.11  text{*membership, intersection *}
    26.1 --- a/doc-src/TutorialI/Types/Numbers.thy	Thu Oct 01 20:49:46 2009 +0200
    26.2 +++ b/doc-src/TutorialI/Types/Numbers.thy	Thu Oct 01 20:52:18 2009 +0200
    26.3 @@ -252,18 +252,13 @@
    26.4  \rulename{mult_cancel_left}
    26.5  *}
    26.6  
    26.7 -ML{*set show_sorts*}
    26.8 -
    26.9  text{*
   26.10  effect of show sorts on the above
   26.11  
   26.12 -@{thm[display] mult_cancel_left[no_vars]}
   26.13 +@{thm[display,show_sorts] mult_cancel_left[no_vars]}
   26.14  \rulename{mult_cancel_left}
   26.15  *}
   26.16  
   26.17 -ML{*reset show_sorts*}
   26.18 -
   26.19 -
   26.20  text{*
   26.21  absolute value
   26.22  
    27.1 --- a/doc-src/TutorialI/Types/document/Numbers.tex	Thu Oct 01 20:49:46 2009 +0200
    27.2 +++ b/doc-src/TutorialI/Types/document/Numbers.tex	Thu Oct 01 20:52:18 2009 +0200
    27.3 @@ -550,44 +550,18 @@
    27.4  \end{isamarkuptext}%
    27.5  \isamarkuptrue%
    27.6  %
    27.7 -\isadelimML
    27.8 -%
    27.9 -\endisadelimML
   27.10 -%
   27.11 -\isatagML
   27.12 -\isacommand{ML}\isamarkupfalse%
   27.13 -{\isacharverbatimopen}set\ show{\isacharunderscore}sorts{\isacharverbatimclose}%
   27.14 -\endisatagML
   27.15 -{\isafoldML}%
   27.16 -%
   27.17 -\isadelimML
   27.18 -%
   27.19 -\endisadelimML
   27.20 -%
   27.21  \begin{isamarkuptext}%
   27.22  effect of show sorts on the above
   27.23  
   27.24  \begin{isabelle}%
   27.25 -{\isacharparenleft}c\ {\isacharasterisk}\ a\ {\isacharequal}\ c\ {\isacharasterisk}\ b{\isacharparenright}\ {\isacharequal}\ {\isacharparenleft}c\ {\isacharequal}\ {\isacharparenleft}{\isadigit{0}}{\isasymColon}{\isacharprime}a{\isacharparenright}\ {\isasymor}\ a\ {\isacharequal}\ b{\isacharparenright}%
   27.26 +{\isacharparenleft}{\isacharparenleft}c{\isasymColon}{\isacharprime}a{\isasymColon}ring{\isacharunderscore}no{\isacharunderscore}zero{\isacharunderscore}divisors{\isacharparenright}\ {\isacharasterisk}\ {\isacharparenleft}a{\isasymColon}{\isacharprime}a{\isasymColon}ring{\isacharunderscore}no{\isacharunderscore}zero{\isacharunderscore}divisors{\isacharparenright}\ {\isacharequal}\isanewline
   27.27 +\isaindent{{\isacharparenleft}}c\ {\isacharasterisk}\ {\isacharparenleft}b{\isasymColon}{\isacharprime}a{\isasymColon}ring{\isacharunderscore}no{\isacharunderscore}zero{\isacharunderscore}divisors{\isacharparenright}{\isacharparenright}\ {\isacharequal}\isanewline
   27.28 +{\isacharparenleft}c\ {\isacharequal}\ {\isacharparenleft}{\isadigit{0}}{\isasymColon}{\isacharprime}a{\isasymColon}ring{\isacharunderscore}no{\isacharunderscore}zero{\isacharunderscore}divisors{\isacharparenright}\ {\isasymor}\ a\ {\isacharequal}\ b{\isacharparenright}%
   27.29  \end{isabelle}
   27.30  \rulename{mult_cancel_left}%
   27.31  \end{isamarkuptext}%
   27.32  \isamarkuptrue%
   27.33  %
   27.34 -\isadelimML
   27.35 -%
   27.36 -\endisadelimML
   27.37 -%
   27.38 -\isatagML
   27.39 -\isacommand{ML}\isamarkupfalse%
   27.40 -{\isacharverbatimopen}reset\ show{\isacharunderscore}sorts{\isacharverbatimclose}%
   27.41 -\endisatagML
   27.42 -{\isafoldML}%
   27.43 -%
   27.44 -\isadelimML
   27.45 -%
   27.46 -\endisadelimML
   27.47 -%
   27.48  \begin{isamarkuptext}%
   27.49  absolute value
   27.50  
    28.1 --- a/src/HOL/IsaMakefile	Thu Oct 01 20:49:46 2009 +0200
    28.2 +++ b/src/HOL/IsaMakefile	Thu Oct 01 20:52:18 2009 +0200
    28.3 @@ -192,6 +192,7 @@
    28.4    Tools/sat_funcs.ML \
    28.5    Tools/sat_solver.ML \
    28.6    Tools/split_rule.ML \
    28.7 +  Tools/transfer.ML \
    28.8    Tools/typecopy.ML \
    28.9    Tools/typedef_codegen.ML \
   28.10    Tools/typedef.ML \
   28.11 @@ -258,12 +259,12 @@
   28.12    Tools/Qelim/presburger.ML \
   28.13    Tools/Qelim/qelim.ML \
   28.14    Tools/recdef.ML \
   28.15 +  Tools/choice_specification.ML \
   28.16    Tools/res_atp.ML \
   28.17    Tools/res_axioms.ML \
   28.18    Tools/res_clause.ML \
   28.19    Tools/res_hol_clause.ML \
   28.20    Tools/res_reconstruct.ML \
   28.21 -  Tools/choice_specification.ML \
   28.22    Tools/string_code.ML \
   28.23    Tools/string_syntax.ML \
   28.24    Tools/TFL/casesplit.ML \
   28.25 @@ -308,7 +309,6 @@
   28.26    Taylor.thy \
   28.27    Transcendental.thy \
   28.28    Tools/float_syntax.ML \
   28.29 -  Tools/transfer.ML \
   28.30    Tools/Qelim/ferrante_rackoff_data.ML \
   28.31    Tools/Qelim/ferrante_rackoff.ML \
   28.32    Tools/Qelim/langford_data.ML \
    29.1 --- a/src/HOL/Library/Nat_Int_Bij.thy	Thu Oct 01 20:49:46 2009 +0200
    29.2 +++ b/src/HOL/Library/Nat_Int_Bij.thy	Thu Oct 01 20:52:18 2009 +0200
    29.3 @@ -128,6 +128,9 @@
    29.4    thus "\<forall>y. \<exists>x. y = nat2_to_nat x"  by fast
    29.5  qed
    29.6  
    29.7 +lemma nat_to_nat2_inj: "inj nat_to_nat2"
    29.8 +  by (simp add: nat_to_nat2_def surj_imp_inj_inv nat2_to_nat_surj) 
    29.9 +
   29.10  
   29.11  subsection{*  A bijection between @{text "\<nat>"} and @{text "\<int>"} *}
   29.12  
    30.1 --- a/src/HOL/Library/Sum_Of_Squares/positivstellensatz_tools.ML	Thu Oct 01 20:49:46 2009 +0200
    30.2 +++ b/src/HOL/Library/Sum_Of_Squares/positivstellensatz_tools.ML	Thu Oct 01 20:52:18 2009 +0200
    30.3 @@ -16,8 +16,6 @@
    30.4  structure PositivstellensatzTools : POSITIVSTELLENSATZ_TOOLS =
    30.5  struct
    30.6  
    30.7 -open RealArith FuncUtil
    30.8 -
    30.9  (*** certificate generation ***)
   30.10  
   30.11  fun string_of_rat r =
   30.12 @@ -41,42 +39,42 @@
   30.13    end
   30.14  
   30.15  fun string_of_monomial m = 
   30.16 - if Ctermfunc.is_undefined m then "1" 
   30.17 + if FuncUtil.Ctermfunc.is_empty m then "1" 
   30.18   else 
   30.19    let 
   30.20 -   val m' = dest_monomial m
   30.21 +   val m' = FuncUtil.dest_monomial m
   30.22     val vps = fold_rev (fn (x,k) => cons (string_of_varpow x k)) m' [] 
   30.23    in foldr1 (fn (s, t) => s ^ "*" ^ t) vps
   30.24    end
   30.25  
   30.26  fun string_of_cmonomial (m,c) =
   30.27 -  if Ctermfunc.is_undefined m then string_of_rat c
   30.28 +  if FuncUtil.Ctermfunc.is_empty m then string_of_rat c
   30.29    else if c = Rat.one then string_of_monomial m
   30.30    else (string_of_rat c) ^ "*" ^ (string_of_monomial m);
   30.31  
   30.32  fun string_of_poly p = 
   30.33 - if Monomialfunc.is_undefined p then "0" 
   30.34 + if FuncUtil.Monomialfunc.is_empty p then "0" 
   30.35   else
   30.36    let 
   30.37     val cms = map string_of_cmonomial
   30.38 -     (sort (prod_ord monomial_order (K EQUAL)) (Monomialfunc.graph p))
   30.39 +     (sort (prod_ord FuncUtil.monomial_order (K EQUAL)) (FuncUtil.Monomialfunc.dest p))
   30.40    in foldr1 (fn (t1, t2) => t1 ^ " + " ^ t2) cms
   30.41    end;
   30.42  
   30.43 -fun pss_to_cert (Axiom_eq i) = "A=" ^ string_of_int i
   30.44 -  | pss_to_cert (Axiom_le i) = "A<=" ^ string_of_int i
   30.45 -  | pss_to_cert (Axiom_lt i) = "A<" ^ string_of_int i
   30.46 -  | pss_to_cert (Rational_eq r) = "R=" ^ string_of_rat r
   30.47 -  | pss_to_cert (Rational_le r) = "R<=" ^ string_of_rat r
   30.48 -  | pss_to_cert (Rational_lt r) = "R<" ^ string_of_rat r
   30.49 -  | pss_to_cert (Square p) = "[" ^ string_of_poly p ^ "]^2"
   30.50 -  | pss_to_cert (Eqmul (p, pss)) = "([" ^ string_of_poly p ^ "] * " ^ pss_to_cert pss ^ ")"
   30.51 -  | pss_to_cert (Sum (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " + " ^ pss_to_cert pss2 ^ ")"
   30.52 -  | pss_to_cert (Product (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " * " ^ pss_to_cert pss2 ^ ")"
   30.53 +fun pss_to_cert (RealArith.Axiom_eq i) = "A=" ^ string_of_int i
   30.54 +  | pss_to_cert (RealArith.Axiom_le i) = "A<=" ^ string_of_int i
   30.55 +  | pss_to_cert (RealArith.Axiom_lt i) = "A<" ^ string_of_int i
   30.56 +  | pss_to_cert (RealArith.Rational_eq r) = "R=" ^ string_of_rat r
   30.57 +  | pss_to_cert (RealArith.Rational_le r) = "R<=" ^ string_of_rat r
   30.58 +  | pss_to_cert (RealArith.Rational_lt r) = "R<" ^ string_of_rat r
   30.59 +  | pss_to_cert (RealArith.Square p) = "[" ^ string_of_poly p ^ "]^2"
   30.60 +  | pss_to_cert (RealArith.Eqmul (p, pss)) = "([" ^ string_of_poly p ^ "] * " ^ pss_to_cert pss ^ ")"
   30.61 +  | pss_to_cert (RealArith.Sum (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " + " ^ pss_to_cert pss2 ^ ")"
   30.62 +  | pss_to_cert (RealArith.Product (pss1, pss2)) = "(" ^ pss_to_cert pss1 ^ " * " ^ pss_to_cert pss2 ^ ")"
   30.63  
   30.64 -fun pss_tree_to_cert Trivial = "()"
   30.65 -  | pss_tree_to_cert (Cert pss) = "(" ^ pss_to_cert pss ^ ")"
   30.66 -  | pss_tree_to_cert (Branch (t1, t2)) = "(" ^ pss_tree_to_cert t1 ^ " & " ^ pss_tree_to_cert t2 ^ ")"
   30.67 +fun pss_tree_to_cert RealArith.Trivial = "()"
   30.68 +  | pss_tree_to_cert (RealArith.Cert pss) = "(" ^ pss_to_cert pss ^ ")"
   30.69 +  | pss_tree_to_cert (RealArith.Branch (t1, t2)) = "(" ^ pss_tree_to_cert t1 ^ " & " ^ pss_tree_to_cert t2 ^ ")"
   30.70  
   30.71  (*** certificate parsing ***)
   30.72  
   30.73 @@ -103,27 +101,27 @@
   30.74    (fn (x, k) => (cterm_of (Context.theory_of_proof ctxt) (Free (x, @{typ real})), k)) 
   30.75  
   30.76  fun parse_monomial ctxt = repeat_sep "*" (parse_varpow ctxt) >>
   30.77 -  foldl (uncurry Ctermfunc.update) Ctermfunc.undefined
   30.78 +  foldl (uncurry FuncUtil.Ctermfunc.update) FuncUtil.Ctermfunc.empty
   30.79  
   30.80  fun parse_cmonomial ctxt =
   30.81    rat_int --| str "*" -- (parse_monomial ctxt) >> swap ||
   30.82    (parse_monomial ctxt) >> (fn m => (m, Rat.one)) ||
   30.83 -  rat_int >> (fn r => (Ctermfunc.undefined, r))
   30.84 +  rat_int >> (fn r => (FuncUtil.Ctermfunc.empty, r))
   30.85  
   30.86  fun parse_poly ctxt = repeat_sep "+" (parse_cmonomial ctxt) >>
   30.87 -  foldl (uncurry Monomialfunc.update) Monomialfunc.undefined
   30.88 +  foldl (uncurry FuncUtil.Monomialfunc.update) FuncUtil.Monomialfunc.empty
   30.89  
   30.90  (* positivstellensatz parser *)
   30.91  
   30.92  val parse_axiom =
   30.93 -  (str "A=" |-- int >> Axiom_eq) ||
   30.94 -  (str "A<=" |-- int >> Axiom_le) ||
   30.95 -  (str "A<" |-- int >> Axiom_lt)
   30.96 +  (str "A=" |-- int >> RealArith.Axiom_eq) ||
   30.97 +  (str "A<=" |-- int >> RealArith.Axiom_le) ||
   30.98 +  (str "A<" |-- int >> RealArith.Axiom_lt)
   30.99  
  30.100  val parse_rational =
  30.101 -  (str "R=" |-- rat_int >> Rational_eq) ||
  30.102 -  (str "R<=" |-- rat_int >> Rational_le) ||
  30.103 -  (str "R<" |-- rat_int >> Rational_lt)
  30.104 +  (str "R=" |-- rat_int >> RealArith.Rational_eq) ||
  30.105 +  (str "R<=" |-- rat_int >> RealArith.Rational_le) ||
  30.106 +  (str "R<" |-- rat_int >> RealArith.Rational_lt)
  30.107  
  30.108  fun parse_cert ctxt input =
  30.109    let
  30.110 @@ -132,10 +130,10 @@
  30.111    in
  30.112    (parse_axiom ||
  30.113     parse_rational ||
  30.114 -   str "[" |-- pp --| str "]^2" >> Square ||
  30.115 -   str "([" |-- pp --| str "]*" -- pc --| str ")" >> Eqmul ||
  30.116 -   str "(" |-- pc --| str "*" -- pc --| str ")" >> Product ||
  30.117 -   str "(" |-- pc --| str "+" -- pc --| str ")" >> Sum) input
  30.118 +   str "[" |-- pp --| str "]^2" >> RealArith.Square ||
  30.119 +   str "([" |-- pp --| str "]*" -- pc --| str ")" >> RealArith.Eqmul ||
  30.120 +   str "(" |-- pc --| str "*" -- pc --| str ")" >> RealArith.Product ||
  30.121 +   str "(" |-- pc --| str "+" -- pc --| str ")" >> RealArith.Sum) input
  30.122    end
  30.123  
  30.124  fun parse_cert_tree ctxt input =
  30.125 @@ -143,9 +141,9 @@
  30.126      val pc = parse_cert ctxt
  30.127      val pt = parse_cert_tree ctxt
  30.128    in
  30.129 -  (str "()" >> K Trivial ||
  30.130 -   str "(" |-- pc --| str ")" >> Cert ||
  30.131 -   str "(" |-- pt --| str "&" -- pt --| str ")" >> Branch) input
  30.132 +  (str "()" >> K RealArith.Trivial ||
  30.133 +   str "(" |-- pc --| str ")" >> RealArith.Cert ||
  30.134 +   str "(" |-- pt --| str "&" -- pt --| str ")" >> RealArith.Branch) input
  30.135    end
  30.136  
  30.137  (* scanner *)
    31.1 --- a/src/HOL/Library/Sum_Of_Squares/sum_of_squares.ML	Thu Oct 01 20:49:46 2009 +0200
    31.2 +++ b/src/HOL/Library/Sum_Of_Squares/sum_of_squares.ML	Thu Oct 01 20:52:18 2009 +0200
    31.3 @@ -23,8 +23,6 @@
    31.4  structure Sos : SOS = 
    31.5  struct
    31.6  
    31.7 -open FuncUtil;
    31.8 -
    31.9  val rat_0 = Rat.zero;
   31.10  val rat_1 = Rat.one;
   31.11  val rat_2 = Rat.two;
   31.12 @@ -104,9 +102,9 @@
   31.13  
   31.14  (* The main types.                                                           *)
   31.15  
   31.16 -type vector = int* Rat.rat Intfunc.T;
   31.17 +type vector = int* Rat.rat FuncUtil.Intfunc.table;
   31.18  
   31.19 -type matrix = (int*int)*(Rat.rat Intpairfunc.T);
   31.20 +type matrix = (int*int)*(Rat.rat FuncUtil.Intpairfunc.table);
   31.21  
   31.22  fun iszero (k,r) = r =/ rat_0;
   31.23  
   31.24 @@ -118,29 +116,29 @@
   31.25   
   31.26  (* Vectors. Conventionally indexed 1..n.                                     *)
   31.27  
   31.28 -fun vector_0 n = (n,Intfunc.undefined):vector;
   31.29 +fun vector_0 n = (n,FuncUtil.Intfunc.empty):vector;
   31.30  
   31.31  fun dim (v:vector) = fst v;
   31.32  
   31.33  fun vector_const c n =
   31.34    if c =/ rat_0 then vector_0 n
   31.35 -  else (n,fold_rev (fn k => Intfunc.update (k,c)) (1 upto n) Intfunc.undefined) :vector;
   31.36 +  else (n,fold_rev (fn k => FuncUtil.Intfunc.update (k,c)) (1 upto n) FuncUtil.Intfunc.empty) :vector;
   31.37  
   31.38  val vector_1 = vector_const rat_1;
   31.39  
   31.40  fun vector_cmul c (v:vector) =
   31.41   let val n = dim v 
   31.42   in if c =/ rat_0 then vector_0 n
   31.43 -    else (n,Intfunc.mapf (fn x => c */ x) (snd v))
   31.44 +    else (n,FuncUtil.Intfunc.map (fn x => c */ x) (snd v))
   31.45   end;
   31.46  
   31.47 -fun vector_neg (v:vector) = (fst v,Intfunc.mapf Rat.neg (snd v)) :vector;
   31.48 +fun vector_neg (v:vector) = (fst v,FuncUtil.Intfunc.map Rat.neg (snd v)) :vector;
   31.49  
   31.50  fun vector_add (v1:vector) (v2:vector) =
   31.51   let val m = dim v1  
   31.52       val n = dim v2 
   31.53   in if m <> n then error "vector_add: incompatible dimensions"
   31.54 -    else (n,Intfunc.combine (curry op +/) (fn x => x =/ rat_0) (snd v1) (snd v2)) :vector 
   31.55 +    else (n,FuncUtil.Intfunc.combine (curry op +/) (fn x => x =/ rat_0) (snd v1) (snd v2)) :vector 
   31.56   end;
   31.57  
   31.58  fun vector_sub v1 v2 = vector_add v1 (vector_neg v2);
   31.59 @@ -149,43 +147,43 @@
   31.60   let val m = dim v1 
   31.61       val n = dim v2 
   31.62   in if m <> n then error "vector_dot: incompatible dimensions" 
   31.63 -    else Intfunc.fold (fn (i,x) => fn a => x +/ a) 
   31.64 -        (Intfunc.combine (curry op */) (fn x => x =/ rat_0) (snd v1) (snd v2)) rat_0
   31.65 +    else FuncUtil.Intfunc.fold (fn (i,x) => fn a => x +/ a) 
   31.66 +        (FuncUtil.Intfunc.combine (curry op */) (fn x => x =/ rat_0) (snd v1) (snd v2)) rat_0
   31.67   end;
   31.68  
   31.69  fun vector_of_list l =
   31.70   let val n = length l 
   31.71 - in (n,fold_rev2 (curry Intfunc.update) (1 upto n) l Intfunc.undefined) :vector
   31.72 + in (n,fold_rev2 (curry FuncUtil.Intfunc.update) (1 upto n) l FuncUtil.Intfunc.empty) :vector
   31.73   end;
   31.74  
   31.75  (* Matrices; again rows and columns indexed from 1.                          *)
   31.76  
   31.77 -fun matrix_0 (m,n) = ((m,n),Intpairfunc.undefined):matrix;
   31.78 +fun matrix_0 (m,n) = ((m,n),FuncUtil.Intpairfunc.empty):matrix;
   31.79  
   31.80  fun dimensions (m:matrix) = fst m;
   31.81  
   31.82  fun matrix_const c (mn as (m,n)) =
   31.83    if m <> n then error "matrix_const: needs to be square"
   31.84    else if c =/ rat_0 then matrix_0 mn
   31.85 -  else (mn,fold_rev (fn k => Intpairfunc.update ((k,k), c)) (1 upto n) Intpairfunc.undefined) :matrix;;
   31.86 +  else (mn,fold_rev (fn k => FuncUtil.Intpairfunc.update ((k,k), c)) (1 upto n) FuncUtil.Intpairfunc.empty) :matrix;;
   31.87  
   31.88  val matrix_1 = matrix_const rat_1;
   31.89  
   31.90  fun matrix_cmul c (m:matrix) =
   31.91   let val (i,j) = dimensions m 
   31.92   in if c =/ rat_0 then matrix_0 (i,j)
   31.93 -    else ((i,j),Intpairfunc.mapf (fn x => c */ x) (snd m))
   31.94 +    else ((i,j),FuncUtil.Intpairfunc.map (fn x => c */ x) (snd m))
   31.95   end;
   31.96  
   31.97  fun matrix_neg (m:matrix) = 
   31.98 -  (dimensions m, Intpairfunc.mapf Rat.neg (snd m)) :matrix;
   31.99 +  (dimensions m, FuncUtil.Intpairfunc.map Rat.neg (snd m)) :matrix;
  31.100  
  31.101  fun matrix_add (m1:matrix) (m2:matrix) =
  31.102   let val d1 = dimensions m1 
  31.103       val d2 = dimensions m2 
  31.104   in if d1 <> d2 
  31.105       then error "matrix_add: incompatible dimensions"
  31.106 -    else (d1,Intpairfunc.combine (curry op +/) (fn x => x =/ rat_0) (snd m1) (snd m2)) :matrix
  31.107 +    else (d1,FuncUtil.Intpairfunc.combine (curry op +/) (fn x => x =/ rat_0) (snd m1) (snd m2)) :matrix
  31.108   end;;
  31.109  
  31.110  fun matrix_sub m1 m2 = matrix_add m1 (matrix_neg m2);
  31.111 @@ -193,112 +191,112 @@
  31.112  fun row k (m:matrix) =
  31.113   let val (i,j) = dimensions m 
  31.114   in (j,
  31.115 -   Intpairfunc.fold (fn ((i,j), c) => fn a => if i = k then Intfunc.update (j,c) a else a) (snd m) Intfunc.undefined ) : vector
  31.116 +   FuncUtil.Intpairfunc.fold (fn ((i,j), c) => fn a => if i = k then FuncUtil.Intfunc.update (j,c) a else a) (snd m) FuncUtil.Intfunc.empty ) : vector
  31.117   end;
  31.118  
  31.119  fun column k (m:matrix) =
  31.120    let val (i,j) = dimensions m 
  31.121    in (i,
  31.122 -   Intpairfunc.fold (fn ((i,j), c) => fn a => if j = k then Intfunc.update (i,c) a else a) (snd m)  Intfunc.undefined)
  31.123 +   FuncUtil.Intpairfunc.fold (fn ((i,j), c) => fn a => if j = k then FuncUtil.Intfunc.update (i,c) a else a) (snd m)  FuncUtil.Intfunc.empty)
  31.124     : vector
  31.125   end;
  31.126  
  31.127  fun transp (m:matrix) =
  31.128    let val (i,j) = dimensions m 
  31.129    in
  31.130 -  ((j,i),Intpairfunc.fold (fn ((i,j), c) => fn a => Intpairfunc.update ((j,i), c) a) (snd m) Intpairfunc.undefined) :matrix
  31.131 +  ((j,i),FuncUtil.Intpairfunc.fold (fn ((i,j), c) => fn a => FuncUtil.Intpairfunc.update ((j,i), c) a) (snd m) FuncUtil.Intpairfunc.empty) :matrix
  31.132   end;
  31.133  
  31.134  fun diagonal (v:vector) =
  31.135   let val n = dim v 
  31.136 - in ((n,n),Intfunc.fold (fn (i, c) => fn a => Intpairfunc.update ((i,i), c) a) (snd v) Intpairfunc.undefined) : matrix
  31.137 + in ((n,n),FuncUtil.Intfunc.fold (fn (i, c) => fn a => FuncUtil.Intpairfunc.update ((i,i), c) a) (snd v) FuncUtil.Intpairfunc.empty) : matrix
  31.138   end;
  31.139  
  31.140  fun matrix_of_list l =
  31.141   let val m = length l 
  31.142   in if m = 0 then matrix_0 (0,0) else
  31.143     let val n = length (hd l) 
  31.144 -   in ((m,n),itern 1 l (fn v => fn i => itern 1 v (fn c => fn j => Intpairfunc.update ((i,j), c))) Intpairfunc.undefined)
  31.145 +   in ((m,n),itern 1 l (fn v => fn i => itern 1 v (fn c => fn j => FuncUtil.Intpairfunc.update ((i,j), c))) FuncUtil.Intpairfunc.empty)
  31.146     end
  31.147   end;
  31.148  
  31.149  (* Monomials.                                                                *)
  31.150  
  31.151 -fun monomial_eval assig (m:monomial) =
  31.152 -  Ctermfunc.fold (fn (x, k) => fn a => a */ rat_pow (Ctermfunc.apply assig x) k)
  31.153 +fun monomial_eval assig m =
  31.154 +  FuncUtil.Ctermfunc.fold (fn (x, k) => fn a => a */ rat_pow (FuncUtil.Ctermfunc.apply assig x) k)
  31.155          m rat_1;
  31.156 -val monomial_1 = (Ctermfunc.undefined:monomial);
  31.157 +val monomial_1 = FuncUtil.Ctermfunc.empty;
  31.158  
  31.159 -fun monomial_var x = Ctermfunc.onefunc (x, 1) :monomial;
  31.160 +fun monomial_var x = FuncUtil.Ctermfunc.onefunc (x, 1);
  31.161  
  31.162 -val (monomial_mul:monomial->monomial->monomial) =
  31.163 -  Ctermfunc.combine (curry op +) (K false);
  31.164 +val monomial_mul =
  31.165 +  FuncUtil.Ctermfunc.combine (curry op +) (K false);
  31.166  
  31.167 -fun monomial_pow (m:monomial) k =
  31.168 +fun monomial_pow m k =
  31.169    if k = 0 then monomial_1
  31.170 -  else Ctermfunc.mapf (fn x => k * x) m;
  31.171 +  else FuncUtil.Ctermfunc.map (fn x => k * x) m;
  31.172  
  31.173 -fun monomial_divides (m1:monomial) (m2:monomial) =
  31.174 -  Ctermfunc.fold (fn (x, k) => fn a => Ctermfunc.tryapplyd m2 x 0 >= k andalso a) m1 true;;
  31.175 +fun monomial_divides m1 m2 =
  31.176 +  FuncUtil.Ctermfunc.fold (fn (x, k) => fn a => FuncUtil.Ctermfunc.tryapplyd m2 x 0 >= k andalso a) m1 true;;
  31.177  
  31.178 -fun monomial_div (m1:monomial) (m2:monomial) =
  31.179 - let val m = Ctermfunc.combine (curry op +) 
  31.180 -   (fn x => x = 0) m1 (Ctermfunc.mapf (fn x => ~ x) m2) 
  31.181 - in if Ctermfunc.fold (fn (x, k) => fn a => k >= 0 andalso a) m true then m
  31.182 +fun monomial_div m1 m2 =
  31.183 + let val m = FuncUtil.Ctermfunc.combine (curry op +) 
  31.184 +   (fn x => x = 0) m1 (FuncUtil.Ctermfunc.map (fn x => ~ x) m2) 
  31.185 + in if FuncUtil.Ctermfunc.fold (fn (x, k) => fn a => k >= 0 andalso a) m true then m
  31.186    else error "monomial_div: non-divisible"
  31.187   end;
  31.188  
  31.189 -fun monomial_degree x (m:monomial) = 
  31.190 -  Ctermfunc.tryapplyd m x 0;;
  31.191 +fun monomial_degree x m = 
  31.192 +  FuncUtil.Ctermfunc.tryapplyd m x 0;;
  31.193  
  31.194 -fun monomial_lcm (m1:monomial) (m2:monomial) =
  31.195 -  fold_rev (fn x => Ctermfunc.update (x, max (monomial_degree x m1) (monomial_degree x m2)))
  31.196 -          (gen_union (is_equal o  cterm_ord) (Ctermfunc.dom m1, Ctermfunc.dom m2)) (Ctermfunc.undefined :monomial);
  31.197 +fun monomial_lcm m1 m2 =
  31.198 +  fold_rev (fn x => FuncUtil.Ctermfunc.update (x, max (monomial_degree x m1) (monomial_degree x m2)))
  31.199 +          (gen_union (is_equal o  FuncUtil.cterm_ord) (FuncUtil.Ctermfunc.dom m1, FuncUtil.Ctermfunc.dom m2)) (FuncUtil.Ctermfunc.empty);
  31.200  
  31.201 -fun monomial_multidegree (m:monomial) = 
  31.202 - Ctermfunc.fold (fn (x, k) => fn a => k + a) m 0;;
  31.203 +fun monomial_multidegree m = 
  31.204 + FuncUtil.Ctermfunc.fold (fn (x, k) => fn a => k + a) m 0;;
  31.205  
  31.206 -fun monomial_variables m = Ctermfunc.dom m;;
  31.207 +fun monomial_variables m = FuncUtil.Ctermfunc.dom m;;
  31.208  
  31.209  (* Polynomials.                                                              *)
  31.210  
  31.211 -fun eval assig (p:poly) =
  31.212 -  Monomialfunc.fold (fn (m, c) => fn a => a +/ c */ monomial_eval assig m) p rat_0;
  31.213 +fun eval assig p =
  31.214 +  FuncUtil.Monomialfunc.fold (fn (m, c) => fn a => a +/ c */ monomial_eval assig m) p rat_0;
  31.215  
  31.216 -val poly_0 = (Monomialfunc.undefined:poly);
  31.217 +val poly_0 = FuncUtil.Monomialfunc.empty;
  31.218  
  31.219 -fun poly_isconst (p:poly) = 
  31.220 -  Monomialfunc.fold (fn (m, c) => fn a => Ctermfunc.is_undefined m andalso a) p true;
  31.221 +fun poly_isconst p = 
  31.222 +  FuncUtil.Monomialfunc.fold (fn (m, c) => fn a => FuncUtil.Ctermfunc.is_empty m andalso a) p true;
  31.223  
  31.224 -fun poly_var x = Monomialfunc.onefunc (monomial_var x,rat_1) :poly;
  31.225 +fun poly_var x = FuncUtil.Monomialfunc.onefunc (monomial_var x,rat_1);
  31.226  
  31.227  fun poly_const c =
  31.228 -  if c =/ rat_0 then poly_0 else Monomialfunc.onefunc(monomial_1, c);
  31.229 +  if c =/ rat_0 then poly_0 else FuncUtil.Monomialfunc.onefunc(monomial_1, c);
  31.230  
  31.231 -fun poly_cmul c (p:poly) =
  31.232 +fun poly_cmul c p =
  31.233    if c =/ rat_0 then poly_0
  31.234 -  else Monomialfunc.mapf (fn x => c */ x) p;
  31.235 +  else FuncUtil.Monomialfunc.map (fn x => c */ x) p;
  31.236  
  31.237 -fun poly_neg (p:poly) = (Monomialfunc.mapf Rat.neg p :poly);;
  31.238 +fun poly_neg p = FuncUtil.Monomialfunc.map Rat.neg p;;
  31.239  
  31.240 -fun poly_add (p1:poly) (p2:poly) =
  31.241 -  (Monomialfunc.combine (curry op +/) (fn x => x =/ rat_0) p1 p2 :poly);
  31.242 +fun poly_add p1 p2 =
  31.243 +  FuncUtil.Monomialfunc.combine (curry op +/) (fn x => x =/ rat_0) p1 p2;
  31.244  
  31.245  fun poly_sub p1 p2 = poly_add p1 (poly_neg p2);
  31.246  
  31.247 -fun poly_cmmul (c,m) (p:poly) =
  31.248 +fun poly_cmmul (c,m) p =
  31.249   if c =/ rat_0 then poly_0
  31.250 - else if Ctermfunc.is_undefined m 
  31.251 -      then Monomialfunc.mapf (fn d => c */ d) p
  31.252 -      else Monomialfunc.fold (fn (m', d) => fn a => (Monomialfunc.update (monomial_mul m m', c */ d) a)) p poly_0;
  31.253 + else if FuncUtil.Ctermfunc.is_empty m 
  31.254 +      then FuncUtil.Monomialfunc.map (fn d => c */ d) p
  31.255 +      else FuncUtil.Monomialfunc.fold (fn (m', d) => fn a => (FuncUtil.Monomialfunc.update (monomial_mul m m', c */ d) a)) p poly_0;
  31.256  
  31.257 -fun poly_mul (p1:poly) (p2:poly) =
  31.258 -  Monomialfunc.fold (fn (m, c) => fn a => poly_add (poly_cmmul (c,m) p2) a) p1 poly_0;
  31.259 +fun poly_mul p1 p2 =
  31.260 +  FuncUtil.Monomialfunc.fold (fn (m, c) => fn a => poly_add (poly_cmmul (c,m) p2) a) p1 poly_0;
  31.261  
  31.262 -fun poly_div (p1:poly) (p2:poly) =
  31.263 +fun poly_div p1 p2 =
  31.264   if not(poly_isconst p2) 
  31.265   then error "poly_div: non-constant" else
  31.266 - let val c = eval Ctermfunc.undefined p2 
  31.267 + let val c = eval FuncUtil.Ctermfunc.empty p2 
  31.268   in if c =/ rat_0 then error "poly_div: division by zero"
  31.269      else poly_cmul (Rat.inv c) p1
  31.270   end;
  31.271 @@ -314,22 +312,20 @@
  31.272  fun poly_exp p1 p2 =
  31.273    if not(poly_isconst p2) 
  31.274    then error "poly_exp: not a constant" 
  31.275 -  else poly_pow p1 (int_of_rat (eval Ctermfunc.undefined p2));
  31.276 +  else poly_pow p1 (int_of_rat (eval FuncUtil.Ctermfunc.empty p2));
  31.277  
  31.278 -fun degree x (p:poly) = 
  31.279 - Monomialfunc.fold (fn (m,c) => fn a => max (monomial_degree x m) a) p 0;
  31.280 +fun degree x p = 
  31.281 + FuncUtil.Monomialfunc.fold (fn (m,c) => fn a => max (monomial_degree x m) a) p 0;
  31.282  
  31.283 -fun multidegree (p:poly) =
  31.284 -  Monomialfunc.fold (fn (m, c) => fn a => max (monomial_multidegree m) a) p 0;
  31.285 +fun multidegree p =
  31.286 +  FuncUtil.Monomialfunc.fold (fn (m, c) => fn a => max (monomial_multidegree m) a) p 0;
  31.287  
  31.288 -fun poly_variables (p:poly) =
  31.289 -  sort cterm_ord (Monomialfunc.fold_rev (fn (m, c) => curry (gen_union (is_equal o  cterm_ord)) (monomial_variables m)) p []);;
  31.290 +fun poly_variables p =
  31.291 +  sort FuncUtil.cterm_ord (FuncUtil.Monomialfunc.fold_rev (fn (m, c) => curry (gen_union (is_equal o FuncUtil.cterm_ord)) (monomial_variables m)) p []);;
  31.292  
  31.293  (* Order monomials for human presentation.                                   *)
  31.294  
  31.295 -fun cterm_ord (t,t') = TermOrd.fast_term_ord (term_of t, term_of t');
  31.296 -
  31.297 -val humanorder_varpow = prod_ord cterm_ord (rev_order o int_ord);
  31.298 +val humanorder_varpow = prod_ord FuncUtil.cterm_ord (rev_order o int_ord);
  31.299  
  31.300  local
  31.301   fun ord (l1,l2) = case (l1,l2) of
  31.302 @@ -341,8 +337,8 @@
  31.303     | EQUAL => ord (t1,t2)
  31.304     | GREATER => GREATER)
  31.305  in fun humanorder_monomial m1 m2 = 
  31.306 - ord (sort humanorder_varpow (Ctermfunc.graph m1),
  31.307 -  sort humanorder_varpow (Ctermfunc.graph m2))
  31.308 + ord (sort humanorder_varpow (FuncUtil.Ctermfunc.dest m1),
  31.309 +  sort humanorder_varpow (FuncUtil.Ctermfunc.dest m2))
  31.310  end;
  31.311  
  31.312  (* Conversions to strings.                                                   *)
  31.313 @@ -352,8 +348,8 @@
  31.314   in if n_raw = 0 then "[]" else
  31.315    let 
  31.316     val n = max min_size (min n_raw max_size) 
  31.317 -   val xs = map (Rat.string_of_rat o (fn i => Intfunc.tryapplyd (snd v) i rat_0)) (1 upto n) 
  31.318 -  in "[" ^ foldr1 (fn (s, t) => s ^ ", " ^ t) xs ^
  31.319 +   val xs = map (Rat.string_of_rat o (fn i => FuncUtil.Intfunc.tryapplyd (snd v) i rat_0)) (1 upto n) 
  31.320 +  in "[" ^ space_implode ", " xs ^
  31.321    (if n_raw > max_size then ", ...]" else "]")
  31.322    end
  31.323   end;
  31.324 @@ -364,7 +360,7 @@
  31.325    val i = min max_size i_raw 
  31.326    val j = min max_size j_raw
  31.327    val rstr = map (fn k => string_of_vector j j (row k m)) (1 upto i) 
  31.328 - in "["^ foldr1 (fn (s, t) => s^";\n "^t) rstr ^
  31.329 + in "["^ space_implode ";\n " rstr ^
  31.330    (if j > max_size then "\n ...]" else "]")
  31.331   end;
  31.332  
  31.333 @@ -387,21 +383,21 @@
  31.334    else string_of_cterm x^"^"^string_of_int k;
  31.335  
  31.336  fun string_of_monomial m =
  31.337 - if Ctermfunc.is_undefined m then "1" else
  31.338 + if FuncUtil.Ctermfunc.is_empty m then "1" else
  31.339   let val vps = fold_rev (fn (x,k) => fn a => string_of_varpow x k :: a)
  31.340 -  (sort humanorder_varpow (Ctermfunc.graph m)) [] 
  31.341 - in foldr1 (fn (s, t) => s^"*"^t) vps
  31.342 +  (sort humanorder_varpow (FuncUtil.Ctermfunc.dest m)) [] 
  31.343 + in space_implode "*" vps
  31.344   end;
  31.345  
  31.346  fun string_of_cmonomial (c,m) =
  31.347 - if Ctermfunc.is_undefined m then Rat.string_of_rat c
  31.348 + if FuncUtil.Ctermfunc.is_empty m then Rat.string_of_rat c
  31.349   else if c =/ rat_1 then string_of_monomial m
  31.350   else Rat.string_of_rat c ^ "*" ^ string_of_monomial m;;
  31.351  
  31.352  fun string_of_poly p =
  31.353 - if Monomialfunc.is_undefined p then "<<0>>" else
  31.354 + if FuncUtil.Monomialfunc.is_empty p then "<<0>>" else
  31.355   let 
  31.356 -  val cms = sort (fn ((m1,_),(m2,_)) => humanorder_monomial m1  m2) (Monomialfunc.graph p)
  31.357 +  val cms = sort (fn ((m1,_),(m2,_)) => humanorder_monomial m1  m2) (FuncUtil.Monomialfunc.dest p)
  31.358    val s = fold (fn (m,c) => fn a =>
  31.359               if c </ rat_0 then a ^ " - " ^ string_of_cmonomial(Rat.neg c,m)
  31.360               else a ^ " + " ^ string_of_cmonomial(c,m))
  31.361 @@ -434,7 +430,7 @@
  31.362        else if lop aconvc inv_tm then
  31.363         let val p = poly_of_term r 
  31.364         in if poly_isconst p 
  31.365 -          then poly_const(Rat.inv (eval Ctermfunc.undefined p))
  31.366 +          then poly_const(Rat.inv (eval FuncUtil.Ctermfunc.empty p))
  31.367            else error "poly_of_term: inverse of non-constant polyomial"
  31.368         end
  31.369     else (let val (opr,l) = Thm.dest_comb lop
  31.370 @@ -451,7 +447,7 @@
  31.371             then let 
  31.372                    val p = poly_of_term l 
  31.373                    val q = poly_of_term r 
  31.374 -                in if poly_isconst q then poly_cmul (Rat.inv (eval Ctermfunc.undefined q)) p
  31.375 +                in if poly_isconst q then poly_cmul (Rat.inv (eval FuncUtil.Ctermfunc.empty q)) p
  31.376                     else error "poly_of_term: division by non-constant polynomial"
  31.377                  end
  31.378            else poly_var tm
  31.379 @@ -471,8 +467,8 @@
  31.380  fun sdpa_of_vector (v:vector) =
  31.381   let 
  31.382    val n = dim v
  31.383 -  val strs = map (decimalize 20 o (fn i => Intfunc.tryapplyd (snd v) i rat_0)) (1 upto n) 
  31.384 - in foldr1 (fn (x, y) => x ^ " " ^ y) strs ^ "\n"
  31.385 +  val strs = map (decimalize 20 o (fn i => FuncUtil.Intfunc.tryapplyd (snd v) i rat_0)) (1 upto n) 
  31.386 + in space_implode " " strs ^ "\n"
  31.387   end;
  31.388  
  31.389  fun triple_int_ord ((a,b,c),(a',b',c')) = 
  31.390 @@ -487,7 +483,7 @@
  31.391    val pfx = string_of_int k ^" "
  31.392    val ents =
  31.393      Inttriplefunc.fold (fn ((b,i,j), c) => fn a => if i > j then a else ((b,i,j),c)::a) m []
  31.394 -  val entss = sort (increasing fst triple_int_ord ) ents
  31.395 +  val entss = sort (triple_int_ord o pairself fst) ents
  31.396   in  fold_rev (fn ((b,i,j),c) => fn a =>
  31.397       pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
  31.398       " " ^ decimalize 20 c ^ "\n" ^ a) entss ""
  31.399 @@ -498,8 +494,8 @@
  31.400  fun sdpa_of_matrix k (m:matrix) =
  31.401   let 
  31.402    val pfx = string_of_int k ^ " 1 "
  31.403 -  val ms = Intpairfunc.fold (fn ((i,j), c) => fn  a => if i > j then a else ((i,j),c)::a) (snd m) [] 
  31.404 -  val mss = sort (increasing fst (prod_ord int_ord int_ord)) ms 
  31.405 +  val ms = FuncUtil.Intpairfunc.fold (fn ((i,j), c) => fn  a => if i > j then a else ((i,j),c)::a) (snd m) [] 
  31.406 +  val mss = sort ((prod_ord int_ord int_ord) o pairself fst) ms 
  31.407   in fold_rev (fn ((i,j),c) => fn a =>
  31.408       pfx ^ string_of_int i ^ " " ^ string_of_int j ^
  31.409       " " ^ decimalize 20 c ^ "\n" ^ a) mss ""
  31.410 @@ -544,18 +540,15 @@
  31.411  
  31.412  (* More parser basics.                                                       *)
  31.413  
  31.414 -local
  31.415 - open Scan
  31.416 -in 
  31.417 - val word = this_string
  31.418 + val word = Scan.this_string
  31.419   fun token s =
  31.420 -  repeat ($$ " ") |-- word s --| repeat ($$ " ")
  31.421 - val numeral = one isnum
  31.422 - val decimalint = bulk numeral >> (rat_of_string o implode)
  31.423 - val decimalfrac = bulk numeral
  31.424 +  Scan.repeat ($$ " ") |-- word s --| Scan.repeat ($$ " ")
  31.425 + val numeral = Scan.one isnum
  31.426 + val decimalint = Scan.bulk numeral >> (rat_of_string o implode)
  31.427 + val decimalfrac = Scan.bulk numeral
  31.428      >> (fn s => rat_of_string(implode s) // pow10 (length s))
  31.429   val decimalsig =
  31.430 -    decimalint -- option (Scan.$$ "." |-- decimalfrac)
  31.431 +    decimalint -- Scan.option (Scan.$$ "." |-- decimalfrac)
  31.432      >> (fn (h,NONE) => h | (h,SOME x) => h +/ x)
  31.433   fun signed prs =
  31.434         $$ "-" |-- prs >> Rat.neg 
  31.435 @@ -568,7 +561,6 @@
  31.436  
  31.437   val decimal = signed decimalsig -- (emptyin rat_0|| exponent)
  31.438      >> (fn (h, x) => h */ pow10 (int_of_rat x));
  31.439 -end;
  31.440  
  31.441   fun mkparser p s =
  31.442    let val (x,rst) = p (explode s) 
  31.443 @@ -605,15 +597,15 @@
  31.444  
  31.445  fun pi_scale_then solver (obj:vector)  mats =
  31.446   let 
  31.447 -  val cd1 = fold_rev (common_denominator Intpairfunc.fold) mats (rat_1)
  31.448 -  val cd2 = common_denominator Intfunc.fold (snd obj)  (rat_1) 
  31.449 -  val mats' = map (Intpairfunc.mapf (fn x => cd1 */ x)) mats
  31.450 +  val cd1 = fold_rev (common_denominator FuncUtil.Intpairfunc.fold) mats (rat_1)
  31.451 +  val cd2 = common_denominator FuncUtil.Intfunc.fold (snd obj)  (rat_1) 
  31.452 +  val mats' = map (FuncUtil.Intpairfunc.map (fn x => cd1 */ x)) mats
  31.453    val obj' = vector_cmul cd2 obj
  31.454 -  val max1 = fold_rev (maximal_element Intpairfunc.fold) mats' (rat_0)
  31.455 -  val max2 = maximal_element Intfunc.fold (snd obj') (rat_0) 
  31.456 +  val max1 = fold_rev (maximal_element FuncUtil.Intpairfunc.fold) mats' (rat_0)
  31.457 +  val max2 = maximal_element FuncUtil.Intfunc.fold (snd obj') (rat_0) 
  31.458    val scal1 = pow2 (20 - trunc(Math.ln (float_of_rat max1) / Math.ln 2.0))
  31.459    val scal2 = pow2 (20 - trunc(Math.ln (float_of_rat max2) / Math.ln 2.0)) 
  31.460 -  val mats'' = map (Intpairfunc.mapf (fn x => x */ scal1)) mats'
  31.461 +  val mats'' = map (FuncUtil.Intpairfunc.map (fn x => x */ scal1)) mats'
  31.462    val obj'' = vector_cmul scal2 obj' 
  31.463   in solver obj'' mats''
  31.464    end
  31.465 @@ -639,14 +631,14 @@
  31.466  fun tri_scale_then solver (obj:vector)  mats =
  31.467   let 
  31.468    val cd1 = fold_rev (common_denominator Inttriplefunc.fold) mats (rat_1)
  31.469 -  val cd2 = common_denominator Intfunc.fold (snd obj)  (rat_1) 
  31.470 -  val mats' = map (Inttriplefunc.mapf (fn x => cd1 */ x)) mats
  31.471 +  val cd2 = common_denominator FuncUtil.Intfunc.fold (snd obj)  (rat_1) 
  31.472 +  val mats' = map (Inttriplefunc.map (fn x => cd1 */ x)) mats
  31.473    val obj' = vector_cmul cd2 obj
  31.474    val max1 = fold_rev (maximal_element Inttriplefunc.fold) mats' (rat_0)
  31.475 -  val max2 = maximal_element Intfunc.fold (snd obj') (rat_0) 
  31.476 +  val max2 = maximal_element FuncUtil.Intfunc.fold (snd obj') (rat_0) 
  31.477    val scal1 = pow2 (20 - int_of_float(Math.ln (float_of_rat max1) / Math.ln 2.0))
  31.478    val scal2 = pow2 (20 - int_of_float(Math.ln (float_of_rat max2) / Math.ln 2.0)) 
  31.479 -  val mats'' = map (Inttriplefunc.mapf (fn x => x */ scal1)) mats'
  31.480 +  val mats'' = map (Inttriplefunc.map (fn x => x */ scal1)) mats'
  31.481    val obj'' = vector_cmul scal2 obj' 
  31.482   in solver obj'' mats''
  31.483    end
  31.484 @@ -656,17 +648,17 @@
  31.485  
  31.486  fun nice_rational n x = round_rat (n */ x) // n;;
  31.487  fun nice_vector n ((d,v) : vector) = 
  31.488 - (d, Intfunc.fold (fn (i,c) => fn a => 
  31.489 + (d, FuncUtil.Intfunc.fold (fn (i,c) => fn a => 
  31.490     let val y = nice_rational n c 
  31.491     in if c =/ rat_0 then a 
  31.492 -      else Intfunc.update (i,y) a end) v Intfunc.undefined):vector
  31.493 +      else FuncUtil.Intfunc.update (i,y) a end) v FuncUtil.Intfunc.empty):vector
  31.494  
  31.495  fun dest_ord f x = is_equal (f x);
  31.496  
  31.497  (* Stuff for "equations" ((int*int*int)->num functions).                         *)
  31.498  
  31.499  fun tri_equation_cmul c eq =
  31.500 -  if c =/ rat_0 then Inttriplefunc.undefined else Inttriplefunc.mapf (fn d => c */ d) eq;
  31.501 +  if c =/ rat_0 then Inttriplefunc.empty else Inttriplefunc.map (fn d => c */ d) eq;
  31.502  
  31.503  fun tri_equation_add eq1 eq2 = Inttriplefunc.combine (curry op +/) (fn x => x =/ rat_0) eq1 eq2;
  31.504  
  31.505 @@ -685,25 +677,25 @@
  31.506   | h::t => if p h then (h,t) else
  31.507            let val (k,s) = extract_first p t in (k,h::s) end
  31.508  fun eliminate vars dun eqs = case vars of 
  31.509 -  [] => if forall Inttriplefunc.is_undefined eqs then dun
  31.510 +  [] => if forall Inttriplefunc.is_empty eqs then dun
  31.511          else raise Unsolvable
  31.512   | v::vs =>
  31.513    ((let 
  31.514      val (eq,oeqs) = extract_first (fn e => Inttriplefunc.defined e v) eqs 
  31.515      val a = Inttriplefunc.apply eq v
  31.516 -    val eq' = tri_equation_cmul ((Rat.neg rat_1) // a) (Inttriplefunc.undefine v eq)
  31.517 +    val eq' = tri_equation_cmul ((Rat.neg rat_1) // a) (Inttriplefunc.delete_safe v eq)
  31.518      fun elim e =
  31.519       let val b = Inttriplefunc.tryapplyd e v rat_0 
  31.520       in if b =/ rat_0 then e else
  31.521          tri_equation_add e (tri_equation_cmul (Rat.neg b // a) eq)
  31.522       end
  31.523 -   in eliminate vs (Inttriplefunc.update (v,eq') (Inttriplefunc.mapf elim dun)) (map elim oeqs)
  31.524 +   in eliminate vs (Inttriplefunc.update (v,eq') (Inttriplefunc.map elim dun)) (map elim oeqs)
  31.525     end)
  31.526    handle Failure _ => eliminate vs dun eqs)
  31.527  in
  31.528  fun tri_eliminate_equations one vars eqs =
  31.529   let 
  31.530 -  val assig = eliminate vars Inttriplefunc.undefined eqs
  31.531 +  val assig = eliminate vars Inttriplefunc.empty eqs
  31.532    val vs = Inttriplefunc.fold (fn (x, f) => fn a => remove (dest_ord triple_int_ord) one (Inttriplefunc.dom f) @ a) assig []
  31.533    in (distinct (dest_ord triple_int_ord) vs, assig)
  31.534    end
  31.535 @@ -716,8 +708,8 @@
  31.536    fun choose_variable eq =
  31.537     let val (v,_) = Inttriplefunc.choose eq 
  31.538     in if is_equal (triple_int_ord(v,one)) then
  31.539 -      let val eq' = Inttriplefunc.undefine v eq 
  31.540 -      in if Inttriplefunc.is_undefined eq' then error "choose_variable" 
  31.541 +      let val eq' = Inttriplefunc.delete_safe v eq 
  31.542 +      in if Inttriplefunc.is_empty eq' then error "choose_variable" 
  31.543           else fst (Inttriplefunc.choose eq')
  31.544        end
  31.545      else v 
  31.546 @@ -725,22 +717,22 @@
  31.547    fun eliminate dun eqs = case eqs of 
  31.548      [] => dun
  31.549    | eq::oeqs =>
  31.550 -    if Inttriplefunc.is_undefined eq then eliminate dun oeqs else
  31.551 +    if Inttriplefunc.is_empty eq then eliminate dun oeqs else
  31.552      let val v = choose_variable eq
  31.553          val a = Inttriplefunc.apply eq v
  31.554          val eq' = tri_equation_cmul ((Rat.rat_of_int ~1) // a) 
  31.555 -                   (Inttriplefunc.undefine v eq)
  31.556 +                   (Inttriplefunc.delete_safe v eq)
  31.557          fun elim e =
  31.558           let val b = Inttriplefunc.tryapplyd e v rat_0 
  31.559           in if b =/ rat_0 then e 
  31.560              else tri_equation_add e (tri_equation_cmul (Rat.neg b // a) eq)
  31.561           end
  31.562 -    in eliminate (Inttriplefunc.update(v, eq') (Inttriplefunc.mapf elim dun)) 
  31.563 +    in eliminate (Inttriplefunc.update(v, eq') (Inttriplefunc.map elim dun)) 
  31.564                   (map elim oeqs) 
  31.565      end
  31.566  in fn eqs =>
  31.567   let 
  31.568 -  val assig = eliminate Inttriplefunc.undefined eqs
  31.569 +  val assig = eliminate Inttriplefunc.empty eqs
  31.570    val vs = Inttriplefunc.fold (fn (x, f) => fn a => remove (dest_ord triple_int_ord) one (Inttriplefunc.dom f) @ a) assig []
  31.571   in (distinct (dest_ord triple_int_ord) vs,assig)
  31.572   end
  31.573 @@ -755,36 +747,36 @@
  31.574              (Inttriplefunc.onefunc(one, Rat.rat_of_int ~1))
  31.575    val ass =
  31.576      Inttriplefunc.combine (curry op +/) (K false) 
  31.577 -    (Inttriplefunc.mapf (tri_equation_eval vfn) assigs) vfn 
  31.578 +    (Inttriplefunc.map (tri_equation_eval vfn) assigs) vfn 
  31.579   in if forall (fn e => tri_equation_eval ass e =/ rat_0) eqs
  31.580 -    then Inttriplefunc.undefine one ass else raise Sanity
  31.581 +    then Inttriplefunc.delete_safe one ass else raise Sanity
  31.582   end;
  31.583  
  31.584  (* Multiply equation-parametrized poly by regular poly and add accumulator.  *)
  31.585  
  31.586  fun tri_epoly_pmul p q acc =
  31.587 - Monomialfunc.fold (fn (m1, c) => fn a =>
  31.588 -  Monomialfunc.fold (fn (m2,e) => fn b =>
  31.589 + FuncUtil.Monomialfunc.fold (fn (m1, c) => fn a =>
  31.590 +  FuncUtil.Monomialfunc.fold (fn (m2,e) => fn b =>
  31.591     let val m =  monomial_mul m1 m2
  31.592 -       val es = Monomialfunc.tryapplyd b m Inttriplefunc.undefined 
  31.593 -   in Monomialfunc.update (m,tri_equation_add (tri_equation_cmul c e) es) b 
  31.594 +       val es = FuncUtil.Monomialfunc.tryapplyd b m Inttriplefunc.empty 
  31.595 +   in FuncUtil.Monomialfunc.update (m,tri_equation_add (tri_equation_cmul c e) es) b 
  31.596     end) q a) p acc ;
  31.597  
  31.598  (* Usual operations on equation-parametrized poly.                           *)
  31.599  
  31.600  fun tri_epoly_cmul c l =
  31.601 -  if c =/ rat_0 then Inttriplefunc.undefined else Inttriplefunc.mapf (tri_equation_cmul c) l;;
  31.602 +  if c =/ rat_0 then Inttriplefunc.empty else Inttriplefunc.map (tri_equation_cmul c) l;;
  31.603  
  31.604  val tri_epoly_neg = tri_epoly_cmul (Rat.rat_of_int ~1);
  31.605  
  31.606 -val tri_epoly_add = Inttriplefunc.combine tri_equation_add Inttriplefunc.is_undefined;
  31.607 +val tri_epoly_add = Inttriplefunc.combine tri_equation_add Inttriplefunc.is_empty;
  31.608  
  31.609  fun tri_epoly_sub p q = tri_epoly_add p (tri_epoly_neg q);;
  31.610  
  31.611  (* Stuff for "equations" ((int*int)->num functions).                         *)
  31.612  
  31.613  fun pi_equation_cmul c eq =
  31.614 -  if c =/ rat_0 then Inttriplefunc.undefined else Inttriplefunc.mapf (fn d => c */ d) eq;
  31.615 +  if c =/ rat_0 then Inttriplefunc.empty else Inttriplefunc.map (fn d => c */ d) eq;
  31.616  
  31.617  fun pi_equation_add eq1 eq2 = Inttriplefunc.combine (curry op +/) (fn x => x =/ rat_0) eq1 eq2;
  31.618  
  31.619 @@ -803,25 +795,25 @@
  31.620   | h::t => if p h then (h,t) else
  31.621            let val (k,s) = extract_first p t in (k,h::s) end
  31.622  fun eliminate vars dun eqs = case vars of 
  31.623 -  [] => if forall Inttriplefunc.is_undefined eqs then dun
  31.624 +  [] => if forall Inttriplefunc.is_empty eqs then dun
  31.625          else raise Unsolvable
  31.626   | v::vs =>
  31.627     let 
  31.628      val (eq,oeqs) = extract_first (fn e => Inttriplefunc.defined e v) eqs 
  31.629      val a = Inttriplefunc.apply eq v
  31.630 -    val eq' = pi_equation_cmul ((Rat.neg rat_1) // a) (Inttriplefunc.undefine v eq)
  31.631 +    val eq' = pi_equation_cmul ((Rat.neg rat_1) // a) (Inttriplefunc.delete_safe v eq)
  31.632      fun elim e =
  31.633       let val b = Inttriplefunc.tryapplyd e v rat_0 
  31.634       in if b =/ rat_0 then e else
  31.635          pi_equation_add e (pi_equation_cmul (Rat.neg b // a) eq)
  31.636       end
  31.637 -   in eliminate vs (Inttriplefunc.update (v,eq') (Inttriplefunc.mapf elim dun)) (map elim oeqs)
  31.638 +   in eliminate vs (Inttriplefunc.update (v,eq') (Inttriplefunc.map elim dun)) (map elim oeqs)
  31.639     end
  31.640    handle Failure _ => eliminate vs dun eqs
  31.641  in
  31.642  fun pi_eliminate_equations one vars eqs =
  31.643   let 
  31.644 -  val assig = eliminate vars Inttriplefunc.undefined eqs
  31.645 +  val assig = eliminate vars Inttriplefunc.empty eqs
  31.646    val vs = Inttriplefunc.fold (fn (x, f) => fn a => remove (dest_ord triple_int_ord) one (Inttriplefunc.dom f) @ a) assig []
  31.647    in (distinct (dest_ord triple_int_ord) vs, assig)
  31.648    end
  31.649 @@ -834,8 +826,8 @@
  31.650    fun choose_variable eq =
  31.651     let val (v,_) = Inttriplefunc.choose eq 
  31.652     in if is_equal (triple_int_ord(v,one)) then
  31.653 -      let val eq' = Inttriplefunc.undefine v eq 
  31.654 -      in if Inttriplefunc.is_undefined eq' then error "choose_variable" 
  31.655 +      let val eq' = Inttriplefunc.delete_safe v eq 
  31.656 +      in if Inttriplefunc.is_empty eq' then error "choose_variable" 
  31.657           else fst (Inttriplefunc.choose eq')
  31.658        end
  31.659      else v 
  31.660 @@ -843,22 +835,22 @@
  31.661    fun eliminate dun eqs = case eqs of 
  31.662      [] => dun
  31.663    | eq::oeqs =>
  31.664 -    if Inttriplefunc.is_undefined eq then eliminate dun oeqs else
  31.665 +    if Inttriplefunc.is_empty eq then eliminate dun oeqs else
  31.666      let val v = choose_variable eq
  31.667          val a = Inttriplefunc.apply eq v
  31.668          val eq' = pi_equation_cmul ((Rat.rat_of_int ~1) // a) 
  31.669 -                   (Inttriplefunc.undefine v eq)
  31.670 +                   (Inttriplefunc.delete_safe v eq)
  31.671          fun elim e =
  31.672           let val b = Inttriplefunc.tryapplyd e v rat_0 
  31.673           in if b =/ rat_0 then e 
  31.674              else pi_equation_add e (pi_equation_cmul (Rat.neg b // a) eq)
  31.675           end
  31.676 -    in eliminate (Inttriplefunc.update(v, eq') (Inttriplefunc.mapf elim dun)) 
  31.677 +    in eliminate (Inttriplefunc.update(v, eq') (Inttriplefunc.map elim dun)) 
  31.678                   (map elim oeqs) 
  31.679      end
  31.680  in fn eqs =>
  31.681   let 
  31.682 -  val assig = eliminate Inttriplefunc.undefined eqs
  31.683 +  val assig = eliminate Inttriplefunc.empty eqs
  31.684    val vs = Inttriplefunc.fold (fn (x, f) => fn a => remove (dest_ord triple_int_ord) one (Inttriplefunc.dom f) @ a) assig []
  31.685   in (distinct (dest_ord triple_int_ord) vs,assig)
  31.686   end
  31.687 @@ -873,29 +865,29 @@
  31.688              (Inttriplefunc.onefunc(one, Rat.rat_of_int ~1))
  31.689    val ass =
  31.690      Inttriplefunc.combine (curry op +/) (K false) 
  31.691 -    (Inttriplefunc.mapf (pi_equation_eval vfn) assigs) vfn 
  31.692 +    (Inttriplefunc.map (pi_equation_eval vfn) assigs) vfn 
  31.693   in if forall (fn e => pi_equation_eval ass e =/ rat_0) eqs
  31.694 -    then Inttriplefunc.undefine one ass else raise Sanity
  31.695 +    then Inttriplefunc.delete_safe one ass else raise Sanity
  31.696   end;
  31.697  
  31.698  (* Multiply equation-parametrized poly by regular poly and add accumulator.  *)
  31.699  
  31.700  fun pi_epoly_pmul p q acc =
  31.701 - Monomialfunc.fold (fn (m1, c) => fn a =>
  31.702 -  Monomialfunc.fold (fn (m2,e) => fn b =>
  31.703 + FuncUtil.Monomialfunc.fold (fn (m1, c) => fn a =>
  31.704 +  FuncUtil.Monomialfunc.fold (fn (m2,e) => fn b =>
  31.705     let val m =  monomial_mul m1 m2
  31.706 -       val es = Monomialfunc.tryapplyd b m Inttriplefunc.undefined 
  31.707 -   in Monomialfunc.update (m,pi_equation_add (pi_equation_cmul c e) es) b 
  31.708 +       val es = FuncUtil.Monomialfunc.tryapplyd b m Inttriplefunc.empty 
  31.709 +   in FuncUtil.Monomialfunc.update (m,pi_equation_add (pi_equation_cmul c e) es) b 
  31.710     end) q a) p acc ;
  31.711  
  31.712  (* Usual operations on equation-parametrized poly.                           *)
  31.713  
  31.714  fun pi_epoly_cmul c l =
  31.715 -  if c =/ rat_0 then Inttriplefunc.undefined else Inttriplefunc.mapf (pi_equation_cmul c) l;;
  31.716 +  if c =/ rat_0 then Inttriplefunc.empty else Inttriplefunc.map (pi_equation_cmul c) l;;
  31.717  
  31.718  val pi_epoly_neg = pi_epoly_cmul (Rat.rat_of_int ~1);
  31.719  
  31.720 -val pi_epoly_add = Inttriplefunc.combine pi_equation_add Inttriplefunc.is_undefined;
  31.721 +val pi_epoly_add = Inttriplefunc.combine pi_equation_add Inttriplefunc.is_empty;
  31.722  
  31.723  fun pi_epoly_sub p q = pi_epoly_add p (pi_epoly_neg q);;
  31.724  
  31.725 @@ -914,27 +906,27 @@
  31.726  
  31.727  local
  31.728  fun diagonalize n i m =
  31.729 - if Intpairfunc.is_undefined (snd m) then [] 
  31.730 + if FuncUtil.Intpairfunc.is_empty (snd m) then [] 
  31.731   else
  31.732 -  let val a11 = Intpairfunc.tryapplyd (snd m) (i,i) rat_0 
  31.733 +  let val a11 = FuncUtil.Intpairfunc.tryapplyd (snd m) (i,i) rat_0 
  31.734    in if a11 </ rat_0 then raise Failure "diagonalize: not PSD"
  31.735      else if a11 =/ rat_0 then
  31.736 -          if Intfunc.is_undefined (snd (row i m)) then diagonalize n (i + 1) m
  31.737 +          if FuncUtil.Intfunc.is_empty (snd (row i m)) then diagonalize n (i + 1) m
  31.738            else raise Failure "diagonalize: not PSD ___ "
  31.739      else
  31.740       let 
  31.741        val v = row i m
  31.742 -      val v' = (fst v, Intfunc.fold (fn (i, c) => fn a => 
  31.743 +      val v' = (fst v, FuncUtil.Intfunc.fold (fn (i, c) => fn a => 
  31.744         let val y = c // a11 
  31.745 -       in if y = rat_0 then a else Intfunc.update (i,y) a 
  31.746 -       end)  (snd v) Intfunc.undefined)
  31.747 -      fun upt0 x y a = if y = rat_0 then a else Intpairfunc.update (x,y) a
  31.748 +       in if y = rat_0 then a else FuncUtil.Intfunc.update (i,y) a 
  31.749 +       end)  (snd v) FuncUtil.Intfunc.empty)
  31.750 +      fun upt0 x y a = if y = rat_0 then a else FuncUtil.Intpairfunc.update (x,y) a
  31.751        val m' =
  31.752        ((n,n),
  31.753        iter (i+1,n) (fn j =>
  31.754            iter (i+1,n) (fn k =>
  31.755 -              (upt0 (j,k) (Intpairfunc.tryapplyd (snd m) (j,k) rat_0 -/ Intfunc.tryapplyd (snd v) j rat_0 */ Intfunc.tryapplyd (snd v') k rat_0))))
  31.756 -          Intpairfunc.undefined)
  31.757 +              (upt0 (j,k) (FuncUtil.Intpairfunc.tryapplyd (snd m) (j,k) rat_0 -/ FuncUtil.Intfunc.tryapplyd (snd v) j rat_0 */ FuncUtil.Intfunc.tryapplyd (snd v') k rat_0))))
  31.758 +          FuncUtil.Intpairfunc.empty)
  31.759       in (a11,v')::diagonalize n (i + 1) m' 
  31.760       end
  31.761    end
  31.762 @@ -953,14 +945,14 @@
  31.763  (* Adjust a diagonalization to collect rationals at the start.               *)
  31.764    (* FIXME : Potentially polymorphic keys, but here only: integers!! *)
  31.765  local
  31.766 - fun upd0 x y a = if y =/ rat_0 then a else Intfunc.update(x,y) a;
  31.767 + fun upd0 x y a = if y =/ rat_0 then a else FuncUtil.Intfunc.update(x,y) a;
  31.768   fun mapa f (d,v) = 
  31.769 -  (d, Intfunc.fold (fn (i,c) => fn a => upd0 i (f c) a) v Intfunc.undefined)
  31.770 +  (d, FuncUtil.Intfunc.fold (fn (i,c) => fn a => upd0 i (f c) a) v FuncUtil.Intfunc.empty)
  31.771   fun adj (c,l) =
  31.772   let val a = 
  31.773 -  Intfunc.fold (fn (i,c) => fn a => lcm_rat a (denominator_rat c)) 
  31.774 +  FuncUtil.Intfunc.fold (fn (i,c) => fn a => lcm_rat a (denominator_rat c)) 
  31.775      (snd l) rat_1 //
  31.776 -  Intfunc.fold (fn (i,c) => fn a => gcd_rat a (numerator_rat c)) 
  31.777 +  FuncUtil.Intfunc.fold (fn (i,c) => fn a => gcd_rat a (numerator_rat c)) 
  31.778      (snd l) rat_0
  31.779    in ((c // (a */ a)),mapa (fn x => a */ x) l)
  31.780    end
  31.781 @@ -977,39 +969,35 @@
  31.782  
  31.783  fun enumerate_monomials d vars = 
  31.784   if d < 0 then []
  31.785 - else if d = 0 then [Ctermfunc.undefined]
  31.786 + else if d = 0 then [FuncUtil.Ctermfunc.empty]
  31.787   else if null vars then [monomial_1] else
  31.788   let val alts =
  31.789    map (fn k => let val oths = enumerate_monomials (d - k) (tl vars) 
  31.790 -               in map (fn ks => if k = 0 then ks else Ctermfunc.update (hd vars, k) ks) oths end) (0 upto d) 
  31.791 - in foldr1 op @ alts
  31.792 +               in map (fn ks => if k = 0 then ks else FuncUtil.Ctermfunc.update (hd vars, k) ks) oths end) (0 upto d) 
  31.793 + in flat alts
  31.794   end;
  31.795  
  31.796  (* Enumerate products of distinct input polys with degree <= d.              *)
  31.797  (* We ignore any constant input polynomials.                                 *)
  31.798  (* Give the output polynomial and a record of how it was derived.            *)
  31.799  
  31.800 -local
  31.801 - open RealArith
  31.802 -in
  31.803  fun enumerate_products d pols =
  31.804 -if d = 0 then [(poly_const rat_1,Rational_lt rat_1)] 
  31.805 +if d = 0 then [(poly_const rat_1,RealArith.Rational_lt rat_1)] 
  31.806  else if d < 0 then [] else
  31.807  case pols of 
  31.808 -   [] => [(poly_const rat_1,Rational_lt rat_1)]
  31.809 +   [] => [(poly_const rat_1,RealArith.Rational_lt rat_1)]
  31.810   | (p,b)::ps => 
  31.811      let val e = multidegree p 
  31.812      in if e = 0 then enumerate_products d ps else
  31.813         enumerate_products d ps @
  31.814 -       map (fn (q,c) => (poly_mul p q,Product(b,c)))
  31.815 +       map (fn (q,c) => (poly_mul p q,RealArith.Product(b,c)))
  31.816           (enumerate_products (d - e) ps)
  31.817      end
  31.818 -end;
  31.819  
  31.820  (* Convert regular polynomial. Note that we treat (0,0,0) as -1.             *)
  31.821  
  31.822  fun epoly_of_poly p =
  31.823 -  Monomialfunc.fold (fn (m,c) => fn a => Monomialfunc.update (m, Inttriplefunc.onefunc ((0,0,0), Rat.neg c)) a) p Monomialfunc.undefined;
  31.824 +  FuncUtil.Monomialfunc.fold (fn (m,c) => fn a => FuncUtil.Monomialfunc.update (m, Inttriplefunc.onefunc ((0,0,0), Rat.neg c)) a) p FuncUtil.Monomialfunc.empty;
  31.825  
  31.826  (* String for block diagonal matrix numbered k.                              *)
  31.827  
  31.828 @@ -1020,7 +1008,7 @@
  31.829      Inttriplefunc.fold 
  31.830        (fn ((b,i,j),c) => fn a => if i > j then a else ((b,i,j),c)::a) 
  31.831        m [] 
  31.832 -  val entss = sort (increasing fst triple_int_ord) ents 
  31.833 +  val entss = sort (triple_int_ord o pairself fst) ents 
  31.834   in fold_rev (fn ((b,i,j),c) => fn a =>
  31.835       pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
  31.836       " " ^ decimalize 20 c ^ "\n" ^ a) entss ""
  31.837 @@ -1033,7 +1021,7 @@
  31.838   in
  31.839    string_of_int m ^ "\n" ^
  31.840    string_of_int nblocks ^ "\n" ^
  31.841 -  (foldr1 (fn (s, t) => s^" "^t) (map string_of_int blocksizes)) ^
  31.842 +  (space_implode " " (map string_of_int blocksizes)) ^
  31.843    "\n" ^
  31.844    sdpa_of_vector obj ^
  31.845    fold_rev2 (fn k => fn m => fn a => sdpa_of_blockdiagonal (k - 1) m ^ a)
  31.846 @@ -1049,8 +1037,8 @@
  31.847  
  31.848  val bmatrix_add = Inttriplefunc.combine (curry op +/) (fn x => x =/ rat_0);
  31.849  fun bmatrix_cmul c bm =
  31.850 -  if c =/ rat_0 then Inttriplefunc.undefined
  31.851 -  else Inttriplefunc.mapf (fn x => c */ x) bm;
  31.852 +  if c =/ rat_0 then Inttriplefunc.empty
  31.853 +  else Inttriplefunc.map (fn x => c */ x) bm;
  31.854  
  31.855  val bmatrix_neg = bmatrix_cmul (Rat.rat_of_int ~1);
  31.856  fun bmatrix_sub m1 m2 = bmatrix_add m1 (bmatrix_neg m2);;
  31.857 @@ -1060,8 +1048,8 @@
  31.858  fun blocks blocksizes bm =
  31.859   map (fn (bs,b0) =>
  31.860        let val m = Inttriplefunc.fold
  31.861 -          (fn ((b,i,j),c) => fn a => if b = b0 then Intpairfunc.update ((i,j),c) a else a) bm Intpairfunc.undefined
  31.862 -          val d = Intpairfunc.fold (fn ((i,j),c) => fn a => max a (max i j)) m 0 
  31.863 +          (fn ((b,i,j),c) => fn a => if b = b0 then FuncUtil.Intpairfunc.update ((i,j),c) a else a) bm FuncUtil.Intpairfunc.empty
  31.864 +          val d = FuncUtil.Intpairfunc.fold (fn ((i,j),c) => fn a => max a (max i j)) m 0 
  31.865        in (((bs,bs),m):matrix) end)
  31.866   (blocksizes ~~ (1 upto length blocksizes));;
  31.867  
  31.868 @@ -1076,15 +1064,12 @@
  31.869  (* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *)
  31.870  
  31.871   
  31.872 -local
  31.873 - open RealArith
  31.874 -in
  31.875  fun real_positivnullstellensatz_general prover linf d eqs leqs pol =
  31.876  let 
  31.877   val vars = fold_rev (curry (gen_union (op aconvc)) o poly_variables) 
  31.878                (pol::eqs @ map fst leqs) []
  31.879   val monoid = if linf then 
  31.880 -      (poly_const rat_1,Rational_lt rat_1)::
  31.881 +      (poly_const rat_1,RealArith.Rational_lt rat_1)::
  31.882        (filter (fn (p,c) => multidegree p <= d) leqs)
  31.883      else enumerate_products d leqs
  31.884   val nblocks = length monoid
  31.885 @@ -1094,7 +1079,7 @@
  31.886     val mons = enumerate_monomials e vars
  31.887     val nons = mons ~~ (1 upto length mons) 
  31.888    in (mons,
  31.889 -      fold_rev (fn (m,n) => Monomialfunc.update(m,Inttriplefunc.onefunc((~k,~n,n),rat_1))) nons Monomialfunc.undefined)
  31.890 +      fold_rev (fn (m,n) => FuncUtil.Monomialfunc.update(m,Inttriplefunc.onefunc((~k,~n,n),rat_1))) nons FuncUtil.Monomialfunc.empty)
  31.891    end
  31.892  
  31.893   fun mk_sqmultiplier k (p,c) =
  31.894 @@ -1108,11 +1093,11 @@
  31.895          let val m = monomial_mul m1 m2 
  31.896          in if n1 > n2 then a else
  31.897            let val c = if n1 = n2 then rat_1 else rat_2
  31.898 -              val e = Monomialfunc.tryapplyd a m Inttriplefunc.undefined 
  31.899 -          in Monomialfunc.update(m, tri_equation_add (Inttriplefunc.onefunc((k,n1,n2), c)) e) a
  31.900 +              val e = FuncUtil.Monomialfunc.tryapplyd a m Inttriplefunc.empty 
  31.901 +          in FuncUtil.Monomialfunc.update(m, tri_equation_add (Inttriplefunc.onefunc((k,n1,n2), c)) e) a
  31.902            end
  31.903          end)  nons)
  31.904 -       nons Monomialfunc.undefined)
  31.905 +       nons FuncUtil.Monomialfunc.empty)
  31.906    end
  31.907  
  31.908    val (sqmonlist,sqs) = split_list (map2 mk_sqmultiplier (1 upto length monoid) monoid)
  31.909 @@ -1122,7 +1107,7 @@
  31.910      fold_rev2 (fn p => fn q => fn a => tri_epoly_pmul p q a) eqs ids
  31.911              (fold_rev2 (fn (p,c) => fn s => fn a => tri_epoly_pmul p s a) monoid sqs
  31.912                       (epoly_of_poly(poly_neg pol)))
  31.913 -  val eqns = Monomialfunc.fold (fn (m,e) => fn a => e::a) bigsum []
  31.914 +  val eqns = FuncUtil.Monomialfunc.fold (fn (m,e) => fn a => e::a) bigsum []
  31.915    val (pvs,assig) = tri_eliminate_all_equations (0,0,0) eqns
  31.916    val qvars = (0,0,0)::pvs
  31.917    val allassig = fold_rev (fn v => Inttriplefunc.update(v,(Inttriplefunc.onefunc(v,rat_1)))) pvs assig
  31.918 @@ -1133,19 +1118,19 @@
  31.919           in if c = rat_0 then m else
  31.920              Inttriplefunc.update ((b,j,i), c) (Inttriplefunc.update ((b,i,j), c) m)
  31.921           end)
  31.922 -          allassig Inttriplefunc.undefined
  31.923 +          allassig Inttriplefunc.empty
  31.924    val diagents = Inttriplefunc.fold
  31.925      (fn ((b,i,j), e) => fn a => if b > 0 andalso i = j then tri_equation_add e a else a)
  31.926 -    allassig Inttriplefunc.undefined
  31.927 +    allassig Inttriplefunc.empty
  31.928  
  31.929    val mats = map mk_matrix qvars
  31.930    val obj = (length pvs,
  31.931 -            itern 1 pvs (fn v => fn i => Intfunc.updatep iszero (i,Inttriplefunc.tryapplyd diagents v rat_0))
  31.932 -                        Intfunc.undefined)
  31.933 +            itern 1 pvs (fn v => fn i => FuncUtil.Intfunc.updatep iszero (i,Inttriplefunc.tryapplyd diagents v rat_0))
  31.934 +                        FuncUtil.Intfunc.empty)
  31.935    val raw_vec = if null pvs then vector_0 0
  31.936                  else tri_scale_then (run_blockproblem prover nblocks blocksizes) obj mats
  31.937 -  fun int_element (d,v) i = Intfunc.tryapplyd v i rat_0
  31.938 -  fun cterm_element (d,v) i = Ctermfunc.tryapplyd v i rat_0
  31.939 +  fun int_element (d,v) i = FuncUtil.Intfunc.tryapplyd v i rat_0
  31.940 +  fun cterm_element (d,v) i = FuncUtil.Ctermfunc.tryapplyd v i rat_0
  31.941  
  31.942    fun find_rounding d =
  31.943     let 
  31.944 @@ -1169,12 +1154,12 @@
  31.945    val finalassigs =
  31.946      Inttriplefunc.fold (fn (v,e) => fn a => Inttriplefunc.update(v, tri_equation_eval newassigs e) a) allassig newassigs
  31.947    fun poly_of_epoly p =
  31.948 -    Monomialfunc.fold (fn (v,e) => fn a => Monomialfunc.updatep iszero (v,tri_equation_eval finalassigs e) a)
  31.949 -          p Monomialfunc.undefined
  31.950 +    FuncUtil.Monomialfunc.fold (fn (v,e) => fn a => FuncUtil.Monomialfunc.updatep iszero (v,tri_equation_eval finalassigs e) a)
  31.951 +          p FuncUtil.Monomialfunc.empty
  31.952    fun  mk_sos mons =
  31.953     let fun mk_sq (c,m) =
  31.954 -    (c,fold_rev (fn k=> fn a => Monomialfunc.updatep iszero (nth mons (k - 1), int_element m k) a)
  31.955 -                 (1 upto length mons) Monomialfunc.undefined)
  31.956 +    (c,fold_rev (fn k=> fn a => FuncUtil.Monomialfunc.updatep iszero (nth mons (k - 1), int_element m k) a)
  31.957 +                 (1 upto length mons) FuncUtil.Monomialfunc.empty)
  31.958     in map mk_sq
  31.959     end
  31.960    val sqs = map2 mk_sos sqmonlist ratdias
  31.961 @@ -1186,13 +1171,11 @@
  31.962             (fold_rev2 (fn p => fn q => poly_add (poly_mul p q)) cfs eqs
  31.963                      (poly_neg pol))
  31.964  
  31.965 -in if not(Monomialfunc.is_undefined sanity) then raise Sanity else
  31.966 +in if not(FuncUtil.Monomialfunc.is_empty sanity) then raise Sanity else
  31.967    (cfs,map (fn (a,b) => (snd a,b)) msq)
  31.968   end
  31.969  
  31.970  
  31.971 -end;
  31.972 -
  31.973  (* Iterative deepening.                                                      *)
  31.974  
  31.975  fun deepen f n = 
  31.976 @@ -1201,21 +1184,15 @@
  31.977  
  31.978  (* Map back polynomials and their composites to a positivstellensatz.        *)
  31.979  
  31.980 -local
  31.981 - open Thm Numeral RealArith
  31.982 -in
  31.983 -
  31.984 -fun cterm_of_sqterm (c,p) = Product(Rational_lt c,Square p);
  31.985 +fun cterm_of_sqterm (c,p) = RealArith.Product(RealArith.Rational_lt c,RealArith.Square p);
  31.986  
  31.987  fun cterm_of_sos (pr,sqs) = if null sqs then pr
  31.988 -  else Product(pr,foldr1 (fn (a, b) => Sum(a,b)) (map cterm_of_sqterm sqs));
  31.989 -
  31.990 -end
  31.991 +  else RealArith.Product(pr,foldr1 RealArith.Sum (map cterm_of_sqterm sqs));
  31.992  
  31.993  (* Interface to HOL.                                                         *)
  31.994  local
  31.995 -  open Thm Conv RealArith
  31.996 -  val concl = dest_arg o cprop_of
  31.997 +  open Conv
  31.998 +  val concl = Thm.dest_arg o cprop_of
  31.999    fun simple_cterm_ord t u = TermOrd.fast_term_ord (term_of t, term_of u) = LESS
 31.1000  in
 31.1001    (* FIXME: Replace tryfind by get_first !! *)
 31.1002 @@ -1228,37 +1205,37 @@
 31.1003         real_poly_pow_conv,real_poly_sub_conv,real_poly_conv) = (add,mul,neg,pow,sub,main)
 31.1004    fun mainf cert_choice translator (eqs,les,lts) = 
 31.1005    let 
 31.1006 -   val eq0 = map (poly_of_term o dest_arg1 o concl) eqs
 31.1007 -   val le0 = map (poly_of_term o dest_arg o concl) les
 31.1008 -   val lt0 = map (poly_of_term o dest_arg o concl) lts
 31.1009 -   val eqp0 = map (fn (t,i) => (t,Axiom_eq i)) (eq0 ~~ (0 upto (length eq0 - 1)))
 31.1010 -   val lep0 = map (fn (t,i) => (t,Axiom_le i)) (le0 ~~ (0 upto (length le0 - 1)))
 31.1011 -   val ltp0 = map (fn (t,i) => (t,Axiom_lt i)) (lt0 ~~ (0 upto (length lt0 - 1)))
 31.1012 +   val eq0 = map (poly_of_term o Thm.dest_arg1 o concl) eqs
 31.1013 +   val le0 = map (poly_of_term o Thm.dest_arg o concl) les
 31.1014 +   val lt0 = map (poly_of_term o Thm.dest_arg o concl) lts
 31.1015 +   val eqp0 = map (fn (t,i) => (t,RealArith.Axiom_eq i)) (eq0 ~~ (0 upto (length eq0 - 1)))
 31.1016 +   val lep0 = map (fn (t,i) => (t,RealArith.Axiom_le i)) (le0 ~~ (0 upto (length le0 - 1)))
 31.1017 +   val ltp0 = map (fn (t,i) => (t,RealArith.Axiom_lt i)) (lt0 ~~ (0 upto (length lt0 - 1)))
 31.1018     val (keq,eq) = List.partition (fn (p,_) => multidegree p = 0) eqp0
 31.1019     val (klep,lep) = List.partition (fn (p,_) => multidegree p = 0) lep0
 31.1020     val (kltp,ltp) = List.partition (fn (p,_) => multidegree p = 0) ltp0
 31.1021     fun trivial_axiom (p,ax) =
 31.1022      case ax of
 31.1023 -       Axiom_eq n => if eval Ctermfunc.undefined p <>/ Rat.zero then nth eqs n 
 31.1024 +       RealArith.Axiom_eq n => if eval FuncUtil.Ctermfunc.empty p <>/ Rat.zero then nth eqs n 
 31.1025                       else raise Failure "trivial_axiom: Not a trivial axiom"
 31.1026 -     | Axiom_le n => if eval Ctermfunc.undefined p </ Rat.zero then nth les n 
 31.1027 +     | RealArith.Axiom_le n => if eval FuncUtil.Ctermfunc.empty p </ Rat.zero then nth les n 
 31.1028                       else raise Failure "trivial_axiom: Not a trivial axiom"
 31.1029 -     | Axiom_lt n => if eval Ctermfunc.undefined p <=/ Rat.zero then nth lts n 
 31.1030 +     | RealArith.Axiom_lt n => if eval FuncUtil.Ctermfunc.empty p <=/ Rat.zero then nth lts n 
 31.1031                       else raise Failure "trivial_axiom: Not a trivial axiom"
 31.1032       | _ => error "trivial_axiom: Not a trivial axiom"
 31.1033     in 
 31.1034    (let val th = tryfind trivial_axiom (keq @ klep @ kltp)
 31.1035     in
 31.1036 -    (fconv_rule (arg_conv (arg1_conv real_poly_conv) then_conv field_comp_conv) th, Trivial)
 31.1037 +    (fconv_rule (arg_conv (arg1_conv real_poly_conv) then_conv field_comp_conv) th, RealArith.Trivial)
 31.1038     end)
 31.1039     handle Failure _ => 
 31.1040       (let val proof =
 31.1041         (case proof_method of Certificate certs =>
 31.1042           (* choose certificate *)
 31.1043           let
 31.1044 -           fun chose_cert [] (Cert c) = c
 31.1045 -             | chose_cert (Left::s) (Branch (l, _)) = chose_cert s l
 31.1046 -             | chose_cert (Right::s) (Branch (_, r)) = chose_cert s r
 31.1047 +           fun chose_cert [] (RealArith.Cert c) = c
 31.1048 +             | chose_cert (RealArith.Left::s) (RealArith.Branch (l, _)) = chose_cert s l
 31.1049 +             | chose_cert (RealArith.Right::s) (RealArith.Branch (_, r)) = chose_cert s r
 31.1050               | chose_cert _ _ = error "certificate tree in invalid form"
 31.1051           in
 31.1052             chose_cert cert_choice certs
 31.1053 @@ -1278,17 +1255,17 @@
 31.1054             end
 31.1055           val (d,i,(cert_ideal,cert_cone)) = deepen tryall 0
 31.1056           val proofs_ideal =
 31.1057 -           map2 (fn q => fn (p,ax) => Eqmul(q,ax)) cert_ideal eq
 31.1058 +           map2 (fn q => fn (p,ax) => RealArith.Eqmul(q,ax)) cert_ideal eq
 31.1059           val proofs_cone = map cterm_of_sos cert_cone
 31.1060 -         val proof_ne = if null ltp then Rational_lt Rat.one else
 31.1061 -           let val p = foldr1 (fn (s, t) => Product(s,t)) (map snd ltp) 
 31.1062 -           in  funpow i (fn q => Product(p,q)) (Rational_lt Rat.one)
 31.1063 +         val proof_ne = if null ltp then RealArith.Rational_lt Rat.one else
 31.1064 +           let val p = foldr1 RealArith.Product (map snd ltp) 
 31.1065 +           in  funpow i (fn q => RealArith.Product(p,q)) (RealArith.Rational_lt Rat.one)
 31.1066             end
 31.1067           in 
 31.1068 -           foldr1 (fn (s, t) => Sum(s,t)) (proof_ne :: proofs_ideal @ proofs_cone) 
 31.1069 +           foldr1 RealArith.Sum (proof_ne :: proofs_ideal @ proofs_cone) 
 31.1070           end)
 31.1071       in
 31.1072 -        (translator (eqs,les,lts) proof, Cert proof)
 31.1073 +        (translator (eqs,les,lts) proof, RealArith.Cert proof)
 31.1074       end)
 31.1075     end
 31.1076   in mainf end
 31.1077 @@ -1305,9 +1282,9 @@
 31.1078  (* A wrapper that tries to substitute away variables first.                  *)
 31.1079  
 31.1080  local
 31.1081 - open Thm Conv RealArith
 31.1082 + open Conv
 31.1083    fun simple_cterm_ord t u = TermOrd.fast_term_ord (term_of t, term_of u) = LESS
 31.1084 - val concl = dest_arg o cprop_of
 31.1085 + val concl = Thm.dest_arg o cprop_of
 31.1086   val shuffle1 = 
 31.1087     fconv_rule (rewr_conv @{lemma "(a + x == y) == (x == y - (a::real))" by (atomize (full)) (simp add: ring_simps) })
 31.1088   val shuffle2 =
 31.1089 @@ -1316,19 +1293,19 @@
 31.1090      Free(_,@{typ real}) => if not (member (op aconvc) fvs tm) then (Rat.one,tm) 
 31.1091                             else raise Failure "substitutable_monomial"
 31.1092    | @{term "op * :: real => _"}$c$(t as Free _ ) => 
 31.1093 -     if is_ratconst (dest_arg1 tm) andalso not (member (op aconvc) fvs (dest_arg tm))
 31.1094 -         then (dest_ratconst (dest_arg1 tm),dest_arg tm) else raise Failure "substitutable_monomial"
 31.1095 +     if RealArith.is_ratconst (Thm.dest_arg1 tm) andalso not (member (op aconvc) fvs (Thm.dest_arg tm))
 31.1096 +         then (RealArith.dest_ratconst (Thm.dest_arg1 tm),Thm.dest_arg tm) else raise Failure "substitutable_monomial"
 31.1097    | @{term "op + :: real => _"}$s$t => 
 31.1098 -       (substitutable_monomial (add_cterm_frees (dest_arg tm) fvs) (dest_arg1 tm)
 31.1099 -        handle Failure _ => substitutable_monomial (add_cterm_frees (dest_arg1 tm) fvs) (dest_arg tm))
 31.1100 +       (substitutable_monomial (Thm.add_cterm_frees (Thm.dest_arg tm) fvs) (Thm.dest_arg1 tm)
 31.1101 +        handle Failure _ => substitutable_monomial (Thm.add_cterm_frees (Thm.dest_arg1 tm) fvs) (Thm.dest_arg tm))
 31.1102    | _ => raise Failure "substitutable_monomial"
 31.1103  
 31.1104    fun isolate_variable v th = 
 31.1105 -   let val w = dest_arg1 (cprop_of th)
 31.1106 +   let val w = Thm.dest_arg1 (cprop_of th)
 31.1107     in if v aconvc w then th
 31.1108        else case term_of w of
 31.1109             @{term "op + :: real => _"}$s$t => 
 31.1110 -              if dest_arg1 w aconvc v then shuffle2 th 
 31.1111 +              if Thm.dest_arg1 w aconvc v then shuffle2 th 
 31.1112                else isolate_variable v (shuffle1 th)
 31.1113            | _ => error "isolate variable : This should not happen?"
 31.1114     end 
 31.1115 @@ -1345,8 +1322,8 @@
 31.1116  
 31.1117    fun make_substitution th =
 31.1118     let 
 31.1119 -    val (c,v) = substitutable_monomial [] (dest_arg1(concl th))
 31.1120 -    val th1 = Drule.arg_cong_rule (capply @{cterm "op * :: real => _"} (cterm_of_rat (Rat.inv c))) (mk_meta_eq th)
 31.1121 +    val (c,v) = substitutable_monomial [] (Thm.dest_arg1(concl th))
 31.1122 +    val th1 = Drule.arg_cong_rule (Thm.capply @{cterm "op * :: real => _"} (RealArith.cterm_of_rat (Rat.inv c))) (mk_meta_eq th)
 31.1123      val th2 = fconv_rule (binop_conv real_poly_mul_conv) th1
 31.1124     in fconv_rule (arg_conv real_poly_conv) (isolate_variable v th2)
 31.1125     end
 31.1126 @@ -1378,18 +1355,9 @@
 31.1127  (* Overall function. *)
 31.1128  
 31.1129  fun real_sos prover ctxt =
 31.1130 -  gen_prover_real_arith ctxt (real_nonlinear_subst_prover prover ctxt)
 31.1131 +  RealArith.gen_prover_real_arith ctxt (real_nonlinear_subst_prover prover ctxt)
 31.1132  end;
 31.1133  
 31.1134 -(* A tactic *)
 31.1135 -fun strip_all ct = 
 31.1136 - case term_of ct of 
 31.1137 -  Const("all",_) $ Abs (xn,xT,p) => 
 31.1138 -   let val (a,(v,t')) = (apsnd (Thm.dest_abs (SOME xn)) o Thm.dest_comb) ct
 31.1139 -   in apfst (cons v) (strip_all t')
 31.1140 -   end
 31.1141 -| _ => ([],ct)
 31.1142 -
 31.1143  val known_sos_constants = 
 31.1144    [@{term "op ==>"}, @{term "Trueprop"}, 
 31.1145     @{term "op -->"}, @{term "op &"}, @{term "op |"}, 
 31.1146 @@ -1424,13 +1392,17 @@
 31.1147                else error ("SOSO: Unknown constants in Subgoal:" ^ commas (map fst ukcs))
 31.1148  in () end
 31.1149  
 31.1150 -fun core_sos_tac print_cert prover ctxt = CSUBGOAL (fn (ct, i) => 
 31.1151 -  let val _ = check_sos known_sos_constants ct
 31.1152 -      val (avs, p) = strip_all ct
 31.1153 -      val (ths, certificates) = real_sos prover ctxt (Thm.dest_arg p)
 31.1154 -      val th = standard (fold_rev forall_intr avs ths)
 31.1155 -      val _ = print_cert certificates
 31.1156 -  in rtac th i end);
 31.1157 +fun core_sos_tac print_cert prover ctxt i = 
 31.1158 +  let
 31.1159 +    fun core_tac {concl, context, ...} =
 31.1160 +      let
 31.1161 +        val _ = check_sos known_sos_constants concl
 31.1162 +        val (ths, certificates) = real_sos prover context (Thm.dest_arg concl)
 31.1163 +        val _ = print_cert certificates
 31.1164 +      in rtac ths i end
 31.1165 +  in
 31.1166 +    SUBPROOF core_tac ctxt i
 31.1167 +  end
 31.1168  
 31.1169  fun default_SOME f NONE v = SOME v
 31.1170    | default_SOME f (SOME v) _ = SOME v;
    32.1 --- a/src/HOL/Library/normarith.ML	Thu Oct 01 20:49:46 2009 +0200
    32.2 +++ b/src/HOL/Library/normarith.ML	Thu Oct 01 20:52:18 2009 +0200
    32.3 @@ -15,7 +15,7 @@
    32.4  structure NormArith : NORM_ARITH = 
    32.5  struct
    32.6  
    32.7 - open Conv Thm FuncUtil;
    32.8 + open Conv;
    32.9   val bool_eq = op = : bool *bool -> bool
   32.10    fun dest_ratconst t = case term_of t of
   32.11     Const(@{const_name divide}, _)$a$b => Rat.rat_of_quotient(HOLogic.dest_number a |> snd, HOLogic.dest_number b |> snd)
   32.12 @@ -23,50 +23,50 @@
   32.13   | _ => Rat.rat_of_int (HOLogic.dest_number (term_of t) |> snd)
   32.14   fun is_ratconst t = can dest_ratconst t
   32.15   fun augment_norm b t acc = case term_of t of 
   32.16 -     Const(@{const_name norm}, _) $ _ => insert (eq_pair bool_eq (op aconvc)) (b,dest_arg t) acc
   32.17 +     Const(@{const_name norm}, _) $ _ => insert (eq_pair bool_eq (op aconvc)) (b,Thm.dest_arg t) acc
   32.18     | _ => acc
   32.19   fun find_normedterms t acc = case term_of t of
   32.20      @{term "op + :: real => _"}$_$_ =>
   32.21 -            find_normedterms (dest_arg1 t) (find_normedterms (dest_arg t) acc)
   32.22 +            find_normedterms (Thm.dest_arg1 t) (find_normedterms (Thm.dest_arg t) acc)
   32.23        | @{term "op * :: real => _"}$_$n =>
   32.24 -            if not (is_ratconst (dest_arg1 t)) then acc else
   32.25 -            augment_norm (dest_ratconst (dest_arg1 t) >=/ Rat.zero) 
   32.26 -                      (dest_arg t) acc
   32.27 +            if not (is_ratconst (Thm.dest_arg1 t)) then acc else
   32.28 +            augment_norm (dest_ratconst (Thm.dest_arg1 t) >=/ Rat.zero) 
   32.29 +                      (Thm.dest_arg t) acc
   32.30        | _ => augment_norm true t acc 
   32.31  
   32.32 - val cterm_lincomb_neg = Ctermfunc.mapf Rat.neg
   32.33 + val cterm_lincomb_neg = FuncUtil.Ctermfunc.map Rat.neg
   32.34   fun cterm_lincomb_cmul c t = 
   32.35 -    if c =/ Rat.zero then Ctermfunc.undefined else Ctermfunc.mapf (fn x => x */ c) t
   32.36 - fun cterm_lincomb_add l r = Ctermfunc.combine (curry op +/) (fn x => x =/ Rat.zero) l r
   32.37 +    if c =/ Rat.zero then FuncUtil.Ctermfunc.empty else FuncUtil.Ctermfunc.map (fn x => x */ c) t
   32.38 + fun cterm_lincomb_add l r = FuncUtil.Ctermfunc.combine (curry op +/) (fn x => x =/ Rat.zero) l r
   32.39   fun cterm_lincomb_sub l r = cterm_lincomb_add l (cterm_lincomb_neg r)
   32.40 - fun cterm_lincomb_eq l r = Ctermfunc.is_undefined (cterm_lincomb_sub l r)
   32.41 + fun cterm_lincomb_eq l r = FuncUtil.Ctermfunc.is_empty (cterm_lincomb_sub l r)
   32.42  
   32.43 - val int_lincomb_neg = Intfunc.mapf Rat.neg
   32.44 + val int_lincomb_neg = FuncUtil.Intfunc.map Rat.neg
   32.45   fun int_lincomb_cmul c t = 
   32.46 -    if c =/ Rat.zero then Intfunc.undefined else Intfunc.mapf (fn x => x */ c) t
   32.47 - fun int_lincomb_add l r = Intfunc.combine (curry op +/) (fn x => x =/ Rat.zero) l r
   32.48 +    if c =/ Rat.zero then FuncUtil.Intfunc.empty else FuncUtil.Intfunc.map (fn x => x */ c) t
   32.49 + fun int_lincomb_add l r = FuncUtil.Intfunc.combine (curry op +/) (fn x => x =/ Rat.zero) l r
   32.50   fun int_lincomb_sub l r = int_lincomb_add l (int_lincomb_neg r)
   32.51 - fun int_lincomb_eq l r = Intfunc.is_undefined (int_lincomb_sub l r)
   32.52 + fun int_lincomb_eq l r = FuncUtil.Intfunc.is_empty (int_lincomb_sub l r)
   32.53  
   32.54  fun vector_lincomb t = case term_of t of 
   32.55     Const(@{const_name plus}, _) $ _ $ _ =>
   32.56 -    cterm_lincomb_add (vector_lincomb (dest_arg1 t)) (vector_lincomb (dest_arg t))
   32.57 +    cterm_lincomb_add (vector_lincomb (Thm.dest_arg1 t)) (vector_lincomb (Thm.dest_arg t))
   32.58   | Const(@{const_name minus}, _) $ _ $ _ =>
   32.59 -    cterm_lincomb_sub (vector_lincomb (dest_arg1 t)) (vector_lincomb (dest_arg t))
   32.60 +    cterm_lincomb_sub (vector_lincomb (Thm.dest_arg1 t)) (vector_lincomb (Thm.dest_arg t))
   32.61   | Const(@{const_name scaleR}, _)$_$_ =>
   32.62 -    cterm_lincomb_cmul (dest_ratconst (dest_arg1 t)) (vector_lincomb (dest_arg t))
   32.63 +    cterm_lincomb_cmul (dest_ratconst (Thm.dest_arg1 t)) (vector_lincomb (Thm.dest_arg t))
   32.64   | Const(@{const_name uminus}, _)$_ =>
   32.65 -     cterm_lincomb_neg (vector_lincomb (dest_arg t))
   32.66 +     cterm_lincomb_neg (vector_lincomb (Thm.dest_arg t))
   32.67  (* FIXME: how should we handle numerals?
   32.68   | Const(@ {const_name vec},_)$_ => 
   32.69     let 
   32.70 -     val b = ((snd o HOLogic.dest_number o term_of o dest_arg) t = 0 
   32.71 +     val b = ((snd o HOLogic.dest_number o term_of o Thm.dest_arg) t = 0 
   32.72                 handle TERM _=> false)
   32.73 -   in if b then Ctermfunc.onefunc (t,Rat.one)
   32.74 -      else Ctermfunc.undefined
   32.75 +   in if b then FuncUtil.Ctermfunc.onefunc (t,Rat.one)
   32.76 +      else FuncUtil.Ctermfunc.empty
   32.77     end
   32.78  *)
   32.79 - | _ => Ctermfunc.onefunc (t,Rat.one)
   32.80 + | _ => FuncUtil.Ctermfunc.onefunc (t,Rat.one)
   32.81  
   32.82   fun vector_lincombs ts =
   32.83    fold_rev 
   32.84 @@ -82,35 +82,35 @@
   32.85  fun replacenegnorms cv t = case term_of t of 
   32.86    @{term "op + :: real => _"}$_$_ => binop_conv (replacenegnorms cv) t
   32.87  | @{term "op * :: real => _"}$_$_ => 
   32.88 -    if dest_ratconst (dest_arg1 t) </ Rat.zero then arg_conv cv t else reflexive t
   32.89 +    if dest_ratconst (Thm.dest_arg1 t) </ Rat.zero then arg_conv cv t else reflexive t
   32.90  | _ => reflexive t
   32.91  fun flip v eq = 
   32.92 -  if Ctermfunc.defined eq v 
   32.93 -  then Ctermfunc.update (v, Rat.neg (Ctermfunc.apply eq v)) eq else eq
   32.94 +  if FuncUtil.Ctermfunc.defined eq v 
   32.95 +  then FuncUtil.Ctermfunc.update (v, Rat.neg (FuncUtil.Ctermfunc.apply eq v)) eq else eq
   32.96  fun allsubsets s = case s of 
   32.97    [] => [[]]
   32.98  |(a::t) => let val res = allsubsets t in
   32.99                 map (cons a) res @ res end
  32.100  fun evaluate env lin =
  32.101 - Intfunc.fold (fn (x,c) => fn s => s +/ c */ (Intfunc.apply env x)) 
  32.102 + FuncUtil.Intfunc.fold (fn (x,c) => fn s => s +/ c */ (FuncUtil.Intfunc.apply env x)) 
  32.103     lin Rat.zero
  32.104  
  32.105  fun solve (vs,eqs) = case (vs,eqs) of
  32.106 -  ([],[]) => SOME (Intfunc.onefunc (0,Rat.one))
  32.107 +  ([],[]) => SOME (FuncUtil.Intfunc.onefunc (0,Rat.one))
  32.108   |(_,eq::oeqs) => 
  32.109 -   (case filter (member (op =) vs) (Intfunc.dom eq) of (*FIXME use find_first here*)
  32.110 +   (case filter (member (op =) vs) (FuncUtil.Intfunc.dom eq) of (*FIXME use find_first here*)
  32.111       [] => NONE
  32.112      | v::_ => 
  32.113 -       if Intfunc.defined eq v 
  32.114 +       if FuncUtil.Intfunc.defined eq v 
  32.115         then 
  32.116          let 
  32.117 -         val c = Intfunc.apply eq v
  32.118 +         val c = FuncUtil.Intfunc.apply eq v
  32.119           val vdef = int_lincomb_cmul (Rat.neg (Rat.inv c)) eq
  32.120 -         fun eliminate eqn = if not (Intfunc.defined eqn v) then eqn 
  32.121 -                             else int_lincomb_add (int_lincomb_cmul (Intfunc.apply eqn v) vdef) eqn
  32.122 +         fun eliminate eqn = if not (FuncUtil.Intfunc.defined eqn v) then eqn 
  32.123 +                             else int_lincomb_add (int_lincomb_cmul (FuncUtil.Intfunc.apply eqn v) vdef) eqn
  32.124          in (case solve (vs \ v,map eliminate oeqs) of
  32.125              NONE => NONE
  32.126 -          | SOME soln => SOME (Intfunc.update (v, evaluate soln (Intfunc.undefine v vdef)) soln))
  32.127 +          | SOME soln => SOME (FuncUtil.Intfunc.update (v, evaluate soln (FuncUtil.Intfunc.delete_safe v vdef)) soln))
  32.128          end
  32.129         else NONE)
  32.130  
  32.131 @@ -130,7 +130,7 @@
  32.132   let 
  32.133    fun vertex cmb = case solve(vs,cmb) of
  32.134      NONE => NONE
  32.135 -   | SOME soln => SOME (map (fn v => Intfunc.tryapplyd soln v Rat.zero) vs)
  32.136 +   | SOME soln => SOME (map (fn v => FuncUtil.Intfunc.tryapplyd soln v Rat.zero) vs)
  32.137    val rawvs = map_filter vertex (combinations (length vs) eqs)
  32.138    val unset = filter (forall (fn c => c >=/ Rat.zero)) rawvs 
  32.139   in fold_rev (insert (uncurry (forall2 (curry op =/)))) unset [] 
  32.140 @@ -265,28 +265,28 @@
  32.141   | fold_rev2 f _ _ _ = raise UnequalLengths;
  32.142  
  32.143  fun int_flip v eq = 
  32.144 -  if Intfunc.defined eq v 
  32.145 -  then Intfunc.update (v, Rat.neg (Intfunc.apply eq v)) eq else eq;
  32.146 +  if FuncUtil.Intfunc.defined eq v 
  32.147 +  then FuncUtil.Intfunc.update (v, Rat.neg (FuncUtil.Intfunc.apply eq v)) eq else eq;
  32.148  
  32.149  local
  32.150   val pth_zero = @{thm norm_zero}
  32.151 - val tv_n = (ctyp_of_term o dest_arg o dest_arg1 o dest_arg o cprop_of)
  32.152 + val tv_n = (ctyp_of_term o Thm.dest_arg o Thm.dest_arg1 o Thm.dest_arg o cprop_of)
  32.153               pth_zero
  32.154 - val concl = dest_arg o cprop_of 
  32.155 + val concl = Thm.dest_arg o cprop_of 
  32.156   fun real_vector_combo_prover ctxt translator (nubs,ges,gts) = 
  32.157    let 
  32.158     (* FIXME: Should be computed statically!!*)
  32.159     val real_poly_conv = 
  32.160        Normalizer.semiring_normalize_wrapper ctxt
  32.161         (valOf (NormalizerData.match ctxt @{cterm "(0::real) + 1"}))
  32.162 -   val sources = map (dest_arg o dest_arg1 o concl) nubs
  32.163 -   val rawdests = fold_rev (find_normedterms o dest_arg o concl) (ges @ gts) [] 
  32.164 +   val sources = map (Thm.dest_arg o Thm.dest_arg1 o concl) nubs
  32.165 +   val rawdests = fold_rev (find_normedterms o Thm.dest_arg o concl) (ges @ gts) [] 
  32.166     val _ = if not (forall fst rawdests) then error "real_vector_combo_prover: Sanity check" 
  32.167             else ()
  32.168     val dests = distinct (op aconvc) (map snd rawdests)
  32.169     val srcfuns = map vector_lincomb sources
  32.170     val destfuns = map vector_lincomb dests 
  32.171 -   val vvs = fold_rev (curry (gen_union op aconvc) o Ctermfunc.dom) (srcfuns @ destfuns) []
  32.172 +   val vvs = fold_rev (curry (gen_union op aconvc) o FuncUtil.Ctermfunc.dom) (srcfuns @ destfuns) []
  32.173     val n = length srcfuns
  32.174     val nvs = 1 upto n
  32.175     val srccombs = srcfuns ~~ nvs
  32.176 @@ -294,12 +294,12 @@
  32.177      let 
  32.178       fun coefficients x =
  32.179        let 
  32.180 -       val inp = if Ctermfunc.defined d x then Intfunc.onefunc (0, Rat.neg(Ctermfunc.apply d x))
  32.181 -                      else Intfunc.undefined 
  32.182 -      in fold_rev (fn (f,v) => fn g => if Ctermfunc.defined f x then Intfunc.update (v, Ctermfunc.apply f x) g else g) srccombs inp 
  32.183 +       val inp = if FuncUtil.Ctermfunc.defined d x then FuncUtil.Intfunc.onefunc (0, Rat.neg(FuncUtil.Ctermfunc.apply d x))
  32.184 +                      else FuncUtil.Intfunc.empty 
  32.185 +      in fold_rev (fn (f,v) => fn g => if FuncUtil.Ctermfunc.defined f x then FuncUtil.Intfunc.update (v, FuncUtil.Ctermfunc.apply f x) g else g) srccombs inp 
  32.186        end
  32.187       val equations = map coefficients vvs
  32.188 -     val inequalities = map (fn n => Intfunc.onefunc (n,Rat.one)) nvs
  32.189 +     val inequalities = map (fn n => FuncUtil.Intfunc.onefunc (n,Rat.one)) nvs
  32.190       fun plausiblevertices f =
  32.191        let 
  32.192         val flippedequations = map (fold_rev int_flip f) equations
  32.193 @@ -307,7 +307,7 @@
  32.194         val rawverts = vertices nvs constraints
  32.195         fun check_solution v =
  32.196          let 
  32.197 -          val f = fold_rev2 (curry Intfunc.update) nvs v (Intfunc.onefunc (0, Rat.one))
  32.198 +          val f = fold_rev2 (curry FuncUtil.Intfunc.update) nvs v (FuncUtil.Intfunc.onefunc (0, Rat.one))
  32.199          in forall (fn e => evaluate f e =/ Rat.zero) flippedequations
  32.200          end
  32.201         val goodverts = filter check_solution rawverts
  32.202 @@ -328,7 +328,7 @@
  32.203     val ges' = map_filter (try compute_ineq) (fold_rev (append o consider) destfuns []) @
  32.204                   map (inequality_canon_rule ctxt) nubs @ ges
  32.205     val zerodests = filter
  32.206 -        (fn t => null (Ctermfunc.dom (vector_lincomb t))) (map snd rawdests)
  32.207 +        (fn t => null (FuncUtil.Ctermfunc.dom (vector_lincomb t))) (map snd rawdests)
  32.208  
  32.209    in fst (RealArith.real_linear_prover translator
  32.210          (map (fn t => instantiate ([(tv_n, ctyp_of_term t)],[]) pth_zero)
  32.211 @@ -344,19 +344,19 @@
  32.212  local
  32.213   val pth = @{thm norm_imp_pos_and_ge}
  32.214   val norm_mp = match_mp pth
  32.215 - val concl = dest_arg o cprop_of
  32.216 + val concl = Thm.dest_arg o cprop_of
  32.217   fun conjunct1 th = th RS @{thm conjunct1}
  32.218   fun conjunct2 th = th RS @{thm conjunct2}
  32.219   fun C f x y = f y x
  32.220  fun real_vector_ineq_prover ctxt translator (ges,gts) = 
  32.221   let 
  32.222  (*   val _ = error "real_vector_ineq_prover: pause" *)
  32.223 -  val ntms = fold_rev find_normedterms (map (dest_arg o concl) (ges @ gts)) []
  32.224 +  val ntms = fold_rev find_normedterms (map (Thm.dest_arg o concl) (ges @ gts)) []
  32.225    val lctab = vector_lincombs (map snd (filter (not o fst) ntms))
  32.226    val (fxns, ctxt') = Variable.variant_fixes (replicate (length lctab) "x") ctxt
  32.227    fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms)
  32.228 -  fun mk_norm t = capply (instantiate_cterm' [SOME (ctyp_of_term t)] [] @{cpat "norm :: (?'a :: real_normed_vector) => real"}) t
  32.229 -  fun mk_equals l r = capply (capply (instantiate_cterm' [SOME (ctyp_of_term l)] [] @{cpat "op == :: ?'a =>_"}) l) r
  32.230 +  fun mk_norm t = Thm.capply (instantiate_cterm' [SOME (ctyp_of_term t)] [] @{cpat "norm :: (?'a :: real_normed_vector) => real"}) t
  32.231 +  fun mk_equals l r = Thm.capply (Thm.capply (instantiate_cterm' [SOME (ctyp_of_term l)] [] @{cpat "op == :: ?'a =>_"}) l) r
  32.232    val asl = map2 (fn (t,_) => fn n => assume (mk_equals (mk_norm t) (cterm_of (ProofContext.theory_of ctxt') (Free(n,@{typ real}))))) lctab fxns
  32.233    val replace_conv = try_conv (rewrs_conv asl)
  32.234    val replace_rule = fconv_rule (funpow 2 arg_conv (replacenegnorms replace_conv))
  32.235 @@ -368,7 +368,7 @@
  32.236    val th1 = real_vector_combo_prover ctxt' translator (nubs,ges',gts')
  32.237    val shs = filter (member (fn (t,th) => t aconvc cprop_of th) asl) (#hyps (crep_thm th1)) 
  32.238    val th11 = hd (Variable.export ctxt' ctxt [fold implies_intr shs th1])
  32.239 -  val cps = map (swap o dest_equals) (cprems_of th11)
  32.240 +  val cps = map (swap o Thm.dest_equals) (cprems_of th11)
  32.241    val th12 = instantiate ([], cps) th11
  32.242    val th13 = fold (C implies_elim) (map (reflexive o snd) cps) th12;
  32.243   in hd (Variable.export ctxt' ctxt [th13])
  32.244 @@ -406,7 +406,7 @@
  32.245     val ctxt' = Variable.declare_term (term_of ct) ctxt
  32.246     val th = init_conv ctxt' ct
  32.247    in equal_elim (Drule.arg_cong_rule @{cterm Trueprop} (symmetric th)) 
  32.248 -                (pure ctxt' (rhs_of th))
  32.249 +                (pure ctxt' (Thm.rhs_of th))
  32.250   end
  32.251  
  32.252   fun norm_arith_tac ctxt = 
    33.1 --- a/src/HOL/Library/positivstellensatz.ML	Thu Oct 01 20:49:46 2009 +0200
    33.2 +++ b/src/HOL/Library/positivstellensatz.ML	Thu Oct 01 20:52:18 2009 +0200
    33.3 @@ -8,41 +8,24 @@
    33.4  
    33.5  signature FUNC = 
    33.6  sig
    33.7 - type 'a T
    33.8 - type key
    33.9 - val apply : 'a T -> key -> 'a
   33.10 - val applyd :'a T -> (key -> 'a) -> key -> 'a
   33.11 - val combine : ('a -> 'a -> 'a) -> ('a -> bool) -> 'a T -> 'a T -> 'a T
   33.12 - val defined : 'a T -> key -> bool
   33.13 - val dom : 'a T -> key list
   33.14 - val fold : (key * 'a -> 'b -> 'b) -> 'a T -> 'b -> 'b
   33.15 - val fold_rev : (key * 'a -> 'b -> 'b) -> 'a T -> 'b -> 'b
   33.16 - val graph : 'a T -> (key * 'a) list
   33.17 - val is_undefined : 'a T -> bool
   33.18 - val mapf : ('a -> 'b) -> 'a T -> 'b T
   33.19 - val tryapplyd : 'a T -> key -> 'a -> 'a
   33.20 - val undefine :  key -> 'a T -> 'a T
   33.21 - val undefined : 'a T
   33.22 - val update : key * 'a -> 'a T -> 'a T
   33.23 - val updatep : (key * 'a -> bool) -> key * 'a -> 'a T -> 'a T
   33.24 - val choose : 'a T -> key * 'a
   33.25 - val onefunc : key * 'a -> 'a T
   33.26 - val get_first: (key*'a -> 'a option) -> 'a T -> 'a option
   33.27 + include TABLE
   33.28 + val apply : 'a table -> key -> 'a
   33.29 + val applyd :'a table -> (key -> 'a) -> key -> 'a
   33.30 + val combine : ('a -> 'a -> 'a) -> ('a -> bool) -> 'a table -> 'a table -> 'a table
   33.31 + val dom : 'a table -> key list
   33.32 + val tryapplyd : 'a table -> key -> 'a -> 'a
   33.33 + val updatep : (key * 'a -> bool) -> key * 'a -> 'a table -> 'a table
   33.34 + val choose : 'a table -> key * 'a
   33.35 + val onefunc : key * 'a -> 'a table
   33.36  end;
   33.37  
   33.38  functor FuncFun(Key: KEY) : FUNC=
   33.39  struct
   33.40  
   33.41 -type key = Key.key;
   33.42  structure Tab = Table(Key);
   33.43 -type 'a T = 'a Tab.table;
   33.44  
   33.45 -val undefined = Tab.empty;
   33.46 -val is_undefined = Tab.is_empty;
   33.47 -val mapf = Tab.map;
   33.48 -val fold = Tab.fold;
   33.49 -val fold_rev = Tab.fold_rev;
   33.50 -val graph = Tab.dest;
   33.51 +open Tab;
   33.52 +
   33.53  fun dom a = sort Key.ord (Tab.keys a);
   33.54  fun applyd f d x = case Tab.lookup f x of 
   33.55     SOME y => y
   33.56 @@ -50,9 +33,6 @@
   33.57  
   33.58  fun apply f x = applyd f (fn _ => raise Tab.UNDEF x) x;
   33.59  fun tryapplyd f a d = applyd f (K d) a;
   33.60 -val defined = Tab.defined;
   33.61 -fun undefine x t = (Tab.delete x t handle UNDEF => t);
   33.62 -val update = Tab.update;
   33.63  fun updatep p (k,v) t = if p (k, v) then t else update (k,v) t
   33.64  fun combine f z a b = 
   33.65   let
   33.66 @@ -64,16 +44,10 @@
   33.67  
   33.68  fun choose f = case Tab.min_key f of 
   33.69     SOME k => (k,valOf (Tab.lookup f k))
   33.70 - | NONE => error "FuncFun.choose : Completely undefined function"
   33.71 -
   33.72 -fun onefunc kv = update kv undefined
   33.73 + | NONE => error "FuncFun.choose : Completely empty function"
   33.74  
   33.75 -local
   33.76 -fun  find f (k,v) NONE = f (k,v)
   33.77 -   | find f (k,v) r = r
   33.78 -in
   33.79 -fun get_first f t = fold (find f) t NONE
   33.80 -end
   33.81 +fun onefunc kv = update kv empty
   33.82 +
   33.83  end;
   33.84  
   33.85  (* Some standard functors and utility functions for them *)
   33.86 @@ -81,33 +55,31 @@
   33.87  structure FuncUtil =
   33.88  struct
   33.89  
   33.90 -fun increasing f ord (x,y) = ord (f x, f y);
   33.91 -
   33.92  structure Intfunc = FuncFun(type key = int val ord = int_ord);
   33.93  structure Ratfunc = FuncFun(type key = Rat.rat val ord = Rat.ord);
   33.94  structure Intpairfunc = FuncFun(type key = int*int val ord = prod_ord int_ord int_ord);
   33.95  structure Symfunc = FuncFun(type key = string val ord = fast_string_ord);
   33.96  structure Termfunc = FuncFun(type key = term val ord = TermOrd.fast_term_ord);
   33.97  
   33.98 -val cterm_ord = (fn (s,t) => TermOrd.fast_term_ord(term_of s, term_of t))
   33.99 +val cterm_ord = TermOrd.fast_term_ord o pairself term_of
  33.100  
  33.101  structure Ctermfunc = FuncFun(type key = cterm val ord = cterm_ord);
  33.102  
  33.103 -type monomial = int Ctermfunc.T;
  33.104 +type monomial = int Ctermfunc.table;
  33.105  
  33.106 -fun monomial_ord (m1,m2) = list_ord (prod_ord cterm_ord int_ord) (Ctermfunc.graph m1, Ctermfunc.graph m2)
  33.107 +val monomial_ord = list_ord (prod_ord cterm_ord int_ord) o pairself Ctermfunc.dest
  33.108  
  33.109  structure Monomialfunc = FuncFun(type key = monomial val ord = monomial_ord)
  33.110  
  33.111 -type poly = Rat.rat Monomialfunc.T;
  33.112 +type poly = Rat.rat Monomialfunc.table;
  33.113  
  33.114  (* The ordering so we can create canonical HOL polynomials.                  *)
  33.115  
  33.116 -fun dest_monomial mon = sort (increasing fst cterm_ord) (Ctermfunc.graph mon);
  33.117 +fun dest_monomial mon = sort (cterm_ord o pairself fst) (Ctermfunc.dest mon);
  33.118  
  33.119  fun monomial_order (m1,m2) =
  33.120 - if Ctermfunc.is_undefined m2 then LESS 
  33.121 - else if Ctermfunc.is_undefined m1 then GREATER 
  33.122 + if Ctermfunc.is_empty m2 then LESS 
  33.123 + else if Ctermfunc.is_empty m1 then GREATER 
  33.124   else
  33.125    let val mon1 = dest_monomial m1 
  33.126        val mon2 = dest_monomial m2
  33.127 @@ -165,7 +137,7 @@
  33.128  structure RealArith : REAL_ARITH =
  33.129  struct
  33.130  
  33.131 - open Conv Thm FuncUtil;;
  33.132 + open Conv
  33.133  (* ------------------------------------------------------------------------- *)
  33.134  (* Data structure for Positivstellensatz refutations.                        *)
  33.135  (* ------------------------------------------------------------------------- *)
  33.136 @@ -353,36 +325,31 @@
  33.137  
  33.138  (* Map back polynomials to HOL.                         *)
  33.139  
  33.140 -local
  33.141 - open Thm Numeral
  33.142 -in
  33.143 -
  33.144 -fun cterm_of_varpow x k = if k = 1 then x else capply (capply @{cterm "op ^ :: real => _"} x) 
  33.145 -  (mk_cnumber @{ctyp nat} k)
  33.146 +fun cterm_of_varpow x k = if k = 1 then x else Thm.capply (Thm.capply @{cterm "op ^ :: real => _"} x) 
  33.147 +  (Numeral.mk_cnumber @{ctyp nat} k)
  33.148  
  33.149  fun cterm_of_monomial m = 
  33.150 - if Ctermfunc.is_undefined m then @{cterm "1::real"} 
  33.151 + if FuncUtil.Ctermfunc.is_empty m then @{cterm "1::real"} 
  33.152   else 
  33.153    let 
  33.154 -   val m' = dest_monomial m
  33.155 +   val m' = FuncUtil.dest_monomial m
  33.156     val vps = fold_rev (fn (x,k) => cons (cterm_of_varpow x k)) m' [] 
  33.157 -  in foldr1 (fn (s, t) => capply (capply @{cterm "op * :: real => _"} s) t) vps
  33.158 +  in foldr1 (fn (s, t) => Thm.capply (Thm.capply @{cterm "op * :: real => _"} s) t) vps
  33.159    end
  33.160  
  33.161 -fun cterm_of_cmonomial (m,c) = if Ctermfunc.is_undefined m then cterm_of_rat c
  33.162 +fun cterm_of_cmonomial (m,c) = if FuncUtil.Ctermfunc.is_empty m then cterm_of_rat c
  33.163      else if c = Rat.one then cterm_of_monomial m
  33.164 -    else capply (capply @{cterm "op *::real => _"} (cterm_of_rat c)) (cterm_of_monomial m);
  33.165 +    else Thm.capply (Thm.capply @{cterm "op *::real => _"} (cterm_of_rat c)) (cterm_of_monomial m);
  33.166  
  33.167  fun cterm_of_poly p = 
  33.168 - if Monomialfunc.is_undefined p then @{cterm "0::real"} 
  33.169 + if FuncUtil.Monomialfunc.is_empty p then @{cterm "0::real"} 
  33.170   else
  33.171    let 
  33.172     val cms = map cterm_of_cmonomial
  33.173 -     (sort (prod_ord monomial_order (K EQUAL)) (Monomialfunc.graph p))
  33.174 -  in foldr1 (fn (t1, t2) => capply(capply @{cterm "op + :: real => _"} t1) t2) cms
  33.175 +     (sort (prod_ord FuncUtil.monomial_order (K EQUAL)) (FuncUtil.Monomialfunc.dest p))
  33.176 +  in foldr1 (fn (t1, t2) => Thm.capply(Thm.capply @{cterm "op + :: real => _"} t1) t2) cms
  33.177    end;
  33.178  
  33.179 -end;
  33.180      (* A general real arithmetic prover *)
  33.181  
  33.182  fun gen_gen_real_arith ctxt (mk_numeric,
  33.183 @@ -390,7 +357,6 @@
  33.184         poly_conv,poly_neg_conv,poly_add_conv,poly_mul_conv,
  33.185         absconv1,absconv2,prover) = 
  33.186  let
  33.187 - open Conv Thm;
  33.188   val _ = my_context := ctxt 
  33.189   val _ = (my_mk_numeric := mk_numeric ; my_numeric_eq_conv := numeric_eq_conv ; 
  33.190            my_numeric_ge_conv := numeric_ge_conv; my_numeric_gt_conv := numeric_gt_conv ;
  33.191 @@ -414,7 +380,7 @@
  33.192  
  33.193   fun real_ineq_conv th ct =
  33.194    let
  33.195 -   val th' = (instantiate (match (lhs_of th, ct)) th 
  33.196 +   val th' = (Thm.instantiate (Thm.match (Thm.lhs_of th, ct)) th 
  33.197        handle MATCH => raise CTERM ("real_ineq_conv", [ct]))
  33.198    in transitive th' (oprconv poly_conv (Thm.rhs_of th'))
  33.199    end 
  33.200 @@ -442,14 +408,14 @@
  33.201          Axiom_eq n => nth eqs n
  33.202        | Axiom_le n => nth les n
  33.203        | Axiom_lt n => nth lts n
  33.204 -      | Rational_eq x => eqT_elim(numeric_eq_conv(capply @{cterm Trueprop} 
  33.205 -                          (capply (capply @{cterm "op =::real => _"} (mk_numeric x)) 
  33.206 +      | Rational_eq x => eqT_elim(numeric_eq_conv(Thm.capply @{cterm Trueprop} 
  33.207 +                          (Thm.capply (Thm.capply @{cterm "op =::real => _"} (mk_numeric x)) 
  33.208                                 @{cterm "0::real"})))
  33.209 -      | Rational_le x => eqT_elim(numeric_ge_conv(capply @{cterm Trueprop} 
  33.210 -                          (capply (capply @{cterm "op <=::real => _"} 
  33.211 +      | Rational_le x => eqT_elim(numeric_ge_conv(Thm.capply @{cterm Trueprop} 
  33.212 +                          (Thm.capply (Thm.capply @{cterm "op <=::real => _"} 
  33.213                                       @{cterm "0::real"}) (mk_numeric x))))
  33.214 -      | Rational_lt x => eqT_elim(numeric_gt_conv(capply @{cterm Trueprop} 
  33.215 -                      (capply (capply @{cterm "op <::real => _"} @{cterm "0::real"})
  33.216 +      | Rational_lt x => eqT_elim(numeric_gt_conv(Thm.capply @{cterm Trueprop} 
  33.217 +                      (Thm.capply (Thm.capply @{cterm "op <::real => _"} @{cterm "0::real"})
  33.218                          (mk_numeric x))))
  33.219        | Square pt => square_rule (cterm_of_poly pt)
  33.220        | Eqmul(pt,p) => emul_rule (cterm_of_poly pt) (translate p)
  33.221 @@ -463,8 +429,8 @@
  33.222        nnf_conv then_conv skolemize_conv then_conv prenex_conv then_conv
  33.223        weak_dnf_conv
  33.224  
  33.225 -  val concl = dest_arg o cprop_of
  33.226 -  fun is_binop opr ct = (dest_fun2 ct aconvc opr handle CTERM _ => false)
  33.227 +  val concl = Thm.dest_arg o cprop_of
  33.228 +  fun is_binop opr ct = (Thm.dest_fun2 ct aconvc opr handle CTERM _ => false)
  33.229    val is_req = is_binop @{cterm "op =:: real => _"}
  33.230    val is_ge = is_binop @{cterm "op <=:: real => _"}
  33.231    val is_gt = is_binop @{cterm "op <:: real => _"}
  33.232 @@ -472,10 +438,13 @@
  33.233    val is_disj = is_binop @{cterm "op |"}
  33.234    fun conj_pair th = (th RS @{thm conjunct1}, th RS @{thm conjunct2})
  33.235    fun disj_cases th th1 th2 = 
  33.236 -   let val (p,q) = dest_binop (concl th)
  33.237 +   let val (p,q) = Thm.dest_binop (concl th)
  33.238         val c = concl th1
  33.239         val _ = if c aconvc (concl th2) then () else error "disj_cases : conclusions not alpha convertible"
  33.240 -   in implies_elim (implies_elim (implies_elim (instantiate' [] (map SOME [p,q,c]) @{thm disjE}) th) (implies_intr (capply @{cterm Trueprop} p) th1)) (implies_intr (capply @{cterm Trueprop} q) th2)
  33.241 +   in implies_elim (implies_elim
  33.242 +          (implies_elim (instantiate' [] (map SOME [p,q,c]) @{thm disjE}) th)
  33.243 +          (implies_intr (Thm.capply @{cterm Trueprop} p) th1))
  33.244 +        (implies_intr (Thm.capply @{cterm Trueprop} q) th2)
  33.245     end
  33.246   fun overall cert_choice dun ths = case ths of
  33.247    [] =>
  33.248 @@ -494,37 +463,37 @@
  33.249        overall cert_choice dun (th1::th2::oths) end
  33.250      else if is_disj ct then
  33.251        let 
  33.252 -       val (th1, cert1) = overall (Left::cert_choice) dun (assume (capply @{cterm Trueprop} (dest_arg1 ct))::oths)
  33.253 -       val (th2, cert2) = overall (Right::cert_choice) dun (assume (capply @{cterm Trueprop} (dest_arg ct))::oths)
  33.254 +       val (th1, cert1) = overall (Left::cert_choice) dun (assume (Thm.capply @{cterm Trueprop} (Thm.dest_arg1 ct))::oths)
  33.255 +       val (th2, cert2) = overall (Right::cert_choice) dun (assume (Thm.capply @{cterm Trueprop} (Thm.dest_arg ct))::oths)
  33.256        in (disj_cases th th1 th2, Branch (cert1, cert2)) end
  33.257     else overall cert_choice (th::dun) oths
  33.258    end
  33.259 -  fun dest_binary b ct = if is_binop b ct then dest_binop ct 
  33.260 +  fun dest_binary b ct = if is_binop b ct then Thm.dest_binop ct 
  33.261                           else raise CTERM ("dest_binary",[b,ct])
  33.262    val dest_eq = dest_binary @{cterm "op = :: real => _"}
  33.263    val neq_th = nth pth 5
  33.264    fun real_not_eq_conv ct = 
  33.265     let 
  33.266 -    val (l,r) = dest_eq (dest_arg ct)
  33.267 -    val th = instantiate ([],[(@{cpat "?x::real"},l),(@{cpat "?y::real"},r)]) neq_th
  33.268 -    val th_p = poly_conv(dest_arg(dest_arg1(rhs_of th)))
  33.269 +    val (l,r) = dest_eq (Thm.dest_arg ct)
  33.270 +    val th = Thm.instantiate ([],[(@{cpat "?x::real"},l),(@{cpat "?y::real"},r)]) neq_th
  33.271 +    val th_p = poly_conv(Thm.dest_arg(Thm.dest_arg1(Thm.rhs_of th)))
  33.272      val th_x = Drule.arg_cong_rule @{cterm "uminus :: real => _"} th_p
  33.273      val th_n = fconv_rule (arg_conv poly_neg_conv) th_x
  33.274      val th' = Drule.binop_cong_rule @{cterm "op |"} 
  33.275 -     (Drule.arg_cong_rule (capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_p)
  33.276 -     (Drule.arg_cong_rule (capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_n)
  33.277 +     (Drule.arg_cong_rule (Thm.capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_p)
  33.278 +     (Drule.arg_cong_rule (Thm.capply @{cterm "op <::real=>_"} @{cterm "0::real"}) th_n)
  33.279      in transitive th th' 
  33.280    end
  33.281   fun equal_implies_1_rule PQ = 
  33.282    let 
  33.283 -   val P = lhs_of PQ
  33.284 +   val P = Thm.lhs_of PQ
  33.285    in implies_intr P (equal_elim PQ (assume P))
  33.286    end
  33.287   (* FIXME!!! Copied from groebner.ml *)
  33.288   val strip_exists =
  33.289    let fun h (acc, t) =
  33.290     case (term_of t) of
  33.291 -    Const("Ex",_)$Abs(x,T,p) => h (dest_abs NONE (dest_arg t) |>> (fn v => v::acc))
  33.292 +    Const("Ex",_)$Abs(x,T,p) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
  33.293    | _ => (acc,t)
  33.294    in fn t => h ([],t)
  33.295    end
  33.296 @@ -559,7 +528,7 @@
  33.297   val strip_forall =
  33.298    let fun h (acc, t) =
  33.299     case (term_of t) of
  33.300 -    Const("All",_)$Abs(x,T,p) => h (dest_abs NONE (dest_arg t) |>> (fn v => v::acc))
  33.301 +    Const("All",_)$Abs(x,T,p) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
  33.302    | _ => (acc,t)
  33.303    in fn t => h ([],t)
  33.304    end
  33.305 @@ -576,16 +545,16 @@
  33.306    fun absremover ct = (literals_conv [@{term "op &"}, @{term "op |"}] [] 
  33.307                    (try_conv (absconv1 then_conv binop_conv (arg_conv poly_conv))) then_conv 
  33.308          try_conv (absconv2 then_conv nnf_norm_conv' then_conv binop_conv absremover)) ct
  33.309 -  val nct = capply @{cterm Trueprop} (capply @{cterm "Not"} ct)
  33.310 +  val nct = Thm.capply @{cterm Trueprop} (Thm.capply @{cterm "Not"} ct)
  33.311    val th0 = (init_conv then_conv arg_conv nnf_norm_conv') nct
  33.312 -  val tm0 = dest_arg (rhs_of th0)
  33.313 +  val tm0 = Thm.dest_arg (Thm.rhs_of th0)
  33.314    val (th, certificates) = if tm0 aconvc @{cterm False} then (equal_implies_1_rule th0, Trivial) else
  33.315     let 
  33.316      val (evs,bod) = strip_exists tm0
  33.317      val (avs,ibod) = strip_forall bod
  33.318      val th1 = Drule.arg_cong_rule @{cterm Trueprop} (fold mk_forall avs (absremover ibod))
  33.319 -    val (th2, certs) = overall [] [] [specl avs (assume (rhs_of th1))]
  33.320 -    val th3 = fold simple_choose evs (prove_hyp (equal_elim th1 (assume (capply @{cterm Trueprop} bod))) th2)
  33.321 +    val (th2, certs) = overall [] [] [specl avs (assume (Thm.rhs_of th1))]
  33.322 +    val th3 = fold simple_choose evs (prove_hyp (equal_elim th1 (assume (Thm.capply @{cterm Trueprop} bod))) th2)
  33.323     in (Drule.implies_intr_hyps (prove_hyp (equal_elim th0 (assume nct)) th3), certs)
  33.324     end
  33.325    in (implies_elim (instantiate' [] [SOME ct] pth_final) th, certificates)
  33.326 @@ -595,11 +564,12 @@
  33.327  
  33.328  (* A linear arithmetic prover *)
  33.329  local
  33.330 -  val linear_add = Ctermfunc.combine (curry op +/) (fn z => z =/ Rat.zero)
  33.331 -  fun linear_cmul c = Ctermfunc.mapf (fn x => c */ x)
  33.332 +  val linear_add = FuncUtil.Ctermfunc.combine (curry op +/) (fn z => z =/ Rat.zero)
  33.333 +  fun linear_cmul c = FuncUtil.Ctermfunc.map (fn x => c */ x)
  33.334    val one_tm = @{cterm "1::real"}
  33.335 -  fun contradictory p (e,_) = ((Ctermfunc.is_undefined e) andalso not(p Rat.zero)) orelse
  33.336 -     ((gen_eq_set (op aconvc) (Ctermfunc.dom e, [one_tm])) andalso not(p(Ctermfunc.apply e one_tm)))
  33.337 +  fun contradictory p (e,_) = ((FuncUtil.Ctermfunc.is_empty e) andalso not(p Rat.zero)) orelse
  33.338 +     ((gen_eq_set (op aconvc) (FuncUtil.Ctermfunc.dom e, [one_tm])) andalso
  33.339 +       not(p(FuncUtil.Ctermfunc.apply e one_tm)))
  33.340  
  33.341    fun linear_ineqs vars (les,lts) = 
  33.342     case find_first (contradictory (fn x => x >/ Rat.zero)) lts of
  33.343 @@ -612,15 +582,15 @@
  33.344       let 
  33.345        val ineqs = les @ lts
  33.346        fun blowup v =
  33.347 -       length(filter (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) ineqs) +
  33.348 -       length(filter (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) ineqs) *
  33.349 -       length(filter (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero </ Rat.zero) ineqs)
  33.350 +       length(filter (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) ineqs) +
  33.351 +       length(filter (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) ineqs) *
  33.352 +       length(filter (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero </ Rat.zero) ineqs)
  33.353        val  v = fst(hd(sort (fn ((_,i),(_,j)) => int_ord (i,j))
  33.354                   (map (fn v => (v,blowup v)) vars)))
  33.355        fun addup (e1,p1) (e2,p2) acc =
  33.356         let 
  33.357 -        val c1 = Ctermfunc.tryapplyd e1 v Rat.zero 
  33.358 -        val c2 = Ctermfunc.tryapplyd e2 v Rat.zero
  33.359 +        val c1 = FuncUtil.Ctermfunc.tryapplyd e1 v Rat.zero 
  33.360 +        val c2 = FuncUtil.Ctermfunc.tryapplyd e2 v Rat.zero
  33.361         in if c1 */ c2 >=/ Rat.zero then acc else
  33.362          let 
  33.363           val e1' = linear_cmul (Rat.abs c2) e1
  33.364 @@ -631,13 +601,13 @@
  33.365          end
  33.366         end
  33.367        val (les0,les1) = 
  33.368 -         List.partition (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) les
  33.369 +         List.partition (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) les
  33.370        val (lts0,lts1) = 
  33.371 -         List.partition (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) lts
  33.372 +         List.partition (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero =/ Rat.zero) lts
  33.373        val (lesp,lesn) = 
  33.374 -         List.partition (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) les1
  33.375 +         List.partition (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) les1
  33.376        val (ltsp,ltsn) = 
  33.377 -         List.partition (fn (e,_) => Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) lts1
  33.378 +         List.partition (fn (e,_) => FuncUtil.Ctermfunc.tryapplyd e v Rat.zero >/ Rat.zero) lts1
  33.379        val les' = fold_rev (fn ep1 => fold_rev (addup ep1) lesp) lesn les0
  33.380        val lts' = fold_rev (fn ep1 => fold_rev (addup ep1) (lesp@ltsp)) ltsn
  33.381                        (fold_rev (fn ep1 => fold_rev (addup ep1) (lesn@ltsn)) ltsp lts0)
  33.382 @@ -650,20 +620,20 @@
  33.383    | NONE => (case eqs of 
  33.384      [] => 
  33.385       let val vars = remove (op aconvc) one_tm 
  33.386 -           (fold_rev (curry (gen_union (op aconvc)) o Ctermfunc.dom o fst) (les@lts) []) 
  33.387 +           (fold_rev (curry (gen_union (op aconvc)) o FuncUtil.Ctermfunc.dom o fst) (les@lts) []) 
  33.388       in linear_ineqs vars (les,lts) end
  33.389     | (e,p)::es => 
  33.390 -     if Ctermfunc.is_undefined e then linear_eqs (es,les,lts) else
  33.391 +     if FuncUtil.Ctermfunc.is_empty e then linear_eqs (es,les,lts) else
  33.392       let 
  33.393 -      val (x,c) = Ctermfunc.choose (Ctermfunc.undefine one_tm e)
  33.394 +      val (x,c) = FuncUtil.Ctermfunc.choose (FuncUtil.Ctermfunc.delete_safe one_tm e)
  33.395        fun xform (inp as (t,q)) =
  33.396 -       let val d = Ctermfunc.tryapplyd t x Rat.zero in
  33.397 +       let val d = FuncUtil.Ctermfunc.tryapplyd t x Rat.zero in
  33.398          if d =/ Rat.zero then inp else
  33.399          let 
  33.400           val k = (Rat.neg d) */ Rat.abs c // c
  33.401           val e' = linear_cmul k e
  33.402           val t' = linear_cmul (Rat.abs c) t
  33.403 -         val p' = Eqmul(Monomialfunc.onefunc (Ctermfunc.undefined, k),p)
  33.404 +         val p' = Eqmul(FuncUtil.Monomialfunc.onefunc (FuncUtil.Ctermfunc.empty, k),p)
  33.405           val q' = Product(Rational_lt(Rat.abs c),q) 
  33.406          in (linear_add e' t',Sum(p',q')) 
  33.407          end 
  33.408 @@ -680,19 +650,19 @@
  33.409     end 
  33.410    
  33.411    fun lin_of_hol ct = 
  33.412 -   if ct aconvc @{cterm "0::real"} then Ctermfunc.undefined
  33.413 -   else if not (is_comb ct) then Ctermfunc.onefunc (ct, Rat.one)
  33.414 -   else if is_ratconst ct then Ctermfunc.onefunc (one_tm, dest_ratconst ct)
  33.415 +   if ct aconvc @{cterm "0::real"} then FuncUtil.Ctermfunc.empty
  33.416 +   else if not (is_comb ct) then FuncUtil.Ctermfunc.onefunc (ct, Rat.one)
  33.417 +   else if is_ratconst ct then FuncUtil.Ctermfunc.onefunc (one_tm, dest_ratconst ct)
  33.418     else
  33.419      let val (lop,r) = Thm.dest_comb ct 
  33.420 -    in if not (is_comb lop) then Ctermfunc.onefunc (ct, Rat.one)
  33.421 +    in if not (is_comb lop) then FuncUtil.Ctermfunc.onefunc (ct, Rat.one)
  33.422         else
  33.423          let val (opr,l) = Thm.dest_comb lop 
  33.424          in if opr aconvc @{cterm "op + :: real =>_"} 
  33.425             then linear_add (lin_of_hol l) (lin_of_hol r)
  33.426             else if opr aconvc @{cterm "op * :: real =>_"} 
  33.427 -                   andalso is_ratconst l then Ctermfunc.onefunc (r, dest_ratconst l)
  33.428 -           else Ctermfunc.onefunc (ct, Rat.one)
  33.429 +                   andalso is_ratconst l then FuncUtil.Ctermfunc.onefunc (r, dest_ratconst l)
  33.430 +           else FuncUtil.Ctermfunc.onefunc (ct, Rat.one)
  33.431          end
  33.432      end
  33.433  
  33.434 @@ -700,21 +670,20 @@
  33.435     Const(@{const_name "real"}, _)$ n => 
  33.436       if can HOLogic.dest_number n then false else true
  33.437    | _ => false
  33.438 - open Thm
  33.439  in 
  33.440  fun real_linear_prover translator (eq,le,lt) = 
  33.441   let 
  33.442 -  val lhs = lin_of_hol o dest_arg1 o dest_arg o cprop_of
  33.443 -  val rhs = lin_of_hol o dest_arg o dest_arg o cprop_of
  33.444 +  val lhs = lin_of_hol o Thm.dest_arg1 o Thm.dest_arg o cprop_of
  33.445 +  val rhs = lin_of_hol o Thm.dest_arg o Thm.dest_arg o cprop_of
  33.446    val eq_pols = map lhs eq
  33.447    val le_pols = map rhs le
  33.448    val lt_pols = map rhs lt 
  33.449    val aliens =  filter is_alien
  33.450 -      (fold_rev (curry (gen_union (op aconvc)) o Ctermfunc.dom) 
  33.451 +      (fold_rev (curry (gen_union (op aconvc)) o FuncUtil.Ctermfunc.dom) 
  33.452            (eq_pols @ le_pols @ lt_pols) [])
  33.453 -  val le_pols' = le_pols @ map (fn v => Ctermfunc.onefunc (v,Rat.one)) aliens
  33.454 +  val le_pols' = le_pols @ map (fn v => FuncUtil.Ctermfunc.onefunc (v,Rat.one)) aliens
  33.455    val (_,proof) = linear_prover (eq_pols,le_pols',lt_pols)
  33.456 -  val le' = le @ map (fn a => instantiate' [] [SOME (dest_arg a)] @{thm real_of_nat_ge_zero}) aliens 
  33.457 +  val le' = le @ map (fn a => instantiate' [] [SOME (Thm.dest_arg a)] @{thm real_of_nat_ge_zero}) aliens 
  33.458   in ((translator (eq,le',lt) proof), Trivial)
  33.459   end
  33.460  end;
  33.461 @@ -737,28 +706,28 @@
  33.462     val y_tm = @{cpat "?y::real"}
  33.463     val is_max = is_binop @{cterm "max :: real => _"}
  33.464     val is_min = is_binop @{cterm "min :: real => _"} 
  33.465 -   fun is_abs t = is_comb t andalso dest_fun t aconvc abs_tm
  33.466 +   fun is_abs t = is_comb t andalso Thm.dest_fun t aconvc abs_tm
  33.467     fun eliminate_construct p c tm =
  33.468      let 
  33.469       val t = find_cterm p tm
  33.470 -     val th0 = (symmetric o beta_conversion false) (capply (cabs t tm) t)
  33.471 -     val (p,ax) = (dest_comb o rhs_of) th0
  33.472 +     val th0 = (symmetric o beta_conversion false) (Thm.capply (Thm.cabs t tm) t)
  33.473 +     val (p,ax) = (Thm.dest_comb o Thm.rhs_of) th0
  33.474      in fconv_rule(arg_conv(binop_conv (arg_conv (beta_conversion false))))
  33.475                 (transitive th0 (c p ax))
  33.476     end
  33.477  
  33.478     val elim_abs = eliminate_construct is_abs
  33.479      (fn p => fn ax => 
  33.480 -       instantiate ([], [(p_tm,p), (x_tm, dest_arg ax)]) pth_abs)
  33.481 +       Thm.instantiate ([], [(p_tm,p), (x_tm, Thm.dest_arg ax)]) pth_abs)
  33.482     val elim_max = eliminate_construct is_max
  33.483      (fn p => fn ax => 
  33.484 -      let val (ax,y) = dest_comb ax 
  33.485 -      in  instantiate ([], [(p_tm,p), (x_tm, dest_arg ax), (y_tm,y)]) 
  33.486 +      let val (ax,y) = Thm.dest_comb ax 
  33.487 +      in  Thm.instantiate ([], [(p_tm,p), (x_tm, Thm.dest_arg ax), (y_tm,y)]) 
  33.488        pth_max end)
  33.489     val elim_min = eliminate_construct is_min
  33.490      (fn p => fn ax => 
  33.491 -      let val (ax,y) = dest_comb ax 
  33.492 -      in  instantiate ([], [(p_tm,p), (x_tm, dest_arg ax), (y_tm,y)]) 
  33.493 +      let val (ax,y) = Thm.dest_comb ax 
  33.494 +      in  Thm.instantiate ([], [(p_tm,p), (x_tm, Thm.dest_arg ax), (y_tm,y)]) 
  33.495        pth_min end)
  33.496     in first_conv [elim_abs, elim_max, elim_min, all_conv]
  33.497    end;
    34.1 --- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Oct 01 20:49:46 2009 +0200
    34.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Oct 01 20:52:18 2009 +0200
    34.3 @@ -24,6 +24,7 @@
    34.4    calls: int,
    34.5    success: int,
    34.6    lemmas: int,
    34.7 +  max_lems: int,
    34.8    time_isa: int,
    34.9    time_atp: int,
   34.10    time_atp_fail: int}
   34.11 @@ -35,6 +36,7 @@
   34.12    time: int,
   34.13    timeout: int,
   34.14    lemmas: int,
   34.15 +  max_lems: int,
   34.16    posns: Position.T list
   34.17    }
   34.18  
   34.19 @@ -49,125 +51,141 @@
   34.20  *)
   34.21  datatype data = Data of sh_data * me_data * min_data * me_data
   34.22  
   34.23 -fun make_sh_data (calls,success,lemmas,time_isa,time_atp,time_atp_fail) =
   34.24 -  ShData{calls=calls, success=success, lemmas=lemmas, time_isa=time_isa,
   34.25 -    time_atp=time_atp, time_atp_fail=time_atp_fail}
   34.26 +fun make_sh_data
   34.27 +      (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail) =
   34.28 +  ShData{calls=calls, success=success, lemmas=lemmas, max_lems=max_lems,
   34.29 +         time_isa=time_isa, time_atp=time_atp, time_atp_fail=time_atp_fail}
   34.30  
   34.31  fun make_min_data (succs, ab_ratios, it_ratios) =
   34.32    MinData{succs=succs, ab_ratios=ab_ratios, it_ratios=it_ratios}
   34.33  
   34.34 -fun make_me_data (calls, success, proofs, time, timeout, lemmas, posns) =
   34.35 -  MeData{calls=calls, success=success, proofs=proofs, time=time, timeout=timeout, lemmas=lemmas, posns=posns}
   34.36 +fun make_me_data (calls,success,proofs,time,timeout,lemmas,max_lems,posns) =
   34.37 +  MeData{calls=calls, success=success, proofs=proofs, time=time,
   34.38 +         timeout=timeout, lemmas=lemmas, max_lems=max_lems, posns=posns}
   34.39  
   34.40  val empty_data =
   34.41 -  Data(make_sh_data (0, 0, 0, 0, 0, 0),
   34.42 -       make_me_data(0, 0, 0, 0, 0, 0, []),
   34.43 +  Data(make_sh_data (0, 0, 0, 0, 0, 0, 0),
   34.44 +       make_me_data(0, 0, 0, 0, 0, 0, 0, []),
   34.45         MinData{succs=0, ab_ratios=0, it_ratios=0},
   34.46 -       make_me_data(0, 0, 0, 0, 0, 0, []))
   34.47 +       make_me_data(0, 0, 0, 0, 0, 0, 0, []))
   34.48  
   34.49  fun map_sh_data f
   34.50 -  (Data (ShData{calls, success, lemmas, time_isa, time_atp, time_atp_fail}, meda0, minda, meda)) =
   34.51 -  Data (make_sh_data (f (calls, success, lemmas, time_isa, time_atp, time_atp_fail)),
   34.52 +    (Data(ShData{calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail},
   34.53 +          meda0, minda, meda)) =
   34.54 +  Data (make_sh_data (f (calls,success,lemmas,max_lems,
   34.55 +                         time_isa,time_atp,time_atp_fail)),
   34.56          meda0, minda, meda)
   34.57  
   34.58  fun map_min_data f
   34.59    (Data(shda, meda0, MinData{succs,ab_ratios,it_ratios}, meda)) =
   34.60    Data(shda, meda0, make_min_data(f(succs,ab_ratios,it_ratios)), meda)
   34.61  
   34.62 -fun map_me_data0 f (Data (shda, MeData{calls,success,proofs,time,timeout,lemmas,posns}, minda, meda)) =
   34.63 -  Data(shda, make_me_data(f (calls,success,proofs,time,timeout,lemmas,posns)), minda, meda)
   34.64 +fun map_me_data0 f (Data (shda, MeData{calls,success,proofs,time,timeout,lemmas,max_lems,posns}, minda, meda)) =
   34.65 +  Data(shda, make_me_data(f (calls,success,proofs,time,timeout,lemmas,max_lems,posns)), minda, meda)
   34.66  
   34.67 -fun map_me_data f (Data (shda, meda0, minda, MeData{calls,success,proofs,time,timeout,lemmas,posns})) =
   34.68 -  Data(shda, meda0, minda, make_me_data(f (calls,success,proofs,time,timeout,lemmas,posns)))
   34.69 +fun map_me_data f (Data (shda, meda0, minda, MeData{calls,success,proofs,time,timeout,lemmas,max_lems,posns})) =
   34.70 +  Data(shda, meda0, minda, make_me_data(f (calls,success,proofs,time,timeout,lemmas,max_lems,posns)))
   34.71  
   34.72 -val inc_sh_calls =
   34.73 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
   34.74 -    => (calls + 1, success, lemmas, time_isa, time_atp, time_atp_fail))
   34.75 +val inc_sh_calls =  map_sh_data
   34.76 +  (fn (calls, success, lemmas,max_lems, time_isa, time_atp, time_atp_fail)
   34.77 +    => (calls + 1, success, lemmas,max_lems, time_isa, time_atp, time_atp_fail))
   34.78  
   34.79 -val inc_sh_success =
   34.80 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
   34.81 -    => (calls, success + 1, lemmas, time_isa, time_atp, time_atp_fail))
   34.82 +val inc_sh_success = map_sh_data
   34.83 +  (fn (calls, success, lemmas,max_lems, time_isa, time_atp, time_atp_fail)
   34.84 +    => (calls, success + 1, lemmas,max_lems, time_isa, time_atp, time_atp_fail))
   34.85  
   34.86 -fun inc_sh_lemmas n =
   34.87 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
   34.88 -    => (calls, success, lemmas + n, time_isa, time_atp, time_atp_fail))
   34.89 +fun inc_sh_lemmas n = map_sh_data
   34.90 +  (fn (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail)
   34.91 +    => (calls,success,lemmas+n,max_lems,time_isa,time_atp,time_atp_fail))
   34.92  
   34.93 -fun inc_sh_time_isa t =
   34.94 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
   34.95 -    => (calls, success, lemmas, time_isa + t, time_atp, time_atp_fail))
   34.96 +fun inc_sh_max_lems n = map_sh_data
   34.97 +  (fn (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail)
   34.98 +    => (calls,success,lemmas,Int.max(max_lems,n),time_isa,time_atp,time_atp_fail))
   34.99  
  34.100 -fun inc_sh_time_atp t =
  34.101 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
  34.102 -    => (calls, success, lemmas, time_isa, time_atp + t, time_atp_fail))
  34.103 +fun inc_sh_time_isa t = map_sh_data
  34.104 +  (fn (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail)
  34.105 +    => (calls,success,lemmas,max_lems,time_isa + t,time_atp,time_atp_fail))
  34.106 +
  34.107 +fun inc_sh_time_atp t = map_sh_data
  34.108 +  (fn (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail)
  34.109 +    => (calls,success,lemmas,max_lems,time_isa,time_atp + t,time_atp_fail))
  34.110  
  34.111 -fun inc_sh_time_atp_fail t =
  34.112 -  map_sh_data (fn (calls, success, lemmas, time_isa, time_atp, time_atp_fail)
  34.113 -    => (calls, success, lemmas, time_isa, time_atp, time_atp_fail + t))
  34.114 +fun inc_sh_time_atp_fail t = map_sh_data
  34.115 +  (fn (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail)
  34.116 +    => (calls,success,lemmas,max_lems,time_isa,time_atp,time_atp_fail + t))
  34.117  
  34.118 -val inc_min_succs =
  34.119 -  map_min_data (fn (succs,ab_ratios,it_ratios) => (succs+1, ab_ratios, it_ratios))
  34.120 +val inc_min_succs = map_min_data
  34.121 +  (fn (succs,ab_ratios,it_ratios) => (succs+1, ab_ratios, it_ratios))
  34.122  
  34.123 -fun inc_min_ab_ratios r =
  34.124 -  map_min_data (fn (succs, ab_ratios, it_ratios) => (succs, ab_ratios+r, it_ratios))
  34.125 +fun inc_min_ab_ratios r = map_min_data
  34.126 +  (fn (succs, ab_ratios, it_ratios) => (succs, ab_ratios+r, it_ratios))
  34.127  
  34.128 -fun inc_min_it_ratios r =
  34.129 -  map_min_data (fn (succs, ab_ratios, it_ratios) => (succs, ab_ratios, it_ratios+r))
  34.130 +fun inc_min_it_ratios r = map_min_data
  34.131 +  (fn (succs, ab_ratios, it_ratios) => (succs, ab_ratios, it_ratios+r))
  34.132  
  34.133  val inc_metis_calls = map_me_data
  34.134 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.135 -  => (calls + 1, success, proofs, time, timeout, lemmas,posns))
  34.136 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.137 +    => (calls + 1, success, proofs, time, timeout, lemmas,max_lems,posns))
  34.138  
  34.139  val inc_metis_success = map_me_data
  34.140 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.141 -  => (calls, success + 1, proofs, time, timeout, lemmas,posns))
  34.142 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.143 +    => (calls, success + 1, proofs, time, timeout, lemmas,max_lems,posns))
  34.144  
  34.145  val inc_metis_proofs = map_me_data
  34.146 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.147 -  => (calls, success, proofs + 1, time, timeout, lemmas,posns))
  34.148 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.149 +    => (calls, success, proofs + 1, time, timeout, lemmas,max_lems,posns))
  34.150  
  34.151  fun inc_metis_time t = map_me_data
  34.152 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.153 -  => (calls, success, proofs, time + t, timeout, lemmas,posns))
  34.154 + (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.155 +  => (calls, success, proofs, time + t, timeout, lemmas,max_lems,posns))
  34.156  
  34.157  val inc_metis_timeout = map_me_data
  34.158 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.159 -  => (calls, success, proofs, time, timeout + 1, lemmas,posns))
  34.160 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.161 +    => (calls, success, proofs, time, timeout + 1, lemmas,max_lems,posns))
  34.162  
  34.163  fun inc_metis_lemmas n = map_me_data
  34.164 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.165 -  => (calls, success, proofs, time, timeout, lemmas + n, posns))
  34.166 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.167 +    => (calls, success, proofs, time, timeout, lemmas+n, max_lems, posns))
  34.168 +
  34.169 +fun inc_metis_max_lems n = map_me_data
  34.170 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.171 +    => (calls,success,proofs,time,timeout,lemmas,Int.max(max_lems,n), posns))
  34.172  
  34.173  fun inc_metis_posns pos = map_me_data
  34.174 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.175 -  => (calls, success, proofs, time, timeout, lemmas, pos::posns))
  34.176 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.177 +    => (calls, success, proofs, time, timeout, lemmas,max_lems, pos::posns))
  34.178  
  34.179  val inc_metis_calls0 = map_me_data0 
  34.180 -(fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.181 -  => (calls + 1, success, proofs, time, timeout, lemmas,posns))
  34.182 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.183 +    => (calls + 1, success, proofs, time, timeout, lemmas,max_lems,posns))
  34.184  
  34.185  val inc_metis_success0 = map_me_data0
  34.186 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.187 -  => (calls, success + 1, proofs, time, timeout, lemmas,posns))
  34.188 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.189 +    => (calls, success + 1, proofs, time, timeout, lemmas,max_lems,posns))
  34.190  
  34.191  val inc_metis_proofs0 = map_me_data0
  34.192 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.193 -  => (calls, success, proofs + 1, time, timeout, lemmas,posns))
  34.194 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.195 +    => (calls, success, proofs + 1, time, timeout, lemmas,max_lems,posns))
  34.196  
  34.197  fun inc_metis_time0 t = map_me_data0
  34.198 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.199 -  => (calls, success, proofs, time + t, timeout, lemmas,posns))
  34.200 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.201 +    => (calls, success, proofs, time + t, timeout, lemmas,max_lems,posns))
  34.202  
  34.203  val inc_metis_timeout0 = map_me_data0
  34.204 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.205 -  => (calls, success, proofs, time, timeout + 1, lemmas,posns))
  34.206 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.207 +    => (calls, success, proofs, time, timeout + 1, lemmas,max_lems,posns))
  34.208  
  34.209  fun inc_metis_lemmas0 n = map_me_data0
  34.210 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.211 -  => (calls, success, proofs, time, timeout, lemmas + n, posns))
  34.212 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.213 +    => (calls, success, proofs, time, timeout, lemmas+n, max_lems, posns))
  34.214 +
  34.215 +fun inc_metis_max_lems0 n = map_me_data0
  34.216 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.217 +    => (calls,success,proofs,time,timeout,lemmas,Int.max(max_lems,n), posns))
  34.218  
  34.219  fun inc_metis_posns0 pos = map_me_data0
  34.220 - (fn (calls,success,proofs,time,timeout,lemmas,posns)
  34.221 -  => (calls, success, proofs, time, timeout, lemmas, pos::posns))
  34.222 +  (fn (calls,success,proofs,time,timeout,lemmas,max_lems,posns)
  34.223 +    => (calls, success, proofs, time, timeout, lemmas,max_lems, pos::posns))
  34.224  
  34.225  local
  34.226  
  34.227 @@ -178,20 +196,21 @@
  34.228  fun avg_time t n =
  34.229    if n > 0 then (Real.fromInt t / 1000.0) / Real.fromInt n else 0.0
  34.230  
  34.231 -fun log_sh_data log sh_calls sh_success sh_lemmas sh_time_isa sh_time_atp sh_time_atp_fail =
  34.232 - (log ("Total number of sledgehammer calls: " ^ str sh_calls);
  34.233 -  log ("Number of successful sledgehammer calls: " ^ str sh_success);
  34.234 -  log ("Number of sledgehammer lemmas: " ^ str sh_lemmas);
  34.235 -  log ("Success rate: " ^ percentage sh_success sh_calls ^ "%");
  34.236 -  log ("Total time for sledgehammer calls (Isabelle): " ^ str3 (time sh_time_isa));
  34.237 -  log ("Total time for successful sledgehammer calls (ATP): " ^ str3 (time sh_time_atp));
  34.238 -  log ("Total time for failed sledgehammer calls (ATP): " ^ str3 (time sh_time_atp_fail));
  34.239 +fun log_sh_data log calls success lemmas max_lems time_isa time_atp time_atp_fail =
  34.240 + (log ("Total number of sledgehammer calls: " ^ str calls);
  34.241 +  log ("Number of successful sledgehammer calls: " ^ str success);
  34.242 +  log ("Number of sledgehammer lemmas: " ^ str lemmas);
  34.243 +  log ("Max number of sledgehammer lemmas: " ^ str max_lems);
  34.244 +  log ("Success rate: " ^ percentage success calls ^ "%");
  34.245 +  log ("Total time for sledgehammer calls (Isabelle): " ^ str3 (time time_isa));
  34.246 +  log ("Total time for successful sledgehammer calls (ATP): " ^ str3 (time time_atp));
  34.247 +  log ("Total time for failed sledgehammer calls (ATP): " ^ str3 (time time_atp_fail));
  34.248    log ("Average time for sledgehammer calls (Isabelle): " ^
  34.249 -    str3 (avg_time sh_time_isa sh_calls));
  34.250 +    str3 (avg_time time_isa calls));
  34.251    log ("Average time for successful sledgehammer calls (ATP): " ^
  34.252 -    str3 (avg_time sh_time_atp sh_success));
  34.253 +    str3 (avg_time time_atp success));
  34.254    log ("Average time for failed sledgehammer calls (ATP): " ^
  34.255 -    str3 (avg_time sh_time_atp_fail (sh_calls - sh_success)))
  34.256 +    str3 (avg_time time_atp_fail (calls - success)))
  34.257    )
  34.258  
  34.259  
  34.260 @@ -200,13 +219,14 @@
  34.261    in str0 (Position.line_of pos) ^ ":" ^ str0 (Position.column_of pos) end
  34.262  
  34.263  fun log_metis_data log tag sh_calls sh_success metis_calls metis_success metis_proofs metis_time
  34.264 -    metis_timeout metis_lemmas metis_posns =
  34.265 +    metis_timeout metis_lemmas metis_max_lems metis_posns =
  34.266   (log ("Total number of " ^ tag ^ "metis calls: " ^ str metis_calls);
  34.267    log ("Number of successful " ^ tag ^ "metis calls: " ^ str metis_success ^
  34.268      " (proof: " ^ str metis_proofs ^ ")");
  34.269    log ("Number of " ^ tag ^ "metis timeouts: " ^ str metis_timeout);
  34.270    log ("Success rate: " ^ percentage metis_success sh_calls ^ "%");
  34.271    log ("Number of successful " ^ tag ^ "metis lemmas: " ^ str metis_lemmas);
  34.272 +  log ("Max number of successful " ^ tag ^ "metis lemmas: " ^ str metis_max_lems);
  34.273    log ("Total time for successful metis calls: " ^ str3 (time metis_time));
  34.274    log ("Average time for successful metis calls: " ^
  34.275      str3 (avg_time metis_time metis_success));
  34.276 @@ -224,27 +244,27 @@
  34.277  in
  34.278  
  34.279  fun log_data id log (Data
  34.280 -   (ShData{calls=sh_calls, lemmas=sh_lemmas, success=sh_success,
  34.281 +   (ShData{calls=sh_calls, lemmas=sh_lemmas,  max_lems=sh_max_lems, success=sh_success,
  34.282        time_isa=sh_time_isa,time_atp=sh_time_atp,time_atp_fail=sh_time_atp_fail},
  34.283      MeData{calls=metis_calls0, proofs=metis_proofs0,
  34.284        success=metis_success0, time=metis_time0, timeout=metis_timeout0,
  34.285 -      lemmas=metis_lemmas0,posns=metis_posns0},
  34.286 +      lemmas=metis_lemmas0,max_lems=metis_max_lems0,posns=metis_posns0},
  34.287      MinData{succs=min_succs, ab_ratios=ab_ratios, it_ratios=it_ratios},
  34.288      MeData{calls=metis_calls, proofs=metis_proofs,
  34.289        success=metis_success, time=metis_time, timeout=metis_timeout,
  34.290 -      lemmas=metis_lemmas,posns=metis_posns})) =
  34.291 +      lemmas=metis_lemmas,max_lems=metis_max_lems,posns=metis_posns})) =
  34.292    if sh_calls > 0
  34.293    then
  34.294     (log ("\n\n\nReport #" ^ string_of_int id ^ ":\n");
  34.295 -    log_sh_data log sh_calls sh_success sh_lemmas sh_time_isa sh_time_atp sh_time_atp_fail;
  34.296 +    log_sh_data log sh_calls sh_success sh_lemmas sh_max_lems sh_time_isa sh_time_atp sh_time_atp_fail;
  34.297      log "";
  34.298      if metis_calls > 0 then log_metis_data log "" sh_calls sh_success metis_calls
  34.299 -      metis_success metis_proofs metis_time metis_timeout metis_lemmas  metis_posns else ();
  34.300 +      metis_success metis_proofs metis_time metis_timeout metis_lemmas metis_max_lems metis_posns else ();
  34.301      log "";
  34.302      if metis_calls0 > 0
  34.303        then (log_min_data log min_succs ab_ratios it_ratios; log "";
  34.304              log_metis_data log "unminimized " sh_calls sh_success metis_calls0
  34.305 -              metis_success0 metis_proofs0 metis_time0 metis_timeout0 metis_lemmas0 metis_posns0)
  34.306 +              metis_success0 metis_proofs0 metis_time0 metis_timeout0 metis_lemmas0  metis_max_lems0 metis_posns0)
  34.307        else ()
  34.308     )
  34.309    else ()
  34.310 @@ -338,15 +358,14 @@
  34.311    in
  34.312      case result of
  34.313        SH_OK (time_isa, time_atp, names) =>
  34.314 -        let
  34.315 -          val _ = change_data id inc_sh_success
  34.316 -          val _ = change_data id (inc_sh_lemmas (length names))
  34.317 -          val _ = change_data id (inc_sh_time_isa time_isa)
  34.318 -          val _ = change_data id (inc_sh_time_atp time_atp)
  34.319 -
  34.320 -          fun get_thms name = (name, thms_of_name (Proof.context_of st) name)
  34.321 -          val _ = named_thms := SOME (map get_thms names)
  34.322 +        let fun get_thms name = (name, thms_of_name (Proof.context_of st) name)
  34.323          in
  34.324 +          change_data id inc_sh_success;
  34.325 +          change_data id (inc_sh_lemmas (length names));
  34.326 +          change_data id (inc_sh_max_lems (length names));
  34.327 +          change_data id (inc_sh_time_isa time_isa);
  34.328 +          change_data id (inc_sh_time_atp time_atp);
  34.329 +          named_thms := SOME (map get_thms names);
  34.330            log (sh_tag id ^ "succeeded (" ^ string_of_int time_isa ^ "+" ^
  34.331              string_of_int time_atp ^ ") [" ^ prover_name ^ "]:\n" ^ msg)
  34.332          end
  34.333 @@ -387,7 +406,7 @@
  34.334  
  34.335  
  34.336  fun run_metis (inc_metis_calls, inc_metis_success, inc_metis_proofs, inc_metis_time, inc_metis_timeout,
  34.337 -    inc_metis_lemmas, inc_metis_posns) args name named_thms id
  34.338 +    inc_metis_lemmas, inc_metis_max_lems, inc_metis_posns) args name named_thms id
  34.339      ({pre=st, timeout, log, pos, ...}: Mirabelle.run_args) =
  34.340    let
  34.341      fun metis thms ctxt = MetisTools.metis_tac ctxt thms
  34.342 @@ -396,6 +415,7 @@
  34.343      fun with_time (false, t) = "failed (" ^ string_of_int t ^ ")"
  34.344        | with_time (true, t) = (change_data id inc_metis_success;
  34.345            change_data id (inc_metis_lemmas (length named_thms));
  34.346 +          change_data id (inc_metis_max_lems (length named_thms));
  34.347            change_data id (inc_metis_time t);
  34.348            change_data id (inc_metis_posns pos);
  34.349            if name = "proof" then change_data id inc_metis_proofs else ();
  34.350 @@ -413,13 +433,14 @@
  34.351    end
  34.352  
  34.353  fun sledgehammer_action args id (st as {log, pre, name, ...}: Mirabelle.run_args) =
  34.354 -  if can Logic.dest_conjunction (Thm.major_prem_of(snd(snd(Proof.get_goal pre))))
  34.355 +  let val goal = Thm.major_prem_of(snd(snd(Proof.get_goal pre))) in
  34.356 +  if can Logic.dest_conjunction goal orelse can Logic.dest_equals goal
  34.357    then () else
  34.358    let
  34.359      val metis_fns = (inc_metis_calls, inc_metis_success, inc_metis_proofs, inc_metis_time,
  34.360 -        inc_metis_timeout, inc_metis_lemmas, inc_metis_posns)
  34.361 +        inc_metis_timeout, inc_metis_lemmas,  inc_metis_max_lems, inc_metis_posns)
  34.362      val metis0_fns = (inc_metis_calls0, inc_metis_success0, inc_metis_proofs0, inc_metis_time0,
  34.363 -        inc_metis_timeout0, inc_metis_lemmas0, inc_metis_posns0)
  34.364 +        inc_metis_timeout0, inc_metis_lemmas0, inc_metis_max_lems0, inc_metis_posns0)
  34.365      val named_thms = Unsynchronized.ref (NONE : (string * thm list) list option)
  34.366      val minimize = AList.defined (op =) args minimizeK
  34.367    in 
  34.368 @@ -435,6 +456,7 @@
  34.369         Mirabelle.catch metis_tag (run_metis metis_fns args name (these (!named_thms))) id st)
  34.370      else ()
  34.371    end
  34.372 +  end
  34.373  
  34.374  fun invoke args =
  34.375    let
    35.1 --- a/src/HOL/Record.thy	Thu Oct 01 20:49:46 2009 +0200
    35.2 +++ b/src/HOL/Record.thy	Thu Oct 01 20:52:18 2009 +0200
    35.3 @@ -450,10 +450,6 @@
    35.4    "Q = R \<Longrightarrow> (P \<and> Q) = (P \<and> R)"
    35.5    by simp
    35.6  
    35.7 -lemma meta_all_sameI:
    35.8 -  "(\<And>x. PROP P x \<equiv> PROP Q x) \<Longrightarrow> (\<And>x. PROP P x) \<equiv> (\<And>x. PROP Q x)"
    35.9 -  by simp
   35.10 -
   35.11  lemma istuple_UNIV_I: "\<And>x. x\<in>UNIV \<equiv> True"
   35.12    by simp
   35.13  
    36.1 --- a/src/HOL/Tools/ATP_Manager/atp_manager.ML	Thu Oct 01 20:49:46 2009 +0200
    36.2 +++ b/src/HOL/Tools/ATP_Manager/atp_manager.ML	Thu Oct 01 20:52:18 2009 +0200
    36.3 @@ -41,7 +41,7 @@
    36.4  
    36.5  local
    36.6  
    36.7 -val atps = Unsynchronized.ref "e remote_vampire";
    36.8 +val atps = Unsynchronized.ref "e spass remote_vampire";
    36.9  val max_atps = Unsynchronized.ref 5;   (* ~1 means infinite number of atps *)
   36.10  val timeout = Unsynchronized.ref 60;
   36.11  val full_types = Unsynchronized.ref false;
    37.1 --- a/src/HOL/Tools/record.ML	Thu Oct 01 20:49:46 2009 +0200
    37.2 +++ b/src/HOL/Tools/record.ML	Thu Oct 01 20:52:18 2009 +0200
    37.3 @@ -202,22 +202,18 @@
    37.4  struct
    37.5  
    37.6  val eq_reflection = @{thm eq_reflection};
    37.7 -val Pair_eq = @{thm Product_Type.prod.inject};
    37.8  val atomize_all = @{thm HOL.atomize_all};
    37.9  val atomize_imp = @{thm HOL.atomize_imp};
   37.10  val meta_allE = @{thm Pure.meta_allE};
   37.11  val prop_subst = @{thm prop_subst};
   37.12 -val Pair_sel_convs = [fst_conv, snd_conv];
   37.13  val K_record_comp = @{thm K_record_comp};
   37.14  val K_comp_convs = [@{thm o_apply}, K_record_comp]
   37.15 -val transitive_thm = @{thm transitive};
   37.16  val o_assoc = @{thm o_assoc};
   37.17  val id_apply = @{thm id_apply};
   37.18  val id_o_apps = [@{thm id_apply}, @{thm id_o}, @{thm o_id}];
   37.19  val Not_eq_iff = @{thm Not_eq_iff};
   37.20  
   37.21  val refl_conj_eq = @{thm refl_conj_eq};
   37.22 -val meta_all_sameI = @{thm meta_all_sameI};
   37.23  
   37.24  val surject_assistI = @{thm "istuple_surjective_proof_assistI"};
   37.25  val surject_assist_idE = @{thm "istuple_surjective_proof_assist_idE"};
   37.26 @@ -250,7 +246,6 @@
   37.27  val ext_typeN = "_ext_type";
   37.28  val inner_typeN = "_inner_type";
   37.29  val extN ="_ext";
   37.30 -val casesN = "_cases";
   37.31  val ext_dest = "_sel";
   37.32  val updateN = "_update";
   37.33  val updN = "_upd";
   37.34 @@ -259,10 +254,6 @@
   37.35  val extendN = "extend";
   37.36  val truncateN = "truncate";
   37.37  
   37.38 -(*see typedef.ML*)
   37.39 -val RepN = "Rep_";
   37.40 -val AbsN = "Abs_";
   37.41 -
   37.42  
   37.43  
   37.44  (*** utilities ***)
   37.45 @@ -273,24 +264,6 @@
   37.46    let fun varify (a, S) = TVar ((a, midx + 1), S);
   37.47    in map_type_tfree varify end;
   37.48  
   37.49 -fun domain_type' T =
   37.50 -  domain_type T handle Match => T;
   37.51 -
   37.52 -fun range_type' T =
   37.53 -  range_type T handle Match => T;
   37.54 -
   37.55 -
   37.56 -(* messages *)  (* FIXME proper context *)
   37.57 -
   37.58 -fun trace_thm str thm =
   37.59 -  tracing (str ^ Pretty.string_of (Display.pretty_thm_without_context thm));
   37.60 -
   37.61 -fun trace_thms str thms =
   37.62 -  (tracing str; map (trace_thm "") thms);
   37.63 -
   37.64 -fun trace_term str t =
   37.65 -  tracing (str ^ Syntax.string_of_term_global Pure.thy t);
   37.66 -
   37.67  
   37.68  (* timing *)
   37.69  
   37.70 @@ -302,7 +275,6 @@
   37.71  (* syntax *)
   37.72  
   37.73  fun prune n xs = Library.drop (n, xs);
   37.74 -fun prefix_base s = Long_Name.map_base_name (fn bname => s ^ bname);
   37.75  
   37.76  val Trueprop = HOLogic.mk_Trueprop;
   37.77  fun All xs t = Term.list_all_free (xs, t);
   37.78 @@ -311,22 +283,10 @@
   37.79  infix 0 :== ===;
   37.80  infixr 0 ==>;
   37.81  
   37.82 -val (op $$) = Term.list_comb;
   37.83 -val (op :==) = PrimitiveDefs.mk_defpair;
   37.84 -val (op ===) = Trueprop o HOLogic.mk_eq;
   37.85 -val (op ==>) = Logic.mk_implies;
   37.86 -
   37.87 -
   37.88 -(* morphisms *)
   37.89 -
   37.90 -fun mk_RepN name = suffix ext_typeN (prefix_base RepN name);
   37.91 -fun mk_AbsN name = suffix ext_typeN (prefix_base AbsN name);
   37.92 -
   37.93 -fun mk_Rep name repT absT =
   37.94 -  Const (suffix ext_typeN (prefix_base RepN name), absT --> repT);
   37.95 -
   37.96 -fun mk_Abs name repT absT =
   37.97 -  Const (mk_AbsN name, repT --> absT);
   37.98 +val op $$ = Term.list_comb;
   37.99 +val op :== = PrimitiveDefs.mk_defpair;
  37.100 +val op === = Trueprop o HOLogic.mk_eq;
  37.101 +val op ==> = Logic.mk_implies;
  37.102  
  37.103  
  37.104  (* constructor *)
  37.105 @@ -338,15 +298,6 @@
  37.106    in list_comb (Const (mk_extC (name, T) Ts), ts) end;
  37.107  
  37.108  
  37.109 -(* cases *)
  37.110 -
  37.111 -fun mk_casesC (name, T, vT) Ts = (suffix casesN name, (Ts ---> vT) --> T --> vT);
  37.112 -
  37.113 -fun mk_cases (name, T, vT) f =
  37.114 -  let val Ts = binder_types (fastype_of f)
  37.115 -  in Const (mk_casesC (name, T, vT) Ts) $ f end;
  37.116 -
  37.117 -
  37.118  (* selector *)
  37.119  
  37.120  fun mk_selC sT (c, T) = (c, sT --> T);
  37.121 @@ -369,7 +320,7 @@
  37.122  
  37.123  (* types *)
  37.124  
  37.125 -fun dest_recT (typ as Type (c_ext_type, Ts as (T :: _))) =
  37.126 +fun dest_recT (typ as Type (c_ext_type, Ts as (_ :: _))) =
  37.127        (case try (unsuffix ext_typeN) c_ext_type of
  37.128          NONE => raise TYPE ("Record.dest_recT", [typ], [])
  37.129        | SOME c => ((c, Ts), List.last Ts))
  37.130 @@ -549,8 +500,6 @@
  37.131  
  37.132  val get_simpset = get_ss_with_context #simpset;
  37.133  val get_sel_upd_defs = get_ss_with_context #defset;
  37.134 -val get_foldcong_ss = get_ss_with_context #foldcong;
  37.135 -val get_unfoldcong_ss = get_ss_with_context #unfoldcong;
  37.136  
  37.137  fun get_update_details u thy =
  37.138    let val sel_upd = get_sel_upd thy in
  37.139 @@ -618,8 +567,6 @@
  37.140        extfields fieldext;
  37.141    in RecordsData.put data thy end;
  37.142  
  37.143 -val get_extsplit = Symtab.lookup o #extsplit o RecordsData.get;
  37.144 -
  37.145  
  37.146  (* access 'splits' *)
  37.147  
  37.148 @@ -659,7 +606,7 @@
  37.149    let
  37.150      val ((name, Ts), moreT) = dest_recT T;
  37.151      val recname =
  37.152 -      let val (nm :: recn :: rst) = rev (Long_Name.explode name)
  37.153 +      let val (nm :: _ :: rst) = rev (Long_Name.explode name)   (* FIXME !? *)
  37.154        in Long_Name.implode (rev (nm :: rst)) end;
  37.155      val midx = maxidx_of_typs (moreT :: Ts);
  37.156      val varifyT = varifyT midx;
  37.157 @@ -698,7 +645,7 @@
  37.158  
  37.159  (* parent records *)
  37.160  
  37.161 -fun add_parents thy NONE parents = parents
  37.162 +fun add_parents _ NONE parents = parents
  37.163    | add_parents thy (SOME (types, name)) parents =
  37.164        let
  37.165          fun err msg = error (msg ^ " parent record " ^ quote name);
  37.166 @@ -787,7 +734,7 @@
  37.167        | splitargs (_ :: _) [] = raise TERM (msg ^ "expecting more fields", [t])
  37.168        | splitargs _ _ = ([], []);
  37.169  
  37.170 -    fun mk_ext (fargs as (name, arg) :: _) =
  37.171 +    fun mk_ext (fargs as (name, _) :: _) =
  37.172            (case get_fieldext thy (Sign.intern_const thy name) of
  37.173              SOME (ext, _) =>
  37.174                (case get_extfields thy ext of
  37.175 @@ -816,7 +763,7 @@
  37.176        | splitargs (_ :: _) [] = raise TERM (msg ^ "expecting more fields", [t])
  37.177        | splitargs _ _ = ([], []);
  37.178  
  37.179 -    fun mk_ext (fargs as (name, arg) :: _) =
  37.180 +    fun mk_ext (fargs as (name, _) :: _) =
  37.181            (case get_fieldext thy (Sign.intern_const thy name) of
  37.182              SOME (ext, alphas) =>
  37.183                (case get_extfields thy ext of
  37.184 @@ -838,7 +785,7 @@
  37.185                      val more' = mk_ext rest;
  37.186                    in
  37.187                      list_comb (Syntax.const (suffix sfx ext), alphas' @ [more'])
  37.188 -                  end handle TYPE_MATCH =>
  37.189 +                  end handle Type.TYPE_MATCH =>
  37.190                      raise TERM (msg ^ "type is no proper record (extension)", [t]))
  37.191                | NONE => raise TERM (msg ^ "no fields defined for " ^ ext, [t]))
  37.192            | NONE => raise TERM (msg ^ name ^" is no proper field", [t]))
  37.193 @@ -896,7 +843,7 @@
  37.194            (case k of
  37.195              Abs (_, _, Abs (_, _, t) $ Bound 0) =>
  37.196                if null (loose_bnos t) then t else raise Match
  37.197 -          | Abs (x, _, t) =>
  37.198 +          | Abs (_, _, t) =>
  37.199                if null (loose_bnos t) then t else raise Match
  37.200            | _ => raise Match);
  37.201  
  37.202 @@ -1012,7 +959,7 @@
  37.203                if HOLogic.is_unitT (Envir.norm_type subst (varifyT (TFree (zeta, Sign.defaultS thy))))
  37.204                then mk_type_abbr subst abbr alphas
  37.205                else mk_type_abbr subst (suffix schemeN abbr) (alphas @ [zeta])
  37.206 -            end handle TYPE_MATCH => default_tr' ctxt tm)
  37.207 +            end handle Type.TYPE_MATCH => default_tr' ctxt tm)
  37.208            else raise Match (*give print translation of specialised record a chance*)
  37.209        | _ => raise Match)
  37.210      else default_tr' ctxt tm
  37.211 @@ -1045,8 +992,7 @@
  37.212                          val subst = fold2 (curry (Sign.typ_match thy)) alphavars args' Vartab.empty;
  37.213                          val flds'' = (map o apsnd) (Envir.norm_type subst o varifyT) flds';
  37.214                        in flds'' @ field_lst more end
  37.215 -                      handle TYPE_MATCH => [("", T)]
  37.216 -                        | Library.UnequalLengths => [("", T)])
  37.217 +                      handle Type.TYPE_MATCH => [("", T)] | Library.UnequalLengths => [("", T)])
  37.218                    | NONE => [("", T)])
  37.219                | NONE => [("", T)])
  37.220            | NONE => [("", T)])
  37.221 @@ -1106,7 +1052,7 @@
  37.222    then noopt ()
  37.223    else opt ();
  37.224  
  37.225 -fun is_sel_upd_pair thy (Const (s, t)) (Const (u, t')) =
  37.226 +fun is_sel_upd_pair thy (Const (s, _)) (Const (u, t')) =
  37.227    (case get_updates thy u of
  37.228      SOME u_name => u_name = s
  37.229    | NONE => raise TERM ("is_sel_upd_pair: not update", [Const (u, t')]));
  37.230 @@ -1130,7 +1076,6 @@
  37.231  fun get_accupd_simps thy term defset intros_tac =
  37.232    let
  37.233      val (acc, [body]) = strip_comb term;
  37.234 -    val recT = domain_type (fastype_of acc);
  37.235      val upd_funs = sort_distinct TermOrd.fast_term_ord (get_upd_funs body);
  37.236      fun get_simp upd =
  37.237        let
  37.238 @@ -1140,10 +1085,10 @@
  37.239            if is_sel_upd_pair thy acc upd
  37.240            then mk_comp (Free ("f", T)) acc
  37.241            else mk_comp_id acc;
  37.242 -        val prop = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
  37.243 +        val prop = lhs === rhs;
  37.244          val othm =
  37.245            Goal.prove (ProofContext.init thy) [] [] prop
  37.246 -            (fn prems =>
  37.247 +            (fn _ =>
  37.248                EVERY
  37.249                 [simp_tac defset 1,
  37.250                  REPEAT_DETERM (intros_tac 1),
  37.251 @@ -1164,10 +1109,10 @@
  37.252        if comp
  37.253        then u $ mk_comp f f'
  37.254        else mk_comp (u' $ f') (u $ f);
  37.255 -    val prop = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
  37.256 +    val prop = lhs === rhs;
  37.257      val othm =
  37.258        Goal.prove (ProofContext.init thy) [] [] prop
  37.259 -        (fn prems =>
  37.260 +        (fn _ =>
  37.261            EVERY
  37.262             [simp_tac defset 1,
  37.263              REPEAT_DETERM (intros_tac 1),
  37.264 @@ -1177,11 +1122,10 @@
  37.265  
  37.266  fun get_updupd_simps thy term defset intros_tac =
  37.267    let
  37.268 -    val recT = fastype_of term;
  37.269      val upd_funs = get_upd_funs term;
  37.270      val cname = fst o dest_Const;
  37.271      fun getswap u u' = get_updupd_simp thy defset intros_tac u u' (cname u = cname u');
  37.272 -    fun build_swaps_to_eq upd [] swaps = swaps
  37.273 +    fun build_swaps_to_eq _ [] swaps = swaps
  37.274        | build_swaps_to_eq upd (u :: us) swaps =
  37.275            let
  37.276              val key = (cname u, cname upd);
  37.277 @@ -1192,7 +1136,7 @@
  37.278              if cname u = cname upd then newswaps
  37.279              else build_swaps_to_eq upd us newswaps
  37.280            end;
  37.281 -    fun swaps_needed [] prev seen swaps = map snd (Symreltab.dest swaps)
  37.282 +    fun swaps_needed [] _ _ swaps = map snd (Symreltab.dest swaps)
  37.283        | swaps_needed (u :: us) prev seen swaps =
  37.284            if Symtab.defined seen (cname u)
  37.285            then swaps_needed us prev seen (build_swaps_to_eq u prev swaps)
  37.286 @@ -1201,20 +1145,20 @@
  37.287  
  37.288  val named_cterm_instantiate = IsTupleSupport.named_cterm_instantiate;
  37.289  
  37.290 -fun prove_unfold_defs thy ss T ex_simps ex_simprs prop =
  37.291 +fun prove_unfold_defs thy ex_simps ex_simprs prop =
  37.292    let
  37.293      val defset = get_sel_upd_defs thy;
  37.294      val in_tac = IsTupleSupport.istuple_intros_tac thy;
  37.295      val prop' = Envir.beta_eta_contract prop;
  37.296 -    val (lhs, rhs) = Logic.dest_equals (Logic.strip_assums_concl prop');
  37.297 -    val (head, args) = strip_comb lhs;
  37.298 +    val (lhs, _) = Logic.dest_equals (Logic.strip_assums_concl prop');
  37.299 +    val (_, args) = strip_comb lhs;
  37.300      val simps =
  37.301        if length args = 1
  37.302        then get_accupd_simps thy lhs defset in_tac
  37.303        else get_updupd_simps thy lhs defset in_tac;
  37.304    in
  37.305      Goal.prove (ProofContext.init thy) [] [] prop'
  37.306 -      (fn prems =>
  37.307 +      (fn _ =>
  37.308          simp_tac (HOL_basic_ss addsimps (simps @ [K_record_comp])) 1 THEN
  37.309          TRY (simp_tac (HOL_basic_ss addsimps ex_simps addsimprocs ex_simprs) 1))
  37.310    end;
  37.311 @@ -1251,55 +1195,52 @@
  37.312  *)
  37.313  val record_simproc =
  37.314    Simplifier.simproc @{theory HOL} "record_simp" ["x"]
  37.315 -    (fn thy => fn ss => fn t =>
  37.316 +    (fn thy => fn _ => fn t =>
  37.317        (case t of
  37.318 -        (sel as Const (s, Type (_, [domS, rangeS]))) $
  37.319 +        (sel as Const (s, Type (_, [_, rangeS]))) $
  37.320              ((upd as Const (u, Type (_, [_, Type (_, [rT, _])]))) $ k $ r) =>
  37.321 -          if is_selector thy s then
  37.322 -            (case get_updates thy u of
  37.323 -              SOME u_name =>
  37.324 -                let
  37.325 -                  val {sel_upd = {updates, ...}, extfields, ...} = RecordsData.get thy;
  37.326 -
  37.327 -                  fun mk_eq_terms ((upd as Const (u, Type(_, [kT, _]))) $ k $ r) =
  37.328 -                        (case Symtab.lookup updates u of
  37.329 -                          NONE => NONE
  37.330 -                        | SOME u_name =>
  37.331 -                            if u_name = s then
  37.332 -                              (case mk_eq_terms r of
  37.333 -                                NONE =>
  37.334 -                                  let
  37.335 -                                    val rv = ("r", rT);
  37.336 -                                    val rb = Bound 0;
  37.337 -                                    val (kv, kb) = K_skeleton "k" kT (Bound 1) k;
  37.338 -                                  in SOME (upd $ kb $ rb, kb $ (sel $ rb), [kv, rv]) end
  37.339 -                              | SOME (trm, trm', vars) =>
  37.340 -                                  let
  37.341 -                                    val (kv, kb) = K_skeleton "k" kT (Bound (length vars)) k;
  37.342 -                                  in SOME (upd $ kb $ trm, kb $ trm', kv :: vars) end)
  37.343 -                            else if has_field extfields u_name rangeS orelse
  37.344 -                              has_field extfields s (domain_type kT) then NONE
  37.345 -                            else
  37.346 -                              (case mk_eq_terms r of
  37.347 -                                SOME (trm, trm', vars) =>
  37.348 -                                  let val (kv, kb) = K_skeleton "k" kT (Bound (length vars)) k
  37.349 -                                  in SOME (upd $ kb $ trm, trm', kv :: vars) end
  37.350 -                              | NONE =>
  37.351 -                                  let
  37.352 -                                    val rv = ("r", rT);
  37.353 -                                    val rb = Bound 0;
  37.354 -                                    val (kv, kb) = K_skeleton "k" kT (Bound 1) k;
  37.355 -                                  in SOME (upd $ kb $ rb, sel $ rb, [kv, rv]) end))
  37.356 -                    | mk_eq_terms r = NONE;
  37.357 -                in
  37.358 -                  (case mk_eq_terms (upd $ k $ r) of
  37.359 -                    SOME (trm, trm', vars) =>
  37.360 -                      SOME
  37.361 -                        (prove_unfold_defs thy ss domS [] []
  37.362 -                          (list_all (vars, Logic.mk_equals (sel $ trm, trm'))))
  37.363 -                  | NONE => NONE)
  37.364 -                end
  37.365 -            | NONE => NONE)
  37.366 +          if is_selector thy s andalso is_some (get_updates thy u) then
  37.367 +            let
  37.368 +              val {sel_upd = {updates, ...}, extfields, ...} = RecordsData.get thy;
  37.369 +
  37.370 +              fun mk_eq_terms ((upd as Const (u, Type(_, [kT, _]))) $ k $ r) =
  37.371 +                    (case Symtab.lookup updates u of
  37.372 +                      NONE => NONE
  37.373 +                    | SOME u_name =>
  37.374 +                        if u_name = s then
  37.375 +                          (case mk_eq_terms r of
  37.376 +                            NONE =>
  37.377 +                              let
  37.378 +                                val rv = ("r", rT);
  37.379 +                                val rb = Bound 0;
  37.380 +                                val (kv, kb) = K_skeleton "k" kT (Bound 1) k;
  37.381 +                              in SOME (upd $ kb $ rb, kb $ (sel $ rb), [kv, rv]) end
  37.382 +                          | SOME (trm, trm', vars) =>
  37.383 +                              let
  37.384 +                                val (kv, kb) = K_skeleton "k" kT (Bound (length vars)) k;
  37.385 +                              in SOME (upd $ kb $ trm, kb $ trm', kv :: vars) end)
  37.386 +                        else if has_field extfields u_name rangeS orelse
  37.387 +                          has_field extfields s (domain_type kT) then NONE
  37.388 +                        else
  37.389 +                          (case mk_eq_terms r of
  37.390 +                            SOME (trm, trm', vars) =>
  37.391 +                              let val (kv, kb) = K_skeleton "k" kT (Bound (length vars)) k
  37.392 +                              in SOME (upd $ kb $ trm, trm', kv :: vars) end
  37.393 +                          | NONE =>
  37.394 +                              let
  37.395 +                                val rv = ("r", rT);
  37.396 +                                val rb = Bound 0;
  37.397 +                                val (kv, kb) = K_skeleton "k" kT (Bound 1) k;
  37.398 +                              in SOME (upd $ kb $ rb, sel $ rb, [kv, rv]) end))
  37.399 +                | mk_eq_terms _ = NONE;
  37.400 +            in
  37.401 +              (case mk_eq_terms (upd $ k $ r) of
  37.402 +                SOME (trm, trm', vars) =>
  37.403 +                  SOME
  37.404 +                    (prove_unfold_defs thy [] []
  37.405 +                      (list_all (vars, Logic.mk_equals (sel $ trm, trm'))))
  37.406 +              | NONE => NONE)
  37.407 +            end
  37.408            else NONE
  37.409        | _ => NONE));
  37.410  
  37.411 @@ -1311,7 +1252,7 @@
  37.412      val prop = concl_of (named_cterm_instantiate insts updacc_cong_triv);
  37.413    in
  37.414      Goal.prove (ProofContext.init thy) [] [] prop
  37.415 -      (fn prems =>
  37.416 +      (fn _ =>
  37.417          EVERY
  37.418           [simp_tac simpset 1,
  37.419            REPEAT_DETERM (in_tac 1),
  37.420 @@ -1331,7 +1272,7 @@
  37.421    both a more update and an update to a field within it.*)
  37.422  val record_upd_simproc =
  37.423    Simplifier.simproc @{theory HOL} "record_upd_simp" ["x"]
  37.424 -    (fn thy => fn ss => fn t =>
  37.425 +    (fn thy => fn _ => fn t =>
  37.426        let
  37.427          (*We can use more-updators with other updators as long
  37.428            as none of the other updators go deeper than any more
  37.429 @@ -1346,7 +1287,7 @@
  37.430                then SOME (if min <= dep then dep else min, max)
  37.431                else NONE;
  37.432  
  37.433 -        fun getupdseq (term as (upd as Const (u, T)) $ f $ tm) min max =
  37.434 +        fun getupdseq (term as (upd as Const (u, _)) $ f $ tm) min max =
  37.435                (case get_update_details u thy of
  37.436                  SOME (s, dep, ismore) =>
  37.437                    (case include_depth (dep, ismore) (min, max) of
  37.438 @@ -1359,15 +1300,14 @@
  37.439  
  37.440          val (upds, base, baseT) = getupdseq t 0 ~1;
  37.441  
  37.442 -        fun is_upd_noop s (f as Abs (n, T, Const (s', T') $ tm')) tm =
  37.443 +        fun is_upd_noop s (Abs (n, T, Const (s', T') $ tm')) tm =
  37.444                if s = s' andalso null (loose_bnos tm')
  37.445                  andalso subst_bound (HOLogic.unit, tm') = tm
  37.446                then (true, Abs (n, T, Const (s', T') $ Bound 1))
  37.447                else (false, HOLogic.unit)
  37.448 -          | is_upd_noop s f tm = (false, HOLogic.unit);
  37.449 -
  37.450 -        fun get_noop_simps (upd as Const (u, T))
  37.451 -            (f as Abs (n, T', (acc as Const (s, T'')) $ _)) =
  37.452 +          | is_upd_noop _ _ _ = (false, HOLogic.unit);
  37.453 +
  37.454 +        fun get_noop_simps (upd as Const _) (Abs (_, _, (acc as Const _) $ _)) =
  37.455            let
  37.456              val ss = get_sel_upd_defs thy;
  37.457              val uathm = get_upd_acc_cong_thm upd acc thy ss;
  37.458 @@ -1417,17 +1357,16 @@
  37.459                        fvar :: vars, dups, true, noops)
  37.460                    | NONE => (upd $ skelf $ lhs, upd $ skelf $ rhs, fvar :: vars, dups, simp, noops))
  37.461                end
  37.462 -          | mk_updterm [] above term =
  37.463 +          | mk_updterm [] _ _ =
  37.464                (Bound 0, Bound 0, [("r", baseT)], Symtab.empty, false, Symtab.empty)
  37.465 -          | mk_updterm us above term =
  37.466 -              raise TERM ("mk_updterm match", map (fn (x, y, z) => x) us);
  37.467 -
  37.468 -        val (lhs, rhs, vars, dups, simp, noops) = mk_updterm upds Symtab.empty base;
  37.469 +          | mk_updterm us _ _ = raise TERM ("mk_updterm match", map (fn (x, _, _) => x) us);
  37.470 +
  37.471 +        val (lhs, rhs, vars, _, simp, noops) = mk_updterm upds Symtab.empty base;
  37.472          val noops' = flat (map snd (Symtab.dest noops));
  37.473        in
  37.474          if simp then
  37.475            SOME
  37.476 -            (prove_unfold_defs thy ss baseT noops' [record_simproc]
  37.477 +            (prove_unfold_defs thy noops' [record_simproc]
  37.478                (list_all (vars, Logic.mk_equals (lhs, rhs))))
  37.479          else NONE
  37.480        end);
  37.481 @@ -1473,11 +1412,11 @@
  37.482    Simplifier.simproc @{theory HOL} "record_split_simp" ["x"]
  37.483      (fn thy => fn _ => fn t =>
  37.484        (case t of
  37.485 -        Const (quantifier, Type (_, [Type (_, [T, _]), _])) $ trm =>
  37.486 +        Const (quantifier, Type (_, [Type (_, [T, _]), _])) $ _ =>
  37.487            if quantifier = "All" orelse quantifier = "all" orelse quantifier = "Ex" then
  37.488              (case rec_id ~1 T of
  37.489                "" => NONE
  37.490 -            | name =>
  37.491 +            | _ =>
  37.492                  let val split = P t in
  37.493                    if split <> 0 then
  37.494                      (case get_splits thy (rec_id split T) of
  37.495 @@ -1568,10 +1507,10 @@
  37.496            simp_tac (HOL_basic_ss addsimps @{thms induct_rulify}) i]
  37.497        end;
  37.498  
  37.499 -    fun split_free_tac P i (free as Free (n, T)) =
  37.500 +    fun split_free_tac P i (free as Free (_, T)) =
  37.501            (case rec_id ~1 T of
  37.502              "" => NONE
  37.503 -          | name =>
  37.504 +          | _ =>
  37.505                let val split = P free in
  37.506                  if split <> 0 then
  37.507                    (case get_splits thy (rec_id split T) of
  37.508 @@ -1598,8 +1537,6 @@
  37.509  (*Split all records in the goal, which are quantified by ! or !!.*)
  37.510  fun record_split_tac i st =
  37.511    let
  37.512 -    val thy = Thm.theory_of_thm st;
  37.513 -
  37.514      val has_rec = exists_Const
  37.515        (fn (s, Type (_, [Type (_, [T, _]), _])) =>
  37.516            (s = "all" orelse s = "All") andalso is_recT T
  37.517 @@ -1695,40 +1632,16 @@
  37.518    in compose_tac (false, rule'', nprems_of rule) i st end;
  37.519  
  37.520  
  37.521 -(*!!x1 ... xn. ... ==> EX x1 ... xn. P x1 ... xn;
  37.522 -  instantiates x1 ... xn with parameters x1 ... xn*)
  37.523 -fun ex_inst_tac i st =
  37.524 -  let
  37.525 -    val thy = Thm.theory_of_thm st;
  37.526 -    val g = nth (prems_of st) (i - 1);   (* FIXME SUBGOAL *)
  37.527 -    val params = Logic.strip_params g;
  37.528 -    val exI' = Thm.lift_rule (Thm.cprem_of st i) exI;
  37.529 -    val _ $ (_ $ x) = Logic.strip_assums_concl (hd (prems_of exI'));
  37.530 -    val cx = cterm_of thy (fst (strip_comb x));
  37.531 -  in
  37.532 -    Seq.single (Library.foldl (fn (st, v) =>
  37.533 -      Seq.hd
  37.534 -        (compose_tac
  37.535 -          (false,
  37.536 -            cterm_instantiate [(cx, cterm_of thy (list_abs (params, Bound v)))] exI', 1) i st))
  37.537 -        (st, (length params - 1) downto 0))
  37.538 -  end;
  37.539 -
  37.540 -fun extension_definition full name fields names alphas zeta moreT more vars thy =
  37.541 +fun extension_definition name fields alphas zeta moreT more vars thy =
  37.542    let
  37.543      val base = Long_Name.base_name;
  37.544      val fieldTs = (map snd fields);
  37.545      val alphas_zeta = alphas @ [zeta];
  37.546      val alphas_zetaTs = map (fn n => TFree (n, HOLogic.typeS)) alphas_zeta;
  37.547 -    val vT = TFree (Name.variant alphas_zeta "'v", HOLogic.typeS);
  37.548      val extT_name = suffix ext_typeN name
  37.549      val extT = Type (extT_name, alphas_zetaTs);
  37.550 -    val fields_more = fields @ [(full moreN, moreT)];
  37.551      val fields_moreTs = fieldTs @ [moreT];
  37.552 -    val bfields_more = map (apfst base) fields_more;
  37.553 -    val r = Free (rN, extT);
  37.554 -    val len = length fields;
  37.555 -    val idxms = 0 upto len;
  37.556 +
  37.557  
  37.558      (*before doing anything else, create the tree of new types
  37.559        that will back the record extension*)
  37.560 @@ -1739,7 +1652,7 @@
  37.561        let
  37.562          val suff = if i = 0 then ext_typeN else inner_typeN ^ string_of_int i;
  37.563          val nm = suffix suff (Long_Name.base_name name);
  37.564 -        val (isom, cons, thy') =
  37.565 +        val (_, cons, thy') =
  37.566            IsTupleSupport.add_istuple_type
  37.567              (nm, alphas_zeta) (fastype_of left, fastype_of right) thy;
  37.568        in
  37.569 @@ -1763,7 +1676,7 @@
  37.570              build_meta_tree_type i' thy' composites more
  37.571            end
  37.572          else
  37.573 -          let val (term, (thy', i')) = mk_istuple (mktreeV vars, more) (thy, 0)
  37.574 +          let val (term, (thy', _)) = mk_istuple (mktreeV vars, more) (thy, 0)
  37.575            in (term, thy') end
  37.576        end;
  37.577  
  37.578 @@ -1795,16 +1708,15 @@
  37.579      val ([ext_def], defs_thy) =
  37.580        timeit_msg "record extension constructor def:" mk_defs;
  37.581  
  37.582 +
  37.583      (* prepare propositions *)
  37.584 +
  37.585      val _ = timing_msg "record extension preparing propositions";
  37.586      val vars_more = vars @ [more];
  37.587 -    val named_vars_more = (names @ [full moreN]) ~~ vars_more;
  37.588      val variants = map (fn Free (x, _) => x) vars_more;
  37.589      val ext = mk_ext vars_more;
  37.590      val s = Free (rN, extT);
  37.591 -    val w = Free (wN, extT);
  37.592      val P = Free (Name.variant variants "P", extT --> HOLogic.boolT);
  37.593 -    val C = Free (Name.variant variants "C", HOLogic.boolT);
  37.594      val intros_tac = IsTupleSupport.istuple_intros_tac defs_thy;
  37.595  
  37.596      val inject_prop =
  37.597 @@ -1819,27 +1731,18 @@
  37.598      val induct_prop =
  37.599        (All (map dest_Free vars_more) (Trueprop (P $ ext)), Trueprop (P $ s));
  37.600  
  37.601 -    val cases_prop =
  37.602 -      All (map dest_Free vars_more)
  37.603 -        (Trueprop (HOLogic.mk_eq (s, ext)) ==> Trueprop C)
  37.604 -      ==> Trueprop C;
  37.605 -
  37.606      val split_meta_prop =
  37.607 -      let val P = Free (Name.variant variants "P", extT-->Term.propT) in
  37.608 +      let val P = Free (Name.variant variants "P", extT --> Term.propT) in
  37.609          Logic.mk_equals
  37.610           (All [dest_Free s] (P $ s), All (map dest_Free vars_more) (P $ ext))
  37.611        end;
  37.612  
  37.613 -    fun prove stndrd = quick_and_dirty_prove stndrd defs_thy;
  37.614      val prove_standard = quick_and_dirty_prove true defs_thy;
  37.615 -    fun prove_simp stndrd simps =
  37.616 -      let val tac = simp_all_tac HOL_ss simps
  37.617 -      in fn prop => prove stndrd [] prop (K tac) end;
  37.618  
  37.619      fun inject_prf () =
  37.620        simplify HOL_ss
  37.621          (prove_standard [] inject_prop
  37.622 -          (fn prems =>
  37.623 +          (fn _ =>
  37.624              EVERY
  37.625               [simp_tac (HOL_basic_ss addsimps [ext_def]) 1,
  37.626                REPEAT_DETERM (resolve_tac [refl_conj_eq] 1 ORELSE
  37.627 @@ -1872,7 +1775,7 @@
  37.628  
  37.629      fun split_meta_prf () =
  37.630        prove_standard [] split_meta_prop
  37.631 -        (fn prems =>
  37.632 +        (fn _ =>
  37.633            EVERY
  37.634             [rtac equal_intr_rule 1, Goal.norm_hhf_tac 1,
  37.635              etac meta_allE 1, atac 1,
  37.636 @@ -1909,8 +1812,8 @@
  37.637    | chop_last [x] = ([], x)
  37.638    | chop_last (x :: xs) = let val (tl, l) = chop_last xs in (x :: tl, l) end;
  37.639  
  37.640 -fun subst_last s [] = error "subst_last: list should not be empty"
  37.641 -  | subst_last s [x] = [s]
  37.642 +fun subst_last _ [] = error "subst_last: list should not be empty"
  37.643 +  | subst_last s [_] = [s]
  37.644    | subst_last s (x :: xs) = x :: subst_last s xs;
  37.645  
  37.646  
  37.647 @@ -1965,7 +1868,6 @@
  37.648      val parent_variants = Name.variant_list [moreN, rN, rN ^ "'", wN] (map base parent_names);
  37.649      val parent_vars = ListPair.map Free (parent_variants, parent_types);
  37.650      val parent_len = length parents;
  37.651 -    val parents_idx = (map #name parents) ~~ (0 upto (parent_len - 1));
  37.652  
  37.653      val fields = map (apfst full) bfields;
  37.654      val names = map fst fields;
  37.655 @@ -1979,13 +1881,10 @@
  37.656          (map fst bfields);
  37.657      val vars = ListPair.map Free (variants, types);
  37.658      val named_vars = names ~~ vars;
  37.659 -    val idxs = 0 upto (len - 1);
  37.660      val idxms = 0 upto len;
  37.661  
  37.662      val all_fields = parent_fields @ fields;
  37.663 -    val all_names = parent_names @ names;
  37.664      val all_types = parent_types @ types;
  37.665 -    val all_len = parent_fields_len + len;
  37.666      val all_variants = parent_variants @ variants;
  37.667      val all_vars = parent_vars @ vars;
  37.668      val all_named_vars = (parent_names ~~ parent_vars) @ named_vars;
  37.669 @@ -1997,7 +1896,6 @@
  37.670      val full_moreN = full moreN;
  37.671      val bfields_more = bfields @ [(moreN, moreT)];
  37.672      val fields_more = fields @ [(full_moreN, moreT)];
  37.673 -    val vars_more = vars @ [more];
  37.674      val named_vars_more = named_vars @ [(full_moreN, more)];
  37.675      val all_vars_more = all_vars @ [more];
  37.676      val all_named_vars_more = all_named_vars @ [(full_moreN, more)];
  37.677 @@ -2008,7 +1906,7 @@
  37.678      val (extension_thy, extT, ext_induct, ext_inject, ext_split, ext_def) =
  37.679        thy
  37.680        |> Sign.add_path bname
  37.681 -      |> extension_definition full extN fields names alphas_ext zeta moreT more vars;
  37.682 +      |> extension_definition extN fields alphas_ext zeta moreT more vars;
  37.683  
  37.684      val _ = timing_msg "record preparing definitions";
  37.685      val Type extension_scheme = extT;
  37.686 @@ -2080,16 +1978,6 @@
  37.687  
  37.688      (* prepare definitions *)
  37.689  
  37.690 -    fun parent_more s =
  37.691 -      if null parents then s
  37.692 -      else mk_sel s (Long_Name.qualify (#name (List.last parents)) moreN, extT);
  37.693 -
  37.694 -    fun parent_more_upd v s =
  37.695 -      if null parents then v $ s
  37.696 -      else
  37.697 -        let val mp = Long_Name.qualify (#name (List.last parents)) moreN;
  37.698 -        in mk_upd updateN mp v s end;
  37.699 -
  37.700      (*record (scheme) type abbreviation*)
  37.701      val recordT_specs =
  37.702        [(Binding.name (suffix schemeN bname), alphas @ [zeta], rec_schemeT0, Syntax.NoSyn),
  37.703 @@ -2233,14 +2121,12 @@
  37.704  
  37.705      (*cases*)
  37.706      val cases_scheme_prop =
  37.707 -      (All (map dest_Free all_vars_more)
  37.708 -        (Trueprop (HOLogic.mk_eq (r0, r_rec0)) ==> Trueprop C))
  37.709 -      ==> Trueprop C;
  37.710 +      (All (map dest_Free all_vars_more) ((r0 === r_rec0) ==> Trueprop C))
  37.711 +        ==> Trueprop C;
  37.712  
  37.713      val cases_prop =
  37.714 -      (All (map dest_Free all_vars)
  37.715 -        (Trueprop (HOLogic.mk_eq (r_unit0, r_rec_unit0)) ==> Trueprop C))
  37.716 -       ==> Trueprop C;
  37.717 +      (All (map dest_Free all_vars) ((r_unit0 === r_rec_unit0) ==> Trueprop C))
  37.718 +         ==> Trueprop C;
  37.719  
  37.720      (*split*)
  37.721      val split_meta_prop =
  37.722 @@ -2359,7 +2245,7 @@
  37.723          val init_ss = HOL_basic_ss addsimps ext_defs;
  37.724        in
  37.725          prove_standard [] surjective_prop
  37.726 -          (fn prems =>
  37.727 +          (fn _ =>
  37.728              EVERY
  37.729               [rtac surject_assist_idE 1,
  37.730                simp_tac init_ss 1,
  37.731 @@ -2369,7 +2255,7 @@
  37.732  
  37.733      fun split_meta_prf () =
  37.734        prove false [] split_meta_prop
  37.735 -        (fn prems =>
  37.736 +        (fn _ =>
  37.737            EVERY
  37.738             [rtac equal_intr_rule 1, Goal.norm_hhf_tac 1,
  37.739              etac meta_allE 1, atac 1,
  37.740 @@ -2423,7 +2309,7 @@
  37.741          val so' = named_cterm_instantiate ([(P_nm, not_P)]) split_object;
  37.742          val so'' = simplify ss so';
  37.743        in
  37.744 -        prove_standard [] split_ex_prop (fn prems => resolve_tac [so''] 1)
  37.745 +        prove_standard [] split_ex_prop (fn _ => resolve_tac [so''] 1)
  37.746        end;
  37.747      val split_ex = timeit_msg "record split_ex proof:" split_ex_prf;
  37.748  
    38.1 --- a/src/HOL/Tools/transfer.ML	Thu Oct 01 20:49:46 2009 +0200
    38.2 +++ b/src/HOL/Tools/transfer.ML	Thu Oct 01 20:52:18 2009 +0200
    38.3 @@ -1,5 +1,5 @@
    38.4  (*  Author:     Amine Chaieb, University of Cambridge, 2009
    38.5 -                Jeremy Avigad, Carnegie Mellon University
    38.6 +    Author:     Jeremy Avigad, Carnegie Mellon University
    38.7  *)
    38.8  
    38.9  signature TRANSFER =
   38.10 @@ -14,10 +14,8 @@
   38.11  structure Transfer : TRANSFER =
   38.12  struct
   38.13  
   38.14 -val eq_thm = Thm.eq_thm;
   38.15 -
   38.16  type entry = {inj : thm list, emb : thm list, ret : thm list, cong : thm list,
   38.17 -  guess : bool, hints : string list}; 
   38.18 +  guess : bool, hints : string list};
   38.19  type data = simpset * (thm * entry) list;
   38.20  
   38.21  structure Data = GenericDataFun
   38.22 @@ -26,36 +24,34 @@
   38.23    val empty = (HOL_ss, []);
   38.24    val extend  = I;
   38.25    fun merge _ ((ss1, e1), (ss2, e2)) =
   38.26 -    (merge_ss (ss1, ss2), AList.merge eq_thm (K true) (e1, e2));
   38.27 +    (merge_ss (ss1, ss2), AList.merge Thm.eq_thm (K true) (e1, e2));
   38.28  );
   38.29  
   38.30  val get = Data.get o Context.Proof;
   38.31  
   38.32 -fun del_data key = apsnd (remove (eq_fst eq_thm) (key, []));
   38.33 +fun del_data key = apsnd (remove (eq_fst Thm.eq_thm) (key, []));
   38.34  
   38.35  val del = Thm.declaration_attribute (Data.map o del_data);
   38.36 -val add_ss = Thm.declaration_attribute 
   38.37 +val add_ss = Thm.declaration_attribute
   38.38     (fn th => Data.map (fn (ss,data) => (ss addsimps [th], data)));
   38.39  
   38.40 -val del_ss = Thm.declaration_attribute 
   38.41 +val del_ss = Thm.declaration_attribute
   38.42     (fn th => Data.map (fn (ss,data) => (ss delsimps [th], data)));
   38.43  
   38.44  val transM_pat = (Thm.dest_arg1 o Thm.dest_arg o cprop_of) @{thm TransferMorphism_def};
   38.45  
   38.46  fun merge_update eq m (k,v) [] = [(k,v)]
   38.47 -  | merge_update eq m (k,v) ((k',v')::al) = 
   38.48 +  | merge_update eq m (k,v) ((k',v')::al) =
   38.49             if eq (k,k') then (k',m (v,v')):: al else (k',v') :: merge_update eq m (k,v) al
   38.50  
   38.51 -fun C f x y = f y x
   38.52 -
   38.53 -fun simpset_of_entry injonly {inj = inj, emb = emb, ret = ret, cong = cg, guess = g, hints = hints} = 
   38.54 +fun simpset_of_entry injonly {inj = inj, emb = emb, ret = ret, cong = cg, guess = g, hints = hints} =
   38.55   HOL_ss addsimps inj addsimps (if injonly then [] else emb@ret) addcongs cg;
   38.56  
   38.57 -fun basic_transfer_rule injonly a0 D0 e leave ctxt0 th = 
   38.58 - let 
   38.59 +fun basic_transfer_rule injonly a0 D0 e leave ctxt0 th =
   38.60 + let
   38.61    val ([a,D], ctxt) = apfst (map Drule.dest_term o snd) (Variable.import true (map Drule.mk_term [a0, D0]) ctxt0)
   38.62 -  val (aT,bT) = 
   38.63 -     let val T = typ_of (ctyp_of_term a) 
   38.64 +  val (aT,bT) =
   38.65 +     let val T = typ_of (ctyp_of_term a)
   38.66       in (Term.range_type T, Term.domain_type T)
   38.67       end
   38.68    val ctxt' = (Variable.declare_term (term_of a) o Variable.declare_term (term_of D) o Variable.declare_thm th) ctxt
   38.69 @@ -65,60 +61,64 @@
   38.70    val cfis = map ((cterm_of o ProofContext.theory_of) ctxt'' o (fn n => Free (n, bT))) ins
   38.71    val cis = map (Thm.capply a) cfis
   38.72    val (hs,ctxt''') = Assumption.add_assumes (map (fn ct => Thm.capply @{cterm "Trueprop"} (Thm.capply D ct)) cfis) ctxt''
   38.73 -  val th1 = Drule.cterm_instantiate (cns~~ cis) th
   38.74 -  val th2 = fold (C implies_elim) hs (fold_rev implies_intr (map cprop_of hs) th1)
   38.75 -  val th3 = Simplifier.asm_full_simplify (Simplifier.context ctxt''' (simpset_of_entry injonly e)) 
   38.76 +  val th1 = Drule.cterm_instantiate (cns ~~ cis) th
   38.77 +  val th2 = fold Thm.elim_implies hs (fold_rev implies_intr (map cprop_of hs) th1)
   38.78 +  val th3 = Simplifier.asm_full_simplify (Simplifier.context ctxt''' (simpset_of_entry injonly e))
   38.79                                           (fold_rev implies_intr (map cprop_of hs) th2)
   38.80  in hd (Variable.export ctxt''' ctxt0 [th3]) end;
   38.81  
   38.82  local
   38.83 -fun transfer_ruleh a D leave ctxt th = 
   38.84 +fun transfer_ruleh a D leave ctxt th =
   38.85   let val (ss,al) = get ctxt
   38.86       val a0 = cterm_of (ProofContext.theory_of ctxt) a
   38.87       val D0 = cterm_of (ProofContext.theory_of ctxt) D
   38.88 -     fun h (th', e) = let val (a',D') = (Thm.dest_binop o Thm.dest_arg o cprop_of) th' 
   38.89 +     fun h (th', e) = let val (a',D') = (Thm.dest_binop o Thm.dest_arg o cprop_of) th'
   38.90                   in if a0 aconvc a' andalso D0 aconvc D' then SOME e else NONE
   38.91                   end
   38.92   in case get_first h al of
   38.93        SOME e => basic_transfer_rule false a0 D0 e leave ctxt th
   38.94      | NONE => error "Transfer: corresponding instance not found in context-data"
   38.95   end
   38.96 -in fun transfer_rule (a,D) leave (gctxt,th) = 
   38.97 +in fun transfer_rule (a,D) leave (gctxt,th) =
   38.98     (gctxt, transfer_ruleh a D leave (Context.proof_of gctxt) th)
   38.99  end;
  38.100  
  38.101  fun  splits P [] = []
  38.102 -   | splits P (xxs as (x::xs)) = 
  38.103 +   | splits P (xxs as (x::xs)) =
  38.104      let val pss = filter (P x) xxs
  38.105          val qss = filter_out (P x) xxs
  38.106      in if null pss then [qss] else if null qss then [pss] else pss:: splits P qss
  38.107      end
  38.108  
  38.109 -fun all_transfers leave (gctxt,th) = 
  38.110 - let 
  38.111 +fun all_transfers leave (gctxt,th) =
  38.112 + let
  38.113    val ctxt = Context.proof_of gctxt
  38.114    val tys = map snd (Term.add_vars (prop_of th) [])
  38.115    val _ = if null tys then error "transfer: Unable to guess instance" else ()
  38.116 -  val tyss = splits (curry Type.could_unify) tys 
  38.117 +  val tyss = splits (curry Type.could_unify) tys
  38.118    val get_ty = typ_of o ctyp_of_term o fst o Thm.dest_binop o Thm.dest_arg o cprop_of
  38.119    val get_aD = Thm.dest_binop o Thm.dest_arg o cprop_of
  38.120 -  val insts = 
  38.121 -    map_filter (fn tys => 
  38.122 -          get_first (fn (k,ss) => if Type.could_unify (hd tys, range_type (get_ty k)) 
  38.123 -                                  then SOME (get_aD k, ss) 
  38.124 -                                  else NONE) (snd (get ctxt))) tyss
  38.125 -  val _ = if null insts then error "Transfer guesser: there were no possible instances, use direction: in order to provide a direction" else ()
  38.126 +  val insts =
  38.127 +    map_filter (fn tys =>
  38.128 +      get_first (fn (k,ss) =>
  38.129 +        if Type.could_unify (hd tys, range_type (get_ty k))
  38.130 +        then SOME (get_aD k, ss)
  38.131 +        else NONE) (snd (get ctxt))) tyss
  38.132 +  val _ =
  38.133 +    if null insts then
  38.134 +      error "Transfer guesser: there were no possible instances, use direction: in order to provide a direction"
  38.135 +    else ()
  38.136    val ths = map  (fn ((a,D),e) => basic_transfer_rule false a D e leave ctxt th) insts
  38.137    val cth = Conjunction.intr_balanced ths
  38.138   in (gctxt, cth)
  38.139   end;
  38.140  
  38.141 -fun transfer_rule_by_hint ls leave (gctxt,th) = 
  38.142 - let 
  38.143 +fun transfer_rule_by_hint ls leave (gctxt,th) =
  38.144 + let
  38.145    val ctxt = Context.proof_of gctxt
  38.146    val get_aD = Thm.dest_binop o Thm.dest_arg o cprop_of
  38.147 -  val insts = 
  38.148 -    map_filter (fn (k,e) => if exists (fn l => l mem_string (#hints e)) ls 
  38.149 +  val insts =
  38.150 +    map_filter (fn (k,e) => if exists (member (op =) (#hints e)) ls
  38.151            then SOME (get_aD k, e) else NONE)
  38.152          (snd (get ctxt))
  38.153    val _ = if null insts then error "Transfer: No labels provided are stored in the context" else ()
  38.154 @@ -128,53 +128,58 @@
  38.155   end;
  38.156  
  38.157  
  38.158 -fun transferred_attribute ls NONE leave = 
  38.159 +fun transferred_attribute ls NONE leave =
  38.160           if null ls then all_transfers leave else transfer_rule_by_hint ls leave
  38.161    | transferred_attribute _ (SOME (a,D)) leave = transfer_rule (a,D) leave
  38.162  
  38.163 -                                                    (* Add data to the context *)
  38.164 +
  38.165 +(* Add data to the context *)
  38.166 +
  38.167  fun gen_merge_entries {inj = inj0, emb = emb0, ret = ret0, cong = cg0, guess = g0, hints = hints0}
  38.168 -                      ({inj = inj1, emb = emb1, ret = ret1, cong = cg1, guess = g1, hints = hints1}, 
  38.169 +                      ({inj = inj1, emb = emb1, ret = ret1, cong = cg1, guess = g1, hints = hints1},
  38.170                         {inj = inj2, emb = emb2, ret = ret2, cong = cg2, guess = g2, hints = hints2})
  38.171 - = 
  38.172 + =
  38.173   let fun h xs0 xs ys = subtract Thm.eq_thm xs0 (merge Thm.eq_thm (xs,ys)) in
  38.174 - {inj = h inj0 inj1 inj2, emb = h emb0 emb1 emb2, 
  38.175 + {inj = h inj0 inj1 inj2, emb = h emb0 emb1 emb2,
  38.176    ret = h ret0 ret1 ret2, cong = h cg0 cg1 cg2, guess = g1 andalso g2,
  38.177 -  hints = subtract (op = : string*string -> bool) hints0 
  38.178 +  hints = subtract (op = : string*string -> bool) hints0
  38.179              (hints1 union_string hints2)}
  38.180   end;
  38.181  
  38.182  local
  38.183   val h = curry (merge Thm.eq_thm)
  38.184  in
  38.185 -fun merge_entries ({inj = inj1, emb = emb1, ret = ret1, cong = cg1, guess = g1, hints = hints1}, 
  38.186 -                   {inj = inj2, emb = emb2, ret = ret2, cong = cg2, guess = g2, hints = hints2}) = 
  38.187 +fun merge_entries ({inj = inj1, emb = emb1, ret = ret1, cong = cg1, guess = g1, hints = hints1},
  38.188 +                   {inj = inj2, emb = emb2, ret = ret2, cong = cg2, guess = g2, hints = hints2}) =
  38.189      {inj = h inj1 inj2, emb = h emb1 emb2, ret = h ret1 ret2, cong = h cg1 cg2, guess = g1 andalso g2, hints = hints1 union_string hints2}
  38.190 -end; 
  38.191 +end;
  38.192  
  38.193  fun add ((inja,injd), (emba,embd), (reta,retd), (cga,cgd), g, (hintsa, hintsd)) =
  38.194    Thm.declaration_attribute (fn key => fn context => context |> Data.map
  38.195 -   (fn (ss, al) => 
  38.196 +   (fn (ss, al) =>
  38.197       let
  38.198 -      val _ = ((let val _ = Thm.match (transM_pat, (Thm.dest_arg o cprop_of) key) 
  38.199 -                in 0 end) 
  38.200 -                handle MATCH => error "Attribute expected Theorem of the form : TransferMorphism A a B b")
  38.201 +      val _ = Thm.match (transM_pat, Thm.dest_arg (Thm.cprop_of key))
  38.202 +        handle Pattern.MATCH =>
  38.203 +          error "Attribute expected Theorem of the form : TransferMorphism A a B b"
  38.204        val e0 = {inj = inja, emb = emba, ret = reta, cong = cga, guess = g, hints = hintsa}
  38.205        val ed = {inj = injd, emb = embd, ret = retd, cong = cgd, guess = g, hints = hintsd}
  38.206 -      val entry = 
  38.207 -        if g then 
  38.208 +      val entry =
  38.209 +        if g then
  38.210           let val (a0,D0) = (Thm.dest_binop o Thm.dest_arg o cprop_of) key
  38.211               val ctxt0 = ProofContext.init (Thm.theory_of_thm key)
  38.212 -             val inj' = if null inja then #inj (case AList.lookup eq_thm al key of SOME e => e | NONE => error "Transfer: can not generate return rules on the fly, either add injectivity axiom or force manual mode with mode: manual") 
  38.213 -                        else inja
  38.214 +             val inj' =
  38.215 +               if null inja then
  38.216 +                #inj
  38.217 +                  (case AList.lookup Thm.eq_thm al key of SOME e => e
  38.218 +                  | NONE => error "Transfer: can not generate return rules on the fly, either add injectivity axiom or force manual mode with mode: manual")
  38.219 +               else inja
  38.220               val ret' = merge Thm.eq_thm (reta,  map (fn th => basic_transfer_rule true a0 D0 {inj = inj', emb = [], ret = [], cong = cga, guess = g, hints = hintsa} [] ctxt0 th RS sym) emba)
  38.221 -         in {inj = inja, emb = emba, ret = ret', cong = cga, guess = g, hints = hintsa} end 
  38.222 +         in {inj = inja, emb = emba, ret = ret', cong = cga, guess = g, hints = hintsa} end
  38.223          else e0
  38.224 -    in (ss, merge_update eq_thm (gen_merge_entries ed) (key, entry) al)
  38.225 +    in (ss, merge_update Thm.eq_thm (gen_merge_entries ed) (key, entry) al)
  38.226      end));
  38.227  
  38.228  
  38.229 -
  38.230  (* concrete syntax *)
  38.231  
  38.232  local
  38.233 @@ -199,7 +204,7 @@
  38.234  
  38.235  val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat
  38.236  val terms = thms >> map Drule.dest_term
  38.237 -val types = thms >> (Logic.dest_type o HOLogic.dest_Trueprop o prop_of o hd) 
  38.238 +val types = thms >> (Logic.dest_type o HOLogic.dest_Trueprop o prop_of o hd)
  38.239  val name = Scan.lift Args.name
  38.240  val names = Scan.repeat (Scan.unless any_keyword name)
  38.241  fun optional scan = Scan.optional scan []
    39.1 --- a/src/Pure/Concurrent/future.ML	Thu Oct 01 20:49:46 2009 +0200
    39.2 +++ b/src/Pure/Concurrent/future.ML	Thu Oct 01 20:52:18 2009 +0200
    39.3 @@ -30,6 +30,7 @@
    39.4    type task = Task_Queue.task
    39.5    type group = Task_Queue.group
    39.6    val is_worker: unit -> bool
    39.7 +  val worker_task: unit -> Task_Queue.task option
    39.8    val worker_group: unit -> Task_Queue.group option
    39.9    type 'a future
   39.10    val task_of: 'a future -> task
   39.11 @@ -71,6 +72,7 @@
   39.12  end;
   39.13  
   39.14  val is_worker = is_some o thread_data;
   39.15 +val worker_task = Option.map #2 o thread_data;
   39.16  val worker_group = Option.map #3 o thread_data;
   39.17  
   39.18  
   39.19 @@ -347,7 +349,8 @@
   39.20    | SOME res => res);
   39.21  
   39.22  fun join_wait x =
   39.23 -  Synchronized.guarded_access (result_of x) (fn NONE => NONE | some => SOME ((), some));
   39.24 +  Synchronized.guarded_access (result_of x)
   39.25 +    (fn NONE => NONE | some => SOME ((), some));
   39.26  
   39.27  fun join_next deps = (*requires SYNCHRONIZED*)
   39.28    if null deps then NONE
   39.29 @@ -357,10 +360,14 @@
   39.30      | (NONE, deps') => (worker_wait work_finished; join_next deps')
   39.31      | (SOME work, deps') => SOME (work, deps'));
   39.32  
   39.33 -fun join_work deps =
   39.34 -  (case SYNCHRONIZED "join" (fn () => join_next deps) of
   39.35 -    NONE => ()
   39.36 -  | SOME (work, deps') => (execute "join" work; join_work deps'));
   39.37 +fun execute_work NONE = ()
   39.38 +  | execute_work (SOME (work, deps')) = (execute "join" work; join_work deps')
   39.39 +and join_work deps =
   39.40 +  execute_work (SYNCHRONIZED "join" (fn () => join_next deps));
   39.41 +
   39.42 +fun join_depend task deps =
   39.43 +  execute_work (SYNCHRONIZED "join" (fn () =>
   39.44 +    (Unsynchronized.change queue (Task_Queue.depend task deps); join_next deps)));
   39.45  
   39.46  in
   39.47  
   39.48 @@ -368,11 +375,11 @@
   39.49    if forall is_finished xs then map get_result xs
   39.50    else if Multithreading.self_critical () then
   39.51      error "Cannot join future values within critical section"
   39.52 -  else uninterruptible (fn _ => fn () =>
   39.53 -     (if is_worker ()
   39.54 -      then join_work (map task_of xs)
   39.55 -      else List.app join_wait xs;
   39.56 -      map get_result xs)) ();
   39.57 +  else
   39.58 +    (case worker_task () of
   39.59 +      SOME task => join_depend task (map task_of xs)
   39.60 +    | NONE => List.app join_wait xs;
   39.61 +    map get_result xs);
   39.62  
   39.63  end;
   39.64  
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/Pure/Concurrent/lazy.ML	Thu Oct 01 20:52:18 2009 +0200
    40.3 @@ -0,0 +1,58 @@
    40.4 +(*  Title:      Pure/Concurrent/lazy.ML
    40.5 +    Author:     Makarius
    40.6 +
    40.7 +Lazy evaluation based on futures.
    40.8 +*)
    40.9 +
   40.10 +signature LAZY =
   40.11 +sig
   40.12 +  type 'a lazy
   40.13 +  val peek: 'a lazy -> 'a Exn.result option
   40.14 +  val lazy: (unit -> 'a) -> 'a lazy
   40.15 +  val value: 'a -> 'a lazy
   40.16 +  val force_result: 'a lazy -> 'a Exn.result
   40.17 +  val force: 'a lazy -> 'a
   40.18 +  val map_force: ('a -> 'b) -> 'a lazy -> 'b lazy
   40.19 +end;
   40.20 +
   40.21 +structure Lazy: LAZY =
   40.22 +struct
   40.23 +
   40.24 +(* datatype *)
   40.25 +
   40.26 +datatype 'a expr =
   40.27 +  Expr of unit -> 'a |
   40.28 +  Future of 'a future;
   40.29 +
   40.30 +abstype 'a lazy = Lazy of 'a expr Synchronized.var
   40.31 +with
   40.32 +
   40.33 +fun peek (Lazy var) =
   40.34 +  (case Synchronized.value var of
   40.35 +    Expr _ => NONE
   40.36 +  | Future x => Future.peek x);
   40.37 +
   40.38 +fun lazy e = Lazy (Synchronized.var "lazy" (Expr e));
   40.39 +fun value a = Lazy (Synchronized.var "lazy" (Future (Future.value a)));
   40.40 +
   40.41 +
   40.42 +(* force result *)
   40.43 +
   40.44 +fun force_result (Lazy var) =
   40.45 +  (case peek (Lazy var) of
   40.46 +    SOME res => res
   40.47 +  | NONE =>
   40.48 +      Synchronized.guarded_access var
   40.49 +        (fn Expr e => let val x = Future.fork e in SOME (x, Future x) end
   40.50 +          | Future x => SOME (x, Future x))
   40.51 +      |> Future.join_result);
   40.52 +
   40.53 +fun force r = Exn.release (force_result r);
   40.54 +
   40.55 +fun map_force f = value o f o force;
   40.56 +
   40.57 +end;
   40.58 +end;
   40.59 +
   40.60 +type 'a lazy = 'a Lazy.lazy;
   40.61 +
    41.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.2 +++ b/src/Pure/Concurrent/lazy_sequential.ML	Thu Oct 01 20:52:18 2009 +0200
    41.3 @@ -0,0 +1,43 @@
    41.4 +(*  Title:      Pure/Concurrent/lazy_sequential.ML
    41.5 +    Author:     Florian Haftmann and Makarius, TU Muenchen
    41.6 +
    41.7 +Lazy evaluation with memoing (sequential version).
    41.8 +*)
    41.9 +
   41.10 +structure Lazy: LAZY =
   41.11 +struct
   41.12 +
   41.13 +(* datatype *)
   41.14 +
   41.15 +datatype 'a expr =
   41.16 +  Expr of unit -> 'a |
   41.17 +  Result of 'a Exn.result;
   41.18 +
   41.19 +abstype 'a lazy = Lazy of 'a expr Unsynchronized.ref
   41.20 +with
   41.21 +
   41.22 +fun peek (Lazy r) =
   41.23 +  (case ! r of
   41.24 +    Expr _ => NONE
   41.25 +  | Result x => SOME x);
   41.26 +
   41.27 +fun lazy e = Lazy (Unsynchronized.ref (Expr e));
   41.28 +fun value a = Lazy (Unsynchronized.ref (Result (Exn.Result a)));
   41.29 +
   41.30 +
   41.31 +(* force result *)
   41.32 +
   41.33 +fun force_result (Lazy r) =
   41.34 +  (case ! r of
   41.35 +    Expr e => Exn.capture e ()
   41.36 +  | Result res => res);
   41.37 +
   41.38 +fun force r = Exn.release (force_result r);
   41.39 +
   41.40 +fun map_force f = value o f o force;
   41.41 +
   41.42 +end;
   41.43 +end;
   41.44 +
   41.45 +type 'a lazy = 'a Lazy.lazy;
   41.46 +
    42.1 --- a/src/Pure/Concurrent/par_list_dummy.ML	Thu Oct 01 20:49:46 2009 +0200
    42.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.3 @@ -1,16 +0,0 @@
    42.4 -(*  Title:      Pure/Concurrent/par_list_dummy.ML
    42.5 -    Author:     Makarius
    42.6 -
    42.7 -Dummy version of parallel list combinators -- plain sequential evaluation.
    42.8 -*)
    42.9 -
   42.10 -structure Par_List: PAR_LIST =
   42.11 -struct
   42.12 -
   42.13 -val map = map;
   42.14 -val get_some = get_first;
   42.15 -val find_some = find_first;
   42.16 -val exists = exists;
   42.17 -val forall = forall;
   42.18 -
   42.19 -end;
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/Pure/Concurrent/par_list_sequential.ML	Thu Oct 01 20:52:18 2009 +0200
    43.3 @@ -0,0 +1,16 @@
    43.4 +(*  Title:      Pure/Concurrent/par_list_sequential.ML
    43.5 +    Author:     Makarius
    43.6 +
    43.7 +Dummy version of parallel list combinators -- plain sequential evaluation.
    43.8 +*)
    43.9 +
   43.10 +structure Par_List: PAR_LIST =
   43.11 +struct
   43.12 +
   43.13 +val map = map;
   43.14 +val get_some = get_first;
   43.15 +val find_some = find_first;
   43.16 +val exists = exists;
   43.17 +val forall = forall;
   43.18 +
   43.19 +end;
    44.1 --- a/src/Pure/Concurrent/synchronized_dummy.ML	Thu Oct 01 20:49:46 2009 +0200
    44.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    44.3 @@ -1,25 +0,0 @@
    44.4 -(*  Title:      Pure/Concurrent/synchronized_dummy.ML
    44.5 -    Author:     Makarius
    44.6 -
    44.7 -Dummy version of state variables -- plain refs for sequential access.
    44.8 -*)
    44.9 -
   44.10 -structure Synchronized: SYNCHRONIZED =
   44.11 -struct
   44.12 -
   44.13 -datatype 'a var = Var of 'a Unsynchronized.ref;
   44.14 -
   44.15 -fun var _ x = Var (Unsynchronized.ref x);
   44.16 -fun value (Var var) = ! var;
   44.17 -
   44.18 -fun timed_access (Var var) _ f =
   44.19 -  (case f (! var) of
   44.20 -    SOME (y, x') => (var := x'; SOME y)
   44.21 -  | NONE => Thread.unavailable ());
   44.22 -
   44.23 -fun guarded_access var f = the (timed_access var (K NONE) f);
   44.24 -
   44.25 -fun change_result var f = guarded_access var (SOME o f);
   44.26 -fun change var f = change_result var (fn x => ((), f x));
   44.27 -
   44.28 -end;
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/Pure/Concurrent/synchronized_sequential.ML	Thu Oct 01 20:52:18 2009 +0200
    45.3 @@ -0,0 +1,27 @@
    45.4 +(*  Title:      Pure/Concurrent/synchronized_sequential.ML
    45.5 +    Author:     Makarius
    45.6 +
    45.7 +Sequential version of state variables -- plain refs.
    45.8 +*)
    45.9 +
   45.10 +structure Synchronized: SYNCHRONIZED =
   45.11 +struct
   45.12 +
   45.13 +abstype 'a var = Var of 'a Unsynchronized.ref
   45.14 +with
   45.15 +
   45.16 +fun var _ x = Var (Unsynchronized.ref x);
   45.17 +fun value (Var var) = ! var;
   45.18 +
   45.19 +fun timed_access (Var var) _ f =
   45.20 +  (case f (! var) of
   45.21 +    SOME (y, x') => (var := x'; SOME y)
   45.22 +  | NONE => Thread.unavailable ());
   45.23 +
   45.24 +fun guarded_access var f = the (timed_access var (K NONE) f);
   45.25 +
   45.26 +fun change_result var f = guarded_access var (SOME o f);
   45.27 +fun change var f = change_result var (fn x => ((), f x));
   45.28 +
   45.29 +end;
   45.30 +end;
    46.1 --- a/src/Pure/Concurrent/task_queue.ML	Thu Oct 01 20:49:46 2009 +0200
    46.2 +++ b/src/Pure/Concurrent/task_queue.ML	Thu Oct 01 20:52:18 2009 +0200
    46.3 @@ -27,6 +27,7 @@
    46.4    val enqueue: group -> task list -> int -> (bool -> bool) -> queue -> (task * bool) * queue
    46.5    val extend: task -> (bool -> bool) -> queue -> queue option
    46.6    val dequeue: Thread.thread -> queue -> (task * group * (bool -> bool) list) option * queue
    46.7 +  val depend: task -> task list -> queue -> queue
    46.8    val dequeue_towards: Thread.thread -> task list -> queue ->
    46.9      (((task * group * (bool -> bool) list) option * task list) * queue)
   46.10    val finish: task -> queue -> bool * queue
   46.11 @@ -101,6 +102,11 @@
   46.12  fun add_job task dep (jobs: jobs) =
   46.13    Task_Graph.add_edge (dep, task) jobs handle Task_Graph.UNDEF _ => jobs;
   46.14  
   46.15 +fun add_dep task dep (jobs: jobs) =
   46.16 +  if Task_Graph.is_edge jobs (task, dep) then
   46.17 +    raise Fail "Cyclic dependency of future tasks"
   46.18 +  else add_job task dep jobs;
   46.19 +
   46.20  fun get_deps (jobs: jobs) task =
   46.21    Task_Graph.imm_preds jobs task handle Task_Graph.UNDEF _ => [];
   46.22  
   46.23 @@ -125,7 +131,7 @@
   46.24  fun status (Queue {jobs, ...}) =
   46.25    let
   46.26      val (x, y, z) =
   46.27 -      Task_Graph.fold (fn (task, ((_, job), (deps, _))) => fn (x, y, z) =>
   46.28 +      Task_Graph.fold (fn (_, ((_, job), (deps, _))) => fn (x, y, z) =>
   46.29            (case job of
   46.30              Job _ => if null deps then (x + 1, y, z) else (x, y + 1, z)
   46.31            | Running _ => (x, y, z + 1)))
   46.32 @@ -205,6 +211,9 @@
   46.33  
   46.34  (* dequeue_towards -- adhoc dependencies *)
   46.35  
   46.36 +fun depend task deps (Queue {groups, jobs, ...}) =
   46.37 +  make_queue groups (fold (add_dep task) deps jobs) Unknown;
   46.38 +
   46.39  fun dequeue_towards thread deps (queue as Queue {groups, jobs, ...}) =
   46.40    let
   46.41      fun ready task =
    47.1 --- a/src/Pure/General/heap.ML	Thu Oct 01 20:49:46 2009 +0200
    47.2 +++ b/src/Pure/General/heap.ML	Thu Oct 01 20:52:18 2009 +0200
    47.3 @@ -78,8 +78,8 @@
    47.4  
    47.5  nonfix upto;
    47.6  
    47.7 -fun upto _ (h as Empty) = ([], h)
    47.8 -  | upto limit (h as Heap (_, x, a, b)) =
    47.9 +fun upto _ Empty = ([], Empty)
   47.10 +  | upto limit (h as Heap (_, x, _, _)) =
   47.11        (case ord (x, limit) of
   47.12          GREATER => ([], h)
   47.13        | _ => upto limit (delete_min h) |>> cons x);
    48.1 --- a/src/Pure/General/lazy.ML	Thu Oct 01 20:49:46 2009 +0200
    48.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    48.3 @@ -1,65 +0,0 @@
    48.4 -(*  Title:      Pure/General/lazy.ML
    48.5 -    Author:     Florian Haftmann and Makarius, TU Muenchen
    48.6 -
    48.7 -Lazy evaluation with memoing.  Concurrency may lead to multiple
    48.8 -attempts of evaluation -- the first result persists.
    48.9 -*)
   48.10 -
   48.11 -signature LAZY =
   48.12 -sig
   48.13 -  type 'a lazy
   48.14 -  val same: 'a lazy * 'a lazy -> bool
   48.15 -  val lazy: (unit -> 'a) -> 'a lazy
   48.16 -  val value: 'a -> 'a lazy
   48.17 -  val peek: 'a lazy -> 'a Exn.result option
   48.18 -  val force_result: 'a lazy -> 'a Exn.result
   48.19 -  val force: 'a lazy -> 'a
   48.20 -  val map_force: ('a -> 'a) -> 'a lazy -> 'a lazy
   48.21 -end
   48.22 -
   48.23 -structure Lazy :> LAZY =
   48.24 -struct
   48.25 -
   48.26 -(* datatype *)
   48.27 -
   48.28 -datatype 'a T =
   48.29 -  Lazy of unit -> 'a |
   48.30 -  Result of 'a Exn.result;
   48.31 -
   48.32 -type 'a lazy = 'a T Unsynchronized.ref;
   48.33 -
   48.34 -fun same (r1: 'a lazy, r2) = r1 = r2;
   48.35 -
   48.36 -fun lazy e = Unsynchronized.ref (Lazy e);
   48.37 -fun value x = Unsynchronized.ref (Result (Exn.Result x));
   48.38 -
   48.39 -fun peek r =
   48.40 -  (case ! r of
   48.41 -    Lazy _ => NONE
   48.42 -  | Result res => SOME res);
   48.43 -
   48.44 -
   48.45 -(* force result *)
   48.46 -
   48.47 -fun force_result r =
   48.48 -  let
   48.49 -    (*potentially concurrent evaluation*)
   48.50 -    val res =
   48.51 -      (case ! r of
   48.52 -        Lazy e => Exn.capture e ()
   48.53 -      | Result res => res);
   48.54 -    (*assign result -- first one persists*)
   48.55 -    val res' = NAMED_CRITICAL "lazy" (fn () =>
   48.56 -      (case ! r of
   48.57 -        Lazy _ => (r := Result res; res)
   48.58 -      | Result res' => res'));
   48.59 -  in res' end;
   48.60 -
   48.61 -fun force r = Exn.release (force_result r);
   48.62 -
   48.63 -fun map_force f = value o f o force;
   48.64 -
   48.65 -end;
   48.66 -
   48.67 -type 'a lazy = 'a Lazy.lazy;
   48.68 -
    49.1 --- a/src/Pure/General/pretty.ML	Thu Oct 01 20:49:46 2009 +0200
    49.2 +++ b/src/Pure/General/pretty.ML	Thu Oct 01 20:52:18 2009 +0200
    49.3 @@ -197,11 +197,11 @@
    49.4  fun setdepth dp = (depth := dp);
    49.5  
    49.6  local
    49.7 -  fun pruning dp (Block (m, bes, indent, wd)) =
    49.8 +  fun pruning dp (Block (m, bes, indent, _)) =
    49.9          if dp > 0
   49.10          then block_markup m (indent, map (pruning (dp - 1)) bes)
   49.11          else str "..."
   49.12 -    | pruning dp e = e
   49.13 +    | pruning _ e = e;
   49.14  in
   49.15    fun prune e = if ! depth > 0 then pruning (! depth) e else e;
   49.16  end;
   49.17 @@ -219,7 +219,7 @@
   49.18    pos = 0,
   49.19    nl = 0};
   49.20  
   49.21 -fun newline {tx, ind, pos, nl} : text =
   49.22 +fun newline {tx, ind = _, pos = _, nl} : text =
   49.23   {tx = Buffer.add (Output.output "\n") tx,
   49.24    ind = Buffer.empty,
   49.25    pos = 0,
   49.26 @@ -250,22 +250,22 @@
   49.27  (*Add the lengths of the expressions until the next Break; if no Break then
   49.28    include "after", to account for text following this block.*)
   49.29  fun breakdist (Block (_, _, _, len) :: es, after) = len + breakdist (es, after)
   49.30 -  | breakdist (String (s, len) :: es, after) = len + breakdist (es, after)
   49.31 -  | breakdist (Break _ :: es, after) = 0
   49.32 +  | breakdist (String (_, len) :: es, after) = len + breakdist (es, after)
   49.33 +  | breakdist (Break _ :: _, _) = 0
   49.34    | breakdist ([], after) = after;
   49.35  
   49.36  (*Search for the next break (at this or higher levels) and force it to occur.*)
   49.37  fun forcenext [] = []
   49.38 -  | forcenext (Break (_, wd) :: es) = Break (true, 0) :: es
   49.39 +  | forcenext (Break _ :: es) = Break (true, 0) :: es
   49.40    | forcenext (e :: es) = e :: forcenext es;
   49.41  
   49.42  (*es is list of expressions to print;
   49.43    blockin is the indentation of the current block;
   49.44    after is the width of the following context until next break.*)
   49.45  fun format ([], _, _) text = text
   49.46 -  | format (e :: es, block as (blockind, blockin), after) (text as {ind, pos, nl, ...}) =
   49.47 +  | format (e :: es, block as (_, blockin), after) (text as {ind, pos, nl, ...}) =
   49.48        (case e of
   49.49 -        Block ((bg, en), bes, indent, wd) =>
   49.50 +        Block ((bg, en), bes, indent, _) =>
   49.51            let
   49.52              val {emergencypos, ...} = ! margin_info;
   49.53              val pos' = pos + indent;
    50.1 --- a/src/Pure/General/scan.ML	Thu Oct 01 20:49:46 2009 +0200
    50.2 +++ b/src/Pure/General/scan.ML	Thu Oct 01 20:52:18 2009 +0200
    50.3 @@ -273,7 +273,7 @@
    50.4  val empty_lexicon = Lexicon Symtab.empty;
    50.5  
    50.6  fun is_literal _ [] = false
    50.7 -  | is_literal (Lexicon tab) (chs as c :: cs) =
    50.8 +  | is_literal (Lexicon tab) (c :: cs) =
    50.9        (case Symtab.lookup tab c of
   50.10          SOME (tip, lex) => tip andalso null cs orelse is_literal lex cs
   50.11        | NONE => false);
   50.12 @@ -286,7 +286,7 @@
   50.13      fun finish (SOME (res, rest)) = (rev res, rest)
   50.14        | finish NONE = raise FAIL NONE;
   50.15      fun scan _ res (Lexicon tab) [] = if Symtab.is_empty tab then finish res else raise MORE NONE
   50.16 -      | scan path res (Lexicon tab) (chs as c :: cs) =
   50.17 +      | scan path res (Lexicon tab) (c :: cs) =
   50.18            (case Symtab.lookup tab (fst c) of
   50.19              SOME (tip, lex) =>
   50.20                let val path' = c :: path
   50.21 @@ -300,7 +300,7 @@
   50.22  fun extend_lexicon chrs lexicon =
   50.23    let
   50.24      fun ext [] lex = lex
   50.25 -      | ext (chs as c :: cs) (Lexicon tab) =
   50.26 +      | ext (c :: cs) (Lexicon tab) =
   50.27            (case Symtab.lookup tab c of
   50.28              SOME (tip, lex) => Lexicon (Symtab.update (c, (tip orelse null cs, ext cs lex)) tab)
   50.29            | NONE => Lexicon (Symtab.update (c, (null cs, ext cs empty_lexicon)) tab));
    51.1 --- a/src/Pure/General/symbol_pos.ML	Thu Oct 01 20:49:46 2009 +0200
    51.2 +++ b/src/Pure/General/symbol_pos.ML	Thu Oct 01 20:52:18 2009 +0200
    51.3 @@ -161,7 +161,7 @@
    51.4  
    51.5  fun pad [] = []
    51.6    | pad [(s, _)] = [s]
    51.7 -  | pad ((s1, pos1) :: (rest as (s2, pos2) :: _)) =
    51.8 +  | pad ((s1, pos1) :: (rest as (_, pos2) :: _)) =
    51.9        let
   51.10          val end_pos1 = Position.advance s1 pos1;
   51.11          val d = Int.max (0, Position.distance_of end_pos1 pos2);
    52.1 --- a/src/Pure/IsaMakefile	Thu Oct 01 20:49:46 2009 +0200
    52.2 +++ b/src/Pure/IsaMakefile	Thu Oct 01 20:52:18 2009 +0200
    52.3 @@ -43,18 +43,19 @@
    52.4  Pure: $(OUT)/Pure
    52.5  
    52.6  $(OUT)/Pure: $(BOOTSTRAP_FILES) Concurrent/future.ML			\
    52.7 +  Concurrent/lazy.ML Concurrent/lazy_sequential.ML			\
    52.8    Concurrent/mailbox.ML Concurrent/par_list.ML				\
    52.9 -  Concurrent/par_list_dummy.ML Concurrent/simple_thread.ML		\
   52.10 -  Concurrent/synchronized.ML Concurrent/synchronized_dummy.ML		\
   52.11 +  Concurrent/par_list_sequential.ML Concurrent/simple_thread.ML		\
   52.12 +  Concurrent/synchronized.ML Concurrent/synchronized_sequential.ML	\
   52.13    Concurrent/task_queue.ML General/alist.ML General/antiquote.ML	\
   52.14    General/balanced_tree.ML General/basics.ML General/binding.ML		\
   52.15    General/buffer.ML General/file.ML General/graph.ML General/heap.ML	\
   52.16 -  General/integer.ML General/lazy.ML General/long_name.ML		\
   52.17 -  General/markup.ML General/name_space.ML General/ord_list.ML		\
   52.18 -  General/output.ML General/path.ML General/position.ML			\
   52.19 -  General/pretty.ML General/print_mode.ML General/properties.ML		\
   52.20 -  General/queue.ML General/same.ML General/scan.ML General/secure.ML	\
   52.21 -  General/seq.ML General/source.ML General/stack.ML General/symbol.ML	\
   52.22 +  General/integer.ML General/long_name.ML General/markup.ML		\
   52.23 +  General/name_space.ML General/ord_list.ML General/output.ML		\
   52.24 +  General/path.ML General/position.ML General/pretty.ML			\
   52.25 +  General/print_mode.ML General/properties.ML General/queue.ML		\
   52.26 +  General/same.ML General/scan.ML General/secure.ML General/seq.ML	\
   52.27 +  General/source.ML General/stack.ML General/symbol.ML			\
   52.28    General/symbol_pos.ML General/table.ML General/url.ML General/xml.ML	\
   52.29    General/yxml.ML Isar/args.ML Isar/attrib.ML Isar/auto_bind.ML		\
   52.30    Isar/calculation.ML Isar/class.ML Isar/class_target.ML Isar/code.ML	\
    53.1 --- a/src/Pure/Isar/args.ML	Thu Oct 01 20:49:46 2009 +0200
    53.2 +++ b/src/Pure/Isar/args.ML	Thu Oct 01 20:52:18 2009 +0200
    53.3 @@ -283,7 +283,7 @@
    53.4  
    53.5  (** syntax wrapper **)
    53.6  
    53.7 -fun syntax kind scan (src as Src ((s, args), pos)) st =
    53.8 +fun syntax kind scan (Src ((s, args), pos)) st =
    53.9    (case Scan.error (Scan.finite' T.stopper (Scan.option scan)) (st, args) of
   53.10      (SOME x, (st', [])) => (x, st')
   53.11    | (_, (_, args')) =>
    54.1 --- a/src/Pure/Isar/context_rules.ML	Thu Oct 01 20:49:46 2009 +0200
    54.2 +++ b/src/Pure/Isar/context_rules.ML	Thu Oct 01 20:52:18 2009 +0200
    54.3 @@ -131,8 +131,8 @@
    54.4  (* retrieving rules *)
    54.5  
    54.6  fun untaglist [] = []
    54.7 -  | untaglist [(k : int * int, x)] = [x]
    54.8 -  | untaglist ((k, x) :: (rest as (k', x') :: _)) =
    54.9 +  | untaglist [(_ : int * int, x)] = [x]
   54.10 +  | untaglist ((k, x) :: (rest as (k', _) :: _)) =
   54.11        if k = k' then untaglist rest
   54.12        else x :: untaglist rest;
   54.13  
   54.14 @@ -160,7 +160,7 @@
   54.15  (* wrappers *)
   54.16  
   54.17  fun gen_add_wrapper upd w =
   54.18 -  Context.theory_map (Rules.map (fn (rs as Rules {next, rules, netpairs, wrappers}) =>
   54.19 +  Context.theory_map (Rules.map (fn Rules {next, rules, netpairs, wrappers} =>
   54.20      make_rules next rules netpairs (upd (fn ws => (w, stamp ()) :: ws) wrappers)));
   54.21  
   54.22  val addSWrapper = gen_add_wrapper Library.apfst;
    55.1 --- a/src/Pure/Isar/expression.ML	Thu Oct 01 20:49:46 2009 +0200
    55.2 +++ b/src/Pure/Isar/expression.ML	Thu Oct 01 20:52:18 2009 +0200
    55.3 @@ -311,7 +311,7 @@
    55.4    | finish_primitive _ close (Defines defs) = close (Defines defs)
    55.5    | finish_primitive _ _ (Notes facts) = Notes facts;
    55.6  
    55.7 -fun finish_inst ctxt parms do_close (loc, (prfx, inst)) =
    55.8 +fun finish_inst ctxt (loc, (prfx, inst)) =
    55.9    let
   55.10      val thy = ProofContext.theory_of ctxt;
   55.11      val (parm_names, parm_types) = Locale.params_of thy loc |> map #1 |> split_list;
   55.12 @@ -323,7 +323,7 @@
   55.13  
   55.14  fun finish ctxt parms do_close insts elems =
   55.15    let
   55.16 -    val deps = map (finish_inst ctxt parms do_close) insts;
   55.17 +    val deps = map (finish_inst ctxt) insts;
   55.18      val elems' = map (finish_elem ctxt parms do_close) elems;
   55.19    in (deps, elems') end;
   55.20  
    56.1 --- a/src/Pure/Isar/isar_document.ML	Thu Oct 01 20:49:46 2009 +0200
    56.2 +++ b/src/Pure/Isar/isar_document.ML	Thu Oct 01 20:52:18 2009 +0200
    56.3 @@ -13,6 +13,7 @@
    56.4    val begin_document: document_id -> Path.T -> unit
    56.5    val end_document: document_id -> unit
    56.6    val edit_document: document_id -> document_id -> (command_id * command_id option) list -> unit
    56.7 +  val init: unit -> unit
    56.8  end;
    56.9  
   56.10  structure Isar_Document: ISAR_DOCUMENT =
    57.1 --- a/src/Pure/Isar/obtain.ML	Thu Oct 01 20:49:46 2009 +0200
    57.2 +++ b/src/Pure/Isar/obtain.ML	Thu Oct 01 20:52:18 2009 +0200
    57.3 @@ -215,7 +215,6 @@
    57.4      val thy = ProofContext.theory_of ctxt;
    57.5      val certT = Thm.ctyp_of thy;
    57.6      val cert = Thm.cterm_of thy;
    57.7 -    val string_of_typ = Syntax.string_of_typ ctxt;
    57.8      val string_of_term = setmp show_types true (Syntax.string_of_term ctxt);
    57.9  
   57.10      fun err msg th = error (msg ^ ":\n" ^ Display.string_of_thm ctxt th);
    58.1 --- a/src/Pure/Isar/proof.ML	Thu Oct 01 20:49:46 2009 +0200
    58.2 +++ b/src/Pure/Isar/proof.ML	Thu Oct 01 20:52:18 2009 +0200
    58.3 @@ -581,7 +581,6 @@
    58.4    let
    58.5      val _ = assert_forward state;
    58.6      val thy = theory_of state;
    58.7 -    val ctxt = context_of state;
    58.8  
    58.9      val (raw_name_atts, (raw_vars, raw_rhss)) = args |> split_list ||> split_list;
   58.10      val name_atts = map (apsnd (map (prep_att thy))) raw_name_atts;
   58.11 @@ -1008,7 +1007,7 @@
   58.12    let
   58.13      val _ = assert_backward state;
   58.14      val (goal_ctxt, (_, goal)) = find_goal state;
   58.15 -    val {statement as (kind, propss, prop), messages, using, goal, before_qed, after_qed} = goal;
   58.16 +    val {statement as (kind, _, prop), messages, using, goal, before_qed, after_qed} = goal;
   58.17      val goal_txt = prop :: map Thm.term_of (Assumption.all_assms_of goal_ctxt);
   58.18  
   58.19      val _ = is_relevant state andalso error "Cannot fork relevant proof";
    59.1 --- a/src/Pure/Isar/proof_context.ML	Thu Oct 01 20:49:46 2009 +0200
    59.2 +++ b/src/Pure/Isar/proof_context.ML	Thu Oct 01 20:52:18 2009 +0200
    59.3 @@ -1033,7 +1033,7 @@
    59.4  
    59.5  local
    59.6  
    59.7 -fun const_syntax ctxt (Free (x, T), mx) = SOME (true, (x, T, mx))
    59.8 +fun const_syntax _ (Free (x, T), mx) = SOME (true, (x, T, mx))
    59.9    | const_syntax ctxt (Const (c, _), mx) =
   59.10        Option.map (pair false) (try (Consts.syntax (consts_of ctxt)) (c, mx))
   59.11    | const_syntax _ _ = NONE;
   59.12 @@ -1106,7 +1106,7 @@
   59.13  
   59.14  (* fixes vs. frees *)
   59.15  
   59.16 -fun auto_fixes (arg as (ctxt, (propss, x))) =
   59.17 +fun auto_fixes (ctxt, (propss, x)) =
   59.18    ((fold o fold) Variable.auto_fixes propss ctxt, (propss, x));
   59.19  
   59.20  fun bind_fixes xs ctxt =
    60.1 --- a/src/Pure/Isar/proof_node.ML	Thu Oct 01 20:49:46 2009 +0200
    60.2 +++ b/src/Pure/Isar/proof_node.ML	Thu Oct 01 20:52:18 2009 +0200
    60.3 @@ -41,7 +41,7 @@
    60.4  
    60.5  (* apply transformer *)
    60.6  
    60.7 -fun applys f (ProofNode (node as (st, _), n)) =
    60.8 +fun applys f (ProofNode ((st, _), n)) =
    60.9    (case Seq.pull (f st) of
   60.10      NONE => error "empty result sequence -- proof command failed"
   60.11    | SOME res => ProofNode (res, n + 1));
    61.1 --- a/src/Pure/Isar/rule_insts.ML	Thu Oct 01 20:49:46 2009 +0200
    61.2 +++ b/src/Pure/Isar/rule_insts.ML	Thu Oct 01 20:52:18 2009 +0200
    61.3 @@ -266,8 +266,8 @@
    61.4    let
    61.5      val thy = ProofContext.theory_of ctxt;
    61.6      (* Separate type and term insts *)
    61.7 -    fun has_type_var ((x, _), _) = (case Symbol.explode x of
    61.8 -          "'"::cs => true | cs => false);
    61.9 +    fun has_type_var ((x, _), _) =
   61.10 +      (case Symbol.explode x of "'" :: _ => true | _ => false);
   61.11      val Tinsts = List.filter has_type_var insts;
   61.12      val tinsts = filter_out has_type_var insts;
   61.13  
    62.1 --- a/src/Pure/Isar/specification.ML	Thu Oct 01 20:49:46 2009 +0200
    62.2 +++ b/src/Pure/Isar/specification.ML	Thu Oct 01 20:52:18 2009 +0200
    62.3 @@ -136,9 +136,6 @@
    62.4    prepare prep_vars parse_prop prep_att do_close
    62.5      vars (map single_spec specs) #>> apsnd (map the_spec);
    62.6  
    62.7 -fun prep_specification prep_vars parse_prop prep_att vars specs =
    62.8 -  prepare prep_vars parse_prop prep_att true [specs];
    62.9 -
   62.10  in
   62.11  
   62.12  fun check_spec x = prep_spec ProofContext.cert_vars (K I) (K I) true x;
    63.1 --- a/src/Pure/Isar/theory_target.ML	Thu Oct 01 20:49:46 2009 +0200
    63.2 +++ b/src/Pure/Isar/theory_target.ML	Thu Oct 01 20:52:18 2009 +0200
    63.3 @@ -45,7 +45,7 @@
    63.4  
    63.5  (* pretty *)
    63.6  
    63.7 -fun pretty_thy ctxt target is_locale is_class =
    63.8 +fun pretty_thy ctxt target is_class =
    63.9    let
   63.10      val thy = ProofContext.theory_of ctxt;
   63.11      val target_name = (if is_class then "class " else "locale ") ^ Locale.extern thy target;
   63.12 @@ -63,12 +63,12 @@
   63.13        (map (Pretty.chunks o Element.pretty_ctxt ctxt) elems)]
   63.14    end;
   63.15  
   63.16 -fun pretty (Target {target, is_locale, is_class, instantiation, overloading, ...}) ctxt =
   63.17 +fun pretty (Target {target, is_class, instantiation, overloading, ...}) ctxt =
   63.18    Pretty.block [Pretty.str "theory", Pretty.brk 1,
   63.19        Pretty.str (Context.theory_name (ProofContext.theory_of ctxt))] ::
   63.20      (if not (null overloading) then [Overloading.pretty ctxt]
   63.21       else if not (null (#1 instantiation)) then [Class_Target.pretty_instantiation ctxt]
   63.22 -     else pretty_thy ctxt target is_locale is_class);
   63.23 +     else pretty_thy ctxt target is_class);
   63.24  
   63.25  
   63.26  (* target declarations *)
   63.27 @@ -260,8 +260,7 @@
   63.28  
   63.29  (* define *)
   63.30  
   63.31 -fun define (ta as Target {target, is_locale, is_class, ...})
   63.32 -    kind ((b, mx), ((name, atts), rhs)) lthy =
   63.33 +fun define ta kind ((b, mx), ((name, atts), rhs)) lthy =
   63.34    let
   63.35      val thy = ProofContext.theory_of lthy;
   63.36      val thy_ctxt = ProofContext.init thy;
    64.1 --- a/src/Pure/Isar/toplevel.ML	Thu Oct 01 20:49:46 2009 +0200
    64.2 +++ b/src/Pure/Isar/toplevel.ML	Thu Oct 01 20:52:18 2009 +0200
    64.3 @@ -126,7 +126,6 @@
    64.4    SkipProof of int * (generic_theory * generic_theory);
    64.5      (*proof depth, resulting theory, original theory*)
    64.6  
    64.7 -val the_global_theory = fn Theory (Context.Theory thy, _) => thy | _ => raise UNDEF;
    64.8  val theory_node = fn Theory (gthy, _) => SOME gthy | _ => NONE;
    64.9  val proof_node = fn Proof (prf, _) => SOME prf | _ => NONE;
   64.10  
   64.11 @@ -256,7 +255,7 @@
   64.12  
   64.13  in
   64.14  
   64.15 -fun apply_transaction pos f g (node, exit) =
   64.16 +fun apply_transaction f g (node, exit) =
   64.17    let
   64.18      val _ = is_draft_theory node andalso error "Illegal draft theory in toplevel state";
   64.19      val cont_node = reset_presentation node;
   64.20 @@ -293,29 +292,29 @@
   64.21  
   64.22  local
   64.23  
   64.24 -fun apply_tr int _ (Init (_, f, exit)) (State (NONE, _)) =
   64.25 +fun apply_tr int (Init (_, f, exit)) (State (NONE, _)) =
   64.26        State (SOME (Theory (Context.Theory (Theory.checkpoint (f int)), NONE), exit), NONE)
   64.27 -  | apply_tr _ _ Exit (State (prev as SOME (Theory (Context.Theory _, _), _), _)) =
   64.28 +  | apply_tr _ Exit (State (prev as SOME (Theory (Context.Theory _, _), _), _)) =
   64.29        State (NONE, prev)
   64.30 -  | apply_tr _ _ CommitExit (State (NONE, SOME (Theory (Context.Theory thy, _), exit))) =
   64.31 +  | apply_tr _ CommitExit (State (NONE, SOME (Theory (Context.Theory thy, _), exit))) =
   64.32        (Runtime.controlled_execution exit thy; toplevel)
   64.33 -  | apply_tr int _ (Keep f) state =
   64.34 +  | apply_tr int (Keep f) state =
   64.35        Runtime.controlled_execution (fn x => tap (f int) x) state
   64.36 -  | apply_tr int pos (Transaction (f, g)) (State (SOME state, _)) =
   64.37 -      apply_transaction pos (fn x => f int x) g state
   64.38 -  | apply_tr _ _ _ _ = raise UNDEF;
   64.39 +  | apply_tr int (Transaction (f, g)) (State (SOME state, _)) =
   64.40 +      apply_transaction (fn x => f int x) g state
   64.41 +  | apply_tr _ _ _ = raise UNDEF;
   64.42  
   64.43 -fun apply_union _ _ [] state = raise FAILURE (state, UNDEF)
   64.44 -  | apply_union int pos (tr :: trs) state =
   64.45 -      apply_union int pos trs state
   64.46 -        handle Runtime.UNDEF => apply_tr int pos tr state
   64.47 -          | FAILURE (alt_state, UNDEF) => apply_tr int pos tr alt_state
   64.48 +fun apply_union _ [] state = raise FAILURE (state, UNDEF)
   64.49 +  | apply_union int (tr :: trs) state =
   64.50 +      apply_union int trs state
   64.51 +        handle Runtime.UNDEF => apply_tr int tr state
   64.52 +          | FAILURE (alt_state, UNDEF) => apply_tr int tr alt_state
   64.53            | exn as FAILURE _ => raise exn
   64.54            | exn => raise FAILURE (state, exn);
   64.55  
   64.56  in
   64.57  
   64.58 -fun apply_trans int pos trs state = (apply_union int pos trs state, NONE)
   64.59 +fun apply_trans int trs state = (apply_union int trs state, NONE)
   64.60    handle FAILURE (alt_state, exn) => (alt_state, SOME exn) | exn => (state, SOME exn);
   64.61  
   64.62  end;
   64.63 @@ -562,14 +561,14 @@
   64.64  
   64.65  local
   64.66  
   64.67 -fun app int (tr as Transition {trans, pos, print, no_timing, ...}) =
   64.68 +fun app int (tr as Transition {trans, print, no_timing, ...}) =
   64.69    setmp_thread_position tr (fn state =>
   64.70      let
   64.71        fun do_timing f x = (warning (command_msg "" tr); timeap f x);
   64.72        fun do_profiling f x = profile (! profiling) f x;
   64.73  
   64.74        val (result, status) =
   64.75 -         state |> (apply_trans int pos trans
   64.76 +         state |> (apply_trans int trans
   64.77            |> (if ! profiling > 0 andalso not no_timing then do_profiling else I)
   64.78            |> (if ! profiling > 0 orelse ! timing andalso not no_timing then do_timing else I));
   64.79  
    65.1 --- a/src/Pure/Isar/value_parse.ML	Thu Oct 01 20:49:46 2009 +0200
    65.2 +++ b/src/Pure/Isar/value_parse.ML	Thu Oct 01 20:52:18 2009 +0200
    65.3 @@ -9,6 +9,7 @@
    65.4    val comma: 'a parser -> 'a parser
    65.5    val equal: 'a parser -> 'a parser
    65.6    val parens: 'a parser -> 'a parser
    65.7 +  val unit: unit parser
    65.8    val pair: 'a parser -> 'b parser -> ('a * 'b) parser
    65.9    val triple: 'a parser -> 'b parser -> 'c parser -> ('a * 'b * 'c) parser
   65.10    val list: 'a parser -> 'a list parser
    66.1 --- a/src/Pure/ML/ml_antiquote.ML	Thu Oct 01 20:49:46 2009 +0200
    66.2 +++ b/src/Pure/ML/ml_antiquote.ML	Thu Oct 01 20:52:18 2009 +0200
    66.3 @@ -41,7 +41,7 @@
    66.4      (Context.Proof ctxt, fn {background, ...} => (K ("", ""), background)))));
    66.5  
    66.6  fun inline name scan = ML_Context.add_antiq name
    66.7 -  (fn _ => scan >> (fn s => fn {struct_name, background} => (K ("", s), background)));
    66.8 +  (fn _ => scan >> (fn s => fn {background, ...} => (K ("", s), background)));
    66.9  
   66.10  fun declaration kind name scan = ML_Context.add_antiq name
   66.11    (fn _ => scan >> (fn s => fn {struct_name, background} =>
    67.1 --- a/src/Pure/Proof/extraction.ML	Thu Oct 01 20:49:46 2009 +0200
    67.2 +++ b/src/Pure/Proof/extraction.ML	Thu Oct 01 20:52:18 2009 +0200
    67.3 @@ -81,8 +81,7 @@
    67.4    {next = next - 1, rs = r :: rs, net = Net.insert_term (K false)
    67.5       (Envir.eta_contract lhs, (next, r)) net};
    67.6  
    67.7 -fun merge_rules
    67.8 -  ({next, rs = rs1, net} : rules) ({next = next2, rs = rs2, ...} : rules) =
    67.9 +fun merge_rules ({next, rs = rs1, net} : rules) ({rs = rs2, ...} : rules) =
   67.10    List.foldr add_rule {next = next, rs = rs1, net = net} (subtract (op =) rs1 rs2);
   67.11  
   67.12  fun condrew thy rules procs =
   67.13 @@ -141,7 +140,7 @@
   67.14    map_proof_terms (subst_TVars tye) (typ_subst_TVars tye);
   67.15  
   67.16  fun relevant_vars types prop = List.foldr (fn
   67.17 -      (Var ((a, i), T), vs) => (case strip_type T of
   67.18 +      (Var ((a, _), T), vs) => (case strip_type T of
   67.19          (_, Type (s, _)) => if member (op =) types s then a :: vs else vs
   67.20        | _ => vs)
   67.21      | (_, vs) => vs) [] (vars_of prop);
    68.1 --- a/src/Pure/ROOT.ML	Thu Oct 01 20:49:46 2009 +0200
    68.2 +++ b/src/Pure/ROOT.ML	Thu Oct 01 20:52:18 2009 +0200
    68.3 @@ -45,7 +45,6 @@
    68.4  use "General/long_name.ML";
    68.5  use "General/binding.ML";
    68.6  use "General/name_space.ML";
    68.7 -use "General/lazy.ML";
    68.8  use "General/path.ML";
    68.9  use "General/url.ML";
   68.10  use "General/buffer.ML";
   68.11 @@ -58,12 +57,17 @@
   68.12  
   68.13  use "Concurrent/simple_thread.ML";
   68.14  use "Concurrent/synchronized.ML";
   68.15 -if Multithreading.available then () else use "Concurrent/synchronized_dummy.ML";
   68.16 +if Multithreading.available then ()
   68.17 +else use "Concurrent/synchronized_sequential.ML";
   68.18  use "Concurrent/mailbox.ML";
   68.19  use "Concurrent/task_queue.ML";
   68.20  use "Concurrent/future.ML";
   68.21 +use "Concurrent/lazy.ML";
   68.22 +if Multithreading.available then ()
   68.23 +else use "Concurrent/lazy_sequential.ML";
   68.24  use "Concurrent/par_list.ML";
   68.25 -if Multithreading.available then () else use "Concurrent/par_list_dummy.ML";
   68.26 +if Multithreading.available then ()
   68.27 +else use "Concurrent/par_list_sequential.ML";
   68.28  
   68.29  
   68.30  (* fundamental structures *)
    69.1 --- a/src/Pure/Syntax/ast.ML	Thu Oct 01 20:49:46 2009 +0200
    69.2 +++ b/src/Pure/Syntax/ast.ML	Thu Oct 01 20:52:18 2009 +0200
    69.3 @@ -94,7 +94,7 @@
    69.4  
    69.5  (** check translation rules **)
    69.6  
    69.7 -fun rule_error (rule as (lhs, rhs)) =
    69.8 +fun rule_error (lhs, rhs) =
    69.9    let
   69.10      fun add_vars (Constant _) = I
   69.11        | add_vars (Variable x) = cons x
    70.1 --- a/src/Pure/Syntax/mixfix.ML	Thu Oct 01 20:49:46 2009 +0200
    70.2 +++ b/src/Pure/Syntax/mixfix.ML	Thu Oct 01 20:52:18 2009 +0200
    70.3 @@ -128,16 +128,6 @@
    70.4  
    70.5  fun const_mixfix c mx = (const_name mx c, fix_mixfix c mx);
    70.6  
    70.7 -fun map_mixfix _ NoSyn = NoSyn
    70.8 -  | map_mixfix f (Mixfix (sy, ps, p)) = Mixfix (f sy, ps, p)
    70.9 -  | map_mixfix f (Delimfix sy) = Delimfix (f sy)
   70.10 -  | map_mixfix f (InfixName (sy, p)) = InfixName (f sy, p)
   70.11 -  | map_mixfix f (InfixlName (sy, p)) = InfixlName (f sy, p)
   70.12 -  | map_mixfix f (InfixrName (sy, p)) = InfixrName (f sy, p)
   70.13 -  | map_mixfix f (Binder (sy, p, q)) = Binder (f sy, p, q)
   70.14 -  | map_mixfix _ Structure = Structure
   70.15 -  | map_mixfix _ _ = raise Fail ("map_mixfix: illegal occurrence of unnamed infix");
   70.16 -
   70.17  fun mixfix_args NoSyn = 0
   70.18    | mixfix_args (Mixfix (sy, _, _)) = SynExt.mfix_args sy
   70.19    | mixfix_args (Delimfix sy) = SynExt.mfix_args sy
    71.1 --- a/src/Pure/Syntax/syn_ext.ML	Thu Oct 01 20:49:46 2009 +0200
    71.2 +++ b/src/Pure/Syntax/syn_ext.ML	Thu Oct 01 20:52:18 2009 +0200
    71.3 @@ -270,9 +270,9 @@
    71.4      fun rem_pri (Argument (s, _)) = Argument (s, chain_pri)
    71.5        | rem_pri sym = sym;
    71.6  
    71.7 -    fun logify_types copy_prod (a as (Argument (s, p))) =
    71.8 +    fun logify_types (a as (Argument (s, p))) =
    71.9            if s <> "prop" andalso is_logtype s then Argument (logic, p) else a
   71.10 -      | logify_types _ a = a;
   71.11 +      | logify_types a = a;
   71.12  
   71.13  
   71.14      val raw_symbs = read_mfix sy handle ERROR msg => err_in_mfix msg mfix;
   71.15 @@ -305,7 +305,7 @@
   71.16        if convert andalso not copy_prod then
   71.17         (if lhs = "prop" then sprop else if is_logtype lhs then logic else lhs)
   71.18        else lhs;
   71.19 -    val symbs' = map (logify_types copy_prod) symbs;
   71.20 +    val symbs' = map logify_types symbs;
   71.21      val xprod = XProd (lhs', symbs', const', pri);
   71.22  
   71.23      val _ = (List.app check_pri pris; check_pri pri; check_blocks symbs');
    72.1 --- a/src/Pure/Syntax/syn_trans.ML	Thu Oct 01 20:49:46 2009 +0200
    72.2 +++ b/src/Pure/Syntax/syn_trans.ML	Thu Oct 01 20:52:18 2009 +0200
    72.3 @@ -155,20 +155,11 @@
    72.4    | bigimpl_ast_tr (*"_bigimpl"*) asts = raise Ast.AST ("bigimpl_ast_tr", asts);
    72.5  
    72.6  
    72.7 -(* meta conjunction *)
    72.8 -
    72.9 -fun conjunction_tr [t, u] = Lexicon.const "Pure.conjunction" $ t $ u
   72.10 -  | conjunction_tr ts = raise TERM ("conjunction_tr", ts);
   72.11 -
   72.12 -
   72.13  (* type/term reflection *)
   72.14  
   72.15  fun type_tr (*"_TYPE"*) [ty] = mk_type ty
   72.16    | type_tr (*"_TYPE"*) ts = raise TERM ("type_tr", ts);
   72.17  
   72.18 -fun term_tr [t] = Lexicon.const "Pure.term" $ t
   72.19 -  | term_tr ts = raise TERM ("term_tr", ts);
   72.20 -
   72.21  
   72.22  (* dddot *)
   72.23  
    73.1 --- a/src/Pure/Syntax/syntax.ML	Thu Oct 01 20:49:46 2009 +0200
    73.2 +++ b/src/Pure/Syntax/syntax.ML	Thu Oct 01 20:52:18 2009 +0200
    73.3 @@ -404,7 +404,7 @@
    73.4  
    73.5  fun pretty_gram (Syntax (tabs, _)) =
    73.6    let
    73.7 -    val {lexicon, prmodes, gram, prtabs, ...} = tabs;
    73.8 +    val {lexicon, prmodes, gram, ...} = tabs;
    73.9      val prmodes' = sort_strings (filter_out (fn s => s = "") prmodes);
   73.10    in
   73.11      [pretty_strs_qs "lexicon:" (Scan.dest_lexicon lexicon),
   73.12 @@ -639,7 +639,7 @@
   73.13  
   73.14  local
   73.15  
   73.16 -fun unparse_t t_to_ast prt_t markup ctxt (syn as Syntax (tabs, _)) curried t =
   73.17 +fun unparse_t t_to_ast prt_t markup ctxt (Syntax (tabs, _)) curried t =
   73.18    let
   73.19      val {print_trtab, print_ruletab, print_ast_trtab, tokentrtab, prtabs, ...} = tabs;
   73.20      val ast = t_to_ast ctxt (lookup_tr' print_trtab) t;
    74.1 --- a/src/Pure/Syntax/type_ext.ML	Thu Oct 01 20:49:46 2009 +0200
    74.2 +++ b/src/Pure/Syntax/type_ext.ML	Thu Oct 01 20:52:18 2009 +0200
    74.3 @@ -82,8 +82,8 @@
    74.4            if Lexicon.is_tid x then TFree (x, get_sort (x, ~1))
    74.5            else Type (x, [])
    74.6        | typ_of (Var (xi, _)) = TVar (xi, get_sort xi)
    74.7 -      | typ_of (Const ("_tfree",_) $ (t as Free x)) = typ_of t
    74.8 -      | typ_of (Const ("_tvar",_) $ (t as Var x)) = typ_of t
    74.9 +      | typ_of (Const ("_tfree",_) $ (t as Free _)) = typ_of t
   74.10 +      | typ_of (Const ("_tvar",_) $ (t as Var _)) = typ_of t
   74.11        | typ_of (Const ("_ofsort", _) $ Free (x, _) $ _) = TFree (x, get_sort (x, ~1))
   74.12        | typ_of (Const ("_ofsort", _) $ (Const ("_tfree",_) $ Free (x, _)) $ _) =
   74.13            TFree (x, get_sort (x, ~1))
    75.1 --- a/src/Pure/System/isabelle_process.ML	Thu Oct 01 20:49:46 2009 +0200
    75.2 +++ b/src/Pure/System/isabelle_process.ML	Thu Oct 01 20:52:18 2009 +0200
    75.3 @@ -133,6 +133,7 @@
    75.4   (Unsynchronized.change print_mode (update (op =) isabelle_processN);
    75.5    setup_channels out |> init_message;
    75.6    OuterKeyword.report ();
    75.7 +  Isar_Document.init ();
    75.8    Output.status (Markup.markup Markup.ready "");
    75.9    Isar.toplevel_loop {init = true, welcome = false, sync = true, secure = true});
   75.10  
    76.1 --- a/src/Pure/System/isar.ML	Thu Oct 01 20:49:46 2009 +0200
    76.2 +++ b/src/Pure/System/isar.ML	Thu Oct 01 20:52:18 2009 +0200
    76.3 @@ -48,7 +48,6 @@
    76.4    in edit count (! global_state, ! global_history) end);
    76.5  
    76.6  fun state () = NAMED_CRITICAL "Isar" (fn () => ! global_state);
    76.7 -fun set_state state = NAMED_CRITICAL "Isar" (fn () => global_state := state);
    76.8  
    76.9  fun exn () = NAMED_CRITICAL "Isar" (fn () => ! global_exn);
   76.10  fun set_exn exn =  NAMED_CRITICAL "Isar" (fn () => global_exn := exn);
    77.1 --- a/src/Pure/Thy/html.ML	Thu Oct 01 20:49:46 2009 +0200
    77.2 +++ b/src/Pure/Thy/html.ML	Thu Oct 01 20:52:18 2009 +0200
    77.3 @@ -222,7 +222,6 @@
    77.4      in (implode syms, width) end;
    77.5  
    77.6  val output = #1 o output_width;
    77.7 -val output_symbols = map #2 o output_syms;
    77.8  
    77.9  val _ = Output.add_mode htmlN output_width Symbol.encode_raw;
   77.10  
    78.1 --- a/src/Pure/Thy/thm_deps.ML	Thu Oct 01 20:49:46 2009 +0200
    78.2 +++ b/src/Pure/Thy/thm_deps.ML	Thu Oct 01 20:52:18 2009 +0200
    78.3 @@ -40,7 +40,7 @@
    78.4                 path = "",
    78.5                 parents = parents};
    78.6            in cons entry end;
    78.7 -    val deps = Proofterm.fold_body_thms (add_dep o #2) (map Thm.proof_body_of thms) [];
    78.8 +    val deps = Proofterm.fold_body_thms add_dep (map Thm.proof_body_of thms) [];
    78.9    in Present.display_graph (sort_wrt #ID deps) end;
   78.10  
   78.11  
   78.12 @@ -55,9 +55,10 @@
   78.13        fold (Facts.fold_static add_fact o PureThy.facts_of) thys []
   78.14        |> sort_distinct (string_ord o pairself #1);
   78.15  
   78.16 -    val tab = Proofterm.fold_body_thms
   78.17 -      (fn (_, (name, prop, _)) => name <> "" ? Symtab.insert_list (op =) (name, prop))
   78.18 -      (map (Proofterm.strip_thm o Thm.proof_body_of o snd) thms) Symtab.empty;
   78.19 +    val tab =
   78.20 +      Proofterm.fold_body_thms
   78.21 +        (fn (name, prop, _) => name <> "" ? Symtab.insert_list (op =) (name, prop))
   78.22 +        (map (Proofterm.strip_thm o Thm.proof_body_of o snd) thms) Symtab.empty;
   78.23      fun is_unused (name, th) =
   78.24        not (member (op aconv) (Symtab.lookup_list tab name) (Thm.prop_of th));
   78.25  
    79.1 --- a/src/Pure/Thy/thy_info.ML	Thu Oct 01 20:49:46 2009 +0200
    79.2 +++ b/src/Pure/Thy/thy_info.ML	Thu Oct 01 20:52:18 2009 +0200
    79.3 @@ -283,7 +283,7 @@
    79.4  
    79.5  local
    79.6  
    79.7 -fun provide path name info (deps as SOME {update_time, master, text, parents, files}) =
    79.8 +fun provide path name info (SOME {update_time, master, text, parents, files}) =
    79.9       (if AList.defined (op =) files path then ()
   79.10        else warning (loader_msg "undeclared dependency of theory" [name] ^
   79.11          " on file: " ^ quote (Path.implode path));
   79.12 @@ -338,7 +338,7 @@
   79.13  fun load_thy time upd_time initiators name =
   79.14    let
   79.15      val _ = priority ("Loading theory " ^ quote name ^ required_by " " initiators);
   79.16 -    val (pos, text, files) =
   79.17 +    val (pos, text, _) =
   79.18        (case get_deps name of
   79.19          SOME {master = SOME (master_path, _), text as _ :: _, files, ...} =>
   79.20            (Path.position master_path, text, files)
   79.21 @@ -364,7 +364,7 @@
   79.22  
   79.23  local
   79.24  
   79.25 -fun schedule_futures task_graph =
   79.26 +fun schedule_futures task_graph = uninterruptible (fn _ => fn () =>
   79.27    let
   79.28      val tasks = Graph.topological_order task_graph |> map_filter (fn name =>
   79.29        (case Graph.get_node task_graph name of Task body => SOME (name, body) | _ => NONE));
   79.30 @@ -397,7 +397,7 @@
   79.31          val _ = after_load ();
   79.32        in [] end handle exn => (kill_thy name; [exn]));
   79.33  
   79.34 -  in ignore (Exn.release_all (map Exn.Exn (rev exns))) end;
   79.35 +  in ignore (Exn.release_all (map Exn.Exn (rev exns))) end) ();
   79.36  
   79.37  fun schedule_seq tasks =
   79.38    Graph.topological_order tasks
   79.39 @@ -410,7 +410,7 @@
   79.40  
   79.41  in
   79.42  
   79.43 -fun schedule_tasks tasks n =
   79.44 +fun schedule_tasks tasks =
   79.45    if not (Multithreading.enabled ()) then schedule_seq tasks
   79.46    else if Multithreading.self_critical () then
   79.47       (warning (loader_msg "no multithreading within critical section" []);
   79.48 @@ -438,7 +438,7 @@
   79.49    | NONE =>
   79.50        let val {master, text, imports = parents, uses = files} = ThyLoad.deps_thy dir name
   79.51        in (false, init_deps (SOME master) text parents files, parents) end
   79.52 -  | SOME (deps as SOME {update_time, master, text, parents, files}) =>
   79.53 +  | SOME (SOME {update_time, master, text, parents, files}) =>
   79.54        let
   79.55          val (thy_path, thy_id) = ThyLoad.check_thy dir name;
   79.56          val master' = SOME (thy_path, thy_id);
   79.57 @@ -471,7 +471,7 @@
   79.58      val dir' = Path.append dir (Path.dir path);
   79.59      val _ = member (op =) initiators name andalso error (cycle_msg initiators);
   79.60    in
   79.61 -    (case try (Graph.get_node (fst tasks)) name of
   79.62 +    (case try (Graph.get_node tasks) name of
   79.63        SOME task => (task_finished task, tasks)
   79.64      | NONE =>
   79.65          let
   79.66 @@ -481,7 +481,7 @@
   79.67                  required_by "\n" initiators);
   79.68            val parent_names = map base_name parents;
   79.69  
   79.70 -          val (parents_current, (tasks_graph', tasks_len')) =
   79.71 +          val (parents_current, tasks_graph') =
   79.72              require_thys time (name :: initiators)
   79.73                (Path.append dir (master_dir' deps)) parents tasks;
   79.74  
   79.75 @@ -496,8 +496,7 @@
   79.76            val tasks_graph'' = tasks_graph' |> new_deps name parent_names
   79.77             (if all_current then Finished
   79.78              else Task (fn () => load_thy time upd_time initiators name));
   79.79 -          val tasks_len'' = if all_current then tasks_len' else tasks_len' + 1;
   79.80 -        in (all_current, (tasks_graph'', tasks_len'')) end)
   79.81 +        in (all_current, tasks_graph'') end)
   79.82    end;
   79.83  
   79.84  end;
   79.85 @@ -508,8 +507,7 @@
   79.86  local
   79.87  
   79.88  fun gen_use_thy' req dir arg =
   79.89 -  let val (_, (tasks, n)) = req [] dir arg (Graph.empty, 0)
   79.90 -  in schedule_tasks tasks n end;
   79.91 +  schedule_tasks (snd (req [] dir arg Graph.empty));
   79.92  
   79.93  fun gen_use_thy req str =
   79.94    let val name = base_name str in
    80.1 --- a/src/Pure/Thy/thy_load.ML	Thu Oct 01 20:49:46 2009 +0200
    80.2 +++ b/src/Pure/Thy/thy_load.ML	Thu Oct 01 20:52:18 2009 +0200
    80.3 @@ -73,7 +73,7 @@
    80.4  
    80.5  (* check files *)
    80.6  
    80.7 -fun check_ext exts paths dir src_path =
    80.8 +fun check_ext exts paths src_path =
    80.9    let
   80.10      val path = Path.expand src_path;
   80.11      val _ = Path.is_current path andalso error "Bad file specification";
   80.12 @@ -84,15 +84,15 @@
   80.13      fun try_prfx prfx = get_first (try_ext (Path.append prfx path)) ("" :: exts);
   80.14    in get_first try_prfx paths end;
   80.15  
   80.16 -fun check_file dir path = check_ext [] (search_path dir path) dir path;
   80.17 -fun check_ml dir path = check_ext ml_exts (search_path dir path) dir path;
   80.18 +fun check_file dir path = check_ext [] (search_path dir path) path;
   80.19 +fun check_ml dir path = check_ext ml_exts (search_path dir path) path;
   80.20  
   80.21  fun check_thy dir name =
   80.22    let
   80.23      val thy_file = thy_path name;
   80.24      val paths = search_path dir thy_file;
   80.25    in
   80.26 -    (case check_ext [] paths dir thy_file of
   80.27 +    (case check_ext [] paths thy_file of
   80.28        NONE => error ("Could not find theory file " ^ quote (Path.implode thy_file) ^
   80.29          " in " ^ commas_quote (map Path.implode paths))
   80.30      | SOME thy_id => thy_id)
    81.1 --- a/src/Pure/Tools/find_consts.ML	Thu Oct 01 20:49:46 2009 +0200
    81.2 +++ b/src/Pure/Tools/find_consts.ML	Thu Oct 01 20:52:18 2009 +0200
    81.3 @@ -107,7 +107,7 @@
    81.4                  val tye = Sign.typ_match thy (qty, ty) Vartab.empty;
    81.5                  val sub_size =
    81.6                    Vartab.fold (fn (_, (_, t)) => fn n => Term.size_of_typ t + n) tye 0;
    81.7 -              in SOME sub_size end handle MATCH => NONE
    81.8 +              in SOME sub_size end handle Type.TYPE_MATCH => NONE
    81.9            end
   81.10        | make_match (Loose arg) =
   81.11            check_const (matches_subtype thy (make_pattern arg) o snd)
    82.1 --- a/src/Pure/Tools/find_theorems.ML	Thu Oct 01 20:49:46 2009 +0200
    82.2 +++ b/src/Pure/Tools/find_theorems.ML	Thu Oct 01 20:52:18 2009 +0200
    82.3 @@ -76,18 +76,9 @@
    82.4  
    82.5  fun is_nontrivial thy = Term.is_Const o Term.head_of o ObjectLogic.drop_judgment thy;
    82.6  
    82.7 -(* Note: ("op =" : "bool --> bool --> bool") does not exist in Pure. *)
    82.8 -fun is_Iff c =
    82.9 -  (case dest_Const c of
   82.10 -     ("op =", ty) =>
   82.11 -       (ty
   82.12 -        |> strip_type
   82.13 -        |> swap
   82.14 -        |> (op ::)
   82.15 -        |> map (fst o dest_Type)
   82.16 -        |> forall (curry (op =) "bool")
   82.17 -        handle TYPE _ => false)
   82.18 -   | _ => false);
   82.19 +(*educated guesses on HOL*)  (* FIXME broken *)
   82.20 +val boolT = Type ("bool", []);
   82.21 +val iff_const = Const ("op =", boolT --> boolT --> boolT);
   82.22  
   82.23  (*extract terms from term_src, refine them to the parts that concern us,
   82.24    if po try match them against obj else vice versa.
   82.25 @@ -97,19 +88,20 @@
   82.26    let
   82.27      val thy = ProofContext.theory_of ctxt;
   82.28  
   82.29 -    val chkmatch = obj |> (if po then rpair else pair) #> Pattern.matches thy;
   82.30 +    fun check_match pat = Pattern.matches thy (if po then (pat, obj) else (obj, pat));
   82.31      fun matches pat =
   82.32        let
   82.33          val jpat = ObjectLogic.drop_judgment thy pat;
   82.34          val c = Term.head_of jpat;
   82.35          val pats =
   82.36            if Term.is_Const c
   82.37 -          then if doiff andalso is_Iff c
   82.38 -               then pat :: map (ObjectLogic.ensure_propT thy) ((snd o strip_comb) jpat)
   82.39 -                    |> filter (is_nontrivial thy)
   82.40 -               else [pat]
   82.41 +          then
   82.42 +            if doiff andalso c = iff_const then
   82.43 +              (pat :: map (ObjectLogic.ensure_propT thy) (snd (strip_comb jpat)))
   82.44 +                |> filter (is_nontrivial thy)
   82.45 +            else [pat]
   82.46            else [];
   82.47 -      in filter chkmatch pats end;
   82.48 +      in filter check_match pats end;
   82.49  
   82.50      fun substsize pat =
   82.51        let val (_, subst) =
   82.52 @@ -117,12 +109,11 @@
   82.53        in Vartab.fold (fn (_, (_, t)) => fn n => size_of_term t + n) subst 0 end;
   82.54  
   82.55      fun bestmatch [] = NONE
   82.56 -     |  bestmatch xs = SOME (foldr1 Int.min xs);
   82.57 +      | bestmatch xs = SOME (foldr1 Int.min xs);
   82.58  
   82.59      val match_thm = matches o refine_term;
   82.60    in
   82.61 -    map match_thm (extract_terms term_src)
   82.62 -    |> flat
   82.63 +    maps match_thm (extract_terms term_src)
   82.64      |> map substsize
   82.65      |> bestmatch
   82.66    end;
   82.67 @@ -178,8 +169,8 @@
   82.68          is_matching_thm false (single, I) ctxt true (goal_tree prem) rule_tree;
   82.69        val successful = prems |> map_filter try_subst;
   82.70      in
   82.71 -    (*elim rules always have assumptions, so an elim with one
   82.72 -      assumption is as good as an intro rule with none*)
   82.73 +      (*elim rules always have assumptions, so an elim with one
   82.74 +        assumption is as good as an intro rule with none*)
   82.75        if is_nontrivial (ProofContext.theory_of ctxt) (Thm.major_prem_of thm)
   82.76          andalso not (null successful)
   82.77        then SOME (Thm.nprems_of thm - 1, foldr1 Int.min successful) else NONE
   82.78 @@ -190,15 +181,13 @@
   82.79  
   82.80  fun filter_solves ctxt goal =
   82.81    let
   82.82 -    val baregoal = Logic.get_goal (Thm.prop_of goal) 1;
   82.83 -
   82.84      fun etacn thm i = Seq.take (! tac_limit) o etac thm i;
   82.85      fun try_thm thm =
   82.86        if Thm.no_prems thm then rtac thm 1 goal
   82.87        else (etacn thm THEN_ALL_NEW (Goal.norm_hhf_tac THEN' Method.assm_tac ctxt)) 1 goal;
   82.88    in
   82.89      fn (_, thm) =>
   82.90 -      if (is_some o Seq.pull o try_thm) thm
   82.91 +      if is_some (Seq.pull (try_thm thm))
   82.92        then SOME (Thm.nprems_of thm, 0) else NONE
   82.93    end;
   82.94  
   82.95 @@ -218,7 +207,7 @@
   82.96  
   82.97  (* filter_pattern *)
   82.98  
   82.99 -fun get_names t = (Term.add_const_names t []) union (Term.add_free_names t []);
  82.100 +fun get_names t = Term.add_const_names t (Term.add_free_names t []);
  82.101  fun get_thm_names (_, thm) = get_names (Thm.full_prop_of thm);
  82.102  
  82.103  (*Including all constants and frees is only sound because
  82.104 @@ -238,10 +227,9 @@
  82.105  
  82.106      fun check (t, NONE) = check (t, SOME (get_thm_names t))
  82.107        | check ((_, thm), c as SOME thm_consts) =
  82.108 -          (if pat_consts subset_string thm_consts
  82.109 -              andalso (Pattern.matches_subterm (ProofContext.theory_of ctxt)
  82.110 -                                               (pat, Thm.full_prop_of thm))
  82.111 -           then SOME (0, 0) else NONE, c);
  82.112 +         (if pat_consts subset_string thm_consts andalso
  82.113 +            Pattern.matches_subterm (ProofContext.theory_of ctxt) (pat, Thm.full_prop_of thm)
  82.114 +          then SOME (0, 0) else NONE, c);
  82.115    in check end;
  82.116  
  82.117  
  82.118 @@ -253,7 +241,6 @@
  82.119    error ("Current goal required for " ^ c ^ " search criterion");
  82.120  
  82.121  val fix_goal = Thm.prop_of;
  82.122 -val fix_goalo = Option.map fix_goal;
  82.123  
  82.124  fun filter_crit _ _ (Name name) = apfst (filter_name name)
  82.125    | filter_crit _ NONE Intro = err_no_goal "intro"
  82.126 @@ -276,7 +263,7 @@
  82.127  fun app_filters thm =
  82.128    let
  82.129      fun app (NONE, _, _) = NONE
  82.130 -      | app (SOME v, consts, []) = SOME (v, thm)
  82.131 +      | app (SOME v, _, []) = SOME (v, thm)
  82.132        | app (r, consts, f :: fs) =
  82.133            let val (r', consts') = f (thm, consts)
  82.134            in app (opt_add r r', consts', fs) end;
  82.135 @@ -439,6 +426,7 @@
  82.136    end;
  82.137  
  82.138  
  82.139 +
  82.140  (** command syntax **)
  82.141  
  82.142  fun find_theorems_cmd ((opt_lim, rem_dups), spec) =
    83.1 --- a/src/Pure/axclass.ML	Thu Oct 01 20:49:46 2009 +0200
    83.2 +++ b/src/Pure/axclass.ML	Thu Oct 01 20:52:18 2009 +0200
    83.3 @@ -150,7 +150,6 @@
    83.4    let val params = #2 (get_axclasses thy);
    83.5    in fold (fn (x, c) => if pred c then cons x else I) params [] end;
    83.6  
    83.7 -fun params_of thy c = get_params thy (fn c' => c' = c);
    83.8  fun all_params_of thy S = get_params thy (fn c => Sign.subsort thy (S, [c]));
    83.9  
   83.10  fun class_of_param thy = AList.lookup (op =) (#2 (get_axclasses thy));
   83.11 @@ -263,7 +262,8 @@
   83.12  
   83.13  fun unoverload_const thy (c_ty as (c, _)) =
   83.14    case class_of_param thy c
   83.15 -   of SOME class => (case get_inst_tyco (Sign.consts_of thy) c_ty
   83.16 +   of SOME class (* FIXME unused? *) =>
   83.17 +     (case get_inst_tyco (Sign.consts_of thy) c_ty
   83.18         of SOME tyco => try (param_of_inst thy) (c, tyco) |> the_default c
   83.19          | NONE => c)
   83.20      | NONE => c;
   83.21 @@ -585,7 +585,7 @@
   83.22          val hyps = vars
   83.23            |> map (fn (T, S) => (T, Thm.of_sort (certT T, S) ~~ S));
   83.24          val ths = (typ, sort)
   83.25 -          |> Sorts.of_sort_derivation (Syntax.pp_global thy) (Sign.classes_of thy)
   83.26 +          |> Sorts.of_sort_derivation (Sign.classes_of thy)
   83.27             {class_relation =
   83.28                fn (th, c1) => fn c2 => th RS the_classrel thy (c1, c2),
   83.29              type_constructor =
    84.1 --- a/src/Pure/consts.ML	Thu Oct 01 20:49:46 2009 +0200
    84.2 +++ b/src/Pure/consts.ML	Thu Oct 01 20:52:18 2009 +0200
    84.3 @@ -199,7 +199,7 @@
    84.4  
    84.5  fun subscript (Type (_, Ts)) (i :: is) = subscript (nth Ts i) is
    84.6    | subscript T [] = T
    84.7 -  | subscript T _ = raise Subscript;
    84.8 +  | subscript _ _ = raise Subscript;
    84.9  
   84.10  in
   84.11  
    85.1 --- a/src/Pure/context.ML	Thu Oct 01 20:49:46 2009 +0200
    85.2 +++ b/src/Pure/context.ML	Thu Oct 01 20:52:18 2009 +0200
    85.3 @@ -455,7 +455,7 @@
    85.4  
    85.5  fun init_proof thy = Prf (init_data thy, check_thy thy);
    85.6  
    85.7 -fun transfer_proof thy' (prf as Prf (data, thy_ref)) =
    85.8 +fun transfer_proof thy' (Prf (data, thy_ref)) =
    85.9    let
   85.10      val thy = deref thy_ref;
   85.11      val _ = subthy (thy, thy') orelse error "transfer proof context: not a super theory";
    86.1 --- a/src/Pure/defs.ML	Thu Oct 01 20:49:46 2009 +0200
    86.2 +++ b/src/Pure/defs.ML	Thu Oct 01 20:52:18 2009 +0200
    86.3 @@ -123,7 +123,7 @@
    86.4  fun contained (U as TVar _) (Type (_, Ts)) = exists (fn T => T = U orelse contained U T) Ts
    86.5    | contained _ _ = false;
    86.6  
    86.7 -fun acyclic pp defs (c, args) (d, Us) =
    86.8 +fun acyclic pp (c, args) (d, Us) =
    86.9    c <> d orelse
   86.10    exists (fn U => exists (contained U) args) Us orelse
   86.11    is_none (match_args (args, Us)) orelse
   86.12 @@ -150,7 +150,7 @@
   86.13        if forall (is_none o #1) reds then NONE
   86.14        else SOME (fold_rev
   86.15          (fn (NONE, dp) => insert (op =) dp | (SOME dps, _) => fold (insert (op =)) dps) reds []);
   86.16 -    val _ = forall (acyclic pp defs const) (the_default deps deps');
   86.17 +    val _ = forall (acyclic pp const) (the_default deps deps');
   86.18    in deps' end;
   86.19  
   86.20  in
   86.21 @@ -163,8 +163,7 @@
   86.22            (args, perhaps (reduction pp defs (c, args)) deps));
   86.23        in
   86.24          if reducts = reducts' then (changed, defs)
   86.25 -        else (true, defs |> map_def c (fn (specs, restricts, reducts) =>
   86.26 -          (specs, restricts, reducts')))
   86.27 +        else (true, defs |> map_def c (fn (specs, restricts, _) => (specs, restricts, reducts')))
   86.28        end;
   86.29      fun norm_all defs =
   86.30        (case Symtab.fold norm_update defs (false, defs) of
   86.31 @@ -206,7 +205,7 @@
   86.32    let
   86.33      val restr =
   86.34        if plain_args args orelse
   86.35 -        (case args of [Type (a, rec_args)] => plain_args rec_args | _ => false)
   86.36 +        (case args of [Type (_, rec_args)] => plain_args rec_args | _ => false)
   86.37        then [] else [(args, name)];
   86.38      val spec =
   86.39        (serial (), {is_def = is_def, name = name, lhs = args, rhs = deps});
    87.1 --- a/src/Pure/display.ML	Thu Oct 01 20:49:46 2009 +0200
    87.2 +++ b/src/Pure/display.ML	Thu Oct 01 20:52:18 2009 +0200
    87.3 @@ -177,7 +177,7 @@
    87.4      val axioms = (Theory.axiom_space thy, Theory.axiom_table thy);
    87.5      val defs = Theory.defs_of thy;
    87.6      val {restricts, reducts} = Defs.dest defs;
    87.7 -    val {naming, syn = _, tsig, consts} = Sign.rep_sg thy;
    87.8 +    val {naming = _, syn = _, tsig, consts} = Sign.rep_sg thy;
    87.9      val {constants, constraints} = Consts.dest consts;
   87.10      val extern_const = NameSpace.extern (#1 constants);
   87.11      val {classes, default, types, ...} = Type.rep_tsig tsig;
    88.1 --- a/src/Pure/envir.ML	Thu Oct 01 20:49:46 2009 +0200
    88.2 +++ b/src/Pure/envir.ML	Thu Oct 01 20:52:18 2009 +0200
    88.3 @@ -62,8 +62,8 @@
    88.4    tenv: tenv,           (*assignments to Vars*)
    88.5    tyenv: Type.tyenv};   (*assignments to TVars*)
    88.6  
    88.7 -fun make_env (maxidx, tenv, tyenv) = Envir {maxidx = maxidx, tenv = tenv, tyenv = tyenv};
    88.8 -fun map_env f (Envir {maxidx, tenv, tyenv}) = make_env (f (maxidx, tenv, tyenv));
    88.9 +fun make_env (maxidx, tenv, tyenv) =
   88.10 +  Envir {maxidx = maxidx, tenv = tenv, tyenv = tyenv};
   88.11  
   88.12  fun maxidx_of (Envir {maxidx, ...}) = maxidx;
   88.13  fun term_env (Envir {tenv, ...}) = tenv;
    89.1 --- a/src/Pure/goal.ML	Thu Oct 01 20:49:46 2009 +0200
    89.2 +++ b/src/Pure/goal.ML	Thu Oct 01 20:52:18 2009 +0200
    89.3 @@ -300,22 +300,22 @@
    89.4    | SOME st' => Seq.single st');
    89.5  
    89.6  (*parallel refinement of non-schematic goal by single results*)
    89.7 +exception FAILED of unit;
    89.8  fun PARALLEL_GOALS tac st =
    89.9    let
   89.10      val st0 = Thm.adjust_maxidx_thm ~1 st;
   89.11      val _ = Thm.maxidx_of st0 >= 0 andalso
   89.12        raise THM ("PARALLEL_GOALS: schematic goal state", 0, [st]);
   89.13  
   89.14 -    exception FAILED;
   89.15      fun try_tac g =
   89.16        (case SINGLE tac g of
   89.17 -        NONE => raise FAILED
   89.18 +        NONE => raise FAILED ()
   89.19        | SOME g' => g');
   89.20  
   89.21      val goals = Drule.strip_imp_prems (Thm.cprop_of st0);
   89.22      val results = Par_List.map (try_tac o init) goals;
   89.23    in ALLGOALS (fn i => retrofit i 1 (nth results (i - 1))) st0 end
   89.24 -  handle FAILED => Seq.empty;
   89.25 +  handle FAILED () => Seq.empty;
   89.26  
   89.27  end;
   89.28  
    90.1 --- a/src/Pure/logic.ML	Thu Oct 01 20:49:46 2009 +0200
    90.2 +++ b/src/Pure/logic.ML	Thu Oct 01 20:52:18 2009 +0200
    90.3 @@ -222,7 +222,7 @@
    90.4  fun mk_of_class (ty, c) =
    90.5    Const (const_of_class c, Term.itselfT ty --> propT) $ mk_type ty;
    90.6  
    90.7 -fun dest_of_class (t as Const (c_class, _) $ ty) = (dest_type ty, class_of_const c_class)
    90.8 +fun dest_of_class (Const (c_class, _) $ ty) = (dest_type ty, class_of_const c_class)
    90.9    | dest_of_class t = raise TERM ("dest_of_class", [t]);
   90.10  
   90.11  
    91.1 --- a/src/Pure/meta_simplifier.ML	Thu Oct 01 20:49:46 2009 +0200
    91.2 +++ b/src/Pure/meta_simplifier.ML	Thu Oct 01 20:52:18 2009 +0200
    91.3 @@ -229,11 +229,6 @@
    91.4  
    91.5  fun make_simpset (args1, args2) = Simpset (make_ss1 args1, make_ss2 args2);
    91.6  
    91.7 -fun map_simpset f (Simpset ({rules, prems, bounds, depth, context},
    91.8 -    {congs, procs, mk_rews, termless, subgoal_tac, loop_tacs, solvers})) =
    91.9 -  make_simpset (f ((rules, prems, bounds, depth, context),
   91.10 -    (congs, procs, mk_rews, termless, subgoal_tac, loop_tacs, solvers)));
   91.11 -
   91.12  fun map_simpset1 f (Simpset (r1, r2)) = Simpset (map_ss1 f r1, r2);
   91.13  fun map_simpset2 f (Simpset (r1, r2)) = Simpset (r1, map_ss2 f r2);
   91.14  
   91.15 @@ -388,7 +383,7 @@
   91.16      (Net.delete_term eq_rrule (term_of elhs, rrule) rules, prems, bounds, depth, context))
   91.17    handle Net.DELETE => (cond_warn_thm "Rewrite rule not in simpset:" ss thm; ss);
   91.18  
   91.19 -fun insert_rrule (rrule as {thm, name, elhs, ...}) ss =
   91.20 +fun insert_rrule (rrule as {thm, name, ...}) ss =
   91.21   (trace_named_thm (fn () => "Adding rewrite rule") ss (thm, name);
   91.22    ss |> map_simpset1 (fn (rules, prems, bounds, depth, context) =>
   91.23      let
   91.24 @@ -455,7 +450,6 @@
   91.25    | SOME eq_True =>
   91.26        let
   91.27          val (_, _, lhs, elhs, _, _) = decomp_simp eq_True;
   91.28 -        val extra = rrule_extra_vars elhs eq_True;
   91.29        in [{thm = eq_True, name = name, lhs = lhs, elhs = elhs, perm = false}] end);
   91.30  
   91.31  (*create the rewrite rule and possibly also the eq_True variant,
   91.32 @@ -869,7 +863,7 @@
   91.33    Otherwise those vars may become instantiated with unnormalized terms
   91.34    while the premises are solved.*)
   91.35  
   91.36 -fun cond_skel (args as (congs, (lhs, rhs))) =
   91.37 +fun cond_skel (args as (_, (lhs, rhs))) =
   91.38    if Term.add_vars rhs [] subset Term.add_vars lhs [] then uncond_skel args
   91.39    else skel0;
   91.40  
   91.41 @@ -892,8 +886,7 @@
   91.42      val eta_t = term_of eta_t';
   91.43      fun rew {thm, name, lhs, elhs, extra, fo, perm} =
   91.44        let
   91.45 -        val thy = Thm.theory_of_thm thm;
   91.46 -        val {prop, maxidx, ...} = rep_thm thm;
   91.47 +        val prop = Thm.prop_of thm;
   91.48          val (rthm, elhs') =
   91.49            if maxt = ~1 orelse not extra then (thm, elhs)
   91.50            else (Thm.incr_indexes (maxt + 1) thm, Thm.incr_indexes_cterm (maxt + 1) elhs);
   91.51 @@ -979,7 +972,7 @@
   91.52        (* Thm.match can raise Pattern.MATCH;
   91.53           is handled when congc is called *)
   91.54        val thm' = Thm.instantiate insts (Thm.rename_boundvars (term_of rlhs) (term_of t) rthm);
   91.55 -      val unit = trace_thm (fn () => "Applying congruence rule:") ss thm';
   91.56 +      val _ = trace_thm (fn () => "Applying congruence rule:") ss thm';
   91.57        fun err (msg, thm) = (trace_thm (fn () => msg) ss thm; NONE)
   91.58    in case prover thm' of
   91.59         NONE => err ("Congruence proof failed.  Could not prove", thm')
   91.60 @@ -1025,7 +1018,7 @@
   91.61  
   91.62      and subc skel (ss as Simpset ({bounds, ...}, {congs, ...})) t0 =
   91.63         (case term_of t0 of
   91.64 -           Abs (a, T, t) =>
   91.65 +           Abs (a, T, _) =>
   91.66               let
   91.67                   val b = Name.bound (#1 bounds);
   91.68                   val (v, t') = Thm.dest_abs (SOME b) t0;
   91.69 @@ -1124,7 +1117,7 @@
   91.70        end
   91.71  
   91.72      and rebuild [] _ _ _ _ eq = eq
   91.73 -      | rebuild (prem :: prems) concl (rrs :: rrss) (asm :: asms) ss eq =
   91.74 +      | rebuild (prem :: prems) concl (_ :: rrss) (_ :: asms) ss eq =
   91.75            let
   91.76              val ss' = add_rrules (rev rrss, rev asms) ss;
   91.77              val concl' =
   91.78 @@ -1231,7 +1224,7 @@
   91.79    let
   91.80      val thy = Thm.theory_of_cterm raw_ct;
   91.81      val ct = Thm.adjust_maxidx_cterm ~1 raw_ct;
   91.82 -    val {t, maxidx, ...} = Thm.rep_cterm ct;
   91.83 +    val {maxidx, ...} = Thm.rep_cterm ct;
   91.84      val ss = inc_simp_depth (activate_context thy raw_ss);
   91.85      val depth = simp_depth ss;
   91.86      val _ =
   91.87 @@ -1297,8 +1290,8 @@
   91.88  (* for folding definitions, handling critical pairs *)
   91.89  
   91.90  (*The depth of nesting in a term*)
   91.91 -fun term_depth (Abs(a,T,t)) = 1 + term_depth t
   91.92 -  | term_depth (f$t) = 1 + Int.max(term_depth f, term_depth t)
   91.93 +fun term_depth (Abs (_, _, t)) = 1 + term_depth t
   91.94 +  | term_depth (f $ t) = 1 + Int.max (term_depth f, term_depth t)
   91.95    | term_depth _ = 0;
   91.96  
   91.97  val lhs_of_thm = #1 o Logic.dest_equals o prop_of;
    92.1 --- a/src/Pure/proofterm.ML	Thu Oct 01 20:49:46 2009 +0200
    92.2 +++ b/src/Pure/proofterm.ML	Thu Oct 01 20:52:18 2009 +0200
    92.3 @@ -40,8 +40,7 @@
    92.4    val proof_of: proof_body -> proof
    92.5    val join_proof: proof_body future -> proof
    92.6    val fold_proof_atoms: bool -> (proof -> 'a -> 'a) -> proof list -> 'a -> 'a
    92.7 -  val fold_body_thms: (serial * (string * term * proof_body) -> 'a -> 'a) ->
    92.8 -    proof_body list -> 'a -> 'a
    92.9 +  val fold_body_thms: (string * term * proof_body -> 'a -> 'a) -> proof_body list -> 'a -> 'a
   92.10    val join_bodies: proof_body list -> unit
   92.11    val status_of: proof_body list -> {failed: bool, oracle: bool, unfinished: bool}
   92.12  
   92.13 @@ -110,7 +109,7 @@
   92.14    val axm_proof: string -> term -> proof
   92.15    val oracle_proof: string -> term -> oracle * proof
   92.16    val promise_proof: theory -> serial -> term -> proof
   92.17 -  val fulfill_proof: theory -> serial -> (serial * proof_body) list -> proof_body -> proof_body
   92.18 +  val fulfill_proof: theory -> (serial * proof_body) list -> proof_body -> proof_body
   92.19    val thm_proof: theory -> string -> term list -> term ->
   92.20      (serial * proof_body future) list -> proof_body -> pthm * proof
   92.21    val get_name: term list -> term -> proof -> string
   92.22 @@ -182,7 +181,7 @@
   92.23            let
   92.24              val body' = Future.join body;
   92.25              val (x', seen') = app body' (x, Inttab.update (i, ()) seen);
   92.26 -          in (f (i, (name, prop, body')) x', seen') end));
   92.27 +          in (f (name, prop, body') x', seen') end));
   92.28    in fn bodies => fn x => #1 (fold app bodies (x, Inttab.empty)) end;
   92.29  
   92.30  fun join_bodies bodies = fold_body_thms (fn _ => fn () => ()) bodies ();
   92.31 @@ -959,7 +958,7 @@
   92.32    if ! proofs = 0 then ((name, dummy), Oracle (name, dummy, NONE))
   92.33    else ((name, prop), gen_axm_proof Oracle name prop);
   92.34  
   92.35 -fun shrink_proof thy =
   92.36 +val shrink_proof =
   92.37    let
   92.38      fun shrink ls lev (prf as Abst (a, T, body)) =
   92.39            let val (b, is, ch, body') = shrink ls (lev+1) body
   92.40 @@ -1279,16 +1278,12 @@
   92.41          | _ => false));
   92.42    in Promise (i, prop, map TVar (Term.add_tvars prop [])) end;
   92.43  
   92.44 -fun fulfill_proof _ _ [] body0 = body0
   92.45 -  | fulfill_proof thy id ps body0 =
   92.46 +fun fulfill_proof _ [] body0 = body0
   92.47 +  | fulfill_proof thy ps body0 =
   92.48        let
   92.49          val PBody {oracles = oracles0, thms = thms0, proof = proof0} = body0;
   92.50 -        val bodies = map snd ps;
   92.51 -        val _ = fold_body_thms (fn (i, (name, _, _)) => fn () =>
   92.52 -          if i = id then error ("Cyclic reference to theorem " ^ quote name)
   92.53 -          else ()) bodies ();
   92.54 -        val oracles = fold (fn PBody {oracles, ...} => merge_oracles oracles) bodies oracles0;
   92.55 -        val thms = fold (fn PBody {thms, ...} => merge_thms thms) bodies thms0;
   92.56 +        val oracles = fold (fn (_, PBody {oracles, ...}) => merge_oracles oracles) ps oracles0;
   92.57 +        val thms = fold (fn (_, PBody {thms, ...}) => merge_thms thms) ps thms0;
   92.58          val proofs = fold (fn (i, PBody {proof, ...}) => Inttab.update (i, proof)) ps Inttab.empty;
   92.59  
   92.60          fun fill (Promise (i, prop, Ts)) =
   92.61 @@ -1300,18 +1295,18 @@
   92.62          val proof = rewrite_prf fst (rules, K fill :: procs) proof0;
   92.63        in PBody {oracles = oracles, thms = thms, proof = proof} end;
   92.64  
   92.65 -fun fulfill_proof_future _ _ [] body = Future.value body
   92.66 -  | fulfill_proof_future thy id promises body =
   92.67 +fun fulfill_proof_future _ [] body = Future.value body
   92.68 +  | fulfill_proof_future thy promises body =
   92.69        Future.fork_deps (map snd promises) (fn () =>
   92.70 -        fulfill_proof thy id (map (apsnd Future.join) promises) body);
   92.71 +        fulfill_proof thy (map (apsnd Future.join) promises) body);
   92.72  
   92.73  
   92.74  (***** theorems *****)
   92.75  
   92.76 -fun thm_proof thy name hyps prop promises body =
   92.77 +fun thm_proof thy name hyps concl promises body =
   92.78    let
   92.79      val PBody {oracles = oracles0, thms = thms0, proof = prf} = body;
   92.80 -    val prop = Logic.list_implies (hyps, prop);
   92.81 +    val prop = Logic.list_implies (hyps, concl);
   92.82      val nvs = needed_vars prop;
   92.83      val args = map (fn (v as Var (ixn, _)) =>
   92.84          if member (op =) nvs ixn then SOME v else NONE) (vars_of prop) @
   92.85 @@ -1319,13 +1314,11 @@
   92.86  
   92.87      val proof0 =
   92.88        if ! proofs = 2 then
   92.89 -        #4 (shrink_proof thy [] 0 (rew_proof thy (fold_rev implies_intr_proof hyps prf)))
   92.90 +        #4 (shrink_proof [] 0 (rew_proof thy (fold_rev implies_intr_proof hyps prf)))
   92.91        else MinProof;
   92.92      val body0 = PBody {oracles = oracles0, thms = thms0, proof = proof0};
   92.93  
   92.94 -    fun new_prf () =
   92.95 -      let val id = serial ()
   92.96 -      in (id, name, prop, fulfill_proof_future thy id promises body0) end;
   92.97 +    fun new_prf () = (serial (), name, prop, fulfill_proof_future thy promises body0);
   92.98      val (i, name, prop, body') =
   92.99        (case strip_combt (fst (strip_combP prf)) of
  92.100          (PThm (i, ((old_name, prop', NONE), body')), args') =>
    93.1 --- a/src/Pure/pure_thy.ML	Thu Oct 01 20:49:46 2009 +0200
    93.2 +++ b/src/Pure/pure_thy.ML	Thu Oct 01 20:52:18 2009 +0200
    93.3 @@ -239,7 +239,6 @@
    93.4  (*** Pure theory syntax and logical content ***)
    93.5  
    93.6  val typ = SimpleSyntax.read_typ;
    93.7 -val term = SimpleSyntax.read_term;
    93.8  val prop = SimpleSyntax.read_prop;
    93.9  
   93.10  val typeT = Syntax.typeT;
    94.1 --- a/src/Pure/sign.ML	Thu Oct 01 20:49:46 2009 +0200
    94.2 +++ b/src/Pure/sign.ML	Thu Oct 01 20:52:18 2009 +0200
    94.3 @@ -68,7 +68,6 @@
    94.4    val certify_typ_mode: Type.mode -> theory -> typ -> typ
    94.5    val certify': bool -> Pretty.pp -> bool -> Consts.T -> theory -> term -> term * typ * int
    94.6    val certify_term: theory -> term -> term * typ * int
    94.7 -  val certify_prop: theory -> term -> term * typ * int
    94.8    val cert_term: theory -> term -> term
    94.9    val cert_prop: theory -> term -> term
   94.10    val no_frees: Pretty.pp -> term -> term
   94.11 @@ -369,11 +368,9 @@
   94.12    in (if tm = tm'' then tm else tm'', T, Term.maxidx_of_term tm'') end;
   94.13  
   94.14  fun certify_term thy = certify' false (Syntax.pp_global thy) true (consts_of thy) thy;
   94.15 -fun certify_prop thy = certify' true (Syntax.pp_global thy) true (consts_of thy) thy;
   94.16 -
   94.17  fun cert_term_abbrev thy = #1 o certify' false (Syntax.pp_global thy) false (consts_of thy) thy;
   94.18  val cert_term = #1 oo certify_term;
   94.19 -val cert_prop = #1 oo certify_prop;
   94.20 +fun cert_prop thy = #1 o certify' true (Syntax.pp_global thy) true (consts_of thy) thy;
   94.21  
   94.22  end;
   94.23  
    95.1 --- a/src/Pure/simplifier.ML	Thu Oct 01 20:49:46 2009 +0200
    95.2 +++ b/src/Pure/simplifier.ML	Thu Oct 01 20:52:18 2009 +0200
    95.3 @@ -287,8 +287,6 @@
    95.4  
    95.5  val simpN = "simp";
    95.6  val congN = "cong";
    95.7 -val addN = "add";
    95.8 -val delN = "del";
    95.9  val onlyN = "only";
   95.10  val no_asmN = "no_asm";
   95.11  val no_asm_useN = "no_asm_use";
    96.1 --- a/src/Pure/sorts.ML	Thu Oct 01 20:49:46 2009 +0200
    96.2 +++ b/src/Pure/sorts.ML	Thu Oct 01 20:52:18 2009 +0200
    96.3 @@ -57,7 +57,7 @@
    96.4    val meet_sort_typ: algebra -> typ * sort -> typ -> typ   (*exception CLASS_ERROR*)
    96.5    val of_sort: algebra -> typ * sort -> bool
    96.6    val weaken: algebra -> ('a * class -> class -> 'a) -> 'a * class -> class -> 'a
    96.7 -  val of_sort_derivation: Pretty.pp -> algebra ->
    96.8 +  val of_sort_derivation: algebra ->
    96.9      {class_relation: 'a * class -> class -> 'a,
   96.10       type_constructor: string -> ('a * class) list list -> class -> 'a,
   96.11       type_variable: typ -> ('a * class) list} ->
   96.12 @@ -401,7 +401,7 @@
   96.13      | cs :: _ => path (x, cs))
   96.14    end;
   96.15  
   96.16 -fun of_sort_derivation pp algebra {class_relation, type_constructor, type_variable} =
   96.17 +fun of_sort_derivation algebra {class_relation, type_constructor, type_variable} =
   96.18    let
   96.19      val weaken = weaken algebra class_relation;
   96.20      val arities = arities_of algebra;
    97.1 --- a/src/Pure/term.ML	Thu Oct 01 20:49:46 2009 +0200
    97.2 +++ b/src/Pure/term.ML	Thu Oct 01 20:52:18 2009 +0200
    97.3 @@ -796,7 +796,7 @@
    97.4        let
    97.5          fun subst (Const (a, T)) = Const (a, typ_subst_TVars instT T)
    97.6            | subst (Free (a, T)) = Free (a, typ_subst_TVars instT T)
    97.7 -          | subst (t as Var (xi, T)) =
    97.8 +          | subst (Var (xi, T)) =
    97.9                (case AList.lookup (op =) inst xi of
   97.10                  NONE => Var (xi, typ_subst_TVars instT T)
   97.11                | SOME t => t)
    98.1 --- a/src/Pure/theory.ML	Thu Oct 01 20:49:46 2009 +0200
    98.2 +++ b/src/Pure/theory.ML	Thu Oct 01 20:52:18 2009 +0200
    98.3 @@ -94,7 +94,8 @@
    98.4    val empty = make_thy (NameSpace.empty_table, Defs.empty, ([], []));
    98.5    val copy = I;
    98.6  
    98.7 -  fun extend (Thy {axioms, defs, wrappers}) = make_thy (NameSpace.empty_table, defs, wrappers);
    98.8 +  fun extend (Thy {axioms = _, defs, wrappers}) =
    98.9 +    make_thy (NameSpace.empty_table, defs, wrappers);
   98.10  
   98.11    fun merge pp (thy1, thy2) =
   98.12      let
   98.13 @@ -155,7 +156,7 @@
   98.14  
   98.15  fun cert_axm thy (b, raw_tm) =
   98.16    let
   98.17 -    val (t, T, _) = Sign.certify_prop thy raw_tm
   98.18 +    val t = Sign.cert_prop thy raw_tm
   98.19        handle TYPE (msg, _, _) => error msg
   98.20          | TERM (msg, _) => error msg;
   98.21    in
    99.1 --- a/src/Pure/thm.ML	Thu Oct 01 20:49:46 2009 +0200
    99.2 +++ b/src/Pure/thm.ML	Thu Oct 01 20:52:18 2009 +0200
    99.3 @@ -181,7 +181,7 @@
    99.4      val sorts = Sorts.insert_typ T [];
    99.5    in Ctyp {thy_ref = Theory.check_thy thy, T = T, maxidx = maxidx, sorts = sorts} end;
    99.6  
    99.7 -fun dest_ctyp (Ctyp {thy_ref, T = Type (s, Ts), maxidx, sorts}) =
    99.8 +fun dest_ctyp (Ctyp {thy_ref, T = Type (_, Ts), maxidx, sorts}) =
    99.9        map (fn T => Ctyp {thy_ref = thy_ref, T = T, maxidx = maxidx, sorts = sorts}) Ts
   99.10    | dest_ctyp cT = raise TYPE ("dest_ctyp", [typ_of cT], []);
   99.11  
   99.12 @@ -218,31 +218,31 @@
   99.13      val sorts = Sorts.insert_term t [];
   99.14    in Cterm {thy_ref = Theory.check_thy thy, t = t, T = T, maxidx = maxidx, sorts = sorts} end;
   99.15  
   99.16 -fun merge_thys0 (Cterm {thy_ref = r1, t = t1, ...}) (Cterm {thy_ref = r2, t = t2, ...}) =
   99.17 +fun merge_thys0 (Cterm {thy_ref = r1, ...}) (Cterm {thy_ref = r2, ...}) =
   99.18    Theory.merge_refs (r1, r2);
   99.19  
   99.20  
   99.21  (* destructors *)
   99.22  
   99.23 -fun dest_comb (ct as Cterm {t = c $ a, T, thy_ref, maxidx, sorts}) =
   99.24 +fun dest_comb (Cterm {t = c $ a, T, thy_ref, maxidx, sorts}) =
   99.25        let val A = Term.argument_type_of c 0 in
   99.26          (Cterm {t = c, T = A --> T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts},
   99.27           Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts})
   99.28        end
   99.29    | dest_comb ct = raise CTERM ("dest_comb", [ct]);
   99.30  
   99.31 -fun dest_fun (ct as Cterm {t = c $ _, T, thy_ref, maxidx, sorts}) =
   99.32 +fun dest_fun (Cterm {t = c $ _, T, thy_ref, maxidx, sorts}) =
   99.33        let val A = Term.argument_type_of c 0
   99.34        in Cterm {t = c, T = A --> T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end
   99.35    | dest_fun ct = raise CTERM ("dest_fun", [ct]);
   99.36  
   99.37 -fun dest_arg (ct as Cterm {t = c $ a, T = _, thy_ref, maxidx, sorts}) =
   99.38 +fun dest_arg (Cterm {t = c $ a, T = _, thy_ref, maxidx, sorts}) =
   99.39        let val A = Term.argument_type_of c 0
   99.40        in Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end
   99.41    | dest_arg ct = raise CTERM ("dest_arg", [ct]);
   99.42  
   99.43  
   99.44 -fun dest_fun2 (Cterm {t = c $ a $ b, T, thy_ref, maxidx, sorts}) =
   99.45 +fun dest_fun2 (Cterm {t = c $ _ $ _, T, thy_ref, maxidx, sorts}) =
   99.46        let
   99.47          val A = Term.argument_type_of c 0;
   99.48          val B = Term.argument_type_of c 1;
   99.49 @@ -254,8 +254,7 @@
   99.50        in Cterm {t = a, T = A, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts} end
   99.51    | dest_arg1 ct = raise CTERM ("dest_arg1", [ct]);
   99.52  
   99.53 -fun dest_abs a (ct as
   99.54 -        Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), thy_ref, maxidx, sorts}) =
   99.55 +fun dest_abs a (Cterm {t = Abs (x, T, t), T = Type ("fun", [_, U]), thy_ref, maxidx, sorts}) =
   99.56        let val (y', t') = Term.dest_abs (the_default x a, T, t) in
   99.57          (Cterm {t = Free (y', T), T = T, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts},
   99.58            Cterm {t = t', T = U, thy_ref = thy_ref, maxidx = maxidx, sorts = sorts})
   99.59 @@ -392,10 +391,10 @@
   99.60  
   99.61  (* merge theories of cterms/thms -- trivial absorption only *)
   99.62  
   99.63 -fun merge_thys1 (Cterm {thy_ref = r1, ...}) (th as Thm (_, {thy_ref = r2, ...})) =
   99.64 +fun merge_thys1 (Cterm {thy_ref = r1, ...}) (Thm (_, {thy_ref = r2, ...})) =
   99.65    Theory.merge_refs (r1, r2);
   99.66  
   99.67 -fun merge_thys2 (th1 as Thm (_, {thy_ref = r1, ...})) (th2 as Thm (_, {thy_ref = r2, ...})) =
   99.68 +fun merge_thys2 (Thm (_, {thy_ref = r1, ...})) (Thm (_, {thy_ref = r2, ...})) =
   99.69    Theory.merge_refs (r1, r2);
   99.70  
   99.71  
   99.72 @@ -541,7 +540,7 @@
   99.73  fun raw_body (Thm (Deriv {body, ...}, _)) = body;
   99.74  
   99.75  fun fulfill_body (Thm (Deriv {promises, body}, {thy_ref, ...})) =
   99.76 -  Pt.fulfill_proof (Theory.deref thy_ref) ~1
   99.77 +  Pt.fulfill_proof (Theory.deref thy_ref)
   99.78      (map #1 promises ~~ fulfill_bodies (map #2 promises)) body
   99.79  and fulfill_bodies futures = map fulfill_body (Exn.release_all (Future.join_results futures));
   99.80  
   99.81 @@ -808,7 +807,7 @@
   99.82  (*Reflexivity
   99.83    t == t
   99.84  *)
   99.85 -fun reflexive (ct as Cterm {thy_ref, t, T, maxidx, sorts}) =
   99.86 +fun reflexive (Cterm {thy_ref, t, T = _, maxidx, sorts}) =
   99.87    Thm (deriv_rule0 Pt.reflexive,
   99.88     {thy_ref = thy_ref,
   99.89      tags = [],
   99.90 @@ -825,7 +824,7 @@
   99.91  *)
   99.92  fun symmetric (th as Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) =
   99.93    (case prop of
   99.94 -    (eq as Const ("==", Type (_, [T, _]))) $ t $ u =>
   99.95 +    (eq as Const ("==", _)) $ t $ u =>
   99.96        Thm (deriv_rule1 Pt.symmetric der,
   99.97         {thy_ref = thy_ref,
   99.98          tags = [],
   99.99 @@ -868,7 +867,7 @@
  99.100    (%x. t)(u) == t[u/x]
  99.101    fully beta-reduces the term if full = true
  99.102  *)
  99.103 -fun beta_conversion full (Cterm {thy_ref, t, T, maxidx, sorts}) =
  99.104 +fun beta_conversion full (Cterm {thy_ref, t, T = _, maxidx, sorts}) =
  99.105    let val t' =
  99.106      if full then Envir.beta_norm t
  99.107      else
  99.108 @@ -885,7 +884,7 @@
  99.109        prop = Logic.mk_equals (t, t')})
  99.110    end;
  99.111  
  99.112 -fun eta_conversion (Cterm {thy_ref, t, T, maxidx, sorts}) =
  99.113 +fun eta_conversion (Cterm {thy_ref, t, T = _, maxidx, sorts}) =
  99.114    Thm (deriv_rule0 Pt.reflexive,
  99.115     {thy_ref = thy_ref,
  99.116      tags = [],
  99.117 @@ -895,7 +894,7 @@
  99.118      tpairs = [],
  99.119      prop = Logic.mk_equals (t, Envir.eta_contract t)});
  99.120  
  99.121 -fun eta_long_conversion (Cterm {thy_ref, t, T, maxidx, sorts}) =
  99.122 +fun eta_long_conversion (Cterm {thy_ref, t, T = _, maxidx, sorts}) =
  99.123    Thm (deriv_rule0 Pt.reflexive,
  99.124     {thy_ref = thy_ref,
  99.125      tags = [],
  99.126 @@ -951,7 +950,7 @@
  99.127        prop = prop2, ...}) = th2;
  99.128      fun chktypes fT tT =
  99.129        (case fT of
  99.130 -        Type ("fun", [T1, T2]) =>
  99.131 +        Type ("fun", [T1, _]) =>
  99.132            if T1 <> tT then
  99.133              raise THM ("combination: types", 0, [th1, th2])
  99.134            else ()
  99.135 @@ -1264,7 +1263,7 @@
  99.136  val varifyT = #2 o varifyT' [];
  99.137  
  99.138  (* Replace all TVars by new TFrees *)
  99.139 -fun freezeT (Thm (der, {thy_ref, maxidx, shyps, hyps, tpairs, prop, ...})) =
  99.140 +fun freezeT (Thm (der, {thy_ref, shyps, hyps, tpairs, prop, ...})) =
  99.141    let
  99.142      val prop1 = attach_tpairs tpairs prop;
  99.143      val prop2 = Type.freeze prop1;
  99.144 @@ -1329,7 +1328,7 @@
  99.145  (*Solve subgoal Bi of proof state B1...Bn/C by assumption. *)
  99.146  fun assumption i state =
  99.147    let
  99.148 -    val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state;
  99.149 +    val Thm (der, {thy_ref, maxidx, shyps, hyps, ...}) = state;
  99.150      val thy = Theory.deref thy_ref;
  99.151      val (tpairs, Bs, Bi, C) = dest_state (state, i);
  99.152      fun newth n (env, tpairs) =
  99.153 @@ -1365,7 +1364,7 @@
  99.154    Checks if Bi's conclusion is alpha-convertible to one of its assumptions*)
  99.155  fun eq_assumption i state =
  99.156    let
  99.157 -    val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state;
  99.158 +    val Thm (der, {thy_ref, maxidx, shyps, hyps, ...}) = state;
  99.159      val (tpairs, Bs, Bi, C) = dest_state (state, i);
  99.160      val (_, asms, concl) = Logic.assum_problems (~1, Bi);
  99.161    in
  99.162 @@ -1386,7 +1385,7 @@
  99.163  (*For rotate_tac: fast rotation of assumptions of subgoal i*)
  99.164  fun rotate_rule k i state =
  99.165    let
  99.166 -    val Thm (der, {thy_ref, maxidx, shyps, hyps, prop, ...}) = state;
  99.167 +    val Thm (der, {thy_ref, maxidx, shyps, hyps, ...}) = state;
  99.168      val (tpairs, Bs, Bi, C) = dest_state (state, i);
  99.169      val params = Term.strip_all_vars Bi
  99.170      and rest   = Term.strip_all_body Bi;
  99.171 @@ -1558,7 +1557,7 @@
  99.172        in Term.all T' $ Abs (a, T', norm_term_skip env n t) end
  99.173    | norm_term_skip env n (Const ("==>", _) $ A $ B) =
  99.174        Logic.mk_implies (A, norm_term_skip env (n - 1) B)
  99.175 -  | norm_term_skip env n t = error "norm_term_skip: too few assumptions??";
  99.176 +  | norm_term_skip _ _ _ = error "norm_term_skip: too few assumptions??";
  99.177  
  99.178  
  99.179  (*Composition of object rule r=(A1...Am/B) with proof state s=(B1...Bn/C)
   100.1 --- a/src/Pure/type.ML	Thu Oct 01 20:49:46 2009 +0200
   100.2 +++ b/src/Pure/type.ML	Thu Oct 01 20:52:18 2009 +0200
   100.3 @@ -140,7 +140,7 @@
   100.4  fun cert_class (TSig {classes, ...}) = Sorts.certify_class (#2 classes);
   100.5  fun cert_sort (TSig {classes, ...}) = Sorts.certify_sort (#2 classes);
   100.6  
   100.7 -fun witness_sorts (tsig as TSig {classes, log_types, ...}) =
   100.8 +fun witness_sorts (TSig {classes, log_types, ...}) =
   100.9    Sorts.witness_sorts (#2 classes) log_types;
  100.10  
  100.11  
  100.12 @@ -280,7 +280,7 @@
  100.13      val used = Name.context
  100.14        |> fold_types (fold_atyps (fn TVar ((a, _), _) => Name.declare a | _ => I)) t;
  100.15      val fmap = fs ~~ map (rpair 0) (#1 (Name.variants (map fst fs) used));
  100.16 -    fun thaw (f as (a, S)) =
  100.17 +    fun thaw (f as (_, S)) =
  100.18        (case AList.lookup (op =) fmap f of
  100.19          NONE => TFree f
  100.20        | SOME xi => TVar (xi, S));
  100.21 @@ -412,10 +412,10 @@
  100.22        (case lookup tye v of
  100.23          SOME U => devar tye U
  100.24        | NONE => T)
  100.25 -  | devar tye T = T;
  100.26 +  | devar _ T = T;
  100.27  
  100.28  (*order-sorted unification*)
  100.29 -fun unify (tsig as TSig {classes = (_, classes), ...}) TU (tyenv, maxidx) =
  100.30 +fun unify (TSig {classes = (_, classes), ...}) TU (tyenv, maxidx) =
  100.31    let
  100.32      val tyvar_count = Unsynchronized.ref maxidx;
  100.33      fun gen_tyvar S = TVar ((Name.aT, Unsynchronized.inc tyvar_count), S);
  100.34 @@ -465,7 +465,7 @@
  100.35  (*purely structural unification*)
  100.36  fun raw_unify (ty1, ty2) tye =
  100.37    (case (devar tye ty1, devar tye ty2) of
  100.38 -    (T as TVar (v, S1), U as TVar (w, S2)) =>
  100.39 +    (T as TVar (v, S1), TVar (w, S2)) =>
  100.40        if Term.eq_ix (v, w) then
  100.41          if S1 = S2 then tye else tvar_clash v S1 S2
  100.42        else Vartab.update_new (w, (S2, T)) tye
  100.43 @@ -545,7 +545,7 @@
  100.44      let
  100.45        val rel' = pairself (cert_class tsig) rel
  100.46          handle TYPE (msg, _, _) => error msg;
  100.47 -      val classes' = classes |> Sorts.add_classrel pp rel;
  100.48 +      val classes' = classes |> Sorts.add_classrel pp rel';
  100.49      in ((space, classes'), default, types) end);
  100.50  
  100.51  
   101.1 --- a/src/Pure/variable.ML	Thu Oct 01 20:49:46 2009 +0200
   101.2 +++ b/src/Pure/variable.ML	Thu Oct 01 20:52:18 2009 +0200
   101.3 @@ -89,7 +89,7 @@
   101.4  structure Data = ProofDataFun
   101.5  (
   101.6    type T = data;
   101.7 -  fun init thy =
   101.8 +  fun init _ =
   101.9      make_data (false, Name.context, Symtab.empty, [], Vartab.empty, Symtab.empty,
  101.10        ~1, [], (Vartab.empty, Vartab.empty));
  101.11  );
   102.1 --- a/src/Tools/Code/code_preproc.ML	Thu Oct 01 20:49:46 2009 +0200
   102.2 +++ b/src/Tools/Code/code_preproc.ML	Thu Oct 01 20:52:18 2009 +0200
   102.3 @@ -403,7 +403,7 @@
   102.4          @ (maps o maps) fst xs;
   102.5      fun type_variable (TFree (_, sort)) = map (pair []) (proj_sort sort);
   102.6    in
   102.7 -    flat (Sorts.of_sort_derivation (Syntax.pp_global thy) algebra
   102.8 +    flat (Sorts.of_sort_derivation algebra
   102.9        { class_relation = class_relation, type_constructor = type_constructor,
  102.10          type_variable = type_variable } (T, proj_sort sort)
  102.11         handle Sorts.CLASS_ERROR _ => [] (*permissive!*))
   103.1 --- a/src/Tools/Code/code_thingol.ML	Thu Oct 01 20:49:46 2009 +0200
   103.2 +++ b/src/Tools/Code/code_thingol.ML	Thu Oct 01 20:52:18 2009 +0200
   103.3 @@ -750,7 +750,6 @@
   103.4    #>> (fn sort => (unprefix "'" v, sort))
   103.5  and translate_dicts thy (algbr as (proj_sort, algebra)) funcgr thm (ty, sort) =
   103.6    let
   103.7 -    val pp = Syntax.pp_global thy;
   103.8      datatype typarg =
   103.9          Global of (class * string) * typarg list list
  103.10        | Local of (class * class) list * (string * (int * sort));
  103.11 @@ -764,7 +763,7 @@
  103.12        let
  103.13          val sort' = proj_sort sort;
  103.14        in map_index (fn (n, class) => (Local ([], (v, (n, sort'))), class)) sort' end;
  103.15 -    val typargs = Sorts.of_sort_derivation pp algebra
  103.16 +    val typargs = Sorts.of_sort_derivation algebra
  103.17        {class_relation = class_relation, type_constructor = type_constructor,
  103.18         type_variable = type_variable} (ty, proj_sort sort)
  103.19        handle Sorts.CLASS_ERROR e => not_wellsorted thy thm ty sort e;
   104.1 --- a/src/Tools/Code/lib/Tools/codegen	Thu Oct 01 20:49:46 2009 +0200
   104.2 +++ b/src/Tools/Code/lib/Tools/codegen	Thu Oct 01 20:52:18 2009 +0200
   104.3 @@ -60,6 +60,6 @@
   104.4  
   104.5  CTXT_CMD="ML_Context.eval_in (SOME (ProofContext.init (theory \"HOL\"))) false Position.none \"Code_Target.shell_command thyname cmd\";"
   104.6  
   104.7 -FULL_CMD="$QND_CMD quick_and_dirty; val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD"
   104.8 +FULL_CMD="Unsynchronized.$QND_CMD quick_and_dirty; val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD"
   104.9  
  104.10  "$ISABELLE" -q -e "$FULL_CMD" "$IMAGE" || exit 1
   105.1 --- a/src/Tools/more_conv.ML	Thu Oct 01 20:49:46 2009 +0200
   105.2 +++ b/src/Tools/more_conv.ML	Thu Oct 01 20:52:18 2009 +0200
   105.3 @@ -46,16 +46,18 @@
   105.4    Conv.arg_conv (Conv.abs_conv (fn (_, cx) => cv cx) ctxt)
   105.5  
   105.6  
   105.7 -fun cache_conv conv =   (* FIXME not thread-safe *)
   105.8 -  let 
   105.9 -    val tab = Unsynchronized.ref Termtab.empty
  105.10 -    fun add_result t thm =
  105.11 -      let val _ = Unsynchronized.change tab (Termtab.insert Thm.eq_thm (t, thm))
  105.12 -      in thm end
  105.13 -    fun cconv ct =  
  105.14 -      (case Termtab.lookup (!tab) (Thm.term_of ct) of
  105.15 +fun cache_conv conv =
  105.16 +  let
  105.17 +    val cache = Synchronized.var "cache_conv" Termtab.empty
  105.18 +    fun lookup t =
  105.19 +      Synchronized.change_result cache (fn tab => (Termtab.lookup tab t, tab))
  105.20 +    val keep = Synchronized.change cache o Termtab.insert Thm.eq_thm
  105.21 +    fun keep_result t thm = (keep (t, thm); thm)
  105.22 +
  105.23 +    fun cconv ct =
  105.24 +      (case lookup (Thm.term_of ct) of
  105.25          SOME thm => thm
  105.26 -      | NONE => add_result (Thm.term_of ct) (conv ct))
  105.27 +      | NONE => keep_result (Thm.term_of ct) (conv ct))
  105.28    in cconv end
  105.29  
  105.30  end