Merge.
1.1 --- a/doc-src/IsarImplementation/Thy/ML.thy Wed Mar 04 10:43:39 2009 +0100
1.2 +++ b/doc-src/IsarImplementation/Thy/ML.thy Wed Mar 04 10:45:52 2009 +0100
1.3 @@ -1,6 +1,6 @@
1.4 -(* $Id$ *)
1.5 -
1.6 -theory "ML" imports base begin
1.7 +theory "ML"
1.8 +imports Base
1.9 +begin
1.10
1.11 chapter {* Advanced ML programming *}
1.12
2.1 --- a/doc-src/IsarImplementation/Thy/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
2.2 +++ b/doc-src/IsarImplementation/Thy/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
2.3 @@ -1,11 +1,11 @@
2.4 -
2.5 -(* $Id$ *)
2.6 -
2.7 -use_thy "prelim";
2.8 -use_thy "logic";
2.9 -use_thy "tactic";
2.10 -use_thy "proof";
2.11 -use_thy "isar";
2.12 -use_thy "locale";
2.13 -use_thy "integration";
2.14 -use_thy "ML";
2.15 +use_thys [
2.16 + "Integration",
2.17 + "Isar",
2.18 + "Local_Theory",
2.19 + "Logic",
2.20 + "ML",
2.21 + "Prelim",
2.22 + "Proof",
2.23 + "Syntax",
2.24 + "Tactic"
2.25 +];
3.1 --- a/doc-src/IsarImplementation/Thy/document/ML.tex Wed Mar 04 10:43:39 2009 +0100
3.2 +++ b/doc-src/IsarImplementation/Thy/document/ML.tex Wed Mar 04 10:45:52 2009 +0100
3.3 @@ -3,14 +3,14 @@
3.4 \def\isabellecontext{ML}%
3.5 %
3.6 \isadelimtheory
3.7 -\isanewline
3.8 -\isanewline
3.9 %
3.10 \endisadelimtheory
3.11 %
3.12 \isatagtheory
3.13 \isacommand{theory}\isamarkupfalse%
3.14 -\ {\isachardoublequoteopen}ML{\isachardoublequoteclose}\ \isakeyword{imports}\ base\ \isakeyword{begin}%
3.15 +\ {\isachardoublequoteopen}ML{\isachardoublequoteclose}\isanewline
3.16 +\isakeyword{imports}\ Base\isanewline
3.17 +\isakeyword{begin}%
3.18 \endisatagtheory
3.19 {\isafoldtheory}%
3.20 %
3.21 @@ -275,9 +275,9 @@
3.22 %
3.23 \begin{isamarkuptext}%
3.24 \begin{mldecls}
3.25 - \indexml{NAMED\_CRITICAL}\verb|NAMED_CRITICAL: string -> (unit -> 'a) -> 'a| \\
3.26 - \indexml{CRITICAL}\verb|CRITICAL: (unit -> 'a) -> 'a| \\
3.27 - \indexml{setmp}\verb|setmp: 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
3.28 + \indexdef{}{ML}{NAMED\_CRITICAL}\verb|NAMED_CRITICAL: string -> (unit -> 'a) -> 'a| \\
3.29 + \indexdef{}{ML}{CRITICAL}\verb|CRITICAL: (unit -> 'a) -> 'a| \\
3.30 + \indexdef{}{ML}{setmp}\verb|setmp: 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c| \\
3.31 \end{mldecls}
3.32
3.33 \begin{description}
3.34 @@ -331,7 +331,7 @@
3.35 %
3.36 \begin{isamarkuptext}%
3.37 \begin{mldecls}
3.38 - \indexml{op |$>$ }\verb|op |\verb,|,\verb|> : 'a * ('a -> 'b) -> 'b| \\
3.39 + \indexdef{}{ML}{op $\mid$$>$ }\verb|op |\verb,|,\verb|> : 'a * ('a -> 'b) -> 'b| \\
3.40 \end{mldecls}%
3.41 \end{isamarkuptext}%
3.42 \isamarkuptrue%
3.43 @@ -410,10 +410,10 @@
3.44 %
3.45 \begin{isamarkuptext}%
3.46 \begin{mldecls}
3.47 - \indexml{op |-$>$ }\verb|op |\verb,|,\verb|-> : ('c * 'a) * ('c -> 'a -> 'b) -> 'b| \\
3.48 - \indexml{op |$>$$>$ }\verb|op |\verb,|,\verb|>> : ('a * 'c) * ('a -> 'b) -> 'b * 'c| \\
3.49 - \indexml{op ||$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|> : ('c * 'a) * ('a -> 'b) -> 'c * 'b| \\
3.50 - \indexml{op ||$>$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|>> : ('c * 'a) * ('a -> 'd * 'b) -> ('c * 'd) * 'b| \\
3.51 + \indexdef{}{ML}{op $\mid$-$>$ }\verb|op |\verb,|,\verb|-> : ('c * 'a) * ('c -> 'a -> 'b) -> 'b| \\
3.52 + \indexdef{}{ML}{op $\mid$$>$$>$ }\verb|op |\verb,|,\verb|>> : ('a * 'c) * ('a -> 'b) -> 'b * 'c| \\
3.53 + \indexdef{}{ML}{op $\mid$$\mid$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|> : ('c * 'a) * ('a -> 'b) -> 'c * 'b| \\
3.54 + \indexdef{}{ML}{op $\mid$$\mid$$>$$>$ }\verb|op |\verb,|,\verb||\verb,|,\verb|>> : ('c * 'a) * ('a -> 'd * 'b) -> ('c * 'd) * 'b| \\
3.55 \end{mldecls}%
3.56 \end{isamarkuptext}%
3.57 \isamarkuptrue%
3.58 @@ -483,8 +483,8 @@
3.59 %
3.60 \begin{isamarkuptext}%
3.61 \begin{mldecls}
3.62 - \indexml{fold}\verb|fold: ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b| \\
3.63 - \indexml{fold\_map}\verb|fold_map: ('a -> 'b -> 'c * 'b) -> 'a list -> 'b -> 'c list * 'b| \\
3.64 + \indexdef{}{ML}{fold}\verb|fold: ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b| \\
3.65 + \indexdef{}{ML}{fold\_map}\verb|fold_map: ('a -> 'b -> 'c * 'b) -> 'a list -> 'b -> 'c list * 'b| \\
3.66 \end{mldecls}%
3.67 \end{isamarkuptext}%
3.68 \isamarkuptrue%
3.69 @@ -545,11 +545,11 @@
3.70 %
3.71 \begin{isamarkuptext}%
3.72 \begin{mldecls}
3.73 - \indexml{op \#$>$ }\verb|op #> : ('a -> 'b) * ('b -> 'c) -> 'a -> 'c| \\
3.74 - \indexml{op \#-$>$ }\verb|op #-> : ('a -> 'c * 'b) * ('c -> 'b -> 'd) -> 'a -> 'd| \\
3.75 - \indexml{op \#$>$$>$ }\verb|op #>> : ('a -> 'c * 'b) * ('c -> 'd) -> 'a -> 'd * 'b| \\
3.76 - \indexml{op \#\#$>$ }\verb|op ##> : ('a -> 'c * 'b) * ('b -> 'd) -> 'a -> 'c * 'd| \\
3.77 - \indexml{op \#\#$>$$>$ }\verb|op ##>> : ('a -> 'c * 'b) * ('b -> 'e * 'd) -> 'a -> ('c * 'e) * 'd| \\
3.78 + \indexdef{}{ML}{op \#$>$ }\verb|op #> : ('a -> 'b) * ('b -> 'c) -> 'a -> 'c| \\
3.79 + \indexdef{}{ML}{op \#-$>$ }\verb|op #-> : ('a -> 'c * 'b) * ('c -> 'b -> 'd) -> 'a -> 'd| \\
3.80 + \indexdef{}{ML}{op \#$>$$>$ }\verb|op #>> : ('a -> 'c * 'b) * ('c -> 'd) -> 'a -> 'd * 'b| \\
3.81 + \indexdef{}{ML}{op \#\#$>$ }\verb|op ##> : ('a -> 'c * 'b) * ('b -> 'd) -> 'a -> 'c * 'd| \\
3.82 + \indexdef{}{ML}{op \#\#$>$$>$ }\verb|op ##>> : ('a -> 'c * 'b) * ('b -> 'e * 'd) -> 'a -> ('c * 'e) * 'd| \\
3.83 \end{mldecls}%
3.84 \end{isamarkuptext}%
3.85 \isamarkuptrue%
3.86 @@ -576,8 +576,8 @@
3.87 %
3.88 \begin{isamarkuptext}%
3.89 \begin{mldecls}
3.90 - \indexml{op ` }\verb|op ` : ('b -> 'a) -> 'b -> 'a * 'b| \\
3.91 - \indexml{tap}\verb|tap: ('b -> 'a) -> 'b -> 'b| \\
3.92 + \indexdef{}{ML}{op ` }\verb|op ` : ('b -> 'a) -> 'b -> 'a * 'b| \\
3.93 + \indexdef{}{ML}{tap}\verb|tap: ('b -> 'a) -> 'b -> 'b| \\
3.94 \end{mldecls}%
3.95 \end{isamarkuptext}%
3.96 \isamarkuptrue%
3.97 @@ -619,14 +619,14 @@
3.98 %
3.99 \begin{isamarkuptext}%
3.100 \begin{mldecls}
3.101 - \indexml{is\_some}\verb|is_some: 'a option -> bool| \\
3.102 - \indexml{is\_none}\verb|is_none: 'a option -> bool| \\
3.103 - \indexml{the}\verb|the: 'a option -> 'a| \\
3.104 - \indexml{these}\verb|these: 'a list option -> 'a list| \\
3.105 - \indexml{the\_list}\verb|the_list: 'a option -> 'a list| \\
3.106 - \indexml{the\_default}\verb|the_default: 'a -> 'a option -> 'a| \\
3.107 - \indexml{try}\verb|try: ('a -> 'b) -> 'a -> 'b option| \\
3.108 - \indexml{can}\verb|can: ('a -> 'b) -> 'a -> bool| \\
3.109 + \indexdef{}{ML}{is\_some}\verb|is_some: 'a option -> bool| \\
3.110 + \indexdef{}{ML}{is\_none}\verb|is_none: 'a option -> bool| \\
3.111 + \indexdef{}{ML}{the}\verb|the: 'a option -> 'a| \\
3.112 + \indexdef{}{ML}{these}\verb|these: 'a list option -> 'a list| \\
3.113 + \indexdef{}{ML}{the\_list}\verb|the_list: 'a option -> 'a list| \\
3.114 + \indexdef{}{ML}{the\_default}\verb|the_default: 'a -> 'a option -> 'a| \\
3.115 + \indexdef{}{ML}{try}\verb|try: ('a -> 'b) -> 'a -> 'b option| \\
3.116 + \indexdef{}{ML}{can}\verb|can: ('a -> 'b) -> 'a -> bool| \\
3.117 \end{mldecls}%
3.118 \end{isamarkuptext}%
3.119 \isamarkuptrue%
3.120 @@ -659,10 +659,10 @@
3.121 %
3.122 \begin{isamarkuptext}%
3.123 \begin{mldecls}
3.124 - \indexml{member}\verb|member: ('b * 'a -> bool) -> 'a list -> 'b -> bool| \\
3.125 - \indexml{insert}\verb|insert: ('a * 'a -> bool) -> 'a -> 'a list -> 'a list| \\
3.126 - \indexml{remove}\verb|remove: ('b * 'a -> bool) -> 'b -> 'a list -> 'a list| \\
3.127 - \indexml{merge}\verb|merge: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list| \\
3.128 + \indexdef{}{ML}{member}\verb|member: ('b * 'a -> bool) -> 'a list -> 'b -> bool| \\
3.129 + \indexdef{}{ML}{insert}\verb|insert: ('a * 'a -> bool) -> 'a -> 'a list -> 'a list| \\
3.130 + \indexdef{}{ML}{remove}\verb|remove: ('b * 'a -> bool) -> 'b -> 'a list -> 'a list| \\
3.131 + \indexdef{}{ML}{merge}\verb|merge: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list| \\
3.132 \end{mldecls}%
3.133 \end{isamarkuptext}%
3.134 \isamarkuptrue%
3.135 @@ -690,19 +690,19 @@
3.136 %
3.137 \begin{isamarkuptext}%
3.138 \begin{mldecls}
3.139 - \indexmlexception{AList.DUP}\verb|exception AList.DUP| \\
3.140 - \indexml{AList.lookup}\verb|AList.lookup: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> 'c option| \\
3.141 - \indexml{AList.defined}\verb|AList.defined: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> bool| \\
3.142 - \indexml{AList.update}\verb|AList.update: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
3.143 - \indexml{AList.default}\verb|AList.default: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
3.144 - \indexml{AList.delete}\verb|AList.delete: ('a * 'b -> bool) -> 'a -> ('b * 'c) list -> ('b * 'c) list| \\
3.145 - \indexml{AList.map\_entry}\verb|AList.map_entry: ('a * 'b -> bool) -> 'a|\isasep\isanewline%
3.146 + \indexdef{}{ML exception}{AList.DUP}\verb|exception AList.DUP| \\
3.147 + \indexdef{}{ML}{AList.lookup}\verb|AList.lookup: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> 'c option| \\
3.148 + \indexdef{}{ML}{AList.defined}\verb|AList.defined: ('a * 'b -> bool) -> ('b * 'c) list -> 'a -> bool| \\
3.149 + \indexdef{}{ML}{AList.update}\verb|AList.update: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
3.150 + \indexdef{}{ML}{AList.default}\verb|AList.default: ('a * 'a -> bool) -> ('a * 'b) -> ('a * 'b) list -> ('a * 'b) list| \\
3.151 + \indexdef{}{ML}{AList.delete}\verb|AList.delete: ('a * 'b -> bool) -> 'a -> ('b * 'c) list -> ('b * 'c) list| \\
3.152 + \indexdef{}{ML}{AList.map\_entry}\verb|AList.map_entry: ('a * 'b -> bool) -> 'a|\isasep\isanewline%
3.153 \verb| -> ('c -> 'c) -> ('b * 'c) list -> ('b * 'c) list| \\
3.154 - \indexml{AList.map\_default}\verb|AList.map_default: ('a * 'a -> bool) -> 'a * 'b -> ('b -> 'b)|\isasep\isanewline%
3.155 + \indexdef{}{ML}{AList.map\_default}\verb|AList.map_default: ('a * 'a -> bool) -> 'a * 'b -> ('b -> 'b)|\isasep\isanewline%
3.156 \verb| -> ('a * 'b) list -> ('a * 'b) list| \\
3.157 - \indexml{AList.join}\verb|AList.join: ('a * 'a -> bool) -> ('a -> 'b * 'b -> 'b) (*exception DUP*)|\isasep\isanewline%
3.158 + \indexdef{}{ML}{AList.join}\verb|AList.join: ('a * 'a -> bool) -> ('a -> 'b * 'b -> 'b) (*exception DUP*)|\isasep\isanewline%
3.159 \verb| -> ('a * 'b) list * ('a * 'b) list -> ('a * 'b) list (*exception AList.DUP*)| \\
3.160 - \indexml{AList.merge}\verb|AList.merge: ('a * 'a -> bool) -> ('b * 'b -> bool)|\isasep\isanewline%
3.161 + \indexdef{}{ML}{AList.merge}\verb|AList.merge: ('a * 'a -> bool) -> ('b * 'b -> bool)|\isasep\isanewline%
3.162 \verb| -> ('a * 'b) list * ('a * 'b) list -> ('a * 'b) list (*exception AList.DUP*)|
3.163 \end{mldecls}%
3.164 \end{isamarkuptext}%
3.165 @@ -732,25 +732,25 @@
3.166 %
3.167 \begin{isamarkuptext}%
3.168 \begin{mldecls}
3.169 - \indexmltype{'a Symtab.table}\verb|type 'a Symtab.table| \\
3.170 - \indexmlexception{Symtab.DUP}\verb|exception Symtab.DUP of string| \\
3.171 - \indexmlexception{Symtab.SAME}\verb|exception Symtab.SAME| \\
3.172 - \indexmlexception{Symtab.UNDEF}\verb|exception Symtab.UNDEF of string| \\
3.173 - \indexml{Symtab.empty}\verb|Symtab.empty: 'a Symtab.table| \\
3.174 - \indexml{Symtab.lookup}\verb|Symtab.lookup: 'a Symtab.table -> string -> 'a option| \\
3.175 - \indexml{Symtab.defined}\verb|Symtab.defined: 'a Symtab.table -> string -> bool| \\
3.176 - \indexml{Symtab.update}\verb|Symtab.update: (string * 'a) -> 'a Symtab.table -> 'a Symtab.table| \\
3.177 - \indexml{Symtab.default}\verb|Symtab.default: string * 'a -> 'a Symtab.table -> 'a Symtab.table| \\
3.178 - \indexml{Symtab.delete}\verb|Symtab.delete: string|\isasep\isanewline%
3.179 + \indexdef{}{ML type}{'a Symtab.table}\verb|type 'a Symtab.table| \\
3.180 + \indexdef{}{ML exception}{Symtab.DUP}\verb|exception Symtab.DUP of string| \\
3.181 + \indexdef{}{ML exception}{Symtab.SAME}\verb|exception Symtab.SAME| \\
3.182 + \indexdef{}{ML exception}{Symtab.UNDEF}\verb|exception Symtab.UNDEF of string| \\
3.183 + \indexdef{}{ML}{Symtab.empty}\verb|Symtab.empty: 'a Symtab.table| \\
3.184 + \indexdef{}{ML}{Symtab.lookup}\verb|Symtab.lookup: 'a Symtab.table -> string -> 'a option| \\
3.185 + \indexdef{}{ML}{Symtab.defined}\verb|Symtab.defined: 'a Symtab.table -> string -> bool| \\
3.186 + \indexdef{}{ML}{Symtab.update}\verb|Symtab.update: (string * 'a) -> 'a Symtab.table -> 'a Symtab.table| \\
3.187 + \indexdef{}{ML}{Symtab.default}\verb|Symtab.default: string * 'a -> 'a Symtab.table -> 'a Symtab.table| \\
3.188 + \indexdef{}{ML}{Symtab.delete}\verb|Symtab.delete: string|\isasep\isanewline%
3.189 \verb| -> 'a Symtab.table -> 'a Symtab.table (*exception Symtab.UNDEF*)| \\
3.190 - \indexml{Symtab.map\_entry}\verb|Symtab.map_entry: string -> ('a -> 'a)|\isasep\isanewline%
3.191 + \indexdef{}{ML}{Symtab.map\_entry}\verb|Symtab.map_entry: string -> ('a -> 'a)|\isasep\isanewline%
3.192 \verb| -> 'a Symtab.table -> 'a Symtab.table| \\
3.193 - \indexml{Symtab.map\_default}\verb|Symtab.map_default: (string * 'a) -> ('a -> 'a)|\isasep\isanewline%
3.194 + \indexdef{}{ML}{Symtab.map\_default}\verb|Symtab.map_default: (string * 'a) -> ('a -> 'a)|\isasep\isanewline%
3.195 \verb| -> 'a Symtab.table -> 'a Symtab.table| \\
3.196 - \indexml{Symtab.join}\verb|Symtab.join: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*)|\isasep\isanewline%
3.197 + \indexdef{}{ML}{Symtab.join}\verb|Symtab.join: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*)|\isasep\isanewline%
3.198 \verb| -> 'a Symtab.table * 'a Symtab.table|\isasep\isanewline%
3.199 \verb| -> 'a Symtab.table (*exception Symtab.DUP*)| \\
3.200 - \indexml{Symtab.merge}\verb|Symtab.merge: ('a * 'a -> bool)|\isasep\isanewline%
3.201 + \indexdef{}{ML}{Symtab.merge}\verb|Symtab.merge: ('a * 'a -> bool)|\isasep\isanewline%
3.202 \verb| -> 'a Symtab.table * 'a Symtab.table|\isasep\isanewline%
3.203 \verb| -> 'a Symtab.table (*exception Symtab.DUP*)|
3.204 \end{mldecls}%
4.1 --- a/doc-src/IsarImplementation/Thy/document/session.tex Wed Mar 04 10:43:39 2009 +0100
4.2 +++ b/doc-src/IsarImplementation/Thy/document/session.tex Wed Mar 04 10:45:52 2009 +0100
4.3 @@ -1,21 +1,23 @@
4.4 -\input{base.tex}
4.5 +\input{Base.tex}
4.6
4.7 -\input{prelim.tex}
4.8 +\input{Integration.tex}
4.9
4.10 -\input{logic.tex}
4.11 +\input{Isar.tex}
4.12
4.13 -\input{tactic.tex}
4.14 +\input{Local_Theory.tex}
4.15
4.16 -\input{proof.tex}
4.17 -
4.18 -\input{isar.tex}
4.19 -
4.20 -\input{locale.tex}
4.21 -
4.22 -\input{integration.tex}
4.23 +\input{Logic.tex}
4.24
4.25 \input{ML.tex}
4.26
4.27 +\input{Prelim.tex}
4.28 +
4.29 +\input{Proof.tex}
4.30 +
4.31 +\input{Syntax.tex}
4.32 +
4.33 +\input{Tactic.tex}
4.34 +
4.35 %%% Local Variables:
4.36 %%% mode: latex
4.37 %%% TeX-master: "root"
5.1 --- a/doc-src/IsarImplementation/implementation.tex Wed Mar 04 10:43:39 2009 +0100
5.2 +++ b/doc-src/IsarImplementation/implementation.tex Wed Mar 04 10:45:52 2009 +0100
5.3 @@ -1,6 +1,3 @@
5.4 -
5.5 -%% $Id$
5.6 -
5.7 \documentclass[12pt,a4paper,fleqn]{report}
5.8 \usepackage{latexsym,graphicx}
5.9 \usepackage[refpage]{nomencl}
5.10 @@ -23,9 +20,6 @@
5.11 and Larry Paulson
5.12 }
5.13
5.14 -%FIXME
5.15 -%\makeglossary
5.16 -
5.17 \makeindex
5.18
5.19
5.20 @@ -71,28 +65,24 @@
5.21 \listoffigures
5.22 \clearfirst
5.23
5.24 -%\input{intro.tex}
5.25 -\input{Thy/document/prelim.tex}
5.26 -\input{Thy/document/logic.tex}
5.27 -\input{Thy/document/tactic.tex}
5.28 -\input{Thy/document/proof.tex}
5.29 -\input{Thy/document/isar.tex}
5.30 -\input{Thy/document/locale.tex}
5.31 -\input{Thy/document/integration.tex}
5.32 +\input{Thy/document/Prelim.tex}
5.33 +\input{Thy/document/Logic.tex}
5.34 +\input{Thy/document/Tactic.tex}
5.35 +\input{Thy/document/Proof.tex}
5.36 +\input{Thy/document/Syntax.tex}
5.37 +\input{Thy/document/Isar.tex}
5.38 +\input{Thy/document/Local_Theory.tex}
5.39 +\input{Thy/document/Integration.tex}
5.40
5.41 \appendix
5.42 \input{Thy/document/ML.tex}
5.43
5.44 \begingroup
5.45 \tocentry{\bibname}
5.46 -\bibliographystyle{plain} \small\raggedright\frenchspacing
5.47 +\bibliographystyle{abbrv} \small\raggedright\frenchspacing
5.48 \bibliography{../manual}
5.49 \endgroup
5.50
5.51 -%FIXME
5.52 -%\tocentry{\glossaryname}
5.53 -%\printglossary
5.54 -
5.55 \tocentry{\indexname}
5.56 \printindex
5.57
6.1 --- a/doc-src/IsarImplementation/style.sty Wed Mar 04 10:43:39 2009 +0100
6.2 +++ b/doc-src/IsarImplementation/style.sty Wed Mar 04 10:45:52 2009 +0100
6.3 @@ -1,6 +1,3 @@
6.4 -
6.5 -%% $Id$
6.6 -
6.7 %% toc
6.8 \newcommand{\tocentry}[1]{\cleardoublepage\phantomsection\addcontentsline{toc}{chapter}{#1}
6.9 \@mkboth{\MakeUppercase{#1}}{\MakeUppercase{#1}}}
6.10 @@ -10,24 +7,12 @@
6.11 \newcommand{\chref}[1]{chapter~\ref{#1}}
6.12 \newcommand{\figref}[1]{figure~\ref{#1}}
6.13
6.14 -%% glossary
6.15 -\renewcommand{\glossary}[2]{\nomenclature{\bf #1}{#2}}
6.16 -\newcommand{\seeglossary}[1]{\emph{#1}}
6.17 -\newcommand{\glossaryname}{Glossary}
6.18 -\renewcommand{\nomname}{\glossaryname}
6.19 -\renewcommand{\pagedeclaration}[1]{\nobreak\quad\dotfill~page~\bold{#1}}
6.20 -
6.21 -%% index
6.22 -\newcommand{\indexml}[1]{\index{\emph{#1}|bold}}
6.23 -\newcommand{\indexmlexception}[1]{\index{\emph{#1} (exception)|bold}}
6.24 -\newcommand{\indexmltype}[1]{\index{\emph{#1} (type)|bold}}
6.25 -\newcommand{\indexmlstructure}[1]{\index{\emph{#1} (structure)|bold}}
6.26 -\newcommand{\indexmlfunctor}[1]{\index{\emph{#1} (functor)|bold}}
6.27 -
6.28 %% math
6.29 \newcommand{\text}[1]{\mbox{#1}}
6.30 \newcommand{\isasymvartheta}{\isamath{\theta}}
6.31 -\newcommand{\isactrlvec}[1]{\emph{$\overline{#1}$}}
6.32 +\newcommand{\isactrlvec}[1]{\emph{$\vec{#1}$}}
6.33 +\newcommand{\isactrlBG}{\isacharbackquoteopen}
6.34 +\newcommand{\isactrlEN}{\isacharbackquoteclose}
6.35
6.36 \setcounter{secnumdepth}{2} \setcounter{tocdepth}{2}
6.37
6.38 @@ -49,6 +34,10 @@
6.39 \newcommand{\isasymtype}{\minorcmd{type}}
6.40 \newcommand{\isasymval}{\minorcmd{val}}
6.41
6.42 +\newcommand{\isasymFIX}{\isakeyword{fix}}
6.43 +\newcommand{\isasymASSUME}{\isakeyword{assume}}
6.44 +\newcommand{\isasymDEFINE}{\isakeyword{define}}
6.45 +\newcommand{\isasymNOTE}{\isakeyword{note}}
6.46 \newcommand{\isasymGUESS}{\isakeyword{guess}}
6.47 \newcommand{\isasymOBTAIN}{\isakeyword{obtain}}
6.48 \newcommand{\isasymTHEORY}{\isakeyword{theory}}
6.49 @@ -61,6 +50,7 @@
6.50
6.51 \isabellestyle{it}
6.52
6.53 +
6.54 %%% Local Variables:
6.55 %%% mode: latex
6.56 %%% TeX-master: "implementation"
7.1 --- a/doc-src/IsarRef/IsaMakefile Wed Mar 04 10:43:39 2009 +0100
7.2 +++ b/doc-src/IsarRef/IsaMakefile Wed Mar 04 10:45:52 2009 +0100
7.3 @@ -22,10 +22,11 @@
7.4 HOL-IsarRef: $(LOG)/HOL-IsarRef.gz
7.5
7.6 $(LOG)/HOL-IsarRef.gz: Thy/ROOT.ML ../antiquote_setup.ML \
7.7 - Thy/Inner_Syntax.thy Thy/Introduction.thy Thy/Outer_Syntax.thy \
7.8 - Thy/Spec.thy Thy/Proof.thy Thy/Misc.thy Thy/Document_Preparation.thy \
7.9 - Thy/Generic.thy Thy/HOL_Specific.thy Thy/Quick_Reference.thy \
7.10 - Thy/Symbols.thy Thy/ML_Tactic.thy
7.11 + Thy/First_Order_Logic.thy Thy/Framework.thy Thy/Inner_Syntax.thy \
7.12 + Thy/Introduction.thy Thy/Outer_Syntax.thy Thy/Spec.thy Thy/Proof.thy \
7.13 + Thy/Misc.thy Thy/Document_Preparation.thy Thy/Generic.thy \
7.14 + Thy/HOL_Specific.thy Thy/Quick_Reference.thy Thy/Symbols.thy \
7.15 + Thy/ML_Tactic.thy
7.16 @$(USEDIR) -s IsarRef HOL Thy
7.17
7.18
8.1 --- a/doc-src/IsarRef/Makefile Wed Mar 04 10:43:39 2009 +0100
8.2 +++ b/doc-src/IsarRef/Makefile Wed Mar 04 10:45:52 2009 +0100
8.3 @@ -1,7 +1,3 @@
8.4 -#
8.5 -# $Id$
8.6 -#
8.7 -
8.8 ## targets
8.9
8.10 default: dvi
9.1 --- a/doc-src/IsarRef/Thy/Document_Preparation.thy Wed Mar 04 10:43:39 2009 +0100
9.2 +++ b/doc-src/IsarRef/Thy/Document_Preparation.thy Wed Mar 04 10:45:52 2009 +0100
9.3 @@ -1,5 +1,3 @@
9.4 -(* $Id$ *)
9.5 -
9.6 theory Document_Preparation
9.7 imports Main
9.8 begin
10.1 --- a/doc-src/IsarRef/Thy/Generic.thy Wed Mar 04 10:43:39 2009 +0100
10.2 +++ b/doc-src/IsarRef/Thy/Generic.thy Wed Mar 04 10:45:52 2009 +0100
10.3 @@ -1,5 +1,3 @@
10.4 -(* $Id$ *)
10.5 -
10.6 theory Generic
10.7 imports Main
10.8 begin
11.1 --- a/doc-src/IsarRef/Thy/HOLCF_Specific.thy Wed Mar 04 10:43:39 2009 +0100
11.2 +++ b/doc-src/IsarRef/Thy/HOLCF_Specific.thy Wed Mar 04 10:45:52 2009 +0100
11.3 @@ -1,5 +1,3 @@
11.4 -(* $Id$ *)
11.5 -
11.6 theory HOLCF_Specific
11.7 imports HOLCF
11.8 begin
12.1 --- a/doc-src/IsarRef/Thy/HOL_Specific.thy Wed Mar 04 10:43:39 2009 +0100
12.2 +++ b/doc-src/IsarRef/Thy/HOL_Specific.thy Wed Mar 04 10:45:52 2009 +0100
12.3 @@ -771,6 +771,55 @@
12.4 *}
12.5
12.6
12.7 +section {* Intuitionistic proof search *}
12.8 +
12.9 +text {*
12.10 + \begin{matharray}{rcl}
12.11 + @{method_def (HOL) iprover} & : & @{text method} \\
12.12 + \end{matharray}
12.13 +
12.14 + \begin{rail}
12.15 + 'iprover' ('!' ?) (rulemod *)
12.16 + ;
12.17 + \end{rail}
12.18 +
12.19 + The @{method (HOL) iprover} method performs intuitionistic proof
12.20 + search, depending on specifically declared rules from the context,
12.21 + or given as explicit arguments. Chained facts are inserted into the
12.22 + goal before commencing proof search; ``@{method (HOL) iprover}@{text
12.23 + "!"}'' means to include the current @{fact prems} as well.
12.24 +
12.25 + Rules need to be classified as @{attribute (Pure) intro},
12.26 + @{attribute (Pure) elim}, or @{attribute (Pure) dest}; here the
12.27 + ``@{text "!"}'' indicator refers to ``safe'' rules, which may be
12.28 + applied aggressively (without considering back-tracking later).
12.29 + Rules declared with ``@{text "?"}'' are ignored in proof search (the
12.30 + single-step @{method rule} method still observes these). An
12.31 + explicit weight annotation may be given as well; otherwise the
12.32 + number of rule premises will be taken into account here.
12.33 +*}
12.34 +
12.35 +
12.36 +section {* Coherent Logic *}
12.37 +
12.38 +text {*
12.39 + \begin{matharray}{rcl}
12.40 + @{method_def (HOL) "coherent"} & : & @{text method} \\
12.41 + \end{matharray}
12.42 +
12.43 + \begin{rail}
12.44 + 'coherent' thmrefs?
12.45 + ;
12.46 + \end{rail}
12.47 +
12.48 + The @{method (HOL) coherent} method solves problems of
12.49 + \emph{Coherent Logic} \cite{Bezem-Coquand:2005}, which covers
12.50 + applications in confluence theory, lattice theory and projective
12.51 + geometry. See @{"file" "~~/src/HOL/ex/Coherent.thy"} for some
12.52 + examples.
12.53 +*}
12.54 +
12.55 +
12.56 section {* Invoking automated reasoning tools -- The Sledgehammer *}
12.57
12.58 text {*
13.1 --- a/doc-src/IsarRef/Thy/Inner_Syntax.thy Wed Mar 04 10:43:39 2009 +0100
13.2 +++ b/doc-src/IsarRef/Thy/Inner_Syntax.thy Wed Mar 04 10:45:52 2009 +0100
13.3 @@ -1,5 +1,3 @@
13.4 -(* $Id$ *)
13.5 -
13.6 theory Inner_Syntax
13.7 imports Main
13.8 begin
13.9 @@ -370,7 +368,7 @@
13.10 \end{matharray}
13.11
13.12 \begin{rail}
13.13 - ('notation' | 'no\_notation') target? mode? (nameref structmixfix + 'and')
13.14 + ('notation' | 'no\_notation') target? mode? \\ (nameref structmixfix + 'and')
13.15 ;
13.16 \end{rail}
13.17
13.18 @@ -525,13 +523,15 @@
13.19 & @{text "|"} & @{text "tid | tvar | "}@{verbatim "_"} \\
13.20 & @{text "|"} & @{text "tid"} @{verbatim "::"} @{text "sort | tvar "}@{verbatim "::"} @{text "sort | "}@{verbatim "_"} @{verbatim "::"} @{text "sort"} \\
13.21 & @{text "|"} & @{text "id | type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) id | "}@{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text id} \\
13.22 - & @{text "|"} & @{text "longid | type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) longid | "}@{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text longid} \\
13.23 + & @{text "|"} & @{text "longid | type\<^sup>(\<^sup>1\<^sup>0\<^sup>0\<^sup>0\<^sup>) longid"} \\
13.24 + & @{text "|"} & @{verbatim "("} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim ")"} @{text longid} \\
13.25 & @{text "|"} & @{text "type\<^sup>(\<^sup>1\<^sup>)"} @{verbatim "=>"} @{text type} & @{text "(0)"} \\
13.26 & @{text "|"} & @{text "type\<^sup>(\<^sup>1\<^sup>)"} @{text "\<Rightarrow>"} @{text type} & @{text "(0)"} \\
13.27 & @{text "|"} & @{verbatim "["} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim "]"} @{verbatim "=>"} @{text type} & @{text "(0)"} \\
13.28 & @{text "|"} & @{verbatim "["} @{text type} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text type} @{verbatim "]"} @{text "\<Rightarrow>"} @{text type} & @{text "(0)"} \\\\
13.29
13.30 - @{syntax_def (inner) sort} & = & @{text "id | longid | "}@{verbatim "{}"}@{text " | "}@{verbatim "{"} @{text "(id | longid)"} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text "(id | longid)"} @{verbatim "}"} \\
13.31 + @{syntax_def (inner) sort} & = & @{text "id | longid | "}@{verbatim "{}"} \\
13.32 + & @{text "|"} & @{verbatim "{"} @{text "(id | longid)"} @{verbatim ","} @{text "\<dots>"} @{verbatim ","} @{text "(id | longid)"} @{verbatim "}"} \\
13.33 \end{supertabular}
13.34 \end{center}
13.35
14.1 --- a/doc-src/IsarRef/Thy/Introduction.thy Wed Mar 04 10:43:39 2009 +0100
14.2 +++ b/doc-src/IsarRef/Thy/Introduction.thy Wed Mar 04 10:45:52 2009 +0100
14.3 @@ -1,5 +1,3 @@
14.4 -(* $Id$ *)
14.5 -
14.6 theory Introduction
14.7 imports Main
14.8 begin
14.9 @@ -12,27 +10,27 @@
14.10 The \emph{Isabelle} system essentially provides a generic
14.11 infrastructure for building deductive systems (programmed in
14.12 Standard ML), with a special focus on interactive theorem proving in
14.13 - higher-order logics. In the olden days even end-users would refer
14.14 - to certain ML functions (goal commands, tactics, tacticals etc.) to
14.15 - pursue their everyday theorem proving tasks
14.16 - \cite{isabelle-intro,isabelle-ref}.
14.17 + higher-order logics. Many years ago, even end-users would refer to
14.18 + certain ML functions (goal commands, tactics, tacticals etc.) to
14.19 + pursue their everyday theorem proving tasks.
14.20
14.21 In contrast \emph{Isar} provides an interpreted language environment
14.22 of its own, which has been specifically tailored for the needs of
14.23 theory and proof development. Compared to raw ML, the Isabelle/Isar
14.24 top-level provides a more robust and comfortable development
14.25 - platform, with proper support for theory development graphs,
14.26 - single-step transactions with unlimited undo, etc. The
14.27 - Isabelle/Isar version of the \emph{Proof~General} user interface
14.28 - \cite{proofgeneral,Aspinall:TACAS:2000} provides an adequate
14.29 - front-end for interactive theory and proof development in this
14.30 - advanced theorem proving environment.
14.31 + platform, with proper support for theory development graphs, managed
14.32 + transactions with unlimited undo etc. The Isabelle/Isar version of
14.33 + the \emph{Proof~General} user interface
14.34 + \cite{proofgeneral,Aspinall:TACAS:2000} provides a decent front-end
14.35 + for interactive theory and proof development in this advanced
14.36 + theorem proving environment, even though it is somewhat biased
14.37 + towards old-style proof scripts.
14.38
14.39 \medskip Apart from the technical advances over bare-bones ML
14.40 programming, the main purpose of the Isar language is to provide a
14.41 conceptually different view on machine-checked proofs
14.42 - \cite{Wenzel:1999:TPHOL,Wenzel-PhD}. ``Isar'' stands for
14.43 - ``Intelligible semi-automated reasoning''. Drawing from both the
14.44 + \cite{Wenzel:1999:TPHOL,Wenzel-PhD}. \emph{Isar} stands for
14.45 + \emph{Intelligible semi-automated reasoning}. Drawing from both the
14.46 traditions of informal mathematical proof texts and high-level
14.47 programming languages, Isar offers a versatile environment for
14.48 structured formal proof documents. Thus properly written Isar
14.49 @@ -47,12 +45,12 @@
14.50 Despite its grand design of structured proof texts, Isar is able to
14.51 assimilate the old tactical style as an ``improper'' sub-language.
14.52 This provides an easy upgrade path for existing tactic scripts, as
14.53 - well as additional means for interactive experimentation and
14.54 - debugging of structured proofs. Isabelle/Isar supports a broad
14.55 - range of proof styles, both readable and unreadable ones.
14.56 + well as some means for interactive experimentation and debugging of
14.57 + structured proofs. Isabelle/Isar supports a broad range of proof
14.58 + styles, both readable and unreadable ones.
14.59
14.60 - \medskip The Isabelle/Isar framework \cite{Wenzel:2006:Festschrift}
14.61 - is generic and should work reasonably well for any Isabelle
14.62 + \medskip The generic Isabelle/Isar framework (see
14.63 + \chref{ch:isar-framework}) works reasonably well for any Isabelle
14.64 object-logic that conforms to the natural deduction view of the
14.65 Isabelle/Pure framework. Specific language elements introduced by
14.66 the major object-logics are described in \chref{ch:hol}
14.67 @@ -72,194 +70,4 @@
14.68 context; other commands emulate old-style tactical theorem proving.
14.69 *}
14.70
14.71 -
14.72 -section {* User interfaces *}
14.73 -
14.74 -subsection {* Terminal sessions *}
14.75 -
14.76 -text {*
14.77 - The Isabelle \texttt{tty} tool provides a very interface for running
14.78 - the Isar interaction loop, with some support for command line
14.79 - editing. For example:
14.80 -\begin{ttbox}
14.81 -isabelle tty\medskip
14.82 -{\out Welcome to Isabelle/HOL (Isabelle2008)}\medskip
14.83 -theory Foo imports Main begin;
14.84 -definition foo :: nat where "foo == 1";
14.85 -lemma "0 < foo" by (simp add: foo_def);
14.86 -end;
14.87 -\end{ttbox}
14.88 -
14.89 - Any Isabelle/Isar command may be retracted by @{command undo}.
14.90 - See the Isabelle/Isar Quick Reference (\appref{ap:refcard}) for a
14.91 - comprehensive overview of available commands and other language
14.92 - elements.
14.93 -*}
14.94 -
14.95 -
14.96 -subsection {* Emacs Proof General *}
14.97 -
14.98 -text {*
14.99 - Plain TTY-based interaction as above used to be quite feasible with
14.100 - traditional tactic based theorem proving, but developing Isar
14.101 - documents really demands some better user-interface support. The
14.102 - Proof~General environment by David Aspinall
14.103 - \cite{proofgeneral,Aspinall:TACAS:2000} offers a generic Emacs
14.104 - interface for interactive theorem provers that organizes all the
14.105 - cut-and-paste and forward-backward walk through the text in a very
14.106 - neat way. In Isabelle/Isar, the current position within a partial
14.107 - proof document is equally important than the actual proof state.
14.108 - Thus Proof~General provides the canonical working environment for
14.109 - Isabelle/Isar, both for getting acquainted (e.g.\ by replaying
14.110 - existing Isar documents) and for production work.
14.111 -*}
14.112 -
14.113 -
14.114 -subsubsection{* Proof~General as default Isabelle interface *}
14.115 -
14.116 -text {*
14.117 - The Isabelle interface wrapper script provides an easy way to invoke
14.118 - Proof~General (including XEmacs or GNU Emacs). The default
14.119 - configuration of Isabelle is smart enough to detect the
14.120 - Proof~General distribution in several canonical places (e.g.\
14.121 - @{verbatim "$ISABELLE_HOME/contrib/ProofGeneral"}). Thus the
14.122 - capital @{verbatim Isabelle} executable would already refer to the
14.123 - @{verbatim "ProofGeneral/isar"} interface without further ado. The
14.124 - Isabelle interface script provides several options; pass @{verbatim
14.125 - "-?"} to see its usage.
14.126 -
14.127 - With the proper Isabelle interface setup, Isar documents may now be edited by
14.128 - visiting appropriate theory files, e.g.\
14.129 -\begin{ttbox}
14.130 -Isabelle \({\langle}isabellehome{\rangle}\)/src/HOL/Isar_examples/Summation.thy
14.131 -\end{ttbox}
14.132 - Beginners may note the tool bar for navigating forward and backward
14.133 - through the text (this depends on the local Emacs installation).
14.134 - Consult the Proof~General documentation \cite{proofgeneral} for
14.135 - further basic command sequences, in particular ``@{verbatim "C-c C-return"}''
14.136 - and ``@{verbatim "C-c u"}''.
14.137 -
14.138 - \medskip Proof~General may be also configured manually by giving
14.139 - Isabelle settings like this (see also \cite{isabelle-sys}):
14.140 -
14.141 -\begin{ttbox}
14.142 -ISABELLE_INTERFACE=\$ISABELLE_HOME/contrib/ProofGeneral/isar/interface
14.143 -PROOFGENERAL_OPTIONS=""
14.144 -\end{ttbox}
14.145 - You may have to change @{verbatim
14.146 - "$ISABELLE_HOME/contrib/ProofGeneral"} to the actual installation
14.147 - directory of Proof~General.
14.148 -
14.149 - \medskip Apart from the Isabelle command line, defaults for
14.150 - interface options may be given by the @{verbatim PROOFGENERAL_OPTIONS}
14.151 - setting. For example, the Emacs executable to be used may be
14.152 - configured in Isabelle's settings like this:
14.153 -\begin{ttbox}
14.154 -PROOFGENERAL_OPTIONS="-p xemacs-mule"
14.155 -\end{ttbox}
14.156 -
14.157 - Occasionally, a user's @{verbatim "~/.emacs"} file contains code
14.158 - that is incompatible with the (X)Emacs version used by
14.159 - Proof~General, causing the interface startup to fail prematurely.
14.160 - Here the @{verbatim "-u false"} option helps to get the interface
14.161 - process up and running. Note that additional Lisp customization
14.162 - code may reside in @{verbatim "proofgeneral-settings.el"} of
14.163 - @{verbatim "$ISABELLE_HOME/etc"} or @{verbatim
14.164 - "$ISABELLE_HOME_USER/etc"}.
14.165 -*}
14.166 -
14.167 -
14.168 -subsubsection {* The X-Symbol package *}
14.169 -
14.170 -text {*
14.171 - Proof~General incorporates a version of the Emacs X-Symbol package
14.172 - \cite{x-symbol}, which handles proper mathematical symbols displayed
14.173 - on screen. Pass option @{verbatim "-x true"} to the Isabelle
14.174 - interface script, or check the appropriate Proof~General menu
14.175 - setting by hand. The main challenge of getting X-Symbol to work
14.176 - properly is the underlying (semi-automated) X11 font setup.
14.177 -
14.178 - \medskip Using proper mathematical symbols in Isabelle theories can
14.179 - be very convenient for readability of large formulas. On the other
14.180 - hand, the plain ASCII sources easily become somewhat unintelligible.
14.181 - For example, @{text "\<Longrightarrow>"} would appear as @{verbatim "\<Longrightarrow>"} according
14.182 - the default set of Isabelle symbols. Nevertheless, the Isabelle
14.183 - document preparation system (see \chref{ch:document-prep}) will be
14.184 - happy to print non-ASCII symbols properly. It is even possible to
14.185 - invent additional notation beyond the display capabilities of Emacs
14.186 - and X-Symbol.
14.187 -*}
14.188 -
14.189 -
14.190 -section {* Isabelle/Isar theories *}
14.191 -
14.192 -text {*
14.193 - Isabelle/Isar offers the following main improvements over classic
14.194 - Isabelle.
14.195 -
14.196 - \begin{enumerate}
14.197 -
14.198 - \item A \emph{theory format} that integrates specifications and
14.199 - proofs, supporting interactive development and unlimited undo
14.200 - operation.
14.201 -
14.202 - \item A \emph{formal proof document language} designed to support
14.203 - intelligible semi-automated reasoning. Instead of putting together
14.204 - unreadable tactic scripts, the author is enabled to express the
14.205 - reasoning in way that is close to usual mathematical practice. The
14.206 - old tactical style has been assimilated as ``improper'' language
14.207 - elements.
14.208 -
14.209 - \item A simple document preparation system, for typesetting formal
14.210 - developments together with informal text. The resulting
14.211 - hyper-linked PDF documents are equally well suited for WWW
14.212 - presentation and as printed copies.
14.213 -
14.214 - \end{enumerate}
14.215 -
14.216 - The Isar proof language is embedded into the new theory format as a
14.217 - proper sub-language. Proof mode is entered by stating some
14.218 - @{command theorem} or @{command lemma} at the theory level, and
14.219 - left again with the final conclusion (e.g.\ via @{command qed}).
14.220 - A few theory specification mechanisms also require some proof, such
14.221 - as HOL's @{command typedef} which demands non-emptiness of the
14.222 - representing sets.
14.223 -*}
14.224 -
14.225 -
14.226 -section {* How to write Isar proofs anyway? \label{sec:isar-howto} *}
14.227 -
14.228 -text {*
14.229 - This is one of the key questions, of course. First of all, the
14.230 - tactic script emulation of Isabelle/Isar essentially provides a
14.231 - clarified version of the very same unstructured proof style of
14.232 - classic Isabelle. Old-time users should quickly become acquainted
14.233 - with that (slightly degenerative) view of Isar.
14.234 -
14.235 - Writing \emph{proper} Isar proof texts targeted at human readers is
14.236 - quite different, though. Experienced users of the unstructured
14.237 - style may even have to unlearn some of their habits to master proof
14.238 - composition in Isar. In contrast, new users with less experience in
14.239 - old-style tactical proving, but a good understanding of mathematical
14.240 - proof in general, often get started easier.
14.241 -
14.242 - \medskip The present text really is only a reference manual on
14.243 - Isabelle/Isar, not a tutorial. Nevertheless, we will attempt to
14.244 - give some clues of how the concepts introduced here may be put into
14.245 - practice. Especially note that \appref{ap:refcard} provides a quick
14.246 - reference card of the most common Isabelle/Isar language elements.
14.247 -
14.248 - Further issues concerning the Isar concepts are covered in the
14.249 - literature
14.250 - \cite{Wenzel:1999:TPHOL,Wiedijk:2000:MV,Bauer-Wenzel:2000:HB,Bauer-Wenzel:2001}.
14.251 - The author's PhD thesis \cite{Wenzel-PhD} presently provides the
14.252 - most complete exposition of Isar foundations, techniques, and
14.253 - applications. A number of example applications are distributed with
14.254 - Isabelle, and available via the Isabelle WWW library (e.g.\
14.255 - \url{http://isabelle.in.tum.de/library/}). The ``Archive of Formal
14.256 - Proofs'' \url{http://afp.sourceforge.net/} also provides plenty of
14.257 - examples, both in proper Isar proof style and unstructured tactic
14.258 - scripts.
14.259 -*}
14.260 -
14.261 end
15.1 --- a/doc-src/IsarRef/Thy/ML_Tactic.thy Wed Mar 04 10:43:39 2009 +0100
15.2 +++ b/doc-src/IsarRef/Thy/ML_Tactic.thy Wed Mar 04 10:45:52 2009 +0100
15.3 @@ -1,5 +1,3 @@
15.4 -(* $Id$ *)
15.5 -
15.6 theory ML_Tactic
15.7 imports Main
15.8 begin
16.1 --- a/doc-src/IsarRef/Thy/Misc.thy Wed Mar 04 10:43:39 2009 +0100
16.2 +++ b/doc-src/IsarRef/Thy/Misc.thy Wed Mar 04 10:45:52 2009 +0100
16.3 @@ -1,5 +1,3 @@
16.4 -(* $Id$ *)
16.5 -
16.6 theory Misc
16.7 imports Main
16.8 begin
17.1 --- a/doc-src/IsarRef/Thy/Outer_Syntax.thy Wed Mar 04 10:43:39 2009 +0100
17.2 +++ b/doc-src/IsarRef/Thy/Outer_Syntax.thy Wed Mar 04 10:45:52 2009 +0100
17.3 @@ -1,5 +1,3 @@
17.4 -(* $Id$ *)
17.5 -
17.6 theory Outer_Syntax
17.7 imports Main
17.8 begin
17.9 @@ -170,10 +168,10 @@
17.10 Isabelle as @{verbatim \<forall>}. There are infinitely many Isabelle
17.11 symbols like this, although proper presentation is left to front-end
17.12 tools such as {\LaTeX} or Proof~General with the X-Symbol package.
17.13 - A list of standard Isabelle symbols that work well with these tools
17.14 - is given in \appref{app:symbols}. Note that @{verbatim "\<lambda>"} does
17.15 - not belong to the @{text letter} category, since it is already used
17.16 - differently in the Pure term language.
17.17 + A list of predefined Isabelle symbols that work well with these
17.18 + tools is given in \appref{app:symbols}. Note that @{verbatim "\<lambda>"}
17.19 + does not belong to the @{text letter} category, since it is already
17.20 + used differently in the Pure term language.
17.21 *}
17.22
17.23
18.1 --- a/doc-src/IsarRef/Thy/Proof.thy Wed Mar 04 10:43:39 2009 +0100
18.2 +++ b/doc-src/IsarRef/Thy/Proof.thy Wed Mar 04 10:45:52 2009 +0100
18.3 @@ -1,17 +1,15 @@
18.4 -(* $Id$ *)
18.5 -
18.6 theory Proof
18.7 imports Main
18.8 begin
18.9
18.10 -chapter {* Proofs *}
18.11 +chapter {* Proofs \label{ch:proofs} *}
18.12
18.13 text {*
18.14 Proof commands perform transitions of Isar/VM machine
18.15 configurations, which are block-structured, consisting of a stack of
18.16 nodes with three main components: logical proof context, current
18.17 - facts, and open goals. Isar/VM transitions are \emph{typed}
18.18 - according to the following three different modes of operation:
18.19 + facts, and open goals. Isar/VM transitions are typed according to
18.20 + the following three different modes of operation:
18.21
18.22 \begin{description}
18.23
18.24 @@ -32,13 +30,17 @@
18.25
18.26 \end{description}
18.27
18.28 - The proof mode indicator may be read as a verb telling the writer
18.29 - what kind of operation may be performed next. The corresponding
18.30 - typings of proof commands restricts the shape of well-formed proof
18.31 - texts to particular command sequences. So dynamic arrangements of
18.32 - commands eventually turn out as static texts of a certain structure.
18.33 - \Appref{ap:refcard} gives a simplified grammar of the overall
18.34 - (extensible) language emerging that way.
18.35 + The proof mode indicator may be understood as an instruction to the
18.36 + writer, telling what kind of operation may be performed next. The
18.37 + corresponding typings of proof commands restricts the shape of
18.38 + well-formed proof texts to particular command sequences. So dynamic
18.39 + arrangements of commands eventually turn out as static texts of a
18.40 + certain structure.
18.41 +
18.42 + \Appref{ap:refcard} gives a simplified grammar of the (extensible)
18.43 + language emerging that way from the different types of proof
18.44 + commands. The main ideas of the overall Isar framework are
18.45 + explained in \chref{ch:isar-framework}.
18.46 *}
18.47
18.48
18.49 @@ -681,7 +683,6 @@
18.50 @{method_def "assumption"} & : & @{text method} \\
18.51 @{method_def "this"} & : & @{text method} \\
18.52 @{method_def "rule"} & : & @{text method} \\
18.53 - @{method_def "iprover"} & : & @{text method} \\[0.5ex]
18.54 @{attribute_def (Pure) "intro"} & : & @{text attribute} \\
18.55 @{attribute_def (Pure) "elim"} & : & @{text attribute} \\
18.56 @{attribute_def (Pure) "dest"} & : & @{text attribute} \\
18.57 @@ -696,8 +697,6 @@
18.58 ;
18.59 'rule' thmrefs?
18.60 ;
18.61 - 'iprover' ('!' ?) (rulemod *)
18.62 - ;
18.63 rulemod: ('intro' | 'elim' | 'dest') ((('!' | () | '?') nat?) | 'del') ':' thmrefs
18.64 ;
18.65 ('intro' | 'elim' | 'dest') ('!' | () | '?') nat?
18.66 @@ -756,27 +755,11 @@
18.67 default behavior of @{command "proof"} and ``@{command ".."}''
18.68 (double-dot) steps (see \secref{sec:proof-steps}).
18.69
18.70 - \item @{method iprover} performs intuitionistic proof search,
18.71 - depending on specifically declared rules from the context, or given
18.72 - as explicit arguments. Chained facts are inserted into the goal
18.73 - before commencing proof search; ``@{method iprover}@{text "!"}''
18.74 - means to include the current @{fact prems} as well.
18.75 -
18.76 - Rules need to be classified as @{attribute (Pure) intro},
18.77 - @{attribute (Pure) elim}, or @{attribute (Pure) dest}; here the
18.78 - ``@{text "!"}'' indicator refers to ``safe'' rules, which may be
18.79 - applied aggressively (without considering back-tracking later).
18.80 - Rules declared with ``@{text "?"}'' are ignored in proof search (the
18.81 - single-step @{method rule} method still observes these). An
18.82 - explicit weight annotation may be given as well; otherwise the
18.83 - number of rule premises will be taken into account here.
18.84 -
18.85 \item @{attribute (Pure) intro}, @{attribute (Pure) elim}, and
18.86 @{attribute (Pure) dest} declare introduction, elimination, and
18.87 - destruct rules, to be used with the @{method rule} and @{method
18.88 - iprover} methods. Note that the latter will ignore rules declared
18.89 - with ``@{text "?"}'', while ``@{text "!"}'' are used most
18.90 - aggressively.
18.91 + destruct rules, to be used with method @{method rule}, and similar
18.92 + tools. Note that the latter will ignore rules declared with
18.93 + ``@{text "?"}'', while ``@{text "!"}'' are used most aggressively.
18.94
18.95 The classical reasoner (see \secref{sec:classical}) introduces its
18.96 own variants of these attributes; use qualified names to access the
18.97 @@ -963,7 +946,7 @@
18.98 \begin{matharray}{l}
18.99 @{text "\<langle>using b\<^sub>1 \<dots> b\<^sub>k\<rangle>"}~~@{command "obtain"}~@{text "x\<^sub>1 \<dots> x\<^sub>m \<WHERE> a: \<phi>\<^sub>1 \<dots> \<phi>\<^sub>n \<langle>proof\<rangle> \<equiv>"} \\[1ex]
18.100 \quad @{command "have"}~@{text "\<And>thesis. (\<And>x\<^sub>1 \<dots> x\<^sub>m. \<phi>\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> thesis) \<Longrightarrow> thesis"} \\
18.101 - \quad @{command "proof"}~@{text succeed} \\
18.102 + \quad @{command "proof"}~@{method succeed} \\
18.103 \qquad @{command "fix"}~@{text thesis} \\
18.104 \qquad @{command "assume"}~@{text "that [Pure.intro?]: \<And>x\<^sub>1 \<dots> x\<^sub>m. \<phi>\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> thesis"} \\
18.105 \qquad @{command "then"}~@{command "show"}~@{text thesis} \\
19.1 --- a/doc-src/IsarRef/Thy/Quick_Reference.thy Wed Mar 04 10:43:39 2009 +0100
19.2 +++ b/doc-src/IsarRef/Thy/Quick_Reference.thy Wed Mar 04 10:45:52 2009 +0100
19.3 @@ -1,5 +1,3 @@
19.4 -(* $Id$ *)
19.5 -
19.6 theory Quick_Reference
19.7 imports Main
19.8 begin
19.9 @@ -30,7 +28,7 @@
19.10
19.11 \begin{tabular}{rcl}
19.12 @{text "theory\<dash>stmt"} & = & @{command "theorem"}~@{text "name: props proof |"}~~@{command "definition"}~@{text "\<dots> | \<dots>"} \\[1ex]
19.13 - @{text "proof"} & = & @{text "prfx\<^sup>*"}~@{command "proof"}~@{text "method stmt\<^sup>*"}~@{command "qed"}~@{text method} \\
19.14 + @{text "proof"} & = & @{text "prfx\<^sup>*"}~@{command "proof"}~@{text "method\<^sup>? stmt\<^sup>*"}~@{command "qed"}~@{text "method\<^sup>?"} \\
19.15 & @{text "|"} & @{text "prfx\<^sup>*"}~@{command "done"} \\[1ex]
19.16 @{text prfx} & = & @{command "apply"}~@{text method} \\
19.17 & @{text "|"} & @{command "using"}~@{text "facts"} \\
20.1 --- a/doc-src/IsarRef/Thy/ROOT-HOLCF.ML Wed Mar 04 10:43:39 2009 +0100
20.2 +++ b/doc-src/IsarRef/Thy/ROOT-HOLCF.ML Wed Mar 04 10:45:52 2009 +0100
20.3 @@ -1,6 +1,3 @@
20.4 -
20.5 -(* $Id$ *)
20.6 -
20.7 set ThyOutput.source;
20.8 use "../../antiquote_setup.ML";
20.9
21.1 --- a/doc-src/IsarRef/Thy/ROOT-ZF.ML Wed Mar 04 10:43:39 2009 +0100
21.2 +++ b/doc-src/IsarRef/Thy/ROOT-ZF.ML Wed Mar 04 10:45:52 2009 +0100
21.3 @@ -1,6 +1,3 @@
21.4 -
21.5 -(* $Id$ *)
21.6 -
21.7 set ThyOutput.source;
21.8 use "../../antiquote_setup.ML";
21.9
22.1 --- a/doc-src/IsarRef/Thy/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
22.2 +++ b/doc-src/IsarRef/Thy/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
22.3 @@ -1,18 +1,20 @@
22.4 -
22.5 -(* $Id$ *)
22.6 -
22.7 +set quick_and_dirty;
22.8 set ThyOutput.source;
22.9 use "../../antiquote_setup.ML";
22.10
22.11 -use_thy "Introduction";
22.12 -use_thy "Outer_Syntax";
22.13 -use_thy "Document_Preparation";
22.14 -use_thy "Spec";
22.15 -use_thy "Proof";
22.16 -use_thy "Inner_Syntax";
22.17 -use_thy "Misc";
22.18 -use_thy "Generic";
22.19 -use_thy "HOL_Specific";
22.20 -use_thy "Quick_Reference";
22.21 -use_thy "Symbols";
22.22 -use_thy "ML_Tactic";
22.23 +use_thys [
22.24 + "Introduction",
22.25 + "Framework",
22.26 + "First_Order_Logic",
22.27 + "Outer_Syntax",
22.28 + "Document_Preparation",
22.29 + "Spec",
22.30 + "Proof",
22.31 + "Inner_Syntax",
22.32 + "Misc",
22.33 + "Generic",
22.34 + "HOL_Specific",
22.35 + "Quick_Reference",
22.36 + "Symbols",
22.37 + "ML_Tactic"
22.38 +];
23.1 --- a/doc-src/IsarRef/Thy/Spec.thy Wed Mar 04 10:43:39 2009 +0100
23.2 +++ b/doc-src/IsarRef/Thy/Spec.thy Wed Mar 04 10:45:52 2009 +0100
23.3 @@ -4,6 +4,24 @@
23.4
23.5 chapter {* Theory specifications *}
23.6
23.7 +text {*
23.8 + The Isabelle/Isar theory format integrates specifications and
23.9 + proofs, supporting interactive development with unlimited undo
23.10 + operation. There is an integrated document preparation system (see
23.11 + \chref{ch:document-prep}), for typesetting formal developments
23.12 + together with informal text. The resulting hyper-linked PDF
23.13 + documents can be used both for WWW presentation and printed copies.
23.14 +
23.15 + The Isar proof language (see \chref{ch:proofs}) is embedded into the
23.16 + theory language as a proper sub-language. Proof mode is entered by
23.17 + stating some @{command theorem} or @{command lemma} at the theory
23.18 + level, and left again with the final conclusion (e.g.\ via @{command
23.19 + qed}). Some theory specification mechanisms also require a proof,
23.20 + such as @{command typedef} in HOL, which demands non-emptiness of
23.21 + the representing sets.
23.22 +*}
23.23 +
23.24 +
23.25 section {* Defining theories \label{sec:begin-thy} *}
23.26
23.27 text {*
23.28 @@ -106,9 +124,9 @@
23.29 @{command (global) "end"} has a different meaning: it concludes the
23.30 theory itself (\secref{sec:begin-thy}).
23.31
23.32 - \item @{text "(\<IN> c)"} given after any local theory command
23.33 - specifies an immediate target, e.g.\ ``@{command
23.34 - "definition"}~@{text "(\<IN> c) \<dots>"}'' or ``@{command
23.35 + \item @{text "("}@{keyword_def "in"}~@{text "c)"} given after any
23.36 + local theory command specifies an immediate target, e.g.\
23.37 + ``@{command "definition"}~@{text "(\<IN> c) \<dots>"}'' or ``@{command
23.38 "theorem"}~@{text "(\<IN> c) \<dots>"}''. This works both in a local or
23.39 global theory context; the current target context will be suspended
23.40 for this command only. Note that ``@{text "(\<IN> -)"}'' will
23.41 @@ -1164,7 +1182,7 @@
23.42
23.43 \end{description}
23.44
23.45 - See @{"file" "~~/src/FOL/ex/IffOracle.thy"} for a worked example of
23.46 + See @{"file" "~~/src/FOL/ex/Iff_Oracle.thy"} for a worked example of
23.47 defining a new primitive rule as oracle, and turning it into a proof
23.48 method.
23.49 *}
24.1 --- a/doc-src/IsarRef/Thy/Symbols.thy Wed Mar 04 10:43:39 2009 +0100
24.2 +++ b/doc-src/IsarRef/Thy/Symbols.thy Wed Mar 04 10:45:52 2009 +0100
24.3 @@ -1,10 +1,8 @@
24.4 -(* $Id$ *)
24.5 -
24.6 theory Symbols
24.7 imports Pure
24.8 begin
24.9
24.10 -chapter {* Standard Isabelle symbols \label{app:symbols} *}
24.11 +chapter {* Predefined Isabelle symbols \label{app:symbols} *}
24.12
24.13 text {*
24.14 Isabelle supports an infinite number of non-ASCII symbols, which are
25.1 --- a/doc-src/IsarRef/Thy/ZF_Specific.thy Wed Mar 04 10:43:39 2009 +0100
25.2 +++ b/doc-src/IsarRef/Thy/ZF_Specific.thy Wed Mar 04 10:45:52 2009 +0100
25.3 @@ -1,5 +1,3 @@
25.4 -(* $Id$ *)
25.5 -
25.6 theory ZF_Specific
25.7 imports Main
25.8 begin
26.1 --- a/doc-src/IsarRef/Thy/document/Document_Preparation.tex Wed Mar 04 10:43:39 2009 +0100
26.2 +++ b/doc-src/IsarRef/Thy/document/Document_Preparation.tex Wed Mar 04 10:45:52 2009 +0100
26.3 @@ -3,8 +3,6 @@
26.4 \def\isabellecontext{Document{\isacharunderscore}Preparation}%
26.5 %
26.6 \isadelimtheory
26.7 -\isanewline
26.8 -\isanewline
26.9 %
26.10 \endisadelimtheory
26.11 %
27.1 --- a/doc-src/IsarRef/Thy/document/Generic.tex Wed Mar 04 10:43:39 2009 +0100
27.2 +++ b/doc-src/IsarRef/Thy/document/Generic.tex Wed Mar 04 10:45:52 2009 +0100
27.3 @@ -3,8 +3,6 @@
27.4 \def\isabellecontext{Generic}%
27.5 %
27.6 \isadelimtheory
27.7 -\isanewline
27.8 -\isanewline
27.9 %
27.10 \endisadelimtheory
27.11 %
28.1 --- a/doc-src/IsarRef/Thy/document/HOLCF_Specific.tex Wed Mar 04 10:43:39 2009 +0100
28.2 +++ b/doc-src/IsarRef/Thy/document/HOLCF_Specific.tex Wed Mar 04 10:45:52 2009 +0100
28.3 @@ -3,8 +3,6 @@
28.4 \def\isabellecontext{HOLCF{\isacharunderscore}Specific}%
28.5 %
28.6 \isadelimtheory
28.7 -\isanewline
28.8 -\isanewline
28.9 %
28.10 \endisadelimtheory
28.11 %
29.1 --- a/doc-src/IsarRef/Thy/document/HOL_Specific.tex Wed Mar 04 10:43:39 2009 +0100
29.2 +++ b/doc-src/IsarRef/Thy/document/HOL_Specific.tex Wed Mar 04 10:45:52 2009 +0100
29.3 @@ -779,6 +779,58 @@
29.4 \end{isamarkuptext}%
29.5 \isamarkuptrue%
29.6 %
29.7 +\isamarkupsection{Intuitionistic proof search%
29.8 +}
29.9 +\isamarkuptrue%
29.10 +%
29.11 +\begin{isamarkuptext}%
29.12 +\begin{matharray}{rcl}
29.13 + \indexdef{HOL}{method}{iprover}\hypertarget{method.HOL.iprover}{\hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}}} & : & \isa{method} \\
29.14 + \end{matharray}
29.15 +
29.16 + \begin{rail}
29.17 + 'iprover' ('!' ?) (rulemod *)
29.18 + ;
29.19 + \end{rail}
29.20 +
29.21 + The \hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}} method performs intuitionistic proof
29.22 + search, depending on specifically declared rules from the context,
29.23 + or given as explicit arguments. Chained facts are inserted into the
29.24 + goal before commencing proof search; ``\hyperlink{method.HOL.iprover}{\mbox{\isa{iprover}}}\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' means to include the current \hyperlink{fact.prems}{\mbox{\isa{prems}}} as well.
29.25 +
29.26 + Rules need to be classified as \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}},
29.27 + \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, or \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}; here the
29.28 + ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' indicator refers to ``safe'' rules, which may be
29.29 + applied aggressively (without considering back-tracking later).
29.30 + Rules declared with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'' are ignored in proof search (the
29.31 + single-step \hyperlink{method.rule}{\mbox{\isa{rule}}} method still observes these). An
29.32 + explicit weight annotation may be given as well; otherwise the
29.33 + number of rule premises will be taken into account here.%
29.34 +\end{isamarkuptext}%
29.35 +\isamarkuptrue%
29.36 +%
29.37 +\isamarkupsection{Coherent Logic%
29.38 +}
29.39 +\isamarkuptrue%
29.40 +%
29.41 +\begin{isamarkuptext}%
29.42 +\begin{matharray}{rcl}
29.43 + \indexdef{HOL}{method}{coherent}\hypertarget{method.HOL.coherent}{\hyperlink{method.HOL.coherent}{\mbox{\isa{coherent}}}} & : & \isa{method} \\
29.44 + \end{matharray}
29.45 +
29.46 + \begin{rail}
29.47 + 'coherent' thmrefs?
29.48 + ;
29.49 + \end{rail}
29.50 +
29.51 + The \hyperlink{method.HOL.coherent}{\mbox{\isa{coherent}}} method solves problems of
29.52 + \emph{Coherent Logic} \cite{Bezem-Coquand:2005}, which covers
29.53 + applications in confluence theory, lattice theory and projective
29.54 + geometry. See \hyperlink{file.~~/src/HOL/ex/Coherent.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}HOL{\isacharslash}ex{\isacharslash}Coherent{\isachardot}thy}}}} for some
29.55 + examples.%
29.56 +\end{isamarkuptext}%
29.57 +\isamarkuptrue%
29.58 +%
29.59 \isamarkupsection{Invoking automated reasoning tools -- The Sledgehammer%
29.60 }
29.61 \isamarkuptrue%
30.1 --- a/doc-src/IsarRef/Thy/document/Inner_Syntax.tex Wed Mar 04 10:43:39 2009 +0100
30.2 +++ b/doc-src/IsarRef/Thy/document/Inner_Syntax.tex Wed Mar 04 10:45:52 2009 +0100
30.3 @@ -3,8 +3,6 @@
30.4 \def\isabellecontext{Inner{\isacharunderscore}Syntax}%
30.5 %
30.6 \isadelimtheory
30.7 -\isanewline
30.8 -\isanewline
30.9 %
30.10 \endisadelimtheory
30.11 %
30.12 @@ -120,19 +118,19 @@
30.13 %
30.14 \begin{isamarkuptext}%
30.15 \begin{mldecls}
30.16 - \indexml{show\_types}\verb|show_types: bool ref| & default \verb|false| \\
30.17 - \indexml{show\_sorts}\verb|show_sorts: bool ref| & default \verb|false| \\
30.18 - \indexml{show\_consts}\verb|show_consts: bool ref| & default \verb|false| \\
30.19 - \indexml{long\_names}\verb|long_names: bool ref| & default \verb|false| \\
30.20 - \indexml{short\_names}\verb|short_names: bool ref| & default \verb|false| \\
30.21 - \indexml{unique\_names}\verb|unique_names: bool ref| & default \verb|true| \\
30.22 - \indexml{show\_brackets}\verb|show_brackets: bool ref| & default \verb|false| \\
30.23 - \indexml{eta\_contract}\verb|eta_contract: bool ref| & default \verb|true| \\
30.24 - \indexml{goals\_limit}\verb|goals_limit: int ref| & default \verb|10| \\
30.25 - \indexml{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool ref| & default \verb|false| \\
30.26 - \indexml{show\_hyps}\verb|show_hyps: bool ref| & default \verb|false| \\
30.27 - \indexml{show\_tags}\verb|show_tags: bool ref| & default \verb|false| \\
30.28 - \indexml{show\_question\_marks}\verb|show_question_marks: bool ref| & default \verb|true| \\
30.29 + \indexdef{}{ML}{show\_types}\verb|show_types: bool ref| & default \verb|false| \\
30.30 + \indexdef{}{ML}{show\_sorts}\verb|show_sorts: bool ref| & default \verb|false| \\
30.31 + \indexdef{}{ML}{show\_consts}\verb|show_consts: bool ref| & default \verb|false| \\
30.32 + \indexdef{}{ML}{long\_names}\verb|long_names: bool ref| & default \verb|false| \\
30.33 + \indexdef{}{ML}{short\_names}\verb|short_names: bool ref| & default \verb|false| \\
30.34 + \indexdef{}{ML}{unique\_names}\verb|unique_names: bool ref| & default \verb|true| \\
30.35 + \indexdef{}{ML}{show\_brackets}\verb|show_brackets: bool ref| & default \verb|false| \\
30.36 + \indexdef{}{ML}{eta\_contract}\verb|eta_contract: bool ref| & default \verb|true| \\
30.37 + \indexdef{}{ML}{goals\_limit}\verb|goals_limit: int ref| & default \verb|10| \\
30.38 + \indexdef{}{ML}{Proof.show\_main\_goal}\verb|Proof.show_main_goal: bool ref| & default \verb|false| \\
30.39 + \indexdef{}{ML}{show\_hyps}\verb|show_hyps: bool ref| & default \verb|false| \\
30.40 + \indexdef{}{ML}{show\_tags}\verb|show_tags: bool ref| & default \verb|false| \\
30.41 + \indexdef{}{ML}{show\_question\_marks}\verb|show_question_marks: bool ref| & default \verb|true| \\
30.42 \end{mldecls}
30.43
30.44 These global ML variables control the detail of information that is
30.45 @@ -233,9 +231,9 @@
30.46 %
30.47 \begin{isamarkuptext}%
30.48 \begin{mldecls}
30.49 - \indexml{Pretty.setdepth}\verb|Pretty.setdepth: int -> unit| \\
30.50 - \indexml{Pretty.setmargin}\verb|Pretty.setmargin: int -> unit| \\
30.51 - \indexml{print\_depth}\verb|print_depth: int -> unit| \\
30.52 + \indexdef{}{ML}{Pretty.setdepth}\verb|Pretty.setdepth: int -> unit| \\
30.53 + \indexdef{}{ML}{Pretty.setmargin}\verb|Pretty.setmargin: int -> unit| \\
30.54 + \indexdef{}{ML}{print\_depth}\verb|print_depth: int -> unit| \\
30.55 \end{mldecls}
30.56
30.57 These ML functions set limits for pretty printed text.
30.58 @@ -392,7 +390,7 @@
30.59 \end{matharray}
30.60
30.61 \begin{rail}
30.62 - ('notation' | 'no\_notation') target? mode? (nameref structmixfix + 'and')
30.63 + ('notation' | 'no\_notation') target? mode? \\ (nameref structmixfix + 'and')
30.64 ;
30.65 \end{rail}
30.66
30.67 @@ -551,13 +549,15 @@
30.68 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}tid\ \ {\isacharbar}\ \ tvar\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|_| \\
30.69 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}tid{\isachardoublequote}} \verb|::| \isa{{\isachardoublequote}sort\ \ {\isacharbar}\ \ tvar\ \ {\isachardoublequote}}\verb|::| \isa{{\isachardoublequote}sort\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|_| \verb|::| \isa{{\isachardoublequote}sort{\isachardoublequote}} \\
30.70 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ id\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{id} \\
30.71 - & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}longid\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{longid} \\
30.72 + & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}longid\ \ {\isacharbar}\ \ type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isadigit{0}}\isactrlsup {\isacharparenright}\ longid{\isachardoublequote}} \\
30.73 + & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|(| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|)| \isa{longid} \\
30.74 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isacharparenright}{\isachardoublequote}} \verb|=>| \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
30.75 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}type\isactrlsup {\isacharparenleft}\isactrlsup {\isadigit{1}}\isactrlsup {\isacharparenright}{\isachardoublequote}} \isa{{\isachardoublequote}{\isasymRightarrow}{\isachardoublequote}} \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
30.76 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|[| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|]| \verb|=>| \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\
30.77 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|[| \isa{type} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{type} \verb|]| \isa{{\isachardoublequote}{\isasymRightarrow}{\isachardoublequote}} \isa{type} & \isa{{\isachardoublequote}{\isacharparenleft}{\isadigit{0}}{\isacharparenright}{\isachardoublequote}} \\\\
30.78
30.79 - \indexdef{inner}{syntax}{sort}\hypertarget{syntax.inner.sort}{\hyperlink{syntax.inner.sort}{\mbox{\isa{sort}}}} & = & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{}|\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|}| \\
30.80 + \indexdef{inner}{syntax}{sort}\hypertarget{syntax.inner.sort}{\hyperlink{syntax.inner.sort}{\mbox{\isa{sort}}}} & = & \isa{{\isachardoublequote}id\ \ {\isacharbar}\ \ longid\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|{}| \\
30.81 + & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \verb|{| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|,| \isa{{\isachardoublequote}{\isacharparenleft}id\ {\isacharbar}\ longid{\isacharparenright}{\isachardoublequote}} \verb|}| \\
30.82 \end{supertabular}
30.83 \end{center}
30.84
31.1 --- a/doc-src/IsarRef/Thy/document/Introduction.tex Wed Mar 04 10:43:39 2009 +0100
31.2 +++ b/doc-src/IsarRef/Thy/document/Introduction.tex Wed Mar 04 10:45:52 2009 +0100
31.3 @@ -3,8 +3,6 @@
31.4 \def\isabellecontext{Introduction}%
31.5 %
31.6 \isadelimtheory
31.7 -\isanewline
31.8 -\isanewline
31.9 %
31.10 \endisadelimtheory
31.11 %
31.12 @@ -32,27 +30,27 @@
31.13 The \emph{Isabelle} system essentially provides a generic
31.14 infrastructure for building deductive systems (programmed in
31.15 Standard ML), with a special focus on interactive theorem proving in
31.16 - higher-order logics. In the olden days even end-users would refer
31.17 - to certain ML functions (goal commands, tactics, tacticals etc.) to
31.18 - pursue their everyday theorem proving tasks
31.19 - \cite{isabelle-intro,isabelle-ref}.
31.20 + higher-order logics. Many years ago, even end-users would refer to
31.21 + certain ML functions (goal commands, tactics, tacticals etc.) to
31.22 + pursue their everyday theorem proving tasks.
31.23
31.24 In contrast \emph{Isar} provides an interpreted language environment
31.25 of its own, which has been specifically tailored for the needs of
31.26 theory and proof development. Compared to raw ML, the Isabelle/Isar
31.27 top-level provides a more robust and comfortable development
31.28 - platform, with proper support for theory development graphs,
31.29 - single-step transactions with unlimited undo, etc. The
31.30 - Isabelle/Isar version of the \emph{Proof~General} user interface
31.31 - \cite{proofgeneral,Aspinall:TACAS:2000} provides an adequate
31.32 - front-end for interactive theory and proof development in this
31.33 - advanced theorem proving environment.
31.34 + platform, with proper support for theory development graphs, managed
31.35 + transactions with unlimited undo etc. The Isabelle/Isar version of
31.36 + the \emph{Proof~General} user interface
31.37 + \cite{proofgeneral,Aspinall:TACAS:2000} provides a decent front-end
31.38 + for interactive theory and proof development in this advanced
31.39 + theorem proving environment, even though it is somewhat biased
31.40 + towards old-style proof scripts.
31.41
31.42 \medskip Apart from the technical advances over bare-bones ML
31.43 programming, the main purpose of the Isar language is to provide a
31.44 conceptually different view on machine-checked proofs
31.45 - \cite{Wenzel:1999:TPHOL,Wenzel-PhD}. ``Isar'' stands for
31.46 - ``Intelligible semi-automated reasoning''. Drawing from both the
31.47 + \cite{Wenzel:1999:TPHOL,Wenzel-PhD}. \emph{Isar} stands for
31.48 + \emph{Intelligible semi-automated reasoning}. Drawing from both the
31.49 traditions of informal mathematical proof texts and high-level
31.50 programming languages, Isar offers a versatile environment for
31.51 structured formal proof documents. Thus properly written Isar
31.52 @@ -67,12 +65,12 @@
31.53 Despite its grand design of structured proof texts, Isar is able to
31.54 assimilate the old tactical style as an ``improper'' sub-language.
31.55 This provides an easy upgrade path for existing tactic scripts, as
31.56 - well as additional means for interactive experimentation and
31.57 - debugging of structured proofs. Isabelle/Isar supports a broad
31.58 - range of proof styles, both readable and unreadable ones.
31.59 + well as some means for interactive experimentation and debugging of
31.60 + structured proofs. Isabelle/Isar supports a broad range of proof
31.61 + styles, both readable and unreadable ones.
31.62
31.63 - \medskip The Isabelle/Isar framework \cite{Wenzel:2006:Festschrift}
31.64 - is generic and should work reasonably well for any Isabelle
31.65 + \medskip The generic Isabelle/Isar framework (see
31.66 + \chref{ch:isar-framework}) works reasonably well for any Isabelle
31.67 object-logic that conforms to the natural deduction view of the
31.68 Isabelle/Pure framework. Specific language elements introduced by
31.69 the major object-logics are described in \chref{ch:hol}
31.70 @@ -92,207 +90,6 @@
31.71 \end{isamarkuptext}%
31.72 \isamarkuptrue%
31.73 %
31.74 -\isamarkupsection{User interfaces%
31.75 -}
31.76 -\isamarkuptrue%
31.77 -%
31.78 -\isamarkupsubsection{Terminal sessions%
31.79 -}
31.80 -\isamarkuptrue%
31.81 -%
31.82 -\begin{isamarkuptext}%
31.83 -The Isabelle \texttt{tty} tool provides a very interface for running
31.84 - the Isar interaction loop, with some support for command line
31.85 - editing. For example:
31.86 -\begin{ttbox}
31.87 -isabelle tty\medskip
31.88 -{\out Welcome to Isabelle/HOL (Isabelle2008)}\medskip
31.89 -theory Foo imports Main begin;
31.90 -definition foo :: nat where "foo == 1";
31.91 -lemma "0 < foo" by (simp add: foo_def);
31.92 -end;
31.93 -\end{ttbox}
31.94 -
31.95 - Any Isabelle/Isar command may be retracted by \hyperlink{command.undo}{\mbox{\isa{\isacommand{undo}}}}.
31.96 - See the Isabelle/Isar Quick Reference (\appref{ap:refcard}) for a
31.97 - comprehensive overview of available commands and other language
31.98 - elements.%
31.99 -\end{isamarkuptext}%
31.100 -\isamarkuptrue%
31.101 -%
31.102 -\isamarkupsubsection{Emacs Proof General%
31.103 -}
31.104 -\isamarkuptrue%
31.105 -%
31.106 -\begin{isamarkuptext}%
31.107 -Plain TTY-based interaction as above used to be quite feasible with
31.108 - traditional tactic based theorem proving, but developing Isar
31.109 - documents really demands some better user-interface support. The
31.110 - Proof~General environment by David Aspinall
31.111 - \cite{proofgeneral,Aspinall:TACAS:2000} offers a generic Emacs
31.112 - interface for interactive theorem provers that organizes all the
31.113 - cut-and-paste and forward-backward walk through the text in a very
31.114 - neat way. In Isabelle/Isar, the current position within a partial
31.115 - proof document is equally important than the actual proof state.
31.116 - Thus Proof~General provides the canonical working environment for
31.117 - Isabelle/Isar, both for getting acquainted (e.g.\ by replaying
31.118 - existing Isar documents) and for production work.%
31.119 -\end{isamarkuptext}%
31.120 -\isamarkuptrue%
31.121 -%
31.122 -\isamarkupsubsubsection{Proof~General as default Isabelle interface%
31.123 -}
31.124 -\isamarkuptrue%
31.125 -%
31.126 -\begin{isamarkuptext}%
31.127 -The Isabelle interface wrapper script provides an easy way to invoke
31.128 - Proof~General (including XEmacs or GNU Emacs). The default
31.129 - configuration of Isabelle is smart enough to detect the
31.130 - Proof~General distribution in several canonical places (e.g.\
31.131 - \verb|$ISABELLE_HOME/contrib/ProofGeneral|). Thus the
31.132 - capital \verb|Isabelle| executable would already refer to the
31.133 - \verb|ProofGeneral/isar| interface without further ado. The
31.134 - Isabelle interface script provides several options; pass \verb|-?| to see its usage.
31.135 -
31.136 - With the proper Isabelle interface setup, Isar documents may now be edited by
31.137 - visiting appropriate theory files, e.g.\
31.138 -\begin{ttbox}
31.139 -Isabelle \({\langle}isabellehome{\rangle}\)/src/HOL/Isar_examples/Summation.thy
31.140 -\end{ttbox}
31.141 - Beginners may note the tool bar for navigating forward and backward
31.142 - through the text (this depends on the local Emacs installation).
31.143 - Consult the Proof~General documentation \cite{proofgeneral} for
31.144 - further basic command sequences, in particular ``\verb|C-c C-return|''
31.145 - and ``\verb|C-c u|''.
31.146 -
31.147 - \medskip Proof~General may be also configured manually by giving
31.148 - Isabelle settings like this (see also \cite{isabelle-sys}):
31.149 -
31.150 -\begin{ttbox}
31.151 -ISABELLE_INTERFACE=\$ISABELLE_HOME/contrib/ProofGeneral/isar/interface
31.152 -PROOFGENERAL_OPTIONS=""
31.153 -\end{ttbox}
31.154 - You may have to change \verb|$ISABELLE_HOME/contrib/ProofGeneral| to the actual installation
31.155 - directory of Proof~General.
31.156 -
31.157 - \medskip Apart from the Isabelle command line, defaults for
31.158 - interface options may be given by the \verb|PROOFGENERAL_OPTIONS|
31.159 - setting. For example, the Emacs executable to be used may be
31.160 - configured in Isabelle's settings like this:
31.161 -\begin{ttbox}
31.162 -PROOFGENERAL_OPTIONS="-p xemacs-mule"
31.163 -\end{ttbox}
31.164 -
31.165 - Occasionally, a user's \verb|~/.emacs| file contains code
31.166 - that is incompatible with the (X)Emacs version used by
31.167 - Proof~General, causing the interface startup to fail prematurely.
31.168 - Here the \verb|-u false| option helps to get the interface
31.169 - process up and running. Note that additional Lisp customization
31.170 - code may reside in \verb|proofgeneral-settings.el| of
31.171 - \verb|$ISABELLE_HOME/etc| or \verb|$ISABELLE_HOME_USER/etc|.%
31.172 -\end{isamarkuptext}%
31.173 -\isamarkuptrue%
31.174 -%
31.175 -\isamarkupsubsubsection{The X-Symbol package%
31.176 -}
31.177 -\isamarkuptrue%
31.178 -%
31.179 -\begin{isamarkuptext}%
31.180 -Proof~General incorporates a version of the Emacs X-Symbol package
31.181 - \cite{x-symbol}, which handles proper mathematical symbols displayed
31.182 - on screen. Pass option \verb|-x true| to the Isabelle
31.183 - interface script, or check the appropriate Proof~General menu
31.184 - setting by hand. The main challenge of getting X-Symbol to work
31.185 - properly is the underlying (semi-automated) X11 font setup.
31.186 -
31.187 - \medskip Using proper mathematical symbols in Isabelle theories can
31.188 - be very convenient for readability of large formulas. On the other
31.189 - hand, the plain ASCII sources easily become somewhat unintelligible.
31.190 - For example, \isa{{\isachardoublequote}{\isasymLongrightarrow}{\isachardoublequote}} would appear as \verb|\<Longrightarrow>| according
31.191 - the default set of Isabelle symbols. Nevertheless, the Isabelle
31.192 - document preparation system (see \chref{ch:document-prep}) will be
31.193 - happy to print non-ASCII symbols properly. It is even possible to
31.194 - invent additional notation beyond the display capabilities of Emacs
31.195 - and X-Symbol.%
31.196 -\end{isamarkuptext}%
31.197 -\isamarkuptrue%
31.198 -%
31.199 -\isamarkupsection{Isabelle/Isar theories%
31.200 -}
31.201 -\isamarkuptrue%
31.202 -%
31.203 -\begin{isamarkuptext}%
31.204 -Isabelle/Isar offers the following main improvements over classic
31.205 - Isabelle.
31.206 -
31.207 - \begin{enumerate}
31.208 -
31.209 - \item A \emph{theory format} that integrates specifications and
31.210 - proofs, supporting interactive development and unlimited undo
31.211 - operation.
31.212 -
31.213 - \item A \emph{formal proof document language} designed to support
31.214 - intelligible semi-automated reasoning. Instead of putting together
31.215 - unreadable tactic scripts, the author is enabled to express the
31.216 - reasoning in way that is close to usual mathematical practice. The
31.217 - old tactical style has been assimilated as ``improper'' language
31.218 - elements.
31.219 -
31.220 - \item A simple document preparation system, for typesetting formal
31.221 - developments together with informal text. The resulting
31.222 - hyper-linked PDF documents are equally well suited for WWW
31.223 - presentation and as printed copies.
31.224 -
31.225 - \end{enumerate}
31.226 -
31.227 - The Isar proof language is embedded into the new theory format as a
31.228 - proper sub-language. Proof mode is entered by stating some
31.229 - \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}} or \hyperlink{command.lemma}{\mbox{\isa{\isacommand{lemma}}}} at the theory level, and
31.230 - left again with the final conclusion (e.g.\ via \hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}).
31.231 - A few theory specification mechanisms also require some proof, such
31.232 - as HOL's \hyperlink{command.typedef}{\mbox{\isa{\isacommand{typedef}}}} which demands non-emptiness of the
31.233 - representing sets.%
31.234 -\end{isamarkuptext}%
31.235 -\isamarkuptrue%
31.236 -%
31.237 -\isamarkupsection{How to write Isar proofs anyway? \label{sec:isar-howto}%
31.238 -}
31.239 -\isamarkuptrue%
31.240 -%
31.241 -\begin{isamarkuptext}%
31.242 -This is one of the key questions, of course. First of all, the
31.243 - tactic script emulation of Isabelle/Isar essentially provides a
31.244 - clarified version of the very same unstructured proof style of
31.245 - classic Isabelle. Old-time users should quickly become acquainted
31.246 - with that (slightly degenerative) view of Isar.
31.247 -
31.248 - Writing \emph{proper} Isar proof texts targeted at human readers is
31.249 - quite different, though. Experienced users of the unstructured
31.250 - style may even have to unlearn some of their habits to master proof
31.251 - composition in Isar. In contrast, new users with less experience in
31.252 - old-style tactical proving, but a good understanding of mathematical
31.253 - proof in general, often get started easier.
31.254 -
31.255 - \medskip The present text really is only a reference manual on
31.256 - Isabelle/Isar, not a tutorial. Nevertheless, we will attempt to
31.257 - give some clues of how the concepts introduced here may be put into
31.258 - practice. Especially note that \appref{ap:refcard} provides a quick
31.259 - reference card of the most common Isabelle/Isar language elements.
31.260 -
31.261 - Further issues concerning the Isar concepts are covered in the
31.262 - literature
31.263 - \cite{Wenzel:1999:TPHOL,Wiedijk:2000:MV,Bauer-Wenzel:2000:HB,Bauer-Wenzel:2001}.
31.264 - The author's PhD thesis \cite{Wenzel-PhD} presently provides the
31.265 - most complete exposition of Isar foundations, techniques, and
31.266 - applications. A number of example applications are distributed with
31.267 - Isabelle, and available via the Isabelle WWW library (e.g.\
31.268 - \url{http://isabelle.in.tum.de/library/}). The ``Archive of Formal
31.269 - Proofs'' \url{http://afp.sourceforge.net/} also provides plenty of
31.270 - examples, both in proper Isar proof style and unstructured tactic
31.271 - scripts.%
31.272 -\end{isamarkuptext}%
31.273 -\isamarkuptrue%
31.274 -%
31.275 \isadelimtheory
31.276 %
31.277 \endisadelimtheory
32.1 --- a/doc-src/IsarRef/Thy/document/ML_Tactic.tex Wed Mar 04 10:43:39 2009 +0100
32.2 +++ b/doc-src/IsarRef/Thy/document/ML_Tactic.tex Wed Mar 04 10:45:52 2009 +0100
32.3 @@ -3,8 +3,6 @@
32.4 \def\isabellecontext{ML{\isacharunderscore}Tactic}%
32.5 %
32.6 \isadelimtheory
32.7 -\isanewline
32.8 -\isanewline
32.9 %
32.10 \endisadelimtheory
32.11 %
33.1 --- a/doc-src/IsarRef/Thy/document/Misc.tex Wed Mar 04 10:43:39 2009 +0100
33.2 +++ b/doc-src/IsarRef/Thy/document/Misc.tex Wed Mar 04 10:45:52 2009 +0100
33.3 @@ -3,8 +3,6 @@
33.4 \def\isabellecontext{Misc}%
33.5 %
33.6 \isadelimtheory
33.7 -\isanewline
33.8 -\isanewline
33.9 %
33.10 \endisadelimtheory
33.11 %
34.1 --- a/doc-src/IsarRef/Thy/document/Outer_Syntax.tex Wed Mar 04 10:43:39 2009 +0100
34.2 +++ b/doc-src/IsarRef/Thy/document/Outer_Syntax.tex Wed Mar 04 10:45:52 2009 +0100
34.3 @@ -3,8 +3,6 @@
34.4 \def\isabellecontext{Outer{\isacharunderscore}Syntax}%
34.5 %
34.6 \isadelimtheory
34.7 -\isanewline
34.8 -\isanewline
34.9 %
34.10 \endisadelimtheory
34.11 %
34.12 @@ -185,10 +183,10 @@
34.13 Isabelle as \verb|\<forall>|. There are infinitely many Isabelle
34.14 symbols like this, although proper presentation is left to front-end
34.15 tools such as {\LaTeX} or Proof~General with the X-Symbol package.
34.16 - A list of standard Isabelle symbols that work well with these tools
34.17 - is given in \appref{app:symbols}. Note that \verb|\<lambda>| does
34.18 - not belong to the \isa{letter} category, since it is already used
34.19 - differently in the Pure term language.%
34.20 + A list of predefined Isabelle symbols that work well with these
34.21 + tools is given in \appref{app:symbols}. Note that \verb|\<lambda>|
34.22 + does not belong to the \isa{letter} category, since it is already
34.23 + used differently in the Pure term language.%
34.24 \end{isamarkuptext}%
34.25 \isamarkuptrue%
34.26 %
35.1 --- a/doc-src/IsarRef/Thy/document/Proof.tex Wed Mar 04 10:43:39 2009 +0100
35.2 +++ b/doc-src/IsarRef/Thy/document/Proof.tex Wed Mar 04 10:45:52 2009 +0100
35.3 @@ -3,8 +3,6 @@
35.4 \def\isabellecontext{Proof}%
35.5 %
35.6 \isadelimtheory
35.7 -\isanewline
35.8 -\isanewline
35.9 %
35.10 \endisadelimtheory
35.11 %
35.12 @@ -20,7 +18,7 @@
35.13 %
35.14 \endisadelimtheory
35.15 %
35.16 -\isamarkupchapter{Proofs%
35.17 +\isamarkupchapter{Proofs \label{ch:proofs}%
35.18 }
35.19 \isamarkuptrue%
35.20 %
35.21 @@ -28,8 +26,8 @@
35.22 Proof commands perform transitions of Isar/VM machine
35.23 configurations, which are block-structured, consisting of a stack of
35.24 nodes with three main components: logical proof context, current
35.25 - facts, and open goals. Isar/VM transitions are \emph{typed}
35.26 - according to the following three different modes of operation:
35.27 + facts, and open goals. Isar/VM transitions are typed according to
35.28 + the following three different modes of operation:
35.29
35.30 \begin{description}
35.31
35.32 @@ -49,13 +47,17 @@
35.33
35.34 \end{description}
35.35
35.36 - The proof mode indicator may be read as a verb telling the writer
35.37 - what kind of operation may be performed next. The corresponding
35.38 - typings of proof commands restricts the shape of well-formed proof
35.39 - texts to particular command sequences. So dynamic arrangements of
35.40 - commands eventually turn out as static texts of a certain structure.
35.41 - \Appref{ap:refcard} gives a simplified grammar of the overall
35.42 - (extensible) language emerging that way.%
35.43 + The proof mode indicator may be understood as an instruction to the
35.44 + writer, telling what kind of operation may be performed next. The
35.45 + corresponding typings of proof commands restricts the shape of
35.46 + well-formed proof texts to particular command sequences. So dynamic
35.47 + arrangements of commands eventually turn out as static texts of a
35.48 + certain structure.
35.49 +
35.50 + \Appref{ap:refcard} gives a simplified grammar of the (extensible)
35.51 + language emerging that way from the different types of proof
35.52 + commands. The main ideas of the overall Isar framework are
35.53 + explained in \chref{ch:isar-framework}.%
35.54 \end{isamarkuptext}%
35.55 \isamarkuptrue%
35.56 %
35.57 @@ -691,7 +693,6 @@
35.58 \indexdef{}{method}{assumption}\hypertarget{method.assumption}{\hyperlink{method.assumption}{\mbox{\isa{assumption}}}} & : & \isa{method} \\
35.59 \indexdef{}{method}{this}\hypertarget{method.this}{\hyperlink{method.this}{\mbox{\isa{this}}}} & : & \isa{method} \\
35.60 \indexdef{}{method}{rule}\hypertarget{method.rule}{\hyperlink{method.rule}{\mbox{\isa{rule}}}} & : & \isa{method} \\
35.61 - \indexdef{}{method}{iprover}\hypertarget{method.iprover}{\hyperlink{method.iprover}{\mbox{\isa{iprover}}}} & : & \isa{method} \\[0.5ex]
35.62 \indexdef{Pure}{attribute}{intro}\hypertarget{attribute.Pure.intro}{\hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}}} & : & \isa{attribute} \\
35.63 \indexdef{Pure}{attribute}{elim}\hypertarget{attribute.Pure.elim}{\hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}} & : & \isa{attribute} \\
35.64 \indexdef{Pure}{attribute}{dest}\hypertarget{attribute.Pure.dest}{\hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}} & : & \isa{attribute} \\
35.65 @@ -706,8 +707,6 @@
35.66 ;
35.67 'rule' thmrefs?
35.68 ;
35.69 - 'iprover' ('!' ?) (rulemod *)
35.70 - ;
35.71 rulemod: ('intro' | 'elim' | 'dest') ((('!' | () | '?') nat?) | 'del') ':' thmrefs
35.72 ;
35.73 ('intro' | 'elim' | 'dest') ('!' | () | '?') nat?
35.74 @@ -762,26 +761,11 @@
35.75 default behavior of \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}} and ``\hyperlink{command.ddot}{\mbox{\isa{\isacommand{{\isachardot}{\isachardot}}}}}''
35.76 (double-dot) steps (see \secref{sec:proof-steps}).
35.77
35.78 - \item \hyperlink{method.iprover}{\mbox{\isa{iprover}}} performs intuitionistic proof search,
35.79 - depending on specifically declared rules from the context, or given
35.80 - as explicit arguments. Chained facts are inserted into the goal
35.81 - before commencing proof search; ``\hyperlink{method.iprover}{\mbox{\isa{iprover}}}\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}''
35.82 - means to include the current \hyperlink{fact.prems}{\mbox{\isa{prems}}} as well.
35.83 -
35.84 - Rules need to be classified as \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}},
35.85 - \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, or \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}}; here the
35.86 - ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' indicator refers to ``safe'' rules, which may be
35.87 - applied aggressively (without considering back-tracking later).
35.88 - Rules declared with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'' are ignored in proof search (the
35.89 - single-step \hyperlink{method.rule}{\mbox{\isa{rule}}} method still observes these). An
35.90 - explicit weight annotation may be given as well; otherwise the
35.91 - number of rule premises will be taken into account here.
35.92 -
35.93 \item \hyperlink{attribute.Pure.intro}{\mbox{\isa{intro}}}, \hyperlink{attribute.Pure.elim}{\mbox{\isa{elim}}}, and
35.94 \hyperlink{attribute.Pure.dest}{\mbox{\isa{dest}}} declare introduction, elimination, and
35.95 - destruct rules, to be used with the \hyperlink{method.rule}{\mbox{\isa{rule}}} and \hyperlink{method.iprover}{\mbox{\isa{iprover}}} methods. Note that the latter will ignore rules declared
35.96 - with ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'', while ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' are used most
35.97 - aggressively.
35.98 + destruct rules, to be used with method \hyperlink{method.rule}{\mbox{\isa{rule}}}, and similar
35.99 + tools. Note that the latter will ignore rules declared with
35.100 + ``\isa{{\isachardoublequote}{\isacharquery}{\isachardoublequote}}'', while ``\isa{{\isachardoublequote}{\isacharbang}{\isachardoublequote}}'' are used most aggressively.
35.101
35.102 The classical reasoner (see \secref{sec:classical}) introduces its
35.103 own variants of these attributes; use qualified names to access the
35.104 @@ -966,7 +950,7 @@
35.105 \begin{matharray}{l}
35.106 \isa{{\isachardoublequote}{\isasymlangle}using\ b\isactrlsub {\isadigit{1}}\ {\isasymdots}\ b\isactrlsub k{\isasymrangle}{\isachardoublequote}}~~\hyperlink{command.obtain}{\mbox{\isa{\isacommand{obtain}}}}~\isa{{\isachardoublequote}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m\ {\isasymWHERE}\ a{\isacharcolon}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ \ {\isasymlangle}proof{\isasymrangle}\ {\isasymequiv}{\isachardoublequote}} \\[1ex]
35.107 \quad \hyperlink{command.have}{\mbox{\isa{\isacommand{have}}}}~\isa{{\isachardoublequote}{\isasymAnd}thesis{\isachardot}\ {\isacharparenleft}{\isasymAnd}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m{\isachardot}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymLongrightarrow}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ {\isasymLongrightarrow}\ thesis{\isacharparenright}\ {\isasymLongrightarrow}\ thesis{\isachardoublequote}} \\
35.108 - \quad \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{succeed} \\
35.109 + \quad \hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\hyperlink{method.succeed}{\mbox{\isa{succeed}}} \\
35.110 \qquad \hyperlink{command.fix}{\mbox{\isa{\isacommand{fix}}}}~\isa{thesis} \\
35.111 \qquad \hyperlink{command.assume}{\mbox{\isa{\isacommand{assume}}}}~\isa{{\isachardoublequote}that\ {\isacharbrackleft}Pure{\isachardot}intro{\isacharquery}{\isacharbrackright}{\isacharcolon}\ {\isasymAnd}x\isactrlsub {\isadigit{1}}\ {\isasymdots}\ x\isactrlsub m{\isachardot}\ {\isasymphi}\isactrlsub {\isadigit{1}}\ {\isasymLongrightarrow}\ {\isasymdots}\ {\isasymphi}\isactrlsub n\ {\isasymLongrightarrow}\ thesis{\isachardoublequote}} \\
35.112 \qquad \hyperlink{command.then}{\mbox{\isa{\isacommand{then}}}}~\hyperlink{command.show}{\mbox{\isa{\isacommand{show}}}}~\isa{thesis} \\
36.1 --- a/doc-src/IsarRef/Thy/document/Quick_Reference.tex Wed Mar 04 10:43:39 2009 +0100
36.2 +++ b/doc-src/IsarRef/Thy/document/Quick_Reference.tex Wed Mar 04 10:45:52 2009 +0100
36.3 @@ -3,8 +3,6 @@
36.4 \def\isabellecontext{Quick{\isacharunderscore}Reference}%
36.5 %
36.6 \isadelimtheory
36.7 -\isanewline
36.8 -\isanewline
36.9 %
36.10 \endisadelimtheory
36.11 %
36.12 @@ -52,7 +50,7 @@
36.13
36.14 \begin{tabular}{rcl}
36.15 \isa{{\isachardoublequote}theory{\isasymdash}stmt{\isachardoublequote}} & = & \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}name{\isacharcolon}\ props\ proof\ \ {\isacharbar}{\isachardoublequote}}~~\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isasymdots}\ \ {\isacharbar}\ \ {\isasymdots}{\isachardoublequote}} \\[1ex]
36.16 - \isa{{\isachardoublequote}proof{\isachardoublequote}} & = & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{{\isachardoublequote}method\ stmt\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}~\isa{method} \\
36.17 + \isa{{\isachardoublequote}proof{\isachardoublequote}} & = & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.proof}{\mbox{\isa{\isacommand{proof}}}}~\isa{{\isachardoublequote}method\isactrlsup {\isacharquery}\ stmt\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}~\isa{{\isachardoublequote}method\isactrlsup {\isacharquery}{\isachardoublequote}} \\
36.18 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \isa{{\isachardoublequote}prfx\isactrlsup {\isacharasterisk}{\isachardoublequote}}~\hyperlink{command.done}{\mbox{\isa{\isacommand{done}}}} \\[1ex]
36.19 \isa{prfx} & = & \hyperlink{command.apply}{\mbox{\isa{\isacommand{apply}}}}~\isa{method} \\
36.20 & \isa{{\isachardoublequote}{\isacharbar}{\isachardoublequote}} & \hyperlink{command.using}{\mbox{\isa{\isacommand{using}}}}~\isa{{\isachardoublequote}facts{\isachardoublequote}} \\
37.1 --- a/doc-src/IsarRef/Thy/document/Spec.tex Wed Mar 04 10:43:39 2009 +0100
37.2 +++ b/doc-src/IsarRef/Thy/document/Spec.tex Wed Mar 04 10:45:52 2009 +0100
37.3 @@ -22,6 +22,23 @@
37.4 }
37.5 \isamarkuptrue%
37.6 %
37.7 +\begin{isamarkuptext}%
37.8 +The Isabelle/Isar theory format integrates specifications and
37.9 + proofs, supporting interactive development with unlimited undo
37.10 + operation. There is an integrated document preparation system (see
37.11 + \chref{ch:document-prep}), for typesetting formal developments
37.12 + together with informal text. The resulting hyper-linked PDF
37.13 + documents can be used both for WWW presentation and printed copies.
37.14 +
37.15 + The Isar proof language (see \chref{ch:proofs}) is embedded into the
37.16 + theory language as a proper sub-language. Proof mode is entered by
37.17 + stating some \hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}} or \hyperlink{command.lemma}{\mbox{\isa{\isacommand{lemma}}}} at the theory
37.18 + level, and left again with the final conclusion (e.g.\ via \hyperlink{command.qed}{\mbox{\isa{\isacommand{qed}}}}). Some theory specification mechanisms also require a proof,
37.19 + such as \hyperlink{command.typedef}{\mbox{\isa{\isacommand{typedef}}}} in HOL, which demands non-emptiness of
37.20 + the representing sets.%
37.21 +\end{isamarkuptext}%
37.22 +\isamarkuptrue%
37.23 +%
37.24 \isamarkupsection{Defining theories \label{sec:begin-thy}%
37.25 }
37.26 \isamarkuptrue%
37.27 @@ -127,8 +144,9 @@
37.28 \hyperlink{command.global.end}{\mbox{\isa{\isacommand{end}}}} has a different meaning: it concludes the
37.29 theory itself (\secref{sec:begin-thy}).
37.30
37.31 - \item \isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}{\isachardoublequote}} given after any local theory command
37.32 - specifies an immediate target, e.g.\ ``\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}'' or ``\hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}''. This works both in a local or
37.33 + \item \isa{{\isachardoublequote}{\isacharparenleft}{\isachardoublequote}}\indexdef{}{keyword}{in}\hypertarget{keyword.in}{\hyperlink{keyword.in}{\mbox{\isa{\isakeyword{in}}}}}~\isa{{\isachardoublequote}c{\isacharparenright}{\isachardoublequote}} given after any
37.34 + local theory command specifies an immediate target, e.g.\
37.35 + ``\hyperlink{command.definition}{\mbox{\isa{\isacommand{definition}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}'' or ``\hyperlink{command.theorem}{\mbox{\isa{\isacommand{theorem}}}}~\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ c{\isacharparenright}\ {\isasymdots}{\isachardoublequote}}''. This works both in a local or
37.36 global theory context; the current target context will be suspended
37.37 for this command only. Note that ``\isa{{\isachardoublequote}{\isacharparenleft}{\isasymIN}\ {\isacharminus}{\isacharparenright}{\isachardoublequote}}'' will
37.38 always produce a global result independently of the current target
37.39 @@ -792,8 +810,8 @@
37.40 \end{matharray}
37.41
37.42 \begin{mldecls}
37.43 - \indexml{bind\_thms}\verb|bind_thms: string * thm list -> unit| \\
37.44 - \indexml{bind\_thm}\verb|bind_thm: string * thm -> unit| \\
37.45 + \indexdef{}{ML}{bind\_thms}\verb|bind_thms: string * thm list -> unit| \\
37.46 + \indexdef{}{ML}{bind\_thm}\verb|bind_thm: string * thm -> unit| \\
37.47 \end{mldecls}
37.48
37.49 \begin{rail}
37.50 @@ -1178,7 +1196,7 @@
37.51
37.52 \end{description}
37.53
37.54 - See \hyperlink{file.~~/src/FOL/ex/IffOracle.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}FOL{\isacharslash}ex{\isacharslash}IffOracle{\isachardot}thy}}}} for a worked example of
37.55 + See \hyperlink{file.~~/src/FOL/ex/Iff-Oracle.thy}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}FOL{\isacharslash}ex{\isacharslash}Iff{\isacharunderscore}Oracle{\isachardot}thy}}}} for a worked example of
37.56 defining a new primitive rule as oracle, and turning it into a proof
37.57 method.%
37.58 \end{isamarkuptext}%
38.1 --- a/doc-src/IsarRef/Thy/document/Symbols.tex Wed Mar 04 10:43:39 2009 +0100
38.2 +++ b/doc-src/IsarRef/Thy/document/Symbols.tex Wed Mar 04 10:45:52 2009 +0100
38.3 @@ -3,8 +3,6 @@
38.4 \def\isabellecontext{Symbols}%
38.5 %
38.6 \isadelimtheory
38.7 -\isanewline
38.8 -\isanewline
38.9 %
38.10 \endisadelimtheory
38.11 %
38.12 @@ -20,7 +18,7 @@
38.13 %
38.14 \endisadelimtheory
38.15 %
38.16 -\isamarkupchapter{Standard Isabelle symbols \label{app:symbols}%
38.17 +\isamarkupchapter{Predefined Isabelle symbols \label{app:symbols}%
38.18 }
38.19 \isamarkuptrue%
38.20 %
39.1 --- a/doc-src/IsarRef/Thy/document/ZF_Specific.tex Wed Mar 04 10:43:39 2009 +0100
39.2 +++ b/doc-src/IsarRef/Thy/document/ZF_Specific.tex Wed Mar 04 10:45:52 2009 +0100
39.3 @@ -3,8 +3,6 @@
39.4 \def\isabellecontext{ZF{\isacharunderscore}Specific}%
39.5 %
39.6 \isadelimtheory
39.7 -\isanewline
39.8 -\isanewline
39.9 %
39.10 \endisadelimtheory
39.11 %
40.1 --- a/doc-src/IsarRef/isar-ref.tex Wed Mar 04 10:43:39 2009 +0100
40.2 +++ b/doc-src/IsarRef/isar-ref.tex Wed Mar 04 10:45:52 2009 +0100
40.3 @@ -1,6 +1,3 @@
40.4 -
40.5 -%% $Id$
40.6 -
40.7 \documentclass[12pt,a4paper,fleqn]{report}
40.8 \usepackage{amssymb}
40.9 \usepackage[greek,english]{babel}
40.10 @@ -27,12 +24,13 @@
40.11 With Contributions by
40.12 Clemens Ballarin,
40.13 Stefan Berghofer, \\
40.14 + Timothy Bourke
40.15 Lucas Dixon,
40.16 - Florian Haftmann,
40.17 - Gerwin Klein, \\
40.18 + Florian Haftmann, \\
40.19 + Gerwin Klein,
40.20 Alexander Krauss,
40.21 - Tobias Nipkow,
40.22 - David von Oheimb, \\
40.23 + Tobias Nipkow, \\
40.24 + David von Oheimb,
40.25 Larry Paulson,
40.26 and Sebastian Skalberg
40.27 }
40.28 @@ -82,7 +80,11 @@
40.29
40.30 \pagenumbering{roman} \tableofcontents \clearfirst
40.31
40.32 +\part{Basic Concepts}
40.33 \input{Thy/document/Introduction.tex}
40.34 +\input{Thy/document/Framework.tex}
40.35 +\input{Thy/document/First_Order_Logic.tex}
40.36 +\part{General Language Elements}
40.37 \input{Thy/document/Outer_Syntax.tex}
40.38 \input{Thy/document/Document_Preparation.tex}
40.39 \input{Thy/document/Spec.tex}
40.40 @@ -90,10 +92,12 @@
40.41 \input{Thy/document/Inner_Syntax.tex}
40.42 \input{Thy/document/Misc.tex}
40.43 \input{Thy/document/Generic.tex}
40.44 +\part{Object-Logics}
40.45 \input{Thy/document/HOL_Specific.tex}
40.46 \input{Thy/document/HOLCF_Specific.tex}
40.47 \input{Thy/document/ZF_Specific.tex}
40.48
40.49 +\part{Appendix}
40.50 \appendix
40.51 \input{Thy/document/Quick_Reference.tex}
40.52 \let\int\intorig
40.53 @@ -101,7 +105,7 @@
40.54 \input{Thy/document/ML_Tactic.tex}
40.55
40.56 \begingroup
40.57 - \bibliographystyle{plain} \small\raggedright\frenchspacing
40.58 + \bibliographystyle{abbrv} \small\raggedright\frenchspacing
40.59 \bibliography{../manual}
40.60 \endgroup
40.61
41.1 --- a/doc-src/IsarRef/style.sty Wed Mar 04 10:43:39 2009 +0100
41.2 +++ b/doc-src/IsarRef/style.sty Wed Mar 04 10:45:52 2009 +0100
41.3 @@ -1,6 +1,3 @@
41.4 -
41.5 -%% $Id$
41.6 -
41.7 %% toc
41.8 \newcommand{\tocentry}[1]{\cleardoublepage\phantomsection\addcontentsline{toc}{chapter}{#1}
41.9 \@mkboth{\MakeUppercase{#1}}{\MakeUppercase{#1}}}
41.10 @@ -18,12 +15,17 @@
41.11
41.12 %% ML
41.13 \newenvironment{mldecls}{\par\noindent\begingroup\def\isanewline{\\}\begin{tabular}{ll}}{\end{tabular}\medskip\endgroup}
41.14 -\newcommand{\indexml}[1]{\index{#1 (ML value)|bold}}
41.15 +
41.16 +%% Isar
41.17 +\newcommand{\isasymBBAR}{{\,\newdimen{\tmpheight}\settoheight\tmpheight{\isacharbar}\rule{1pt}{\tmpheight}\,}}
41.18 +\isafoldtag{noproof}\def\isafoldnoproof{~\isafold{proof}}
41.19
41.20 %% math
41.21 +\newcommand{\isasymstrut}{\isamath{\mathstrut}}
41.22 +\newcommand{\isasymvartheta}{\isamath{\,\theta}}
41.23 \newcommand{\isactrlvec}[1]{\emph{$\overline{#1}$}}
41.24 \renewcommand{\isadigit}[1]{\isamath{#1}}
41.25 -
41.26 +\newcommand{\text}[1]{\mbox{#1}}
41.27
41.28 %% global style options
41.29 \pagestyle{headings}
42.1 --- a/doc-src/Ref/Makefile Wed Mar 04 10:43:39 2009 +0100
42.2 +++ b/doc-src/Ref/Makefile Wed Mar 04 10:45:52 2009 +0100
42.3 @@ -1,6 +1,3 @@
42.4 -#
42.5 -# $Id$
42.6 -#
42.7
42.8 ## targets
42.9
42.10 @@ -12,16 +9,15 @@
42.11 include ../Makefile.in
42.12
42.13 NAME = ref
42.14 -FILES = ref.tex introduction.tex goals.tex tactic.tex tctical.tex \
42.15 - thm.tex theories.tex defining.tex syntax.tex substitution.tex \
42.16 - simplifier.tex classical.tex theory-syntax.tex \
42.17 - ../rail.sty ../proof.sty ../iman.sty ../extra.sty ../ttbox.sty ../manual.bib
42.18 +FILES = ref.tex introduction.tex tactic.tex tctical.tex thm.tex \
42.19 + theories.tex defining.tex syntax.tex substitution.tex \
42.20 + simplifier.tex classical.tex ../proof.sty ../iman.sty \
42.21 + ../extra.sty ../ttbox.sty ../manual.bib
42.22
42.23 dvi: $(NAME).dvi
42.24
42.25 $(NAME).dvi: $(FILES) isabelle.eps
42.26 $(LATEX) $(NAME)
42.27 - $(RAIL) $(NAME)
42.28 $(BIBTEX) $(NAME)
42.29 $(LATEX) $(NAME)
42.30 $(LATEX) $(NAME)
42.31 @@ -32,7 +28,6 @@
42.32
42.33 $(NAME).pdf: $(FILES) isabelle.pdf
42.34 $(PDFLATEX) $(NAME)
42.35 - $(RAIL) $(NAME)
42.36 $(BIBTEX) $(NAME)
42.37 $(PDFLATEX) $(NAME)
42.38 $(PDFLATEX) $(NAME)
43.1 --- a/doc-src/Ref/classical.tex Wed Mar 04 10:43:39 2009 +0100
43.2 +++ b/doc-src/Ref/classical.tex Wed Mar 04 10:45:52 2009 +0100
43.3 @@ -1,4 +1,4 @@
43.4 -%% $Id$
43.5 +
43.6 \chapter{The Classical Reasoner}\label{chap:classical}
43.7 \index{classical reasoner|(}
43.8 \newcommand\ainfer[2]{\begin{array}{r@{\,}l}#2\\ \hline#1\end{array}}
43.9 @@ -28,29 +28,6 @@
43.10 be traced, and their components can be called directly; in this manner,
43.11 any proof can be viewed interactively.
43.12
43.13 -The simplest way to apply the classical reasoner (to subgoal~$i$) is to type
43.14 -\begin{ttbox}
43.15 -by (Blast_tac \(i\));
43.16 -\end{ttbox}
43.17 -This command quickly proves most simple formulas of the predicate calculus or
43.18 -set theory. To attempt to prove subgoals using a combination of
43.19 -rewriting and classical reasoning, try
43.20 -\begin{ttbox}
43.21 -auto(); \emph{\textrm{applies to all subgoals}}
43.22 -force i; \emph{\textrm{applies to one subgoal}}
43.23 -\end{ttbox}
43.24 -To do all obvious logical steps, even if they do not prove the
43.25 -subgoal, type one of the following:
43.26 -\begin{ttbox}
43.27 -by Safe_tac; \emph{\textrm{applies to all subgoals}}
43.28 -by (Clarify_tac \(i\)); \emph{\textrm{applies to one subgoal}}
43.29 -\end{ttbox}
43.30 -
43.31 -
43.32 -You need to know how the classical reasoner works in order to use it
43.33 -effectively. There are many tactics to choose from, including
43.34 -{\tt Fast_tac} and \texttt{Best_tac}.
43.35 -
43.36 We shall first discuss the underlying principles, then present the classical
43.37 reasoner. Finally, we shall see how to instantiate it for new logics. The
43.38 logics FOL, ZF, HOL and HOLCF have it already installed.
44.1 --- a/doc-src/Ref/defining.tex Wed Mar 04 10:43:39 2009 +0100
44.2 +++ b/doc-src/Ref/defining.tex Wed Mar 04 10:45:52 2009 +0100
44.3 @@ -1,376 +1,5 @@
44.4 -%% $Id$
44.5 +
44.6 \chapter{Defining Logics} \label{Defining-Logics}
44.7 -This chapter explains how to define new formal systems --- in particular,
44.8 -their concrete syntax. While Isabelle can be regarded as a theorem prover
44.9 -for set theory, higher-order logic or the sequent calculus, its
44.10 -distinguishing feature is support for the definition of new logics.
44.11 -
44.12 -Isabelle logics are hierarchies of theories, which are described and
44.13 -illustrated in
44.14 -\iflabelundefined{sec:defining-theories}{{\em Introduction to Isabelle}}%
44.15 -{\S\ref{sec:defining-theories}}. That material, together with the theory
44.16 -files provided in the examples directories, should suffice for all simple
44.17 -applications. The easiest way to define a new theory is by modifying a
44.18 -copy of an existing theory.
44.19 -
44.20 -This chapter documents the meta-logic syntax, mixfix declarations and
44.21 -pretty printing. The extended examples in \S\ref{sec:min_logics}
44.22 -demonstrate the logical aspects of the definition of theories.
44.23 -
44.24 -
44.25 -\section{Priority grammars} \label{sec:priority_grammars}
44.26 -\index{priority grammars|(}
44.27 -
44.28 -A context-free grammar contains a set of {\bf nonterminal symbols}, a set of
44.29 -{\bf terminal symbols} and a set of {\bf productions}\index{productions}.
44.30 -Productions have the form ${A=\gamma}$, where $A$ is a nonterminal and
44.31 -$\gamma$ is a string of terminals and nonterminals. One designated
44.32 -nonterminal is called the {\bf start symbol}. The language defined by the
44.33 -grammar consists of all strings of terminals that can be derived from the
44.34 -start symbol by applying productions as rewrite rules.
44.35 -
44.36 -The syntax of an Isabelle logic is specified by a {\bf priority
44.37 - grammar}.\index{priorities} Each nonterminal is decorated by an integer
44.38 -priority, as in~$A^{(p)}$. A nonterminal $A^{(p)}$ in a derivation may be
44.39 -rewritten using a production $A^{(q)} = \gamma$ only if~$p \leq q$. Any
44.40 -priority grammar can be translated into a normal context free grammar by
44.41 -introducing new nonterminals and productions.
44.42 -
44.43 -Formally, a set of context free productions $G$ induces a derivation
44.44 -relation $\longrightarrow@G$. Let $\alpha$ and $\beta$ denote strings of
44.45 -terminal or nonterminal symbols. Then
44.46 -\[ \alpha\, A^{(p)}\, \beta ~\longrightarrow@G~ \alpha\,\gamma\,\beta \]
44.47 -if and only if $G$ contains some production $A^{(q)}=\gamma$ for~$p \leq q$.
44.48 -
44.49 -The following simple grammar for arithmetic expressions demonstrates how
44.50 -binding power and associativity of operators can be enforced by priorities.
44.51 -\begin{center}
44.52 -\begin{tabular}{rclr}
44.53 - $A^{(9)}$ & = & {\tt0} \\
44.54 - $A^{(9)}$ & = & {\tt(} $A^{(0)}$ {\tt)} \\
44.55 - $A^{(0)}$ & = & $A^{(0)}$ {\tt+} $A^{(1)}$ \\
44.56 - $A^{(2)}$ & = & $A^{(3)}$ {\tt*} $A^{(2)}$ \\
44.57 - $A^{(3)}$ & = & {\tt-} $A^{(3)}$
44.58 -\end{tabular}
44.59 -\end{center}
44.60 -The choice of priorities determines that {\tt -} binds tighter than {\tt *},
44.61 -which binds tighter than {\tt +}. Furthermore {\tt +} associates to the
44.62 -left and {\tt *} to the right.
44.63 -
44.64 -For clarity, grammars obey these conventions:
44.65 -\begin{itemize}
44.66 -\item All priorities must lie between~0 and \ttindex{max_pri}, which is a
44.67 - some fixed integer. Sometimes {\tt max_pri} is written as $\infty$.
44.68 -\item Priority 0 on the right-hand side and priority \ttindex{max_pri} on
44.69 - the left-hand side may be omitted.
44.70 -\item The production $A^{(p)} = \alpha$ is written as $A = \alpha~(p)$; the
44.71 - priority of the left-hand side actually appears in a column on the far
44.72 - right.
44.73 -\item Alternatives are separated by~$|$.
44.74 -\item Repetition is indicated by dots~(\dots) in an informal but obvious
44.75 - way.
44.76 -\end{itemize}
44.77 -
44.78 -Using these conventions and assuming $\infty=9$, the grammar
44.79 -takes the form
44.80 -\begin{center}
44.81 -\begin{tabular}{rclc}
44.82 -$A$ & = & {\tt0} & \hspace*{4em} \\
44.83 - & $|$ & {\tt(} $A$ {\tt)} \\
44.84 - & $|$ & $A$ {\tt+} $A^{(1)}$ & (0) \\
44.85 - & $|$ & $A^{(3)}$ {\tt*} $A^{(2)}$ & (2) \\
44.86 - & $|$ & {\tt-} $A^{(3)}$ & (3)
44.87 -\end{tabular}
44.88 -\end{center}
44.89 -\index{priority grammars|)}
44.90 -
44.91 -
44.92 -\begin{figure}\small
44.93 -\begin{center}
44.94 -\begin{tabular}{rclc}
44.95 -$any$ &=& $prop$ ~~$|$~~ $logic$ \\\\
44.96 -$prop$ &=& {\tt(} $prop$ {\tt)} \\
44.97 - &$|$& $prop^{(4)}$ {\tt::} $type$ & (3) \\
44.98 - &$|$& {\tt PROP} $aprop$ \\
44.99 - &$|$& $any^{(3)}$ {\tt ==} $any^{(2)}$ & (2) \\
44.100 - &$|$& $any^{(3)}$ {\tt =?=} $any^{(2)}$ & (2) \\
44.101 - &$|$& $prop^{(2)}$ {\tt ==>} $prop^{(1)}$ & (1) \\
44.102 - &$|$& {\tt[|} $prop$ {\tt;} \dots {\tt;} $prop$ {\tt|]} {\tt==>} $prop^{(1)}$ & (1) \\
44.103 - &$|$& {\tt!!} $idts$ {\tt.} $prop$ & (0) \\
44.104 - &$|$& {\tt OFCLASS} {\tt(} $type$ {\tt,} $logic$ {\tt)} \\\\
44.105 -$aprop$ &=& $id$ ~~$|$~~ $longid$ ~~$|$~~ $var$
44.106 - ~~$|$~~ $logic^{(\infty)}$ {\tt(} $any$ {\tt,} \dots {\tt,} $any$ {\tt)} \\\\
44.107 -$logic$ &=& {\tt(} $logic$ {\tt)} \\
44.108 - &$|$& $logic^{(4)}$ {\tt::} $type$ & (3) \\
44.109 - &$|$& $id$ ~~$|$~~ $longid$ ~~$|$~~ $var$
44.110 - ~~$|$~~ $logic^{(\infty)}$ {\tt(} $any$ {\tt,} \dots {\tt,} $any$ {\tt)} \\
44.111 - &$|$& {\tt \%} $pttrns$ {\tt.} $any^{(3)}$ & (3) \\
44.112 - &$|$& {\tt TYPE} {\tt(} $type$ {\tt)} \\\\
44.113 -$idts$ &=& $idt$ ~~$|$~~ $idt^{(1)}$ $idts$ \\\\
44.114 -$idt$ &=& $id$ ~~$|$~~ {\tt(} $idt$ {\tt)} \\
44.115 - &$|$& $id$ {\tt ::} $type$ & (0) \\\\
44.116 -$pttrns$ &=& $pttrn$ ~~$|$~~ $pttrn^{(1)}$ $pttrns$ \\\\
44.117 -$pttrn$ &=& $idt$ \\\\
44.118 -$type$ &=& {\tt(} $type$ {\tt)} \\
44.119 - &$|$& $tid$ ~~$|$~~ $tvar$ ~~$|$~~ $tid$ {\tt::} $sort$
44.120 - ~~$|$~~ $tvar$ {\tt::} $sort$ \\
44.121 - &$|$& $id$ ~~$|$~~ $type^{(\infty)}$ $id$
44.122 - ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $id$ \\
44.123 - &$|$& $longid$ ~~$|$~~ $type^{(\infty)}$ $longid$
44.124 - ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $longid$ \\
44.125 - &$|$& $type^{(1)}$ {\tt =>} $type$ & (0) \\
44.126 - &$|$& {\tt[} $type$ {\tt,} \dots {\tt,} $type$ {\tt]} {\tt=>} $type$&(0) \\\\
44.127 -$sort$ &=& $id$ ~~$|$~~ $longid$ ~~$|$~~ {\tt\ttlbrace\ttrbrace} ~~$|$~~
44.128 - {\tt\ttlbrace} $id$ ~$|$~ $longid${\tt,}\dots{\tt,} $id$ ~$|$~$longid$ {\tt\ttrbrace}
44.129 -\end{tabular}
44.130 -\index{*PROP symbol}
44.131 -\index{*== symbol}\index{*=?= symbol}\index{*==> symbol}
44.132 -\index{*:: symbol}\index{*=> symbol}
44.133 -\index{sort constraints}
44.134 -%the index command: a percent is permitted, but braces must match!
44.135 -\index{%@{\tt\%} symbol}
44.136 -\index{{}@{\tt\ttlbrace} symbol}\index{{}@{\tt\ttrbrace} symbol}
44.137 -\index{*[ symbol}\index{*] symbol}
44.138 -\index{*"!"! symbol}
44.139 -\index{*"["| symbol}
44.140 -\index{*"|"] symbol}
44.141 -\end{center}
44.142 -\caption{Meta-logic syntax}\label{fig:pure_gram}
44.143 -\end{figure}
44.144 -
44.145 -
44.146 -\section{The Pure syntax} \label{sec:basic_syntax}
44.147 -\index{syntax!Pure|(}
44.148 -
44.149 -At the root of all object-logics lies the theory \thydx{Pure}. It
44.150 -contains, among many other things, the Pure syntax. An informal account of
44.151 -this basic syntax (types, terms and formulae) appears in
44.152 -\iflabelundefined{sec:forward}{{\em Introduction to Isabelle}}%
44.153 -{\S\ref{sec:forward}}. A more precise description using a priority grammar
44.154 -appears in Fig.\ts\ref{fig:pure_gram}. It defines the following
44.155 -nonterminals:
44.156 -\begin{ttdescription}
44.157 - \item[\ndxbold{any}] denotes any term.
44.158 -
44.159 - \item[\ndxbold{prop}] denotes terms of type {\tt prop}. These are formulae
44.160 - of the meta-logic. Note that user constants of result type {\tt prop}
44.161 - (i.e.\ $c :: \ldots \To prop$) should always provide concrete syntax.
44.162 - Otherwise atomic propositions with head $c$ may be printed incorrectly.
44.163 -
44.164 - \item[\ndxbold{aprop}] denotes atomic propositions.
44.165 -
44.166 -%% FIXME huh!?
44.167 -% These typically
44.168 -% include the judgement forms of the object-logic; its definition
44.169 -% introduces a meta-level predicate for each judgement form.
44.170 -
44.171 - \item[\ndxbold{logic}] denotes terms whose type belongs to class
44.172 - \cldx{logic}, excluding type \tydx{prop}.
44.173 -
44.174 - \item[\ndxbold{idts}] denotes a list of identifiers, possibly constrained
44.175 - by types.
44.176 -
44.177 - \item[\ndxbold{pttrn}, \ndxbold{pttrns}] denote patterns for
44.178 - abstraction, cases etc. Initially the same as $idt$ and $idts$,
44.179 - these are intended to be augmented by user extensions.
44.180 -
44.181 - \item[\ndxbold{type}] denotes types of the meta-logic.
44.182 -
44.183 - \item[\ndxbold{sort}] denotes meta-level sorts.
44.184 -\end{ttdescription}
44.185 -
44.186 -\begin{warn}
44.187 - In {\tt idts}, note that \verb|x::nat y| is parsed as \verb|x::(nat y)|,
44.188 - treating {\tt y} like a type constructor applied to {\tt nat}. The
44.189 - likely result is an error message. To avoid this interpretation, use
44.190 - parentheses and write \verb|(x::nat) y|.
44.191 - \index{type constraints}\index{*:: symbol}
44.192 -
44.193 - Similarly, \verb|x::nat y::nat| is parsed as \verb|x::(nat y::nat)| and
44.194 - yields an error. The correct form is \verb|(x::nat) (y::nat)|.
44.195 -\end{warn}
44.196 -
44.197 -\begin{warn}
44.198 - Type constraints bind very weakly. For example, \verb!x<y::nat! is normally
44.199 - parsed as \verb!(x<y)::nat!, unless \verb$<$ has priority of 3 or less, in
44.200 - which case the string is likely to be ambiguous. The correct form is
44.201 - \verb!x<(y::nat)!.
44.202 -\end{warn}
44.203 -
44.204 -\subsection{Logical types and default syntax}\label{logical-types}
44.205 -\index{lambda calc@$\lambda$-calculus}
44.206 -
44.207 -Isabelle's representation of mathematical languages is based on the
44.208 -simply typed $\lambda$-calculus. All logical types, namely those of
44.209 -class \cldx{logic}, are automatically equipped with a basic syntax of
44.210 -types, identifiers, variables, parentheses, $\lambda$-abstraction and
44.211 -application.
44.212 -\begin{warn}
44.213 - Isabelle combines the syntaxes for all types of class \cldx{logic} by
44.214 - mapping all those types to the single nonterminal $logic$. Thus all
44.215 - productions of $logic$, in particular $id$, $var$ etc, become available.
44.216 -\end{warn}
44.217 -
44.218 -
44.219 -\subsection{Lexical matters}
44.220 -The parser does not process input strings directly. It operates on token
44.221 -lists provided by Isabelle's \bfindex{lexer}. There are two kinds of
44.222 -tokens: \bfindex{delimiters} and \bfindex{name tokens}.
44.223 -
44.224 -\index{reserved words}
44.225 -Delimiters can be regarded as reserved words of the syntax. You can
44.226 -add new ones when extending theories. In Fig.\ts\ref{fig:pure_gram} they
44.227 -appear in typewriter font, for example {\tt ==}, {\tt =?=} and
44.228 -{\tt PROP}\@.
44.229 -
44.230 -Name tokens have a predefined syntax. The lexer distinguishes six disjoint
44.231 -classes of names: \rmindex{identifiers}, \rmindex{unknowns}, type
44.232 -identifiers\index{type identifiers}, type unknowns\index{type unknowns},
44.233 -\rmindex{numerals}, \rmindex{strings}. They are denoted by \ndxbold{id},
44.234 -\ndxbold{var}, \ndxbold{tid}, \ndxbold{tvar}, \ndxbold{num}, \ndxbold{xnum},
44.235 -\ndxbold{xstr}, respectively. Typical examples are {\tt x}, {\tt ?x7}, {\tt
44.236 - 'a}, {\tt ?'a3}, {\tt \#42}, {\tt ''foo bar''}. Here is the precise syntax:
44.237 -\begin{eqnarray*}
44.238 -id & = & letter\,quasiletter^* \\
44.239 -longid & = & id (\mbox{\tt .}id)^+ \\
44.240 -var & = & \mbox{\tt ?}id ~~|~~ \mbox{\tt ?}id\mbox{\tt .}nat \\
44.241 -tid & = & \mbox{\tt '}id \\
44.242 -tvar & = & \mbox{\tt ?}tid ~~|~~
44.243 - \mbox{\tt ?}tid\mbox{\tt .}nat \\
44.244 -num & = & nat ~~|~~ \mbox{\tt-}nat ~~|~~ \verb,0x,\,hex^+ ~~|~~ \verb,0b,\,bin^+ \\
44.245 -xnum & = & \mbox{\tt \#}num \\
44.246 -xstr & = & \mbox{\tt ''~\dots~\tt ''} \\[1ex]
44.247 -letter & = & latin ~|~ \verb,\<,latin\verb,>, ~|~ \verb,\<,latin\,latin\verb,>, ~|~ greek ~| \\
44.248 - & & \verb,\<^isub>, ~|~ \verb,\<^isup>, \\
44.249 -quasiletter & = & letter ~|~ digit ~|~ \verb,_, ~|~ \verb,', \\
44.250 -latin & = & \verb,a, ~|~ \dots ~|~ \verb,z, ~|~ \verb,A, ~|~ \dots ~|~ \verb,Z, \\
44.251 -digit & = & \verb,0, ~|~ \dots ~|~ \verb,9, \\
44.252 -nat & = & digit^+ \\
44.253 -bin & = & \verb,0, ~|~ \verb,1, \\
44.254 -hex & = & digit ~|~ \verb,a, ~|~ \dots ~|~ \verb,f, ~|~ \verb,A, ~|~ \dots ~|~ \verb,F, \\
44.255 -greek & = & \verb,\<alpha>, ~|~ \verb,\<beta>, ~|~ \verb,\<gamma>, ~|~ \verb,\<delta>, ~| \\
44.256 - & & \verb,\<epsilon>, ~|~ \verb,\<zeta>, ~|~ \verb,\<eta>, ~|~ \verb,\<theta>, ~| \\
44.257 - & & \verb,\<iota>, ~|~ \verb,\<kappa>, ~|~ \verb,\<mu>, ~|~ \verb,\<nu>, ~| \\
44.258 - & & \verb,\<xi>, ~|~ \verb,\<pi>, ~|~ \verb,\<rho>, ~|~ \verb,\<sigma>, ~| \\
44.259 - & & \verb,\<tau>, ~|~ \verb,\<upsilon>, ~|~ \verb,\<phi>, ~|~ \verb,\<psi>, ~| \\
44.260 - & & \verb,\<omega>, ~|~ \verb,\<Gamma>, ~|~ \verb,\<Delta>, ~|~ \verb,\<Theta>, ~| \\
44.261 - & & \verb,\<Lambda>, ~|~ \verb,\<Xi>, ~|~ \verb,\<Pi>, ~|~ \verb,\<Sigma>, ~| \\
44.262 - & & \verb,\<Upsilon>, ~|~ \verb,\<Phi>, ~|~ \verb,\<Psi>, ~|~ \verb,\<Omega>, \\
44.263 -\end{eqnarray*}
44.264 -The lexer repeatedly takes the longest prefix of the input string that
44.265 -forms a valid token. A maximal prefix that is both a delimiter and a
44.266 -name is treated as a delimiter. Spaces, tabs, newlines and formfeeds
44.267 -are separators; they never occur within tokens, except those of class
44.268 -$xstr$.
44.269 -
44.270 -\medskip
44.271 -Delimiters need not be separated by white space. For example, if {\tt -}
44.272 -is a delimiter but {\tt --} is not, then the string {\tt --} is treated as
44.273 -two consecutive occurrences of the token~{\tt -}. In contrast, \ML\
44.274 -treats {\tt --} as a single symbolic name. The consequence of Isabelle's
44.275 -more liberal scheme is that the same string may be parsed in different ways
44.276 -after extending the syntax: after adding {\tt --} as a delimiter, the input
44.277 -{\tt --} is treated as a single token.
44.278 -
44.279 -A \ndxbold{var} or \ndxbold{tvar} describes an unknown, which is internally
44.280 -a pair of base name and index (\ML\ type \mltydx{indexname}). These
44.281 -components are either separated by a dot as in {\tt ?x.1} or {\tt ?x7.3} or
44.282 -run together as in {\tt ?x1}. The latter form is possible if the base name
44.283 -does not end with digits. If the index is 0, it may be dropped altogether:
44.284 -{\tt ?x} abbreviates both {\tt ?x0} and {\tt ?x.0}.
44.285 -
44.286 -Tokens of class $num$, $xnum$ or $xstr$ are not used by the meta-logic.
44.287 -Object-logics may provide numerals and string constants by adding appropriate
44.288 -productions and translation functions.
44.289 -
44.290 -\medskip
44.291 -Although name tokens are returned from the lexer rather than the parser, it
44.292 -is more logical to regard them as nonterminals. Delimiters, however, are
44.293 -terminals; they are just syntactic sugar and contribute nothing to the
44.294 -abstract syntax tree.
44.295 -
44.296 -
44.297 -\subsection{*Inspecting the syntax} \label{pg:print_syn}
44.298 -\begin{ttbox}
44.299 -syn_of : theory -> Syntax.syntax
44.300 -print_syntax : theory -> unit
44.301 -Syntax.print_syntax : Syntax.syntax -> unit
44.302 -Syntax.print_gram : Syntax.syntax -> unit
44.303 -Syntax.print_trans : Syntax.syntax -> unit
44.304 -\end{ttbox}
44.305 -The abstract type \mltydx{Syntax.syntax} allows manipulation of syntaxes
44.306 -in \ML. You can display values of this type by calling the following
44.307 -functions:
44.308 -\begin{ttdescription}
44.309 -\item[\ttindexbold{syn_of} {\it thy}] returns the syntax of the Isabelle
44.310 - theory~{\it thy} as an \ML\ value.
44.311 -
44.312 -\item[\ttindexbold{print_syntax} $thy$] uses {\tt Syntax.print_syntax}
44.313 - to display the syntax part of theory $thy$.
44.314 -
44.315 -\item[\ttindexbold{Syntax.print_syntax} {\it syn}] shows virtually all
44.316 - information contained in the syntax {\it syn}. The displayed output can
44.317 - be large. The following two functions are more selective.
44.318 -
44.319 -\item[\ttindexbold{Syntax.print_gram} {\it syn}] shows the grammar part
44.320 - of~{\it syn}, namely the lexicon, logical types and productions. These are
44.321 - discussed below.
44.322 -
44.323 -\item[\ttindexbold{Syntax.print_trans} {\it syn}] shows the translation
44.324 - part of~{\it syn}, namely the constants, parse/print macros and
44.325 - parse/print translations.
44.326 -\end{ttdescription}
44.327 -
44.328 -The output of the above print functions is divided into labelled sections.
44.329 -The grammar is represented by {\tt lexicon}, {\tt logtypes} and {\tt prods}.
44.330 -The rest refers to syntactic translations and macro expansion. Here is an
44.331 -explanation of the various sections.
44.332 -\begin{description}
44.333 - \item[{\tt lexicon}] lists the delimiters used for lexical
44.334 - analysis.\index{delimiters}
44.335 -
44.336 - \item[{\tt logtypes}] lists the types that are regarded the same as {\tt
44.337 - logic} syntactically. Thus types of object-logics (e.g.\ {\tt nat}, say)
44.338 - will be automatically equipped with the standard syntax of
44.339 - $\lambda$-calculus.
44.340 -
44.341 - \item[{\tt prods}] lists the \rmindex{productions} of the priority grammar.
44.342 - The nonterminal $A^{(n)}$ is rendered in {\sc ascii} as {\tt $A$[$n$]}.
44.343 - Each delimiter is quoted. Some productions are shown with {\tt =>} and
44.344 - an attached string. These strings later become the heads of parse
44.345 - trees; they also play a vital role when terms are printed (see
44.346 - \S\ref{sec:asts}).
44.347 -
44.348 - Productions with no strings attached are called {\bf copy
44.349 - productions}\indexbold{productions!copy}. Their right-hand side must
44.350 - have exactly one nonterminal symbol (or name token). The parser does
44.351 - not create a new parse tree node for copy productions, but simply
44.352 - returns the parse tree of the right-hand symbol.
44.353 -
44.354 - If the right-hand side consists of a single nonterminal with no
44.355 - delimiters, then the copy production is called a {\bf chain
44.356 - production}. Chain productions act as abbreviations:
44.357 - conceptually, they are removed from the grammar by adding new
44.358 - productions. Priority information attached to chain productions is
44.359 - ignored; only the dummy value $-1$ is displayed.
44.360 -
44.361 - \item[\ttindex{print_modes}] lists the alternative print modes
44.362 - provided by this syntax (see \S\ref{sec:prmodes}).
44.363 -
44.364 - \item[{\tt consts}, {\tt parse_rules}, {\tt print_rules}]
44.365 - relate to macros (see \S\ref{sec:macros}).
44.366 -
44.367 - \item[{\tt parse_ast_translation}, {\tt print_ast_translation}]
44.368 - list sets of constants that invoke translation functions for abstract
44.369 - syntax trees. Section \S\ref{sec:asts} below discusses this obscure
44.370 - matter.\index{constants!for translations}
44.371 -
44.372 - \item[{\tt parse_translation}, {\tt print_translation}] list the sets
44.373 - of constants that invoke translation functions for terms (see
44.374 - \S\ref{sec:tr_funs}).
44.375 -\end{description}
44.376 -\index{syntax!Pure|)}
44.377 -
44.378
44.379 \section{Mixfix declarations} \label{sec:mixfix}
44.380 \index{mixfix declarations|(}
44.381 @@ -515,49 +144,6 @@
44.382 syntax}. Try this as an exercise and study the changes in the
44.383 grammar.
44.384
44.385 -\subsection{The mixfix template}
44.386 -Let us now take a closer look at the string $template$ appearing in mixfix
44.387 -annotations. This string specifies a list of parsing and printing
44.388 -directives: delimiters\index{delimiters}, arguments, spaces, blocks of
44.389 -indentation and line breaks. These are encoded by the following character
44.390 -sequences:
44.391 -\index{pretty printing|(}
44.392 -\begin{description}
44.393 -\item[~$d$~] is a delimiter, namely a non-empty sequence of characters
44.394 - other than the special characters {\tt _}, {\tt(}, {\tt)} and~{\tt/}.
44.395 - Even these characters may appear if escaped; this means preceding it with
44.396 - a~{\tt '} (single quote). Thus you have to write {\tt ''} if you really
44.397 - want a single quote. Furthermore, a~{\tt '} followed by a space separates
44.398 - delimiters without extra white space being added for printing.
44.399 -
44.400 -\item[~{\tt_}~] is an argument position, which stands for a nonterminal symbol
44.401 - or name token.
44.402 -
44.403 -\item[~$s$~] is a non-empty sequence of spaces for printing. This and the
44.404 - following specifications do not affect parsing at all.
44.405 -
44.406 -\item[~{\tt(}$n$~] opens a pretty printing block. The optional number $n$
44.407 - specifies how much indentation to add when a line break occurs within the
44.408 - block. If {\tt(} is not followed by digits, the indentation defaults
44.409 - to~0.
44.410 -
44.411 -\item[~{\tt)}~] closes a pretty printing block.
44.412 -
44.413 -\item[~{\tt//}~] forces a line break.
44.414 -
44.415 -\item[~{\tt/}$s$~] allows a line break. Here $s$ stands for the string of
44.416 - spaces (zero or more) right after the {\tt /} character. These spaces
44.417 - are printed if the break is not taken.
44.418 -\end{description}
44.419 -For example, the template {\tt"(_ +/ _)"} specifies an infix operator.
44.420 -There are two argument positions; the delimiter~{\tt+} is preceded by a
44.421 -space and followed by a space or line break; the entire phrase is a pretty
44.422 -printing block. Other examples appear in Fig.\ts\ref{fig:set_trans} below.
44.423 -Isabelle's pretty printer resembles the one described in
44.424 -Paulson~\cite{paulson-ml2}.
44.425 -
44.426 -\index{pretty printing|)}
44.427 -
44.428
44.429 \subsection{Infixes}
44.430 \indexbold{infixes}
44.431 @@ -723,141 +309,6 @@
44.432 ambiguity should be eliminated by changing the grammar or the rule.
44.433
44.434
44.435 -\section{Example: some minimal logics} \label{sec:min_logics}
44.436 -\index{examples!of logic definitions}
44.437 -
44.438 -This section presents some examples that have a simple syntax. They
44.439 -demonstrate how to define new object-logics from scratch.
44.440 -
44.441 -First we must define how an object-logic syntax is embedded into the
44.442 -meta-logic. Since all theorems must conform to the syntax for~\ndx{prop}
44.443 -(see Fig.\ts\ref{fig:pure_gram}), that syntax has to be extended with the
44.444 -object-level syntax. Assume that the syntax of your object-logic defines a
44.445 -meta-type~\tydx{o} of formulae which refers to the nonterminal {\tt logic}.
44.446 -These formulae can now appear in axioms and theorems wherever \ndx{prop} does
44.447 -if you add the production
44.448 -\[ prop ~=~ logic. \]
44.449 -This is not supposed to be a copy production but an implicit coercion from
44.450 -formulae to propositions:
44.451 -\begin{ttbox}
44.452 -Base = Pure +
44.453 -types
44.454 - o
44.455 -arities
44.456 - o :: logic
44.457 -consts
44.458 - Trueprop :: o => prop ("_" 5)
44.459 -end
44.460 -\end{ttbox}
44.461 -The constant \cdx{Trueprop} (the name is arbitrary) acts as an invisible
44.462 -coercion function. Assuming this definition resides in a file {\tt Base.thy},
44.463 -you have to load it with the command {\tt use_thy "Base"}.
44.464 -
44.465 -One of the simplest nontrivial logics is {\bf minimal logic} of
44.466 -implication. Its definition in Isabelle needs no advanced features but
44.467 -illustrates the overall mechanism nicely:
44.468 -\begin{ttbox}
44.469 -Hilbert = Base +
44.470 -consts
44.471 - "-->" :: [o, o] => o (infixr 10)
44.472 -rules
44.473 - K "P --> Q --> P"
44.474 - S "(P --> Q --> R) --> (P --> Q) --> P --> R"
44.475 - MP "[| P --> Q; P |] ==> Q"
44.476 -end
44.477 -\end{ttbox}
44.478 -After loading this definition from the file {\tt Hilbert.thy}, you can
44.479 -start to prove theorems in the logic:
44.480 -\begin{ttbox}
44.481 -Goal "P --> P";
44.482 -{\out Level 0}
44.483 -{\out P --> P}
44.484 -{\out 1. P --> P}
44.485 -\ttbreak
44.486 -by (resolve_tac [Hilbert.MP] 1);
44.487 -{\out Level 1}
44.488 -{\out P --> P}
44.489 -{\out 1. ?P --> P --> P}
44.490 -{\out 2. ?P}
44.491 -\ttbreak
44.492 -by (resolve_tac [Hilbert.MP] 1);
44.493 -{\out Level 2}
44.494 -{\out P --> P}
44.495 -{\out 1. ?P1 --> ?P --> P --> P}
44.496 -{\out 2. ?P1}
44.497 -{\out 3. ?P}
44.498 -\ttbreak
44.499 -by (resolve_tac [Hilbert.S] 1);
44.500 -{\out Level 3}
44.501 -{\out P --> P}
44.502 -{\out 1. P --> ?Q2 --> P}
44.503 -{\out 2. P --> ?Q2}
44.504 -\ttbreak
44.505 -by (resolve_tac [Hilbert.K] 1);
44.506 -{\out Level 4}
44.507 -{\out P --> P}
44.508 -{\out 1. P --> ?Q2}
44.509 -\ttbreak
44.510 -by (resolve_tac [Hilbert.K] 1);
44.511 -{\out Level 5}
44.512 -{\out P --> P}
44.513 -{\out No subgoals!}
44.514 -\end{ttbox}
44.515 -As we can see, this Hilbert-style formulation of minimal logic is easy to
44.516 -define but difficult to use. The following natural deduction formulation is
44.517 -better:
44.518 -\begin{ttbox}
44.519 -MinI = Base +
44.520 -consts
44.521 - "-->" :: [o, o] => o (infixr 10)
44.522 -rules
44.523 - impI "(P ==> Q) ==> P --> Q"
44.524 - impE "[| P --> Q; P |] ==> Q"
44.525 -end
44.526 -\end{ttbox}
44.527 -Note, however, that although the two systems are equivalent, this fact
44.528 -cannot be proved within Isabelle. Axioms {\tt S} and {\tt K} can be
44.529 -derived in {\tt MinI} (exercise!), but {\tt impI} cannot be derived in {\tt
44.530 - Hilbert}. The reason is that {\tt impI} is only an {\bf admissible} rule
44.531 -in {\tt Hilbert}, something that can only be shown by induction over all
44.532 -possible proofs in {\tt Hilbert}.
44.533 -
44.534 -We may easily extend minimal logic with falsity:
44.535 -\begin{ttbox}
44.536 -MinIF = MinI +
44.537 -consts
44.538 - False :: o
44.539 -rules
44.540 - FalseE "False ==> P"
44.541 -end
44.542 -\end{ttbox}
44.543 -On the other hand, we may wish to introduce conjunction only:
44.544 -\begin{ttbox}
44.545 -MinC = Base +
44.546 -consts
44.547 - "&" :: [o, o] => o (infixr 30)
44.548 -\ttbreak
44.549 -rules
44.550 - conjI "[| P; Q |] ==> P & Q"
44.551 - conjE1 "P & Q ==> P"
44.552 - conjE2 "P & Q ==> Q"
44.553 -end
44.554 -\end{ttbox}
44.555 -And if we want to have all three connectives together, we create and load a
44.556 -theory file consisting of a single line:
44.557 -\begin{ttbox}
44.558 -MinIFC = MinIF + MinC
44.559 -\end{ttbox}
44.560 -Now we can prove mixed theorems like
44.561 -\begin{ttbox}
44.562 -Goal "P & False --> Q";
44.563 -by (resolve_tac [MinI.impI] 1);
44.564 -by (dresolve_tac [MinC.conjE2] 1);
44.565 -by (eresolve_tac [MinIF.FalseE] 1);
44.566 -\end{ttbox}
44.567 -Try this as an exercise!
44.568 -
44.569 -
44.570 %%% Local Variables:
44.571 %%% mode: latex
44.572 %%% TeX-master: "ref"
45.1 --- a/doc-src/Ref/introduction.tex Wed Mar 04 10:43:39 2009 +0100
45.2 +++ b/doc-src/Ref/introduction.tex Wed Mar 04 10:45:52 2009 +0100
45.3 @@ -1,23 +1,5 @@
45.4 -
45.5 -%% $Id$
45.6
45.7 \chapter{Basic Use of Isabelle}\index{sessions|(}
45.8 -The Reference Manual is a comprehensive description of Isabelle
45.9 -proper, including all \ML{} commands, functions and packages. It
45.10 -really is intended for reference, perhaps for browsing, but not for
45.11 -reading through. It is not a tutorial, but assumes familiarity with
45.12 -the basic logical concepts of Isabelle.
45.13 -
45.14 -When you are looking for a way of performing some task, scan the Table of
45.15 -Contents for a relevant heading. Functions are organized by their purpose,
45.16 -by their operands (subgoals, tactics, theorems), and by their usefulness.
45.17 -In each section, basic functions appear first, then advanced functions, and
45.18 -finally esoteric functions. Use the Index when you are looking for the
45.19 -definition of a particular Isabelle function.
45.20 -
45.21 -A few examples are presented. Many example files are distributed with
45.22 -Isabelle, however; please experiment interactively.
45.23 -
45.24
45.25 \section{Basic interaction with Isabelle}
45.26 \index{starting up|bold}\nobreak
45.27 @@ -217,109 +199,6 @@
45.28 value is returned.
45.29
45.30
45.31 -\section{Printing of terms and theorems}\label{sec:printing-control}
45.32 -\index{printing control|(}
45.33 -Isabelle's pretty printer is controlled by a number of parameters.
45.34 -
45.35 -\subsection{Printing limits}
45.36 -\begin{ttbox}
45.37 -Pretty.setdepth : int -> unit
45.38 -Pretty.setmargin : int -> unit
45.39 -print_depth : int -> unit
45.40 -\end{ttbox}
45.41 -These set limits for terminal output. See also {\tt goals_limit},
45.42 -which limits the number of subgoals printed
45.43 -(\S\ref{sec:goals-printing}).
45.44 -
45.45 -\begin{ttdescription}
45.46 -\item[\ttindexbold{Pretty.setdepth} \(d\);] tells Isabelle's pretty printer to
45.47 - limit the printing depth to~$d$. This affects the display of theorems and
45.48 - terms. The default value is~0, which permits printing to an arbitrary
45.49 - depth. Useful values for $d$ are~10 and~20.
45.50 -
45.51 -\item[\ttindexbold{Pretty.setmargin} \(m\);]
45.52 - tells Isabelle's pretty printer to assume a right margin (page width)
45.53 - of~$m$. The initial margin is~76.
45.54 -
45.55 -\item[\ttindexbold{print_depth} \(n\);]
45.56 - limits the printing depth of complex \ML{} values, such as theorems and
45.57 - terms. This command affects the \ML{} top level and its effect is
45.58 - compiler-dependent. Typically $n$ should be less than~10.
45.59 -\end{ttdescription}
45.60 -
45.61 -
45.62 -\subsection{Printing of hypotheses, brackets, types etc.}
45.63 -\index{meta-assumptions!printing of}
45.64 -\index{types!printing of}\index{sorts!printing of}
45.65 -\begin{ttbox}
45.66 -show_hyps : bool ref \hfill{\bf initially false}
45.67 -show_tags : bool ref \hfill{\bf initially false}
45.68 -show_brackets : bool ref \hfill{\bf initially false}
45.69 -show_types : bool ref \hfill{\bf initially false}
45.70 -show_sorts : bool ref \hfill{\bf initially false}
45.71 -show_consts : bool ref \hfill{\bf initially false}
45.72 -long_names : bool ref \hfill{\bf initially false}
45.73 -\end{ttbox}
45.74 -These flags allow you to control how much information is displayed for
45.75 -types, terms and theorems. The hypotheses of theorems \emph{are}
45.76 -normally shown. Superfluous parentheses of types and terms are not.
45.77 -Types and sorts of variables are normally hidden.
45.78 -
45.79 -Note that displaying types and sorts may explain why a polymorphic
45.80 -inference rule fails to resolve with some goal, or why a rewrite rule
45.81 -does not apply as expected.
45.82 -
45.83 -\begin{ttdescription}
45.84 -
45.85 -\item[reset \ttindexbold{show_hyps};] makes Isabelle show each
45.86 - meta-level hypothesis as a dot.
45.87 -
45.88 -\item[set \ttindexbold{show_tags};] makes Isabelle show tags of theorems
45.89 - (which are basically just comments that may be attached by some tools).
45.90 -
45.91 -\item[set \ttindexbold{show_brackets};] makes Isabelle show full
45.92 - bracketing. In particular, this reveals the grouping of infix
45.93 - operators.
45.94 -
45.95 -\item[set \ttindexbold{show_types};] makes Isabelle show types when
45.96 - printing a term or theorem.
45.97 -
45.98 -\item[set \ttindexbold{show_sorts};] makes Isabelle show both types
45.99 - and the sorts of type variables, independently of the value of
45.100 - \texttt{show_types}.
45.101 -
45.102 -\item[set \ttindexbold{show_consts};] makes Isabelle show types of constants
45.103 - when printing proof states. Note that the output can be enormous as
45.104 - polymorphic constants often occur at several different type instances.
45.105 -
45.106 -\item[set \ttindexbold{long_names};] forces names of all objects
45.107 - (types, constants, theorems, etc.) to be printed in their fully
45.108 - qualified internal form.
45.109 -
45.110 -\end{ttdescription}
45.111 -
45.112 -
45.113 -\subsection{Eta-contraction before printing}
45.114 -\begin{ttbox}
45.115 -eta_contract: bool ref
45.116 -\end{ttbox}
45.117 -The {\bf $\eta$-contraction law} asserts $(\lambda x.f(x))\equiv f$,
45.118 -provided $x$ is not free in ~$f$. It asserts {\bf extensionality} of
45.119 -functions: $f\equiv g$ if $f(x)\equiv g(x)$ for all~$x$. Higher-order
45.120 -unification frequently puts terms into a fully $\eta$-expanded form. For
45.121 -example, if $F$ has type $(\tau\To\tau)\To\tau$ then its expanded form is
45.122 -$\lambda h.F(\lambda x.h(x))$. By default, the user sees this expanded
45.123 -form.
45.124 -
45.125 -\begin{ttdescription}
45.126 -\item[set \ttindexbold{eta_contract};]
45.127 -makes Isabelle perform $\eta$-contractions before printing, so that
45.128 -$\lambda h.F(\lambda x.h(x))$ appears simply as~$F$. The
45.129 -distinction between a term and its $\eta$-expanded form occasionally
45.130 -matters.
45.131 -\end{ttdescription}
45.132 -\index{printing control|)}
45.133 -
45.134 \section{Diagnostic messages}
45.135 \index{error messages}
45.136 \index{warnings}
45.137 @@ -351,40 +230,16 @@
45.138 \ttindex{warning} resume normal program execution.
45.139
45.140
45.141 -\section{Displaying exceptions as error messages}
45.142 -\index{exceptions!printing of}
45.143 +\section{Timing}
45.144 +\index{timing statistics}\index{proofs!timing}
45.145 \begin{ttbox}
45.146 -print_exn: exn -> 'a
45.147 +timing: bool ref \hfill{\bf initially false}
45.148 \end{ttbox}
45.149 -Certain Isabelle primitives, such as the forward proof functions {\tt RS}
45.150 -and {\tt RSN}, are called both interactively and from programs. They
45.151 -indicate errors not by printing messages, but by raising exceptions. For
45.152 -interactive use, \ML's reporting of an uncaught exception may be
45.153 -uninformative. The Poly/ML function {\tt exception_trace} can generate a
45.154 -backtrace.\index{Poly/{\ML} compiler}
45.155
45.156 \begin{ttdescription}
45.157 -\item[\ttindexbold{print_exn} $e$]
45.158 -displays the exception~$e$ in a readable manner, and then re-raises~$e$.
45.159 -Typical usage is~\hbox{\tt $EXP$ handle e => print_exn e;}, where
45.160 -$EXP$ is an expression that may raise an exception.
45.161 -
45.162 -{\tt print_exn} can display the following common exceptions, which concern
45.163 -types, terms, theorems and theories, respectively. Each carries a message
45.164 -and related information.
45.165 -\begin{ttbox}
45.166 -exception TYPE of string * typ list * term list
45.167 -exception TERM of string * term list
45.168 -exception THM of string * int * thm list
45.169 -exception THEORY of string * theory list
45.170 -\end{ttbox}
45.171 +\item[set \ttindexbold{timing};] enables global timing in Isabelle.
45.172 + This information is compiler-dependent.
45.173 \end{ttdescription}
45.174 -\begin{warn}
45.175 - {\tt print_exn} prints terms by calling \ttindex{prin}, which obtains
45.176 - pretty printing information from the proof state last stored in the
45.177 - subgoal module. The appearance of the output thus depends upon the
45.178 - theory used in the last interactive proof.
45.179 -\end{warn}
45.180
45.181 \index{sessions|)}
45.182
46.1 --- a/doc-src/Ref/ref.tex Wed Mar 04 10:43:39 2009 +0100
46.2 +++ b/doc-src/Ref/ref.tex Wed Mar 04 10:45:52 2009 +0100
46.3 @@ -1,13 +1,12 @@
46.4 \documentclass[12pt,a4paper]{report}
46.5 -\usepackage{graphicx,../iman,../extra,../ttbox,../proof,../rail,../pdfsetup}
46.6 +\usepackage{graphicx,../iman,../extra,../ttbox,../proof,../pdfsetup}
46.7
46.8 -%% $Id$
46.9 %%\includeonly{}
46.10 %%% to index ids: \[\\tt \([a-zA-Z0-9][a-zA-Z0-9_'.]*\) [\\ttindexbold{\1}
46.11 %%% to delete old ones: \\indexbold{\*[^}]*}
46.12 %% run sedindex ref to prepare index file
46.13 %%% needs chapter on Provers/typedsimp.ML?
46.14 -\title{\includegraphics[scale=0.5]{isabelle} \\[4ex] The Isabelle Reference Manual}
46.15 +\title{\includegraphics[scale=0.5]{isabelle} \\[4ex] Old Isabelle Reference Manual}
46.16
46.17 \author{{\em Lawrence C. Paulson}\\
46.18 Computer Laboratory \\ University of Cambridge \\
46.19 @@ -22,10 +21,6 @@
46.20 \sloppy
46.21 \binperiod %%%treat . like a binary operator
46.22
46.23 -\railalias{lbrace}{\ttlbrace}
46.24 -\railalias{rbrace}{\ttrbrace}
46.25 -\railterm{lbrace,rbrace}
46.26 -
46.27 \begin{document}
46.28 \underscoreoff
46.29
46.30 @@ -34,17 +29,10 @@
46.31 \index{meta-rules|see{meta-rules}}
46.32
46.33 \maketitle
46.34 -\emph{Note}: this document is part of the earlier Isabelle documentation,
46.35 -which is somewhat superseded by the Isabelle/HOL
46.36 -\emph{Tutorial}~\cite{isa-tutorial}. Much of it is concerned with
46.37 -the old-style theory syntax and the primitives for conducting proofs
46.38 -using the ML top level. This style of interaction is largely obsolete:
46.39 -most Isabelle proofs are now written using the Isar
46.40 -language and the Proof General interface. However, this is the only
46.41 -comprehensive Isabelle reference manual.
46.42 -
46.43 -See also the \emph{Introduction to Isabelle}, which has tutorial examples
46.44 -on conducting proofs using the ML top-level.
46.45 +\emph{Note}: this document is part of the earlier Isabelle
46.46 +documentation and is mostly outdated. Fully obsolete parts of the
46.47 +original text have already been removed. The remaining material
46.48 +covers some aspects that did not make it into the newer manuals yet.
46.49
46.50 \subsubsection*{Acknowledgements}
46.51 Tobias Nipkow, of T. U. Munich, wrote most of
46.52 @@ -62,7 +50,6 @@
46.53 \pagenumbering{roman} \tableofcontents \clearfirst
46.54
46.55 \include{introduction}
46.56 -\include{goals}
46.57 \include{tactic}
46.58 \include{tctical}
46.59 \include{thm}
47.1 --- a/doc-src/Ref/simplifier.tex Wed Mar 04 10:43:39 2009 +0100
47.2 +++ b/doc-src/Ref/simplifier.tex Wed Mar 04 10:45:52 2009 +0100
47.3 @@ -1,4 +1,4 @@
47.4 -%% $Id$
47.5 +
47.6 \chapter{Simplification}
47.7 \label{chap:simplification}
47.8 \index{simplification|(}
47.9 @@ -810,173 +810,6 @@
47.10 \end{warn}
47.11
47.12
47.13 -\section{Examples of using the Simplifier}
47.14 -\index{examples!of simplification} Assume we are working within {\tt
47.15 - FOL} (see the file \texttt{FOL/ex/Nat}) and that
47.16 -\begin{ttdescription}
47.17 -\item[Nat.thy]
47.18 - is a theory including the constants $0$, $Suc$ and $+$,
47.19 -\item[add_0]
47.20 - is the rewrite rule $0+\Var{n} = \Var{n}$,
47.21 -\item[add_Suc]
47.22 - is the rewrite rule $Suc(\Var{m})+\Var{n} = Suc(\Var{m}+\Var{n})$,
47.23 -\item[induct]
47.24 - is the induction rule $\List{\Var{P}(0);\; \Forall x. \Var{P}(x)\Imp
47.25 - \Var{P}(Suc(x))} \Imp \Var{P}(\Var{n})$.
47.26 -\end{ttdescription}
47.27 -We augment the implicit simpset inherited from \texttt{Nat} with the
47.28 -basic rewrite rules for addition of natural numbers:
47.29 -\begin{ttbox}
47.30 -Addsimps [add_0, add_Suc];
47.31 -\end{ttbox}
47.32 -
47.33 -\subsection{A trivial example}
47.34 -Proofs by induction typically involve simplification. Here is a proof
47.35 -that~0 is a right identity:
47.36 -\begin{ttbox}
47.37 -Goal "m+0 = m";
47.38 -{\out Level 0}
47.39 -{\out m + 0 = m}
47.40 -{\out 1. m + 0 = m}
47.41 -\end{ttbox}
47.42 -The first step is to perform induction on the variable~$m$. This returns a
47.43 -base case and inductive step as two subgoals:
47.44 -\begin{ttbox}
47.45 -by (res_inst_tac [("n","m")] induct 1);
47.46 -{\out Level 1}
47.47 -{\out m + 0 = m}
47.48 -{\out 1. 0 + 0 = 0}
47.49 -{\out 2. !!x. x + 0 = x ==> Suc(x) + 0 = Suc(x)}
47.50 -\end{ttbox}
47.51 -Simplification solves the first subgoal trivially:
47.52 -\begin{ttbox}
47.53 -by (Simp_tac 1);
47.54 -{\out Level 2}
47.55 -{\out m + 0 = m}
47.56 -{\out 1. !!x. x + 0 = x ==> Suc(x) + 0 = Suc(x)}
47.57 -\end{ttbox}
47.58 -The remaining subgoal requires \ttindex{Asm_simp_tac} in order to use the
47.59 -induction hypothesis as a rewrite rule:
47.60 -\begin{ttbox}
47.61 -by (Asm_simp_tac 1);
47.62 -{\out Level 3}
47.63 -{\out m + 0 = m}
47.64 -{\out No subgoals!}
47.65 -\end{ttbox}
47.66 -
47.67 -\subsection{An example of tracing}
47.68 -\index{tracing!of simplification|(}\index{*trace_simp}
47.69 -
47.70 -Let us prove a similar result involving more complex terms. We prove
47.71 -that addition is commutative.
47.72 -\begin{ttbox}
47.73 -Goal "m+Suc(n) = Suc(m+n)";
47.74 -{\out Level 0}
47.75 -{\out m + Suc(n) = Suc(m + n)}
47.76 -{\out 1. m + Suc(n) = Suc(m + n)}
47.77 -\end{ttbox}
47.78 -Performing induction on~$m$ yields two subgoals:
47.79 -\begin{ttbox}
47.80 -by (res_inst_tac [("n","m")] induct 1);
47.81 -{\out Level 1}
47.82 -{\out m + Suc(n) = Suc(m + n)}
47.83 -{\out 1. 0 + Suc(n) = Suc(0 + n)}
47.84 -{\out 2. !!x. x + Suc(n) = Suc(x + n) ==>}
47.85 -{\out Suc(x) + Suc(n) = Suc(Suc(x) + n)}
47.86 -\end{ttbox}
47.87 -Simplification solves the first subgoal, this time rewriting two
47.88 -occurrences of~0:
47.89 -\begin{ttbox}
47.90 -by (Simp_tac 1);
47.91 -{\out Level 2}
47.92 -{\out m + Suc(n) = Suc(m + n)}
47.93 -{\out 1. !!x. x + Suc(n) = Suc(x + n) ==>}
47.94 -{\out Suc(x) + Suc(n) = Suc(Suc(x) + n)}
47.95 -\end{ttbox}
47.96 -Switching tracing on illustrates how the simplifier solves the remaining
47.97 -subgoal:
47.98 -\begin{ttbox}
47.99 -set trace_simp;
47.100 -by (Asm_simp_tac 1);
47.101 -\ttbreak
47.102 -{\out Adding rewrite rule:}
47.103 -{\out .x + Suc n == Suc (.x + n)}
47.104 -\ttbreak
47.105 -{\out Applying instance of rewrite rule:}
47.106 -{\out ?m + Suc ?n == Suc (?m + ?n)}
47.107 -{\out Rewriting:}
47.108 -{\out Suc .x + Suc n == Suc (Suc .x + n)}
47.109 -\ttbreak
47.110 -{\out Applying instance of rewrite rule:}
47.111 -{\out Suc ?m + ?n == Suc (?m + ?n)}
47.112 -{\out Rewriting:}
47.113 -{\out Suc .x + n == Suc (.x + n)}
47.114 -\ttbreak
47.115 -{\out Applying instance of rewrite rule:}
47.116 -{\out Suc ?m + ?n == Suc (?m + ?n)}
47.117 -{\out Rewriting:}
47.118 -{\out Suc .x + n == Suc (.x + n)}
47.119 -\ttbreak
47.120 -{\out Applying instance of rewrite rule:}
47.121 -{\out ?x = ?x == True}
47.122 -{\out Rewriting:}
47.123 -{\out Suc (Suc (.x + n)) = Suc (Suc (.x + n)) == True}
47.124 -\ttbreak
47.125 -{\out Level 3}
47.126 -{\out m + Suc(n) = Suc(m + n)}
47.127 -{\out No subgoals!}
47.128 -\end{ttbox}
47.129 -Many variations are possible. At Level~1 (in either example) we could have
47.130 -solved both subgoals at once using the tactical \ttindex{ALLGOALS}:
47.131 -\begin{ttbox}
47.132 -by (ALLGOALS Asm_simp_tac);
47.133 -{\out Level 2}
47.134 -{\out m + Suc(n) = Suc(m + n)}
47.135 -{\out No subgoals!}
47.136 -\end{ttbox}
47.137 -\index{tracing!of simplification|)}
47.138 -
47.139 -
47.140 -\subsection{Free variables and simplification}
47.141 -
47.142 -Here is a conjecture to be proved for an arbitrary function~$f$
47.143 -satisfying the law $f(Suc(\Var{n})) = Suc(f(\Var{n}))$:
47.144 -\begin{ttbox}
47.145 -val [prem] = Goal
47.146 - "(!!n. f(Suc(n)) = Suc(f(n))) ==> f(i+j) = i+f(j)";
47.147 -{\out Level 0}
47.148 -{\out f(i + j) = i + f(j)}
47.149 -{\out 1. f(i + j) = i + f(j)}
47.150 -\ttbreak
47.151 -{\out val prem = "f(Suc(?n)) = Suc(f(?n))}
47.152 -{\out [!!n. f(Suc(n)) = Suc(f(n))]" : thm}
47.153 -\end{ttbox}
47.154 -In the theorem~\texttt{prem}, note that $f$ is a free variable while
47.155 -$\Var{n}$ is a schematic variable.
47.156 -\begin{ttbox}
47.157 -by (res_inst_tac [("n","i")] induct 1);
47.158 -{\out Level 1}
47.159 -{\out f(i + j) = i + f(j)}
47.160 -{\out 1. f(0 + j) = 0 + f(j)}
47.161 -{\out 2. !!x. f(x + j) = x + f(j) ==> f(Suc(x) + j) = Suc(x) + f(j)}
47.162 -\end{ttbox}
47.163 -We simplify each subgoal in turn. The first one is trivial:
47.164 -\begin{ttbox}
47.165 -by (Simp_tac 1);
47.166 -{\out Level 2}
47.167 -{\out f(i + j) = i + f(j)}
47.168 -{\out 1. !!x. f(x + j) = x + f(j) ==> f(Suc(x) + j) = Suc(x) + f(j)}
47.169 -\end{ttbox}
47.170 -The remaining subgoal requires rewriting by the premise, so we add it
47.171 -to the current simpset:
47.172 -\begin{ttbox}
47.173 -by (asm_simp_tac (simpset() addsimps [prem]) 1);
47.174 -{\out Level 3}
47.175 -{\out f(i + j) = i + f(j)}
47.176 -{\out No subgoals!}
47.177 -\end{ttbox}
47.178 -
47.179 -
47.180 \section{Permutative rewrite rules}
47.181 \index{rewrite rules!permutative|(}
47.182
48.1 --- a/doc-src/Ref/substitution.tex Wed Mar 04 10:43:39 2009 +0100
48.2 +++ b/doc-src/Ref/substitution.tex Wed Mar 04 10:45:52 2009 +0100
48.3 @@ -1,4 +1,4 @@
48.4 -%% $Id$
48.5 +
48.6 \chapter{Substitution Tactics} \label{substitution}
48.7 \index{tactics!substitution|(}\index{equality|(}
48.8
49.1 --- a/doc-src/Ref/syntax.tex Wed Mar 04 10:43:39 2009 +0100
49.2 +++ b/doc-src/Ref/syntax.tex Wed Mar 04 10:45:52 2009 +0100
49.3 @@ -1,4 +1,4 @@
49.4 -%% $Id$
49.5 +
49.6 \chapter{Syntax Transformations} \label{chap:syntax}
49.7 \newcommand\ttapp{\mathrel{\hbox{\tt\$}}}
49.8 \newcommand\mtt[1]{\mbox{\tt #1}}
50.1 --- a/doc-src/Ref/tactic.tex Wed Mar 04 10:43:39 2009 +0100
50.2 +++ b/doc-src/Ref/tactic.tex Wed Mar 04 10:45:52 2009 +0100
50.3 @@ -1,235 +1,8 @@
50.4 -%% $Id$
50.5 +
50.6 \chapter{Tactics} \label{tactics}
50.7 -\index{tactics|(} Tactics have type \mltydx{tactic}. This is just an
50.8 -abbreviation for functions from theorems to theorem sequences, where
50.9 -the theorems represent states of a backward proof. Tactics seldom
50.10 -need to be coded from scratch, as functions; instead they are
50.11 -expressed using basic tactics and tacticals.
50.12 -
50.13 -This chapter only presents the primitive tactics. Substantial proofs
50.14 -require the power of automatic tools like simplification
50.15 -(Chapter~\ref{chap:simplification}) and classical tableau reasoning
50.16 -(Chapter~\ref{chap:classical}).
50.17 -
50.18 -\section{Resolution and assumption tactics}
50.19 -{\bf Resolution} is Isabelle's basic mechanism for refining a subgoal using
50.20 -a rule. {\bf Elim-resolution} is particularly suited for elimination
50.21 -rules, while {\bf destruct-resolution} is particularly suited for
50.22 -destruction rules. The {\tt r}, {\tt e}, {\tt d} naming convention is
50.23 -maintained for several different kinds of resolution tactics, as well as
50.24 -the shortcuts in the subgoal module.
50.25 -
50.26 -All the tactics in this section act on a subgoal designated by a positive
50.27 -integer~$i$. They fail (by returning the empty sequence) if~$i$ is out of
50.28 -range.
50.29 -
50.30 -\subsection{Resolution tactics}
50.31 -\index{resolution!tactics}
50.32 -\index{tactics!resolution|bold}
50.33 -\begin{ttbox}
50.34 -resolve_tac : thm list -> int -> tactic
50.35 -eresolve_tac : thm list -> int -> tactic
50.36 -dresolve_tac : thm list -> int -> tactic
50.37 -forward_tac : thm list -> int -> tactic
50.38 -\end{ttbox}
50.39 -These perform resolution on a list of theorems, $thms$, representing a list
50.40 -of object-rules. When generating next states, they take each of the rules
50.41 -in the order given. Each rule may yield several next states, or none:
50.42 -higher-order resolution may yield multiple resolvents.
50.43 -\begin{ttdescription}
50.44 -\item[\ttindexbold{resolve_tac} {\it thms} {\it i}]
50.45 - refines the proof state using the rules, which should normally be
50.46 - introduction rules. It resolves a rule's conclusion with
50.47 - subgoal~$i$ of the proof state.
50.48 -
50.49 -\item[\ttindexbold{eresolve_tac} {\it thms} {\it i}]
50.50 - \index{elim-resolution}
50.51 - performs elim-resolution with the rules, which should normally be
50.52 - elimination rules. It resolves with a rule, proves its first premise by
50.53 - assumption, and finally \emph{deletes} that assumption from any new
50.54 - subgoals. (To rotate a rule's premises,
50.55 - see \texttt{rotate_prems} in~{\S}\ref{MiscellaneousForwardRules}.)
50.56 -
50.57 -\item[\ttindexbold{dresolve_tac} {\it thms} {\it i}]
50.58 - \index{forward proof}\index{destruct-resolution}
50.59 - performs destruct-resolution with the rules, which normally should
50.60 - be destruction rules. This replaces an assumption by the result of
50.61 - applying one of the rules.
50.62 -
50.63 -\item[\ttindexbold{forward_tac}]\index{forward proof}
50.64 - is like {\tt dresolve_tac} except that the selected assumption is not
50.65 - deleted. It applies a rule to an assumption, adding the result as a new
50.66 - assumption.
50.67 -\end{ttdescription}
50.68 -
50.69 -\subsection{Assumption tactics}
50.70 -\index{tactics!assumption|bold}\index{assumptions!tactics for}
50.71 -\begin{ttbox}
50.72 -assume_tac : int -> tactic
50.73 -eq_assume_tac : int -> tactic
50.74 -\end{ttbox}
50.75 -\begin{ttdescription}
50.76 -\item[\ttindexbold{assume_tac} {\it i}]
50.77 -attempts to solve subgoal~$i$ by assumption.
50.78 -
50.79 -\item[\ttindexbold{eq_assume_tac}]
50.80 -is like {\tt assume_tac} but does not use unification. It succeeds (with a
50.81 -\emph{unique} next state) if one of the assumptions is identical to the
50.82 -subgoal's conclusion. Since it does not instantiate variables, it cannot
50.83 -make other subgoals unprovable. It is intended to be called from proof
50.84 -strategies, not interactively.
50.85 -\end{ttdescription}
50.86 -
50.87 -\subsection{Matching tactics} \label{match_tac}
50.88 -\index{tactics!matching}
50.89 -\begin{ttbox}
50.90 -match_tac : thm list -> int -> tactic
50.91 -ematch_tac : thm list -> int -> tactic
50.92 -dmatch_tac : thm list -> int -> tactic
50.93 -\end{ttbox}
50.94 -These are just like the resolution tactics except that they never
50.95 -instantiate unknowns in the proof state. Flexible subgoals are not updated
50.96 -willy-nilly, but are left alone. Matching --- strictly speaking --- means
50.97 -treating the unknowns in the proof state as constants; these tactics merely
50.98 -discard unifiers that would update the proof state.
50.99 -\begin{ttdescription}
50.100 -\item[\ttindexbold{match_tac} {\it thms} {\it i}]
50.101 -refines the proof state using the rules, matching a rule's
50.102 -conclusion with subgoal~$i$ of the proof state.
50.103 -
50.104 -\item[\ttindexbold{ematch_tac}]
50.105 -is like {\tt match_tac}, but performs elim-resolution.
50.106 -
50.107 -\item[\ttindexbold{dmatch_tac}]
50.108 -is like {\tt match_tac}, but performs destruct-resolution.
50.109 -\end{ttdescription}
50.110 -
50.111 -
50.112 -\subsection{Explicit instantiation} \label{res_inst_tac}
50.113 -\index{tactics!instantiation}\index{instantiation}
50.114 -\begin{ttbox}
50.115 -res_inst_tac : (string*string)list -> thm -> int -> tactic
50.116 -eres_inst_tac : (string*string)list -> thm -> int -> tactic
50.117 -dres_inst_tac : (string*string)list -> thm -> int -> tactic
50.118 -forw_inst_tac : (string*string)list -> thm -> int -> tactic
50.119 -instantiate_tac : (string*string)list -> tactic
50.120 -\end{ttbox}
50.121 -The first four of these tactics are designed for applying rules by resolution
50.122 -such as substitution and induction, which cause difficulties for higher-order
50.123 -unification. The tactics accept explicit instantiations for unknowns
50.124 -in the rule ---typically, in the rule's conclusion. The last one,
50.125 -{\tt instantiate_tac}, may be used to instantiate unknowns in the proof state,
50.126 -independently of rule application.
50.127 -
50.128 -Each instantiation is a pair {\tt($v$,$e$)},
50.129 -where $v$ is an unknown \emph{without} its leading question mark!
50.130 -\begin{itemize}
50.131 -\item If $v$ is the type unknown {\tt'a}, then
50.132 -the rule must contain a type unknown \verb$?'a$ of some
50.133 -sort~$s$, and $e$ should be a type of sort $s$.
50.134 -
50.135 -\item If $v$ is the unknown {\tt P}, then
50.136 -the rule must contain an unknown \verb$?P$ of some type~$\tau$,
50.137 -and $e$ should be a term of some type~$\sigma$ such that $\tau$ and
50.138 -$\sigma$ are unifiable. If the unification of $\tau$ and $\sigma$
50.139 -instantiates any type unknowns in $\tau$, these instantiations
50.140 -are recorded for application to the rule.
50.141 -\end{itemize}
50.142 -Types are instantiated before terms are. Because type instantiations are
50.143 -inferred from term instantiations, explicit type instantiations are seldom
50.144 -necessary --- if \verb$?t$ has type \verb$?'a$, then the instantiation list
50.145 -\texttt{[("'a","bool"), ("t","True")]} may be simplified to
50.146 -\texttt{[("t","True")]}. Type unknowns in the proof state may cause
50.147 -failure because the tactics cannot instantiate them.
50.148 -
50.149 -The first four instantiation tactics act on a given subgoal. Terms in the
50.150 -instantiations are type-checked in the context of that subgoal --- in
50.151 -particular, they may refer to that subgoal's parameters. Any unknowns in
50.152 -the terms receive subscripts and are lifted over the parameters; thus, you
50.153 -may not refer to unknowns in the subgoal.
50.154 -
50.155 -\begin{ttdescription}
50.156 -\item[\ttindexbold{res_inst_tac} {\it insts} {\it thm} {\it i}]
50.157 -instantiates the rule {\it thm} with the instantiations {\it insts}, as
50.158 -described above, and then performs resolution on subgoal~$i$. Resolution
50.159 -typically causes further instantiations; you need not give explicit
50.160 -instantiations for every unknown in the rule.
50.161 -
50.162 -\item[\ttindexbold{eres_inst_tac}]
50.163 -is like {\tt res_inst_tac}, but performs elim-resolution.
50.164 -
50.165 -\item[\ttindexbold{dres_inst_tac}]
50.166 -is like {\tt res_inst_tac}, but performs destruct-resolution.
50.167 -
50.168 -\item[\ttindexbold{forw_inst_tac}]
50.169 -is like {\tt dres_inst_tac} except that the selected assumption is not
50.170 -deleted. It applies the instantiated rule to an assumption, adding the
50.171 -result as a new assumption.
50.172 -
50.173 -\item[\ttindexbold{instantiate_tac} {\it insts}]
50.174 -instantiates unknowns in the proof state. This affects the main goal as
50.175 -well as all subgoals.
50.176 -\end{ttdescription}
50.177 -
50.178 +\index{tactics|(}
50.179
50.180 \section{Other basic tactics}
50.181 -\subsection{Tactic shortcuts}
50.182 -\index{shortcuts!for tactics}
50.183 -\index{tactics!resolution}\index{tactics!assumption}
50.184 -\index{tactics!meta-rewriting}
50.185 -\begin{ttbox}
50.186 -rtac : thm -> int -> tactic
50.187 -etac : thm -> int -> tactic
50.188 -dtac : thm -> int -> tactic
50.189 -ftac : thm -> int -> tactic
50.190 -atac : int -> tactic
50.191 -eatac : thm -> int -> int -> tactic
50.192 -datac : thm -> int -> int -> tactic
50.193 -fatac : thm -> int -> int -> tactic
50.194 -ares_tac : thm list -> int -> tactic
50.195 -rewtac : thm -> tactic
50.196 -\end{ttbox}
50.197 -These abbreviate common uses of tactics.
50.198 -\begin{ttdescription}
50.199 -\item[\ttindexbold{rtac} {\it thm} {\it i}]
50.200 -abbreviates \hbox{\tt resolve_tac [{\it thm}] {\it i}}, doing resolution.
50.201 -
50.202 -\item[\ttindexbold{etac} {\it thm} {\it i}]
50.203 -abbreviates \hbox{\tt eresolve_tac [{\it thm}] {\it i}}, doing elim-resolution.
50.204 -
50.205 -\item[\ttindexbold{dtac} {\it thm} {\it i}]
50.206 -abbreviates \hbox{\tt dresolve_tac [{\it thm}] {\it i}}, doing
50.207 -destruct-resolution.
50.208 -
50.209 -\item[\ttindexbold{ftac} {\it thm} {\it i}]
50.210 -abbreviates \hbox{\tt forward_tac [{\it thm}] {\it i}}, doing
50.211 -destruct-resolution without deleting the assumption.
50.212 -
50.213 -\item[\ttindexbold{atac} {\it i}]
50.214 -abbreviates \hbox{\tt assume_tac {\it i}}, doing proof by assumption.
50.215 -
50.216 -\item[\ttindexbold{eatac} {\it thm} {\it j} {\it i}]
50.217 -performs \hbox{\tt etac {\it thm}} and then {\it j} times \texttt{atac},
50.218 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
50.219 -
50.220 -\item[\ttindexbold{datac} {\it thm} {\it j} {\it i}]
50.221 -performs \hbox{\tt dtac {\it thm}} and then {\it j} times \texttt{atac},
50.222 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
50.223 -
50.224 -\item[\ttindexbold{fatac} {\it thm} {\it j} {\it i}]
50.225 -performs \hbox{\tt ftac {\it thm}} and then {\it j} times \texttt{atac},
50.226 -solving additionally {\it j}~premises of the rule {\it thm} by assumption.
50.227 -
50.228 -\item[\ttindexbold{ares_tac} {\it thms} {\it i}]
50.229 -tries proof by assumption and resolution; it abbreviates
50.230 -\begin{ttbox}
50.231 -assume_tac {\it i} ORELSE resolve_tac {\it thms} {\it i}
50.232 -\end{ttbox}
50.233 -
50.234 -\item[\ttindexbold{rewtac} {\it def}]
50.235 -abbreviates \hbox{\tt rewrite_goals_tac [{\it def}]}, unfolding a definition.
50.236 -\end{ttdescription}
50.237 -
50.238
50.239 \subsection{Inserting premises and facts}\label{cut_facts_tac}
50.240 \index{tactics!for inserting facts}\index{assumptions!inserting}
50.241 @@ -351,52 +124,6 @@
50.242
50.243 \section{Obscure tactics}
50.244
50.245 -\subsection{Renaming parameters in a goal} \index{parameters!renaming}
50.246 -\begin{ttbox}
50.247 -rename_tac : string -> int -> tactic
50.248 -rename_last_tac : string -> string list -> int -> tactic
50.249 -Logic.set_rename_prefix : string -> unit
50.250 -Logic.auto_rename : bool ref \hfill{\bf initially false}
50.251 -\end{ttbox}
50.252 -When creating a parameter, Isabelle chooses its name by matching variable
50.253 -names via the object-rule. Given the rule $(\forall I)$ formalized as
50.254 -$\left(\Forall x. P(x)\right) \Imp \forall x.P(x)$, Isabelle will note that
50.255 -the $\Forall$-bound variable in the premise has the same name as the
50.256 -$\forall$-bound variable in the conclusion.
50.257 -
50.258 -Sometimes there is insufficient information and Isabelle chooses an
50.259 -arbitrary name. The renaming tactics let you override Isabelle's choice.
50.260 -Because renaming parameters has no logical effect on the proof state, the
50.261 -{\tt by} command prints the message {\tt Warning:\ same as previous
50.262 -level}.
50.263 -
50.264 -Alternatively, you can suppress the naming mechanism described above and
50.265 -have Isabelle generate uniform names for parameters. These names have the
50.266 -form $p${\tt a}, $p${\tt b}, $p${\tt c},~\ldots, where $p$ is any desired
50.267 -prefix. They are ugly but predictable.
50.268 -
50.269 -\begin{ttdescription}
50.270 -\item[\ttindexbold{rename_tac} {\it str} {\it i}]
50.271 -interprets the string {\it str} as a series of blank-separated variable
50.272 -names, and uses them to rename the parameters of subgoal~$i$. The names
50.273 -must be distinct. If there are fewer names than parameters, then the
50.274 -tactic renames the innermost parameters and may modify the remaining ones
50.275 -to ensure that all the parameters are distinct.
50.276 -
50.277 -\item[\ttindexbold{rename_last_tac} {\it prefix} {\it suffixes} {\it i}]
50.278 -generates a list of names by attaching each of the {\it suffixes\/} to the
50.279 -{\it prefix}. It is intended for coding structural induction tactics,
50.280 -where several of the new parameters should have related names.
50.281 -
50.282 -\item[\ttindexbold{Logic.set_rename_prefix} {\it prefix};]
50.283 -sets the prefix for uniform renaming to~{\it prefix}. The default prefix
50.284 -is {\tt"k"}.
50.285 -
50.286 -\item[set \ttindexbold{Logic.auto_rename};]
50.287 -makes Isabelle generate uniform names for parameters.
50.288 -\end{ttdescription}
50.289 -
50.290 -
50.291 \subsection{Manipulating assumptions}
50.292 \index{assumptions!rotating}
50.293 \begin{ttbox}
50.294 @@ -594,142 +321,6 @@
50.295 is no longer than {\it limit}.
50.296 \end{ttdescription}
50.297
50.298 -
50.299 -\section{Programming tools for proof strategies}
50.300 -Do not consider using the primitives discussed in this section unless you
50.301 -really need to code tactics from scratch.
50.302 -
50.303 -\subsection{Operations on tactics}
50.304 -\index{tactics!primitives for coding} A tactic maps theorems to sequences of
50.305 -theorems. The type constructor for sequences (lazy lists) is called
50.306 -\mltydx{Seq.seq}. To simplify the types of tactics and tacticals,
50.307 -Isabelle defines a type abbreviation:
50.308 -\begin{ttbox}
50.309 -type tactic = thm -> thm Seq.seq
50.310 -\end{ttbox}
50.311 -The following operations provide means for coding tactics in a clean style.
50.312 -\begin{ttbox}
50.313 -PRIMITIVE : (thm -> thm) -> tactic
50.314 -SUBGOAL : ((term*int) -> tactic) -> int -> tactic
50.315 -\end{ttbox}
50.316 -\begin{ttdescription}
50.317 -\item[\ttindexbold{PRIMITIVE} $f$] packages the meta-rule~$f$ as a tactic that
50.318 - applies $f$ to the proof state and returns the result as a one-element
50.319 - sequence. If $f$ raises an exception, then the tactic's result is the empty
50.320 - sequence.
50.321 -
50.322 -\item[\ttindexbold{SUBGOAL} $f$ $i$]
50.323 -extracts subgoal~$i$ from the proof state as a term~$t$, and computes a
50.324 -tactic by calling~$f(t,i)$. It applies the resulting tactic to the same
50.325 -state. The tactic body is expressed using tactics and tacticals, but may
50.326 -peek at a particular subgoal:
50.327 -\begin{ttbox}
50.328 -SUBGOAL (fn (t,i) => {\it tactic-valued expression})
50.329 -\end{ttbox}
50.330 -\end{ttdescription}
50.331 -
50.332 -
50.333 -\subsection{Tracing}
50.334 -\index{tactics!tracing}
50.335 -\index{tracing!of tactics}
50.336 -\begin{ttbox}
50.337 -pause_tac: tactic
50.338 -print_tac: string -> tactic
50.339 -\end{ttbox}
50.340 -These tactics print tracing information when they are applied to a proof
50.341 -state. Their output may be difficult to interpret. Note that certain of
50.342 -the searching tacticals, such as {\tt REPEAT}, have built-in tracing
50.343 -options.
50.344 -\begin{ttdescription}
50.345 -\item[\ttindexbold{pause_tac}]
50.346 -prints {\footnotesize\tt** Press RETURN to continue:} and then reads a line
50.347 -from the terminal. If this line is blank then it returns the proof state
50.348 -unchanged; otherwise it fails (which may terminate a repetition).
50.349 -
50.350 -\item[\ttindexbold{print_tac}~$msg$]
50.351 -returns the proof state unchanged, with the side effect of printing it at
50.352 -the terminal.
50.353 -\end{ttdescription}
50.354 -
50.355 -
50.356 -\section{*Sequences}
50.357 -\index{sequences (lazy lists)|bold}
50.358 -The module {\tt Seq} declares a type of lazy lists. It uses
50.359 -Isabelle's type \mltydx{option} to represent the possible presence
50.360 -(\ttindexbold{Some}) or absence (\ttindexbold{None}) of
50.361 -a value:
50.362 -\begin{ttbox}
50.363 -datatype 'a option = None | Some of 'a;
50.364 -\end{ttbox}
50.365 -The {\tt Seq} structure is supposed to be accessed via fully qualified
50.366 -names and should not be \texttt{open}.
50.367 -
50.368 -\subsection{Basic operations on sequences}
50.369 -\begin{ttbox}
50.370 -Seq.empty : 'a seq
50.371 -Seq.make : (unit -> ('a * 'a seq) option) -> 'a seq
50.372 -Seq.single : 'a -> 'a seq
50.373 -Seq.pull : 'a seq -> ('a * 'a seq) option
50.374 -\end{ttbox}
50.375 -\begin{ttdescription}
50.376 -\item[Seq.empty] is the empty sequence.
50.377 -
50.378 -\item[\tt Seq.make (fn () => Some ($x$, $xq$))] constructs the
50.379 - sequence with head~$x$ and tail~$xq$, neither of which is evaluated.
50.380 -
50.381 -\item[Seq.single $x$]
50.382 -constructs the sequence containing the single element~$x$.
50.383 -
50.384 -\item[Seq.pull $xq$] returns {\tt None} if the sequence is empty and
50.385 - {\tt Some ($x$, $xq'$)} if the sequence has head~$x$ and tail~$xq'$.
50.386 - Warning: calling \hbox{Seq.pull $xq$} again will {\it recompute\/}
50.387 - the value of~$x$; it is not stored!
50.388 -\end{ttdescription}
50.389 -
50.390 -
50.391 -\subsection{Converting between sequences and lists}
50.392 -\begin{ttbox}
50.393 -Seq.chop : int * 'a seq -> 'a list * 'a seq
50.394 -Seq.list_of : 'a seq -> 'a list
50.395 -Seq.of_list : 'a list -> 'a seq
50.396 -\end{ttbox}
50.397 -\begin{ttdescription}
50.398 -\item[Seq.chop ($n$, $xq$)] returns the first~$n$ elements of~$xq$ as a
50.399 - list, paired with the remaining elements of~$xq$. If $xq$ has fewer
50.400 - than~$n$ elements, then so will the list.
50.401 -
50.402 -\item[Seq.list_of $xq$] returns the elements of~$xq$, which must be
50.403 - finite, as a list.
50.404 -
50.405 -\item[Seq.of_list $xs$] creates a sequence containing the elements
50.406 - of~$xs$.
50.407 -\end{ttdescription}
50.408 -
50.409 -
50.410 -\subsection{Combining sequences}
50.411 -\begin{ttbox}
50.412 -Seq.append : 'a seq * 'a seq -> 'a seq
50.413 -Seq.interleave : 'a seq * 'a seq -> 'a seq
50.414 -Seq.flat : 'a seq seq -> 'a seq
50.415 -Seq.map : ('a -> 'b) -> 'a seq -> 'b seq
50.416 -Seq.filter : ('a -> bool) -> 'a seq -> 'a seq
50.417 -\end{ttbox}
50.418 -\begin{ttdescription}
50.419 -\item[Seq.append ($xq$, $yq$)] concatenates $xq$ to $yq$.
50.420 -
50.421 -\item[Seq.interleave ($xq$, $yq$)] joins $xq$ with $yq$ by
50.422 - interleaving their elements. The result contains all the elements
50.423 - of the sequences, even if both are infinite.
50.424 -
50.425 -\item[Seq.flat $xqq$] concatenates a sequence of sequences.
50.426 -
50.427 -\item[Seq.map $f$ $xq$] applies $f$ to every element
50.428 - of~$xq=x@1,x@2,\ldots$, yielding the sequence $f(x@1),f(x@2),\ldots$.
50.429 -
50.430 -\item[Seq.filter $p$ $xq$] returns the sequence consisting of all
50.431 - elements~$x$ of~$xq$ such that $p(x)$ is {\tt true}.
50.432 -\end{ttdescription}
50.433 -
50.434 \index{tactics|)}
50.435
50.436
51.1 --- a/doc-src/Ref/tctical.tex Wed Mar 04 10:43:39 2009 +0100
51.2 +++ b/doc-src/Ref/tctical.tex Wed Mar 04 10:45:52 2009 +0100
51.3 @@ -1,4 +1,4 @@
51.4 -%% $Id$
51.5 +
51.6 \chapter{Tacticals}
51.7 \index{tacticals|(}
51.8 Tacticals are operations on tactics. Their implementation makes use of
52.1 --- a/doc-src/Ref/theories.tex Wed Mar 04 10:43:39 2009 +0100
52.2 +++ b/doc-src/Ref/theories.tex Wed Mar 04 10:45:52 2009 +0100
52.3 @@ -1,216 +1,6 @@
52.4 -
52.5 -%% $Id$
52.6
52.7 \chapter{Theories, Terms and Types} \label{theories}
52.8 -\index{theories|(}\index{signatures|bold}
52.9 -\index{reading!axioms|see{\texttt{assume_ax}}} Theories organize the syntax,
52.10 -declarations and axioms of a mathematical development. They are built,
52.11 -starting from the Pure or CPure theory, by extending and merging existing
52.12 -theories. They have the \ML\ type \mltydx{theory}. Theory operations signal
52.13 -errors by raising exception \xdx{THEORY}, returning a message and a list of
52.14 -theories.
52.15 -
52.16 -Signatures, which contain information about sorts, types, constants and
52.17 -syntax, have the \ML\ type~\mltydx{Sign.sg}. For identification, each
52.18 -signature carries a unique list of \bfindex{stamps}, which are \ML\
52.19 -references to strings. The strings serve as human-readable names; the
52.20 -references serve as unique identifiers. Each primitive signature has a
52.21 -single stamp. When two signatures are merged, their lists of stamps are
52.22 -also merged. Every theory carries a unique signature.
52.23 -
52.24 -Terms and types are the underlying representation of logical syntax. Their
52.25 -\ML\ definitions are irrelevant to naive Isabelle users. Programmers who
52.26 -wish to extend Isabelle may need to know such details, say to code a tactic
52.27 -that looks for subgoals of a particular form. Terms and types may be
52.28 -`certified' to be well-formed with respect to a given signature.
52.29 -
52.30 -
52.31 -\section{Defining theories}\label{sec:ref-defining-theories}
52.32 -
52.33 -Theories are defined via theory files $name$\texttt{.thy} (there are also
52.34 -\ML-level interfaces which are only intended for people building advanced
52.35 -theory definition packages). Appendix~\ref{app:TheorySyntax} presents the
52.36 -concrete syntax for theory files; here follows an explanation of the
52.37 -constituent parts.
52.38 -\begin{description}
52.39 -\item[{\it theoryDef}] is the full definition. The new theory is called $id$.
52.40 - It is the union of the named \textbf{parent
52.41 - theories}\indexbold{theories!parent}, possibly extended with new
52.42 - components. \thydx{Pure} and \thydx{CPure} are the basic theories, which
52.43 - contain only the meta-logic. They differ just in their concrete syntax for
52.44 - function applications.
52.45 -
52.46 - The new theory begins as a merge of its parents.
52.47 - \begin{ttbox}
52.48 - Attempt to merge different versions of theories: "\(T@1\)", \(\ldots\), "\(T@n\)"
52.49 - \end{ttbox}
52.50 - This error may especially occur when a theory is redeclared --- say to
52.51 - change an inappropriate definition --- and bindings to old versions persist.
52.52 - Isabelle ensures that old and new theories of the same name are not involved
52.53 - in a proof.
52.54 -
52.55 -\item[$classes$]
52.56 - is a series of class declarations. Declaring {\tt$id$ < $id@1$ \dots\
52.57 - $id@n$} makes $id$ a subclass of the existing classes $id@1\dots
52.58 - id@n$. This rules out cyclic class structures. Isabelle automatically
52.59 - computes the transitive closure of subclass hierarchies; it is not
52.60 - necessary to declare \texttt{c < e} in addition to \texttt{c < d} and \texttt{d <
52.61 - e}.
52.62 -
52.63 -\item[$default$]
52.64 - introduces $sort$ as the new default sort for type variables. This applies
52.65 - to unconstrained type variables in an input string but not to type
52.66 - variables created internally. If omitted, the default sort is the listwise
52.67 - union of the default sorts of the parent theories (i.e.\ their logical
52.68 - intersection).
52.69 -
52.70 -\item[$sort$] is a finite set of classes. A single class $id$ abbreviates the
52.71 - sort $\{id\}$.
52.72 -
52.73 -\item[$types$]
52.74 - is a series of type declarations. Each declares a new type constructor
52.75 - or type synonym. An $n$-place type constructor is specified by
52.76 - $(\alpha@1,\dots,\alpha@n)name$, where the type variables serve only to
52.77 - indicate the number~$n$.
52.78 -
52.79 - A \textbf{type synonym}\indexbold{type synonyms} is an abbreviation
52.80 - $(\alpha@1,\dots,\alpha@n)name = \tau$, where $name$ and $\tau$ can
52.81 - be strings.
52.82 -
52.83 -\item[$infix$]
52.84 - declares a type or constant to be an infix operator having priority $nat$
52.85 - and associating to the left (\texttt{infixl}) or right (\texttt{infixr}).
52.86 - Only 2-place type constructors can have infix status; an example is {\tt
52.87 - ('a,'b)~"*"~(infixr~20)}, which may express binary product types.
52.88 -
52.89 -\item[$arities$] is a series of type arity declarations. Each assigns
52.90 - arities to type constructors. The $name$ must be an existing type
52.91 - constructor, which is given the additional arity $arity$.
52.92 -
52.93 -\item[$nonterminals$]\index{*nonterminal symbols} declares purely
52.94 - syntactic types to be used as nonterminal symbols of the context
52.95 - free grammar.
52.96 -
52.97 -\item[$consts$] is a series of constant declarations. Each new
52.98 - constant $name$ is given the specified type. The optional $mixfix$
52.99 - annotations may attach concrete syntax to the constant.
52.100 -
52.101 -\item[$syntax$] \index{*syntax section}\index{print mode} is a variant
52.102 - of $consts$ which adds just syntax without actually declaring
52.103 - logical constants. This gives full control over a theory's context
52.104 - free grammar. The optional $mode$ specifies the print mode where the
52.105 - mixfix productions should be added. If there is no \texttt{output}
52.106 - option given, all productions are also added to the input syntax
52.107 - (regardless of the print mode).
52.108 -
52.109 -\item[$mixfix$] \index{mixfix declarations}
52.110 - annotations can take three forms:
52.111 - \begin{itemize}
52.112 - \item A mixfix template given as a $string$ of the form
52.113 - {\tt"}\dots{\tt\_}\dots{\tt\_}\dots{\tt"} where the $i$-th underscore
52.114 - indicates the position where the $i$-th argument should go. The list
52.115 - of numbers gives the priority of each argument. The final number gives
52.116 - the priority of the whole construct.
52.117 -
52.118 - \item A constant $f$ of type $\tau@1\To(\tau@2\To\tau)$ can be given {\bf
52.119 - infix} status.
52.120 -
52.121 - \item A constant $f$ of type $(\tau@1\To\tau@2)\To\tau$ can be given {\bf
52.122 - binder} status. The declaration \texttt{binder} $\cal Q$ $p$ causes
52.123 - ${\cal Q}\,x.F(x)$ to be treated
52.124 - like $f(F)$, where $p$ is the priority.
52.125 - \end{itemize}
52.126 -
52.127 -\item[$trans$]
52.128 - specifies syntactic translation rules (macros). There are three forms:
52.129 - parse rules (\texttt{=>}), print rules (\texttt{<=}), and parse/print rules ({\tt
52.130 - ==}).
52.131 -
52.132 -\item[$rules$]
52.133 - is a series of rule declarations. Each has a name $id$ and the formula is
52.134 - given by the $string$. Rule names must be distinct within any single
52.135 - theory.
52.136 -
52.137 -\item[$defs$] is a series of definitions. They are just like $rules$, except
52.138 - that every $string$ must be a definition (see below for details).
52.139 -
52.140 -\item[$constdefs$] combines the declaration of constants and their
52.141 - definition. The first $string$ is the type, the second the definition.
52.142 -
52.143 -\item[$axclass$] \index{*axclass section} defines an \rmindex{axiomatic type
52.144 - class} \cite{Wenzel:1997:TPHOL} as the intersection of existing classes,
52.145 - with additional axioms holding. Class axioms may not contain more than one
52.146 - type variable. The class axioms (with implicit sort constraints added) are
52.147 - bound to the given names. Furthermore a class introduction rule is
52.148 - generated, which is automatically employed by $instance$ to prove
52.149 - instantiations of this class.
52.150 -
52.151 -\item[$instance$] \index{*instance section} proves class inclusions or
52.152 - type arities at the logical level and then transfers these to the
52.153 - type signature. The instantiation is proven and checked properly.
52.154 - The user has to supply sufficient witness information: theorems
52.155 - ($longident$), axioms ($string$), or even arbitrary \ML{} tactic
52.156 - code $verbatim$.
52.157 -
52.158 -\item[$oracle$] links the theory to a trusted external reasoner. It is
52.159 - allowed to create theorems, but each theorem carries a proof object
52.160 - describing the oracle invocation. See \S\ref{sec:oracles} for details.
52.161 -
52.162 -\item[$local$, $global$] change the current name declaration mode.
52.163 - Initially, theories start in $local$ mode, causing all names of
52.164 - types, constants, axioms etc.\ to be automatically qualified by the
52.165 - theory name. Changing this to $global$ causes all names to be
52.166 - declared as short base names only.
52.167 -
52.168 - The $local$ and $global$ declarations act like switches, affecting
52.169 - all following theory sections until changed again explicitly. Also
52.170 - note that the final state at the end of the theory will persist. In
52.171 - particular, this determines how the names of theorems stored later
52.172 - on are handled.
52.173 -
52.174 -\item[$setup$]\index{*setup!theory} applies a list of ML functions to
52.175 - the theory. The argument should denote a value of type
52.176 - \texttt{(theory -> theory) list}. Typically, ML packages are
52.177 - initialized in this way.
52.178 -
52.179 -\item[$ml$] \index{*ML section}
52.180 - consists of \ML\ code, typically for parse and print translation functions.
52.181 -\end{description}
52.182 -%
52.183 -Chapters~\ref{Defining-Logics} and \ref{chap:syntax} explain mixfix
52.184 -declarations, translation rules and the \texttt{ML} section in more detail.
52.185 -
52.186 -
52.187 -\subsection{*Classes and arities}
52.188 -\index{classes!context conditions}\index{arities!context conditions}
52.189 -
52.190 -In order to guarantee principal types~\cite{nipkow-prehofer},
52.191 -arity declarations must obey two conditions:
52.192 -\begin{itemize}
52.193 -\item There must not be any two declarations $ty :: (\vec{r})c$ and
52.194 - $ty :: (\vec{s})c$ with $\vec{r} \neq \vec{s}$. For example, this
52.195 - excludes the following:
52.196 -\begin{ttbox}
52.197 -arities
52.198 - foo :: (\{logic{\}}) logic
52.199 - foo :: (\{{\}})logic
52.200 -\end{ttbox}
52.201 -
52.202 -\item If there are two declarations $ty :: (s@1,\dots,s@n)c$ and $ty ::
52.203 - (s@1',\dots,s@n')c'$ such that $c' < c$ then $s@i' \preceq s@i$ must hold
52.204 - for $i=1,\dots,n$. The relationship $\preceq$, defined as
52.205 -\[ s' \preceq s \iff \forall c\in s. \exists c'\in s'.~ c'\le c, \]
52.206 -expresses that the set of types represented by $s'$ is a subset of the
52.207 -set of types represented by $s$. Assuming $term \preceq logic$, the
52.208 -following is forbidden:
52.209 -\begin{ttbox}
52.210 -arities
52.211 - foo :: (\{logic{\}})logic
52.212 - foo :: (\{{\}})term
52.213 -\end{ttbox}
52.214 -
52.215 -\end{itemize}
52.216 -
52.217 +\index{theories|(}
52.218
52.219 \section{The theory loader}\label{sec:more-theories}
52.220 \index{theories!reading}\index{files!reading}
52.221 @@ -247,13 +37,6 @@
52.222 dispose a large number of theories at once. Note that {\ML} bindings to
52.223 theorems etc.\ of removed theories may still persist.
52.224
52.225 -\item[reset \ttindexbold{delete_tmpfiles};] processing theory files usually
52.226 - involves temporary {\ML} files to be created. By default, these are deleted
52.227 - afterwards. Resetting the \texttt{delete_tmpfiles} flag inhibits this,
52.228 - leaving the generated code for debugging purposes. The basic location for
52.229 - temporary files is determined by the \texttt{ISABELLE_TMP} environment
52.230 - variable (which is private to the running Isabelle process and may be
52.231 - retrieved by \ttindex{getenv} from {\ML}).
52.232 \end{ttdescription}
52.233
52.234 \medskip Theory and {\ML} files are located by skimming through the
52.235 @@ -296,224 +79,6 @@
52.236 temporarily appended to the load path, too.
52.237
52.238
52.239 -\section{Locales}
52.240 -\label{Locales}
52.241 -
52.242 -Locales \cite{kammueller-locales} are a concept of local proof contexts. They
52.243 -are introduced as named syntactic objects within theories and can be
52.244 -opened in any descendant theory.
52.245 -
52.246 -\subsection{Declaring Locales}
52.247 -
52.248 -A locale is declared in a theory section that starts with the
52.249 -keyword \texttt{locale}. It consists typically of three parts, the
52.250 -\texttt{fixes} part, the \texttt{assumes} part, and the \texttt{defines} part.
52.251 -Appendix \ref{app:TheorySyntax} presents the full syntax.
52.252 -
52.253 -\subsubsection{Parts of Locales}
52.254 -
52.255 -The subsection introduced by the keyword \texttt{fixes} declares the locale
52.256 -constants in a way that closely resembles a global \texttt{consts}
52.257 -declaration. In particular, there may be an optional pretty printing syntax
52.258 -for the locale constants.
52.259 -
52.260 -The subsequent \texttt{assumes} part specifies the locale rules. They are
52.261 -defined like \texttt{rules}: by an identifier followed by the rule
52.262 -given as a string. Locale rules admit the statement of local assumptions
52.263 -about the locale constants. The \texttt{assumes} part is optional. Non-fixed
52.264 -variables in locale rules are automatically bound by the universal quantifier
52.265 -\texttt{!!} of the meta-logic.
52.266 -
52.267 -Finally, the \texttt{defines} part introduces the definitions that are
52.268 -available in the locale. Locale constants declared in the \texttt{fixes}
52.269 -section are defined using the meta-equality \texttt{==}. If the
52.270 -locale constant is a functiond then its definition can (as usual) have
52.271 -variables on the left-hand side acting as formal parameters; they are
52.272 -considered as schematic variables and are automatically generalized by
52.273 -universal quantification of the meta-logic. The right hand side of a
52.274 -definition must not contain variables that are not already on the left hand
52.275 -side. In so far locale definitions behave like theory level definitions.
52.276 -However, the locale concept realizes \emph{dependent definitions}: any variable
52.277 -that is fixed as a locale constant can occur on the right hand side of
52.278 -definitions. For an illustration of these dependent definitions see the
52.279 -occurrence of the locale constant \texttt{G} on the right hand side of the
52.280 -definitions of the locale \texttt{group} below. Naturally, definitions can
52.281 -already use the syntax of the locale constants in the \texttt{fixes}
52.282 -subsection. The \texttt{defines} part is, as the \texttt{assumes} part,
52.283 -optional.
52.284 -
52.285 -\subsubsection{Example for Definition}
52.286 -The concrete syntax of locale definitions is demonstrated by example below.
52.287 -
52.288 -Locale \texttt{group} assumes the definition of groups in a theory
52.289 -file\footnote{This and other examples are from \texttt{HOL/ex}.}. A locale
52.290 -defining a convenient proof environment for group related proofs may be
52.291 -added to the theory as follows:
52.292 -\begin{ttbox}
52.293 - locale group =
52.294 - fixes
52.295 - G :: "'a grouptype"
52.296 - e :: "'a"
52.297 - binop :: "'a => 'a => 'a" (infixr "#" 80)
52.298 - inv :: "'a => 'a" ("i(_)" [90] 91)
52.299 - assumes
52.300 - Group_G "G: Group"
52.301 - defines
52.302 - e_def "e == unit G"
52.303 - binop_def "x # y == bin_op G x y"
52.304 - inv_def "i(x) == inverse G x"
52.305 -\end{ttbox}
52.306 -
52.307 -\subsubsection{Polymorphism}
52.308 -
52.309 -In contrast to polymorphic definitions in theories, the use of the
52.310 -same type variable for the declaration of different locale constants in the
52.311 -fixes part means \emph{the same} type. In other words, the scope of the
52.312 -polymorphic variables is extended over all constant declarations of a locale.
52.313 -In the above example \texttt{'a} refers to the same type which is fixed inside
52.314 -the locale. In an exported theorem (see \S\ref{sec:locale-export}) the
52.315 -constructors of locale \texttt{group} are polymorphic, yet only simultaneously
52.316 -instantiatable.
52.317 -
52.318 -\subsubsection{Nested Locales}
52.319 -
52.320 -A locale can be defined as the extension of a previously defined
52.321 -locale. This operation of extension is optional and is syntactically
52.322 -expressed as
52.323 -\begin{ttbox}
52.324 -locale foo = bar + ...
52.325 -\end{ttbox}
52.326 -The locale \texttt{foo} builds on the constants and syntax of the locale {\tt
52.327 -bar}. That is, all contents of the locale \texttt{bar} can be used in
52.328 -definitions and rules of the corresponding parts of the locale {\tt
52.329 -foo}. Although locale \texttt{foo} assumes the \texttt{fixes} part of \texttt{bar} it
52.330 -does not automatically subsume its rules and definitions. Normally, one
52.331 -expects to use locale \texttt{foo} only if locale \texttt{bar} is already
52.332 -active. These aspects of use and activation of locales are considered in the
52.333 -subsequent section.
52.334 -
52.335 -
52.336 -\subsection{Locale Scope}
52.337 -
52.338 -Locales are by default inactive, but they can be invoked. The list of
52.339 -currently active locales is called \emph{scope}. The process of activating
52.340 -them is called \emph{opening}; the reverse is \emph{closing}.
52.341 -
52.342 -\subsubsection{Scope}
52.343 -The locale scope is part of each theory. It is a dynamic stack containing
52.344 -all active locales at a certain point in an interactive session.
52.345 -The scope lives until all locales are explicitly closed. At one time there
52.346 -can be more than one locale open. The contents of these various active
52.347 -locales are all visible in the scope. In case of nested locales for example,
52.348 -the nesting is actually reflected to the scope, which contains the nested
52.349 -locales as layers. To check the state of the scope during a development the
52.350 -function \texttt{Print\_scope} may be used. It displays the names of all open
52.351 -locales on the scope. The function \texttt{print\_locales} applied to a theory
52.352 -displays all locales contained in that theory and in addition also the
52.353 -current scope.
52.354 -
52.355 -The scope is manipulated by the commands for opening and closing of locales.
52.356 -
52.357 -\subsubsection{Opening}
52.358 -Locales can be \emph{opened} at any point during a session where
52.359 -we want to prove theorems concerning the locale. Opening a locale means
52.360 -making its contents visible by pushing it onto the scope of the current
52.361 -theory. Inside a scope of opened locales, theorems can use all definitions and
52.362 -rules contained in the locales on the scope. The rules and definitions may
52.363 -be accessed individually using the function \ttindex{thm}. This function is
52.364 -applied to the names assigned to locale rules and definitions as
52.365 -strings. The opening command is called \texttt{Open\_locale} and takes the
52.366 -name of the locale to be opened as its argument.
52.367 -
52.368 -If one opens a locale \texttt{foo} that is defined by extension from locale
52.369 -\texttt{bar}, the function \texttt{Open\_locale} checks if locale \texttt{bar}
52.370 -is open. If so, then it just opens \texttt{foo}, if not, then it prints a
52.371 -message and opens \texttt{bar} before opening \texttt{foo}. Naturally, this
52.372 -carries on, if \texttt{bar} is again an extension.
52.373 -
52.374 -\subsubsection{Closing}
52.375 -
52.376 -\emph{Closing} means to cancel the last opened locale, pushing it out of the
52.377 -scope. Theorems proved during the life cycle of this locale will be disabled,
52.378 -unless they have been explicitly exported, as described below. However, when
52.379 -the same locale is opened again these theorems may be used again as well,
52.380 -provided that they were saved as theorems in the first place, using
52.381 -\texttt{qed} or ML assignment. The command \texttt{Close\_locale} takes a
52.382 -locale name as a string and checks if this locale is actually the topmost
52.383 -locale on the scope. If this is the case, it removes this locale, otherwise
52.384 -it prints a warning message and does not change the scope.
52.385 -
52.386 -\subsubsection{Export of Theorems}
52.387 -\label{sec:locale-export}
52.388 -
52.389 -Export of theorems transports theorems out of the scope of locales. Locale
52.390 -rules that have been used in the proof of an exported theorem inside the
52.391 -locale are carried by the exported form of the theorem as its individual
52.392 -meta-assumptions. The locale constants are universally quantified variables
52.393 -in these theorems, hence such theorems can be instantiated individually.
52.394 -Definitions become unfolded; locale constants that were merely used for
52.395 -definitions vanish. Logically, exporting corresponds to a combined
52.396 -application of introduction rules for implication and universal
52.397 -quantification. Exporting forms a kind of normalization of theorems in a
52.398 -locale scope.
52.399 -
52.400 -According to the possibility of nested locales there are two different forms
52.401 -of export. The first one is realized by the function \texttt{export} that
52.402 -exports theorems through all layers of opened locales of the scope. Hence,
52.403 -the application of export to a theorem yields a theorem of the global level,
52.404 -that is, the current theory context without any local assumptions or
52.405 -definitions.
52.406 -
52.407 -When locales are nested we might want to export a theorem, not to the global
52.408 -level of the current theory but just to the previous level. The other export
52.409 -function, \texttt{Export}, transports theorems one level up in the scope; the
52.410 -theorem still uses locale constants, definitions and rules of the locales
52.411 -underneath.
52.412 -
52.413 -\subsection{Functions for Locales}
52.414 -\label{Syntax}
52.415 -\index{locales!functions}
52.416 -
52.417 -Here is a quick reference list of locale functions.
52.418 -\begin{ttbox}
52.419 - Open_locale : xstring -> unit
52.420 - Close_locale : xstring -> unit
52.421 - export : thm -> thm
52.422 - Export : thm -> thm
52.423 - thm : xstring -> thm
52.424 - Print_scope : unit -> unit
52.425 - print_locales: theory -> unit
52.426 -\end{ttbox}
52.427 -\begin{ttdescription}
52.428 -\item[\ttindexbold{Open_locale} $xstring$]
52.429 - opens the locale {\it xstring}, adding it to the scope of the theory of the
52.430 - current context. If the opened locale is built by extension, the ancestors
52.431 - are opened automatically.
52.432 -
52.433 -\item[\ttindexbold{Close_locale} $xstring$] eliminates the locale {\it
52.434 - xstring} from the scope if it is the topmost item on it, otherwise it does
52.435 - not change the scope and produces a warning.
52.436 -
52.437 -\item[\ttindexbold{export} $thm$] locale definitions become expanded in {\it
52.438 - thm} and locale rules that were used in the proof of {\it thm} become part
52.439 - of its individual assumptions. This normalization happens with respect to
52.440 - \emph{all open locales} on the scope.
52.441 -
52.442 -\item[\ttindexbold{Export} $thm$] works like \texttt{export} but normalizes
52.443 - theorems only up to the previous level of locales on the scope.
52.444 -
52.445 -\item[\ttindexbold{thm} $xstring$] applied to the name of a locale definition
52.446 - or rule it returns the definition as a theorem.
52.447 -
52.448 -\item[\ttindexbold{Print_scope}()] prints the names of the locales in the
52.449 - current scope of the current theory context.
52.450 -
52.451 -\item[\ttindexbold{print_locale} $theory$] prints all locales that are
52.452 - contained in {\it theory} directly or indirectly. It also displays the
52.453 - current scope similar to \texttt{Print\_scope}.
52.454 -\end{ttdescription}
52.455 -
52.456 -
52.457 \section{Basic operations on theories}\label{BasicOperationsOnTheories}
52.458
52.459 \subsection{*Theory inclusion}
52.460 @@ -905,111 +470,6 @@
52.461 \end{ttdescription}
52.462
52.463
52.464 -\section{Oracles: calling trusted external reasoners}
52.465 -\label{sec:oracles}
52.466 -\index{oracles|(}
52.467 -
52.468 -Oracles allow Isabelle to take advantage of external reasoners such as
52.469 -arithmetic decision procedures, model checkers, fast tautology checkers or
52.470 -computer algebra systems. Invoked as an oracle, an external reasoner can
52.471 -create arbitrary Isabelle theorems. It is your responsibility to ensure that
52.472 -the external reasoner is as trustworthy as your application requires.
52.473 -Isabelle's proof objects~(\S\ref{sec:proofObjects}) record how each theorem
52.474 -depends upon oracle calls.
52.475 -
52.476 -\begin{ttbox}
52.477 -invoke_oracle : theory -> xstring -> Sign.sg * object -> thm
52.478 -Theory.add_oracle : bstring * (Sign.sg * object -> term) -> theory
52.479 - -> theory
52.480 -\end{ttbox}
52.481 -\begin{ttdescription}
52.482 -\item[\ttindexbold{invoke_oracle} $thy$ $name$ ($sign$, $data$)]
52.483 - invokes the oracle $name$ of theory $thy$ passing the information
52.484 - contained in the exception value $data$ and creating a theorem
52.485 - having signature $sign$. Note that type \ttindex{object} is just an
52.486 - abbreviation for \texttt{exn}. Errors arise if $thy$ does not have
52.487 - an oracle called $name$, if the oracle rejects its arguments or if
52.488 - its result is ill-typed.
52.489 -
52.490 -\item[\ttindexbold{Theory.add_oracle} $name$ $fun$ $thy$] extends
52.491 - $thy$ by oracle $fun$ called $name$. It is seldom called
52.492 - explicitly, as there is concrete syntax for oracles in theory files.
52.493 -\end{ttdescription}
52.494 -
52.495 -A curious feature of {\ML} exceptions is that they are ordinary constructors.
52.496 -The {\ML} type \texttt{exn} is a datatype that can be extended at any time. (See
52.497 -my {\em {ML} for the Working Programmer}~\cite{paulson-ml2}, especially
52.498 -page~136.) The oracle mechanism takes advantage of this to allow an oracle to
52.499 -take any information whatever.
52.500 -
52.501 -There must be some way of invoking the external reasoner from \ML, either
52.502 -because it is coded in {\ML} or via an operating system interface. Isabelle
52.503 -expects the {\ML} function to take two arguments: a signature and an
52.504 -exception object.
52.505 -\begin{itemize}
52.506 -\item The signature will typically be that of a desendant of the theory
52.507 - declaring the oracle. The oracle will use it to distinguish constants from
52.508 - variables, etc., and it will be attached to the generated theorems.
52.509 -
52.510 -\item The exception is used to pass arbitrary information to the oracle. This
52.511 - information must contain a full description of the problem to be solved by
52.512 - the external reasoner, including any additional information that might be
52.513 - required. The oracle may raise the exception to indicate that it cannot
52.514 - solve the specified problem.
52.515 -\end{itemize}
52.516 -
52.517 -A trivial example is provided in theory \texttt{FOL/ex/IffOracle}. This
52.518 -oracle generates tautologies of the form $P\bimp\cdots\bimp P$, with
52.519 -an even number of $P$s.
52.520 -
52.521 -The \texttt{ML} section of \texttt{IffOracle.thy} begins by declaring
52.522 -a few auxiliary functions (suppressed below) for creating the
52.523 -tautologies. Then it declares a new exception constructor for the
52.524 -information required by the oracle: here, just an integer. It finally
52.525 -defines the oracle function itself.
52.526 -\begin{ttbox}
52.527 -exception IffOracleExn of int;\medskip
52.528 -fun mk_iff_oracle (sign, IffOracleExn n) =
52.529 - if n > 0 andalso n mod 2 = 0
52.530 - then Trueprop \$ mk_iff n
52.531 - else raise IffOracleExn n;
52.532 -\end{ttbox}
52.533 -Observe the function's two arguments, the signature \texttt{sign} and the
52.534 -exception given as a pattern. The function checks its argument for
52.535 -validity. If $n$ is positive and even then it creates a tautology
52.536 -containing $n$ occurrences of~$P$. Otherwise it signals error by
52.537 -raising its own exception (just by happy coincidence). Errors may be
52.538 -signalled by other means, such as returning the theorem \texttt{True}.
52.539 -Please ensure that the oracle's result is correctly typed; Isabelle
52.540 -will reject ill-typed theorems by raising a cryptic exception at top
52.541 -level.
52.542 -
52.543 -The \texttt{oracle} section of \texttt{IffOracle.thy} installs above
52.544 -\texttt{ML} function as follows:
52.545 -\begin{ttbox}
52.546 -IffOracle = FOL +\medskip
52.547 -oracle
52.548 - iff = mk_iff_oracle\medskip
52.549 -end
52.550 -\end{ttbox}
52.551 -
52.552 -Now in \texttt{IffOracle.ML} we first define a wrapper for invoking
52.553 -the oracle:
52.554 -\begin{ttbox}
52.555 -fun iff_oracle n = invoke_oracle IffOracle.thy "iff"
52.556 - (sign_of IffOracle.thy, IffOracleExn n);
52.557 -\end{ttbox}
52.558 -
52.559 -Here are some example applications of the \texttt{iff} oracle. An
52.560 -argument of 10 is allowed, but one of 5 is forbidden:
52.561 -\begin{ttbox}
52.562 -iff_oracle 10;
52.563 -{\out "P <-> P <-> P <-> P <-> P <-> P <-> P <-> P <-> P <-> P" : thm}
52.564 -iff_oracle 5;
52.565 -{\out Exception- IffOracleExn 5 raised}
52.566 -\end{ttbox}
52.567 -
52.568 -\index{oracles|)}
52.569 \index{theories|)}
52.570
52.571
53.1 --- a/doc-src/Ref/thm.tex Wed Mar 04 10:43:39 2009 +0100
53.2 +++ b/doc-src/Ref/thm.tex Wed Mar 04 10:45:52 2009 +0100
53.3 @@ -1,4 +1,4 @@
53.4 -%% $Id$
53.5 +
53.6 \chapter{Theorems and Forward Proof}
53.7 \index{theorems|(}
53.8
53.9 @@ -13,19 +13,6 @@
53.10 ignore such complexities --- and skip all but the first section of
53.11 this chapter.
53.12
53.13 -The theorem operations do not print error messages. Instead, they raise
53.14 -exception~\xdx{THM}\@. Use \ttindex{print_exn} to display
53.15 -exceptions nicely:
53.16 -\begin{ttbox}
53.17 -allI RS mp handle e => print_exn e;
53.18 -{\out Exception THM raised:}
53.19 -{\out RSN: no unifiers -- premise 1}
53.20 -{\out (!!x. ?P(x)) ==> ALL x. ?P(x)}
53.21 -{\out [| ?P --> ?Q; ?P |] ==> ?Q}
53.22 -{\out}
53.23 -{\out uncaught exception THM}
53.24 -\end{ttbox}
53.25 -
53.26
53.27 \section{Basic operations on theorems}
53.28 \subsection{Pretty-printing a theorem}
54.1 --- a/doc-src/System/Thy/Basics.thy Wed Mar 04 10:43:39 2009 +0100
54.2 +++ b/doc-src/System/Thy/Basics.thy Wed Mar 04 10:45:52 2009 +0100
54.3 @@ -360,8 +360,8 @@
54.4 @{verbatim "-W"} option makes Isabelle enter a special process
54.5 wrapper for interaction via an external program; the protocol is a
54.6 stripped-down version of Proof General the interaction mode, see
54.7 - also @{"file" "~~/src/Pure/Tools/isabelle_process.ML"} and @{"file"
54.8 - "~~/src/Pure/Tools/isabelle_process.scala"}.
54.9 + also @{"file" "~~/src/Pure/System/isabelle_process.ML"} and @{"file"
54.10 + "~~/src/Pure/System/isabelle_process.scala"}.
54.11
54.12 \medskip The @{verbatim "-S"} option makes the Isabelle process more
54.13 secure by disabling some critical operations, notably runtime
55.1 --- a/doc-src/System/Thy/Presentation.thy Wed Mar 04 10:43:39 2009 +0100
55.2 +++ b/doc-src/System/Thy/Presentation.thy Wed Mar 04 10:45:52 2009 +0100
55.3 @@ -654,7 +654,7 @@
55.4 "-"}@{text foo}'' to drop, and ``@{verbatim "/"}@{text foo}'' to
55.5 fold text tagged as @{text foo}. The builtin default is equivalent
55.6 to the tag specification ``@{verbatim
55.7 - "/theory,/proof,/ML,+visible,-invisible"}''; see also the {\LaTeX}
55.8 + "+theory,+proof,+ML,+visible,-invisible"}''; see also the {\LaTeX}
55.9 macros @{verbatim "\\isakeeptag"}, @{verbatim "\\isadroptag"}, and
55.10 @{verbatim "\\isafoldtag"}, in @{"file"
55.11 "~~/lib/texinputs/isabelle.sty"}.
56.1 --- a/doc-src/System/Thy/document/Basics.tex Wed Mar 04 10:43:39 2009 +0100
56.2 +++ b/doc-src/System/Thy/document/Basics.tex Wed Mar 04 10:45:52 2009 +0100
56.3 @@ -369,7 +369,7 @@
56.4 \verb|-W| option makes Isabelle enter a special process
56.5 wrapper for interaction via an external program; the protocol is a
56.6 stripped-down version of Proof General the interaction mode, see
56.7 - also \hyperlink{file.~~/src/Pure/Tools/isabelle-process.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Tools{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}ML}}}} and \hyperlink{file.~~/src/Pure/Tools/isabelle-process.scala}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Tools{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}scala}}}}.
56.8 + also \hyperlink{file.~~/src/Pure/System/isabelle-process.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}System{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}ML}}}} and \hyperlink{file.~~/src/Pure/System/isabelle-process.scala}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}System{\isacharslash}isabelle{\isacharunderscore}process{\isachardot}scala}}}}.
56.9
56.10 \medskip The \verb|-S| option makes the Isabelle process more
56.11 secure by disabling some critical operations, notably runtime
57.1 --- a/doc-src/System/Thy/document/Presentation.tex Wed Mar 04 10:43:39 2009 +0100
57.2 +++ b/doc-src/System/Thy/document/Presentation.tex Wed Mar 04 10:45:52 2009 +0100
57.3 @@ -668,7 +668,7 @@
57.4 tagged Isabelle command regions. Tags are specified as a comma
57.5 separated list of modifier/name pairs: ``\verb|+|\isa{foo}'' (or just ``\isa{foo}'') means to keep, ``\verb|-|\isa{foo}'' to drop, and ``\verb|/|\isa{foo}'' to
57.6 fold text tagged as \isa{foo}. The builtin default is equivalent
57.7 - to the tag specification ``\verb|/theory,/proof,/ML,+visible,-invisible|''; see also the {\LaTeX}
57.8 + to the tag specification ``\verb|+theory,+proof,+ML,+visible,-invisible|''; see also the {\LaTeX}
57.9 macros \verb|\isakeeptag|, \verb|\isadroptag|, and
57.10 \verb|\isafoldtag|, in \hyperlink{file.~~/lib/texinputs/isabelle.sty}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}lib{\isacharslash}texinputs{\isacharslash}isabelle{\isachardot}sty}}}}.
57.11
58.1 --- a/doc-src/System/system.tex Wed Mar 04 10:43:39 2009 +0100
58.2 +++ b/doc-src/System/system.tex Wed Mar 04 10:45:52 2009 +0100
58.3 @@ -36,7 +36,7 @@
58.4 \input{Thy/document/Misc.tex}
58.5
58.6 \begingroup
58.7 - \bibliographystyle{plain} \small\raggedright\frenchspacing
58.8 + \bibliographystyle{abbrv} \small\raggedright\frenchspacing
58.9 \bibliography{../manual}
58.10 \endgroup
58.11
59.1 --- a/doc-src/TutorialI/Types/Numbers.thy Wed Mar 04 10:43:39 2009 +0100
59.2 +++ b/doc-src/TutorialI/Types/Numbers.thy Wed Mar 04 10:45:52 2009 +0100
59.3 @@ -100,8 +100,8 @@
59.4 @{thm[display] div_mult1_eq[no_vars]}
59.5 \rulename{div_mult1_eq}
59.6
59.7 -@{thm[display] mod_mult1_eq[no_vars]}
59.8 -\rulename{mod_mult1_eq}
59.9 +@{thm[display] mod_mult_right_eq[no_vars]}
59.10 +\rulename{mod_mult_right_eq}
59.11
59.12 @{thm[display] div_mult2_eq[no_vars]}
59.13 \rulename{div_mult2_eq}
59.14 @@ -147,8 +147,8 @@
59.15 @{thm[display] zdiv_zadd1_eq[no_vars]}
59.16 \rulename{zdiv_zadd1_eq}
59.17
59.18 -@{thm[display] zmod_zadd1_eq[no_vars]}
59.19 -\rulename{zmod_zadd1_eq}
59.20 +@{thm[display] mod_add_eq[no_vars]}
59.21 +\rulename{mod_add_eq}
59.22
59.23 @{thm[display] zdiv_zmult1_eq[no_vars]}
59.24 \rulename{zdiv_zmult1_eq}
60.1 --- a/doc-src/TutorialI/Types/document/Numbers.tex Wed Mar 04 10:43:39 2009 +0100
60.2 +++ b/doc-src/TutorialI/Types/document/Numbers.tex Wed Mar 04 10:45:52 2009 +0100
60.3 @@ -244,7 +244,7 @@
60.4 \begin{isabelle}%
60.5 a\ {\isacharasterisk}\ b\ mod\ c\ {\isacharequal}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ mod\ c{\isacharparenright}\ mod\ c%
60.6 \end{isabelle}
60.7 -\rulename{mod_mult1_eq}
60.8 +\rulename{mod_mult_right_eq}
60.9
60.10 \begin{isabelle}%
60.11 a\ div\ {\isacharparenleft}b\ {\isacharasterisk}\ c{\isacharparenright}\ {\isacharequal}\ a\ div\ b\ div\ c%
60.12 @@ -318,7 +318,7 @@
60.13 \begin{isabelle}%
60.14 {\isacharparenleft}a\ {\isacharplus}\ b{\isacharparenright}\ mod\ c\ {\isacharequal}\ {\isacharparenleft}a\ mod\ c\ {\isacharplus}\ b\ mod\ c{\isacharparenright}\ mod\ c%
60.15 \end{isabelle}
60.16 -\rulename{zmod_zadd1_eq}
60.17 +\rulename{mod_add_eq}
60.18
60.19 \begin{isabelle}%
60.20 a\ {\isacharasterisk}\ b\ div\ c\ {\isacharequal}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ div\ c{\isacharparenright}\ {\isacharplus}\ a\ {\isacharasterisk}\ {\isacharparenleft}b\ mod\ c{\isacharparenright}\ div\ c%
61.1 --- a/doc-src/TutorialI/Types/numerics.tex Wed Mar 04 10:43:39 2009 +0100
61.2 +++ b/doc-src/TutorialI/Types/numerics.tex Wed Mar 04 10:45:52 2009 +0100
61.3 @@ -154,7 +154,7 @@
61.4 a\ *\ b\ div\ c\ =\ a\ *\ (b\ div\ c)\ +\ a\ *\ (b\ mod\ c)\ div\ c%
61.5 \rulename{div_mult1_eq}\isanewline
61.6 a\ *\ b\ mod\ c\ =\ a\ *\ (b\ mod\ c)\ mod\ c%
61.7 -\rulename{mod_mult1_eq}\isanewline
61.8 +\rulename{mod_mult_right_eq}\isanewline
61.9 a\ div\ (b*c)\ =\ a\ div\ b\ div\ c%
61.10 \rulename{div_mult2_eq}\isanewline
61.11 a\ mod\ (b*c)\ =\ b * (a\ div\ b\ mod\ c)\ +\ a\ mod\ b%
61.12 @@ -276,7 +276,7 @@
61.13 \rulename{zdiv_zadd1_eq}
61.14 \par\smallskip
61.15 (a\ +\ b)\ mod\ c\ =\ (a\ mod\ c\ +\ b\ mod\ c)\ mod\ c%
61.16 -\rulename{zmod_zadd1_eq}
61.17 +\rulename{mod_add_eq}
61.18 \end{isabelle}
61.19
61.20 \begin{isabelle}
62.1 --- a/doc-src/ZF/FOL.tex Wed Mar 04 10:43:39 2009 +0100
62.2 +++ b/doc-src/ZF/FOL.tex Wed Mar 04 10:45:52 2009 +0100
62.3 @@ -1,4 +1,4 @@
62.4 -%% $Id$
62.5 +%!TEX root = logics-ZF.tex
62.6 \chapter{First-Order Logic}
62.7 \index{first-order logic|(}
62.8
62.9 @@ -360,7 +360,8 @@
62.10 logic by designating \isa{IFOL} rather than \isa{FOL} as the parent
62.11 theory:
62.12 \begin{isabelle}
62.13 -\isacommand{theory}\ IFOL\_examples\ =\ IFOL:
62.14 +\isacommand{theory}\ IFOL\_examples\ \isacommand{imports}\ IFOL\isanewline
62.15 +\isacommand{begin}
62.16 \end{isabelle}
62.17 The proof begins by entering the goal, then applying the rule $({\imp}I)$.
62.18 \begin{isabelle}
62.19 @@ -441,7 +442,7 @@
62.20 \ 1.\ (\isasymexists y.\ \isasymforall x.\ Q(x,\ y))\
62.21 \isasymlongrightarrow \ (\isasymforall x.\ \isasymexists y.\ Q(x,\ y))
62.22 \isanewline
62.23 -\isacommand{by} (tactic {*IntPr.fast_tac 1*})\isanewline
62.24 +\isacommand{by} (tactic \ttlbrace*IntPr.fast_tac 1*\ttrbrace)\isanewline
62.25 No\ subgoals!
62.26 \end{isabelle}
62.27
62.28 @@ -529,7 +530,8 @@
62.29 $\all{x}P(x)$ is true. Either way the theorem holds. First, we must
62.30 work in a theory based on classical logic, the theory \isa{FOL}:
62.31 \begin{isabelle}
62.32 -\isacommand{theory}\ FOL\_examples\ =\ FOL:
62.33 +\isacommand{theory}\ FOL\_examples\ \isacommand{imports}\ FOL\isanewline
62.34 +\isacommand{begin}
62.35 \end{isabelle}
62.36
62.37 The formal proof does not conform in any obvious way to the sketch given
62.38 @@ -631,7 +633,8 @@
62.39 $if::[o,o,o]\To o$. The axiom \tdx{if_def} asserts the
62.40 equation~$(if)$.
62.41 \begin{isabelle}
62.42 -\isacommand{theory}\ If\ =\ FOL:\isanewline
62.43 +\isacommand{theory}\ If\ \isacommand{imports}\ FOL\isanewline
62.44 +\isacommand{begin}\isanewline
62.45 \isacommand{constdefs}\isanewline
62.46 \ \ if\ ::\ "[o,o,o]=>o"\isanewline
62.47 \ \ \ "if(P,Q,R)\ ==\ P\&Q\ |\ \isachartilde P\&R"
63.1 --- a/doc-src/antiquote_setup.ML Wed Mar 04 10:43:39 2009 +0100
63.2 +++ b/doc-src/antiquote_setup.ML Wed Mar 04 10:45:52 2009 +0100
63.3 @@ -1,5 +1,4 @@
63.4 (* Title: Doc/antiquote_setup.ML
63.5 - ID: $Id$
63.6 Author: Makarius
63.7
63.8 Auxiliary antiquotations for the Isabelle manuals.
63.9 @@ -13,13 +12,17 @@
63.10
63.11 (* misc utils *)
63.12
63.13 -val clean_string = translate_string
63.14 +fun translate f = Symbol.explode #> map f #> implode;
63.15 +
63.16 +val clean_string = translate
63.17 (fn "_" => "\\_"
63.18 + | "#" => "\\#"
63.19 | "<" => "$<$"
63.20 | ">" => "$>$"
63.21 - | "#" => "\\#"
63.22 | "{" => "\\{"
63.23 + | "|" => "$\\mid$"
63.24 | "}" => "\\}"
63.25 + | "\\<dash>" => "-"
63.26 | c => c);
63.27
63.28 fun clean_name "\\<dots>" = "dots"
63.29 @@ -28,7 +31,7 @@
63.30 | clean_name "_" = "underscore"
63.31 | clean_name "{" = "braceleft"
63.32 | clean_name "}" = "braceright"
63.33 - | clean_name s = s |> translate_string (fn "_" => "-" | c => c);
63.34 + | clean_name s = s |> translate (fn "_" => "-" | "\\<dash>" => "-" | c => c);
63.35
63.36
63.37 (* verbatim text *)
63.38 @@ -66,8 +69,9 @@
63.39 val txt' = if kind = "" then txt else kind ^ " " ^ txt;
63.40 val _ = writeln (ml (txt1, txt2));
63.41 val _ = ML_Context.eval_in (SOME ctxt) false Position.none (ml (txt1, txt2));
63.42 + val kind' = if kind = "" then "ML" else "ML " ^ kind;
63.43 in
63.44 - "\\indexml" ^ kind ^ enclose "{" "}" (clean_string txt1) ^
63.45 + "\\indexdef{}{" ^ kind' ^ "}{" ^ clean_string txt1 ^ "}" ^
63.46 (txt'
63.47 |> (if ! O.quotes then quote else I)
63.48 |> (if ! O.display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
63.49 @@ -193,6 +197,7 @@
63.50 entity_antiqs no_check "" "case" @
63.51 entity_antiqs (K ThyOutput.defined_command) "" "antiquotation" @
63.52 entity_antiqs (fn _ => fn name => is_some (OS.Process.getEnv name)) "isatt" "setting" @
63.53 + entity_antiqs no_check "" "inference" @
63.54 entity_antiqs no_check "isatt" "executable" @
63.55 entity_antiqs (K check_tool) "isatt" "tool" @
63.56 entity_antiqs (K (File.exists o Path.explode)) "isatt" "file" @
64.1 --- a/doc-src/isar.sty Wed Mar 04 10:43:39 2009 +0100
64.2 +++ b/doc-src/isar.sty Wed Mar 04 10:45:52 2009 +0100
64.3 @@ -1,6 +1,3 @@
64.4 -
64.5 -%% $Id$
64.6 -
64.7 \usepackage{ifthen}
64.8
64.9 \newcommand{\indexdef}[3]%
64.10 @@ -20,3 +17,9 @@
64.11 \newcommand{\isasymIMPORTS}{\isakeyword{imports}}
64.12 \newcommand{\isasymIN}{\isakeyword{in}}
64.13 \newcommand{\isasymSTRUCTURE}{\isakeyword{structure}}
64.14 +\newcommand{\isasymFIXES}{\isakeyword{fixes}}
64.15 +\newcommand{\isasymASSUMES}{\isakeyword{assumes}}
64.16 +\newcommand{\isasymSHOWS}{\isakeyword{shows}}
64.17 +\newcommand{\isasymOBTAINS}{\isakeyword{obtains}}
64.18 +
64.19 +\newcommand{\isasymASSM}{\isacommand{assm}}
65.1 --- a/doc-src/manual.bib Wed Mar 04 10:43:39 2009 +0100
65.2 +++ b/doc-src/manual.bib Wed Mar 04 10:45:52 2009 +0100
65.3 @@ -1,6 +1,4 @@
65.4 % BibTeX database for the Isabelle documentation
65.5 -%
65.6 -% Lawrence C Paulson $Id$
65.7
65.8 %publishers
65.9 @string{AP="Academic Press"}
65.10 @@ -185,6 +183,16 @@
65.11 {F}ormal-{L}ogic {E}ngineering},
65.12 crossref = {tphols99}}
65.13
65.14 +
65.15 +@InProceedings{Bezem-Coquand:2005,
65.16 + author = {M.A. Bezem and T. Coquand},
65.17 + title = {Automating {Coherent Logic}},
65.18 + booktitle = {LPAR-12},
65.19 + editor = {G. Sutcliffe and A. Voronkov},
65.20 + volume = 3835,
65.21 + series = LNCS,
65.22 + publisher = Springer}
65.23 +
65.24 @book{Bird-Wadler,author="Richard Bird and Philip Wadler",
65.25 title="Introduction to Functional Programming",publisher=PH,year=1988}
65.26
65.27 @@ -469,6 +477,17 @@
65.28 number = {364/07}
65.29 }
65.30
65.31 +@InProceedings{Haftmann-Wenzel:2009,
65.32 + author = {Florian Haftmann and Makarius Wenzel},
65.33 + title = {Local theory specifications in {Isabelle/Isar}},
65.34 + editor = {Stefano Berardi and Ferruccio Damiani and de Liguoro, Ugo},
65.35 + booktitle = {Types for Proofs and Programs, TYPES 2008},
65.36 + publisher = {Springer},
65.37 + series = {LNCS},
65.38 + volume = {????},
65.39 + year = {2009}
65.40 +}
65.41 +
65.42 @manual{isabelle-classes,
65.43 author = {Florian Haftmann},
65.44 title = {Haskell-style type classes with {Isabelle}/{Isar}},
65.45 @@ -669,6 +688,16 @@
65.46 pages = {341-386},
65.47 crossref = {birtwistle89}}
65.48
65.49 +@Article{Miller:1991,
65.50 + author = {Dale Miller},
65.51 + title = {A Logic Programming Language with Lambda-Abstraction, Function Variables,
65.52 + and Simple Unification},
65.53 + journal = {Journal of Logic and Computation},
65.54 + year = 1991,
65.55 + volume = 1,
65.56 + number = 4
65.57 +}
65.58 +
65.59 @Article{miller-mixed,
65.60 Author = {Dale Miller},
65.61 Title = {Unification Under a Mixed Prefix},
65.62 @@ -1198,6 +1227,15 @@
65.63 pages = {578-596},
65.64 crossref = {fme93}}
65.65
65.66 +@Article{Schroeder-Heister:1984,
65.67 + author = {Peter Schroeder-Heister},
65.68 + title = {A Natural Extension of Natural Deduction},
65.69 + journal = {Journal of Symbolic Logic},
65.70 + year = 1984,
65.71 + volume = 49,
65.72 + number = 4
65.73 +}
65.74 +
65.75 @inproceedings{slind-tfl,
65.76 author = {Konrad Slind},
65.77 title = {Function Definition in Higher Order Logic},
65.78 @@ -1331,6 +1369,24 @@
65.79 year=2002,
65.80 note = {\url{http://tumb1.biblio.tu-muenchen.de/publ/diss/in/2002/wenzel.html}}}
65.81
65.82 +@Article{Wenzel-Wiedijk:2002,
65.83 + author = {Freek Wiedijk and Markus Wenzel},
65.84 + title = {A comparison of the mathematical proof languages {Mizar} and {Isar}.},
65.85 + journal = {Journal of Automated Reasoning},
65.86 + year = 2002,
65.87 + volume = 29,
65.88 + number = {3-4}
65.89 +}
65.90 +
65.91 +@InCollection{Wenzel-Paulson:2006,
65.92 + author = {Markus Wenzel and Lawrence C. Paulson},
65.93 + title = {{Isabelle/Isar}},
65.94 + booktitle = {The Seventeen Provers of the World},
65.95 + year = 2006,
65.96 + editor = {F. Wiedijk},
65.97 + series = {LNAI 3600}
65.98 +}
65.99 +
65.100 @InCollection{Wenzel:2006:Festschrift,
65.101 author = {Makarius Wenzel},
65.102 title = {{Isabelle/Isar} --- a generic framework for human-readable proof documents},
66.1 --- a/doc-src/more_antiquote.ML Wed Mar 04 10:43:39 2009 +0100
66.2 +++ b/doc-src/more_antiquote.ML Wed Mar 04 10:45:52 2009 +0100
66.3 @@ -1,5 +1,4 @@
66.4 (* Title: Doc/more_antiquote.ML
66.5 - ID: $Id$
66.6 Author: Florian Haftmann, TU Muenchen
66.7
66.8 More antiquotations.
66.9 @@ -92,9 +91,9 @@
66.10 let
66.11 val thy = ProofContext.theory_of ctxt;
66.12 val const = Code_Unit.check_const thy raw_const;
66.13 - val (_, funcgr) = Code_Funcgr.make thy [const];
66.14 + val (_, funcgr) = Code_Wellsorted.make thy [const];
66.15 fun holize thm = @{thm meta_eq_to_obj_eq} OF [thm];
66.16 - val thms = Code_Funcgr.eqns funcgr const
66.17 + val thms = Code_Wellsorted.eqns funcgr const
66.18 |> map_filter (fn (thm, linear) => if linear then SOME thm else NONE)
66.19 |> map (holize o no_vars ctxt o AxClass.overload thy);
66.20 in ThyOutput.output_list pretty_thm src ctxt thms end;
67.1 --- a/doc/Contents Wed Mar 04 10:43:39 2009 +0100
67.2 +++ b/doc/Contents Wed Mar 04 10:45:52 2009 +0100
67.3 @@ -6,13 +6,16 @@
67.4 functions Tutorial on Function Definitions
67.5 codegen Tutorial on Code Generation
67.6 sugar LaTeX sugar for proof documents
67.7 - ind-defs (Co)Inductive Definitions in ZF
67.8
67.9 Reference Manuals
67.10 isar-ref The Isabelle/Isar Reference Manual
67.11 implementation The Isabelle/Isar Implementation Manual
67.12 system The Isabelle System Manual
67.13 - ref The Isabelle Reference Manual
67.14 +
67.15 +Old Manuals (outdated!)
67.16 + intro Old Introduction to Isabelle
67.17 + ref Old Isabelle Reference Manual
67.18 logics Isabelle's Logics: overview and misc logics
67.19 logics-HOL Isabelle's Logics: HOL
67.20 logics-ZF Isabelle's Logics: FOL and ZF
67.21 + ind-defs (Co)Inductive Definitions in ZF
68.1 --- a/etc/settings Wed Mar 04 10:43:39 2009 +0100
68.2 +++ b/etc/settings Wed Mar 04 10:45:52 2009 +0100
68.3 @@ -60,12 +60,6 @@
68.4 #ML_OPTIONS=""
68.5 #ML_PLATFORM=""
68.6
68.7 -# Alice 1.4 (experimental!)
68.8 -#ML_SYSTEM=alice
68.9 -#ML_HOME="/usr/local/alice/bin"
68.10 -#ML_OPTIONS=""
68.11 -#ML_PLATFORM=""
68.12 -
68.13
68.14 ###
68.15 ### JVM components (Scala or Java)
68.16 @@ -268,6 +262,8 @@
68.17
68.18 # zChaff (SAT Solver, cf. Isabelle/src/HOL/Tools/sat_solver.ML)
68.19 #ZCHAFF_HOME=/usr/local/bin
68.20 +#ZCHAFF_VERSION=2004.5.13
68.21 +#ZCHAFF_VERSION=2004.11.15
68.22
68.23 # BerkMin561 (SAT Solver, cf. Isabelle/src/HOL/Tools/sat_solver.ML)
68.24 #BERKMIN_HOME=/usr/local/bin
69.1 --- a/lib/Tools/codegen Wed Mar 04 10:43:39 2009 +0100
69.2 +++ b/lib/Tools/codegen Wed Mar 04 10:45:52 2009 +0100
69.3 @@ -36,5 +36,5 @@
69.4 THY=$(echo $THY | sed -e 's/\\/\\\\"/g; s/"/\\\"/g')
69.5 ISAR="theory Codegen imports \"$THY\" begin export_code $CMD end"
69.6
69.7 -echo "$ISAR" | "$ISABELLE_TOOL" tty -l "$IMAGE"
69.8 +echo "$ISAR" | "$ISABELLE_PROCESS" -I "$IMAGE"
69.9 exit ${PIPESTATUS[1]}
70.1 --- a/src/FOL/IFOL.thy Wed Mar 04 10:43:39 2009 +0100
70.2 +++ b/src/FOL/IFOL.thy Wed Mar 04 10:45:52 2009 +0100
70.3 @@ -1,5 +1,4 @@
70.4 (* Title: FOL/IFOL.thy
70.5 - ID: $Id$
70.6 Author: Lawrence C Paulson and Markus Wenzel
70.7 *)
70.8
70.9 @@ -14,9 +13,10 @@
70.10 "~~/src/Tools/IsaPlanner/isand.ML"
70.11 "~~/src/Tools/IsaPlanner/rw_tools.ML"
70.12 "~~/src/Tools/IsaPlanner/rw_inst.ML"
70.13 - "~~/src/Provers/eqsubst.ML"
70.14 + "~~/src/Tools/eqsubst.ML"
70.15 "~~/src/Provers/quantifier1.ML"
70.16 - "~~/src/Provers/project_rule.ML"
70.17 + "~~/src/Tools/intuitionistic.ML"
70.18 + "~~/src/Tools/project_rule.ML"
70.19 "~~/src/Tools/atomize_elim.ML"
70.20 ("fologic.ML")
70.21 ("hypsubstdata.ML")
70.22 @@ -610,6 +610,8 @@
70.23
70.24 subsection {* Intuitionistic Reasoning *}
70.25
70.26 +setup {* Intuitionistic.method_setup "iprover" *}
70.27 +
70.28 lemma impE':
70.29 assumes 1: "P --> Q"
70.30 and 2: "Q ==> R"
71.1 --- a/src/FOL/IsaMakefile Wed Mar 04 10:43:39 2009 +0100
71.2 +++ b/src/FOL/IsaMakefile Wed Mar 04 10:45:52 2009 +0100
71.3 @@ -32,12 +32,13 @@
71.4 $(SRC)/Provers/clasimp.ML $(SRC)/Provers/classical.ML \
71.5 $(SRC)/Tools/IsaPlanner/zipper.ML $(SRC)/Tools/IsaPlanner/isand.ML \
71.6 $(SRC)/Tools/IsaPlanner/rw_tools.ML \
71.7 - $(SRC)/Tools/IsaPlanner/rw_inst.ML $(SRC)/Provers/eqsubst.ML \
71.8 + $(SRC)/Tools/IsaPlanner/rw_inst.ML $(SRC)/Tools/eqsubst.ML \
71.9 $(SRC)/Provers/hypsubst.ML $(SRC)/Tools/induct.ML \
71.10 - $(SRC)/Tools/atomize_elim.ML $(SRC)/Provers/project_rule.ML \
71.11 - $(SRC)/Provers/quantifier1.ML $(SRC)/Provers/splitter.ML FOL.thy \
71.12 - IFOL.thy ROOT.ML blastdata.ML cladata.ML document/root.tex \
71.13 - fologic.ML hypsubstdata.ML intprover.ML simpdata.ML
71.14 + $(SRC)/Tools/intuitionistic.ML $(SRC)/Tools/atomize_elim.ML \
71.15 + $(SRC)/Tools/project_rule.ML $(SRC)/Provers/quantifier1.ML \
71.16 + $(SRC)/Provers/splitter.ML FOL.thy IFOL.thy ROOT.ML blastdata.ML \
71.17 + cladata.ML document/root.tex fologic.ML hypsubstdata.ML intprover.ML \
71.18 + simpdata.ML
71.19 @$(ISABELLE_TOOL) usedir -p 2 -b $(OUT)/Pure FOL
71.20
71.21
71.22 @@ -46,12 +47,12 @@
71.23 FOL-ex: FOL $(LOG)/FOL-ex.gz
71.24
71.25 $(LOG)/FOL-ex.gz: $(OUT)/FOL ex/First_Order_Logic.thy ex/If.thy \
71.26 - ex/IffOracle.thy ex/Nat.thy ex/Natural_Numbers.thy \
71.27 - ex/LocaleTest.thy \
71.28 - ex/Miniscope.thy ex/Prolog.thy ex/ROOT.ML ex/Classical.thy \
71.29 - ex/document/root.tex ex/Foundation.thy ex/Intuitionistic.thy \
71.30 - ex/Intro.thy ex/Propositional_Int.thy ex/Propositional_Cla.thy \
71.31 - ex/Quantifiers_Int.thy ex/Quantifiers_Cla.thy
71.32 + ex/Iff_Oracle.thy ex/Nat.thy ex/Nat_Class.thy ex/Natural_Numbers.thy \
71.33 + ex/LocaleTest.thy ex/Miniscope.thy ex/Prolog.thy ex/ROOT.ML \
71.34 + ex/Classical.thy ex/document/root.tex ex/Foundation.thy \
71.35 + ex/Intuitionistic.thy ex/Intro.thy ex/Propositional_Int.thy \
71.36 + ex/Propositional_Cla.thy ex/Quantifiers_Int.thy \
71.37 + ex/Quantifiers_Cla.thy
71.38 @$(ISABELLE_TOOL) usedir $(OUT)/FOL ex
71.39
71.40
72.1 --- a/src/FOL/ex/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
72.2 +++ b/src/FOL/ex/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
72.3 @@ -1,7 +1,4 @@
72.4 (* Title: FOL/ex/ROOT.ML
72.5 - ID: $Id$
72.6 - Author: Lawrence C Paulson, Cambridge University Computer Laboratory
72.7 - Copyright 1992 University of Cambridge
72.8
72.9 Examples for First-Order Logic.
72.10 *)
72.11 @@ -11,23 +8,19 @@
72.12 "Natural_Numbers",
72.13 "Intro",
72.14 "Nat",
72.15 + "Nat_Class",
72.16 "Foundation",
72.17 "Prolog",
72.18 -
72.19 "Intuitionistic",
72.20 "Propositional_Int",
72.21 "Quantifiers_Int",
72.22 -
72.23 "Classical",
72.24 "Propositional_Cla",
72.25 "Quantifiers_Cla",
72.26 "Miniscope",
72.27 "If",
72.28 -
72.29 - "NatClass",
72.30 - "IffOracle"
72.31 + "Iff_Oracle"
72.32 ];
72.33
72.34 (*regression test for locales -- sets several global flags!*)
72.35 no_document use_thy "LocaleTest";
72.36 -
73.1 --- a/src/FOLP/simp.ML Wed Mar 04 10:43:39 2009 +0100
73.2 +++ b/src/FOLP/simp.ML Wed Mar 04 10:45:52 2009 +0100
73.3 @@ -433,7 +433,7 @@
73.4 val thms = map (trivial o cterm_of(Thm.theory_of_thm thm)) As;
73.5 val new_rws = List.concat(map mk_rew_rules thms);
73.6 val rwrls = map mk_trans (List.concat(map mk_rew_rules thms));
73.7 - val anet' = foldr lhs_insert_thm anet rwrls
73.8 + val anet' = List.foldr lhs_insert_thm anet rwrls
73.9 in if !tracing andalso not(null new_rws)
73.10 then (writeln"Adding rewrites:"; Display.prths new_rws; ())
73.11 else ();
74.1 --- a/src/HOL/Algebra/Coset.thy Wed Mar 04 10:43:39 2009 +0100
74.2 +++ b/src/HOL/Algebra/Coset.thy Wed Mar 04 10:45:52 2009 +0100
74.3 @@ -602,8 +602,8 @@
74.4 interpret group G by fact
74.5 show ?thesis
74.6 proof (intro equiv.intro)
74.7 - show "refl (carrier G) (rcong H)"
74.8 - by (auto simp add: r_congruent_def refl_def)
74.9 + show "refl_on (carrier G) (rcong H)"
74.10 + by (auto simp add: r_congruent_def refl_on_def)
74.11 next
74.12 show "sym (rcong H)"
74.13 proof (simp add: r_congruent_def sym_def, clarify)
75.1 --- a/src/HOL/Algebra/Exponent.thy Wed Mar 04 10:43:39 2009 +0100
75.2 +++ b/src/HOL/Algebra/Exponent.thy Wed Mar 04 10:45:52 2009 +0100
75.3 @@ -210,12 +210,12 @@
75.4
75.5 lemma p_fac_forw: "[| (m::nat) > 0; k>0; k < p^a; (p^r) dvd (p^a)* m - k |]
75.6 ==> (p^r) dvd (p^a) - k"
75.7 -apply (frule_tac k1 = k and i = p in p_fac_forw_lemma [THEN le_imp_power_dvd], auto)
75.8 +apply (frule p_fac_forw_lemma [THEN le_imp_power_dvd, of _ k p], auto)
75.9 apply (subgoal_tac "p^r dvd p^a*m")
75.10 prefer 2 apply (blast intro: dvd_mult2)
75.11 apply (drule dvd_diffD1)
75.12 apply assumption
75.13 - prefer 2 apply (blast intro: dvd_diff)
75.14 + prefer 2 apply (blast intro: nat_dvd_diff)
75.15 apply (drule gr0_implies_Suc, auto)
75.16 done
75.17
75.18 @@ -226,12 +226,12 @@
75.19
75.20 lemma p_fac_backw: "[| m>0; k>0; (p::nat)\<noteq>0; k < p^a; (p^r) dvd p^a - k |]
75.21 ==> (p^r) dvd (p^a)*m - k"
75.22 -apply (frule_tac k1 = k and i = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
75.23 +apply (frule_tac k1 = k and p1 = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
75.24 apply (subgoal_tac "p^r dvd p^a*m")
75.25 prefer 2 apply (blast intro: dvd_mult2)
75.26 apply (drule dvd_diffD1)
75.27 apply assumption
75.28 - prefer 2 apply (blast intro: dvd_diff)
75.29 + prefer 2 apply (blast intro: nat_dvd_diff)
75.30 apply (drule less_imp_Suc_add, auto)
75.31 done
75.32
76.1 --- a/src/HOL/Algebra/Sylow.thy Wed Mar 04 10:43:39 2009 +0100
76.2 +++ b/src/HOL/Algebra/Sylow.thy Wed Mar 04 10:45:52 2009 +0100
76.3 @@ -20,8 +20,8 @@
76.4 and "RelM == {(N1,N2). N1 \<in> calM & N2 \<in> calM &
76.5 (\<exists>g \<in> carrier(G). N1 = (N2 #> g) )}"
76.6
76.7 -lemma (in sylow) RelM_refl: "refl calM RelM"
76.8 -apply (auto simp add: refl_def RelM_def calM_def)
76.9 +lemma (in sylow) RelM_refl_on: "refl_on calM RelM"
76.10 +apply (auto simp add: refl_on_def RelM_def calM_def)
76.11 apply (blast intro!: coset_mult_one [symmetric])
76.12 done
76.13
76.14 @@ -40,7 +40,7 @@
76.15
76.16 lemma (in sylow) RelM_equiv: "equiv calM RelM"
76.17 apply (unfold equiv_def)
76.18 -apply (blast intro: RelM_refl RelM_sym RelM_trans)
76.19 +apply (blast intro: RelM_refl_on RelM_sym RelM_trans)
76.20 done
76.21
76.22 lemma (in sylow) M_subset_calM_prep: "M' \<in> calM // RelM ==> M' \<subseteq> calM"
77.1 --- a/src/HOL/Algebra/poly/UnivPoly2.thy Wed Mar 04 10:43:39 2009 +0100
77.2 +++ b/src/HOL/Algebra/poly/UnivPoly2.thy Wed Mar 04 10:45:52 2009 +0100
77.3 @@ -1,6 +1,5 @@
77.4 (*
77.5 Title: Univariate Polynomials
77.6 - Id: $Id$
77.7 Author: Clemens Ballarin, started 9 December 1996
77.8 Copyright: Clemens Ballarin
77.9 *)
77.10 @@ -388,7 +387,7 @@
77.11 proof (cases k)
77.12 case 0 then show ?thesis by simp ring
77.13 next
77.14 - case Suc then show ?thesis by (simp add: algebra_simps) ring
77.15 + case Suc then show ?thesis by simp (ring, simp)
77.16 qed
77.17 then show "coeff (monom a 0 * p) k = coeff (a *s p) k" by ring
77.18 qed
78.1 --- a/src/HOL/Arith_Tools.thy Wed Mar 04 10:43:39 2009 +0100
78.2 +++ b/src/HOL/Arith_Tools.thy Wed Mar 04 10:45:52 2009 +0100
78.3 @@ -68,8 +68,9 @@
78.4 apply (subst add_eq_if)
78.5 apply (simp split add: nat.split
78.6 del: nat_numeral_1_eq_1
78.7 - add: numeral_1_eq_Suc_0 [symmetric] Let_def
78.8 - neg_imp_number_of_eq_0 neg_number_of_pred_iff_0)
78.9 + add: nat_numeral_1_eq_1 [symmetric]
78.10 + numeral_1_eq_Suc_0 [symmetric]
78.11 + neg_number_of_pred_iff_0)
78.12 done
78.13
78.14 lemma nat_rec_number_of [simp]:
78.15 @@ -89,7 +90,8 @@
78.16 apply (subst add_eq_if)
78.17 apply (simp split add: nat.split
78.18 del: nat_numeral_1_eq_1
78.19 - add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
78.20 + add: nat_numeral_1_eq_1 [symmetric]
78.21 + numeral_1_eq_Suc_0 [symmetric]
78.22 neg_number_of_pred_iff_0)
78.23 done
78.24
79.1 --- a/src/HOL/Complex_Main.thy Wed Mar 04 10:43:39 2009 +0100
79.2 +++ b/src/HOL/Complex_Main.thy Wed Mar 04 10:45:52 2009 +0100
79.3 @@ -9,7 +9,6 @@
79.4 Ln
79.5 Taylor
79.6 Integration
79.7 - FrechetDeriv
79.8 begin
79.9
79.10 end
80.1 --- a/src/HOL/Decision_Procs/Approximation.thy Wed Mar 04 10:43:39 2009 +0100
80.2 +++ b/src/HOL/Decision_Procs/Approximation.thy Wed Mar 04 10:45:52 2009 +0100
80.3 @@ -1,7 +1,9 @@
80.4 -(* Title: HOL/Reflection/Approximation.thy
80.5 - * Author: Johannes Hölzl <hoelzl@in.tum.de> 2008 / 2009
80.6 - *)
80.7 +(* Title: HOL/Reflection/Approximation.thy
80.8 + Author: Johannes Hoelzl <hoelzl@in.tum.de> 2008 / 2009
80.9 +*)
80.10 +
80.11 header {* Prove unequations about real numbers by computation *}
80.12 +
80.13 theory Approximation
80.14 imports Complex_Main Float Reflection Dense_Linear_Order Efficient_Nat
80.15 begin
81.1 --- a/src/HOL/Decision_Procs/Cooper.thy Wed Mar 04 10:43:39 2009 +0100
81.2 +++ b/src/HOL/Decision_Procs/Cooper.thy Wed Mar 04 10:45:52 2009 +0100
81.3 @@ -620,7 +620,7 @@
81.4 {assume "i=0" hence ?case using "12.hyps" by (simp add: dvd_def Let_def)}
81.5 moreover
81.6 {assume i1: "abs i = 1"
81.7 - from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
81.8 + from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
81.9 have ?case using i1 apply (cases "i=0", simp_all add: Let_def)
81.10 by (cases "i > 0", simp_all)}
81.11 moreover
81.12 @@ -640,7 +640,7 @@
81.13 {assume "i=0" hence ?case using "13.hyps" by (simp add: dvd_def Let_def)}
81.14 moreover
81.15 {assume i1: "abs i = 1"
81.16 - from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
81.17 + from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
81.18 have ?case using i1 apply (cases "i=0", simp_all add: Let_def)
81.19 apply (cases "i > 0", simp_all) done}
81.20 moreover
81.21 @@ -990,7 +990,7 @@
81.22 have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
81.23 moreover
81.24 {assume "j=0" hence z: "zlfm (Dvd j a) = (zlfm (Eq a))" by (simp add: Let_def)
81.25 - hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
81.26 + hence ?case using prems by (simp del: zlfm.simps)}
81.27 moreover
81.28 {assume "?c=0" and "j\<noteq>0" hence ?case
81.29 using zsplit0_I[OF spl, where x="i" and bs="bs"]
81.30 @@ -1005,7 +1005,7 @@
81.31 moreover
81.32 {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))"
81.33 by (simp add: nb Let_def split_def)
81.34 - hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
81.35 + hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r" ]
81.36 by (simp add: Let_def split_def) }
81.37 ultimately show ?case by blast
81.38 next
81.39 @@ -1019,7 +1019,7 @@
81.40 have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
81.41 moreover
81.42 {assume "j=0" hence z: "zlfm (NDvd j a) = (zlfm (NEq a))" by (simp add: Let_def)
81.43 - hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
81.44 + hence ?case using prems by (simp del: zlfm.simps)}
81.45 moreover
81.46 {assume "?c=0" and "j\<noteq>0" hence ?case
81.47 using zsplit0_I[OF spl, where x="i" and bs="bs"]
81.48 @@ -1034,7 +1034,7 @@
81.49 moreover
81.50 {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))"
81.51 by (simp add: nb Let_def split_def)
81.52 - hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
81.53 + hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r"]
81.54 by (simp add: Let_def split_def)}
81.55 ultimately show ?case by blast
81.56 qed auto
81.57 @@ -1092,10 +1092,10 @@
81.58 using lin ad d
81.59 proof(induct p rule: iszlfm.induct)
81.60 case (9 i c e) thus ?case using d
81.61 - by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
81.62 + by (simp add: dvd_trans[of "i" "d" "d'"])
81.63 next
81.64 case (10 i c e) thus ?case using d
81.65 - by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
81.66 + by (simp add: dvd_trans[of "i" "d" "d'"])
81.67 qed simp_all
81.68
81.69 lemma \<delta> : assumes lin:"iszlfm p"
81.70 @@ -1354,7 +1354,7 @@
81.71 case (9 j c e) hence nb: "numbound0 e" by simp
81.72 have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
81.73 also have "\<dots> = (j dvd (- (c*x - ?e)))"
81.74 - by (simp only: zdvd_zminus_iff)
81.75 + by (simp only: dvd_minus_iff)
81.76 also have "\<dots> = (j dvd (c* (- x)) + ?e)"
81.77 apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
81.78 by (simp add: algebra_simps)
81.79 @@ -1366,7 +1366,7 @@
81.80 case (10 j c e) hence nb: "numbound0 e" by simp
81.81 have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
81.82 also have "\<dots> = (j dvd (- (c*x - ?e)))"
81.83 - by (simp only: zdvd_zminus_iff)
81.84 + by (simp only: dvd_minus_iff)
81.85 also have "\<dots> = (j dvd (c* (- x)) + ?e)"
81.86 apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
81.87 by (simp add: algebra_simps)
81.88 @@ -1392,7 +1392,7 @@
81.89 and dr: "d\<beta> p l"
81.90 and d: "l dvd l'"
81.91 shows "d\<beta> p l'"
81.92 -using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
81.93 +using dr linp dvd_trans[of _ "l" "l'", simplified d]
81.94 by (induct p rule: iszlfm.induct) simp_all
81.95
81.96 lemma \<alpha>_l: assumes lp: "iszlfm p"
81.97 @@ -1431,7 +1431,7 @@
81.98 by (simp add: zdiv_mono1[OF clel cp])
81.99 then have ldcp:"0 < l div c"
81.100 by (simp add: zdiv_self[OF cnz])
81.101 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.102 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.103 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.104 by simp
81.105 hence "(l*x + (l div c) * Inum (x # bs) e < 0) =
81.106 @@ -1449,7 +1449,7 @@
81.107 by (simp add: zdiv_mono1[OF clel cp])
81.108 then have ldcp:"0 < l div c"
81.109 by (simp add: zdiv_self[OF cnz])
81.110 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.111 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.112 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.113 by simp
81.114 hence "(l*x + (l div c) * Inum (x# bs) e \<le> 0) =
81.115 @@ -1467,7 +1467,7 @@
81.116 by (simp add: zdiv_mono1[OF clel cp])
81.117 then have ldcp:"0 < l div c"
81.118 by (simp add: zdiv_self[OF cnz])
81.119 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.120 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.121 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.122 by simp
81.123 hence "(l*x + (l div c)* Inum (x # bs) e > 0) =
81.124 @@ -1485,7 +1485,7 @@
81.125 by (simp add: zdiv_mono1[OF clel cp])
81.126 then have ldcp:"0 < l div c"
81.127 by (simp add: zdiv_self[OF cnz])
81.128 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.129 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.130 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.131 by simp
81.132 hence "(l*x + (l div c)* Inum (x # bs) e \<ge> 0) =
81.133 @@ -1505,7 +1505,7 @@
81.134 by (simp add: zdiv_mono1[OF clel cp])
81.135 then have ldcp:"0 < l div c"
81.136 by (simp add: zdiv_self[OF cnz])
81.137 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.138 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.139 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.140 by simp
81.141 hence "(l * x + (l div c) * Inum (x # bs) e = 0) =
81.142 @@ -1523,7 +1523,7 @@
81.143 by (simp add: zdiv_mono1[OF clel cp])
81.144 then have ldcp:"0 < l div c"
81.145 by (simp add: zdiv_self[OF cnz])
81.146 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.147 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.148 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.149 by simp
81.150 hence "(l * x + (l div c) * Inum (x # bs) e \<noteq> 0) =
81.151 @@ -1541,7 +1541,7 @@
81.152 by (simp add: zdiv_mono1[OF clel cp])
81.153 then have ldcp:"0 < l div c"
81.154 by (simp add: zdiv_self[OF cnz])
81.155 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.156 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.157 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.158 by simp
81.159 hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)" by simp
81.160 @@ -1558,7 +1558,7 @@
81.161 by (simp add: zdiv_mono1[OF clel cp])
81.162 then have ldcp:"0 < l div c"
81.163 by (simp add: zdiv_self[OF cnz])
81.164 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
81.165 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
81.166 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
81.167 by simp
81.168 hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)" by simp
82.1 --- a/src/HOL/Decision_Procs/Ferrack.thy Wed Mar 04 10:43:39 2009 +0100
82.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy Wed Mar 04 10:45:52 2009 +0100
82.3 @@ -501,9 +501,9 @@
82.4 assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
82.5 shows "dvdnumcoeff t g"
82.6 using dgt' gdg
82.7 - by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
82.8 + by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
82.9
82.10 -declare zdvd_trans [trans add]
82.11 +declare dvd_trans [trans add]
82.12
82.13 lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
82.14 by arith
83.1 --- a/src/HOL/Decision_Procs/MIR.thy Wed Mar 04 10:43:39 2009 +0100
83.2 +++ b/src/HOL/Decision_Procs/MIR.thy Wed Mar 04 10:45:52 2009 +0100
83.3 @@ -83,7 +83,7 @@
83.4 have "real (floor x) \<le> x" by simp
83.5 hence "real (floor x) < real (n + 1) " using ub by arith
83.6 hence "floor x < n+1" by simp
83.7 - moreover from lb have "n \<le> floor x" using floor_mono2[where x="real n" and y="x"]
83.8 + moreover from lb have "n \<le> floor x" using floor_mono[where x="real n" and y="x"]
83.9 by simp ultimately show "floor x = n" by simp
83.10 qed
83.11
83.12 @@ -132,13 +132,13 @@
83.13 assume d: "real d rdvd t"
83.14 from d int_rdvd_real have d2: "d dvd (floor t)" and ti: "real (floor t) = t" by auto
83.15
83.16 - from iffD2[OF zdvd_abs1] d2 have "(abs d) dvd (floor t)" by blast
83.17 + from iffD2[OF abs_dvd_iff] d2 have "(abs d) dvd (floor t)" by blast
83.18 with ti int_rdvd_real[symmetric] have "real (abs d) rdvd t" by blast
83.19 thus "abs (real d) rdvd t" by simp
83.20 next
83.21 assume "abs (real d) rdvd t" hence "real (abs d) rdvd t" by simp
83.22 with int_rdvd_real[where i="abs d" and x="t"] have d2: "abs d dvd floor t" and ti: "real (floor t) =t" by auto
83.23 - from iffD1[OF zdvd_abs1] d2 have "d dvd floor t" by blast
83.24 + from iffD1[OF abs_dvd_iff] d2 have "d dvd floor t" by blast
83.25 with ti int_rdvd_real[symmetric] show "real d rdvd t" by blast
83.26 qed
83.27
83.28 @@ -675,9 +675,9 @@
83.29 assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
83.30 shows "dvdnumcoeff t g"
83.31 using dgt' gdg
83.32 - by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
83.33 -
83.34 -declare zdvd_trans [trans add]
83.35 + by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
83.36 +
83.37 +declare dvd_trans [trans add]
83.38
83.39 lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
83.40 by arith
83.41 @@ -1775,11 +1775,11 @@
83.42 "(real (a::int) \<le> b) = (a \<le> floor b \<or> (a = floor b \<and> real (floor b) < b))"
83.43 proof( auto)
83.44 assume alb: "real a \<le> b" and agb: "\<not> a \<le> floor b"
83.45 - from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono2)
83.46 + from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono)
83.47 hence "a \<le> floor b" by simp with agb show "False" by simp
83.48 next
83.49 assume alb: "a \<le> floor b"
83.50 - hence "real a \<le> real (floor b)" by (simp only: floor_mono2)
83.51 + hence "real a \<le> real (floor b)" by (simp only: floor_mono)
83.52 also have "\<dots>\<le> b" by simp finally show "real a \<le> b" .
83.53 qed
83.54
83.55 @@ -2114,10 +2114,10 @@
83.56 using lin ad d
83.57 proof(induct p rule: iszlfm.induct)
83.58 case (9 i c e) thus ?case using d
83.59 - by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
83.60 + by (simp add: dvd_trans[of "i" "d" "d'"])
83.61 next
83.62 case (10 i c e) thus ?case using d
83.63 - by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
83.64 + by (simp add: dvd_trans[of "i" "d" "d'"])
83.65 qed simp_all
83.66
83.67 lemma \<delta> : assumes lin:"iszlfm p bs"
83.68 @@ -2496,7 +2496,7 @@
83.69 and dr: "d\<beta> p l"
83.70 and d: "l dvd l'"
83.71 shows "d\<beta> p l'"
83.72 -using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
83.73 +using dr linp dvd_trans[of _ "l" "l'", simplified d]
83.74 by (induct p rule: iszlfm.induct) simp_all
83.75
83.76 lemma \<alpha>_l: assumes lp: "iszlfm p (a#bs)"
83.77 @@ -2535,7 +2535,7 @@
83.78 by (simp add: zdiv_mono1[OF clel cp])
83.79 then have ldcp:"0 < l div c"
83.80 by (simp add: zdiv_self[OF cnz])
83.81 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.82 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.83 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.84 by simp
83.85 hence "(real l * real x + real (l div c) * Inum (real x # bs) e < (0\<Colon>real)) =
83.86 @@ -2553,7 +2553,7 @@
83.87 by (simp add: zdiv_mono1[OF clel cp])
83.88 then have ldcp:"0 < l div c"
83.89 by (simp add: zdiv_self[OF cnz])
83.90 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.91 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.92 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.93 by simp
83.94 hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<le> (0\<Colon>real)) =
83.95 @@ -2571,7 +2571,7 @@
83.96 by (simp add: zdiv_mono1[OF clel cp])
83.97 then have ldcp:"0 < l div c"
83.98 by (simp add: zdiv_self[OF cnz])
83.99 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.100 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.101 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.102 by simp
83.103 hence "(real l * real x + real (l div c) * Inum (real x # bs) e > (0\<Colon>real)) =
83.104 @@ -2589,7 +2589,7 @@
83.105 by (simp add: zdiv_mono1[OF clel cp])
83.106 then have ldcp:"0 < l div c"
83.107 by (simp add: zdiv_self[OF cnz])
83.108 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.109 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.110 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.111 by simp
83.112 hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<ge> (0\<Colon>real)) =
83.113 @@ -2607,7 +2607,7 @@
83.114 by (simp add: zdiv_mono1[OF clel cp])
83.115 then have ldcp:"0 < l div c"
83.116 by (simp add: zdiv_self[OF cnz])
83.117 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.118 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.119 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.120 by simp
83.121 hence "(real l * real x + real (l div c) * Inum (real x # bs) e = (0\<Colon>real)) =
83.122 @@ -2625,7 +2625,7 @@
83.123 by (simp add: zdiv_mono1[OF clel cp])
83.124 then have ldcp:"0 < l div c"
83.125 by (simp add: zdiv_self[OF cnz])
83.126 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.127 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.128 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.129 by simp
83.130 hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<noteq> (0\<Colon>real)) =
83.131 @@ -2643,7 +2643,7 @@
83.132 by (simp add: zdiv_mono1[OF clel cp])
83.133 then have ldcp:"0 < l div c"
83.134 by (simp add: zdiv_self[OF cnz])
83.135 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.136 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.137 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.138 by simp
83.139 hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)" by simp
83.140 @@ -2660,7 +2660,7 @@
83.141 by (simp add: zdiv_mono1[OF clel cp])
83.142 then have ldcp:"0 < l div c"
83.143 by (simp add: zdiv_self[OF cnz])
83.144 - have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
83.145 + have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
83.146 hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric]
83.147 by simp
83.148 hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)" by simp
83.149 @@ -3697,7 +3697,7 @@
83.150 assumes xb: "real m \<le> x \<and> x < real ((n::int) + 1)"
83.151 shows "\<exists> j\<in> {m.. n}. real j \<le> x \<and> x < real (j+1)" (is "\<exists> j\<in> ?N. ?P j")
83.152 by (rule bexI[where P="?P" and x="floor x" and A="?N"])
83.153 -(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono2[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
83.154 +(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
83.155
83.156 lemma rsplit0_complete:
83.157 assumes xp:"0 \<le> x" and x1:"x < 1"
83.158 @@ -5926,7 +5926,7 @@
83.159 apply mir
83.160 done
83.161
83.162 -lemma "ALL x y. \<lfloor>x\<rfloor> = \<lfloor>y\<rfloor> \<longrightarrow> 0 \<le> abs (y - x) \<and> abs (y - x) \<le> 1"
83.163 +lemma "ALL (x::real) (y::real). \<lfloor>x\<rfloor> = \<lfloor>y\<rfloor> \<longrightarrow> 0 \<le> abs (y - x) \<and> abs (y - x) \<le> 1"
83.164 apply mir
83.165 done
83.166
84.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML Wed Mar 04 10:43:39 2009 +0100
84.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML Wed Mar 04 10:45:52 2009 +0100
84.3 @@ -27,12 +27,9 @@
84.4 val Suc_plus1 = @{thm Suc_plus1};
84.5 val imp_le_cong = @{thm imp_le_cong};
84.6 val conj_le_cong = @{thm conj_le_cong};
84.7 -val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
84.8 -val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
84.9 -val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
84.10 -val int_mod_add_eq = @{thm mod_add_eq} RS sym;
84.11 -val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
84.12 -val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
84.13 +val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
84.14 +val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
84.15 +val mod_add_eq = @{thm mod_add_eq} RS sym;
84.16 val nat_div_add_eq = @{thm div_add1_eq} RS sym;
84.17 val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
84.18
84.19 @@ -70,14 +67,13 @@
84.20 val (t,np,nh) = prepare_for_linz q g
84.21 (* Some simpsets for dealing with mod div abs and nat*)
84.22 val mod_div_simpset = HOL_basic_ss
84.23 - addsimps [refl,nat_mod_add_eq, nat_mod_add_left_eq,
84.24 - nat_mod_add_right_eq, int_mod_add_eq,
84.25 - int_mod_add_right_eq, int_mod_add_left_eq,
84.26 + addsimps [refl,mod_add_eq, mod_add_left_eq,
84.27 + mod_add_right_eq,
84.28 nat_div_add_eq, int_div_add_eq,
84.29 @{thm mod_self}, @{thm "zmod_self"},
84.30 @{thm mod_by_0}, @{thm div_by_0},
84.31 @{thm "zdiv_zero"}, @{thm "zmod_zero"}, @{thm "div_0"}, @{thm "mod_0"},
84.32 - @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
84.33 + @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
84.34 Suc_plus1]
84.35 addsimps @{thms add_ac}
84.36 addsimprocs [cancel_div_mod_proc]
85.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML Wed Mar 04 10:43:39 2009 +0100
85.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML Wed Mar 04 10:45:52 2009 +0100
85.3 @@ -31,12 +31,8 @@
85.4 val Suc_plus1 = @{thm Suc_plus1};
85.5 val imp_le_cong = @{thm imp_le_cong};
85.6 val conj_le_cong = @{thm conj_le_cong};
85.7 -val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
85.8 -val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
85.9 -val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
85.10 -val int_mod_add_eq = @{thm mod_add_eq} RS sym;
85.11 -val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
85.12 -val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
85.13 +val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
85.14 +val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
85.15 val nat_div_add_eq = @{thm div_add1_eq} RS sym;
85.16 val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
85.17 val ZDIVISION_BY_ZERO_MOD = @{thm DIVISION_BY_ZERO} RS conjunct2;
86.1 --- a/src/HOL/Decision_Procs/mir_tac.ML Wed Mar 04 10:43:39 2009 +0100
86.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML Wed Mar 04 10:45:52 2009 +0100
86.3 @@ -46,12 +46,9 @@
86.4 val Suc_plus1 = @{thm "Suc_plus1"};
86.5 val imp_le_cong = @{thm "imp_le_cong"};
86.6 val conj_le_cong = @{thm "conj_le_cong"};
86.7 -val nat_mod_add_eq = @{thm "mod_add1_eq"} RS sym;
86.8 -val nat_mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
86.9 -val nat_mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
86.10 -val int_mod_add_eq = @{thm "mod_add_eq"} RS sym;
86.11 -val int_mod_add_left_eq = @{thm "zmod_zadd_left_eq"} RS sym;
86.12 -val int_mod_add_right_eq = @{thm "zmod_zadd_right_eq"} RS sym;
86.13 +val mod_add_eq = @{thm "mod_add_eq"} RS sym;
86.14 +val mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
86.15 +val mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
86.16 val nat_div_add_eq = @{thm "div_add1_eq"} RS sym;
86.17 val int_div_add_eq = @{thm "zdiv_zadd1_eq"} RS sym;
86.18 val ZDIVISION_BY_ZERO_MOD = @{thm "DIVISION_BY_ZERO"} RS conjunct2;
86.19 @@ -96,10 +93,10 @@
86.20 val (t,np,nh) = prepare_for_mir thy q g
86.21 (* Some simpsets for dealing with mod div abs and nat*)
86.22 val mod_div_simpset = HOL_basic_ss
86.23 - addsimps [refl,nat_mod_add_eq,
86.24 + addsimps [refl, mod_add_eq,
86.25 @{thm "mod_self"}, @{thm "zmod_self"},
86.26 @{thm "zdiv_zero"},@{thm "zmod_zero"},@{thm "div_0"}, @{thm "mod_0"},
86.27 - @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
86.28 + @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
86.29 @{thm "Suc_plus1"}]
86.30 addsimps @{thms add_ac}
86.31 addsimprocs [cancel_div_mod_proc]
87.1 --- a/src/HOL/Deriv.thy Wed Mar 04 10:43:39 2009 +0100
87.2 +++ b/src/HOL/Deriv.thy Wed Mar 04 10:45:52 2009 +0100
87.3 @@ -9,7 +9,7 @@
87.4 header{* Differentiation *}
87.5
87.6 theory Deriv
87.7 -imports Lim Polynomial
87.8 +imports Lim
87.9 begin
87.10
87.11 text{*Standard Definitions*}
87.12 @@ -217,9 +217,7 @@
87.13 by (cases "n", simp, simp add: DERIV_power_Suc f)
87.14
87.15
87.16 -(* ------------------------------------------------------------------------ *)
87.17 -(* Caratheodory formulation of derivative at a point: standard proof *)
87.18 -(* ------------------------------------------------------------------------ *)
87.19 +text {* Caratheodory formulation of derivative at a point *}
87.20
87.21 lemma CARAT_DERIV:
87.22 "(DERIV f x :> l) =
87.23 @@ -307,6 +305,9 @@
87.24 ==> DERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / (g(x) ^ Suc (Suc 0))"
87.25 by (drule (2) DERIV_divide) (simp add: mult_commute power_Suc)
87.26
87.27 +lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
87.28 +by auto
87.29 +
87.30
87.31 subsection {* Differentiability predicate *}
87.32
87.33 @@ -655,6 +656,9 @@
87.34 apply (blast intro: IVT2)
87.35 done
87.36
87.37 +
87.38 +subsection {* Boundedness of continuous functions *}
87.39 +
87.40 text{*By bisection, function continuous on closed interval is bounded above*}
87.41
87.42 lemma isCont_bounded:
87.43 @@ -773,6 +777,8 @@
87.44 done
87.45
87.46
87.47 +subsection {* Local extrema *}
87.48 +
87.49 text{*If @{term "0 < f'(x)"} then @{term x} is Locally Strictly Increasing At The Right*}
87.50
87.51 lemma DERIV_left_inc:
87.52 @@ -877,6 +883,9 @@
87.53 shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) = f(y) |] ==> l = 0"
87.54 by (auto dest!: DERIV_local_max)
87.55
87.56 +
87.57 +subsection {* Rolle's Theorem *}
87.58 +
87.59 text{*Lemma about introducing open ball in open interval*}
87.60 lemma lemma_interval_lt:
87.61 "[| a < x; x < b |]
87.62 @@ -1163,6 +1172,8 @@
87.63 qed
87.64
87.65
87.66 +subsection {* Continuous injective functions *}
87.67 +
87.68 text{*Dull lemma: an continuous injection on an interval must have a
87.69 strict maximum at an end point, not in the middle.*}
87.70
87.71 @@ -1356,6 +1367,9 @@
87.72 using neq by (rule LIM_inverse)
87.73 qed
87.74
87.75 +
87.76 +subsection {* Generalized Mean Value Theorem *}
87.77 +
87.78 theorem GMVT:
87.79 fixes a b :: real
87.80 assumes alb: "a < b"
87.81 @@ -1442,245 +1456,6 @@
87.82 with g'cdef f'cdef cint show ?thesis by auto
87.83 qed
87.84
87.85 -lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
87.86 -by auto
87.87 -
87.88 -
87.89 -subsection {* Derivatives of univariate polynomials *}
87.90 -
87.91 -definition
87.92 - pderiv :: "'a::real_normed_field poly \<Rightarrow> 'a poly" where
87.93 - "pderiv = poly_rec 0 (\<lambda>a p p'. p + pCons 0 p')"
87.94 -
87.95 -lemma pderiv_0 [simp]: "pderiv 0 = 0"
87.96 - unfolding pderiv_def by (simp add: poly_rec_0)
87.97 -
87.98 -lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
87.99 - unfolding pderiv_def by (simp add: poly_rec_pCons)
87.100 -
87.101 -lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
87.102 - apply (induct p arbitrary: n, simp)
87.103 - apply (simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
87.104 - done
87.105 -
87.106 -lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
87.107 - apply (rule iffI)
87.108 - apply (cases p, simp)
87.109 - apply (simp add: expand_poly_eq coeff_pderiv del: of_nat_Suc)
87.110 - apply (simp add: expand_poly_eq coeff_pderiv coeff_eq_0)
87.111 - done
87.112 -
87.113 -lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
87.114 - apply (rule order_antisym [OF degree_le])
87.115 - apply (simp add: coeff_pderiv coeff_eq_0)
87.116 - apply (cases "degree p", simp)
87.117 - apply (rule le_degree)
87.118 - apply (simp add: coeff_pderiv del: of_nat_Suc)
87.119 - apply (rule subst, assumption)
87.120 - apply (rule leading_coeff_neq_0, clarsimp)
87.121 - done
87.122 -
87.123 -lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
87.124 -by (simp add: pderiv_pCons)
87.125 -
87.126 -lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
87.127 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
87.128 -
87.129 -lemma pderiv_minus: "pderiv (- p) = - pderiv p"
87.130 -by (rule poly_ext, simp add: coeff_pderiv)
87.131 -
87.132 -lemma pderiv_diff: "pderiv (p - q) = pderiv p - pderiv q"
87.133 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
87.134 -
87.135 -lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
87.136 -by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
87.137 -
87.138 -lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
87.139 -apply (induct p)
87.140 -apply simp
87.141 -apply (simp add: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
87.142 -done
87.143 -
87.144 -lemma pderiv_power_Suc:
87.145 - "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
87.146 -apply (induct n)
87.147 -apply simp
87.148 -apply (subst power_Suc)
87.149 -apply (subst pderiv_mult)
87.150 -apply (erule ssubst)
87.151 -apply (simp add: smult_add_left algebra_simps)
87.152 -done
87.153 -
87.154 -lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
87.155 -by (simp add: DERIV_cmult mult_commute [of _ c])
87.156 -
87.157 -lemma DERIV_pow2: "DERIV (%x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
87.158 -by (rule lemma_DERIV_subst, rule DERIV_pow, simp)
87.159 -declare DERIV_pow2 [simp] DERIV_pow [simp]
87.160 -
87.161 -lemma DERIV_add_const: "DERIV f x :> D ==> DERIV (%x. a + f x :: 'a::real_normed_field) x :> D"
87.162 -by (rule lemma_DERIV_subst, rule DERIV_add, auto)
87.163 -
87.164 -lemma poly_DERIV[simp]: "DERIV (%x. poly p x) x :> poly (pderiv p) x"
87.165 -apply (induct p)
87.166 -apply simp
87.167 -apply (simp add: pderiv_pCons)
87.168 -apply (rule lemma_DERIV_subst)
87.169 -apply (rule DERIV_add DERIV_mult DERIV_const DERIV_ident | assumption)+
87.170 -apply simp
87.171 -done
87.172 -
87.173 -text{* Consequences of the derivative theorem above*}
87.174 -
87.175 -lemma poly_differentiable[simp]: "(%x. poly p x) differentiable (x::real)"
87.176 -apply (simp add: differentiable_def)
87.177 -apply (blast intro: poly_DERIV)
87.178 -done
87.179 -
87.180 -lemma poly_isCont[simp]: "isCont (%x. poly p x) (x::real)"
87.181 -by (rule poly_DERIV [THEN DERIV_isCont])
87.182 -
87.183 -lemma poly_IVT_pos: "[| a < b; poly p (a::real) < 0; 0 < poly p b |]
87.184 - ==> \<exists>x. a < x & x < b & (poly p x = 0)"
87.185 -apply (cut_tac f = "%x. poly p x" and a = a and b = b and y = 0 in IVT_objl)
87.186 -apply (auto simp add: order_le_less)
87.187 -done
87.188 -
87.189 -lemma poly_IVT_neg: "[| (a::real) < b; 0 < poly p a; poly p b < 0 |]
87.190 - ==> \<exists>x. a < x & x < b & (poly p x = 0)"
87.191 -by (insert poly_IVT_pos [where p = "- p" ]) simp
87.192 -
87.193 -lemma poly_MVT: "(a::real) < b ==>
87.194 - \<exists>x. a < x & x < b & (poly p b - poly p a = (b - a) * poly (pderiv p) x)"
87.195 -apply (drule_tac f = "poly p" in MVT, auto)
87.196 -apply (rule_tac x = z in exI)
87.197 -apply (auto simp add: real_mult_left_cancel poly_DERIV [THEN DERIV_unique])
87.198 -done
87.199 -
87.200 -text{*Lemmas for Derivatives*}
87.201 -
87.202 -(* FIXME
87.203 -lemma lemma_order_pderiv [rule_format]:
87.204 - "\<forall>p q a. 0 < n &
87.205 - poly (pderiv p) \<noteq> poly [] &
87.206 - poly p = poly ([- a, 1] %^ n *** q) & ~ [- a, 1] divides q
87.207 - --> n = Suc (order a (pderiv p))"
87.208 -apply (induct "n", safe)
87.209 -apply (rule order_unique_lemma, rule conjI, assumption)
87.210 -apply (subgoal_tac "\<forall>r. r divides (pderiv p) = r divides (pderiv ([-a, 1] %^ Suc n *** q))")
87.211 -apply (drule_tac [2] poly_pderiv_welldef)
87.212 - prefer 2 apply (simp add: divides_def del: pmult_Cons pexp_Suc)
87.213 -apply (simp del: pmult_Cons pexp_Suc)
87.214 -apply (rule conjI)
87.215 -apply (simp add: divides_def fun_eq del: pmult_Cons pexp_Suc)
87.216 -apply (rule_tac x = "[-a, 1] *** (pderiv q) +++ real (Suc n) %* q" in exI)
87.217 -apply (simp add: poly_pderiv_mult poly_pderiv_exp_prime poly_add poly_mult poly_cmult right_distrib mult_ac del: pmult_Cons pexp_Suc)
87.218 -apply (simp add: poly_mult right_distrib left_distrib mult_ac del: pmult_Cons)
87.219 -apply (erule_tac V = "\<forall>r. r divides pderiv p = r divides pderiv ([- a, 1] %^ Suc n *** q)" in thin_rl)
87.220 -apply (unfold divides_def)
87.221 -apply (simp (no_asm) add: poly_pderiv_mult poly_pderiv_exp_prime fun_eq poly_add poly_mult del: pmult_Cons pexp_Suc)
87.222 -apply (rule contrapos_np, assumption)
87.223 -apply (rotate_tac 3, erule contrapos_np)
87.224 -apply (simp del: pmult_Cons pexp_Suc, safe)
87.225 -apply (rule_tac x = "inverse (real (Suc n)) %* (qa +++ -- (pderiv q))" in exI)
87.226 -apply (subgoal_tac "poly ([-a, 1] %^ n *** q) = poly ([-a, 1] %^ n *** ([-a, 1] *** (inverse (real (Suc n)) %* (qa +++ -- (pderiv q))))) ")
87.227 -apply (drule poly_mult_left_cancel [THEN iffD1], simp)
87.228 -apply (simp add: fun_eq poly_mult poly_add poly_cmult poly_minus del: pmult_Cons mult_cancel_left, safe)
87.229 -apply (rule_tac c1 = "real (Suc n)" in real_mult_left_cancel [THEN iffD1])
87.230 -apply (simp (no_asm))
87.231 -apply (subgoal_tac "real (Suc n) * (poly ([- a, 1] %^ n) xa * poly q xa) =
87.232 - (poly qa xa + - poly (pderiv q) xa) *
87.233 - (poly ([- a, 1] %^ n) xa *
87.234 - ((- a + xa) * (inverse (real (Suc n)) * real (Suc n))))")
87.235 -apply (simp only: mult_ac)
87.236 -apply (rotate_tac 2)
87.237 -apply (drule_tac x = xa in spec)
87.238 -apply (simp add: left_distrib mult_ac del: pmult_Cons)
87.239 -done
87.240 -
87.241 -lemma order_pderiv: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
87.242 - ==> (order a p = Suc (order a (pderiv p)))"
87.243 -apply (case_tac "poly p = poly []")
87.244 -apply (auto dest: pderiv_zero)
87.245 -apply (drule_tac a = a and p = p in order_decomp)
87.246 -using neq0_conv
87.247 -apply (blast intro: lemma_order_pderiv)
87.248 -done
87.249 -
87.250 -text{*Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *}
87.251 -
87.252 -lemma poly_squarefree_decomp_order: "[| poly (pderiv p) \<noteq> poly [];
87.253 - poly p = poly (q *** d);
87.254 - poly (pderiv p) = poly (e *** d);
87.255 - poly d = poly (r *** p +++ s *** pderiv p)
87.256 - |] ==> order a q = (if order a p = 0 then 0 else 1)"
87.257 -apply (subgoal_tac "order a p = order a q + order a d")
87.258 -apply (rule_tac [2] s = "order a (q *** d)" in trans)
87.259 -prefer 2 apply (blast intro: order_poly)
87.260 -apply (rule_tac [2] order_mult)
87.261 - prefer 2 apply force
87.262 -apply (case_tac "order a p = 0", simp)
87.263 -apply (subgoal_tac "order a (pderiv p) = order a e + order a d")
87.264 -apply (rule_tac [2] s = "order a (e *** d)" in trans)
87.265 -prefer 2 apply (blast intro: order_poly)
87.266 -apply (rule_tac [2] order_mult)
87.267 - prefer 2 apply force
87.268 -apply (case_tac "poly p = poly []")
87.269 -apply (drule_tac p = p in pderiv_zero, simp)
87.270 -apply (drule order_pderiv, assumption)
87.271 -apply (subgoal_tac "order a (pderiv p) \<le> order a d")
87.272 -apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides d")
87.273 - prefer 2 apply (simp add: poly_entire order_divides)
87.274 -apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides p & ([-a, 1] %^ (order a (pderiv p))) divides (pderiv p) ")
87.275 - prefer 3 apply (simp add: order_divides)
87.276 - prefer 2 apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe)
87.277 -apply (rule_tac x = "r *** qa +++ s *** qaa" in exI)
87.278 -apply (simp add: fun_eq poly_add poly_mult left_distrib right_distrib mult_ac del: pexp_Suc pmult_Cons, auto)
87.279 -done
87.280 -
87.281 -
87.282 -lemma poly_squarefree_decomp_order2: "[| poly (pderiv p) \<noteq> poly [];
87.283 - poly p = poly (q *** d);
87.284 - poly (pderiv p) = poly (e *** d);
87.285 - poly d = poly (r *** p +++ s *** pderiv p)
87.286 - |] ==> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
87.287 -apply (blast intro: poly_squarefree_decomp_order)
87.288 -done
87.289 -
87.290 -lemma order_pderiv2: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
87.291 - ==> (order a (pderiv p) = n) = (order a p = Suc n)"
87.292 -apply (auto dest: order_pderiv)
87.293 -done
87.294 -
87.295 -lemma rsquarefree_roots:
87.296 - "rsquarefree p = (\<forall>a. ~(poly p a = 0 & poly (pderiv p) a = 0))"
87.297 -apply (simp add: rsquarefree_def)
87.298 -apply (case_tac "poly p = poly []", simp, simp)
87.299 -apply (case_tac "poly (pderiv p) = poly []")
87.300 -apply simp
87.301 -apply (drule pderiv_iszero, clarify)
87.302 -apply (subgoal_tac "\<forall>a. order a p = order a [h]")
87.303 -apply (simp add: fun_eq)
87.304 -apply (rule allI)
87.305 -apply (cut_tac p = "[h]" and a = a in order_root)
87.306 -apply (simp add: fun_eq)
87.307 -apply (blast intro: order_poly)
87.308 -apply (auto simp add: order_root order_pderiv2)
87.309 -apply (erule_tac x="a" in allE, simp)
87.310 -done
87.311 -
87.312 -lemma poly_squarefree_decomp: "[| poly (pderiv p) \<noteq> poly [];
87.313 - poly p = poly (q *** d);
87.314 - poly (pderiv p) = poly (e *** d);
87.315 - poly d = poly (r *** p +++ s *** pderiv p)
87.316 - |] ==> rsquarefree q & (\<forall>a. (poly q a = 0) = (poly p a = 0))"
87.317 -apply (frule poly_squarefree_decomp_order2, assumption+)
87.318 -apply (case_tac "poly p = poly []")
87.319 -apply (blast dest: pderiv_zero)
87.320 -apply (simp (no_asm) add: rsquarefree_def order_root del: pmult_Cons)
87.321 -apply (simp add: poly_entire del: pmult_Cons)
87.322 -done
87.323 -*)
87.324
87.325 subsection {* Theorems about Limits *}
87.326
88.1 --- a/src/HOL/Divides.thy Wed Mar 04 10:43:39 2009 +0100
88.2 +++ b/src/HOL/Divides.thy Wed Mar 04 10:45:52 2009 +0100
88.3 @@ -44,10 +44,10 @@
88.4 by (simp add: mod_div_equality2)
88.5
88.6 lemma mod_by_0 [simp]: "a mod 0 = a"
88.7 - using mod_div_equality [of a zero] by simp
88.8 +using mod_div_equality [of a zero] by simp
88.9
88.10 lemma mod_0 [simp]: "0 mod a = 0"
88.11 - using mod_div_equality [of zero a] div_0 by simp
88.12 +using mod_div_equality [of zero a] div_0 by simp
88.13
88.14 lemma div_mult_self2 [simp]:
88.15 assumes "b \<noteq> 0"
88.16 @@ -178,6 +178,12 @@
88.17 lemma dvd_div_mult_self: "a dvd b \<Longrightarrow> (b div a) * a = b"
88.18 by (subst (2) mod_div_equality [of b a, symmetric]) (simp add:dvd_imp_mod_0)
88.19
88.20 +lemma dvd_div_mult: "a dvd b \<Longrightarrow> (b div a) * c = b * c div a"
88.21 +apply (cases "a = 0")
88.22 + apply simp
88.23 +apply (auto simp: dvd_def mult_assoc)
88.24 +done
88.25 +
88.26 lemma div_dvd_div[simp]:
88.27 "a dvd b \<Longrightarrow> a dvd c \<Longrightarrow> (b div a dvd c div a) = (b dvd c)"
88.28 apply (cases "a = 0")
88.29 @@ -188,6 +194,12 @@
88.30 apply(fastsimp simp add: mult_assoc)
88.31 done
88.32
88.33 +lemma dvd_mod_imp_dvd: "[| k dvd m mod n; k dvd n |] ==> k dvd m"
88.34 + apply (subgoal_tac "k dvd (m div n) *n + m mod n")
88.35 + apply (simp add: mod_div_equality)
88.36 + apply (simp only: dvd_add dvd_mult)
88.37 + done
88.38 +
88.39 text {* Addition respects modular equivalence. *}
88.40
88.41 lemma mod_add_left_eq: "(a + b) mod c = (a mod c + b) mod c"
88.42 @@ -330,6 +342,25 @@
88.43 unfolding diff_minus using assms
88.44 by (intro mod_add_cong mod_minus_cong)
88.45
88.46 +lemma dvd_neg_div: "y dvd x \<Longrightarrow> -x div y = - (x div y)"
88.47 +apply (case_tac "y = 0") apply simp
88.48 +apply (auto simp add: dvd_def)
88.49 +apply (subgoal_tac "-(y * k) = y * - k")
88.50 + apply (erule ssubst)
88.51 + apply (erule div_mult_self1_is_id)
88.52 +apply simp
88.53 +done
88.54 +
88.55 +lemma dvd_div_neg: "y dvd x \<Longrightarrow> x div -y = - (x div y)"
88.56 +apply (case_tac "y = 0") apply simp
88.57 +apply (auto simp add: dvd_def)
88.58 +apply (subgoal_tac "y * k = -y * -k")
88.59 + apply (erule ssubst)
88.60 + apply (rule div_mult_self1_is_id)
88.61 + apply simp
88.62 +apply simp
88.63 +done
88.64 +
88.65 end
88.66
88.67
88.68 @@ -478,9 +509,9 @@
88.69 from divmod_rel have divmod_m_n: "divmod_rel m n (m div n) (m mod n)" .
88.70 with assms have m_div_n: "m div n \<ge> 1"
88.71 by (cases "m div n") (auto simp add: divmod_rel_def)
88.72 - from assms divmod_m_n have "divmod_rel (m - n) n (m div n - 1) (m mod n)"
88.73 + from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0) (m mod n)"
88.74 by (cases "m div n") (auto simp add: divmod_rel_def)
88.75 - with divmod_eq have "divmod (m - n) n = (m div n - 1, m mod n)" by simp
88.76 + with divmod_eq have "divmod (m - n) n = (m div n - Suc 0, m mod n)" by simp
88.77 moreover from divmod_div_mod have "divmod (m - n) n = ((m - n) div n, (m - n) mod n)" .
88.78 ultimately have "m div n = Suc ((m - n) div n)"
88.79 and "m mod n = (m - n) mod n" using m_div_n by simp_all
88.80 @@ -653,16 +684,6 @@
88.81 apply (blast intro: divmod_rel [THEN divmod_rel_mult1_eq, THEN div_eq])
88.82 done
88.83
88.84 -lemma mod_mult1_eq: "(a*b) mod c = a*(b mod c) mod (c::nat)"
88.85 -by (rule mod_mult_right_eq)
88.86 -
88.87 -lemma mod_mult1_eq': "(a*b) mod (c::nat) = ((a mod c) * b) mod c"
88.88 -by (rule mod_mult_left_eq)
88.89 -
88.90 -lemma mod_mult_distrib_mod:
88.91 - "(a*b) mod (c::nat) = ((a mod c) * (b mod c)) mod c"
88.92 -by (rule mod_mult_eq)
88.93 -
88.94 lemma divmod_rel_add1_eq:
88.95 "[| divmod_rel a c aq ar; divmod_rel b c bq br; c > 0 |]
88.96 ==> divmod_rel (a + b) c (aq + bq + (ar+br) div c) ((ar + br) mod c)"
88.97 @@ -675,9 +696,6 @@
88.98 apply (blast intro: divmod_rel_add1_eq [THEN div_eq] divmod_rel)
88.99 done
88.100
88.101 -lemma mod_add1_eq: "(a+b) mod (c::nat) = (a mod c + b mod c) mod c"
88.102 -by (rule mod_add_eq)
88.103 -
88.104 lemma mod_lemma: "[| (0::nat) < c; r < b |] ==> b * (q mod c) + r < b * c"
88.105 apply (cut_tac m = q and n = c in mod_less_divisor)
88.106 apply (drule_tac [2] m = "q mod c" in less_imp_Suc_add, auto)
88.107 @@ -795,12 +813,6 @@
88.108 apply (auto simp add: Suc_diff_le le_mod_geq)
88.109 done
88.110
88.111 -lemma nat_mod_div_trivial: "m mod n div n = (0 :: nat)"
88.112 -by simp
88.113 -
88.114 -lemma nat_mod_mod_trivial: "m mod n mod n = (m mod n :: nat)"
88.115 -by simp
88.116 -
88.117
88.118 subsubsection {* The Divides Relation *}
88.119
88.120 @@ -810,6 +822,9 @@
88.121 lemma dvd_1_iff_1 [simp]: "(m dvd Suc 0) = (m = Suc 0)"
88.122 by (simp add: dvd_def)
88.123
88.124 +lemma nat_dvd_1_iff_1 [simp]: "m dvd (1::nat) \<longleftrightarrow> m = 1"
88.125 +by (simp add: dvd_def)
88.126 +
88.127 lemma dvd_anti_sym: "[| m dvd n; n dvd m |] ==> m = (n::nat)"
88.128 unfolding dvd_def
88.129 by (force dest: mult_eq_self_implies_10 simp add: mult_assoc mult_eq_1_iff)
88.130 @@ -819,9 +834,9 @@
88.131 interpretation dvd!: order "op dvd" "\<lambda>n m \<Colon> nat. n dvd m \<and> \<not> m dvd n"
88.132 proof qed (auto intro: dvd_refl dvd_trans dvd_anti_sym)
88.133
88.134 -lemma dvd_diff: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
88.135 - unfolding dvd_def
88.136 - by (blast intro: diff_mult_distrib2 [symmetric])
88.137 +lemma nat_dvd_diff[simp]: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
88.138 +unfolding dvd_def
88.139 +by (blast intro: diff_mult_distrib2 [symmetric])
88.140
88.141 lemma dvd_diffD: "[| k dvd m-n; k dvd n; n\<le>m |] ==> k dvd (m::nat)"
88.142 apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
88.143 @@ -829,7 +844,7 @@
88.144 done
88.145
88.146 lemma dvd_diffD1: "[| k dvd m-n; k dvd m; n\<le>m |] ==> k dvd (n::nat)"
88.147 -by (drule_tac m = m in dvd_diff, auto)
88.148 +by (drule_tac m = m in nat_dvd_diff, auto)
88.149
88.150 lemma dvd_reduce: "(k dvd n + k) = (k dvd (n::nat))"
88.151 apply (rule iffI)
88.152 @@ -838,7 +853,7 @@
88.153 apply (subgoal_tac "n = (n+k) -k")
88.154 prefer 2 apply simp
88.155 apply (erule ssubst)
88.156 - apply (erule dvd_diff)
88.157 + apply (erule nat_dvd_diff)
88.158 apply (rule dvd_refl)
88.159 done
88.160
88.161 @@ -848,12 +863,6 @@
88.162 apply (blast intro: mod_mult_distrib2 [symmetric])
88.163 done
88.164
88.165 -lemma dvd_mod_imp_dvd: "[| (k::nat) dvd m mod n; k dvd n |] ==> k dvd m"
88.166 - apply (subgoal_tac "k dvd (m div n) *n + m mod n")
88.167 - apply (simp add: mod_div_equality)
88.168 - apply (simp only: dvd_add dvd_mult)
88.169 - done
88.170 -
88.171 lemma dvd_mod_iff: "k dvd n ==> ((k::nat) dvd m mod n) = (k dvd m)"
88.172 by (blast intro: dvd_mod_imp_dvd dvd_mod)
88.173
88.174 @@ -889,21 +898,9 @@
88.175 apply (simp only: dvd_eq_mod_eq_0)
88.176 done
88.177
88.178 -lemma le_imp_power_dvd: "!!i::nat. m \<le> n ==> i^m dvd i^n"
88.179 - apply (unfold dvd_def)
88.180 - apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
88.181 - apply (simp add: power_add)
88.182 - done
88.183 -
88.184 lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
88.185 by (induct n) auto
88.186
88.187 -lemma power_le_dvd [rule_format]: "k^j dvd n --> i\<le>j --> k^i dvd (n::nat)"
88.188 - apply (induct j)
88.189 - apply (simp_all add: le_Suc_eq)
88.190 - apply (blast dest!: dvd_mult_right)
88.191 - done
88.192 -
88.193 lemma power_dvd_imp_le: "[|i^m dvd i^n; (1::nat) < i|] ==> m \<le> n"
88.194 apply (rule power_le_imp_le_exp, assumption)
88.195 apply (erule dvd_imp_le, simp)
89.1 --- a/src/HOL/Equiv_Relations.thy Wed Mar 04 10:43:39 2009 +0100
89.2 +++ b/src/HOL/Equiv_Relations.thy Wed Mar 04 10:45:52 2009 +0100
89.3 @@ -12,7 +12,7 @@
89.4
89.5 locale equiv =
89.6 fixes A and r
89.7 - assumes refl: "refl A r"
89.8 + assumes refl_on: "refl_on A r"
89.9 and sym: "sym r"
89.10 and trans: "trans r"
89.11
89.12 @@ -27,21 +27,21 @@
89.13 "sym r ==> trans r ==> r\<inverse> O r \<subseteq> r"
89.14 by (unfold trans_def sym_def converse_def) blast
89.15
89.16 -lemma refl_comp_subset: "refl A r ==> r \<subseteq> r\<inverse> O r"
89.17 - by (unfold refl_def) blast
89.18 +lemma refl_on_comp_subset: "refl_on A r ==> r \<subseteq> r\<inverse> O r"
89.19 + by (unfold refl_on_def) blast
89.20
89.21 lemma equiv_comp_eq: "equiv A r ==> r\<inverse> O r = r"
89.22 apply (unfold equiv_def)
89.23 apply clarify
89.24 apply (rule equalityI)
89.25 - apply (iprover intro: sym_trans_comp_subset refl_comp_subset)+
89.26 + apply (iprover intro: sym_trans_comp_subset refl_on_comp_subset)+
89.27 done
89.28
89.29 text {* Second half. *}
89.30
89.31 lemma comp_equivI:
89.32 "r\<inverse> O r = r ==> Domain r = A ==> equiv A r"
89.33 - apply (unfold equiv_def refl_def sym_def trans_def)
89.34 + apply (unfold equiv_def refl_on_def sym_def trans_def)
89.35 apply (erule equalityE)
89.36 apply (subgoal_tac "\<forall>x y. (x, y) \<in> r --> (y, x) \<in> r")
89.37 apply fast
89.38 @@ -63,12 +63,12 @@
89.39 done
89.40
89.41 lemma equiv_class_self: "equiv A r ==> a \<in> A ==> a \<in> r``{a}"
89.42 - by (unfold equiv_def refl_def) blast
89.43 + by (unfold equiv_def refl_on_def) blast
89.44
89.45 lemma subset_equiv_class:
89.46 "equiv A r ==> r``{b} \<subseteq> r``{a} ==> b \<in> A ==> (a,b) \<in> r"
89.47 -- {* lemma for the next result *}
89.48 - by (unfold equiv_def refl_def) blast
89.49 + by (unfold equiv_def refl_on_def) blast
89.50
89.51 lemma eq_equiv_class:
89.52 "r``{a} = r``{b} ==> equiv A r ==> b \<in> A ==> (a, b) \<in> r"
89.53 @@ -79,7 +79,7 @@
89.54 by (unfold equiv_def trans_def sym_def) blast
89.55
89.56 lemma equiv_type: "equiv A r ==> r \<subseteq> A \<times> A"
89.57 - by (unfold equiv_def refl_def) blast
89.58 + by (unfold equiv_def refl_on_def) blast
89.59
89.60 theorem equiv_class_eq_iff:
89.61 "equiv A r ==> ((x, y) \<in> r) = (r``{x} = r``{y} & x \<in> A & y \<in> A)"
89.62 @@ -103,7 +103,7 @@
89.63 by (unfold quotient_def) blast
89.64
89.65 lemma Union_quotient: "equiv A r ==> Union (A//r) = A"
89.66 - by (unfold equiv_def refl_def quotient_def) blast
89.67 + by (unfold equiv_def refl_on_def quotient_def) blast
89.68
89.69 lemma quotient_disj:
89.70 "equiv A r ==> X \<in> A//r ==> Y \<in> A//r ==> X = Y | (X \<inter> Y = {})"
89.71 @@ -228,7 +228,7 @@
89.72
89.73 lemma congruent2_implies_congruent:
89.74 "equiv A r1 ==> congruent2 r1 r2 f ==> a \<in> A ==> congruent r2 (f a)"
89.75 - by (unfold congruent_def congruent2_def equiv_def refl_def) blast
89.76 + by (unfold congruent_def congruent2_def equiv_def refl_on_def) blast
89.77
89.78 lemma congruent2_implies_congruent_UN:
89.79 "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a \<in> A2 ==>
89.80 @@ -237,7 +237,7 @@
89.81 apply clarify
89.82 apply (rule equiv_type [THEN subsetD, THEN SigmaE2], assumption+)
89.83 apply (simp add: UN_equiv_class congruent2_implies_congruent)
89.84 - apply (unfold congruent2_def equiv_def refl_def)
89.85 + apply (unfold congruent2_def equiv_def refl_on_def)
89.86 apply (blast del: equalityI)
89.87 done
89.88
89.89 @@ -272,7 +272,7 @@
89.90 ==> congruent2 r1 r2 f"
89.91 -- {* Suggested by John Harrison -- the two subproofs may be *}
89.92 -- {* \emph{much} simpler than the direct proof. *}
89.93 - apply (unfold congruent2_def equiv_def refl_def)
89.94 + apply (unfold congruent2_def equiv_def refl_on_def)
89.95 apply clarify
89.96 apply (blast intro: trans)
89.97 done
90.1 --- a/src/HOL/Extraction/Euclid.thy Wed Mar 04 10:43:39 2009 +0100
90.2 +++ b/src/HOL/Extraction/Euclid.thy Wed Mar 04 10:45:52 2009 +0100
90.3 @@ -189,7 +189,7 @@
90.4 assume pn: "p \<le> n"
90.5 from `prime p` have "0 < p" by (rule prime_g_zero)
90.6 then have "p dvd n!" using pn by (rule dvd_factorial)
90.7 - with dvd have "p dvd ?k - n!" by (rule dvd_diff)
90.8 + with dvd have "p dvd ?k - n!" by (rule nat_dvd_diff)
90.9 then have "p dvd 1" by simp
90.10 with prime show False using prime_nd_one by auto
90.11 qed
91.1 --- a/src/HOL/Fact.thy Wed Mar 04 10:43:39 2009 +0100
91.2 +++ b/src/HOL/Fact.thy Wed Mar 04 10:45:52 2009 +0100
91.3 @@ -7,7 +7,7 @@
91.4 header{*Factorial Function*}
91.5
91.6 theory Fact
91.7 -imports Nat
91.8 +imports Main
91.9 begin
91.10
91.11 consts fact :: "nat => nat"
91.12 @@ -58,7 +58,7 @@
91.13 "n < Suc m ==> fact (Suc m - n) = (Suc m - n) * fact (m - n)"
91.14 apply (induct n arbitrary: m)
91.15 apply auto
91.16 -apply (drule_tac x = "m - 1" in meta_spec, auto)
91.17 +apply (drule_tac x = "m - Suc 0" in meta_spec, auto)
91.18 done
91.19
91.20 lemma fact_num0: "fact 0 = 1"
92.1 --- a/src/HOL/GCD.thy Wed Mar 04 10:43:39 2009 +0100
92.2 +++ b/src/HOL/GCD.thy Wed Mar 04 10:45:52 2009 +0100
92.3 @@ -60,9 +60,12 @@
92.4 lemma gcd_non_0: "n > 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
92.5 by simp
92.6
92.7 -lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = 1"
92.8 +lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = Suc 0"
92.9 by simp
92.10
92.11 +lemma nat_gcd_1_right [simp, algebra]: "gcd m 1 = 1"
92.12 + unfolding One_nat_def by (rule gcd_1)
92.13 +
92.14 declare gcd.simps [simp del]
92.15
92.16 text {*
92.17 @@ -116,9 +119,12 @@
92.18 apply (blast intro: dvd_trans)
92.19 done
92.20
92.21 -lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = 1"
92.22 +lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = Suc 0"
92.23 by (simp add: gcd_commute)
92.24
92.25 +lemma nat_gcd_1_left [simp, algebra]: "gcd 1 m = 1"
92.26 + unfolding One_nat_def by (rule gcd_1_left)
92.27 +
92.28 text {*
92.29 \medskip Multiplication laws
92.30 *}
92.31 @@ -156,7 +162,6 @@
92.32 apply (simp add: gcd_assoc)
92.33 apply (simp add: gcd_commute)
92.34 apply (simp_all add: mult_commute)
92.35 - apply (blast intro: dvd_mult)
92.36 done
92.37
92.38
92.39 @@ -404,7 +409,7 @@
92.40 {fix x y assume H: "a * x - b * y = d \<or> b * x - a * y = d"
92.41 have dv: "?g dvd a*x" "?g dvd b * y" "?g dvd b*x" "?g dvd a * y"
92.42 using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
92.43 - from dvd_diff[OF dv(1,2)] dvd_diff[OF dv(3,4)] H
92.44 + from nat_dvd_diff[OF dv(1,2)] nat_dvd_diff[OF dv(3,4)] H
92.45 have ?rhs by auto}
92.46 ultimately show ?thesis by blast
92.47 qed
92.48 @@ -597,8 +602,8 @@
92.49 from h' have "int (nat \<bar>k\<bar>) = int (nat \<bar>i\<bar> * h')" by simp
92.50 then have "\<bar>k\<bar> = \<bar>i\<bar> * int h'" by (simp add: int_mult)
92.51 then show ?thesis
92.52 - apply (subst zdvd_abs1 [symmetric])
92.53 - apply (subst zdvd_abs2 [symmetric])
92.54 + apply (subst abs_dvd_iff [symmetric])
92.55 + apply (subst dvd_abs_iff [symmetric])
92.56 apply (unfold dvd_def)
92.57 apply (rule_tac x = "int h'" in exI, simp)
92.58 done
92.59 @@ -614,11 +619,11 @@
92.60 let ?m' = "nat \<bar>m\<bar>"
92.61 let ?n' = "nat \<bar>n\<bar>"
92.62 from `k dvd m` and `k dvd n` have dvd': "?k' dvd ?m'" "?k' dvd ?n'"
92.63 - unfolding zdvd_int by (simp_all only: int_nat_abs zdvd_abs1 zdvd_abs2)
92.64 + unfolding zdvd_int by (simp_all only: int_nat_abs abs_dvd_iff dvd_abs_iff)
92.65 from gcd_greatest [OF dvd'] have "int (nat \<bar>k\<bar>) dvd zgcd m n"
92.66 unfolding zgcd_def by (simp only: zdvd_int)
92.67 then have "\<bar>k\<bar> dvd zgcd m n" by (simp only: int_nat_abs)
92.68 - then show "k dvd zgcd m n" by (simp add: zdvd_abs1)
92.69 + then show "k dvd zgcd m n" by simp
92.70 qed
92.71
92.72 lemma div_zgcd_relprime:
92.73 @@ -721,7 +726,7 @@
92.74 assumes "k dvd i" shows "k dvd (zlcm i j)"
92.75 proof -
92.76 have "nat(abs k) dvd nat(abs i)" using `k dvd i`
92.77 - by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
92.78 + by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
92.79 thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
92.80 qed
92.81
92.82 @@ -729,7 +734,7 @@
92.83 assumes "k dvd j" shows "k dvd (zlcm i j)"
92.84 proof -
92.85 have "nat(abs k) dvd nat(abs j)" using `k dvd j`
92.86 - by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
92.87 + by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
92.88 thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
92.89 qed
92.90
93.1 --- a/src/HOL/Groebner_Basis.thy Wed Mar 04 10:43:39 2009 +0100
93.2 +++ b/src/HOL/Groebner_Basis.thy Wed Mar 04 10:45:52 2009 +0100
93.3 @@ -147,7 +147,7 @@
93.4 next show "pwr (mul x y) q = mul (pwr x q) (pwr y q)" by (rule pwr_mul)
93.5 next show "pwr (pwr x p) q = pwr x (p * q)" by (rule pwr_pwr)
93.6 next show "pwr x 0 = r1" using pwr_0 .
93.7 -next show "pwr x 1 = x" by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
93.8 +next show "pwr x 1 = x" unfolding One_nat_def by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
93.9 next show "mul x (add y z) = add (mul x y) (mul x z)" using mul_d by simp
93.10 next show "pwr x (Suc q) = mul x (pwr x q)" using pwr_Suc by simp
93.11 next show "pwr x (2 * n) = mul (pwr x n) (pwr x n)" by (simp add: nat_number mul_pwr)
93.12 @@ -436,8 +436,8 @@
93.13 *} "solve polynomial equations over (semi)rings and ideal membership problems using Groebner bases"
93.14 declare dvd_def[algebra]
93.15 declare dvd_eq_mod_eq_0[symmetric, algebra]
93.16 -declare nat_mod_div_trivial[algebra]
93.17 -declare nat_mod_mod_trivial[algebra]
93.18 +declare mod_div_trivial[algebra]
93.19 +declare mod_mod_trivial[algebra]
93.20 declare conjunct1[OF DIVISION_BY_ZERO, algebra]
93.21 declare conjunct2[OF DIVISION_BY_ZERO, algebra]
93.22 declare zmod_zdiv_equality[symmetric,algebra]
93.23 @@ -448,16 +448,16 @@
93.24 declare zmod_zminus2[algebra]
93.25 declare zdiv_zero[algebra]
93.26 declare zmod_zero[algebra]
93.27 -declare zmod_1[algebra]
93.28 -declare zdiv_1[algebra]
93.29 +declare mod_by_1[algebra]
93.30 +declare div_by_1[algebra]
93.31 declare zmod_minus1_right[algebra]
93.32 declare zdiv_minus1_right[algebra]
93.33 declare mod_div_trivial[algebra]
93.34 declare mod_mod_trivial[algebra]
93.35 -declare zmod_zmult_self1[algebra]
93.36 -declare zmod_zmult_self2[algebra]
93.37 +declare mod_mult_self2_is_0[algebra]
93.38 +declare mod_mult_self1_is_0[algebra]
93.39 declare zmod_eq_0_iff[algebra]
93.40 -declare zdvd_0_left[algebra]
93.41 +declare dvd_0_left_iff[algebra]
93.42 declare zdvd1_eq[algebra]
93.43 declare zmod_eq_dvd_iff[algebra]
93.44 declare nat_mod_eq_iff[algebra]
94.1 --- a/src/HOL/HOL.thy Wed Mar 04 10:43:39 2009 +0100
94.2 +++ b/src/HOL/HOL.thy Wed Mar 04 10:45:52 2009 +0100
94.3 @@ -12,14 +12,15 @@
94.4 "~~/src/Tools/IsaPlanner/isand.ML"
94.5 "~~/src/Tools/IsaPlanner/rw_tools.ML"
94.6 "~~/src/Tools/IsaPlanner/rw_inst.ML"
94.7 - "~~/src/Provers/project_rule.ML"
94.8 + "~~/src/Tools/intuitionistic.ML"
94.9 + "~~/src/Tools/project_rule.ML"
94.10 "~~/src/Provers/hypsubst.ML"
94.11 "~~/src/Provers/splitter.ML"
94.12 "~~/src/Provers/classical.ML"
94.13 "~~/src/Provers/blast.ML"
94.14 "~~/src/Provers/clasimp.ML"
94.15 - "~~/src/Provers/coherent.ML"
94.16 - "~~/src/Provers/eqsubst.ML"
94.17 + "~~/src/Tools/coherent.ML"
94.18 + "~~/src/Tools/eqsubst.ML"
94.19 "~~/src/Provers/quantifier1.ML"
94.20 ("Tools/simpdata.ML")
94.21 "~~/src/Tools/random_word.ML"
94.22 @@ -28,7 +29,8 @@
94.23 ("~~/src/Tools/induct_tacs.ML")
94.24 "~~/src/Tools/value.ML"
94.25 "~~/src/Tools/code/code_name.ML"
94.26 - "~~/src/Tools/code/code_funcgr.ML"
94.27 + "~~/src/Tools/code/code_funcgr.ML" (*formal dependency*)
94.28 + "~~/src/Tools/code/code_wellsorted.ML"
94.29 "~~/src/Tools/code/code_thingol.ML"
94.30 "~~/src/Tools/code/code_printer.ML"
94.31 "~~/src/Tools/code/code_target.ML"
94.32 @@ -38,6 +40,9 @@
94.33 ("Tools/recfun_codegen.ML")
94.34 begin
94.35
94.36 +setup {* Intuitionistic.method_setup "iprover" *}
94.37 +
94.38 +
94.39 subsection {* Primitive logic *}
94.40
94.41 subsubsection {* Core syntax *}
94.42 @@ -290,7 +295,7 @@
94.43 typed_print_translation {*
94.44 let
94.45 fun tr' c = (c, fn show_sorts => fn T => fn ts =>
94.46 - if T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
94.47 + if (not o null) ts orelse T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
94.48 else Syntax.const Syntax.constrainC $ Syntax.const c $ Syntax.term_of_typ show_sorts T);
94.49 in map tr' [@{const_syntax HOL.one}, @{const_syntax HOL.zero}] end;
94.50 *} -- {* show types that are presumably too general *}
94.51 @@ -1704,11 +1709,6 @@
94.52 subsection {* Nitpick theorem store *}
94.53
94.54 ML {*
94.55 -structure Nitpick_Const_Def_Thms = NamedThmsFun
94.56 -(
94.57 - val name = "nitpick_const_def"
94.58 - val description = "pseudo-definition of constants as needed by Nitpick"
94.59 -)
94.60 structure Nitpick_Const_Simp_Thms = NamedThmsFun
94.61 (
94.62 val name = "nitpick_const_simp"
94.63 @@ -1725,8 +1725,7 @@
94.64 val description = "introduction rules for (co)inductive predicates as needed by Nitpick"
94.65 )
94.66 *}
94.67 -setup {* Nitpick_Const_Def_Thms.setup
94.68 - #> Nitpick_Const_Simp_Thms.setup
94.69 +setup {* Nitpick_Const_Simp_Thms.setup
94.70 #> Nitpick_Const_Psimp_Thms.setup
94.71 #> Nitpick_Ind_Intro_Thms.setup *}
94.72
95.1 --- a/src/HOL/Hoare/Arith2.thy Wed Mar 04 10:43:39 2009 +0100
95.2 +++ b/src/HOL/Hoare/Arith2.thy Wed Mar 04 10:45:52 2009 +0100
95.3 @@ -42,12 +42,12 @@
95.4
95.5 lemma cd_diff_l: "n<=m ==> cd x m n = cd x (m-n) n"
95.6 apply (unfold cd_def)
95.7 - apply (blast intro: dvd_diff dest: dvd_diffD)
95.8 + apply (fastsimp dest: dvd_diffD)
95.9 done
95.10
95.11 lemma cd_diff_r: "m<=n ==> cd x m n = cd x m (n-m)"
95.12 apply (unfold cd_def)
95.13 - apply (blast intro: dvd_diff dest: dvd_diffD)
95.14 + apply (fastsimp dest: dvd_diffD)
95.15 done
95.16
95.17
96.1 --- a/src/HOL/Import/lazy_seq.ML Wed Mar 04 10:43:39 2009 +0100
96.2 +++ b/src/HOL/Import/lazy_seq.ML Wed Mar 04 10:45:52 2009 +0100
96.3 @@ -1,5 +1,4 @@
96.4 (* Title: HOL/Import/lazy_seq.ML
96.5 - ID: $Id$
96.6 Author: Sebastian Skalberg, TU Muenchen
96.7
96.8 Alternative version of lazy sequences.
96.9 @@ -408,8 +407,8 @@
96.10 make (fn () => copy (f x))
96.11 end
96.12
96.13 -fun EVERY fs = foldr (op THEN) succeed fs
96.14 -fun FIRST fs = foldr (op ORELSE) fail fs
96.15 +fun EVERY fs = List.foldr (op THEN) succeed fs
96.16 +fun FIRST fs = List.foldr (op ORELSE) fail fs
96.17
96.18 fun TRY f x =
96.19 make (fn () =>
97.1 --- a/src/HOL/Import/proof_kernel.ML Wed Mar 04 10:43:39 2009 +0100
97.2 +++ b/src/HOL/Import/proof_kernel.ML Wed Mar 04 10:45:52 2009 +0100
97.3 @@ -777,7 +777,7 @@
97.4 val (c,asl) = case terms of
97.5 [] => raise ERR "x2p" "Bad oracle description"
97.6 | (hd::tl) => (hd,tl)
97.7 - val tg = foldr (fn (oracle,tg) => Tag.merge (Tag.read oracle) tg) Tag.empty_tag ors
97.8 + val tg = List.foldr (fn (oracle,tg) => Tag.merge (Tag.read oracle) tg) Tag.empty_tag ors
97.9 in
97.10 mk_proof (POracle(tg,map xml_to_term asl,xml_to_term c))
97.11 end
97.12 @@ -1840,7 +1840,7 @@
97.13 | inst_type ty1 ty2 (ty as Type(name,tys)) =
97.14 Type(name,map (inst_type ty1 ty2) tys)
97.15 in
97.16 - foldr (fn (v,th) =>
97.17 + List.foldr (fn (v,th) =>
97.18 let
97.19 val cdom = fst (dom_rng (fst (dom_rng cty)))
97.20 val vty = type_of v
97.21 @@ -1852,7 +1852,7 @@
97.22 end
97.23 | SOME _ => raise ERR "GEN_ABS" "Bad constant"
97.24 | NONE =>
97.25 - foldr (fn (v,th) => mk_ABS v th thy) th vlist'
97.26 + List.foldr (fn (v,th) => mk_ABS v th thy) th vlist'
97.27 val res = HOLThm(rens_of info',th1)
97.28 val _ = message "RESULT:"
97.29 val _ = if_debug pth res
97.30 @@ -2020,7 +2020,7 @@
97.31 Sign.add_consts_i consts thy'
97.32 end
97.33
97.34 - val thy1 = foldr (fn(name,thy)=>
97.35 + val thy1 = List.foldr (fn(name,thy)=>
97.36 snd (get_defname thyname name thy)) thy1 names
97.37 fun new_name name = fst (get_defname thyname name thy1)
97.38 val names' = map (fn name => (new_name name,name,false)) names
97.39 @@ -2041,7 +2041,7 @@
97.40 then quotename name
97.41 else (quotename newname) ^ ": " ^ (quotename name),thy')
97.42 end
97.43 - val (new_names,thy') = foldr (fn(name,(names,thy)) =>
97.44 + val (new_names,thy') = List.foldr (fn(name,(names,thy)) =>
97.45 let
97.46 val (name',thy') = handle_const (name,thy)
97.47 in
98.1 --- a/src/HOL/Induct/Common_Patterns.thy Wed Mar 04 10:43:39 2009 +0100
98.2 +++ b/src/HOL/Induct/Common_Patterns.thy Wed Mar 04 10:45:52 2009 +0100
98.3 @@ -1,5 +1,4 @@
98.4 (* Title: HOL/Induct/Common_Patterns.thy
98.5 - ID: $Id$
98.6 Author: Makarius
98.7 *)
98.8
99.1 --- a/src/HOL/Induct/LList.thy Wed Mar 04 10:43:39 2009 +0100
99.2 +++ b/src/HOL/Induct/LList.thy Wed Mar 04 10:45:52 2009 +0100
99.3 @@ -8,7 +8,7 @@
99.4 bounds on the amount of lookahead required.
99.5
99.6 Could try (but would it work for the gfp analogue of term?)
99.7 - LListD_Fun_def "LListD_Fun(A) == (%Z. diag({Numb(0)}) <++> diag(A) <**> Z)"
99.8 + LListD_Fun_def "LListD_Fun(A) == (%Z. Id_on({Numb(0)}) <++> Id_on(A) <**> Z)"
99.9
99.10 A nice but complex example would be [ML for the Working Programmer, page 176]
99.11 from(1) = enumerate (Lmap (Lmap(pack), makeqq(from(1),from(1))))
99.12 @@ -95,7 +95,7 @@
99.13 llistD_Fun :: "('a llist * 'a llist)set => ('a llist * 'a llist)set" where
99.14 "llistD_Fun(r) =
99.15 prod_fun Abs_LList Abs_LList `
99.16 - LListD_Fun (diag(range Leaf))
99.17 + LListD_Fun (Id_on(range Leaf))
99.18 (prod_fun Rep_LList Rep_LList ` r)"
99.19
99.20
99.21 @@ -265,12 +265,12 @@
99.22 subsection{* @{text llist} equality as a @{text gfp}; the bisimulation principle *}
99.23
99.24 text{*This theorem is actually used, unlike the many similar ones in ZF*}
99.25 -lemma LListD_unfold: "LListD r = dsum (diag {Numb 0}) (dprod r (LListD r))"
99.26 +lemma LListD_unfold: "LListD r = dsum (Id_on {Numb 0}) (dprod r (LListD r))"
99.27 by (fast intro!: LListD.intros [unfolded NIL_def CONS_def]
99.28 elim: LListD.cases [unfolded NIL_def CONS_def])
99.29
99.30 lemma LListD_implies_ntrunc_equality [rule_format]:
99.31 - "\<forall>M N. (M,N) \<in> LListD(diag A) --> ntrunc k M = ntrunc k N"
99.32 + "\<forall>M N. (M,N) \<in> LListD(Id_on A) --> ntrunc k M = ntrunc k N"
99.33 apply (induct_tac "k" rule: nat_less_induct)
99.34 apply (safe del: equalityI)
99.35 apply (erule LListD.cases)
99.36 @@ -283,7 +283,7 @@
99.37
99.38 text{*The domain of the @{text LListD} relation*}
99.39 lemma Domain_LListD:
99.40 - "Domain (LListD(diag A)) \<subseteq> llist(A)"
99.41 + "Domain (LListD(Id_on A)) \<subseteq> llist(A)"
99.42 apply (rule subsetI)
99.43 apply (erule llist.coinduct)
99.44 apply (simp add: NIL_def CONS_def)
99.45 @@ -291,10 +291,10 @@
99.46 done
99.47
99.48 text{*This inclusion justifies the use of coinduction to show @{text "M = N"}*}
99.49 -lemma LListD_subset_diag: "LListD(diag A) \<subseteq> diag(llist(A))"
99.50 +lemma LListD_subset_Id_on: "LListD(Id_on A) \<subseteq> Id_on(llist(A))"
99.51 apply (rule subsetI)
99.52 apply (rule_tac p = x in PairE, safe)
99.53 -apply (rule diag_eqI)
99.54 +apply (rule Id_on_eqI)
99.55 apply (rule LListD_implies_ntrunc_equality [THEN ntrunc_equality], assumption)
99.56 apply (erule DomainI [THEN Domain_LListD [THEN subsetD]])
99.57 done
99.58 @@ -321,7 +321,7 @@
99.59 by (simp add: LListD_Fun_def NIL_def)
99.60
99.61 lemma LListD_Fun_CONS_I:
99.62 - "[| x\<in>A; (M,N):s |] ==> (CONS x M, CONS x N) \<in> LListD_Fun (diag A) s"
99.63 + "[| x\<in>A; (M,N):s |] ==> (CONS x M, CONS x N) \<in> LListD_Fun (Id_on A) s"
99.64 by (simp add: LListD_Fun_def CONS_def, blast)
99.65
99.66 text{*Utilise the "strong" part, i.e. @{text "gfp(f)"}*}
99.67 @@ -335,24 +335,24 @@
99.68
99.69
99.70 text{*This converse inclusion helps to strengthen @{text LList_equalityI}*}
99.71 -lemma diag_subset_LListD: "diag(llist(A)) \<subseteq> LListD(diag A)"
99.72 +lemma Id_on_subset_LListD: "Id_on(llist(A)) \<subseteq> LListD(Id_on A)"
99.73 apply (rule subsetI)
99.74 apply (erule LListD_coinduct)
99.75 apply (rule subsetI)
99.76 -apply (erule diagE)
99.77 +apply (erule Id_onE)
99.78 apply (erule ssubst)
99.79 apply (erule llist.cases)
99.80 -apply (simp_all add: diagI LListD_Fun_NIL_I LListD_Fun_CONS_I)
99.81 +apply (simp_all add: Id_onI LListD_Fun_NIL_I LListD_Fun_CONS_I)
99.82 done
99.83
99.84 -lemma LListD_eq_diag: "LListD(diag A) = diag(llist(A))"
99.85 -apply (rule equalityI LListD_subset_diag diag_subset_LListD)+
99.86 +lemma LListD_eq_Id_on: "LListD(Id_on A) = Id_on(llist(A))"
99.87 +apply (rule equalityI LListD_subset_Id_on Id_on_subset_LListD)+
99.88 done
99.89
99.90 -lemma LListD_Fun_diag_I: "M \<in> llist(A) ==> (M,M) \<in> LListD_Fun (diag A) (X Un diag(llist(A)))"
99.91 -apply (rule LListD_eq_diag [THEN subst])
99.92 +lemma LListD_Fun_Id_on_I: "M \<in> llist(A) ==> (M,M) \<in> LListD_Fun (Id_on A) (X Un Id_on(llist(A)))"
99.93 +apply (rule LListD_eq_Id_on [THEN subst])
99.94 apply (rule LListD_Fun_LListD_I)
99.95 -apply (simp add: LListD_eq_diag diagI)
99.96 +apply (simp add: LListD_eq_Id_on Id_onI)
99.97 done
99.98
99.99
99.100 @@ -360,11 +360,11 @@
99.101 [also admits true equality]
99.102 Replace @{text A} by some particular set, like @{text "{x. True}"}??? *}
99.103 lemma LList_equalityI:
99.104 - "[| (M,N) \<in> r; r \<subseteq> LListD_Fun (diag A) (r Un diag(llist(A))) |]
99.105 + "[| (M,N) \<in> r; r \<subseteq> LListD_Fun (Id_on A) (r Un Id_on(llist(A))) |]
99.106 ==> M=N"
99.107 -apply (rule LListD_subset_diag [THEN subsetD, THEN diagE])
99.108 +apply (rule LListD_subset_Id_on [THEN subsetD, THEN Id_onE])
99.109 apply (erule LListD_coinduct)
99.110 -apply (simp add: LListD_eq_diag, safe)
99.111 +apply (simp add: LListD_eq_Id_on, safe)
99.112 done
99.113
99.114
99.115 @@ -525,14 +525,14 @@
99.116 f(NIL)=g(NIL);
99.117 !!x l. [| x\<in>A; l \<in> llist(A) |] ==>
99.118 (f(CONS x l),g(CONS x l)) \<in>
99.119 - LListD_Fun (diag A) ((%u.(f(u),g(u)))`llist(A) Un
99.120 - diag(llist(A)))
99.121 + LListD_Fun (Id_on A) ((%u.(f(u),g(u)))`llist(A) Un
99.122 + Id_on(llist(A)))
99.123 |] ==> f(M) = g(M)"
99.124 apply (rule LList_equalityI)
99.125 apply (erule imageI)
99.126 apply (rule image_subsetI)
99.127 apply (erule_tac a=x in llist.cases)
99.128 -apply (erule ssubst, erule ssubst, erule LListD_Fun_diag_I, blast)
99.129 +apply (erule ssubst, erule ssubst, erule LListD_Fun_Id_on_I, blast)
99.130 done
99.131
99.132
99.133 @@ -687,7 +687,7 @@
99.134
99.135 lemma LListD_Fun_subset_Times_llist:
99.136 "r \<subseteq> (llist A) <*> (llist A)
99.137 - ==> LListD_Fun (diag A) r \<subseteq> (llist A) <*> (llist A)"
99.138 + ==> LListD_Fun (Id_on A) r \<subseteq> (llist A) <*> (llist A)"
99.139 by (auto simp add: LListD_Fun_def)
99.140
99.141 lemma subset_Times_llist:
99.142 @@ -703,9 +703,9 @@
99.143 apply (simp add: LListI [THEN Abs_LList_inverse])
99.144 done
99.145
99.146 -lemma prod_fun_range_eq_diag:
99.147 +lemma prod_fun_range_eq_Id_on:
99.148 "prod_fun Rep_LList Rep_LList ` range(%x. (x, x)) =
99.149 - diag(llist(range Leaf))"
99.150 + Id_on(llist(range Leaf))"
99.151 apply (rule equalityI, blast)
99.152 apply (fast elim: LListI [THEN Abs_LList_inverse, THEN subst])
99.153 done
99.154 @@ -730,10 +730,10 @@
99.155 apply (rule image_compose [THEN subst])
99.156 apply (rule prod_fun_compose [THEN subst])
99.157 apply (subst image_Un)
99.158 -apply (subst prod_fun_range_eq_diag)
99.159 +apply (subst prod_fun_range_eq_Id_on)
99.160 apply (rule LListD_Fun_subset_Times_llist [THEN prod_fun_lemma])
99.161 apply (rule subset_Times_llist [THEN Un_least])
99.162 -apply (rule diag_subset_Times)
99.163 +apply (rule Id_on_subset_Times)
99.164 done
99.165
99.166 subsubsection{* Rules to prove the 2nd premise of @{text llist_equalityI} *}
99.167 @@ -755,8 +755,8 @@
99.168 apply (rule Rep_LList_inverse [THEN subst])
99.169 apply (rule prod_fun_imageI)
99.170 apply (subst image_Un)
99.171 -apply (subst prod_fun_range_eq_diag)
99.172 -apply (rule Rep_LList [THEN LListD, THEN LListD_Fun_diag_I])
99.173 +apply (subst prod_fun_range_eq_Id_on)
99.174 +apply (rule Rep_LList [THEN LListD, THEN LListD_Fun_Id_on_I])
99.175 done
99.176
99.177 text{*A special case of @{text list_equality} for functions over lazy lists*}
100.1 --- a/src/HOL/Induct/QuoDataType.thy Wed Mar 04 10:43:39 2009 +0100
100.2 +++ b/src/HOL/Induct/QuoDataType.thy Wed Mar 04 10:45:52 2009 +0100
100.3 @@ -47,7 +47,7 @@
100.4
100.5 theorem equiv_msgrel: "equiv UNIV msgrel"
100.6 proof -
100.7 - have "reflexive msgrel" by (simp add: refl_def msgrel_refl)
100.8 + have "refl msgrel" by (simp add: refl_on_def msgrel_refl)
100.9 moreover have "sym msgrel" by (simp add: sym_def, blast intro: msgrel.SYM)
100.10 moreover have "trans msgrel" by (simp add: trans_def, blast intro: msgrel.TRANS)
100.11 ultimately show ?thesis by (simp add: equiv_def)
101.1 --- a/src/HOL/Induct/QuoNestedDataType.thy Wed Mar 04 10:43:39 2009 +0100
101.2 +++ b/src/HOL/Induct/QuoNestedDataType.thy Wed Mar 04 10:45:52 2009 +0100
101.3 @@ -44,7 +44,7 @@
101.4
101.5 theorem equiv_exprel: "equiv UNIV exprel"
101.6 proof -
101.7 - have "reflexive exprel" by (simp add: refl_def exprel_refl)
101.8 + have "refl exprel" by (simp add: refl_on_def exprel_refl)
101.9 moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM)
101.10 moreover have "trans exprel" by (simp add: trans_def, blast intro: exprel.TRANS)
101.11 ultimately show ?thesis by (simp add: equiv_def)
102.1 --- a/src/HOL/Induct/SList.thy Wed Mar 04 10:43:39 2009 +0100
102.2 +++ b/src/HOL/Induct/SList.thy Wed Mar 04 10:45:52 2009 +0100
102.3 @@ -1,15 +1,10 @@
102.4 -(* *********************************************************************** *)
102.5 -(* *)
102.6 -(* Title: SList.thy (Extended List Theory) *)
102.7 -(* Based on: $Id$ *)
102.8 -(* Author: Lawrence C Paulson, Cambridge University Computer Laboratory*)
102.9 -(* Author: B. Wolff, University of Bremen *)
102.10 -(* Purpose: Enriched theory of lists *)
102.11 -(* mutual indirect recursive data-types *)
102.12 -(* *)
102.13 -(* *********************************************************************** *)
102.14 +(* Title: SList.thy
102.15 + Author: Lawrence C Paulson, Cambridge University Computer Laboratory
102.16 + Author: B. Wolff, University of Bremen
102.17
102.18 -(* Definition of type 'a list (strict lists) by a least fixed point
102.19 +Enriched theory of lists; mutual indirect recursive data-types.
102.20 +
102.21 +Definition of type 'a list (strict lists) by a least fixed point
102.22
102.23 We use list(A) == lfp(%Z. {NUMB(0)} <+> A <*> Z)
102.24 and not list == lfp(%Z. {NUMB(0)} <+> range(Leaf) <*> Z)
102.25 @@ -24,6 +19,8 @@
102.26 Tidied by lcp. Still needs removal of nat_rec.
102.27 *)
102.28
102.29 +header {* Extended List Theory (old) *}
102.30 +
102.31 theory SList
102.32 imports Sexp
102.33 begin
102.34 @@ -79,12 +76,12 @@
102.35
102.36 (*Declaring the abstract list constructors*)
102.37
102.38 -(*<*)no_translations
102.39 +no_translations
102.40 "[x, xs]" == "x#[xs]"
102.41 "[x]" == "x#[]"
102.42 -no_syntax
102.43 - Nil :: "'a list" ("[]")
102.44 - Cons :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixr "#" 65)(*>*)
102.45 +no_notation
102.46 + Nil ("[]") and
102.47 + Cons (infixr "#" 65)
102.48
102.49 definition
102.50 Nil :: "'a list" ("[]") where
102.51 @@ -149,8 +146,8 @@
102.52 ttl :: "'a list => 'a list" where
102.53 "ttl xs = list_rec xs [] (%x xs r. xs)"
102.54
102.55 -(*<*)no_syntax
102.56 - member :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" (infixl "mem" 55)(*>*)
102.57 +no_notation member (infixl "mem" 55)
102.58 +
102.59 definition
102.60 member :: "['a, 'a list] => bool" (infixl "mem" 55) where
102.61 "x mem xs = list_rec xs False (%y ys r. if y=x then True else r)"
102.62 @@ -163,8 +160,8 @@
102.63 map :: "('a=>'b) => ('a list => 'b list)" where
102.64 "map f xs = list_rec xs [] (%x l r. f(x)#r)"
102.65
102.66 -(*<*)no_syntax
102.67 - "\<^const>List.append" :: "'a list => 'a list => 'a list" (infixr "@" 65)(*>*)
102.68 +no_notation append (infixr "@" 65)
102.69 +
102.70 definition
102.71 append :: "['a list, 'a list] => 'a list" (infixr "@" 65) where
102.72 "xs@ys = list_rec xs ys (%x l r. x#r)"
102.73 @@ -342,14 +339,14 @@
102.74
102.75
102.76 lemma not_CONS_self: "N: list(A) ==> !M. N ~= CONS M N"
102.77 -by (erule list.induct, simp_all)
102.78 +apply (erule list.induct) apply simp_all done
102.79
102.80 lemma not_Cons_self2: "\<forall>x. l ~= x#l"
102.81 -by (induct_tac "l" rule: list_induct, simp_all)
102.82 +by (induct l rule: list_induct) simp_all
102.83
102.84
102.85 lemma neq_Nil_conv2: "(xs ~= []) = (\<exists>y ys. xs = y#ys)"
102.86 -by (induct_tac "xs" rule: list_induct, auto)
102.87 +by (induct xs rule: list_induct) auto
102.88
102.89 (** Conversion rules for List_case: case analysis operator **)
102.90
102.91 @@ -491,7 +488,7 @@
102.92
102.93 lemma expand_list_case:
102.94 "P(list_case a f xs) = ((xs=[] --> P a ) & (!y ys. xs=y#ys --> P(f y ys)))"
102.95 -by (induct_tac "xs" rule: list_induct, simp_all)
102.96 +by (induct xs rule: list_induct) simp_all
102.97
102.98
102.99 (**** Function definitions ****)
102.100 @@ -533,41 +530,44 @@
102.101 (** @ - append **)
102.102
102.103 lemma append_assoc [simp]: "(xs@ys)@zs = xs@(ys@zs)"
102.104 -by (induct_tac "xs" rule: list_induct, simp_all)
102.105 +by (induct xs rule: list_induct) simp_all
102.106
102.107 lemma append_Nil2 [simp]: "xs @ [] = xs"
102.108 -by (induct_tac "xs" rule: list_induct, simp_all)
102.109 +by (induct xs rule: list_induct) simp_all
102.110
102.111 (** mem **)
102.112
102.113 lemma mem_append [simp]: "x mem (xs@ys) = (x mem xs | x mem ys)"
102.114 -by (induct_tac "xs" rule: list_induct, simp_all)
102.115 +by (induct xs rule: list_induct) simp_all
102.116
102.117 lemma mem_filter [simp]: "x mem [x\<leftarrow>xs. P x ] = (x mem xs & P(x))"
102.118 -by (induct_tac "xs" rule: list_induct, simp_all)
102.119 +by (induct xs rule: list_induct) simp_all
102.120
102.121 (** list_all **)
102.122
102.123 lemma list_all_True [simp]: "(Alls x:xs. True) = True"
102.124 -by (induct_tac "xs" rule: list_induct, simp_all)
102.125 +by (induct xs rule: list_induct) simp_all
102.126
102.127 lemma list_all_conj [simp]:
102.128 "list_all p (xs@ys) = ((list_all p xs) & (list_all p ys))"
102.129 -by (induct_tac "xs" rule: list_induct, simp_all)
102.130 +by (induct xs rule: list_induct) simp_all
102.131
102.132 lemma list_all_mem_conv: "(Alls x:xs. P(x)) = (!x. x mem xs --> P(x))"
102.133 -apply (induct_tac "xs" rule: list_induct, simp_all)
102.134 +apply (induct xs rule: list_induct)
102.135 +apply simp_all
102.136 apply blast
102.137 done
102.138
102.139 lemma nat_case_dist : "(! n. P n) = (P 0 & (! n. P (Suc n)))"
102.140 apply auto
102.141 -apply (induct_tac "n", auto)
102.142 +apply (induct_tac n)
102.143 +apply auto
102.144 done
102.145
102.146
102.147 lemma alls_P_eq_P_nth: "(Alls u:A. P u) = (!n. n < length A --> P(nth n A))"
102.148 -apply (induct_tac "A" rule: list_induct, simp_all)
102.149 +apply (induct_tac A rule: list_induct)
102.150 +apply simp_all
102.151 apply (rule trans)
102.152 apply (rule_tac [2] nat_case_dist [symmetric], simp_all)
102.153 done
102.154 @@ -583,7 +583,7 @@
102.155 lemma Abs_Rep_map:
102.156 "(!!x. f(x): sexp) ==>
102.157 Abs_map g (Rep_map f xs) = map (%t. g(f(t))) xs"
102.158 -apply (induct_tac "xs" rule: list_induct)
102.159 +apply (induct xs rule: list_induct)
102.160 apply (simp_all add: Rep_map_type list_sexp [THEN subsetD])
102.161 done
102.162
102.163 @@ -591,24 +591,25 @@
102.164 (** Additional mapping lemmas **)
102.165
102.166 lemma map_ident [simp]: "map(%x. x)(xs) = xs"
102.167 -by (induct_tac "xs" rule: list_induct, simp_all)
102.168 +by (induct xs rule: list_induct) simp_all
102.169
102.170 lemma map_append [simp]: "map f (xs@ys) = map f xs @ map f ys"
102.171 -by (induct_tac "xs" rule: list_induct, simp_all)
102.172 +by (induct xs rule: list_induct) simp_all
102.173
102.174 lemma map_compose: "map(f o g)(xs) = map f (map g xs)"
102.175 apply (simp add: o_def)
102.176 -apply (induct_tac "xs" rule: list_induct, simp_all)
102.177 +apply (induct xs rule: list_induct)
102.178 +apply simp_all
102.179 done
102.180
102.181
102.182 lemma mem_map_aux1 [rule_format]:
102.183 "x mem (map f q) --> (\<exists>y. y mem q & x = f y)"
102.184 -by (induct_tac "q" rule: list_induct, simp_all, blast)
102.185 +by (induct q rule: list_induct) auto
102.186
102.187 lemma mem_map_aux2 [rule_format]:
102.188 "(\<exists>y. y mem q & x = f y) --> x mem (map f q)"
102.189 -by (induct_tac "q" rule: list_induct, auto)
102.190 +by (induct q rule: list_induct) auto
102.191
102.192 lemma mem_map: "x mem (map f q) = (\<exists>y. y mem q & x = f y)"
102.193 apply (rule iffI)
102.194 @@ -617,10 +618,10 @@
102.195 done
102.196
102.197 lemma hd_append [rule_format]: "A ~= [] --> hd(A @ B) = hd(A)"
102.198 -by (induct_tac "A" rule: list_induct, auto)
102.199 +by (induct A rule: list_induct) auto
102.200
102.201 lemma tl_append [rule_format]: "A ~= [] --> tl(A @ B) = tl(A) @ B"
102.202 -by (induct_tac "A" rule: list_induct, auto)
102.203 +by (induct A rule: list_induct) auto
102.204
102.205
102.206 (** take **)
102.207 @@ -638,8 +639,8 @@
102.208 by (simp add: drop_def)
102.209
102.210 lemma drop_Suc1 [simp]: "drop [] (Suc x) = []"
102.211 -apply (simp add: drop_def)
102.212 -apply (induct_tac "x", auto)
102.213 +apply (induct x)
102.214 +apply (simp_all add: drop_def)
102.215 done
102.216
102.217 lemma drop_Suc2 [simp]: "drop(a#xs)(Suc x) = drop xs x"
102.218 @@ -698,9 +699,7 @@
102.219
102.220
102.221 lemma zipWith_Cons_Nil [simp]: "zipWith f (x,[]) = []"
102.222 -apply (simp add: zipWith_def)
102.223 -apply (induct_tac "x" rule: list_induct, simp_all)
102.224 -done
102.225 +by (induct x rule: list_induct) (simp_all add: zipWith_def)
102.226
102.227
102.228 lemma zipWith_Nil_Cons [simp]: "zipWith f ([],x) = []"
102.229 @@ -722,23 +721,23 @@
102.230 done
102.231
102.232 lemma map_flat: "map f (flat S) = flat(map (map f) S)"
102.233 -by (induct_tac "S" rule: list_induct, simp_all)
102.234 +by (induct S rule: list_induct) simp_all
102.235
102.236 lemma list_all_map_eq: "(Alls u:xs. f(u) = g(u)) --> map f xs = map g xs"
102.237 -by (induct_tac "xs" rule: list_induct, simp_all)
102.238 +by (induct xs rule: list_induct) simp_all
102.239
102.240 lemma filter_map_d: "filter p (map f xs) = map f (filter(p o f)(xs))"
102.241 -by (induct_tac "xs" rule: list_induct, simp_all)
102.242 +by (induct xs rule: list_induct) simp_all
102.243
102.244 lemma filter_compose: "filter p (filter q xs) = filter(%x. p x & q x) xs"
102.245 -by (induct_tac "xs" rule: list_induct, simp_all)
102.246 +by (induct xs rule: list_induct) simp_all
102.247
102.248 (* "filter(p, filter(q,xs)) = filter(q, filter(p,xs))",
102.249 "filter(p, filter(p,xs)) = filter(p,xs)" BIRD's thms.*)
102.250
102.251 lemma filter_append [rule_format, simp]:
102.252 "\<forall>B. filter p (A @ B) = (filter p A @ filter p B)"
102.253 -by (induct_tac "A" rule: list_induct, simp_all)
102.254 +by (induct A rule: list_induct) simp_all
102.255
102.256
102.257 (* inits(xs) == map(fst,splits(xs)),
102.258 @@ -749,44 +748,50 @@
102.259 x mem xs & y mem ys = <x,y> mem diag(xs,ys) *)
102.260
102.261 lemma length_append: "length(xs@ys) = length(xs)+length(ys)"
102.262 -by (induct_tac "xs" rule: list_induct, simp_all)
102.263 +by (induct xs rule: list_induct) simp_all
102.264
102.265 lemma length_map: "length(map f xs) = length(xs)"
102.266 -by (induct_tac "xs" rule: list_induct, simp_all)
102.267 +by (induct xs rule: list_induct) simp_all
102.268
102.269
102.270 lemma take_Nil [simp]: "take [] n = []"
102.271 -by (induct_tac "n", simp_all)
102.272 +by (induct n) simp_all
102.273
102.274 lemma take_take_eq [simp]: "\<forall>n. take (take xs n) n = take xs n"
102.275 -apply (induct_tac "xs" rule: list_induct, simp_all)
102.276 +apply (induct xs rule: list_induct)
102.277 +apply simp_all
102.278 apply (rule allI)
102.279 -apply (induct_tac "n", auto)
102.280 +apply (induct_tac n)
102.281 +apply auto
102.282 done
102.283
102.284 lemma take_take_Suc_eq1 [rule_format]:
102.285 "\<forall>n. take (take xs(Suc(n+m))) n = take xs n"
102.286 -apply (induct_tac "xs" rule: list_induct, simp_all)
102.287 +apply (induct_tac xs rule: list_induct)
102.288 +apply simp_all
102.289 apply (rule allI)
102.290 -apply (induct_tac "n", auto)
102.291 +apply (induct_tac n)
102.292 +apply auto
102.293 done
102.294
102.295 declare take_Suc [simp del]
102.296
102.297 lemma take_take_1: "take (take xs (n+m)) n = take xs n"
102.298 -apply (induct_tac "m")
102.299 +apply (induct m)
102.300 apply (simp_all add: take_take_Suc_eq1)
102.301 done
102.302
102.303 lemma take_take_Suc_eq2 [rule_format]:
102.304 "\<forall>n. take (take xs n)(Suc(n+m)) = take xs n"
102.305 -apply (induct_tac "xs" rule: list_induct, simp_all)
102.306 +apply (induct_tac xs rule: list_induct)
102.307 +apply simp_all
102.308 apply (rule allI)
102.309 -apply (induct_tac "n", auto)
102.310 +apply (induct_tac n)
102.311 +apply auto
102.312 done
102.313
102.314 lemma take_take_2: "take(take xs n)(n+m) = take xs n"
102.315 -apply (induct_tac "m")
102.316 +apply (induct m)
102.317 apply (simp_all add: take_take_Suc_eq2)
102.318 done
102.319
102.320 @@ -794,29 +799,33 @@
102.321 (* length(drop(xs,n)) = length(xs) - n *)
102.322
102.323 lemma drop_Nil [simp]: "drop [] n = []"
102.324 -by (induct_tac "n", auto)
102.325 +by (induct n) auto
102.326
102.327 lemma drop_drop [rule_format]: "\<forall>xs. drop (drop xs m) n = drop xs(m+n)"
102.328 -apply (induct_tac "m", auto)
102.329 -apply (induct_tac "xs" rule: list_induct, auto)
102.330 +apply (induct_tac m)
102.331 +apply auto
102.332 +apply (induct_tac xs rule: list_induct)
102.333 +apply auto
102.334 done
102.335
102.336 lemma take_drop [rule_format]: "\<forall>xs. (take xs n) @ (drop xs n) = xs"
102.337 -apply (induct_tac "n", auto)
102.338 -apply (induct_tac "xs" rule: list_induct, auto)
102.339 +apply (induct_tac n)
102.340 +apply auto
102.341 +apply (induct_tac xs rule: list_induct)
102.342 +apply auto
102.343 done
102.344
102.345 lemma copy_copy: "copy x n @ copy x m = copy x (n+m)"
102.346 -by (induct_tac "n", auto)
102.347 +by (induct n) auto
102.348
102.349 lemma length_copy: "length(copy x n) = n"
102.350 -by (induct_tac "n", auto)
102.351 +by (induct n) auto
102.352
102.353 lemma length_take [rule_format, simp]:
102.354 "\<forall>xs. length(take xs n) = min (length xs) n"
102.355 -apply (induct_tac "n")
102.356 +apply (induct n)
102.357 apply auto
102.358 -apply (induct_tac "xs" rule: list_induct)
102.359 +apply (induct_tac xs rule: list_induct)
102.360 apply auto
102.361 done
102.362
102.363 @@ -824,85 +833,93 @@
102.364 by (simp only: length_append [symmetric] take_drop)
102.365
102.366 lemma take_append [rule_format]: "\<forall>A. length(A) = n --> take(A@B) n = A"
102.367 -apply (induct_tac "n")
102.368 +apply (induct n)
102.369 apply (rule allI)
102.370 apply (rule_tac [2] allI)
102.371 -apply (induct_tac "A" rule: list_induct)
102.372 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
102.373 +apply (induct_tac A rule: list_induct)
102.374 +apply (induct_tac [3] A rule: list_induct, simp_all)
102.375 done
102.376
102.377 lemma take_append2 [rule_format]:
102.378 "\<forall>A. length(A) = n --> take(A@B) (n+k) = A @ take B k"
102.379 -apply (induct_tac "n")
102.380 +apply (induct n)
102.381 apply (rule allI)
102.382 apply (rule_tac [2] allI)
102.383 -apply (induct_tac "A" rule: list_induct)
102.384 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
102.385 +apply (induct_tac A rule: list_induct)
102.386 +apply (induct_tac [3] A rule: list_induct, simp_all)
102.387 done
102.388
102.389 lemma take_map [rule_format]: "\<forall>n. take (map f A) n = map f (take A n)"
102.390 -apply (induct_tac "A" rule: list_induct, simp_all)
102.391 +apply (induct A rule: list_induct)
102.392 +apply simp_all
102.393 apply (rule allI)
102.394 -apply (induct_tac "n", simp_all)
102.395 +apply (induct_tac n)
102.396 +apply simp_all
102.397 done
102.398
102.399 lemma drop_append [rule_format]: "\<forall>A. length(A) = n --> drop(A@B)n = B"
102.400 -apply (induct_tac "n")
102.401 +apply (induct n)
102.402 apply (rule allI)
102.403 apply (rule_tac [2] allI)
102.404 -apply (induct_tac "A" rule: list_induct)
102.405 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
102.406 +apply (induct_tac A rule: list_induct)
102.407 +apply (induct_tac [3] A rule: list_induct)
102.408 +apply simp_all
102.409 done
102.410
102.411 lemma drop_append2 [rule_format]:
102.412 "\<forall>A. length(A) = n --> drop(A@B)(n+k) = drop B k"
102.413 -apply (induct_tac "n")
102.414 +apply (induct n)
102.415 apply (rule allI)
102.416 apply (rule_tac [2] allI)
102.417 -apply (induct_tac "A" rule: list_induct)
102.418 -apply (induct_tac [3] "A" rule: list_induct, simp_all)
102.419 +apply (induct_tac A rule: list_induct)
102.420 +apply (induct_tac [3] A rule: list_induct)
102.421 +apply simp_all
102.422 done
102.423
102.424
102.425 lemma drop_all [rule_format]: "\<forall>A. length(A) = n --> drop A n = []"
102.426 -apply (induct_tac "n")
102.427 +apply (induct n)
102.428 apply (rule allI)
102.429 apply (rule_tac [2] allI)
102.430 -apply (induct_tac "A" rule: list_induct)
102.431 -apply (induct_tac [3] "A" rule: list_induct, auto)
102.432 +apply (induct_tac A rule: list_induct)
102.433 +apply (induct_tac [3] A rule: list_induct)
102.434 +apply auto
102.435 done
102.436
102.437 lemma drop_map [rule_format]: "\<forall>n. drop (map f A) n = map f (drop A n)"
102.438 -apply (induct_tac "A" rule: list_induct, simp_all)
102.439 +apply (induct A rule: list_induct)
102.440 +apply simp_all
102.441 apply (rule allI)
102.442 -apply (induct_tac "n", simp_all)
102.443 +apply (induct_tac n)
102.444 +apply simp_all
102.445 done
102.446
102.447 lemma take_all [rule_format]: "\<forall>A. length(A) = n --> take A n = A"
102.448 -apply (induct_tac "n")
102.449 +apply (induct n)
102.450 apply (rule allI)
102.451 apply (rule_tac [2] allI)
102.452 -apply (induct_tac "A" rule: list_induct)
102.453 -apply (induct_tac [3] "A" rule: list_induct, auto)
102.454 +apply (induct_tac A rule: list_induct)
102.455 +apply (induct_tac [3] A rule: list_induct)
102.456 +apply auto
102.457 done
102.458
102.459 lemma foldl_single: "foldl f a [b] = f a b"
102.460 by simp_all
102.461
102.462 -lemma foldl_append [rule_format, simp]:
102.463 - "\<forall>a. foldl f a (A @ B) = foldl f (foldl f a A) B"
102.464 -by (induct_tac "A" rule: list_induct, simp_all)
102.465 +lemma foldl_append [simp]:
102.466 + "\<And>a. foldl f a (A @ B) = foldl f (foldl f a A) B"
102.467 +by (induct A rule: list_induct) simp_all
102.468
102.469 -lemma foldl_map [rule_format]:
102.470 - "\<forall>e. foldl f e (map g S) = foldl (%x y. f x (g y)) e S"
102.471 -by (induct_tac "S" rule: list_induct, simp_all)
102.472 +lemma foldl_map:
102.473 + "\<And>e. foldl f e (map g S) = foldl (%x y. f x (g y)) e S"
102.474 +by (induct S rule: list_induct) simp_all
102.475
102.476 lemma foldl_neutr_distr [rule_format]:
102.477 assumes r_neutr: "\<forall>a. f a e = a"
102.478 and r_neutl: "\<forall>a. f e a = a"
102.479 and assoc: "\<forall>a b c. f a (f b c) = f(f a b) c"
102.480 shows "\<forall>y. f y (foldl f e A) = foldl f y A"
102.481 -apply (induct_tac "A" rule: list_induct)
102.482 +apply (induct A rule: list_induct)
102.483 apply (simp_all add: r_neutr r_neutl, clarify)
102.484 apply (erule all_dupE)
102.485 apply (rule trans)
102.486 @@ -923,95 +940,98 @@
102.487
102.488 lemma foldr_append [rule_format, simp]:
102.489 "\<forall>a. foldr f a (A @ B) = foldr f (foldr f a B) A"
102.490 -apply (induct_tac "A" rule: list_induct, simp_all)
102.491 -done
102.492 +by (induct A rule: list_induct) simp_all
102.493
102.494
102.495 -lemma foldr_map [rule_format]: "\<forall>e. foldr f e (map g S) = foldr (f o g) e S"
102.496 -apply (simp add: o_def)
102.497 -apply (induct_tac "S" rule: list_induct, simp_all)
102.498 -done
102.499 +lemma foldr_map: "\<And>e. foldr f e (map g S) = foldr (f o g) e S"
102.500 +by (induct S rule: list_induct) (simp_all add: o_def)
102.501
102.502 lemma foldr_Un_eq_UN: "foldr op Un {} S = (UN X: {t. t mem S}.X)"
102.503 -by (induct_tac "S" rule: list_induct, auto)
102.504 +by (induct S rule: list_induct) auto
102.505
102.506 lemma foldr_neutr_distr:
102.507 "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |]
102.508 ==> foldr f y S = f (foldr f e S) y"
102.509 -by (induct_tac "S" rule: list_induct, auto)
102.510 +by (induct S rule: list_induct) auto
102.511
102.512 lemma foldr_append2:
102.513 "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |]
102.514 ==> foldr f e (A @ B) = f (foldr f e A) (foldr f e B)"
102.515 apply auto
102.516 -apply (rule foldr_neutr_distr, auto)
102.517 +apply (rule foldr_neutr_distr)
102.518 +apply auto
102.519 done
102.520
102.521 lemma foldr_flat:
102.522 "[| !a. f e a = a; !a b c. f a (f b c) = f(f a b) c |] ==>
102.523 foldr f e (flat S) = (foldr f e)(map (foldr f e) S)"
102.524 -apply (induct_tac "S" rule: list_induct)
102.525 +apply (induct S rule: list_induct)
102.526 apply (simp_all del: foldr_append add: foldr_append2)
102.527 done
102.528
102.529
102.530 lemma list_all_map: "(Alls x:map f xs .P(x)) = (Alls x:xs.(P o f)(x))"
102.531 -by (induct_tac "xs" rule: list_induct, auto)
102.532 +by (induct xs rule: list_induct) auto
102.533
102.534 lemma list_all_and:
102.535 "(Alls x:xs. P(x)&Q(x)) = ((Alls x:xs. P(x))&(Alls x:xs. Q(x)))"
102.536 -by (induct_tac "xs" rule: list_induct, auto)
102.537 +by (induct xs rule: list_induct) auto
102.538
102.539
102.540 lemma nth_map [rule_format]:
102.541 "\<forall>i. i < length(A) --> nth i (map f A) = f(nth i A)"
102.542 -apply (induct_tac "A" rule: list_induct, simp_all)
102.543 +apply (induct A rule: list_induct)
102.544 +apply simp_all
102.545 apply (rule allI)
102.546 -apply (induct_tac "i", auto)
102.547 +apply (induct_tac i)
102.548 +apply auto
102.549 done
102.550
102.551 lemma nth_app_cancel_right [rule_format]:
102.552 "\<forall>i. i < length(A) --> nth i(A@B) = nth i A"
102.553 -apply (induct_tac "A" rule: list_induct, simp_all)
102.554 +apply (induct A rule: list_induct)
102.555 +apply simp_all
102.556 apply (rule allI)
102.557 -apply (induct_tac "i", simp_all)
102.558 +apply (induct_tac i)
102.559 +apply simp_all
102.560 done
102.561
102.562 lemma nth_app_cancel_left [rule_format]:
102.563 "\<forall>n. n = length(A) --> nth(n+i)(A@B) = nth i B"
102.564 -by (induct_tac "A" rule: list_induct, simp_all)
102.565 +by (induct A rule: list_induct) simp_all
102.566
102.567
102.568 (** flat **)
102.569
102.570 lemma flat_append [simp]: "flat(xs@ys) = flat(xs) @ flat(ys)"
102.571 -by (induct_tac "xs" rule: list_induct, auto)
102.572 +by (induct xs rule: list_induct) auto
102.573
102.574 lemma filter_flat: "filter p (flat S) = flat(map (filter p) S)"
102.575 -by (induct_tac "S" rule: list_induct, auto)
102.576 +by (induct S rule: list_induct) auto
102.577
102.578
102.579 (** rev **)
102.580
102.581 lemma rev_append [simp]: "rev(xs@ys) = rev(ys) @ rev(xs)"
102.582 -by (induct_tac "xs" rule: list_induct, auto)
102.583 +by (induct xs rule: list_induct) auto
102.584
102.585 lemma rev_rev_ident [simp]: "rev(rev l) = l"
102.586 -by (induct_tac "l" rule: list_induct, auto)
102.587 +by (induct l rule: list_induct) auto
102.588
102.589 lemma rev_flat: "rev(flat ls) = flat (map rev (rev ls))"
102.590 -by (induct_tac "ls" rule: list_induct, auto)
102.591 +by (induct ls rule: list_induct) auto
102.592
102.593 lemma rev_map_distrib: "rev(map f l) = map f (rev l)"
102.594 -by (induct_tac "l" rule: list_induct, auto)
102.595 +by (induct l rule: list_induct) auto
102.596
102.597 lemma foldl_rev: "foldl f b (rev l) = foldr (%x y. f y x) b l"
102.598 -by (induct_tac "l" rule: list_induct, auto)
102.599 +by (induct l rule: list_induct) auto
102.600
102.601 lemma foldr_rev: "foldr f b (rev l) = foldl (%x y. f y x) b l"
102.602 apply (rule sym)
102.603 apply (rule trans)
102.604 -apply (rule_tac [2] foldl_rev, simp)
102.605 +apply (rule_tac [2] foldl_rev)
102.606 +apply simp
102.607 done
102.608
102.609 end
103.1 --- a/src/HOL/Int.thy Wed Mar 04 10:43:39 2009 +0100
103.2 +++ b/src/HOL/Int.thy Wed Mar 04 10:45:52 2009 +0100
103.3 @@ -77,7 +77,7 @@
103.4 by (simp add: intrel_def)
103.5
103.6 lemma equiv_intrel: "equiv UNIV intrel"
103.7 -by (simp add: intrel_def equiv_def refl_def sym_def trans_def)
103.8 +by (simp add: intrel_def equiv_def refl_on_def sym_def trans_def)
103.9
103.10 text{*Reduces equality of equivalence classes to the @{term intrel} relation:
103.11 @{term "(intrel `` {x} = intrel `` {y}) = ((x,y) \<in> intrel)"} *}
103.12 @@ -832,8 +832,8 @@
103.13 le_imp_0_less [THEN order_less_imp_le])
103.14 next
103.15 case (neg n)
103.16 - thus ?thesis by (simp del: of_nat_Suc of_nat_add
103.17 - add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
103.18 + thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
103.19 + add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
103.20 qed
103.21
103.22 lemma bin_less_0_simps:
103.23 @@ -1165,8 +1165,8 @@
103.24 le_imp_0_less [THEN order_less_imp_le])
103.25 next
103.26 case (neg n)
103.27 - thus ?thesis by (simp del: of_nat_Suc of_nat_add
103.28 - add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
103.29 + thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
103.30 + add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
103.31 qed
103.32
103.33 text {* Less-Than or Equals *}
103.34 @@ -1547,7 +1547,7 @@
103.35 "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
103.36 by (simp add: power_abs)
103.37
103.38 -lemma of_int_number_of_eq:
103.39 +lemma of_int_number_of_eq [simp]:
103.40 "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
103.41 by (simp add: number_of_eq)
103.42
103.43 @@ -1785,11 +1785,12 @@
103.44 lemma int_val_lemma:
103.45 "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->
103.46 f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
103.47 +unfolding One_nat_def
103.48 apply (induct n, simp)
103.49 apply (intro strip)
103.50 apply (erule impE, simp)
103.51 apply (erule_tac x = n in allE, simp)
103.52 -apply (case_tac "k = f (n+1) ")
103.53 +apply (case_tac "k = f (Suc n)")
103.54 apply force
103.55 apply (erule impE)
103.56 apply (simp add: abs_if split add: split_if_asm)
103.57 @@ -1803,6 +1804,7 @@
103.58 f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
103.59 apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k
103.60 in int_val_lemma)
103.61 +unfolding One_nat_def
103.62 apply simp
103.63 apply (erule exE)
103.64 apply (rule_tac x = "i+m" in exI, arith)
104.1 --- a/src/HOL/IntDiv.thy Wed Mar 04 10:43:39 2009 +0100
104.2 +++ b/src/HOL/IntDiv.thy Wed Mar 04 10:45:52 2009 +0100
104.3 @@ -547,34 +547,6 @@
104.4 simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
104.5 {* K (divmod_proc (@{thm divmod_rel_mod_eq})) *}
104.6
104.7 -(* The following 8 lemmas are made unnecessary by the above simprocs: *)
104.8 -
104.9 -lemmas div_pos_pos_number_of =
104.10 - div_pos_pos [of "number_of v" "number_of w", standard]
104.11 -
104.12 -lemmas div_neg_pos_number_of =
104.13 - div_neg_pos [of "number_of v" "number_of w", standard]
104.14 -
104.15 -lemmas div_pos_neg_number_of =
104.16 - div_pos_neg [of "number_of v" "number_of w", standard]
104.17 -
104.18 -lemmas div_neg_neg_number_of =
104.19 - div_neg_neg [of "number_of v" "number_of w", standard]
104.20 -
104.21 -
104.22 -lemmas mod_pos_pos_number_of =
104.23 - mod_pos_pos [of "number_of v" "number_of w", standard]
104.24 -
104.25 -lemmas mod_neg_pos_number_of =
104.26 - mod_neg_pos [of "number_of v" "number_of w", standard]
104.27 -
104.28 -lemmas mod_pos_neg_number_of =
104.29 - mod_pos_neg [of "number_of v" "number_of w", standard]
104.30 -
104.31 -lemmas mod_neg_neg_number_of =
104.32 - mod_neg_neg [of "number_of v" "number_of w", standard]
104.33 -
104.34 -
104.35 lemmas posDivAlg_eqn_number_of [simp] =
104.36 posDivAlg_eqn [of "number_of v" "number_of w", standard]
104.37
104.38 @@ -584,15 +556,6 @@
104.39
104.40 text{*Special-case simplification *}
104.41
104.42 -lemma zmod_1 [simp]: "a mod (1::int) = 0"
104.43 -apply (cut_tac a = a and b = 1 in pos_mod_sign)
104.44 -apply (cut_tac [2] a = a and b = 1 in pos_mod_bound)
104.45 -apply (auto simp del:pos_mod_bound pos_mod_sign)
104.46 -done
104.47 -
104.48 -lemma zdiv_1 [simp]: "a div (1::int) = a"
104.49 -by (cut_tac a = a and b = 1 in zmod_zdiv_equality, auto)
104.50 -
104.51 lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0"
104.52 apply (cut_tac a = a and b = "-1" in neg_mod_sign)
104.53 apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound)
104.54 @@ -726,9 +689,6 @@
104.55 apply (blast intro: divmod_rel_div_mod [THEN zmult1_lemma, THEN divmod_rel_mod])
104.56 done
104.57
104.58 -lemma zdiv_zmult_self1 [simp]: "b \<noteq> (0::int) ==> (a*b) div b = a"
104.59 -by (simp add: zdiv_zmult1_eq)
104.60 -
104.61 lemma zmod_zdiv_trivial: "(a mod b) div b = (0::int)"
104.62 apply (case_tac "b = 0", simp)
104.63 apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial)
104.64 @@ -754,7 +714,7 @@
104.65 assume not0: "b \<noteq> 0"
104.66 show "(a + c * b) div b = c + a div b"
104.67 unfolding zdiv_zadd1_eq [of a "c * b"] using not0
104.68 - by (simp add: zmod_zmult1_eq zmod_zdiv_trivial)
104.69 + by (simp add: zmod_zmult1_eq zmod_zdiv_trivial zdiv_zmult1_eq)
104.70 qed auto
104.71
104.72 lemma posDivAlg_div_mod:
104.73 @@ -784,41 +744,12 @@
104.74 show ?thesis by simp
104.75 qed
104.76
104.77 -lemma zdiv_zadd_self1: "a \<noteq> (0::int) ==> (a+b) div a = b div a + 1"
104.78 -by (rule div_add_self1) (* already declared [simp] *)
104.79 -
104.80 -lemma zdiv_zadd_self2: "a \<noteq> (0::int) ==> (b+a) div a = b div a + 1"
104.81 -by (rule div_add_self2) (* already declared [simp] *)
104.82 -
104.83 -lemma zdiv_zmult_self2: "b \<noteq> (0::int) ==> (b*a) div b = a"
104.84 -by (rule div_mult_self1_is_id) (* already declared [simp] *)
104.85 -
104.86 -lemma zmod_zmult_self1: "(a*b) mod b = (0::int)"
104.87 -by (rule mod_mult_self2_is_0) (* already declared [simp] *)
104.88 -
104.89 -lemma zmod_zmult_self2: "(b*a) mod b = (0::int)"
104.90 -by (rule mod_mult_self1_is_0) (* already declared [simp] *)
104.91 -
104.92 lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)"
104.93 by (simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def)
104.94
104.95 (* REVISIT: should this be generalized to all semiring_div types? *)
104.96 lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
104.97
104.98 -lemma zmod_zadd_left_eq: "(a+b) mod (c::int) = ((a mod c) + b) mod c"
104.99 -by (rule mod_add_left_eq)
104.100 -
104.101 -lemma zmod_zadd_right_eq: "(a+b) mod (c::int) = (a + (b mod c)) mod c"
104.102 -by (rule mod_add_right_eq)
104.103 -
104.104 -lemma zmod_zadd_self1: "(a+b) mod a = b mod (a::int)"
104.105 -by (rule mod_add_self1) (* already declared [simp] *)
104.106 -
104.107 -lemma zmod_zadd_self2: "(b+a) mod a = b mod (a::int)"
104.108 -by (rule mod_add_self2) (* already declared [simp] *)
104.109 -
104.110 -lemma zmod_zdiff1_eq: "(a - b) mod c = (a mod c - b mod c) mod (c::int)"
104.111 -by (rule mod_diff_eq)
104.112
104.113 subsection{*Proving @{term "a div (b*c) = (a div b) div c"} *}
104.114
104.115 @@ -902,13 +833,6 @@
104.116 "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)"
104.117 by (simp add:zdiv_zmult_zmult1)
104.118
104.119 -(*
104.120 -lemma zdiv_zmult_zmult2: "c \<noteq> (0::int) ==> (a*c) div (b*c) = a div b"
104.121 -apply (drule zdiv_zmult_zmult1)
104.122 -apply (auto simp add: mult_commute)
104.123 -done
104.124 -*)
104.125 -
104.126
104.127 subsection{*Distribution of Factors over mod*}
104.128
104.129 @@ -933,9 +857,6 @@
104.130 apply (auto simp add: mult_commute)
104.131 done
104.132
104.133 -lemma zmod_zmod_cancel: "n dvd m \<Longrightarrow> (k::int) mod m mod n = k mod n"
104.134 -by (rule mod_mod_cancel)
104.135 -
104.136
104.137 subsection {*Splitting Rules for div and mod*}
104.138
104.139 @@ -1070,7 +991,7 @@
104.140 apply (subgoal_tac "(1 + 2* (-b - 1)) mod (2* (-a)) =
104.141 1 + 2* ((-b - 1) mod (-a))")
104.142 apply (rule_tac [2] pos_zmod_mult_2)
104.143 -apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
104.144 +apply (auto simp add: right_diff_distrib)
104.145 apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
104.146 prefer 2 apply simp
104.147 apply (simp only: zmod_zminus_zminus diff_minus minus_add_distrib [symmetric])
104.148 @@ -1132,38 +1053,8 @@
104.149
104.150 subsection {* The Divides Relation *}
104.151
104.152 -lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
104.153 - by (rule dvd_eq_mod_eq_0)
104.154 -
104.155 lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
104.156 - zdvd_iff_zmod_eq_0 [of "number_of x" "number_of y", standard]
104.157 -
104.158 -lemma zdvd_0_right: "(m::int) dvd 0"
104.159 - by (rule dvd_0_right) (* already declared [iff] *)
104.160 -
104.161 -lemma zdvd_0_left: "(0 dvd (m::int)) = (m = 0)"
104.162 - by (rule dvd_0_left_iff) (* already declared [noatp,simp] *)
104.163 -
104.164 -lemma zdvd_1_left: "1 dvd (m::int)"
104.165 - by (rule one_dvd) (* already declared [simp] *)
104.166 -
104.167 -lemma zdvd_refl: "m dvd (m::int)"
104.168 - by (rule dvd_refl) (* already declared [simp] *)
104.169 -
104.170 -lemma zdvd_trans: "m dvd n ==> n dvd k ==> m dvd (k::int)"
104.171 - by (rule dvd_trans)
104.172 -
104.173 -lemma zdvd_zminus_iff: "m dvd -n \<longleftrightarrow> m dvd (n::int)"
104.174 - by (rule dvd_minus_iff) (* already declared [simp] *)
104.175 -
104.176 -lemma zdvd_zminus2_iff: "-m dvd n \<longleftrightarrow> m dvd (n::int)"
104.177 - by (rule minus_dvd_iff) (* already declared [simp] *)
104.178 -
104.179 -lemma zdvd_abs1: "( \<bar>i::int\<bar> dvd j) = (i dvd j)"
104.180 - by (rule abs_dvd_iff) (* already declared [simp] *)
104.181 -
104.182 -lemma zdvd_abs2: "( (i::int) dvd \<bar>j\<bar>) = (i dvd j)"
104.183 - by (rule dvd_abs_iff) (* already declared [simp] *)
104.184 + dvd_eq_mod_eq_0 [of "number_of x::int" "number_of y::int", standard]
104.185
104.186 lemma zdvd_anti_sym:
104.187 "0 < m ==> 0 < n ==> m dvd n ==> n dvd m ==> m = (n::int)"
104.188 @@ -1171,58 +1062,32 @@
104.189 apply (simp add: mult_assoc zero_less_mult_iff zmult_eq_1_iff)
104.190 done
104.191
104.192 -lemma zdvd_zadd: "k dvd m ==> k dvd n ==> k dvd (m + n :: int)"
104.193 - by (rule dvd_add)
104.194 -
104.195 -lemma zdvd_dvd_eq: assumes anz:"a \<noteq> 0" and ab: "(a::int) dvd b" and ba:"b dvd a"
104.196 +lemma zdvd_dvd_eq: assumes "a \<noteq> 0" and "(a::int) dvd b" and "b dvd a"
104.197 shows "\<bar>a\<bar> = \<bar>b\<bar>"
104.198 proof-
104.199 - from ab obtain k where k:"b = a*k" unfolding dvd_def by blast
104.200 - from ba obtain k' where k':"a = b*k'" unfolding dvd_def by blast
104.201 + from `a dvd b` obtain k where k:"b = a*k" unfolding dvd_def by blast
104.202 + from `b dvd a` obtain k' where k':"a = b*k'" unfolding dvd_def by blast
104.203 from k k' have "a = a*k*k'" by simp
104.204 with mult_cancel_left1[where c="a" and b="k*k'"]
104.205 - have kk':"k*k' = 1" using anz by (simp add: mult_assoc)
104.206 + have kk':"k*k' = 1" using `a\<noteq>0` by (simp add: mult_assoc)
104.207 hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
104.208 thus ?thesis using k k' by auto
104.209 qed
104.210
104.211 -lemma zdvd_zdiff: "k dvd m ==> k dvd n ==> k dvd (m - n :: int)"
104.212 - by (rule Ring_and_Field.dvd_diff)
104.213 -
104.214 lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
104.215 apply (subgoal_tac "m = n + (m - n)")
104.216 apply (erule ssubst)
104.217 - apply (blast intro: zdvd_zadd, simp)
104.218 + apply (blast intro: dvd_add, simp)
104.219 done
104.220
104.221 -lemma zdvd_zmult: "k dvd (n::int) ==> k dvd m * n"
104.222 - by (rule dvd_mult)
104.223 -
104.224 -lemma zdvd_zmult2: "k dvd (m::int) ==> k dvd m * n"
104.225 - by (rule dvd_mult2)
104.226 -
104.227 -lemma zdvd_triv_right: "(k::int) dvd m * k"
104.228 - by (rule dvd_triv_right) (* already declared [simp] *)
104.229 -
104.230 -lemma zdvd_triv_left: "(k::int) dvd k * m"
104.231 - by (rule dvd_triv_left) (* already declared [simp] *)
104.232 -
104.233 -lemma zdvd_zmultD2: "j * k dvd n ==> j dvd (n::int)"
104.234 - by (rule dvd_mult_left)
104.235 -
104.236 -lemma zdvd_zmultD: "j * k dvd n ==> k dvd (n::int)"
104.237 - by (rule dvd_mult_right)
104.238 -
104.239 -lemma zdvd_zmult_mono: "i dvd m ==> j dvd (n::int) ==> i * j dvd m * n"
104.240 - by (rule mult_dvd_mono)
104.241 -
104.242 lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
104.243 - apply (rule iffI)
104.244 - apply (erule_tac [2] zdvd_zadd)
104.245 - apply (subgoal_tac "n = (n + k * m) - k * m")
104.246 - apply (erule ssubst)
104.247 - apply (erule zdvd_zdiff, simp_all)
104.248 - done
104.249 +apply (rule iffI)
104.250 + apply (erule_tac [2] dvd_add)
104.251 + apply (subgoal_tac "n = (n + k * m) - k * m")
104.252 + apply (erule ssubst)
104.253 + apply (erule dvd_diff)
104.254 + apply(simp_all)
104.255 +done
104.256
104.257 lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
104.258 apply (simp add: dvd_def)
104.259 @@ -1232,7 +1097,7 @@
104.260 lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
104.261 apply (subgoal_tac "k dvd n * (m div n) + m mod n")
104.262 apply (simp add: zmod_zdiv_equality [symmetric])
104.263 - apply (simp only: zdvd_zadd zdvd_zmult2)
104.264 + apply (simp only: dvd_add dvd_mult2)
104.265 done
104.266
104.267 lemma zdvd_not_zless: "0 < m ==> m < n ==> \<not> n dvd (m::int)"
104.268 @@ -1252,7 +1117,7 @@
104.269 lemma zdvd_mult_div_cancel:"(n::int) dvd m \<Longrightarrow> n * (m div n) = m"
104.270 apply (subgoal_tac "m mod n = 0")
104.271 apply (simp add: zmult_div_cancel)
104.272 -apply (simp only: zdvd_iff_zmod_eq_0)
104.273 +apply (simp only: dvd_eq_mod_eq_0)
104.274 done
104.275
104.276 lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
104.277 @@ -1265,10 +1130,6 @@
104.278 thus ?thesis by simp
104.279 qed
104.280
104.281 -lemma zdvd_zmult_cancel_disj[simp]:
104.282 - "(k*m) dvd (k*n) = (k=0 | m dvd (n::int))"
104.283 -by (auto simp: zdvd_zmult_mono dest: zdvd_mult_cancel)
104.284 -
104.285
104.286 theorem ex_nat: "(\<exists>x::nat. P x) = (\<exists>x::int. 0 <= x \<and> P (nat x))"
104.287 apply (simp split add: split_nat)
104.288 @@ -1300,44 +1161,38 @@
104.289 then show ?thesis by (simp only: negative_eq_positive) auto
104.290 qed
104.291 qed
104.292 - then show ?thesis by (auto elim!: dvdE simp only: zdvd_triv_left int_mult)
104.293 + then show ?thesis by (auto elim!: dvdE simp only: dvd_triv_left int_mult)
104.294 qed
104.295
104.296 lemma zdvd1_eq[simp]: "(x::int) dvd 1 = ( \<bar>x\<bar> = 1)"
104.297 proof
104.298 - assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by (simp add: zdvd_abs1)
104.299 + assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by simp
104.300 hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
104.301 hence "nat \<bar>x\<bar> = 1" by simp
104.302 thus "\<bar>x\<bar> = 1" by (cases "x < 0", auto)
104.303 next
104.304 assume "\<bar>x\<bar>=1" thus "x dvd 1"
104.305 - by(cases "x < 0",simp_all add: minus_equation_iff zdvd_iff_zmod_eq_0)
104.306 + by(cases "x < 0",simp_all add: minus_equation_iff dvd_eq_mod_eq_0)
104.307 qed
104.308 lemma zdvd_mult_cancel1:
104.309 assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
104.310 proof
104.311 assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m"
104.312 - by (cases "n >0", auto simp add: zdvd_zminus2_iff minus_equation_iff)
104.313 + by (cases "n >0", auto simp add: minus_dvd_iff minus_equation_iff)
104.314 next
104.315 assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
104.316 from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
104.317 qed
104.318
104.319 lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
104.320 - unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus_iff)
104.321 + unfolding zdvd_int by (cases "z \<ge> 0") simp_all
104.322
104.323 lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
104.324 - unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus2_iff)
104.325 + unfolding zdvd_int by (cases "z \<ge> 0") simp_all
104.326
104.327 lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
104.328 by (auto simp add: dvd_int_iff)
104.329
104.330 -lemma zminus_dvd_iff [iff]: "(-z dvd w) = (z dvd (w::int))"
104.331 - by (rule minus_dvd_iff)
104.332 -
104.333 -lemma dvd_zminus_iff [iff]: "(z dvd -w) = (z dvd (w::int))"
104.334 - by (rule dvd_minus_iff)
104.335 -
104.336 lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
104.337 apply (rule_tac z=n in int_cases)
104.338 apply (auto simp add: dvd_int_iff)
104.339 @@ -1367,10 +1222,13 @@
104.340 apply (auto simp add: IntDiv.divmod_rel_def of_nat_mult)
104.341 done
104.342
104.343 +lemma abs_div: "(y::int) dvd x \<Longrightarrow> abs (x div y) = abs x div abs y"
104.344 +by (unfold dvd_def, cases "y=0", auto simp add: abs_mult)
104.345 +
104.346 text{*Suggested by Matthias Daum*}
104.347 lemma int_power_div_base:
104.348 "\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)"
104.349 -apply (subgoal_tac "k ^ m = k ^ ((m - 1) + 1)")
104.350 +apply (subgoal_tac "k ^ m = k ^ ((m - Suc 0) + Suc 0)")
104.351 apply (erule ssubst)
104.352 apply (simp only: power_add)
104.353 apply simp_all
104.354 @@ -1387,8 +1245,8 @@
104.355 by (rule mod_diff_right_eq [symmetric])
104.356
104.357 lemmas zmod_simps =
104.358 - IntDiv.zmod_zadd_left_eq [symmetric]
104.359 - IntDiv.zmod_zadd_right_eq [symmetric]
104.360 + mod_add_left_eq [symmetric]
104.361 + mod_add_right_eq [symmetric]
104.362 IntDiv.zmod_zmult1_eq [symmetric]
104.363 mod_mult_left_eq [symmetric]
104.364 IntDiv.zpower_zmod
104.365 @@ -1463,14 +1321,14 @@
104.366 assume H: "x mod n = y mod n"
104.367 hence "x mod n - y mod n = 0" by simp
104.368 hence "(x mod n - y mod n) mod n = 0" by simp
104.369 - hence "(x - y) mod n = 0" by (simp add: zmod_zdiff1_eq[symmetric])
104.370 - thus "n dvd x - y" by (simp add: zdvd_iff_zmod_eq_0)
104.371 + hence "(x - y) mod n = 0" by (simp add: mod_diff_eq[symmetric])
104.372 + thus "n dvd x - y" by (simp add: dvd_eq_mod_eq_0)
104.373 next
104.374 assume H: "n dvd x - y"
104.375 then obtain k where k: "x-y = n*k" unfolding dvd_def by blast
104.376 hence "x = n*k + y" by simp
104.377 hence "x mod n = (n*k + y) mod n" by simp
104.378 - thus "x mod n = y mod n" by (simp add: zmod_zadd_left_eq)
104.379 + thus "x mod n = y mod n" by (simp add: mod_add_left_eq)
104.380 qed
104.381
104.382 lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y mod n" and xy:"y \<le> x"
105.1 --- a/src/HOL/Integration.thy Wed Mar 04 10:43:39 2009 +0100
105.2 +++ b/src/HOL/Integration.thy Wed Mar 04 10:45:52 2009 +0100
105.3 @@ -134,7 +134,7 @@
105.4 apply (frule partition [THEN iffD1], safe)
105.5 apply (drule_tac x = "psize D" and P="%n. psize D \<le> n --> ?P n" in spec, safe)
105.6 apply (case_tac "psize D = 0")
105.7 -apply (drule_tac [2] n = "psize D - 1" in partition_lt, auto)
105.8 +apply (drule_tac [2] n = "psize D - Suc 0" in partition_lt, auto)
105.9 done
105.10
105.11 lemma partition_gt: "[|partition(a,b) D; n < (psize D)|] ==> D(n) < D(psize D)"
105.12 @@ -145,7 +145,7 @@
105.13 apply (rotate_tac 2)
105.14 apply (drule_tac x = "psize D" in spec)
105.15 apply (rule ccontr)
105.16 -apply (drule_tac n = "psize D - 1" in partition_lt)
105.17 +apply (drule_tac n = "psize D - Suc 0" in partition_lt)
105.18 apply auto
105.19 done
105.20
106.1 --- a/src/HOL/IsaMakefile Wed Mar 04 10:43:39 2009 +0100
106.2 +++ b/src/HOL/IsaMakefile Wed Mar 04 10:45:52 2009 +0100
106.3 @@ -13,7 +13,6 @@
106.4 HOL-Library \
106.5 HOL-ex \
106.6 HOL-Auth \
106.7 - HOL-AxClasses \
106.8 HOL-Bali \
106.9 HOL-Decision_Procs \
106.10 HOL-Extraction \
106.11 @@ -79,38 +78,39 @@
106.12 $(OUT)/Pure: Pure
106.13
106.14 BASE_DEPENDENCIES = $(OUT)/Pure \
106.15 + $(SRC)/Provers/blast.ML \
106.16 + $(SRC)/Provers/clasimp.ML \
106.17 + $(SRC)/Provers/classical.ML \
106.18 + $(SRC)/Provers/hypsubst.ML \
106.19 + $(SRC)/Provers/quantifier1.ML \
106.20 + $(SRC)/Provers/splitter.ML \
106.21 + $(SRC)/Tools/IsaPlanner/isand.ML \
106.22 + $(SRC)/Tools/IsaPlanner/rw_inst.ML \
106.23 + $(SRC)/Tools/IsaPlanner/rw_tools.ML \
106.24 + $(SRC)/Tools/IsaPlanner/zipper.ML \
106.25 + $(SRC)/Tools/atomize_elim.ML \
106.26 + $(SRC)/Tools/code/code_funcgr.ML \
106.27 + $(SRC)/Tools/code/code_haskell.ML \
106.28 + $(SRC)/Tools/code/code_ml.ML \
106.29 + $(SRC)/Tools/code/code_name.ML \
106.30 + $(SRC)/Tools/code/code_printer.ML \
106.31 + $(SRC)/Tools/code/code_target.ML \
106.32 + $(SRC)/Tools/code/code_thingol.ML \
106.33 + $(SRC)/Tools/code/code_wellsorted.ML \
106.34 + $(SRC)/Tools/coherent.ML \
106.35 + $(SRC)/Tools/eqsubst.ML \
106.36 + $(SRC)/Tools/induct.ML \
106.37 + $(SRC)/Tools/intuitionistic.ML \
106.38 + $(SRC)/Tools/induct_tacs.ML \
106.39 + $(SRC)/Tools/nbe.ML \
106.40 + $(SRC)/Tools/project_rule.ML \
106.41 + $(SRC)/Tools/random_word.ML \
106.42 + $(SRC)/Tools/value.ML \
106.43 Code_Setup.thy \
106.44 HOL.thy \
106.45 Tools/hologic.ML \
106.46 Tools/recfun_codegen.ML \
106.47 Tools/simpdata.ML \
106.48 - $(SRC)/Tools/atomize_elim.ML \
106.49 - $(SRC)/Tools/code/code_funcgr.ML \
106.50 - $(SRC)/Tools/code/code_funcgr.ML \
106.51 - $(SRC)/Tools/code/code_name.ML \
106.52 - $(SRC)/Tools/code/code_printer.ML \
106.53 - $(SRC)/Tools/code/code_target.ML \
106.54 - $(SRC)/Tools/code/code_ml.ML \
106.55 - $(SRC)/Tools/code/code_haskell.ML \
106.56 - $(SRC)/Tools/code/code_thingol.ML \
106.57 - $(SRC)/Tools/induct.ML \
106.58 - $(SRC)/Tools/induct_tacs.ML \
106.59 - $(SRC)/Tools/IsaPlanner/isand.ML \
106.60 - $(SRC)/Tools/IsaPlanner/rw_inst.ML \
106.61 - $(SRC)/Tools/IsaPlanner/rw_tools.ML \
106.62 - $(SRC)/Tools/IsaPlanner/zipper.ML \
106.63 - $(SRC)/Tools/nbe.ML \
106.64 - $(SRC)/Tools/random_word.ML \
106.65 - $(SRC)/Tools/value.ML \
106.66 - $(SRC)/Provers/blast.ML \
106.67 - $(SRC)/Provers/clasimp.ML \
106.68 - $(SRC)/Provers/classical.ML \
106.69 - $(SRC)/Provers/coherent.ML \
106.70 - $(SRC)/Provers/eqsubst.ML \
106.71 - $(SRC)/Provers/hypsubst.ML \
106.72 - $(SRC)/Provers/project_rule.ML \
106.73 - $(SRC)/Provers/quantifier1.ML \
106.74 - $(SRC)/Provers/splitter.ML \
106.75
106.76 $(OUT)/HOL-Base: base.ML $(BASE_DEPENDENCIES)
106.77 @$(ISABELLE_TOOL) usedir -b -f base.ML -d false -g false $(OUT)/Pure HOL-Base
106.78 @@ -267,11 +267,11 @@
106.79 @$(ISABELLE_TOOL) usedir -b -f main.ML -g true $(OUT)/Pure HOL-Main
106.80
106.81 $(OUT)/HOL: ROOT.ML $(MAIN_DEPENDENCIES) \
106.82 + Archimedean_Field.thy \
106.83 Complex_Main.thy \
106.84 Complex.thy \
106.85 Deriv.thy \
106.86 Fact.thy \
106.87 - FrechetDeriv.thy \
106.88 Integration.thy \
106.89 Lim.thy \
106.90 Ln.thy \
106.91 @@ -285,7 +285,6 @@
106.92 GCD.thy \
106.93 Parity.thy \
106.94 Lubs.thy \
106.95 - Polynomial.thy \
106.96 PReal.thy \
106.97 Rational.thy \
106.98 RComplete.thy \
106.99 @@ -314,8 +313,11 @@
106.100 Library/Euclidean_Space.thy Library/Glbs.thy Library/normarith.ML \
106.101 Library/Executable_Set.thy Library/Infinite_Set.thy \
106.102 Library/FuncSet.thy Library/Permutations.thy Library/Determinants.thy\
106.103 + Library/Bit.thy \
106.104 Library/Finite_Cartesian_Product.thy \
106.105 + Library/FrechetDeriv.thy \
106.106 Library/Fundamental_Theorem_Algebra.thy \
106.107 + Library/Inner_Product.thy \
106.108 Library/Library.thy Library/List_Prefix.thy Library/State_Monad.thy \
106.109 Library/Nat_Int_Bij.thy Library/Multiset.thy Library/Permutation.thy \
106.110 Library/Primes.thy Library/Pocklington.thy Library/Quotient.thy \
106.111 @@ -336,6 +338,10 @@
106.112 Library/Boolean_Algebra.thy Library/Countable.thy \
106.113 Library/RBT.thy Library/Univ_Poly.thy \
106.114 Library/Random.thy Library/Quickcheck.thy \
106.115 + Library/Poly_Deriv.thy \
106.116 + Library/Polynomial.thy \
106.117 + Library/Product_plus.thy \
106.118 + Library/Product_Vector.thy \
106.119 Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML $(SRC)/HOL/Tools/float_arith.ML \
106.120 Library/reify_data.ML Library/reflection.ML
106.121 @cd Library; $(ISABELLE_TOOL) usedir $(OUT)/HOL Library
106.122 @@ -790,15 +796,6 @@
106.123 @$(ISABELLE_TOOL) usedir $(OUT)/HOL IOA
106.124
106.125
106.126 -## HOL-AxClasses
106.127 -
106.128 -HOL-AxClasses: HOL $(LOG)/HOL-AxClasses.gz
106.129 -
106.130 -$(LOG)/HOL-AxClasses.gz: $(OUT)/HOL AxClasses/Group.thy \
106.131 - AxClasses/Product.thy AxClasses/ROOT.ML AxClasses/Semigroups.thy
106.132 - @$(ISABELLE_TOOL) usedir $(OUT)/HOL AxClasses
106.133 -
106.134 -
106.135 ## HOL-Lattice
106.136
106.137 HOL-Lattice: HOL $(LOG)/HOL-Lattice.gz
106.138 @@ -814,34 +811,31 @@
106.139 HOL-ex: HOL $(LOG)/HOL-ex.gz
106.140
106.141 $(LOG)/HOL-ex.gz: $(OUT)/HOL Library/Commutative_Ring.thy \
106.142 - Library/Primes.thy \
106.143 - ex/Abstract_NAT.thy ex/Antiquote.thy ex/Arith_Examples.thy ex/BT.thy \
106.144 - ex/BinEx.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy \
106.145 - ex/Coherent.thy ex/Dense_Linear_Order_Ex.thy ex/Eval_Examples.thy \
106.146 - ex/Groebner_Examples.thy ex/Quickcheck_Generators.thy \
106.147 - ex/Codegenerator.thy ex/Codegenerator_Pretty.thy \
106.148 - ex/CodegenSML_Test.thy ex/Formal_Power_Series_Examples.thy \
106.149 - ex/Commutative_RingEx.thy ex/Efficient_Nat_examples.thy \
106.150 - ex/Hex_Bin_Examples.thy ex/Commutative_Ring_Complete.thy \
106.151 - ex/ExecutableContent.thy ex/Fundefs.thy ex/Guess.thy ex/Hebrew.thy \
106.152 - ex/Binary.thy ex/Higher_Order_Logic.thy ex/Hilbert_Classical.thy \
106.153 + Library/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy \
106.154 + ex/ApproximationEx.thy ex/Arith_Examples.thy \
106.155 + ex/Arithmetic_Series_Complex.thy ex/BT.thy ex/BinEx.thy \
106.156 + ex/Binary.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy \
106.157 + ex/CodegenSML_Test.thy ex/Codegenerator.thy \
106.158 + ex/Codegenerator_Pretty.thy ex/Coherent.thy \
106.159 + ex/Commutative_RingEx.thy ex/Commutative_Ring_Complete.thy \
106.160 + ex/Dense_Linear_Order_Ex.thy ex/Efficient_Nat_examples.thy \
106.161 + ex/Eval_Examples.thy ex/ExecutableContent.thy \
106.162 + ex/Formal_Power_Series_Examples.thy ex/Fundefs.thy \
106.163 + ex/Groebner_Examples.thy ex/Guess.thy ex/HarmonicSeries.thy \
106.164 + ex/Hebrew.thy ex/Hex_Bin_Examples.thy ex/Higher_Order_Logic.thy \
106.165 + ex/Hilbert_Classical.thy ex/ImperativeQuicksort.thy \
106.166 ex/Induction_Scheme.thy ex/InductiveInvariant.thy \
106.167 ex/InductiveInvariant_examples.thy ex/Intuitionistic.thy \
106.168 - ex/Lagrange.thy ex/LocaleTest2.thy ex/MT.thy \
106.169 - ex/MergeSort.thy ex/MonoidGroup.thy ex/Multiquote.thy ex/NatSum.thy \
106.170 + ex/Lagrange.thy ex/LocaleTest2.thy ex/MT.thy ex/MergeSort.thy \
106.171 + ex/Meson_Test.thy ex/MonoidGroup.thy ex/Multiquote.thy ex/NatSum.thy \
106.172 ex/Numeral.thy ex/PER.thy ex/PresburgerEx.thy ex/Primrec.thy \
106.173 - ex/Quickcheck_Examples.thy \
106.174 - ex/ReflectionEx.thy ex/ROOT.ML ex/Recdefs.thy ex/Records.thy \
106.175 + ex/Quickcheck_Examples.thy ex/Quickcheck_Generators.thy ex/ROOT.ML \
106.176 + ex/Recdefs.thy ex/Records.thy ex/ReflectionEx.thy \
106.177 ex/Refute_Examples.thy ex/SAT_Examples.thy ex/SVC_Oracle.thy \
106.178 - ex/Subarray.thy ex/Sublist.thy \
106.179 - ex/Sudoku.thy ex/Tarski.thy ex/Termination.thy ex/Term_Of_Syntax.thy \
106.180 - ex/Unification.thy ex/document/root.bib \
106.181 - ex/document/root.tex ex/Meson_Test.thy ex/set.thy \
106.182 - ex/svc_funcs.ML ex/svc_test.thy \
106.183 - ex/ImperativeQuicksort.thy \
106.184 - ex/Arithmetic_Series_Complex.thy ex/HarmonicSeries.thy \
106.185 - ex/Sqrt.thy ex/Sqrt_Script.thy \
106.186 - ex/ApproximationEx.thy
106.187 + ex/Serbian.thy ex/Sqrt.thy ex/Sqrt_Script.thy ex/Subarray.thy \
106.188 + ex/Sublist.thy ex/Sudoku.thy ex/Tarski.thy ex/Term_Of_Syntax.thy \
106.189 + ex/Termination.thy ex/Unification.thy ex/document/root.bib \
106.190 + ex/document/root.tex ex/set.thy ex/svc_funcs.ML ex/svc_test.thy
106.191 @$(ISABELLE_TOOL) usedir $(OUT)/HOL ex
106.192
106.193
106.194 @@ -1062,22 +1056,22 @@
106.195 ## clean
106.196
106.197 clean:
106.198 - @rm -f $(OUT)/HOL-Plain $(OUT)/HOL-Main $(OUT)/HOL $(OUT)/HOL-Nominal $(OUT)/TLA \
106.199 - $(LOG)/HOL.gz $(LOG)/TLA.gz \
106.200 - $(LOG)/HOL-Isar_examples.gz $(LOG)/HOL-Induct.gz \
106.201 - $(LOG)/HOL-ex.gz $(LOG)/HOL-Subst.gz $(LOG)/HOL-IMP.gz \
106.202 - $(LOG)/HOL-IMPP.gz $(LOG)/HOL-Hoare.gz \
106.203 - $(LOG)/HOL-HoareParallel.gz \
106.204 - $(LOG)/HOL-Lex.gz $(LOG)/HOL-Algebra.gz \
106.205 - $(LOG)/HOL-Auth.gz $(LOG)/HOL-UNITY.gz \
106.206 - $(LOG)/HOL-Modelcheck.gz $(LOG)/HOL-Lambda.gz \
106.207 - $(LOG)/HOL-Bali.gz \
106.208 - $(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz \
106.209 - $(LOG)/HOL-Nominal-Examples.gz \
106.210 - $(LOG)/HOL-IOA.gz $(LOG)/HOL-AxClasses \
106.211 - $(LOG)/HOL-Lattice $(LOG)/HOL-Matrix \
106.212 - $(LOG)/HOL-HahnBanach.gz $(LOG)/HOL-SET-Protocol.gz \
106.213 - $(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz $(LOG)/TLA-Memory.gz \
106.214 - $(LOG)/HOL-Library.gz $(LOG)/HOL-Unix.gz \
106.215 - $(OUT)/HOL-Word $(LOG)/HOL-Word.gz $(LOG)/HOL-Word-Examples.gz \
106.216 - $(OUT)/HOL-NSA $(LOG)/HOL-NSA.gz $(LOG)/HOL-NSA-Examples.gz
106.217 + @rm -f $(OUT)/HOL-Plain $(OUT)/HOL-Main $(OUT)/HOL \
106.218 + $(OUT)/HOL-Nominal $(OUT)/TLA $(LOG)/HOL.gz \
106.219 + $(LOG)/TLA.gz $(LOG)/HOL-Isar_examples.gz \
106.220 + $(LOG)/HOL-Induct.gz $(LOG)/HOL-ex.gz \
106.221 + $(LOG)/HOL-Subst.gz $(LOG)/HOL-IMP.gz \
106.222 + $(LOG)/HOL-IMPP.gz $(LOG)/HOL-Hoare.gz \
106.223 + $(LOG)/HOL-HoareParallel.gz $(LOG)/HOL-Lex.gz \
106.224 + $(LOG)/HOL-Algebra.gz $(LOG)/HOL-Auth.gz \
106.225 + $(LOG)/HOL-UNITY.gz $(LOG)/HOL-Modelcheck.gz \
106.226 + $(LOG)/HOL-Lambda.gz $(LOG)/HOL-Bali.gz \
106.227 + $(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz \
106.228 + $(LOG)/HOL-Nominal-Examples.gz $(LOG)/HOL-IOA.gz \
106.229 + $(LOG)/HOL-Lattice $(LOG)/HOL-Matrix \
106.230 + $(LOG)/HOL-HahnBanach.gz $(LOG)/HOL-SET-Protocol.gz \
106.231 + $(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz \
106.232 + $(LOG)/TLA-Memory.gz $(LOG)/HOL-Library.gz \
106.233 + $(LOG)/HOL-Unix.gz $(OUT)/HOL-Word $(LOG)/HOL-Word.gz \
106.234 + $(LOG)/HOL-Word-Examples.gz $(OUT)/HOL-NSA \
106.235 + $(LOG)/HOL-NSA.gz $(LOG)/HOL-NSA-Examples.gz
107.1 --- a/src/HOL/Library/Abstract_Rat.thy Wed Mar 04 10:43:39 2009 +0100
107.2 +++ b/src/HOL/Library/Abstract_Rat.thy Wed Mar 04 10:45:52 2009 +0100
107.3 @@ -247,7 +247,7 @@
107.4 (of_int(n div d)::'a::{field, ring_char_0}) = of_int n / of_int d"
107.5 apply (frule of_int_div_aux [of d n, where ?'a = 'a])
107.6 apply simp
107.7 - apply (simp add: zdvd_iff_zmod_eq_0)
107.8 + apply (simp add: dvd_eq_mod_eq_0)
107.9 done
107.10
107.11
108.1 --- a/src/HOL/Library/Boolean_Algebra.thy Wed Mar 04 10:43:39 2009 +0100
108.2 +++ b/src/HOL/Library/Boolean_Algebra.thy Wed Mar 04 10:45:52 2009 +0100
108.3 @@ -223,7 +223,7 @@
108.4 lemma xor_left_self [simp]: "x \<oplus> (x \<oplus> y) = y"
108.5 by (simp only: xor_assoc [symmetric] xor_self xor_zero_left)
108.6
108.7 -lemma xor_compl_left: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
108.8 +lemma xor_compl_left [simp]: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
108.9 apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
108.10 apply (simp only: conj_disj_distribs)
108.11 apply (simp only: conj_cancel_right conj_cancel_left)
108.12 @@ -231,7 +231,7 @@
108.13 apply (simp only: disj_ac conj_ac)
108.14 done
108.15
108.16 -lemma xor_compl_right: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
108.17 +lemma xor_compl_right [simp]: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
108.18 apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
108.19 apply (simp only: conj_disj_distribs)
108.20 apply (simp only: conj_cancel_right conj_cancel_left)
108.21 @@ -239,11 +239,11 @@
108.22 apply (simp only: disj_ac conj_ac)
108.23 done
108.24
108.25 -lemma xor_cancel_right [simp]: "x \<oplus> \<sim> x = \<one>"
108.26 +lemma xor_cancel_right: "x \<oplus> \<sim> x = \<one>"
108.27 by (simp only: xor_compl_right xor_self compl_zero)
108.28
108.29 -lemma xor_cancel_left [simp]: "\<sim> x \<oplus> x = \<one>"
108.30 -by (subst xor_commute) (rule xor_cancel_right)
108.31 +lemma xor_cancel_left: "\<sim> x \<oplus> x = \<one>"
108.32 +by (simp only: xor_compl_left xor_self compl_zero)
108.33
108.34 lemma conj_xor_distrib: "x \<sqinter> (y \<oplus> z) = (x \<sqinter> y) \<oplus> (x \<sqinter> z)"
108.35 proof -
109.1 --- a/src/HOL/Library/Char_nat.thy Wed Mar 04 10:43:39 2009 +0100
109.2 +++ b/src/HOL/Library/Char_nat.thy Wed Mar 04 10:45:52 2009 +0100
109.3 @@ -132,7 +132,7 @@
109.4 lemma Char_char_of_nat:
109.5 "Char n m = char_of_nat (nat_of_nibble n * 16 + nat_of_nibble m)"
109.6 unfolding char_of_nat_def Let_def nibble_pair_of_nat_def
109.7 - by (auto simp add: div_add1_eq mod_add1_eq nat_of_nibble_div_16 nibble_of_nat_norm nibble_of_nat_of_nibble)
109.8 + by (auto simp add: div_add1_eq mod_add_eq nat_of_nibble_div_16 nibble_of_nat_norm nibble_of_nat_of_nibble)
109.9
109.10 lemma char_of_nat_of_char:
109.11 "char_of_nat (nat_of_char c) = c"
109.12 @@ -165,7 +165,7 @@
109.13 show ?thesis
109.14 by (simp add: nat_of_char.simps char_of_nat_def nibble_of_pair
109.15 nat_of_nibble_of_nat mod_mult_distrib
109.16 - n aux3 mod_mult_self3 l_256 aux4 mod_add1_eq [of "256 * k"] l_div_256)
109.17 + n aux3 mod_mult_self3 l_256 aux4 mod_add_eq [of "256 * k"] l_div_256)
109.18 qed
109.19
109.20 lemma nibble_pair_of_nat_char:
110.1 --- a/src/HOL/Library/Code_Char.thy Wed Mar 04 10:43:39 2009 +0100
110.2 +++ b/src/HOL/Library/Code_Char.thy Wed Mar 04 10:45:52 2009 +0100
110.3 @@ -1,5 +1,4 @@
110.4 (* Title: HOL/Library/Code_Char.thy
110.5 - ID: $Id$
110.6 Author: Florian Haftmann
110.7 *)
110.8
111.1 --- a/src/HOL/Library/Coinductive_List.thy Wed Mar 04 10:43:39 2009 +0100
111.2 +++ b/src/HOL/Library/Coinductive_List.thy Wed Mar 04 10:45:52 2009 +0100
111.3 @@ -298,12 +298,12 @@
111.4 (CONS a M, CONS b N) \<in> EqLList r"
111.5
111.6 lemma EqLList_unfold:
111.7 - "EqLList r = dsum (diag {Datatype.Numb 0}) (dprod r (EqLList r))"
111.8 + "EqLList r = dsum (Id_on {Datatype.Numb 0}) (dprod r (EqLList r))"
111.9 by (fast intro!: EqLList.intros [unfolded NIL_def CONS_def]
111.10 elim: EqLList.cases [unfolded NIL_def CONS_def])
111.11
111.12 lemma EqLList_implies_ntrunc_equality:
111.13 - "(M, N) \<in> EqLList (diag A) \<Longrightarrow> ntrunc k M = ntrunc k N"
111.14 + "(M, N) \<in> EqLList (Id_on A) \<Longrightarrow> ntrunc k M = ntrunc k N"
111.15 apply (induct k arbitrary: M N rule: nat_less_induct)
111.16 apply (erule EqLList.cases)
111.17 apply (safe del: equalityI)
111.18 @@ -314,28 +314,28 @@
111.19 apply (simp_all add: CONS_def less_Suc_eq)
111.20 done
111.21
111.22 -lemma Domain_EqLList: "Domain (EqLList (diag A)) \<subseteq> LList A"
111.23 +lemma Domain_EqLList: "Domain (EqLList (Id_on A)) \<subseteq> LList A"
111.24 apply (rule subsetI)
111.25 apply (erule LList.coinduct)
111.26 apply (subst (asm) EqLList_unfold)
111.27 apply (auto simp add: NIL_def CONS_def)
111.28 done
111.29
111.30 -lemma EqLList_diag: "EqLList (diag A) = diag (LList A)"
111.31 +lemma EqLList_Id_on: "EqLList (Id_on A) = Id_on (LList A)"
111.32 (is "?lhs = ?rhs")
111.33 proof
111.34 show "?lhs \<subseteq> ?rhs"
111.35 apply (rule subsetI)
111.36 apply (rule_tac p = x in PairE)
111.37 apply clarify
111.38 - apply (rule diag_eqI)
111.39 + apply (rule Id_on_eqI)
111.40 apply (rule EqLList_implies_ntrunc_equality [THEN ntrunc_equality],
111.41 assumption)
111.42 apply (erule DomainI [THEN Domain_EqLList [THEN subsetD]])
111.43 done
111.44 {
111.45 - fix M N assume "(M, N) \<in> diag (LList A)"
111.46 - then have "(M, N) \<in> EqLList (diag A)"
111.47 + fix M N assume "(M, N) \<in> Id_on (LList A)"
111.48 + then have "(M, N) \<in> EqLList (Id_on A)"
111.49 proof coinduct
111.50 case (EqLList M N)
111.51 then obtain L where L: "L \<in> LList A" and MN: "M = L" "N = L" by blast
111.52 @@ -344,7 +344,7 @@
111.53 case NIL with MN have ?EqNIL by simp
111.54 then show ?thesis ..
111.55 next
111.56 - case CONS with MN have ?EqCONS by (simp add: diagI)
111.57 + case CONS with MN have ?EqCONS by (simp add: Id_onI)
111.58 then show ?thesis ..
111.59 qed
111.60 qed
111.61 @@ -352,8 +352,8 @@
111.62 then show "?rhs \<subseteq> ?lhs" by auto
111.63 qed
111.64
111.65 -lemma EqLList_diag_iff [iff]: "(p \<in> EqLList (diag A)) = (p \<in> diag (LList A))"
111.66 - by (simp only: EqLList_diag)
111.67 +lemma EqLList_Id_on_iff [iff]: "(p \<in> EqLList (Id_on A)) = (p \<in> Id_on (LList A))"
111.68 + by (simp only: EqLList_Id_on)
111.69
111.70
111.71 text {*
111.72 @@ -367,11 +367,11 @@
111.73 and step: "\<And>M N. (M, N) \<in> r \<Longrightarrow>
111.74 M = NIL \<and> N = NIL \<or>
111.75 (\<exists>a b M' N'.
111.76 - M = CONS a M' \<and> N = CONS b N' \<and> (a, b) \<in> diag A \<and>
111.77 - ((M', N') \<in> r \<or> (M', N') \<in> EqLList (diag A)))"
111.78 + M = CONS a M' \<and> N = CONS b N' \<and> (a, b) \<in> Id_on A \<and>
111.79 + ((M', N') \<in> r \<or> (M', N') \<in> EqLList (Id_on A)))"
111.80 shows "M = N"
111.81 proof -
111.82 - from r have "(M, N) \<in> EqLList (diag A)"
111.83 + from r have "(M, N) \<in> EqLList (Id_on A)"
111.84 proof coinduct
111.85 case EqLList
111.86 then show ?case by (rule step)
111.87 @@ -387,8 +387,8 @@
111.88 (f (CONS x l), g (CONS x l)) = (NIL, NIL) \<or>
111.89 (\<exists>M N a b.
111.90 (f (CONS x l), g (CONS x l)) = (CONS a M, CONS b N) \<and>
111.91 - (a, b) \<in> diag A \<and>
111.92 - (M, N) \<in> {(f u, g u) | u. u \<in> LList A} \<union> diag (LList A))"
111.93 + (a, b) \<in> Id_on A \<and>
111.94 + (M, N) \<in> {(f u, g u) | u. u \<in> LList A} \<union> Id_on (LList A))"
111.95 (is "\<And>x l. _ \<Longrightarrow> _ \<Longrightarrow> ?fun_CONS x l")
111.96 shows "f M = g M"
111.97 proof -
111.98 @@ -401,8 +401,8 @@
111.99 from L show ?case
111.100 proof (cases L)
111.101 case NIL
111.102 - with fun_NIL and MN have "(M, N) \<in> diag (LList A)" by auto
111.103 - then have "(M, N) \<in> EqLList (diag A)" ..
111.104 + with fun_NIL and MN have "(M, N) \<in> Id_on (LList A)" by auto
111.105 + then have "(M, N) \<in> EqLList (Id_on A)" ..
111.106 then show ?thesis by cases simp_all
111.107 next
111.108 case (CONS a K)
111.109 @@ -411,23 +411,23 @@
111.110 then show ?thesis
111.111 proof
111.112 assume ?NIL
111.113 - with MN CONS have "(M, N) \<in> diag (LList A)" by auto
111.114 - then have "(M, N) \<in> EqLList (diag A)" ..
111.115 + with MN CONS have "(M, N) \<in> Id_on (LList A)" by auto
111.116 + then have "(M, N) \<in> EqLList (Id_on A)" ..
111.117 then show ?thesis by cases simp_all
111.118 next
111.119 assume ?CONS
111.120 with CONS obtain a b M' N' where
111.121 fg: "(f L, g L) = (CONS a M', CONS b N')"
111.122 - and ab: "(a, b) \<in> diag A"
111.123 - and M'N': "(M', N') \<in> ?bisim \<union> diag (LList A)"
111.124 + and ab: "(a, b) \<in> Id_on A"
111.125 + and M'N': "(M', N') \<in> ?bisim \<union> Id_on (LList A)"
111.126 by blast
111.127 from M'N' show ?thesis
111.128 proof
111.129 assume "(M', N') \<in> ?bisim"
111.130 with MN fg ab show ?thesis by simp
111.131 next
111.132 - assume "(M', N') \<in> diag (LList A)"
111.133 - then have "(M', N') \<in> EqLList (diag A)" ..
111.134 + assume "(M', N') \<in> Id_on (LList A)"
111.135 + then have "(M', N') \<in> EqLList (Id_on A)" ..
111.136 with MN fg ab show ?thesis by simp
111.137 qed
111.138 qed
111.139 @@ -463,7 +463,7 @@
111.140 with h h' MN have "M = CONS (fst p) (h (snd p))"
111.141 and "N = CONS (fst p) (h' (snd p))"
111.142 by (simp_all split: prod.split)
111.143 - then have ?EqCONS by (auto iff: diag_iff)
111.144 + then have ?EqCONS by (auto iff: Id_on_iff)
111.145 then show ?thesis ..
111.146 qed
111.147 qed
111.148 @@ -498,7 +498,7 @@
111.149 next
111.150 assume "?EqLCons (l1, l2)"
111.151 with MN have ?EqCONS
111.152 - by (force simp add: Rep_llist_LCons EqLList_diag intro: Rep_llist_UNIV)
111.153 + by (force simp add: Rep_llist_LCons EqLList_Id_on intro: Rep_llist_UNIV)
111.154 then show ?thesis ..
111.155 qed
111.156 qed
112.1 --- a/src/HOL/Library/Determinants.thy Wed Mar 04 10:43:39 2009 +0100
112.2 +++ b/src/HOL/Library/Determinants.thy Wed Mar 04 10:45:52 2009 +0100
112.3 @@ -1048,7 +1048,7 @@
112.4 note th0 = this
112.5 let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
112.6 {fix x:: "real ^'n" assume nx: "norm x = 1"
112.7 - have "?g x = f x" using nx by (simp add: norm_eq_0[symmetric])}
112.8 + have "?g x = f x" using nx by auto}
112.9 hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
112.10 have g0: "?g 0 = 0" by simp
112.11 {fix x y :: "real ^'n"
112.12 @@ -1057,15 +1057,15 @@
112.13 moreover
112.14 {assume "x = 0" "y \<noteq> 0"
112.15 then have "dist (?g x) (?g y) = dist x y"
112.16 - apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
112.17 + apply (simp add: dist_def norm_mul)
112.18 apply (rule f1[rule_format])
112.19 - by(simp add: norm_mul norm_eq_0 field_simps)}
112.20 + by(simp add: norm_mul field_simps)}
112.21 moreover
112.22 {assume "x \<noteq> 0" "y = 0"
112.23 then have "dist (?g x) (?g y) = dist x y"
112.24 - apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
112.25 + apply (simp add: dist_def norm_mul)
112.26 apply (rule f1[rule_format])
112.27 - by(simp add: norm_mul norm_eq_0 field_simps)}
112.28 + by(simp add: norm_mul field_simps)}
112.29 moreover
112.30 {assume z: "x \<noteq> 0" "y \<noteq> 0"
112.31 have th00: "x = norm x *s inverse (norm x) *s x" "y = norm y *s inverse (norm y) *s y" "norm x *s f (inverse (norm x) *s x) = norm x *s f (inverse (norm x) *s x)"
112.32 @@ -1077,7 +1077,7 @@
112.33 "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
112.34 norm (inverse (norm x) *s x - inverse (norm y) *s y)"
112.35 using z
112.36 - by (auto simp add: norm_eq_0 vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
112.37 + by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
112.38 from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
112.39 by (simp add: dist_def)}
112.40 ultimately have "dist (?g x) (?g y) = dist x y" by blast}
112.41 @@ -1148,4 +1148,4 @@
112.42 by (simp add: ring_simps)
112.43 qed
112.44
112.45 -end
112.46 \ No newline at end of file
112.47 +end
113.1 --- a/src/HOL/Library/Enum.thy Wed Mar 04 10:43:39 2009 +0100
113.2 +++ b/src/HOL/Library/Enum.thy Wed Mar 04 10:45:52 2009 +0100
113.3 @@ -1,5 +1,4 @@
113.4 (* Title: HOL/Library/Enum.thy
113.5 - ID: $Id$
113.6 Author: Florian Haftmann, TU Muenchen
113.7 *)
113.8
114.1 --- a/src/HOL/Library/Euclidean_Space.thy Wed Mar 04 10:43:39 2009 +0100
114.2 +++ b/src/HOL/Library/Euclidean_Space.thy Wed Mar 04 10:45:52 2009 +0100
114.3 @@ -8,6 +8,7 @@
114.4 theory Euclidean_Space
114.5 imports "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Complex_Main
114.6 Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
114.7 + Inner_Product
114.8 uses ("normarith.ML")
114.9 begin
114.10
114.11 @@ -84,7 +85,13 @@
114.12 instance by (intro_classes)
114.13 end
114.14
114.15 -text{* Also the scalar-vector multiplication. FIXME: We should unify this with the scalar multiplication in @{text real_vector} *}
114.16 +instantiation "^" :: (scaleR, type) scaleR
114.17 +begin
114.18 +definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
114.19 +instance ..
114.20 +end
114.21 +
114.22 +text{* Also the scalar-vector multiplication. *}
114.23
114.24 definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixr "*s" 75)
114.25 where "c *s x = (\<chi> i. c * (x$i))"
114.26 @@ -118,6 +125,7 @@
114.27 [@{thm vector_add_def}, @{thm vector_mult_def},
114.28 @{thm vector_minus_def}, @{thm vector_uminus_def},
114.29 @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def},
114.30 + @{thm vector_scaleR_def},
114.31 @{thm Cart_lambda_beta'}, @{thm vector_scalar_mult_def}]
114.32 fun vector_arith_tac ths =
114.33 simp_tac ss1
114.34 @@ -166,9 +174,18 @@
114.35 shows "(- x)$i = - (x$i)"
114.36 using i by vector
114.37
114.38 +lemma vector_scaleR_component:
114.39 + fixes x :: "'a::scaleR ^ 'n"
114.40 + assumes i: "i \<in> {1 .. dimindex(UNIV :: 'n set)}"
114.41 + shows "(scaleR r x)$i = scaleR r (x$i)"
114.42 + using i by vector
114.43 +
114.44 lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
114.45
114.46 -lemmas vector_component = vec_component vector_add_component vector_mult_component vector_smult_component vector_minus_component vector_uminus_component cond_component
114.47 +lemmas vector_component =
114.48 + vec_component vector_add_component vector_mult_component
114.49 + vector_smult_component vector_minus_component vector_uminus_component
114.50 + vector_scaleR_component cond_component
114.51
114.52 subsection {* Some frequently useful arithmetic lemmas over vectors. *}
114.53
114.54 @@ -199,6 +216,9 @@
114.55 apply (intro_classes)
114.56 by (vector Cart_eq)
114.57
114.58 +instance "^" :: (real_vector, type) real_vector
114.59 + by default (vector scaleR_left_distrib scaleR_right_distrib)+
114.60 +
114.61 instance "^" :: (semigroup_mult,type) semigroup_mult
114.62 apply (intro_classes) by (vector mult_assoc)
114.63
114.64 @@ -242,6 +262,18 @@
114.65 instance "^" :: (ring,type) ring by (intro_classes)
114.66 instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes)
114.67 instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
114.68 +
114.69 +instance "^" :: (ring_1,type) ring_1 ..
114.70 +
114.71 +instance "^" :: (real_algebra,type) real_algebra
114.72 + apply intro_classes
114.73 + apply (simp_all add: vector_scaleR_def ring_simps)
114.74 + apply vector
114.75 + apply vector
114.76 + done
114.77 +
114.78 +instance "^" :: (real_algebra_1,type) real_algebra_1 ..
114.79 +
114.80 lemma of_nat_index:
114.81 "i\<in>{1 .. dimindex (UNIV :: 'n set)} \<Longrightarrow> (of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
114.82 apply (induct n)
114.83 @@ -290,8 +322,7 @@
114.84 qed
114.85
114.86 instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
114.87 - (* FIXME!!! Why does the axclass package complain here !!*)
114.88 -(* instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes *)
114.89 +instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
114.90
114.91 lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
114.92 by (vector mult_assoc)
114.93 @@ -314,6 +345,241 @@
114.94 apply (auto simp add: vec_def Cart_eq vec_component Cart_lambda_beta )
114.95 using dimindex_ge_1 apply auto done
114.96
114.97 +subsection {* Square root of sum of squares *}
114.98 +
114.99 +definition
114.100 + "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
114.101 +
114.102 +lemma setL2_cong:
114.103 + "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
114.104 + unfolding setL2_def by simp
114.105 +
114.106 +lemma strong_setL2_cong:
114.107 + "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
114.108 + unfolding setL2_def simp_implies_def by simp
114.109 +
114.110 +lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
114.111 + unfolding setL2_def by simp
114.112 +
114.113 +lemma setL2_empty [simp]: "setL2 f {} = 0"
114.114 + unfolding setL2_def by simp
114.115 +
114.116 +lemma setL2_insert [simp]:
114.117 + "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
114.118 + setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
114.119 + unfolding setL2_def by (simp add: setsum_nonneg)
114.120 +
114.121 +lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
114.122 + unfolding setL2_def by (simp add: setsum_nonneg)
114.123 +
114.124 +lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
114.125 + unfolding setL2_def by simp
114.126 +
114.127 +lemma setL2_mono:
114.128 + assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
114.129 + assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
114.130 + shows "setL2 f K \<le> setL2 g K"
114.131 + unfolding setL2_def
114.132 + by (simp add: setsum_nonneg setsum_mono power_mono prems)
114.133 +
114.134 +lemma setL2_right_distrib:
114.135 + "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
114.136 + unfolding setL2_def
114.137 + apply (simp add: power_mult_distrib)
114.138 + apply (simp add: setsum_right_distrib [symmetric])
114.139 + apply (simp add: real_sqrt_mult setsum_nonneg)
114.140 + done
114.141 +
114.142 +lemma setL2_left_distrib:
114.143 + "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
114.144 + unfolding setL2_def
114.145 + apply (simp add: power_mult_distrib)
114.146 + apply (simp add: setsum_left_distrib [symmetric])
114.147 + apply (simp add: real_sqrt_mult setsum_nonneg)
114.148 + done
114.149 +
114.150 +lemma setsum_nonneg_eq_0_iff:
114.151 + fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
114.152 + shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
114.153 + apply (induct set: finite, simp)
114.154 + apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
114.155 + done
114.156 +
114.157 +lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
114.158 + unfolding setL2_def
114.159 + by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
114.160 +
114.161 +lemma setL2_triangle_ineq:
114.162 + shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
114.163 +proof (cases "finite A")
114.164 + case False
114.165 + thus ?thesis by simp
114.166 +next
114.167 + case True
114.168 + thus ?thesis
114.169 + proof (induct set: finite)
114.170 + case empty
114.171 + show ?case by simp
114.172 + next
114.173 + case (insert x F)
114.174 + hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
114.175 + sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
114.176 + by (intro real_sqrt_le_mono add_left_mono power_mono insert
114.177 + setL2_nonneg add_increasing zero_le_power2)
114.178 + also have
114.179 + "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
114.180 + by (rule real_sqrt_sum_squares_triangle_ineq)
114.181 + finally show ?case
114.182 + using insert by simp
114.183 + qed
114.184 +qed
114.185 +
114.186 +lemma sqrt_sum_squares_le_sum:
114.187 + "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
114.188 + apply (rule power2_le_imp_le)
114.189 + apply (simp add: power2_sum)
114.190 + apply (simp add: mult_nonneg_nonneg)
114.191 + apply (simp add: add_nonneg_nonneg)
114.192 + done
114.193 +
114.194 +lemma setL2_le_setsum [rule_format]:
114.195 + "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
114.196 + apply (cases "finite A")
114.197 + apply (induct set: finite)
114.198 + apply simp
114.199 + apply clarsimp
114.200 + apply (erule order_trans [OF sqrt_sum_squares_le_sum])
114.201 + apply simp
114.202 + apply simp
114.203 + apply simp
114.204 + done
114.205 +
114.206 +lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
114.207 + apply (rule power2_le_imp_le)
114.208 + apply (simp add: power2_sum)
114.209 + apply (simp add: mult_nonneg_nonneg)
114.210 + apply (simp add: add_nonneg_nonneg)
114.211 + done
114.212 +
114.213 +lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
114.214 + apply (cases "finite A")
114.215 + apply (induct set: finite)
114.216 + apply simp
114.217 + apply simp
114.218 + apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
114.219 + apply simp
114.220 + apply simp
114.221 + done
114.222 +
114.223 +lemma setL2_mult_ineq_lemma:
114.224 + fixes a b c d :: real
114.225 + shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
114.226 +proof -
114.227 + have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
114.228 + also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
114.229 + by (simp only: power2_diff power_mult_distrib)
114.230 + also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
114.231 + by simp
114.232 + finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
114.233 + by simp
114.234 +qed
114.235 +
114.236 +lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
114.237 + apply (cases "finite A")
114.238 + apply (induct set: finite)
114.239 + apply simp
114.240 + apply (rule power2_le_imp_le, simp)
114.241 + apply (rule order_trans)
114.242 + apply (rule power_mono)
114.243 + apply (erule add_left_mono)
114.244 + apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
114.245 + apply (simp add: power2_sum)
114.246 + apply (simp add: power_mult_distrib)
114.247 + apply (simp add: right_distrib left_distrib)
114.248 + apply (rule ord_le_eq_trans)
114.249 + apply (rule setL2_mult_ineq_lemma)
114.250 + apply simp
114.251 + apply (intro mult_nonneg_nonneg setL2_nonneg)
114.252 + apply simp
114.253 + done
114.254 +
114.255 +lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
114.256 + apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
114.257 + apply fast
114.258 + apply (subst setL2_insert)
114.259 + apply simp
114.260 + apply simp
114.261 + apply simp
114.262 + done
114.263 +
114.264 +subsection {* Norms *}
114.265 +
114.266 +instantiation "^" :: (real_normed_vector, type) real_normed_vector
114.267 +begin
114.268 +
114.269 +definition vector_norm_def:
114.270 + "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) {1 .. dimindex (UNIV:: 'b set)}"
114.271 +
114.272 +definition vector_sgn_def:
114.273 + "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
114.274 +
114.275 +instance proof
114.276 + fix a :: real and x y :: "'a ^ 'b"
114.277 + show "0 \<le> norm x"
114.278 + unfolding vector_norm_def
114.279 + by (rule setL2_nonneg)
114.280 + show "norm x = 0 \<longleftrightarrow> x = 0"
114.281 + unfolding vector_norm_def
114.282 + by (simp add: setL2_eq_0_iff Cart_eq)
114.283 + show "norm (x + y) \<le> norm x + norm y"
114.284 + unfolding vector_norm_def
114.285 + apply (rule order_trans [OF _ setL2_triangle_ineq])
114.286 + apply (rule setL2_mono)
114.287 + apply (simp add: vector_component norm_triangle_ineq)
114.288 + apply simp
114.289 + done
114.290 + show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
114.291 + unfolding vector_norm_def
114.292 + by (simp add: vector_component norm_scaleR setL2_right_distrib
114.293 + cong: strong_setL2_cong)
114.294 + show "sgn x = scaleR (inverse (norm x)) x"
114.295 + by (rule vector_sgn_def)
114.296 +qed
114.297 +
114.298 +end
114.299 +
114.300 +subsection {* Inner products *}
114.301 +
114.302 +instantiation "^" :: (real_inner, type) real_inner
114.303 +begin
114.304 +
114.305 +definition vector_inner_def:
114.306 + "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) {1 .. dimindex(UNIV::'b set)}"
114.307 +
114.308 +instance proof
114.309 + fix r :: real and x y z :: "'a ^ 'b"
114.310 + show "inner x y = inner y x"
114.311 + unfolding vector_inner_def
114.312 + by (simp add: inner_commute)
114.313 + show "inner (x + y) z = inner x z + inner y z"
114.314 + unfolding vector_inner_def
114.315 + by (vector inner_left_distrib)
114.316 + show "inner (scaleR r x) y = r * inner x y"
114.317 + unfolding vector_inner_def
114.318 + by (vector inner_scaleR_left)
114.319 + show "0 \<le> inner x x"
114.320 + unfolding vector_inner_def
114.321 + by (simp add: setsum_nonneg)
114.322 + show "inner x x = 0 \<longleftrightarrow> x = 0"
114.323 + unfolding vector_inner_def
114.324 + by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
114.325 + show "norm x = sqrt (inner x x)"
114.326 + unfolding vector_inner_def vector_norm_def setL2_def
114.327 + by (simp add: power2_norm_eq_inner)
114.328 +qed
114.329 +
114.330 +end
114.331 +
114.332 subsection{* Properties of the dot product. *}
114.333
114.334 lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x"
114.335 @@ -363,18 +629,7 @@
114.336 lemma dot_pos_lt: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x]
114.337 by (auto simp add: le_less)
114.338
114.339 -subsection {* Introduce norms, but defer many properties till we get square roots. *}
114.340 -text{* FIXME : This is ugly *}
114.341 -defs (overloaded)
114.342 - real_of_real_def [code inline, simp]: "real == id"
114.343 -
114.344 -instantiation "^" :: ("{times, comm_monoid_add}", type) norm begin
114.345 -definition real_vector_norm_def: "norm \<equiv> (\<lambda>x. sqrt (real (x \<bullet> x)))"
114.346 -instance ..
114.347 -end
114.348 -
114.349 -
114.350 -subsection{* The collapse of the general concepts to dimention one. *}
114.351 +subsection{* The collapse of the general concepts to dimension one. *}
114.352
114.353 lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
114.354 by (vector dimindex_def)
114.355 @@ -385,11 +640,15 @@
114.356 apply (simp only: vector_one[symmetric])
114.357 done
114.358
114.359 +lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
114.360 + by (simp add: vector_norm_def dimindex_def)
114.361 +
114.362 lemma norm_real: "norm(x::real ^ 1) = abs(x$1)"
114.363 - by (simp add: real_vector_norm_def)
114.364 + by (simp add: norm_vector_1)
114.365
114.366 text{* Metric *}
114.367
114.368 +text {* FIXME: generalize to arbitrary @{text real_normed_vector} types *}
114.369 definition dist:: "real ^ 'n \<Rightarrow> real ^ 'n \<Rightarrow> real" where
114.370 "dist x y = norm (x - y)"
114.371
114.372 @@ -501,27 +760,18 @@
114.373 text{* Hence derive more interesting properties of the norm. *}
114.374
114.375 lemma norm_0: "norm (0::real ^ 'n) = 0"
114.376 - by (simp add: real_vector_norm_def dot_eq_0)
114.377 -
114.378 -lemma norm_pos_le: "0 <= norm (x::real^'n)"
114.379 - by (simp add: real_vector_norm_def dot_pos_le)
114.380 -lemma norm_neg: " norm(-x) = norm (x:: real ^ 'n)"
114.381 - by (simp add: real_vector_norm_def dot_lneg dot_rneg)
114.382 -lemma norm_sub: "norm(x - y) = norm(y - (x::real ^ 'n))"
114.383 - by (metis norm_neg minus_diff_eq)
114.384 + by (rule norm_zero)
114.385 +
114.386 lemma norm_mul: "norm(a *s x) = abs(a) * norm x"
114.387 - by (simp add: real_vector_norm_def dot_lmult dot_rmult mult_assoc[symmetric] real_sqrt_mult)
114.388 + by (simp add: vector_norm_def vector_component setL2_right_distrib
114.389 + abs_mult cong: strong_setL2_cong)
114.390 lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
114.391 + by (simp add: vector_norm_def dot_def setL2_def power2_eq_square)
114.392 +lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
114.393 + by (simp add: vector_norm_def setL2_def dot_def power2_eq_square)
114.394 +lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
114.395 by (simp add: real_vector_norm_def)
114.396 -lemma norm_eq_0: "norm x = 0 \<longleftrightarrow> x = (0::real ^ 'n)"
114.397 - by (simp add: real_vector_norm_def dot_eq_0)
114.398 -lemma norm_pos_lt: "0 < norm x \<longleftrightarrow> x \<noteq> (0::real ^ 'n)"
114.399 - by (metis less_le real_vector_norm_def norm_pos_le norm_eq_0)
114.400 -lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
114.401 - by (simp add: real_vector_norm_def dot_pos_le)
114.402 -lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_0)
114.403 -lemma norm_le_0: "norm x <= 0 \<longleftrightarrow> x = (0::real ^'n)"
114.404 - by (metis norm_eq_0 norm_pos_le order_antisym)
114.405 +lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero)
114.406 lemma vector_mul_eq_0: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
114.407 by vector
114.408 lemma vector_mul_lcancel: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
114.409 @@ -535,14 +785,14 @@
114.410 lemma norm_cauchy_schwarz: "x \<bullet> y <= norm x * norm y"
114.411 proof-
114.412 {assume "norm x = 0"
114.413 - hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
114.414 + hence ?thesis by (simp add: dot_lzero dot_rzero)}
114.415 moreover
114.416 {assume "norm y = 0"
114.417 - hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
114.418 + hence ?thesis by (simp add: dot_lzero dot_rzero)}
114.419 moreover
114.420 {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
114.421 let ?z = "norm y *s x - norm x *s y"
114.422 - from h have p: "norm x * norm y > 0" by (metis norm_pos_le le_less zero_compare_simps)
114.423 + from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
114.424 from dot_pos_le[of ?z]
114.425 have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
114.426 apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
114.427 @@ -553,26 +803,16 @@
114.428 ultimately show ?thesis by metis
114.429 qed
114.430
114.431 -lemma norm_abs[simp]: "abs (norm x) = norm (x::real ^'n)"
114.432 - using norm_pos_le[of x] by (simp add: real_abs_def linorder_linear)
114.433 -
114.434 lemma norm_cauchy_schwarz_abs: "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
114.435 using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
114.436 - by (simp add: real_abs_def dot_rneg norm_neg)
114.437 -lemma norm_triangle: "norm(x + y) <= norm x + norm (y::real ^'n)"
114.438 - unfolding real_vector_norm_def
114.439 - apply (rule real_le_lsqrt)
114.440 - apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
114.441 - apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
114.442 - apply (simp add: dot_ladd dot_radd dot_sym )
114.443 - by (simp add: norm_pow_2[symmetric] power2_eq_square ring_simps norm_cauchy_schwarz)
114.444 + by (simp add: real_abs_def dot_rneg)
114.445
114.446 lemma norm_triangle_sub: "norm (x::real ^'n) <= norm(y) + norm(x - y)"
114.447 - using norm_triangle[of "y" "x - y"] by (simp add: ring_simps)
114.448 + using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
114.449 lemma norm_triangle_le: "norm(x::real ^'n) + norm y <= e ==> norm(x + y) <= e"
114.450 - by (metis order_trans norm_triangle)
114.451 + by (metis order_trans norm_triangle_ineq)
114.452 lemma norm_triangle_lt: "norm(x::real ^'n) + norm(y) < e ==> norm(x + y) < e"
114.453 - by (metis basic_trans_rules(21) norm_triangle)
114.454 + by (metis basic_trans_rules(21) norm_triangle_ineq)
114.455
114.456 lemma setsum_delta:
114.457 assumes fS: "finite S"
114.458 @@ -597,19 +837,10 @@
114.459 qed
114.460
114.461 lemma component_le_norm: "i \<in> {1 .. dimindex(UNIV :: 'n set)} ==> \<bar>x$i\<bar> <= norm (x::real ^ 'n)"
114.462 -proof(simp add: real_vector_norm_def, rule real_le_rsqrt, clarsimp)
114.463 - assume i: "Suc 0 \<le> i" "i \<le> dimindex (UNIV :: 'n set)"
114.464 - let ?S = "{1 .. dimindex(UNIV :: 'n set)}"
114.465 - let ?f = "(\<lambda>k. if k = i then x$i ^2 else 0)"
114.466 - have fS: "finite ?S" by simp
114.467 - from i setsum_delta[OF fS, of i "\<lambda>k. x$i ^ 2"]
114.468 - have th: "x$i^2 = setsum ?f ?S" by simp
114.469 - let ?g = "\<lambda>k. x$k * x$k"
114.470 - {fix x assume x: "x \<in> ?S" have "?f x \<le> ?g x" by (simp add: power2_eq_square)}
114.471 - with setsum_mono[of ?S ?f ?g]
114.472 - have "setsum ?f ?S \<le> setsum ?g ?S" by blast
114.473 - then show "x$i ^2 \<le> x \<bullet> (x:: real ^ 'n)" unfolding dot_def th[symmetric] .
114.474 -qed
114.475 + apply (simp add: vector_norm_def)
114.476 + apply (rule member_le_setL2, simp_all)
114.477 + done
114.478 +
114.479 lemma norm_bound_component_le: "norm(x::real ^ 'n) <= e
114.480 ==> \<forall>i \<in> {1 .. dimindex(UNIV:: 'n set)}. \<bar>x$i\<bar> <= e"
114.481 by (metis component_le_norm order_trans)
114.482 @@ -619,24 +850,12 @@
114.483 by (metis component_le_norm basic_trans_rules(21))
114.484
114.485 lemma norm_le_l1: "norm (x:: real ^'n) <= setsum(\<lambda>i. \<bar>x$i\<bar>) {1..dimindex(UNIV::'n set)}"
114.486 -proof (simp add: real_vector_norm_def, rule real_le_lsqrt,simp add: dot_pos_le, simp add: setsum_mono, simp add: dot_def, induct "dimindex(UNIV::'n set)")
114.487 - case 0 thus ?case by simp
114.488 -next
114.489 - case (Suc n)
114.490 - have th: "2 * (\<bar>x$(Suc n)\<bar> * (\<Sum>i = Suc 0..n. \<bar>x$i\<bar>)) \<ge> 0"
114.491 - apply simp
114.492 - apply (rule mult_nonneg_nonneg)
114.493 - by (simp_all add: setsum_abs_ge_zero)
114.494 -
114.495 - from Suc
114.496 - show ?case using th by (simp add: power2_eq_square ring_simps)
114.497 -qed
114.498 + by (simp add: vector_norm_def setL2_le_setsum)
114.499
114.500 lemma real_abs_norm: "\<bar> norm x\<bar> = norm (x :: real ^'n)"
114.501 - by (simp add: norm_pos_le)
114.502 + by (rule abs_norm_cancel)
114.503 lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n) - norm y\<bar> <= norm(x - y)"
114.504 - apply (simp add: abs_le_iff ring_simps)
114.505 - by (metis norm_triangle_sub norm_sub)
114.506 + by (rule norm_triangle_ineq3)
114.507 lemma norm_le: "norm(x::real ^ 'n) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
114.508 by (simp add: real_vector_norm_def)
114.509 lemma norm_lt: "norm(x::real ^'n) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
114.510 @@ -652,13 +871,7 @@
114.511 by (simp add: real_vector_norm_def dot_pos_le )
114.512
114.513 lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
114.514 -proof-
114.515 - have th: "\<And>x y::real. x^2 = y^2 \<longleftrightarrow> x = y \<or> x = -y" by algebra
114.516 - show ?thesis using norm_pos_le[of x]
114.517 - apply (simp add: dot_square_norm th)
114.518 - apply arith
114.519 - done
114.520 -qed
114.521 + by (auto simp add: real_vector_norm_def)
114.522
114.523 lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
114.524 proof-
114.525 @@ -668,14 +881,14 @@
114.526 qed
114.527
114.528 lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
114.529 - using norm_pos_le[of x]
114.530 apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
114.531 + using norm_ge_zero[of x]
114.532 apply arith
114.533 done
114.534
114.535 lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2"
114.536 - using norm_pos_le[of x]
114.537 apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
114.538 + using norm_ge_zero[of x]
114.539 apply arith
114.540 done
114.541
114.542 @@ -746,14 +959,14 @@
114.543 lemma pth_d: "x + (0::real ^'n) == x" by (atomize (full)) vector
114.544
114.545 lemma norm_imp_pos_and_ge: "norm (x::real ^ 'n) == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
114.546 - by (atomize) (auto simp add: norm_pos_le)
114.547 + by (atomize) (auto simp add: norm_ge_zero)
114.548
114.549 lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
114.550
114.551 lemma norm_pths:
114.552 "(x::real ^'n) = y \<longleftrightarrow> norm (x - y) \<le> 0"
114.553 "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
114.554 - using norm_pos_le[of "x - y"] by (auto simp add: norm_0 norm_eq_0)
114.555 + using norm_ge_zero[of "x - y"] by auto
114.556
114.557 use "normarith.ML"
114.558
114.559 @@ -797,11 +1010,6 @@
114.560
114.561 lemma dist_le_0: "dist x y <= 0 \<longleftrightarrow> x = y" by norm
114.562
114.563 -instantiation "^" :: (monoid_add,type) monoid_add
114.564 -begin
114.565 - instance by (intro_classes)
114.566 -end
114.567 -
114.568 lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
114.569 apply vector
114.570 apply auto
114.571 @@ -873,7 +1081,7 @@
114.572 assumes fS: "finite S"
114.573 shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
114.574 proof(induct rule: finite_induct[OF fS])
114.575 - case 1 thus ?case by (simp add: norm_zero)
114.576 + case 1 thus ?case by simp
114.577 next
114.578 case (2 x S)
114.579 from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
114.580 @@ -887,10 +1095,10 @@
114.581 assumes fS: "finite S"
114.582 shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
114.583 proof(induct rule: finite_induct[OF fS])
114.584 - case 1 thus ?case by simp norm
114.585 + case 1 thus ?case by simp
114.586 next
114.587 case (2 x S)
114.588 - from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" apply (simp add: norm_triangle_ineq) by norm
114.589 + from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
114.590 also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
114.591 using "2.hyps" by simp
114.592 finally show ?case using "2.hyps" by simp
114.593 @@ -936,45 +1144,6 @@
114.594 using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
114.595 by simp
114.596
114.597 -instantiation "^" :: ("{scaleR, one, times}",type) scaleR
114.598 -begin
114.599 -
114.600 -definition vector_scaleR_def: "(scaleR :: real \<Rightarrow> 'a ^'b \<Rightarrow> 'a ^'b) \<equiv> (\<lambda> c x . (scaleR c 1) *s x)"
114.601 -instance ..
114.602 -end
114.603 -
114.604 -instantiation "^" :: ("ring_1",type) ring_1
114.605 -begin
114.606 -instance by intro_classes
114.607 -end
114.608 -
114.609 -instantiation "^" :: (real_algebra_1,type) real_vector
114.610 -begin
114.611 -
114.612 -instance
114.613 - apply intro_classes
114.614 - apply (simp_all add: vector_scaleR_def)
114.615 - apply (simp_all add: vector_sadd_rdistrib vector_add_ldistrib vector_smult_lid vector_smult_assoc scaleR_left_distrib mult_commute)
114.616 - done
114.617 -end
114.618 -
114.619 -instantiation "^" :: (real_algebra_1,type) real_algebra
114.620 -begin
114.621 -
114.622 -instance
114.623 - apply intro_classes
114.624 - apply (simp_all add: vector_scaleR_def ring_simps)
114.625 - apply vector
114.626 - apply vector
114.627 - done
114.628 -end
114.629 -
114.630 -instantiation "^" :: (real_algebra_1,type) real_algebra_1
114.631 -begin
114.632 -
114.633 -instance ..
114.634 -end
114.635 -
114.636 lemma setsum_vmul:
114.637 fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
114.638 assumes fS: "finite S"
114.639 @@ -1211,7 +1380,7 @@
114.640 by (auto simp add: setsum_component intro: abs_le_D1)
114.641 have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
114.642 using i component_le_norm[OF i, of "setsum (\<lambda>x. - f x) ?Pn"] fPs[OF PnP]
114.643 - by (auto simp add: setsum_negf norm_neg setsum_component vector_component intro: abs_le_D1)
114.644 + by (auto simp add: setsum_negf setsum_component vector_component intro: abs_le_D1)
114.645 have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn"
114.646 apply (subst thp)
114.647 apply (rule setsum_Un_nonzero)
114.648 @@ -1535,7 +1704,7 @@
114.649 unfolding norm_mul
114.650 apply (simp only: mult_commute)
114.651 apply (rule mult_mono)
114.652 - by (auto simp add: ring_simps norm_pos_le) }
114.653 + by (auto simp add: ring_simps norm_ge_zero) }
114.654 then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis
114.655 from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
114.656 have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
114.657 @@ -1552,16 +1721,18 @@
114.658 let ?K = "\<bar>B\<bar> + 1"
114.659 have Kp: "?K > 0" by arith
114.660 {assume C: "B < 0"
114.661 - have "norm (1::real ^ 'n) > 0" by (simp add: norm_pos_lt)
114.662 + have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
114.663 with C have "B * norm (1:: real ^ 'n) < 0"
114.664 by (simp add: zero_compare_simps)
114.665 - with B[rule_format, of 1] norm_pos_le[of "f 1"] have False by simp
114.666 + with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
114.667 }
114.668 then have Bp: "B \<ge> 0" by ferrack
114.669 {fix x::"real ^ 'n"
114.670 have "norm (f x) \<le> ?K * norm x"
114.671 - using B[rule_format, of x] norm_pos_le[of x] norm_pos_le[of "f x"] Bp
114.672 - by (auto simp add: ring_simps split add: abs_split)
114.673 + using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
114.674 + apply (auto simp add: ring_simps split add: abs_split)
114.675 + apply (erule order_trans, simp)
114.676 + done
114.677 }
114.678 then show ?thesis using Kp by blast
114.679 qed
114.680 @@ -1641,9 +1812,9 @@
114.681 apply simp
114.682 apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
114.683 apply (rule mult_mono)
114.684 - apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
114.685 + apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
114.686 apply (rule mult_mono)
114.687 - apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
114.688 + apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
114.689 done}
114.690 then show ?thesis by metis
114.691 qed
114.692 @@ -1663,7 +1834,7 @@
114.693 have "B * norm x * norm y \<le> ?K * norm x * norm y"
114.694 apply -
114.695 apply (rule mult_right_mono, rule mult_right_mono)
114.696 - by (auto simp add: norm_pos_le)
114.697 + by (auto simp add: norm_ge_zero)
114.698 then have "norm (h x y) \<le> ?K * norm x * norm y"
114.699 using B[rule_format, of x y] by simp}
114.700 with Kp show ?thesis by blast
114.701 @@ -2276,21 +2447,21 @@
114.702 moreover
114.703 {assume H: ?lhs
114.704 from H[rule_format, of "basis 1"]
114.705 - have bp: "b \<ge> 0" using norm_pos_le[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
114.706 - by (auto simp add: norm_basis)
114.707 + have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
114.708 + by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
114.709 {fix x :: "real ^'n"
114.710 {assume "x = 0"
114.711 - then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] norm_0 bp)}
114.712 + then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
114.713 moreover
114.714 {assume x0: "x \<noteq> 0"
114.715 - hence n0: "norm x \<noteq> 0" by (metis norm_eq_0)
114.716 + hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
114.717 let ?c = "1/ norm x"
114.718 - have "norm (?c*s x) = 1" by (simp add: n0 norm_mul)
114.719 + have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
114.720 with H have "norm (f(?c*s x)) \<le> b" by blast
114.721 hence "?c * norm (f x) \<le> b"
114.722 by (simp add: linear_cmul[OF lf] norm_mul)
114.723 hence "norm (f x) \<le> b * norm x"
114.724 - using n0 norm_pos_le[of x] by (auto simp add: field_simps)}
114.725 + using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
114.726 ultimately have "norm (f x) \<le> b * norm x" by blast}
114.727 then have ?rhs by blast}
114.728 ultimately show ?thesis by blast
114.729 @@ -2322,12 +2493,12 @@
114.730 qed
114.731
114.732 lemma onorm_pos_le: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)" shows "0 <= onorm f"
114.733 - using order_trans[OF norm_pos_le onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
114.734 + using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
114.735
114.736 lemma onorm_eq_0: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)"
114.737 shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
114.738 using onorm[OF lf]
114.739 - apply (auto simp add: norm_0 onorm_pos_le norm_le_0)
114.740 + apply (auto simp add: onorm_pos_le)
114.741 apply atomize
114.742 apply (erule allE[where x="0::real"])
114.743 using onorm_pos_le[OF lf]
114.744 @@ -2365,7 +2536,7 @@
114.745 lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
114.746 shows "onorm (\<lambda>x. - f x) \<le> onorm f"
114.747 using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
114.748 - unfolding norm_neg by metis
114.749 + unfolding norm_minus_cancel by metis
114.750
114.751 lemma onorm_neg: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
114.752 shows "onorm (\<lambda>x. - f x) = onorm f"
114.753 @@ -2377,7 +2548,7 @@
114.754 shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
114.755 apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
114.756 apply (rule order_trans)
114.757 - apply (rule norm_triangle)
114.758 + apply (rule norm_triangle_ineq)
114.759 apply (simp add: distrib)
114.760 apply (rule add_mono)
114.761 apply (rule onorm(1)[OF lf])
114.762 @@ -2594,7 +2765,7 @@
114.763 by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square del: One_nat_def)
114.764 then show ?thesis
114.765 unfolding th0
114.766 - unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
114.767 + unfolding real_vector_norm_def real_sqrt_le_iff id_def
114.768 by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
114.769 qed
114.770
114.771 @@ -2626,7 +2797,7 @@
114.772 by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square setsum_reindex[OF finj, unfolded fS] del: One_nat_def)
114.773 then show ?thesis
114.774 unfolding th0
114.775 - unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
114.776 + unfolding real_vector_norm_def real_sqrt_le_iff id_def
114.777 by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
114.778 qed
114.779
114.780 @@ -2683,7 +2854,7 @@
114.781 qed
114.782
114.783 lemma norm_pastecart: "norm(pastecart x y) <= norm(x :: real ^ _) + norm(y)"
114.784 - unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff real_of_real_def id_def
114.785 + unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff id_def
114.786 apply (rule power2_le_imp_le)
114.787 apply (simp add: real_sqrt_pow2[OF add_nonneg_nonneg[OF dot_pos_le[of x] dot_pos_le[of y]]])
114.788 apply (auto simp add: power2_eq_square ring_simps)
114.789 @@ -5007,7 +5178,7 @@
114.790 apply blast
114.791 by (rule abs_ge_zero)
114.792 from real_le_lsqrt[OF dot_pos_le th th1]
114.793 - show ?thesis unfolding real_vector_norm_def real_of_real_def id_def .
114.794 + show ?thesis unfolding real_vector_norm_def id_def .
114.795 qed
114.796
114.797 (* Equality in Cauchy-Schwarz and triangle inequalities. *)
114.798 @@ -5015,10 +5186,10 @@
114.799 lemma norm_cauchy_schwarz_eq: "(x::real ^'n) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
114.800 proof-
114.801 {assume h: "x = 0"
114.802 - hence ?thesis by (simp add: norm_0)}
114.803 + hence ?thesis by simp}
114.804 moreover
114.805 {assume h: "y = 0"
114.806 - hence ?thesis by (simp add: norm_0)}
114.807 + hence ?thesis by simp}
114.808 moreover
114.809 {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
114.810 from dot_eq_0[of "norm y *s x - norm x *s y"]
114.811 @@ -5032,7 +5203,7 @@
114.812 also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
114.813 by (simp add: ring_simps dot_sym)
114.814 also have "\<dots> \<longleftrightarrow> ?lhs" using x y
114.815 - apply (simp add: norm_eq_0)
114.816 + apply simp
114.817 by metis
114.818 finally have ?thesis by blast}
114.819 ultimately show ?thesis by blast
114.820 @@ -5043,14 +5214,14 @@
114.821 proof-
114.822 have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
114.823 have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
114.824 - apply (simp add: norm_neg) by vector
114.825 + apply simp by vector
114.826 also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
114.827 (-x) \<bullet> y = norm x * norm y)"
114.828 unfolding norm_cauchy_schwarz_eq[symmetric]
114.829 - unfolding norm_neg
114.830 + unfolding norm_minus_cancel
114.831 norm_mul by blast
114.832 also have "\<dots> \<longleftrightarrow> ?lhs"
114.833 - unfolding th[OF mult_nonneg_nonneg, OF norm_pos_le[of x] norm_pos_le[of y]] dot_lneg
114.834 + unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
114.835 by arith
114.836 finally show ?thesis ..
114.837 qed
114.838 @@ -5058,17 +5229,17 @@
114.839 lemma norm_triangle_eq: "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
114.840 proof-
114.841 {assume x: "x =0 \<or> y =0"
114.842 - hence ?thesis by (cases "x=0", simp_all add: norm_0)}
114.843 + hence ?thesis by (cases "x=0", simp_all)}
114.844 moreover
114.845 {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
114.846 hence "norm x \<noteq> 0" "norm y \<noteq> 0"
114.847 - by (simp_all add: norm_eq_0)
114.848 + by simp_all
114.849 hence n: "norm x > 0" "norm y > 0"
114.850 - using norm_pos_le[of x] norm_pos_le[of y]
114.851 + using norm_ge_zero[of x] norm_ge_zero[of y]
114.852 by arith+
114.853 have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
114.854 have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
114.855 - apply (rule th) using n norm_pos_le[of "x + y"]
114.856 + apply (rule th) using n norm_ge_zero[of "x + y"]
114.857 by arith
114.858 also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
114.859 unfolding norm_cauchy_schwarz_eq[symmetric]
114.860 @@ -5138,8 +5309,8 @@
114.861
114.862 lemma norm_cauchy_schwarz_equal: "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
114.863 unfolding norm_cauchy_schwarz_abs_eq
114.864 -apply (cases "x=0", simp_all add: collinear_2 norm_0)
114.865 -apply (cases "y=0", simp_all add: collinear_2 norm_0 insert_commute)
114.866 +apply (cases "x=0", simp_all add: collinear_2)
114.867 +apply (cases "y=0", simp_all add: collinear_2 insert_commute)
114.868 unfolding collinear_lemma
114.869 apply simp
114.870 apply (subgoal_tac "norm x \<noteq> 0")
114.871 @@ -5164,8 +5335,8 @@
114.872 apply (simp add: ring_simps)
114.873 apply (case_tac "c <= 0", simp add: ring_simps)
114.874 apply (simp add: ring_simps)
114.875 -apply (simp add: norm_eq_0)
114.876 -apply (simp add: norm_eq_0)
114.877 +apply simp
114.878 +apply simp
114.879 done
114.880
114.881 -end
114.882 \ No newline at end of file
114.883 +end
115.1 --- a/src/HOL/Library/Float.thy Wed Mar 04 10:43:39 2009 +0100
115.2 +++ b/src/HOL/Library/Float.thy Wed Mar 04 10:45:52 2009 +0100
115.3 @@ -1,7 +1,10 @@
115.4 -(* Title: HOL/Library/Float.thy
115.5 - * Author: Steven Obua 2008
115.6 - * Johannes Hölzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
115.7 - *)
115.8 +(* Title: HOL/Library/Float.thy
115.9 + Author: Steven Obua 2008
115.10 + Author: Johannes Hoelzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
115.11 +*)
115.12 +
115.13 +header {* Floating-Point Numbers *}
115.14 +
115.15 theory Float
115.16 imports Complex_Main
115.17 begin
115.18 @@ -792,7 +795,7 @@
115.19 have "x \<noteq> y"
115.20 proof (rule ccontr)
115.21 assume "\<not> x \<noteq> y" hence "x = y" by auto
115.22 - have "?X mod y = 0" unfolding `x = y` using zmod_zmult_self2 by auto
115.23 + have "?X mod y = 0" unfolding `x = y` using mod_mult_self1_is_0 by auto
115.24 thus False using False by auto
115.25 qed
115.26 hence "x < y" using `x \<le> y` by auto
115.27 @@ -1090,7 +1093,7 @@
115.28 { have "2^(prec - 1) * m \<le> 2^(prec - 1) * 2^?b" using `m < 2^?b`[THEN less_imp_le] by (rule mult_left_mono, auto)
115.29 also have "\<dots> = 2 ^ nat (int prec + bitlen m - 1)" unfolding pow_split zpower_zadd_distrib by auto
115.30 finally have "2^(prec - 1) * m div m \<le> 2 ^ nat (int prec + bitlen m - 1) div m" using `0 < m` by (rule zdiv_mono1)
115.31 - hence "2^(prec - 1) \<le> 2 ^ nat (int prec + bitlen m - 1) div m" unfolding zdiv_zmult_self1[OF `m \<noteq> 0`] .
115.32 + hence "2^(prec - 1) \<le> 2 ^ nat (int prec + bitlen m - 1) div m" unfolding div_mult_self2_is_id[OF `m \<noteq> 0`] .
115.33 hence "2^(prec - 1) * inverse (2 ^ nat (int prec + bitlen m - 1)) \<le> ?d"
115.34 unfolding real_of_int_le_iff[of "2^(prec - 1)", symmetric] by auto }
115.35 from mult_left_mono[OF this[unfolded pow_split power_add inverse_mult_distrib real_mult_assoc[symmetric] right_inverse[OF pow_not0] real_mult_1], of "2^?e"]
116.1 --- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy Wed Mar 04 10:43:39 2009 +0100
116.2 +++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy Wed Mar 04 10:45:52 2009 +0100
116.3 @@ -177,151 +177,6 @@
116.4 thus ?thesis by blast
116.5 qed
116.6
116.7 -
116.8 -subsection{* Some theorems about Sequences*}
116.9 -text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
116.10 -
116.11 -lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
116.12 - unfolding Ex1_def
116.13 - apply (rule_tac x="nat_rec e f" in exI)
116.14 - apply (rule conjI)+
116.15 -apply (rule def_nat_rec_0, simp)
116.16 -apply (rule allI, rule def_nat_rec_Suc, simp)
116.17 -apply (rule allI, rule impI, rule ext)
116.18 -apply (erule conjE)
116.19 -apply (induct_tac x)
116.20 -apply (simp add: nat_rec_0)
116.21 -apply (erule_tac x="n" in allE)
116.22 -apply (simp)
116.23 -done
116.24 -
116.25 -text{* for any sequence, there is a mootonic subsequence *}
116.26 -lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
116.27 -proof-
116.28 - {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
116.29 - let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
116.30 - from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
116.31 - obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
116.32 - have "?P (f 0) 0" unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
116.33 - using H apply -
116.34 - apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI)
116.35 - unfolding order_le_less by blast
116.36 - hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
116.37 - {fix n
116.38 - have "?P (f (Suc n)) (f n)"
116.39 - unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
116.40 - using H apply -
116.41 - apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI)
116.42 - unfolding order_le_less by blast
116.43 - hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
116.44 - note fSuc = this
116.45 - {fix p q assume pq: "p \<ge> f q"
116.46 - have "s p \<le> s(f(q))" using f0(2)[rule_format, of p] pq fSuc
116.47 - by (cases q, simp_all) }
116.48 - note pqth = this
116.49 - {fix q
116.50 - have "f (Suc q) > f q" apply (induct q)
116.51 - using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
116.52 - note fss = this
116.53 - from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
116.54 - {fix a b
116.55 - have "f a \<le> f (a + b)"
116.56 - proof(induct b)
116.57 - case 0 thus ?case by simp
116.58 - next
116.59 - case (Suc b)
116.60 - from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
116.61 - qed}
116.62 - note fmon0 = this
116.63 - have "monoseq (\<lambda>n. s (f n))"
116.64 - proof-
116.65 - {fix n
116.66 - have "s (f n) \<ge> s (f (Suc n))"
116.67 - proof(cases n)
116.68 - case 0
116.69 - assume n0: "n = 0"
116.70 - from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
116.71 - from f0(2)[rule_format, OF th0] show ?thesis using n0 by simp
116.72 - next
116.73 - case (Suc m)
116.74 - assume m: "n = Suc m"
116.75 - from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
116.76 - from m fSuc(2)[rule_format, OF th0] show ?thesis by simp
116.77 - qed}
116.78 - thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast
116.79 - qed
116.80 - with th1 have ?thesis by blast}
116.81 - moreover
116.82 - {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
116.83 - {fix p assume p: "p \<ge> Suc N"
116.84 - hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
116.85 - have "m \<noteq> p" using m(2) by auto
116.86 - with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
116.87 - note th0 = this
116.88 - let ?P = "\<lambda>m x. m > x \<and> s x < s m"
116.89 - from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
116.90 - obtain f where f: "f 0 = (SOME x. ?P x (Suc N))"
116.91 - "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
116.92 - have "?P (f 0) (Suc N)" unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
116.93 - using N apply -
116.94 - apply (erule allE[where x="Suc N"], clarsimp)
116.95 - apply (rule_tac x="m" in exI)
116.96 - apply auto
116.97 - apply (subgoal_tac "Suc N \<noteq> m")
116.98 - apply simp
116.99 - apply (rule ccontr, simp)
116.100 - done
116.101 - hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
116.102 - {fix n
116.103 - have "f n > N \<and> ?P (f (Suc n)) (f n)"
116.104 - unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
116.105 - proof (induct n)
116.106 - case 0 thus ?case
116.107 - using f0 N apply auto
116.108 - apply (erule allE[where x="f 0"], clarsimp)
116.109 - apply (rule_tac x="m" in exI, simp)
116.110 - by (subgoal_tac "f 0 \<noteq> m", auto)
116.111 - next
116.112 - case (Suc n)
116.113 - from Suc.hyps have Nfn: "N < f n" by blast
116.114 - from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
116.115 - with Nfn have mN: "m > N" by arith
116.116 - note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
116.117 -
116.118 - from key have th0: "f (Suc n) > N" by simp
116.119 - from N[rule_format, OF th0]
116.120 - obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
116.121 - have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
116.122 - hence "m' > f (Suc n)" using m'(1) by simp
116.123 - with key m'(2) show ?case by auto
116.124 - qed}
116.125 - note fSuc = this
116.126 - {fix n
116.127 - have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto
116.128 - hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
116.129 - note thf = this
116.130 - have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
116.131 - have "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc using thf
116.132 - apply -
116.133 - apply (rule disjI1)
116.134 - apply auto
116.135 - apply (rule order_less_imp_le)
116.136 - apply blast
116.137 - done
116.138 - then have ?thesis using sqf by blast}
116.139 - ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
116.140 -qed
116.141 -
116.142 -lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
116.143 -proof(induct n)
116.144 - case 0 thus ?case by simp
116.145 -next
116.146 - case (Suc n)
116.147 - from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
116.148 - have "n < f (Suc n)" by arith
116.149 - thus ?case by arith
116.150 -qed
116.151 -
116.152 subsection {* Fundamental theorem of algebra *}
116.153 lemma unimodular_reduce_norm:
116.154 assumes md: "cmod z = 1"
116.155 @@ -407,7 +262,6 @@
116.156 ultimately show "\<exists>z. ?P z n" by blast
116.157 qed
116.158
116.159 -
116.160 text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
116.161
116.162 lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
116.163 @@ -946,90 +800,6 @@
116.164 ultimately show ?case by blast
116.165 qed simp
116.166
116.167 -subsection {* Order of polynomial roots *}
116.168 -
116.169 -definition
116.170 - order :: "'a::{idom,recpower} \<Rightarrow> 'a poly \<Rightarrow> nat"
116.171 -where
116.172 - [code del]:
116.173 - "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
116.174 -
116.175 -lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
116.176 -by (induct n, simp, auto intro: order_trans degree_mult_le)
116.177 -
116.178 -lemma coeff_linear_power:
116.179 - fixes a :: "'a::{comm_semiring_1,recpower}"
116.180 - shows "coeff ([:a, 1:] ^ n) n = 1"
116.181 -apply (induct n, simp_all)
116.182 -apply (subst coeff_eq_0)
116.183 -apply (auto intro: le_less_trans degree_power_le)
116.184 -done
116.185 -
116.186 -lemma degree_linear_power:
116.187 - fixes a :: "'a::{comm_semiring_1,recpower}"
116.188 - shows "degree ([:a, 1:] ^ n) = n"
116.189 -apply (rule order_antisym)
116.190 -apply (rule ord_le_eq_trans [OF degree_power_le], simp)
116.191 -apply (rule le_degree, simp add: coeff_linear_power)
116.192 -done
116.193 -
116.194 -lemma order_1: "[:-a, 1:] ^ order a p dvd p"
116.195 -apply (cases "p = 0", simp)
116.196 -apply (cases "order a p", simp)
116.197 -apply (subgoal_tac "nat < (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)")
116.198 -apply (drule not_less_Least, simp)
116.199 -apply (fold order_def, simp)
116.200 -done
116.201 -
116.202 -lemma order_2: "p \<noteq> 0 \<Longrightarrow> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
116.203 -unfolding order_def
116.204 -apply (rule LeastI_ex)
116.205 -apply (rule_tac x="degree p" in exI)
116.206 -apply (rule notI)
116.207 -apply (drule (1) dvd_imp_degree_le)
116.208 -apply (simp only: degree_linear_power)
116.209 -done
116.210 -
116.211 -lemma order:
116.212 - "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
116.213 -by (rule conjI [OF order_1 order_2])
116.214 -
116.215 -lemma order_degree:
116.216 - assumes p: "p \<noteq> 0"
116.217 - shows "order a p \<le> degree p"
116.218 -proof -
116.219 - have "order a p = degree ([:-a, 1:] ^ order a p)"
116.220 - by (simp only: degree_linear_power)
116.221 - also have "\<dots> \<le> degree p"
116.222 - using order_1 p by (rule dvd_imp_degree_le)
116.223 - finally show ?thesis .
116.224 -qed
116.225 -
116.226 -lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0"
116.227 -apply (cases "p = 0", simp_all)
116.228 -apply (rule iffI)
116.229 -apply (rule ccontr, simp)
116.230 -apply (frule order_2 [where a=a], simp)
116.231 -apply (simp add: poly_eq_0_iff_dvd)
116.232 -apply (simp add: poly_eq_0_iff_dvd)
116.233 -apply (simp only: order_def)
116.234 -apply (drule not_less_Least, simp)
116.235 -done
116.236 -
116.237 -lemma poly_zero:
116.238 - fixes p :: "'a::{idom,ring_char_0} poly"
116.239 - shows "poly p = poly 0 \<longleftrightarrow> p = 0"
116.240 -apply (cases "p = 0", simp_all)
116.241 -apply (drule poly_roots_finite)
116.242 -apply (auto simp add: infinite_UNIV_char_0)
116.243 -done
116.244 -
116.245 -lemma poly_eq_iff:
116.246 - fixes p q :: "'a::{idom,ring_char_0} poly"
116.247 - shows "poly p = poly q \<longleftrightarrow> p = q"
116.248 - using poly_zero [of "p - q"]
116.249 - by (simp add: expand_fun_eq)
116.250 -
116.251
116.252 subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
116.253
117.1 --- a/src/HOL/Library/Library.thy Wed Mar 04 10:43:39 2009 +0100
117.2 +++ b/src/HOL/Library/Library.thy Wed Mar 04 10:45:52 2009 +0100
117.3 @@ -5,6 +5,7 @@
117.4 AssocList
117.5 BigO
117.6 Binomial
117.7 + Bit
117.8 Boolean_Algebra
117.9 Char_ord
117.10 Code_Char_chr
117.11 @@ -22,9 +23,11 @@
117.12 Executable_Set
117.13 Float
117.14 Formal_Power_Series
117.15 + FrechetDeriv
117.16 FuncSet
117.17 Fundamental_Theorem_Algebra
117.18 Infinite_Set
117.19 + Inner_Product
117.20 ListVector
117.21 Mapping
117.22 Multiset
117.23 @@ -35,7 +38,10 @@
117.24 Option_ord
117.25 Permutation
117.26 Pocklington
117.27 + Poly_Deriv
117.28 + Polynomial
117.29 Primes
117.30 + Product_Vector
117.31 Quickcheck
117.32 Quicksort
117.33 Quotient
118.1 --- a/src/HOL/Library/Numeral_Type.thy Wed Mar 04 10:43:39 2009 +0100
118.2 +++ b/src/HOL/Library/Numeral_Type.thy Wed Mar 04 10:45:52 2009 +0100
118.3 @@ -42,36 +42,87 @@
118.4 end
118.5 *}
118.6
118.7 -lemma card_unit: "CARD(unit) = 1"
118.8 +lemma card_unit [simp]: "CARD(unit) = 1"
118.9 unfolding UNIV_unit by simp
118.10
118.11 -lemma card_bool: "CARD(bool) = 2"
118.12 +lemma card_bool [simp]: "CARD(bool) = 2"
118.13 unfolding UNIV_bool by simp
118.14
118.15 -lemma card_prod: "CARD('a::finite \<times> 'b::finite) = CARD('a) * CARD('b)"
118.16 +lemma card_prod [simp]: "CARD('a \<times> 'b) = CARD('a::finite) * CARD('b::finite)"
118.17 unfolding UNIV_Times_UNIV [symmetric] by (simp only: card_cartesian_product)
118.18
118.19 -lemma card_sum: "CARD('a::finite + 'b::finite) = CARD('a) + CARD('b)"
118.20 +lemma card_sum [simp]: "CARD('a + 'b) = CARD('a::finite) + CARD('b::finite)"
118.21 unfolding UNIV_Plus_UNIV [symmetric] by (simp only: finite card_Plus)
118.22
118.23 -lemma card_option: "CARD('a::finite option) = Suc CARD('a)"
118.24 +lemma card_option [simp]: "CARD('a option) = Suc CARD('a::finite)"
118.25 unfolding insert_None_conv_UNIV [symmetric]
118.26 apply (subgoal_tac "(None::'a option) \<notin> range Some")
118.27 - apply (simp add: finite card_image)
118.28 + apply (simp add: card_image)
118.29 apply fast
118.30 done
118.31
118.32 -lemma card_set: "CARD('a::finite set) = 2 ^ CARD('a)"
118.33 +lemma card_set [simp]: "CARD('a set) = 2 ^ CARD('a::finite)"
118.34 unfolding Pow_UNIV [symmetric]
118.35 by (simp only: card_Pow finite numeral_2_eq_2)
118.36
118.37 +lemma card_nat [simp]: "CARD(nat) = 0"
118.38 + by (simp add: infinite_UNIV_nat card_eq_0_iff)
118.39 +
118.40 +
118.41 +subsection {* Classes with at least 1 and 2 *}
118.42 +
118.43 +text {* Class finite already captures "at least 1" *}
118.44 +
118.45 +lemma zero_less_card_finite [simp]: "0 < CARD('a::finite)"
118.46 + unfolding neq0_conv [symmetric] by simp
118.47 +
118.48 +lemma one_le_card_finite [simp]: "Suc 0 \<le> CARD('a::finite)"
118.49 + by (simp add: less_Suc_eq_le [symmetric])
118.50 +
118.51 +text {* Class for cardinality "at least 2" *}
118.52 +
118.53 +class card2 = finite +
118.54 + assumes two_le_card: "2 \<le> CARD('a)"
118.55 +
118.56 +lemma one_less_card: "Suc 0 < CARD('a::card2)"
118.57 + using two_le_card [where 'a='a] by simp
118.58 +
118.59 +lemma one_less_int_card: "1 < int CARD('a::card2)"
118.60 + using one_less_card [where 'a='a] by simp
118.61 +
118.62
118.63 subsection {* Numeral Types *}
118.64
118.65 typedef (open) num0 = "UNIV :: nat set" ..
118.66 typedef (open) num1 = "UNIV :: unit set" ..
118.67 -typedef (open) 'a bit0 = "UNIV :: (bool * 'a) set" ..
118.68 -typedef (open) 'a bit1 = "UNIV :: (bool * 'a) option set" ..
118.69 +
118.70 +typedef (open) 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
118.71 +proof
118.72 + show "0 \<in> {0 ..< 2 * int CARD('a)}"
118.73 + by simp
118.74 +qed
118.75 +
118.76 +typedef (open) 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
118.77 +proof
118.78 + show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
118.79 + by simp
118.80 +qed
118.81 +
118.82 +lemma card_num0 [simp]: "CARD (num0) = 0"
118.83 + unfolding type_definition.card [OF type_definition_num0]
118.84 + by simp
118.85 +
118.86 +lemma card_num1 [simp]: "CARD(num1) = 1"
118.87 + unfolding type_definition.card [OF type_definition_num1]
118.88 + by (simp only: card_unit)
118.89 +
118.90 +lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
118.91 + unfolding type_definition.card [OF type_definition_bit0]
118.92 + by simp
118.93 +
118.94 +lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
118.95 + unfolding type_definition.card [OF type_definition_bit1]
118.96 + by simp
118.97
118.98 instance num1 :: finite
118.99 proof
118.100 @@ -80,46 +131,263 @@
118.101 using finite by (rule finite_imageI)
118.102 qed
118.103
118.104 -instance bit0 :: (finite) finite
118.105 +instance bit0 :: (finite) card2
118.106 proof
118.107 show "finite (UNIV::'a bit0 set)"
118.108 unfolding type_definition.univ [OF type_definition_bit0]
118.109 - using finite by (rule finite_imageI)
118.110 + by simp
118.111 + show "2 \<le> CARD('a bit0)"
118.112 + by simp
118.113 qed
118.114
118.115 -instance bit1 :: (finite) finite
118.116 +instance bit1 :: (finite) card2
118.117 proof
118.118 show "finite (UNIV::'a bit1 set)"
118.119 unfolding type_definition.univ [OF type_definition_bit1]
118.120 - using finite by (rule finite_imageI)
118.121 + by simp
118.122 + show "2 \<le> CARD('a bit1)"
118.123 + by simp
118.124 qed
118.125
118.126 -lemma card_num1: "CARD(num1) = 1"
118.127 - unfolding type_definition.card [OF type_definition_num1]
118.128 - by (simp only: card_unit)
118.129
118.130 -lemma card_bit0: "CARD('a::finite bit0) = 2 * CARD('a)"
118.131 - unfolding type_definition.card [OF type_definition_bit0]
118.132 - by (simp only: card_prod card_bool)
118.133 +subsection {* Locale for modular arithmetic subtypes *}
118.134
118.135 -lemma card_bit1: "CARD('a::finite bit1) = Suc (2 * CARD('a))"
118.136 - unfolding type_definition.card [OF type_definition_bit1]
118.137 - by (simp only: card_prod card_option card_bool)
118.138 +locale mod_type =
118.139 + fixes n :: int
118.140 + and Rep :: "'a::{zero,one,plus,times,uminus,minus,power} \<Rightarrow> int"
118.141 + and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus,power}"
118.142 + assumes type: "type_definition Rep Abs {0..<n}"
118.143 + and size1: "1 < n"
118.144 + and zero_def: "0 = Abs 0"
118.145 + and one_def: "1 = Abs 1"
118.146 + and add_def: "x + y = Abs ((Rep x + Rep y) mod n)"
118.147 + and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
118.148 + and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
118.149 + and minus_def: "- x = Abs ((- Rep x) mod n)"
118.150 + and power_def: "x ^ k = Abs (Rep x ^ k mod n)"
118.151 +begin
118.152
118.153 -lemma card_num0: "CARD (num0) = 0"
118.154 - by (simp add: infinite_UNIV_nat card_eq_0_iff type_definition.card [OF type_definition_num0])
118.155 +lemma size0: "0 < n"
118.156 +by (cut_tac size1, simp)
118.157
118.158 -lemmas card_univ_simps [simp] =
118.159 - card_unit
118.160 - card_bool
118.161 - card_prod
118.162 - card_sum
118.163 - card_option
118.164 - card_set
118.165 - card_num1
118.166 - card_bit0
118.167 - card_bit1
118.168 - card_num0
118.169 +lemmas definitions =
118.170 + zero_def one_def add_def mult_def minus_def diff_def power_def
118.171 +
118.172 +lemma Rep_less_n: "Rep x < n"
118.173 +by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
118.174 +
118.175 +lemma Rep_le_n: "Rep x \<le> n"
118.176 +by (rule Rep_less_n [THEN order_less_imp_le])
118.177 +
118.178 +lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
118.179 +by (rule type_definition.Rep_inject [OF type, symmetric])
118.180 +
118.181 +lemma Rep_inverse: "Abs (Rep x) = x"
118.182 +by (rule type_definition.Rep_inverse [OF type])
118.183 +
118.184 +lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
118.185 +by (rule type_definition.Abs_inverse [OF type])
118.186 +
118.187 +lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
118.188 +by (simp add: Abs_inverse IntDiv.pos_mod_conj [OF size0])
118.189 +
118.190 +lemma Rep_Abs_0: "Rep (Abs 0) = 0"
118.191 +by (simp add: Abs_inverse size0)
118.192 +
118.193 +lemma Rep_0: "Rep 0 = 0"
118.194 +by (simp add: zero_def Rep_Abs_0)
118.195 +
118.196 +lemma Rep_Abs_1: "Rep (Abs 1) = 1"
118.197 +by (simp add: Abs_inverse size1)
118.198 +
118.199 +lemma Rep_1: "Rep 1 = 1"
118.200 +by (simp add: one_def Rep_Abs_1)
118.201 +
118.202 +lemma Rep_mod: "Rep x mod n = Rep x"
118.203 +apply (rule_tac x=x in type_definition.Abs_cases [OF type])
118.204 +apply (simp add: type_definition.Abs_inverse [OF type])
118.205 +apply (simp add: mod_pos_pos_trivial)
118.206 +done
118.207 +
118.208 +lemmas Rep_simps =
118.209 + Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1
118.210 +
118.211 +lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
118.212 +apply (intro_classes, unfold definitions)
118.213 +apply (simp_all add: Rep_simps zmod_simps ring_simps)
118.214 +done
118.215 +
118.216 +lemma recpower: "OFCLASS('a, recpower_class)"
118.217 +apply (intro_classes, unfold definitions)
118.218 +apply (simp_all add: Rep_simps zmod_simps add_ac mult_assoc
118.219 + mod_pos_pos_trivial size1)
118.220 +done
118.221 +
118.222 +end
118.223 +
118.224 +locale mod_ring = mod_type +
118.225 + constrains n :: int
118.226 + and Rep :: "'a::{number_ring,power} \<Rightarrow> int"
118.227 + and Abs :: "int \<Rightarrow> 'a::{number_ring,power}"
118.228 +begin
118.229 +
118.230 +lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
118.231 +apply (induct k)
118.232 +apply (simp add: zero_def)
118.233 +apply (simp add: Rep_simps add_def one_def zmod_simps add_ac)
118.234 +done
118.235 +
118.236 +lemma of_int_eq: "of_int z = Abs (z mod n)"
118.237 +apply (cases z rule: int_diff_cases)
118.238 +apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
118.239 +done
118.240 +
118.241 +lemma Rep_number_of:
118.242 + "Rep (number_of w) = number_of w mod n"
118.243 +by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
118.244 +
118.245 +lemma iszero_number_of:
118.246 + "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
118.247 +by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
118.248 +
118.249 +lemma cases:
118.250 + assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
118.251 + shows "P"
118.252 +apply (cases x rule: type_definition.Abs_cases [OF type])
118.253 +apply (rule_tac z="y" in 1)
118.254 +apply (simp_all add: of_int_eq mod_pos_pos_trivial)
118.255 +done
118.256 +
118.257 +lemma induct:
118.258 + "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
118.259 +by (cases x rule: cases) simp
118.260 +
118.261 +end
118.262 +
118.263 +
118.264 +subsection {* Number ring instances *}
118.265 +
118.266 +text {*
118.267 + Unfortunately a number ring instance is not possible for
118.268 + @{typ num1}, since 0 and 1 are not distinct.
118.269 +*}
118.270 +
118.271 +instantiation num1 :: "{comm_ring,comm_monoid_mult,number,recpower}"
118.272 +begin
118.273 +
118.274 +lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
118.275 + by (induct x, induct y) simp
118.276 +
118.277 +instance proof
118.278 +qed (simp_all add: num1_eq_iff)
118.279 +
118.280 +end
118.281 +
118.282 +instantiation
118.283 + bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus,power}"
118.284 +begin
118.285 +
118.286 +definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
118.287 + "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"
118.288 +
118.289 +definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
118.290 + "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"
118.291 +
118.292 +definition "0 = Abs_bit0 0"
118.293 +definition "1 = Abs_bit0 1"
118.294 +definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
118.295 +definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
118.296 +definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
118.297 +definition "- x = Abs_bit0' (- Rep_bit0 x)"
118.298 +definition "x ^ k = Abs_bit0' (Rep_bit0 x ^ k)"
118.299 +
118.300 +definition "0 = Abs_bit1 0"
118.301 +definition "1 = Abs_bit1 1"
118.302 +definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
118.303 +definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
118.304 +definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
118.305 +definition "- x = Abs_bit1' (- Rep_bit1 x)"
118.306 +definition "x ^ k = Abs_bit1' (Rep_bit1 x ^ k)"
118.307 +
118.308 +instance ..
118.309 +
118.310 +end
118.311 +
118.312 +interpretation bit0!:
118.313 + mod_type "int CARD('a::finite bit0)"
118.314 + "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
118.315 + "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
118.316 +apply (rule mod_type.intro)
118.317 +apply (simp add: int_mult type_definition_bit0)
118.318 +apply (rule one_less_int_card)
118.319 +apply (rule zero_bit0_def)
118.320 +apply (rule one_bit0_def)
118.321 +apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
118.322 +apply (rule times_bit0_def [unfolded Abs_bit0'_def])
118.323 +apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
118.324 +apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
118.325 +apply (rule power_bit0_def [unfolded Abs_bit0'_def])
118.326 +done
118.327 +
118.328 +interpretation bit1!:
118.329 + mod_type "int CARD('a::finite bit1)"
118.330 + "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
118.331 + "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
118.332 +apply (rule mod_type.intro)
118.333 +apply (simp add: int_mult type_definition_bit1)
118.334 +apply (rule one_less_int_card)
118.335 +apply (rule zero_bit1_def)
118.336 +apply (rule one_bit1_def)
118.337 +apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
118.338 +apply (rule times_bit1_def [unfolded Abs_bit1'_def])
118.339 +apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
118.340 +apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
118.341 +apply (rule power_bit1_def [unfolded Abs_bit1'_def])
118.342 +done
118.343 +
118.344 +instance bit0 :: (finite) "{comm_ring_1,recpower}"
118.345 + by (rule bit0.comm_ring_1 bit0.recpower)+
118.346 +
118.347 +instance bit1 :: (finite) "{comm_ring_1,recpower}"
118.348 + by (rule bit1.comm_ring_1 bit1.recpower)+
118.349 +
118.350 +instantiation bit0 and bit1 :: (finite) number_ring
118.351 +begin
118.352 +
118.353 +definition "(number_of w :: _ bit0) = of_int w"
118.354 +
118.355 +definition "(number_of w :: _ bit1) = of_int w"
118.356 +
118.357 +instance proof
118.358 +qed (rule number_of_bit0_def number_of_bit1_def)+
118.359 +
118.360 +end
118.361 +
118.362 +interpretation bit0!:
118.363 + mod_ring "int CARD('a::finite bit0)"
118.364 + "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
118.365 + "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
118.366 + ..
118.367 +
118.368 +interpretation bit1!:
118.369 + mod_ring "int CARD('a::finite bit1)"
118.370 + "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
118.371 + "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
118.372 + ..
118.373 +
118.374 +text {* Set up cases, induction, and arithmetic *}
118.375 +
118.376 +lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
118.377 +lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases
118.378 +
118.379 +lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
118.380 +lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
118.381 +
118.382 +lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
118.383 +lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
118.384 +
118.385 +declare power_Suc [where ?'a="'a::finite bit0", standard, simp]
118.386 +declare power_Suc [where ?'a="'a::finite bit1", standard, simp]
118.387
118.388
118.389 subsection {* Syntax *}
118.390 @@ -184,42 +452,10 @@
118.391 in [("bit0", bit_tr' 0), ("bit1", bit_tr' 1)] end;
118.392 *}
118.393
118.394 -
118.395 -subsection {* Classes with at least 1 and 2 *}
118.396 -
118.397 -text {* Class finite already captures "at least 1" *}
118.398 -
118.399 -lemma zero_less_card_finite [simp]:
118.400 - "0 < CARD('a::finite)"
118.401 -proof (cases "CARD('a::finite) = 0")
118.402 - case False thus ?thesis by (simp del: card_0_eq)
118.403 -next
118.404 - case True
118.405 - thus ?thesis by (simp add: finite)
118.406 -qed
118.407 -
118.408 -lemma one_le_card_finite [simp]:
118.409 - "Suc 0 <= CARD('a::finite)"
118.410 - by (simp add: less_Suc_eq_le [symmetric] zero_less_card_finite)
118.411 -
118.412 -
118.413 -text {* Class for cardinality "at least 2" *}
118.414 -
118.415 -class card2 = finite +
118.416 - assumes two_le_card: "2 <= CARD('a)"
118.417 -
118.418 -lemma one_less_card: "Suc 0 < CARD('a::card2)"
118.419 - using two_le_card [where 'a='a] by simp
118.420 -
118.421 -instance bit0 :: (finite) card2
118.422 - by intro_classes (simp add: one_le_card_finite)
118.423 -
118.424 -instance bit1 :: (finite) card2
118.425 - by intro_classes (simp add: one_le_card_finite)
118.426 -
118.427 subsection {* Examples *}
118.428
118.429 lemma "CARD(0) = 0" by simp
118.430 lemma "CARD(17) = 17" by simp
118.431 +lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp
118.432
118.433 end
119.1 --- a/src/HOL/Library/Order_Relation.thy Wed Mar 04 10:43:39 2009 +0100
119.2 +++ b/src/HOL/Library/Order_Relation.thy Wed Mar 04 10:45:52 2009 +0100
119.3 @@ -10,7 +10,7 @@
119.4
119.5 subsection{* Orders on a set *}
119.6
119.7 -definition "preorder_on A r \<equiv> refl A r \<and> trans r"
119.8 +definition "preorder_on A r \<equiv> refl_on A r \<and> trans r"
119.9
119.10 definition "partial_order_on A r \<equiv> preorder_on A r \<and> antisym r"
119.11
119.12 @@ -57,7 +57,7 @@
119.13
119.14 subsection{* Orders on the field *}
119.15
119.16 -abbreviation "Refl r \<equiv> refl (Field r) r"
119.17 +abbreviation "Refl r \<equiv> refl_on (Field r) r"
119.18
119.19 abbreviation "Preorder r \<equiv> preorder_on (Field r) r"
119.20
119.21 @@ -73,7 +73,7 @@
119.22 lemma subset_Image_Image_iff:
119.23 "\<lbrakk> Preorder r; A \<subseteq> Field r; B \<subseteq> Field r\<rbrakk> \<Longrightarrow>
119.24 r `` A \<subseteq> r `` B \<longleftrightarrow> (\<forall>a\<in>A.\<exists>b\<in>B. (b,a):r)"
119.25 -apply(auto simp add: subset_eq preorder_on_def refl_def Image_def)
119.26 +apply(auto simp add: subset_eq preorder_on_def refl_on_def Image_def)
119.27 apply metis
119.28 by(metis trans_def)
119.29
119.30 @@ -83,7 +83,7 @@
119.31
119.32 lemma Refl_antisym_eq_Image1_Image1_iff:
119.33 "\<lbrakk>Refl r; antisym r; a:Field r; b:Field r\<rbrakk> \<Longrightarrow> r `` {a} = r `` {b} \<longleftrightarrow> a=b"
119.34 -by(simp add: expand_set_eq antisym_def refl_def) metis
119.35 +by(simp add: expand_set_eq antisym_def refl_on_def) metis
119.36
119.37 lemma Partial_order_eq_Image1_Image1_iff:
119.38 "\<lbrakk>Partial_order r; a:Field r; b:Field r\<rbrakk> \<Longrightarrow> r `` {a} = r `` {b} \<longleftrightarrow> a=b"
120.1 --- a/src/HOL/Library/Permutations.thy Wed Mar 04 10:43:39 2009 +0100
120.2 +++ b/src/HOL/Library/Permutations.thy Wed Mar 04 10:45:52 2009 +0100
120.3 @@ -6,7 +6,7 @@
120.4 header {* Permutations, both general and specifically on finite sets.*}
120.5
120.6 theory Permutations
120.7 -imports Main Finite_Cartesian_Product Parity
120.8 +imports Main Finite_Cartesian_Product Parity Fact
120.9 begin
120.10
120.11 (* Why should I import Main just to solve the Typerep problem! *)
120.12 @@ -683,13 +683,13 @@
120.13 (* ------------------------------------------------------------------------- *)
120.14
120.15 lemma permutes_natset_le:
120.16 - assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S. p i <= i" shows "p = id"
120.17 + assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S. p i <= i" shows "p = id"
120.18 proof-
120.19 {fix n
120.20 have "p n = n"
120.21 using p le
120.22 - proof(induct n arbitrary: S rule: nat_less_induct)
120.23 - fix n S assume H: "\<forall> m< n. \<forall>S. p permutes S \<longrightarrow> (\<forall>i\<in>S. p i \<le> i) \<longrightarrow> p m = m"
120.24 + proof(induct n arbitrary: S rule: less_induct)
120.25 + fix n S assume H: "\<And>m S. \<lbrakk>m < n; p permutes S; \<forall>i\<in>S. p i \<le> i\<rbrakk> \<Longrightarrow> p m = m"
120.26 "p permutes S" "\<forall>i \<in>S. p i \<le> i"
120.27 {assume "n \<notin> S"
120.28 with H(2) have "p n = n" unfolding permutes_def by metis}
120.29 @@ -699,7 +699,7 @@
120.30 moreover{assume h: "p n < n"
120.31 from H h have "p (p n) = p n" by metis
120.32 with permutes_inj[OF H(2)] have "p n = n" unfolding inj_on_def by blast
120.33 - with h have False by arith}
120.34 + with h have False by simp}
120.35 ultimately have "p n = n" by blast }
120.36 ultimately show "p n = n" by blast
120.37 qed}
120.38 @@ -707,7 +707,7 @@
120.39 qed
120.40
120.41 lemma permutes_natset_ge:
120.42 - assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S. p i \<ge> i" shows "p = id"
120.43 + assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S. p i \<ge> i" shows "p = id"
120.44 proof-
120.45 {fix i assume i: "i \<in> S"
120.46 from i permutes_in_image[OF permutes_inv[OF p]] have "inv p i \<in> S" by simp
120.47 @@ -757,13 +757,13 @@
120.48 done
120.49
120.50 term setsum
120.51 -lemma setsum_permutations_inverse: "setsum f {p. p permutes {m..n}} = setsum (\<lambda>p. f(inv p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
120.52 +lemma setsum_permutations_inverse: "setsum f {p. p permutes S} = setsum (\<lambda>p. f(inv p)) {p. p permutes S}" (is "?lhs = ?rhs")
120.53 proof-
120.54 - let ?S = "{p . p permutes {m .. n}}"
120.55 + let ?S = "{p . p permutes S}"
120.56 have th0: "inj_on inv ?S"
120.57 proof(auto simp add: inj_on_def)
120.58 fix q r
120.59 - assume q: "q permutes {m .. n}" and r: "r permutes {m .. n}" and qr: "inv q = inv r"
120.60 + assume q: "q permutes S" and r: "r permutes S" and qr: "inv q = inv r"
120.61 hence "inv (inv q) = inv (inv r)" by simp
120.62 with permutes_inv_inv[OF q] permutes_inv_inv[OF r]
120.63 show "q = r" by metis
120.64 @@ -774,17 +774,17 @@
120.65 qed
120.66
120.67 lemma setum_permutations_compose_left:
120.68 - assumes q: "q permutes {m..n}"
120.69 - shows "setsum f {p. p permutes {m..n}} =
120.70 - setsum (\<lambda>p. f(q o p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
120.71 + assumes q: "q permutes S"
120.72 + shows "setsum f {p. p permutes S} =
120.73 + setsum (\<lambda>p. f(q o p)) {p. p permutes S}" (is "?lhs = ?rhs")
120.74 proof-
120.75 - let ?S = "{p. p permutes {m..n}}"
120.76 + let ?S = "{p. p permutes S}"
120.77 have th0: "?rhs = setsum (f o (op o q)) ?S" by (simp add: o_def)
120.78 have th1: "inj_on (op o q) ?S"
120.79 apply (auto simp add: inj_on_def)
120.80 proof-
120.81 fix p r
120.82 - assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "q \<circ> p = q \<circ> r"
120.83 + assume "p permutes S" and r:"r permutes S" and rp: "q \<circ> p = q \<circ> r"
120.84 hence "inv q o q o p = inv q o q o r" by (simp add: o_assoc[symmetric])
120.85 with permutes_inj[OF q, unfolded inj_iff]
120.86
120.87 @@ -796,17 +796,17 @@
120.88 qed
120.89
120.90 lemma sum_permutations_compose_right:
120.91 - assumes q: "q permutes {m..n}"
120.92 - shows "setsum f {p. p permutes {m..n}} =
120.93 - setsum (\<lambda>p. f(p o q)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
120.94 + assumes q: "q permutes S"
120.95 + shows "setsum f {p. p permutes S} =
120.96 + setsum (\<lambda>p. f(p o q)) {p. p permutes S}" (is "?lhs = ?rhs")
120.97 proof-
120.98 - let ?S = "{p. p permutes {m..n}}"
120.99 + let ?S = "{p. p permutes S}"
120.100 have th0: "?rhs = setsum (f o (\<lambda>p. p o q)) ?S" by (simp add: o_def)
120.101 have th1: "inj_on (\<lambda>p. p o q) ?S"
120.102 apply (auto simp add: inj_on_def)
120.103 proof-
120.104 fix p r
120.105 - assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "p o q = r o q"
120.106 + assume "p permutes S" and r:"r permutes S" and rp: "p o q = r o q"
120.107 hence "p o (q o inv q) = r o (q o inv q)" by (simp add: o_assoc)
120.108 with permutes_surj[OF q, unfolded surj_iff]
120.109
121.1 --- a/src/HOL/Library/Pocklington.thy Wed Mar 04 10:43:39 2009 +0100
121.2 +++ b/src/HOL/Library/Pocklington.thy Wed Mar 04 10:45:52 2009 +0100
121.3 @@ -142,10 +142,10 @@
121.4 shows "[x * y = x' * y'] (mod n)"
121.5 proof-
121.6 have "(x * y) mod n = (x mod n) * (y mod n) mod n"
121.7 - by (simp add: mod_mult1_eq'[of x y n] mod_mult1_eq[of "x mod n" y n])
121.8 + by (simp add: mod_mult_left_eq[of x y n] mod_mult_right_eq[of "x mod n" y n])
121.9 also have "\<dots> = (x' mod n) * (y' mod n) mod n" using xx'[unfolded modeq_def] yy'[unfolded modeq_def] by simp
121.10 also have "\<dots> = (x' * y') mod n"
121.11 - by (simp add: mod_mult1_eq'[of x' y' n] mod_mult1_eq[of "x' mod n" y' n])
121.12 + by (simp add: mod_mult_left_eq[of x' y' n] mod_mult_right_eq[of "x' mod n" y' n])
121.13 finally show ?thesis unfolding modeq_def .
121.14 qed
121.15
121.16 @@ -296,7 +296,7 @@
121.17 from cong_solve[OF an] obtain x where x: "[a*x = b] (mod n)" by blast
121.18 let ?x = "x mod n"
121.19 from x have th: "[a * ?x = b] (mod n)"
121.20 - by (simp add: modeq_def mod_mult1_eq[of a x n])
121.21 + by (simp add: modeq_def mod_mult_right_eq[of a x n])
121.22 from mod_less_divisor[ of n x] nz th have Px: "?P ?x" by simp
121.23 {fix y assume Py: "y < n" "[a * y = b] (mod n)"
121.24 from Py(2) th have "[a * y = a*?x] (mod n)" by (simp add: modeq_def)
121.25 @@ -753,10 +753,10 @@
121.26 next
121.27 case (Suc n)
121.28 have "(x mod m)^(Suc n) mod m = ((x mod m) * (((x mod m) ^ n) mod m)) mod m"
121.29 - by (simp add: mod_mult1_eq[symmetric])
121.30 + by (simp add: mod_mult_right_eq[symmetric])
121.31 also have "\<dots> = ((x mod m) * (x^n mod m)) mod m" using Suc.hyps by simp
121.32 also have "\<dots> = x^(Suc n) mod m"
121.33 - by (simp add: mod_mult1_eq'[symmetric] mod_mult1_eq[symmetric])
121.34 + by (simp add: mod_mult_left_eq[symmetric] mod_mult_right_eq[symmetric])
121.35 finally show ?case .
121.36 qed
121.37
121.38 @@ -873,7 +873,7 @@
121.39 from lh[unfolded nat_mod]
121.40 obtain q1 q2 where q12:"a ^ d + n * q1 = 1 + n * q2" by blast
121.41 hence "a ^ d + n * q1 - n * q2 = 1" by simp
121.42 - with dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp
121.43 + with nat_dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp
121.44 with p(3) have False by simp
121.45 hence ?rhs ..}
121.46 ultimately have ?rhs by blast}
121.47 @@ -891,9 +891,9 @@
121.48 hence "[(a^?o)^?q * (a^?r) = 1] (mod n)"
121.49 by (simp add: modeq_def power_mult[symmetric] power_add[symmetric])
121.50 hence th: "[a^?r = 1] (mod n)"
121.51 - using eqo mod_mult1_eq'[of "(a^?o)^?q" "a^?r" n]
121.52 + using eqo mod_mult_left_eq[of "(a^?o)^?q" "a^?r" n]
121.53 apply (simp add: modeq_def del: One_nat_def)
121.54 - by (simp add: mod_mult1_eq'[symmetric])
121.55 + by (simp add: mod_mult_left_eq[symmetric])
121.56 {assume r: "?r = 0" hence ?rhs by (simp add: dvd_eq_mod_eq_0)}
121.57 moreover
121.58 {assume r: "?r \<noteq> 0"
122.1 --- a/src/HOL/Library/Primes.thy Wed Mar 04 10:43:39 2009 +0100
122.2 +++ b/src/HOL/Library/Primes.thy Wed Mar 04 10:45:52 2009 +0100
122.3 @@ -45,12 +45,14 @@
122.4 by (rule prime_dvd_square) (simp_all add: power2_eq_square)
122.5
122.6
122.7 -lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0" by (induct n, auto)
122.8 +lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0"
122.9 +by (induct n, auto)
122.10 +
122.11 lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \<longleftrightarrow> x < y"
122.12 - using power_less_imp_less_base[of x "Suc n" y] power_strict_mono[of x y "Suc n"]
122.13 - by auto
122.14 +by(metis linorder_not_less not_less0 power_le_imp_le_base power_less_imp_less_base)
122.15 +
122.16 lemma exp_mono_le: "(x::nat) ^ (Suc n) \<le> y ^ (Suc n) \<longleftrightarrow> x \<le> y"
122.17 - by (simp only: linorder_not_less[symmetric] exp_mono_lt)
122.18 +by (simp only: linorder_not_less[symmetric] exp_mono_lt)
122.19
122.20 lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \<longleftrightarrow> x = y"
122.21 using power_inject_base[of x n y] by auto
122.22 @@ -307,8 +309,8 @@
122.23 {fix e assume H: "e dvd a^n" "e dvd b^n"
122.24 from bezout_gcd_pow[of a n b] obtain x y
122.25 where xy: "a ^ n * x - b ^ n * y = ?gn \<or> b ^ n * x - a ^ n * y = ?gn" by blast
122.26 - from dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
122.27 - dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
122.28 + from nat_dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
122.29 + nat_dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
122.30 have "e dvd ?gn" by (cases "a ^ n * x - b ^ n * y = gcd a b ^ n", simp_all)}
122.31 hence th: "\<forall>e. e dvd a^n \<and> e dvd b^n \<longrightarrow> e dvd ?gn" by blast
122.32 from divides_exp[OF gcd_dvd1[of a b], of n] divides_exp[OF gcd_dvd2[of a b], of n] th
123.1 --- a/src/HOL/Library/Word.thy Wed Mar 04 10:43:39 2009 +0100
123.2 +++ b/src/HOL/Library/Word.thy Wed Mar 04 10:45:52 2009 +0100
123.3 @@ -575,7 +575,7 @@
123.4 have "?lhs = (1 + 2 * bv_to_nat w) mod 2"
123.5 by (simp add: add_commute)
123.6 also have "... = 1"
123.7 - by (subst mod_add1_eq) simp
123.8 + by (subst mod_add_eq) simp
123.9 finally have eq1: "?lhs = 1" .
123.10 have "?rhs = 0" by simp
123.11 with orig and eq1
124.1 --- a/src/HOL/Library/Zorn.thy Wed Mar 04 10:43:39 2009 +0100
124.2 +++ b/src/HOL/Library/Zorn.thy Wed Mar 04 10:45:52 2009 +0100
124.3 @@ -297,7 +297,7 @@
124.4 fix a B assume aB: "B:C" "a:B"
124.5 with 1 obtain x where "x:Field r" "B = r^-1 `` {x}" by auto
124.6 thus "(a,u) : r" using uA aB `Preorder r`
124.7 - by (auto simp add: preorder_on_def refl_def) (metis transD)
124.8 + by (auto simp add: preorder_on_def refl_on_def) (metis transD)
124.9 qed
124.10 thus "EX u:Field r. ?P u" using `u:Field r` by blast
124.11 qed
124.12 @@ -322,7 +322,7 @@
124.13 (infix "initial'_segment'_of" 55) where
124.14 "r initial_segment_of s == (r,s):init_seg_of"
124.15
124.16 -lemma refl_init_seg_of[simp]: "r initial_segment_of r"
124.17 +lemma refl_on_init_seg_of[simp]: "r initial_segment_of r"
124.18 by(simp add:init_seg_of_def)
124.19
124.20 lemma trans_init_seg_of:
124.21 @@ -411,7 +411,7 @@
124.22 by(simp add:Chain_def I_def) blast
124.23 have FI: "Field I = ?WO" by(auto simp add:I_def init_seg_of_def Field_def)
124.24 hence 0: "Partial_order I"
124.25 - by(auto simp: partial_order_on_def preorder_on_def antisym_def antisym_init_seg_of refl_def trans_def I_def elim!: trans_init_seg_of)
124.26 + by(auto simp: partial_order_on_def preorder_on_def antisym_def antisym_init_seg_of refl_on_def trans_def I_def elim!: trans_init_seg_of)
124.27 -- {*I-chains have upper bounds in ?WO wrt I: their Union*}
124.28 { fix R assume "R \<in> Chain I"
124.29 hence Ris: "R \<in> Chain init_seg_of" using mono_Chain[OF I_init] by blast
124.30 @@ -420,7 +420,7 @@
124.31 have "\<forall>r\<in>R. Refl r" "\<forall>r\<in>R. trans r" "\<forall>r\<in>R. antisym r" "\<forall>r\<in>R. Total r"
124.32 "\<forall>r\<in>R. wf(r-Id)"
124.33 using Chain_wo[OF `R \<in> Chain I`] by(simp_all add:order_on_defs)
124.34 - have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by(auto simp:refl_def)
124.35 + have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by(auto simp:refl_on_def)
124.36 moreover have "trans (\<Union>R)"
124.37 by(rule chain_subset_trans_Union[OF subch `\<forall>r\<in>R. trans r`])
124.38 moreover have "antisym(\<Union>R)"
124.39 @@ -452,7 +452,7 @@
124.40 proof
124.41 assume "m={}"
124.42 moreover have "Well_order {(x,x)}"
124.43 - by(simp add:order_on_defs refl_def trans_def antisym_def total_on_def Field_def Domain_def Range_def)
124.44 + by(simp add:order_on_defs refl_on_def trans_def antisym_def total_on_def Field_def Domain_def Range_def)
124.45 ultimately show False using max
124.46 by (auto simp:I_def init_seg_of_def simp del:Field_insert)
124.47 qed
124.48 @@ -467,7 +467,7 @@
124.49 have "Refl m" "trans m" "antisym m" "Total m" "wf(m-Id)"
124.50 using `Well_order m` by(simp_all add:order_on_defs)
124.51 --{*We show that the extension is a well-order*}
124.52 - have "Refl ?m" using `Refl m` Fm by(auto simp:refl_def)
124.53 + have "Refl ?m" using `Refl m` Fm by(auto simp:refl_on_def)
124.54 moreover have "trans ?m" using `trans m` `x \<notin> Field m`
124.55 unfolding trans_def Field_def Domain_def Range_def by blast
124.56 moreover have "antisym ?m" using `antisym m` `x \<notin> Field m`
124.57 @@ -500,10 +500,10 @@
124.58 using well_ordering[where 'a = "'a"] by blast
124.59 let ?r = "{(x,y). x:A & y:A & (x,y):r}"
124.60 have 1: "Field ?r = A" using wo univ
124.61 - by(fastsimp simp: Field_def Domain_def Range_def order_on_defs refl_def)
124.62 + by(fastsimp simp: Field_def Domain_def Range_def order_on_defs refl_on_def)
124.63 have "Refl r" "trans r" "antisym r" "Total r" "wf(r-Id)"
124.64 using `Well_order r` by(simp_all add:order_on_defs)
124.65 - have "Refl ?r" using `Refl r` by(auto simp:refl_def 1 univ)
124.66 + have "Refl ?r" using `Refl r` by(auto simp:refl_on_def 1 univ)
124.67 moreover have "trans ?r" using `trans r`
124.68 unfolding trans_def by blast
124.69 moreover have "antisym ?r" using `antisym r`
125.1 --- a/src/HOL/Library/reflection.ML Wed Mar 04 10:43:39 2009 +0100
125.2 +++ b/src/HOL/Library/reflection.ML Wed Mar 04 10:45:52 2009 +0100
125.3 @@ -88,17 +88,12 @@
125.4
125.5 fun dest_listT (Type ("List.list", [T])) = T;
125.6
125.7 -fun partition P [] = ([],[])
125.8 - | partition P (x::xs) =
125.9 - let val (yes,no) = partition P xs
125.10 - in if P x then (x::yes,no) else (yes, x::no) end
125.11 -
125.12 fun rearrange congs =
125.13 let
125.14 fun P (_, th) =
125.15 let val @{term "Trueprop"}$(Const ("op =",_) $l$_) = concl_of th
125.16 in can dest_Var l end
125.17 - val (yes,no) = partition P congs
125.18 + val (yes,no) = List.partition P congs
125.19 in no @ yes end
125.20
125.21 fun genreif ctxt raw_eqs t =
126.1 --- a/src/HOL/List.thy Wed Mar 04 10:43:39 2009 +0100
126.2 +++ b/src/HOL/List.thy Wed Mar 04 10:45:52 2009 +0100
126.3 @@ -1461,6 +1461,12 @@
126.4
126.5 declare take_Cons [simp del] and drop_Cons [simp del]
126.6
126.7 +lemma take_1_Cons [simp]: "take 1 (x # xs) = [x]"
126.8 + unfolding One_nat_def by simp
126.9 +
126.10 +lemma drop_1_Cons [simp]: "drop 1 (x # xs) = xs"
126.11 + unfolding One_nat_def by simp
126.12 +
126.13 lemma take_Suc: "xs ~= [] ==> take (Suc n) xs = hd xs # take n (tl xs)"
126.14 by(clarsimp simp add:neq_Nil_conv)
126.15
126.16 @@ -1592,13 +1598,13 @@
126.17 by (simp add: butlast_conv_take min_max.inf_absorb1 min_max.inf_absorb2)
126.18
126.19 lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)"
126.20 -by (simp add: butlast_conv_take drop_take)
126.21 +by (simp add: butlast_conv_take drop_take add_ac)
126.22
126.23 lemma take_butlast: "n < length xs ==> take n (butlast xs) = take n xs"
126.24 by (simp add: butlast_conv_take min_max.inf_absorb1)
126.25
126.26 lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)"
126.27 -by (simp add: butlast_conv_take drop_take)
126.28 +by (simp add: butlast_conv_take drop_take add_ac)
126.29
126.30 lemma hd_drop_conv_nth: "\<lbrakk> xs \<noteq> []; n < length xs \<rbrakk> \<Longrightarrow> hd(drop n xs) = xs!n"
126.31 by(simp add: hd_conv_nth)
126.32 @@ -1639,7 +1645,7 @@
126.33 done
126.34
126.35 lemma take_hd_drop:
126.36 - "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (n+1) xs"
126.37 + "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs"
126.38 apply(induct xs arbitrary: n)
126.39 apply simp
126.40 apply(simp add:drop_Cons split:nat.split)
126.41 @@ -3220,7 +3226,7 @@
126.42 lemma lenlex_conv:
126.43 "lenlex r = {(xs,ys). length xs < length ys |
126.44 length xs = length ys \<and> (xs, ys) : lex r}"
126.45 -by (simp add: lenlex_def diag_def lex_prod_def inv_image_def)
126.46 +by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def)
126.47
126.48 lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r"
126.49 by (simp add: lex_conv)
126.50 @@ -3386,8 +3392,8 @@
126.51 apply (erule listrel.induct, auto)
126.52 done
126.53
126.54 -lemma listrel_refl: "refl A r \<Longrightarrow> refl (lists A) (listrel r)"
126.55 -apply (simp add: refl_def listrel_subset Ball_def)
126.56 +lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)"
126.57 +apply (simp add: refl_on_def listrel_subset Ball_def)
126.58 apply (rule allI)
126.59 apply (induct_tac x)
126.60 apply (auto intro: listrel.intros)
126.61 @@ -3408,7 +3414,7 @@
126.62 done
126.63
126.64 theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)"
126.65 -by (simp add: equiv_def listrel_refl listrel_sym listrel_trans)
126.66 +by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans)
126.67
126.68 lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}"
126.69 by (blast intro: listrel.intros)
126.70 @@ -3564,52 +3570,51 @@
126.71
126.72 open Basic_Code_Thingol;
126.73
126.74 -fun implode_list (nil', cons') t =
126.75 - let
126.76 - fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
126.77 - if c = cons'
126.78 - then SOME (t1, t2)
126.79 - else NONE
126.80 - | dest_cons _ = NONE;
126.81 - val (ts, t') = Code_Thingol.unfoldr dest_cons t;
126.82 - in case t'
126.83 - of IConst (c, _) => if c = nil' then SOME ts else NONE
126.84 +fun implode_list naming t = case pairself
126.85 + (Code_Thingol.lookup_const naming) (@{const_name Nil}, @{const_name Cons})
126.86 + of (SOME nil', SOME cons') => let
126.87 + fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
126.88 + if c = cons'
126.89 + then SOME (t1, t2)
126.90 + else NONE
126.91 + | dest_cons _ = NONE;
126.92 + val (ts, t') = Code_Thingol.unfoldr dest_cons t;
126.93 + in case t'
126.94 + of IConst (c, _) => if c = nil' then SOME ts else NONE
126.95 + | _ => NONE
126.96 + end
126.97 | _ => NONE
126.98 - end;
126.99 -
126.100 -fun decode_char nibbles' (IConst (c1, _), IConst (c2, _)) =
126.101 - let
126.102 - fun idx c = find_index (curry (op =) c) nibbles';
126.103 - fun decode ~1 _ = NONE
126.104 - | decode _ ~1 = NONE
126.105 - | decode n m = SOME (chr (n * 16 + m));
126.106 - in decode (idx c1) (idx c2) end
126.107 - | decode_char _ _ = NONE;
126.108 -
126.109 -fun implode_string (char', nibbles') mk_char mk_string ts =
126.110 - let
126.111 - fun implode_char (IConst (c, _) `$ t1 `$ t2) =
126.112 - if c = char' then decode_char nibbles' (t1, t2) else NONE
126.113 - | implode_char _ = NONE;
126.114 - val ts' = map implode_char ts;
126.115 - in if forall is_some ts'
126.116 - then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
126.117 - else NONE
126.118 - end;
126.119 -
126.120 -fun list_names naming = pairself (the o Code_Thingol.lookup_const naming)
126.121 - (@{const_name Nil}, @{const_name Cons});
126.122 -fun char_name naming = (the o Code_Thingol.lookup_const naming)
126.123 - @{const_name Char}
126.124 -fun nibble_names naming = map (the o Code_Thingol.lookup_const naming)
126.125 - [@{const_name Nibble0}, @{const_name Nibble1},
126.126 +
126.127 +fun decode_char naming (IConst (c1, _), IConst (c2, _)) = (case map_filter
126.128 + (Code_Thingol.lookup_const naming)[@{const_name Nibble0}, @{const_name Nibble1},
126.129 @{const_name Nibble2}, @{const_name Nibble3},
126.130 @{const_name Nibble4}, @{const_name Nibble5},
126.131 @{const_name Nibble6}, @{const_name Nibble7},
126.132 @{const_name Nibble8}, @{const_name Nibble9},
126.133 @{const_name NibbleA}, @{const_name NibbleB},
126.134 @{const_name NibbleC}, @{const_name NibbleD},
126.135 - @{const_name NibbleE}, @{const_name NibbleF}];
126.136 + @{const_name NibbleE}, @{const_name NibbleF}]
126.137 + of nibbles' as [_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _] => let
126.138 + fun idx c = find_index (curry (op =) c) nibbles';
126.139 + fun decode ~1 _ = NONE
126.140 + | decode _ ~1 = NONE
126.141 + | decode n m = SOME (chr (n * 16 + m));
126.142 + in decode (idx c1) (idx c2) end
126.143 + | _ => NONE)
126.144 + | decode_char _ _ = NONE
126.145 +
126.146 +fun implode_string naming mk_char mk_string ts = case
126.147 + Code_Thingol.lookup_const naming @{const_name Char}
126.148 + of SOME char' => let
126.149 + fun implode_char (IConst (c, _) `$ t1 `$ t2) =
126.150 + if c = char' then decode_char naming (t1, t2) else NONE
126.151 + | implode_char _ = NONE;
126.152 + val ts' = map implode_char ts;
126.153 + in if forall is_some ts'
126.154 + then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
126.155 + else NONE
126.156 + end
126.157 + | _ => NONE;
126.158
126.159 fun default_list (target_fxy, target_cons) pr fxy t1 t2 =
126.160 Code_Printer.brackify_infix (target_fxy, Code_Printer.R) fxy [
126.161 @@ -3622,7 +3627,7 @@
126.162 let
126.163 val mk_list = Code_Printer.literal_list literals;
126.164 fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
126.165 - case Option.map (cons t1) (implode_list (list_names naming) t2)
126.166 + case Option.map (cons t1) (implode_list naming t2)
126.167 of SOME ts => mk_list (map (pr vars Code_Printer.NOBR) ts)
126.168 | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
126.169 in (2, pretty) end;
126.170 @@ -3633,8 +3638,8 @@
126.171 val mk_char = Code_Printer.literal_char literals;
126.172 val mk_string = Code_Printer.literal_string literals;
126.173 fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
126.174 - case Option.map (cons t1) (implode_list (list_names naming) t2)
126.175 - of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
126.176 + case Option.map (cons t1) (implode_list naming t2)
126.177 + of SOME ts => (case implode_string naming mk_char mk_string ts
126.178 of SOME p => p
126.179 | NONE => mk_list (map (pr vars Code_Printer.NOBR) ts))
126.180 | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
126.181 @@ -3644,7 +3649,7 @@
126.182 let
126.183 val mk_char = Code_Printer.literal_char literals;
126.184 fun pretty _ naming thm _ _ [(t1, _), (t2, _)] =
126.185 - case decode_char (nibble_names naming) (t1, t2)
126.186 + case decode_char naming (t1, t2)
126.187 of SOME c => (Code_Printer.str o mk_char) c
126.188 | NONE => Code_Printer.nerror thm "Illegal character expression";
126.189 in (2, pretty) end;
126.190 @@ -3654,8 +3659,8 @@
126.191 val mk_char = Code_Printer.literal_char literals;
126.192 val mk_string = Code_Printer.literal_string literals;
126.193 fun pretty _ naming thm _ _ [(t, _)] =
126.194 - case implode_list (list_names naming) t
126.195 - of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
126.196 + case implode_list naming t
126.197 + of SOME ts => (case implode_string naming mk_char mk_string ts
126.198 of SOME p => p
126.199 | NONE => Code_Printer.nerror thm "Illegal message expression")
126.200 | NONE => Code_Printer.nerror thm "Illegal message expression";
127.1 --- a/src/HOL/MacLaurin.thy Wed Mar 04 10:43:39 2009 +0100
127.2 +++ b/src/HOL/MacLaurin.thy Wed Mar 04 10:45:52 2009 +0100
127.3 @@ -81,7 +81,7 @@
127.4 prefer 2 apply simp
127.5 apply (frule less_iff_Suc_add [THEN iffD1], clarify)
127.6 apply (simp del: setsum_op_ivl_Suc)
127.7 - apply (insert sumr_offset4 [of 1])
127.8 + apply (insert sumr_offset4 [of "Suc 0"])
127.9 apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
127.10 apply (rule lemma_DERIV_subst)
127.11 apply (rule DERIV_add)
127.12 @@ -124,7 +124,7 @@
127.13
127.14 have g2: "g 0 = 0 & g h = 0"
127.15 apply (simp add: m f_h g_def del: setsum_op_ivl_Suc)
127.16 - apply (cut_tac n = m and k = 1 in sumr_offset2)
127.17 + apply (cut_tac n = m and k = "Suc 0" in sumr_offset2)
127.18 apply (simp add: eq_diff_eq' diff_0 del: setsum_op_ivl_Suc)
127.19 done
127.20
127.21 @@ -144,7 +144,7 @@
127.22 apply (simp add: m difg_def)
127.23 apply (frule less_iff_Suc_add [THEN iffD1], clarify)
127.24 apply (simp del: setsum_op_ivl_Suc)
127.25 - apply (insert sumr_offset4 [of 1])
127.26 + apply (insert sumr_offset4 [of "Suc 0"])
127.27 apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
127.28 done
127.29
127.30 @@ -552,6 +552,10 @@
127.31 "[|x = y; abs u \<le> (v::real) |] ==> \<bar>(x + u) - y\<bar> \<le> v"
127.32 by auto
127.33
127.34 +text {* TODO: move to Parity.thy *}
127.35 +lemma nat_odd_1 [simp]: "odd (1::nat)"
127.36 + unfolding even_nat_def by simp
127.37 +
127.38 lemma Maclaurin_sin_bound:
127.39 "abs(sin x - (\<Sum>m=0..<n. (if even m then 0 else (-1 ^ ((m - Suc 0) div 2)) / real (fact m)) *
127.40 x ^ m)) \<le> inverse(real (fact n)) * \<bar>x\<bar> ^ n"
128.1 --- a/src/HOL/MetisExamples/Tarski.thy Wed Mar 04 10:43:39 2009 +0100
128.2 +++ b/src/HOL/MetisExamples/Tarski.thy Wed Mar 04 10:45:52 2009 +0100
128.3 @@ -61,7 +61,7 @@
128.4 "Top po == greatest (%x. True) po"
128.5
128.6 PartialOrder :: "('a potype) set"
128.7 - "PartialOrder == {P. refl (pset P) (order P) & antisym (order P) &
128.8 + "PartialOrder == {P. refl_on (pset P) (order P) & antisym (order P) &
128.9 trans (order P)}"
128.10
128.11 CompleteLattice :: "('a potype) set"
128.12 @@ -126,7 +126,7 @@
128.13
128.14 subsection {* Partial Order *}
128.15
128.16 -lemma (in PO) PO_imp_refl: "refl A r"
128.17 +lemma (in PO) PO_imp_refl_on: "refl_on A r"
128.18 apply (insert cl_po)
128.19 apply (simp add: PartialOrder_def A_def r_def)
128.20 done
128.21 @@ -143,7 +143,7 @@
128.22
128.23 lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
128.24 apply (insert cl_po)
128.25 -apply (simp add: PartialOrder_def refl_def A_def r_def)
128.26 +apply (simp add: PartialOrder_def refl_on_def A_def r_def)
128.27 done
128.28
128.29 lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
128.30 @@ -166,7 +166,7 @@
128.31 apply (simp (no_asm) add: PartialOrder_def)
128.32 apply auto
128.33 -- {* refl *}
128.34 -apply (simp add: refl_def induced_def)
128.35 +apply (simp add: refl_on_def induced_def)
128.36 apply (blast intro: reflE)
128.37 -- {* antisym *}
128.38 apply (simp add: antisym_def induced_def)
128.39 @@ -203,7 +203,7 @@
128.40
128.41 lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
128.42 apply (insert cl_po)
128.43 -apply (simp add: PartialOrder_def dual_def refl_converse
128.44 +apply (simp add: PartialOrder_def dual_def refl_on_converse
128.45 trans_converse antisym_converse)
128.46 done
128.47
128.48 @@ -230,12 +230,12 @@
128.49
128.50 lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]
128.51
128.52 -declare PO.PO_imp_refl [OF PO.intro [OF CL_imp_PO], simp]
128.53 +declare PO.PO_imp_refl_on [OF PO.intro [OF CL_imp_PO], simp]
128.54 declare PO.PO_imp_sym [OF PO.intro [OF CL_imp_PO], simp]
128.55 declare PO.PO_imp_trans [OF PO.intro [OF CL_imp_PO], simp]
128.56
128.57 -lemma (in CL) CO_refl: "refl A r"
128.58 -by (rule PO_imp_refl)
128.59 +lemma (in CL) CO_refl_on: "refl_on A r"
128.60 +by (rule PO_imp_refl_on)
128.61
128.62 lemma (in CL) CO_antisym: "antisym r"
128.63 by (rule PO_imp_sym)
128.64 @@ -501,10 +501,10 @@
128.65 apply (rule conjI)
128.66 ML_command{*AtpWrapper.problem_name:="Tarski__CLF_flubH_le_lubH_simpler"*}
128.67 (*??no longer terminates, with combinators
128.68 -apply (metis CO_refl lubH_le_flubH monotone_def monotone_f reflD1 reflD2)
128.69 +apply (metis CO_refl_on lubH_le_flubH monotone_def monotone_f reflD1 reflD2)
128.70 *)
128.71 -apply (metis CO_refl lubH_le_flubH monotoneE [OF monotone_f] reflD1 reflD2)
128.72 -apply (metis CO_refl lubH_le_flubH reflD2)
128.73 +apply (metis CO_refl_on lubH_le_flubH monotoneE [OF monotone_f] refl_onD1 refl_onD2)
128.74 +apply (metis CO_refl_on lubH_le_flubH refl_onD2)
128.75 done
128.76 declare CLF.f_in_funcset[rule del] funcset_mem[rule del]
128.77 CL.lub_in_lattice[rule del] PO.monotoneE[rule del]
128.78 @@ -542,12 +542,12 @@
128.79 by (metis 5 3)
128.80 have 7: "(lub H cl, lub H cl) \<in> r"
128.81 by (metis 6 4)
128.82 -have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl X1 r"
128.83 - by (metis 7 reflD2)
128.84 -have 9: "\<not> refl A r"
128.85 +have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl_on X1 r"
128.86 + by (metis 7 refl_onD2)
128.87 +have 9: "\<not> refl_on A r"
128.88 by (metis 8 2)
128.89 show "False"
128.90 - by (metis CO_refl 9);
128.91 + by (metis CO_refl_on 9);
128.92 next --{*apparently the way to insert a second structured proof*}
128.93 show "H = {x. (x, f x) \<in> r \<and> x \<in> A} \<Longrightarrow>
128.94 f (lub {x. (x, f x) \<in> r \<and> x \<in> A} cl) = lub {x. (x, f x) \<in> r \<and> x \<in> A} cl"
128.95 @@ -589,13 +589,13 @@
128.96 apply (simp add: fix_def)
128.97 apply (rule conjI)
128.98 ML_command{*AtpWrapper.problem_name:="Tarski__CLF_lubH_is_fixp_simpler"*}
128.99 -apply (metis CO_refl lubH_le_flubH reflD1)
128.100 +apply (metis CO_refl_on lubH_le_flubH refl_onD1)
128.101 apply (metis antisymE flubH_le_lubH lubH_le_flubH)
128.102 done
128.103
128.104 lemma (in CLF) fix_in_H:
128.105 "[| H = {x. (x, f x) \<in> r & x \<in> A}; x \<in> P |] ==> x \<in> H"
128.106 -by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl
128.107 +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
128.108 fix_subset [of f A, THEN subsetD])
128.109
128.110
128.111 @@ -678,16 +678,16 @@
128.112
128.113
128.114 ML{*AtpWrapper.problem_name:="Tarski__rel_imp_elem"*}
128.115 - declare (in CLF) CO_refl[simp] refl_def [simp]
128.116 + declare (in CLF) CO_refl_on[simp] refl_on_def [simp]
128.117 lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
128.118 -by (metis CO_refl reflD1)
128.119 - declare (in CLF) CO_refl[simp del] refl_def [simp del]
128.120 +by (metis CO_refl_on refl_onD1)
128.121 + declare (in CLF) CO_refl_on[simp del] refl_on_def [simp del]
128.122
128.123 ML{*AtpWrapper.problem_name:="Tarski__interval_subset"*}
128.124 declare (in CLF) rel_imp_elem[intro]
128.125 declare interval_def [simp]
128.126 lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
128.127 -by (metis CO_refl interval_imp_mem reflD reflD2 rel_imp_elem subset_eq)
128.128 +by (metis CO_refl_on interval_imp_mem refl_onD refl_onD2 rel_imp_elem subset_eq)
128.129 declare (in CLF) rel_imp_elem[rule del]
128.130 declare interval_def [simp del]
128.131
129.1 --- a/src/HOL/NSA/NSA.thy Wed Mar 04 10:43:39 2009 +0100
129.2 +++ b/src/HOL/NSA/NSA.thy Wed Mar 04 10:45:52 2009 +0100
129.3 @@ -157,7 +157,7 @@
129.4 by transfer (rule norm_divide)
129.5
129.6 lemma hypreal_hnorm_def [simp]:
129.7 - "\<And>r::hypreal. hnorm r \<equiv> \<bar>r\<bar>"
129.8 + "\<And>r::hypreal. hnorm r = \<bar>r\<bar>"
129.9 by transfer (rule real_norm_def)
129.10
129.11 lemma hnorm_add_less:
130.1 --- a/src/HOL/NSA/StarDef.thy Wed Mar 04 10:43:39 2009 +0100
130.2 +++ b/src/HOL/NSA/StarDef.thy Wed Mar 04 10:45:52 2009 +0100
130.3 @@ -64,7 +64,7 @@
130.4
130.5 lemma equiv_starrel: "equiv UNIV starrel"
130.6 proof (rule equiv.intro)
130.7 - show "reflexive starrel" by (simp add: refl_def)
130.8 + show "refl starrel" by (simp add: refl_on_def)
130.9 show "sym starrel" by (simp add: sym_def eq_commute)
130.10 show "trans starrel" by (auto intro: transI elim!: ultra)
130.11 qed
131.1 --- a/src/HOL/Nat.thy Wed Mar 04 10:43:39 2009 +0100
131.2 +++ b/src/HOL/Nat.thy Wed Mar 04 10:45:52 2009 +0100
131.3 @@ -196,8 +196,8 @@
131.4
131.5 instance proof
131.6 fix n m q :: nat
131.7 - show "0 \<noteq> (1::nat)" by simp
131.8 - show "1 * n = n" by simp
131.9 + show "0 \<noteq> (1::nat)" unfolding One_nat_def by simp
131.10 + show "1 * n = n" unfolding One_nat_def by simp
131.11 show "n * m = m * n" by (induct n) simp_all
131.12 show "(n * m) * q = n * (m * q)" by (induct n) (simp_all add: add_mult_distrib)
131.13 show "(n + m) * q = n * q + m * q" by (rule add_mult_distrib)
131.14 @@ -280,6 +280,9 @@
131.15 lemma diff_add_0: "n - (n + m) = (0::nat)"
131.16 by (induct n) simp_all
131.17
131.18 +lemma diff_Suc_1 [simp]: "Suc n - 1 = n"
131.19 + unfolding One_nat_def by simp
131.20 +
131.21 text {* Difference distributes over multiplication *}
131.22
131.23 lemma diff_mult_distrib: "((m::nat) - n) * k = (m * k) - (n * k)"
131.24 @@ -307,18 +310,24 @@
131.25 lemmas nat_distrib =
131.26 add_mult_distrib add_mult_distrib2 diff_mult_distrib diff_mult_distrib2
131.27
131.28 -lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = 1 & n = 1)"
131.29 +lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = Suc 0 & n = Suc 0)"
131.30 apply (induct m)
131.31 apply simp
131.32 apply (induct n)
131.33 apply auto
131.34 done
131.35
131.36 -lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = 1 & n = 1)"
131.37 +lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = Suc 0 & n = Suc 0)"
131.38 apply (rule trans)
131.39 apply (rule_tac [2] mult_eq_1_iff, fastsimp)
131.40 done
131.41
131.42 +lemma nat_mult_eq_1_iff [simp]: "m * n = (1::nat) \<longleftrightarrow> m = 1 \<and> n = 1"
131.43 + unfolding One_nat_def by (rule mult_eq_1_iff)
131.44 +
131.45 +lemma nat_1_eq_mult_iff [simp]: "(1::nat) = m * n \<longleftrightarrow> m = 1 \<and> n = 1"
131.46 + unfolding One_nat_def by (rule one_eq_mult_iff)
131.47 +
131.48 lemma mult_cancel1 [simp]: "(k * m = k * n) = (m = n | (k = (0::nat)))"
131.49 proof -
131.50 have "k \<noteq> 0 \<Longrightarrow> k * m = k * n \<Longrightarrow> m = n"
131.51 @@ -465,11 +474,11 @@
131.52 lemma less_Suc_eq: "(m < Suc n) = (m < n | m = n)"
131.53 unfolding less_Suc_eq_le le_less ..
131.54
131.55 -lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
131.56 +lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
131.57 by (simp add: less_Suc_eq)
131.58
131.59 -lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
131.60 - by (simp add: less_Suc_eq)
131.61 +lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
131.62 + unfolding One_nat_def by (rule less_Suc0)
131.63
131.64 lemma Suc_mono: "m < n ==> Suc m < Suc n"
131.65 by simp
131.66 @@ -692,6 +701,9 @@
131.67 lemma Suc_pred [simp]: "n>0 ==> Suc (n - Suc 0) = n"
131.68 by (simp add: diff_Suc split: nat.split)
131.69
131.70 +lemma Suc_diff_1 [simp]: "0 < n ==> Suc (n - 1) = n"
131.71 +unfolding One_nat_def by (rule Suc_pred)
131.72 +
131.73 lemma nat_add_left_cancel_le [simp]: "(k + m \<le> k + n) = (m\<le>(n::nat))"
131.74 by (induct k) simp_all
131.75
131.76 @@ -735,6 +747,11 @@
131.77 show "i < j ==> 0 < k ==> k * i < k * j" by (simp add: mult_less_mono2)
131.78 qed
131.79
131.80 +instance nat :: no_zero_divisors
131.81 +proof
131.82 + fix a::nat and b::nat show "a ~= 0 \<Longrightarrow> b ~= 0 \<Longrightarrow> a * b ~= 0" by auto
131.83 +qed
131.84 +
131.85 lemma nat_mult_1: "(1::nat) * n = n"
131.86 by simp
131.87
131.88 @@ -795,6 +812,7 @@
131.89 done
131.90
131.91 lemma ex_least_nat_less: "\<not>P(0) \<Longrightarrow> P(n::nat) \<Longrightarrow> \<exists>k<n. (\<forall>i\<le>k. \<not>P i) & P(k+1)"
131.92 + unfolding One_nat_def
131.93 apply (cases n)
131.94 apply blast
131.95 apply (frule (1) ex_least_nat_le)
131.96 @@ -1084,7 +1102,7 @@
131.97 apply simp_all
131.98 done
131.99
131.100 -lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (1 \<le> m & 1 \<le> n)"
131.101 +lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (Suc 0 \<le> m & Suc 0 \<le> n)"
131.102 apply (induct m)
131.103 apply simp
131.104 apply (case_tac n)
131.105 @@ -1159,7 +1177,7 @@
131.106 | of_nat_Suc: "of_nat (Suc m) = 1 + of_nat m"
131.107
131.108 lemma of_nat_1 [simp]: "of_nat 1 = 1"
131.109 - by simp
131.110 + unfolding One_nat_def by simp
131.111
131.112 lemma of_nat_add [simp]: "of_nat (m + n) = of_nat m + of_nat n"
131.113 by (induct m) (simp_all add: add_ac)
131.114 @@ -1271,7 +1289,7 @@
131.115 end
131.116
131.117 lemma of_nat_id [simp]: "of_nat n = n"
131.118 - by (induct n) auto
131.119 + by (induct n) (auto simp add: One_nat_def)
131.120
131.121 lemma of_nat_eq_id [simp]: "of_nat = id"
131.122 by (auto simp add: expand_fun_eq)
131.123 @@ -1376,7 +1394,7 @@
131.124 apply(induct_tac k)
131.125 apply simp
131.126 apply(erule_tac x="m+n" in meta_allE)
131.127 -apply(erule_tac x="m+n+1" in meta_allE)
131.128 +apply(erule_tac x="Suc(m+n)" in meta_allE)
131.129 apply simp
131.130 done
131.131
132.1 --- a/src/HOL/NatBin.thy Wed Mar 04 10:43:39 2009 +0100
132.2 +++ b/src/HOL/NatBin.thy Wed Mar 04 10:45:52 2009 +0100
132.3 @@ -159,6 +159,21 @@
132.4 unfolding nat_number_of_def number_of_is_id numeral_simps
132.5 by (simp add: nat_add_distrib)
132.6
132.7 +lemma nat_number_of_add_1 [simp]:
132.8 + "number_of v + (1::nat) =
132.9 + (if v < Int.Pls then 1 else number_of (Int.succ v))"
132.10 + unfolding nat_number_of_def number_of_is_id numeral_simps
132.11 + by (simp add: nat_add_distrib)
132.12 +
132.13 +lemma nat_1_add_number_of [simp]:
132.14 + "(1::nat) + number_of v =
132.15 + (if v < Int.Pls then 1 else number_of (Int.succ v))"
132.16 + unfolding nat_number_of_def number_of_is_id numeral_simps
132.17 + by (simp add: nat_add_distrib)
132.18 +
132.19 +lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
132.20 + by (rule int_int_eq [THEN iffD1]) simp
132.21 +
132.22
132.23 subsubsection{*Subtraction *}
132.24
132.25 @@ -178,6 +193,12 @@
132.26 unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
132.27 by auto
132.28
132.29 +lemma nat_number_of_diff_1 [simp]:
132.30 + "number_of v - (1::nat) =
132.31 + (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
132.32 + unfolding nat_number_of_def number_of_is_id numeral_simps
132.33 + by auto
132.34 +
132.35
132.36 subsubsection{*Multiplication *}
132.37
132.38 @@ -362,9 +383,14 @@
132.39 unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
132.40
132.41 lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
132.42 -apply (induct "n")
132.43 -apply (auto simp add: power_Suc power_add)
132.44 -done
132.45 +proof (induct n)
132.46 + case 0 show ?case by simp
132.47 +next
132.48 + case (Suc n) then show ?case by (simp add: power_Suc power_add)
132.49 +qed
132.50 +
132.51 +lemma power_minus1_odd: "(- 1) ^ Suc(2*n) = -(1::'a::{comm_ring_1,recpower})"
132.52 + by (simp add: power_Suc)
132.53
132.54 lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
132.55 by (subst mult_commute) (simp add: power_mult)
132.56 @@ -437,19 +463,13 @@
132.57 (* These two can be useful when m = number_of... *)
132.58
132.59 lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
132.60 -apply (case_tac "m")
132.61 -apply (simp_all add: numerals)
132.62 -done
132.63 + unfolding One_nat_def by (cases m) simp_all
132.64
132.65 lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
132.66 -apply (case_tac "m")
132.67 -apply (simp_all add: numerals)
132.68 -done
132.69 + unfolding One_nat_def by (cases m) simp_all
132.70
132.71 lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
132.72 -apply (case_tac "m")
132.73 -apply (simp_all add: numerals)
132.74 -done
132.75 + unfolding One_nat_def by (cases m) simp_all
132.76
132.77
132.78 subsection{*Comparisons involving (0::nat) *}
133.1 --- a/src/HOL/Nominal/Examples/Fsub.thy Wed Mar 04 10:43:39 2009 +0100
133.2 +++ b/src/HOL/Nominal/Examples/Fsub.thy Wed Mar 04 10:45:52 2009 +0100
133.3 @@ -7,13 +7,18 @@
133.4 text{* Authors: Christian Urban,
133.5 Benjamin Pierce,
133.6 Dimitrios Vytiniotis
133.7 - Stephanie Weirich and
133.8 + Stephanie Weirich
133.9 Steve Zdancewic
133.10 + Julien Narboux
133.11 + Stefan Berghofer
133.12
133.13 - with great help from Stefan Berghofer and Markus Wenzel. *}
133.14 + with great help from Markus Wenzel. *}
133.15
133.16 section {* Types for Names, Nominal Datatype Declaration for Types and Terms *}
133.17
133.18 +no_syntax
133.19 + "_Map" :: "maplets => 'a ~=> 'b" ("(1[_])")
133.20 +
133.21 text {* The main point of this solution is to use names everywhere (be they bound,
133.22 binding or free). In System \FSUB{} there are two kinds of names corresponding to
133.23 type-variables and to term-variables. These two kinds of names are represented in
133.24 @@ -31,30 +36,35 @@
133.25 nominal_datatype ty =
133.26 Tvar "tyvrs"
133.27 | Top
133.28 - | Arrow "ty" "ty" ("_ \<rightarrow> _" [100,100] 100)
133.29 + | Arrow "ty" "ty" (infixr "\<rightarrow>" 200)
133.30 | Forall "\<guillemotleft>tyvrs\<guillemotright>ty" "ty"
133.31
133.32 nominal_datatype trm =
133.33 Var "vrs"
133.34 - | Lam "\<guillemotleft>vrs\<guillemotright>trm" "ty"
133.35 - | Tabs "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
133.36 - | App "trm" "trm"
133.37 - | Tapp "trm" "ty"
133.38 + | Abs "\<guillemotleft>vrs\<guillemotright>trm" "ty"
133.39 + | TAbs "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
133.40 + | App "trm" "trm" (infixl "\<cdot>" 200)
133.41 + | TApp "trm" "ty" (infixl "\<cdot>\<^sub>\<tau>" 200)
133.42
133.43 text {* To be polite to the eye, some more familiar notation is introduced.
133.44 Because of the change in the order of arguments, one needs to use
133.45 translation rules, instead of syntax annotations at the term-constructors
133.46 as given above for @{term "Arrow"}. *}
133.47
133.48 -syntax
133.49 - Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty" ("\<forall>[_<:_]._" [100,100,100] 100)
133.50 - Lam_syn :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("Lam [_:_]._" [100,100,100] 100)
133.51 - Tabs_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("Tabs [_<:_]._" [100,100,100] 100)
133.52 +abbreviation
133.53 + Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty" ("(3\<forall>_<:_./ _)" [0, 0, 10] 10)
133.54 +where
133.55 + "\<forall>X<:T\<^isub>1. T\<^isub>2 \<equiv> ty.Forall X T\<^isub>2 T\<^isub>1"
133.56
133.57 -translations
133.58 - "\<forall>[X<:T\<^isub>1].T\<^isub>2" \<rightleftharpoons> "ty.Forall X T\<^isub>2 T\<^isub>1"
133.59 - "Lam [x:T].t" \<rightleftharpoons> "trm.Lam x t T"
133.60 - "Tabs [X<:T].t" \<rightleftharpoons> "trm.Tabs X t T"
133.61 +abbreviation
133.62 + Abs_syn :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("(3\<lambda>_:_./ _)" [0, 0, 10] 10)
133.63 +where
133.64 + "\<lambda>x:T. t \<equiv> trm.Abs x t T"
133.65 +
133.66 +abbreviation
133.67 + TAbs_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("(3\<lambda>_<:_./ _)" [0, 0, 10] 10)
133.68 +where
133.69 + "\<lambda>X<:T. t \<equiv> trm.TAbs X t T"
133.70
133.71 text {* Again there are numerous facts that are proved automatically for @{typ "ty"}
133.72 and @{typ "trm"}: for example that the set of free variables, i.e.~the @{text "support"},
133.73 @@ -64,13 +74,17 @@
133.74 and @{typ "trm"}s are equal: *}
133.75
133.76 lemma alpha_illustration:
133.77 - shows "\<forall>[X<:T].(Tvar X) = \<forall>[Y<:T].(Tvar Y)"
133.78 - and "Lam [x:T].(Var x) = Lam [y:T].(Var y)"
133.79 + shows "(\<forall>X<:T. Tvar X) = (\<forall>Y<:T. Tvar Y)"
133.80 + and "(\<lambda>x:T. Var x) = (\<lambda>y:T. Var y)"
133.81 by (simp_all add: ty.inject trm.inject alpha calc_atm fresh_atm)
133.82
133.83 section {* SubTyping Contexts *}
133.84
133.85 -types ty_context = "(tyvrs\<times>ty) list"
133.86 +nominal_datatype binding =
133.87 + VarB vrs ty
133.88 + | TVarB tyvrs ty
133.89 +
133.90 +types env = "binding list"
133.91
133.92 text {* Typing contexts are represented as lists that ``grow" on the left; we
133.93 thereby deviating from the convention in the POPLmark-paper. The lists contain
133.94 @@ -79,66 +93,139 @@
133.95 text {* In order to state validity-conditions for typing-contexts, the notion of
133.96 a @{text "domain"} of a typing-context is handy. *}
133.97
133.98 +nominal_primrec
133.99 + "tyvrs_of" :: "binding \<Rightarrow> tyvrs set"
133.100 +where
133.101 + "tyvrs_of (VarB x y) = {}"
133.102 +| "tyvrs_of (TVarB x y) = {x}"
133.103 +by auto
133.104 +
133.105 +nominal_primrec
133.106 + "vrs_of" :: "binding \<Rightarrow> vrs set"
133.107 +where
133.108 + "vrs_of (VarB x y) = {x}"
133.109 +| "vrs_of (TVarB x y) = {}"
133.110 +by auto
133.111 +
133.112 consts
133.113 - "domain" :: "ty_context \<Rightarrow> tyvrs set"
133.114 + "ty_domain" :: "env \<Rightarrow> tyvrs set"
133.115 primrec
133.116 - "domain [] = {}"
133.117 - "domain (X#\<Gamma>) = {fst X}\<union>(domain \<Gamma>)"
133.118 + "ty_domain [] = {}"
133.119 + "ty_domain (X#\<Gamma>) = (tyvrs_of X)\<union>(ty_domain \<Gamma>)"
133.120
133.121 -lemma domain_eqvt[eqvt]:
133.122 +consts
133.123 + "trm_domain" :: "env \<Rightarrow> vrs set"
133.124 +primrec
133.125 + "trm_domain [] = {}"
133.126 + "trm_domain (X#\<Gamma>) = (vrs_of X)\<union>(trm_domain \<Gamma>)"
133.127 +
133.128 +lemma vrs_of_eqvt[eqvt]:
133.129 + fixes pi ::"tyvrs prm"
133.130 + and pi'::"vrs prm"
133.131 + shows "pi \<bullet>(tyvrs_of x) = tyvrs_of (pi\<bullet>x)"
133.132 + and "pi'\<bullet>(tyvrs_of x) = tyvrs_of (pi'\<bullet>x)"
133.133 + and "pi \<bullet>(vrs_of x) = vrs_of (pi\<bullet>x)"
133.134 + and "pi'\<bullet>(vrs_of x) = vrs_of (pi'\<bullet>x)"
133.135 +by (nominal_induct x rule: binding.strong_induct) (simp_all add: tyvrs_of.simps eqvts)
133.136 +
133.137 +lemma domains_eqvt[eqvt]:
133.138 fixes pi::"tyvrs prm"
133.139 and pi'::"vrs prm"
133.140 - shows "pi\<bullet>(domain \<Gamma>) = domain (pi\<bullet>\<Gamma>)"
133.141 - and "pi'\<bullet>(domain \<Gamma>) = domain (pi'\<bullet>\<Gamma>)"
133.142 - by (induct \<Gamma>) (simp_all add: eqvts)
133.143 + shows "pi \<bullet>(ty_domain \<Gamma>) = ty_domain (pi\<bullet>\<Gamma>)"
133.144 + and "pi'\<bullet>(ty_domain \<Gamma>) = ty_domain (pi'\<bullet>\<Gamma>)"
133.145 + and "pi \<bullet>(trm_domain \<Gamma>) = trm_domain (pi\<bullet>\<Gamma>)"
133.146 + and "pi'\<bullet>(trm_domain \<Gamma>) = trm_domain (pi'\<bullet>\<Gamma>)"
133.147 +by (induct \<Gamma>) (simp_all add: eqvts)
133.148
133.149 -lemma finite_domain:
133.150 - shows "finite (domain \<Gamma>)"
133.151 +lemma finite_vrs:
133.152 + shows "finite (tyvrs_of x)"
133.153 + and "finite (vrs_of x)"
133.154 +by (nominal_induct rule:binding.strong_induct, auto)
133.155 +
133.156 +lemma finite_domains:
133.157 + shows "finite (ty_domain \<Gamma>)"
133.158 + and "finite (trm_domain \<Gamma>)"
133.159 +by (induct \<Gamma>, auto simp add: finite_vrs)
133.160 +
133.161 +lemma ty_domain_supp:
133.162 + shows "(supp (ty_domain \<Gamma>)) = (ty_domain \<Gamma>)"
133.163 + and "(supp (trm_domain \<Gamma>)) = (trm_domain \<Gamma>)"
133.164 +by (simp only: at_fin_set_supp at_tyvrs_inst at_vrs_inst finite_domains)+
133.165 +
133.166 +lemma ty_domain_inclusion:
133.167 + assumes a: "(TVarB X T)\<in>set \<Gamma>"
133.168 + shows "X\<in>(ty_domain \<Gamma>)"
133.169 +using a by (induct \<Gamma>, auto)
133.170 +
133.171 +lemma ty_binding_existence:
133.172 + assumes "X \<in> (tyvrs_of a)"
133.173 + shows "\<exists>T.(TVarB X T=a)"
133.174 + using assms
133.175 +by (nominal_induct a rule: binding.strong_induct, auto)
133.176 +
133.177 +lemma ty_domain_existence:
133.178 + assumes a: "X\<in>(ty_domain \<Gamma>)"
133.179 + shows "\<exists>T.(TVarB X T)\<in>set \<Gamma>"
133.180 + using a
133.181 + apply (induct \<Gamma>, auto)
133.182 + apply (subgoal_tac "\<exists>T.(TVarB X T=a)")
133.183 + apply (auto)
133.184 + apply (auto simp add: ty_binding_existence)
133.185 +done
133.186 +
133.187 +lemma domains_append:
133.188 + shows "ty_domain (\<Gamma>@\<Delta>) = ((ty_domain \<Gamma>) \<union> (ty_domain \<Delta>))"
133.189 + and "trm_domain (\<Gamma>@\<Delta>) = ((trm_domain \<Gamma>) \<union> (trm_domain \<Delta>))"
133.190 by (induct \<Gamma>, auto)
133.191
133.192 -lemma domain_supp:
133.193 - shows "(supp (domain \<Gamma>)) = (domain \<Gamma>)"
133.194 - by (simp only: at_fin_set_supp at_tyvrs_inst finite_domain)
133.195 +lemma ty_vrs_prm_simp:
133.196 + fixes pi::"vrs prm"
133.197 + and S::"ty"
133.198 + shows "pi\<bullet>S = S"
133.199 +by (induct S rule: ty.induct) (auto simp add: calc_atm)
133.200
133.201 -lemma domain_inclusion:
133.202 - assumes a: "(X,T)\<in>set \<Gamma>"
133.203 - shows "X\<in>(domain \<Gamma>)"
133.204 - using a by (induct \<Gamma>, auto)
133.205 +lemma fresh_ty_domain_cons:
133.206 + fixes X::"tyvrs"
133.207 + shows "X\<sharp>(ty_domain (Y#\<Gamma>)) = (X\<sharp>(tyvrs_of Y) \<and> X\<sharp>(ty_domain \<Gamma>))"
133.208 + apply (nominal_induct rule:binding.strong_induct)
133.209 + apply (auto)
133.210 + apply (simp add: fresh_def supp_def eqvts)
133.211 + apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)
133.212 + apply (simp add: fresh_def supp_def eqvts)
133.213 + apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)+
133.214 + done
133.215
133.216 -lemma domain_existence:
133.217 - assumes a: "X\<in>(domain \<Gamma>)"
133.218 - shows "\<exists>T.(X,T)\<in>set \<Gamma>"
133.219 - using a by (induct \<Gamma>, auto)
133.220 -
133.221 -lemma domain_append:
133.222 - shows "domain (\<Gamma>@\<Delta>) = ((domain \<Gamma>) \<union> (domain \<Delta>))"
133.223 - by (induct \<Gamma>, auto)
133.224 -
133.225 -lemma fresh_domain_cons:
133.226 - fixes X::"tyvrs"
133.227 - shows "X\<sharp>(domain (Y#\<Gamma>)) = (X\<sharp>(fst Y) \<and> X\<sharp>(domain \<Gamma>))"
133.228 - by (simp add: fresh_fin_insert pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst finite_domain)
133.229 +lemma tyvrs_fresh:
133.230 + fixes X::"tyvrs"
133.231 + assumes "X \<sharp> a"
133.232 + shows "X \<sharp> tyvrs_of a"
133.233 + and "X \<sharp> vrs_of a"
133.234 + using assms
133.235 + apply (nominal_induct a rule:binding.strong_induct)
133.236 + apply (auto)
133.237 + apply (fresh_guess)+
133.238 +done
133.239
133.240 lemma fresh_domain:
133.241 fixes X::"tyvrs"
133.242 assumes a: "X\<sharp>\<Gamma>"
133.243 - shows "X\<sharp>(domain \<Gamma>)"
133.244 + shows "X\<sharp>(ty_domain \<Gamma>)"
133.245 using a
133.246 apply(induct \<Gamma>)
133.247 apply(simp add: fresh_set_empty)
133.248 -apply(simp only: fresh_domain_cons)
133.249 -apply(auto simp add: fresh_prod fresh_list_cons)
133.250 +apply(simp only: fresh_ty_domain_cons)
133.251 +apply(auto simp add: fresh_prod fresh_list_cons tyvrs_fresh)
133.252 done
133.253
133.254 -text {* Not all lists of type @{typ "ty_context"} are well-formed. One condition
133.255 - requires that in @{term "(X,S)#\<Gamma>"} all free variables of @{term "S"} must be
133.256 - in the @{term "domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"}
133.257 +text {* Not all lists of type @{typ "env"} are well-formed. One condition
133.258 + requires that in @{term "TVarB X S#\<Gamma>"} all free variables of @{term "S"} must be
133.259 + in the @{term "ty_domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"}
133.260 in @{term "\<Gamma>"}. The set of free variables of @{term "S"} is the
133.261 @{text "support"} of @{term "S"}. *}
133.262
133.263 constdefs
133.264 - "closed_in" :: "ty \<Rightarrow> ty_context \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
133.265 - "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(domain \<Gamma>)"
133.266 + "closed_in" :: "ty \<Rightarrow> env \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
133.267 + "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(ty_domain \<Gamma>)"
133.268
133.269 lemma closed_in_eqvt[eqvt]:
133.270 fixes pi::"tyvrs prm"
133.271 @@ -150,80 +237,148 @@
133.272 then show "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)" by (simp add: closed_in_def eqvts)
133.273 qed
133.274
133.275 -lemma ty_vrs_prm_simp:
133.276 +lemma tyvrs_vrs_prm_simp:
133.277 fixes pi::"vrs prm"
133.278 - and S::"ty"
133.279 - shows "pi\<bullet>S = S"
133.280 -by (induct S rule: ty.induct) (auto simp add: calc_atm)
133.281 + shows "tyvrs_of (pi\<bullet>a) = tyvrs_of a"
133.282 + apply (nominal_induct rule:binding.strong_induct)
133.283 + apply (simp_all add: eqvts)
133.284 + apply (simp add: dj_perm_forget[OF dj_tyvrs_vrs])
133.285 + done
133.286
133.287 -lemma ty_context_vrs_prm_simp:
133.288 +lemma ty_vrs_fresh[fresh]:
133.289 + fixes x::"vrs"
133.290 + and T::"ty"
133.291 + shows "x \<sharp> T"
133.292 +by (simp add: fresh_def supp_def ty_vrs_prm_simp)
133.293 +
133.294 +lemma ty_domain_vrs_prm_simp:
133.295 fixes pi::"vrs prm"
133.296 - and \<Gamma>::"ty_context"
133.297 - shows "pi\<bullet>\<Gamma> = \<Gamma>"
133.298 -by (induct \<Gamma>)
133.299 - (auto simp add: calc_atm ty_vrs_prm_simp)
133.300 + and \<Gamma>::"env"
133.301 + shows "(ty_domain (pi\<bullet>\<Gamma>)) = (ty_domain \<Gamma>)"
133.302 + apply(induct \<Gamma>)
133.303 + apply (simp add: eqvts)
133.304 + apply(simp add: tyvrs_vrs_prm_simp)
133.305 +done
133.306
133.307 lemma closed_in_eqvt'[eqvt]:
133.308 fixes pi::"vrs prm"
133.309 assumes a: "S closed_in \<Gamma>"
133.310 shows "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)"
133.311 using a
133.312 -by (simp add: ty_vrs_prm_simp ty_context_vrs_prm_simp)
133.313 +by (simp add: closed_in_def ty_domain_vrs_prm_simp ty_vrs_prm_simp)
133.314 +
133.315 +lemma fresh_vrs_of:
133.316 + fixes x::"vrs"
133.317 + shows "x\<sharp>vrs_of b = x\<sharp>b"
133.318 + by (nominal_induct b rule: binding.strong_induct)
133.319 + (simp_all add: fresh_singleton [OF pt_vrs_inst at_vrs_inst] fresh_set_empty ty_vrs_fresh fresh_atm)
133.320 +
133.321 +lemma fresh_trm_domain:
133.322 + fixes x::"vrs"
133.323 + shows "x\<sharp> trm_domain \<Gamma> = x\<sharp>\<Gamma>"
133.324 + by (induct \<Gamma>)
133.325 + (simp_all add: fresh_set_empty fresh_list_cons
133.326 + fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.327 + finite_domains finite_vrs fresh_vrs_of fresh_list_nil)
133.328 +
133.329 +lemma closed_in_fresh: "(X::tyvrs) \<sharp> ty_domain \<Gamma> \<Longrightarrow> T closed_in \<Gamma> \<Longrightarrow> X \<sharp> T"
133.330 + by (auto simp add: closed_in_def fresh_def ty_domain_supp)
133.331
133.332 text {* Now validity of a context is a straightforward inductive definition. *}
133.333
133.334 -inductive
133.335 - valid_rel :: "ty_context \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
133.336 +inductive
133.337 + valid_rel :: "env \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
133.338 where
133.339 - valid_nil[simp]: "\<turnstile> [] ok"
133.340 -| valid_cons[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(domain \<Gamma>); T closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<turnstile> ((X,T)#\<Gamma>) ok"
133.341 + valid_nil[simp]: "\<turnstile> [] ok"
133.342 +| valid_consT[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(ty_domain \<Gamma>); T closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<turnstile> (TVarB X T#\<Gamma>) ok"
133.343 +| valid_cons [simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; x\<sharp>(trm_domain \<Gamma>); T closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<turnstile> (VarB x T#\<Gamma>) ok"
133.344
133.345 equivariance valid_rel
133.346
133.347 -lemma validE:
133.348 - assumes a: "\<turnstile> ((X,T)#\<Gamma>) ok"
133.349 - shows "\<turnstile> \<Gamma> ok \<and> X\<sharp>(domain \<Gamma>) \<and> T closed_in \<Gamma>"
133.350 -using a by (cases, auto)
133.351 +declare binding.inject [simp add]
133.352 +declare trm.inject [simp add]
133.353 +
133.354 +inductive_cases validE[elim]: "\<turnstile> (TVarB X T#\<Gamma>) ok" "\<turnstile> (VarB x T#\<Gamma>) ok" "\<turnstile> (b#\<Gamma>) ok"
133.355 +
133.356 +declare binding.inject [simp del]
133.357 +declare trm.inject [simp del]
133.358
133.359 lemma validE_append:
133.360 assumes a: "\<turnstile> (\<Delta>@\<Gamma>) ok"
133.361 shows "\<turnstile> \<Gamma> ok"
133.362 - using a by (induct \<Delta>, auto dest: validE)
133.363 + using a
133.364 +proof (induct \<Delta>)
133.365 + case (Cons a \<Gamma>')
133.366 + then show ?case
133.367 + by (nominal_induct a rule:binding.strong_induct)
133.368 + (auto elim: validE)
133.369 +qed (auto)
133.370
133.371 lemma replace_type:
133.372 - assumes a: "\<turnstile> (\<Delta>@(X,T)#\<Gamma>) ok"
133.373 + assumes a: "\<turnstile> (\<Delta>@(TVarB X T)#\<Gamma>) ok"
133.374 and b: "S closed_in \<Gamma>"
133.375 - shows "\<turnstile> (\<Delta>@(X,S)#\<Gamma>) ok"
133.376 + shows "\<turnstile> (\<Delta>@(TVarB X S)#\<Gamma>) ok"
133.377 using a b
133.378 -apply(induct \<Delta>)
133.379 -apply(auto dest!: validE intro!: valid_cons simp add: domain_append closed_in_def)
133.380 -done
133.381 +proof(induct \<Delta>)
133.382 + case Nil
133.383 + then show ?case by (auto elim: validE intro: valid_cons simp add: domains_append closed_in_def)
133.384 +next
133.385 + case (Cons a \<Gamma>')
133.386 + then show ?case
133.387 + by (nominal_induct a rule:binding.strong_induct)
133.388 + (auto elim: validE intro!: valid_cons simp add: domains_append closed_in_def)
133.389 +qed
133.390
133.391 text {* Well-formed contexts have a unique type-binding for a type-variable. *}
133.392
133.393 lemma uniqueness_of_ctxt:
133.394 - fixes \<Gamma>::"ty_context"
133.395 + fixes \<Gamma>::"env"
133.396 assumes a: "\<turnstile> \<Gamma> ok"
133.397 - and b: "(X,T)\<in>set \<Gamma>"
133.398 - and c: "(X,S)\<in>set \<Gamma>"
133.399 + and b: "(TVarB X T)\<in>set \<Gamma>"
133.400 + and c: "(TVarB X S)\<in>set \<Gamma>"
133.401 shows "T=S"
133.402 using a b c
133.403 proof (induct)
133.404 - case valid_nil thus "T=S" by simp
133.405 -next
133.406 - case valid_cons
133.407 + case (valid_consT \<Gamma> X' T')
133.408 moreover
133.409 - { fix \<Gamma>::"ty_context"
133.410 - assume a: "X\<sharp>(domain \<Gamma>)"
133.411 - have "\<not>(\<exists>T.(X,T)\<in>(set \<Gamma>))" using a
133.412 - proof (induct \<Gamma>)
133.413 - case (Cons Y \<Gamma>)
133.414 - thus "\<not> (\<exists>T.(X,T)\<in>set(Y#\<Gamma>))"
133.415 - by (simp only: fresh_domain_cons, auto simp add: fresh_atm)
133.416 + { fix \<Gamma>'::"env"
133.417 + assume a: "X'\<sharp>(ty_domain \<Gamma>')"
133.418 + have "\<not>(\<exists>T.(TVarB X' T)\<in>(set \<Gamma>'))" using a
133.419 + proof (induct \<Gamma>')
133.420 + case (Cons Y \<Gamma>')
133.421 + thus "\<not> (\<exists>T.(TVarB X' T)\<in>set(Y#\<Gamma>'))"
133.422 + by (simp add: fresh_ty_domain_cons
133.423 + fresh_fin_union[OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
133.424 + finite_vrs finite_domains,
133.425 + auto simp add: fresh_atm fresh_singleton [OF pt_tyvrs_inst at_tyvrs_inst])
133.426 qed (simp)
133.427 }
133.428 - ultimately show "T=S" by auto
133.429 -qed
133.430 + ultimately show "T=S" by (auto simp add: binding.inject)
133.431 +qed (auto)
133.432 +
133.433 +lemma uniqueness_of_ctxt':
133.434 + fixes \<Gamma>::"env"
133.435 + assumes a: "\<turnstile> \<Gamma> ok"
133.436 + and b: "(VarB x T)\<in>set \<Gamma>"
133.437 + and c: "(VarB x S)\<in>set \<Gamma>"
133.438 + shows "T=S"
133.439 +using a b c
133.440 +proof (induct)
133.441 + case (valid_cons \<Gamma> x' T')
133.442 + moreover
133.443 + { fix \<Gamma>'::"env"
133.444 + assume a: "x'\<sharp>(trm_domain \<Gamma>')"
133.445 + have "\<not>(\<exists>T.(VarB x' T)\<in>(set \<Gamma>'))" using a
133.446 + proof (induct \<Gamma>')
133.447 + case (Cons y \<Gamma>')
133.448 + thus "\<not> (\<exists>T.(VarB x' T)\<in>set(y#\<Gamma>'))"
133.449 + by (simp add: fresh_fin_union[OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.450 + finite_vrs finite_domains,
133.451 + auto simp add: fresh_atm fresh_singleton [OF pt_vrs_inst at_vrs_inst])
133.452 + qed (simp)
133.453 + }
133.454 + ultimately show "T=S" by (auto simp add: binding.inject)
133.455 +qed (auto)
133.456
133.457 section {* Size and Capture-Avoiding Substitution for Types *}
133.458
133.459 @@ -233,7 +388,7 @@
133.460 "size_ty (Tvar X) = 1"
133.461 | "size_ty (Top) = 1"
133.462 | "size_ty (T1 \<rightarrow> T2) = (size_ty T1) + (size_ty T2) + 1"
133.463 -| "X\<sharp>T1 \<Longrightarrow> size_ty (\<forall>[X<:T1].T2) = (size_ty T1) + (size_ty T2) + 1"
133.464 +| "X \<sharp> T1 \<Longrightarrow> size_ty (\<forall>X<:T1. T2) = (size_ty T1) + (size_ty T2) + 1"
133.465 apply (finite_guess)+
133.466 apply (rule TrueI)+
133.467 apply (simp add: fresh_nat)
133.468 @@ -241,24 +396,195 @@
133.469 done
133.470
133.471 nominal_primrec
133.472 - subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_:=_]\<^isub>t\<^isub>y" [100,100,100] 100)
133.473 + subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_ \<mapsto> _]\<^sub>\<tau>" [300, 0, 0] 300)
133.474 where
133.475 - "(Tvar X)[Y:=T]\<^isub>t\<^isub>y= (if X=Y then T else (Tvar X))"
133.476 -| "(Top)[Y:=T]\<^isub>t\<^isub>y = Top"
133.477 -| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (T\<^isub>1[Y:=T]\<^isub>t\<^isub>y) \<rightarrow> (T\<^isub>2[Y:=T]\<^isub>t\<^isub>y)"
133.478 -| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>[X<:T\<^isub>1].T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (\<forall>[X<:(T\<^isub>1[Y:=T]\<^isub>t\<^isub>y)].(T\<^isub>2[Y:=T]\<^isub>t\<^isub>y))"
133.479 + "(Tvar X)[Y \<mapsto> T]\<^sub>\<tau> = (if X=Y then T else Tvar X)"
133.480 +| "(Top)[Y \<mapsto> T]\<^sub>\<tau> = Top"
133.481 +| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau> \<rightarrow> T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>"
133.482 +| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>X<:T\<^isub>1. T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = (\<forall>X<:T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau>. T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>)"
133.483 apply (finite_guess)+
133.484 apply (rule TrueI)+
133.485 apply (simp add: abs_fresh)
133.486 apply (fresh_guess)+
133.487 done
133.488
133.489 +lemma subst_eqvt[eqvt]:
133.490 + fixes pi::"tyvrs prm"
133.491 + and T::"ty"
133.492 + shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
133.493 + by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
133.494 + (perm_simp add: fresh_bij)+
133.495 +
133.496 +lemma subst_eqvt'[eqvt]:
133.497 + fixes pi::"vrs prm"
133.498 + and T::"ty"
133.499 + shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
133.500 + by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
133.501 + (perm_simp add: fresh_left)+
133.502 +
133.503 +lemma type_subst_fresh[fresh]:
133.504 + fixes X::"tyvrs"
133.505 + assumes "X \<sharp> T" and "X \<sharp> P"
133.506 + shows "X \<sharp> T[Y \<mapsto> P]\<^sub>\<tau>"
133.507 +using assms
133.508 +by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
133.509 + (auto simp add: abs_fresh)
133.510 +
133.511 +lemma fresh_type_subst_fresh[fresh]:
133.512 + assumes "X\<sharp>T'"
133.513 + shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
133.514 +using assms
133.515 +by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
133.516 + (auto simp add: fresh_atm abs_fresh fresh_nat)
133.517 +
133.518 +lemma type_subst_identity: "X \<sharp> T \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> = T"
133.519 + by (nominal_induct T avoiding: X U rule: ty.strong_induct)
133.520 + (simp_all add: fresh_atm abs_fresh)
133.521 +
133.522 +lemma type_substitution_lemma:
133.523 + "X \<noteq> Y \<Longrightarrow> X \<sharp> L \<Longrightarrow> M[X \<mapsto> N]\<^sub>\<tau>[Y \<mapsto> L]\<^sub>\<tau> = M[Y \<mapsto> L]\<^sub>\<tau>[X \<mapsto> N[Y \<mapsto> L]\<^sub>\<tau>]\<^sub>\<tau>"
133.524 + by (nominal_induct M avoiding: X Y N L rule: ty.strong_induct)
133.525 + (auto simp add: type_subst_fresh type_subst_identity)
133.526 +
133.527 +lemma type_subst_rename:
133.528 + "Y \<sharp> T \<Longrightarrow> ([(Y, X)] \<bullet> T)[Y \<mapsto> U]\<^sub>\<tau> = T[X \<mapsto> U]\<^sub>\<tau>"
133.529 + by (nominal_induct T avoiding: X Y U rule: ty.strong_induct)
133.530 + (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux)
133.531 +
133.532 +nominal_primrec
133.533 + subst_tyb :: "binding \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> binding" ("_[_ \<mapsto> _]\<^sub>b" [100,100,100] 100)
133.534 +where
133.535 + "(TVarB X U)[Y \<mapsto> T]\<^sub>b = TVarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
133.536 +| "(VarB X U)[Y \<mapsto> T]\<^sub>b = VarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
133.537 +by auto
133.538 +
133.539 +lemma binding_subst_fresh[fresh]:
133.540 + fixes X::"tyvrs"
133.541 + assumes "X \<sharp> a"
133.542 + and "X \<sharp> P"
133.543 + shows "X \<sharp> a[Y \<mapsto> P]\<^sub>b"
133.544 +using assms
133.545 +by (nominal_induct a rule:binding.strong_induct)
133.546 + (auto simp add: freshs)
133.547 +
133.548 +lemma binding_subst_identity: "X \<sharp> B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
133.549 + by (induct B rule: binding.induct)
133.550 + (simp_all add: fresh_atm type_subst_identity)
133.551 +
133.552 consts
133.553 - subst_tyc :: "ty_context \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty_context" ("_[_:=_]\<^isub>t\<^isub>y\<^isub>c" [100,100,100] 100)
133.554 + subst_tyc :: "env \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> env" ("_[_ \<mapsto> _]\<^sub>e" [100,100,100] 100)
133.555 +
133.556 primrec
133.557 -"([])[Y:=T]\<^isub>t\<^isub>y\<^isub>c= []"
133.558 -"(XT#\<Gamma>)[Y:=T]\<^isub>t\<^isub>y\<^isub>c = (fst XT,(snd XT)[Y:=T]\<^isub>t\<^isub>y)#(\<Gamma>[Y:=T]\<^isub>t\<^isub>y\<^isub>c)"
133.559 -
133.560 +"([])[Y \<mapsto> T]\<^sub>e= []"
133.561 +"(B#\<Gamma>)[Y \<mapsto> T]\<^sub>e = (B[Y \<mapsto> T]\<^sub>b)#(\<Gamma>[Y \<mapsto> T]\<^sub>e)"
133.562 +
133.563 +lemma ctxt_subst_fresh'[fresh]:
133.564 + fixes X::"tyvrs"
133.565 + assumes "X \<sharp> \<Gamma>"
133.566 + and "X \<sharp> P"
133.567 + shows "X \<sharp> \<Gamma>[Y \<mapsto> P]\<^sub>e"
133.568 +using assms
133.569 +by (induct \<Gamma>)
133.570 + (auto simp add: fresh_list_cons freshs)
133.571 +
133.572 +lemma ctxt_subst_mem_TVarB: "TVarB X T \<in> set \<Gamma> \<Longrightarrow> TVarB X (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
133.573 + by (induct \<Gamma>) auto
133.574 +
133.575 +lemma ctxt_subst_mem_VarB: "VarB x T \<in> set \<Gamma> \<Longrightarrow> VarB x (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
133.576 + by (induct \<Gamma>) auto
133.577 +
133.578 +lemma ctxt_subst_identity: "X \<sharp> \<Gamma> \<Longrightarrow> \<Gamma>[X \<mapsto> U]\<^sub>e = \<Gamma>"
133.579 + by (induct \<Gamma>) (simp_all add: fresh_list_cons binding_subst_identity)
133.580 +
133.581 +lemma ctxt_subst_append: "(\<Delta> @ \<Gamma>)[X \<mapsto> T]\<^sub>e = \<Delta>[X \<mapsto> T]\<^sub>e @ \<Gamma>[X \<mapsto> T]\<^sub>e"
133.582 + by (induct \<Delta>) simp_all
133.583 +
133.584 +nominal_primrec
133.585 + subst_trm :: "trm \<Rightarrow> vrs \<Rightarrow> trm \<Rightarrow> trm" ("_[_ \<mapsto> _]" [300, 0, 0] 300)
133.586 +where
133.587 + "(Var x)[y \<mapsto> t'] = (if x=y then t' else (Var x))"
133.588 +| "(t1 \<cdot> t2)[y \<mapsto> t'] = t1[y \<mapsto> t'] \<cdot> t2[y \<mapsto> t']"
133.589 +| "(t \<cdot>\<^sub>\<tau> T)[y \<mapsto> t'] = t[y \<mapsto> t'] \<cdot>\<^sub>\<tau> T"
133.590 +| "X\<sharp>(T,t') \<Longrightarrow> (\<lambda>X<:T. t)[y \<mapsto> t'] = (\<lambda>X<:T. t[y \<mapsto> t'])"
133.591 +| "x\<sharp>(y,t') \<Longrightarrow> (\<lambda>x:T. t)[y \<mapsto> t'] = (\<lambda>x:T. t[y \<mapsto> t'])"
133.592 +apply(finite_guess)+
133.593 +apply(rule TrueI)+
133.594 +apply(simp add: abs_fresh)+
133.595 +apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
133.596 +done
133.597 +
133.598 +lemma subst_trm_fresh_tyvar:
133.599 + "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> u \<Longrightarrow> X \<sharp> t[x \<mapsto> u]"
133.600 + by (nominal_induct t avoiding: x u rule: trm.strong_induct)
133.601 + (auto simp add: trm.fresh abs_fresh)
133.602 +
133.603 +lemma subst_trm_fresh_var: "x \<sharp> u \<Longrightarrow> x \<sharp> t[x \<mapsto> u]"
133.604 + by (nominal_induct t avoiding: x u rule: trm.strong_induct)
133.605 + (simp_all add: abs_fresh fresh_atm ty_vrs_fresh)
133.606 +
133.607 +lemma subst_trm_eqvt[eqvt]:
133.608 + fixes pi::"tyvrs prm"
133.609 + and t::"trm"
133.610 + shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
133.611 + by (nominal_induct t avoiding: x u rule: trm.strong_induct)
133.612 + (perm_simp add: fresh_left)+
133.613 +
133.614 +lemma subst_trm_eqvt'[eqvt]:
133.615 + fixes pi::"vrs prm"
133.616 + and t::"trm"
133.617 + shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
133.618 + by (nominal_induct t avoiding: x u rule: trm.strong_induct)
133.619 + (perm_simp add: fresh_left)+
133.620 +
133.621 +lemma subst_trm_rename:
133.622 + "y \<sharp> t \<Longrightarrow> ([(y, x)] \<bullet> t)[y \<mapsto> u] = t[x \<mapsto> u]"
133.623 + by (nominal_induct t avoiding: x y u rule: trm.strong_induct)
133.624 + (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux ty_vrs_fresh perm_fresh_fresh)
133.625 +
133.626 +nominal_primrec (freshness_context: "T2::ty")
133.627 + subst_trm_ty :: "trm \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> trm" ("_[_ \<mapsto>\<^sub>\<tau> _]" [300, 0, 0] 300)
133.628 +where
133.629 + "(Var x)[Y \<mapsto>\<^sub>\<tau> T2] = Var x"
133.630 +| "(t1 \<cdot> t2)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot> t2[Y \<mapsto>\<^sub>\<tau> T2]"
133.631 +| "(t1 \<cdot>\<^sub>\<tau> T)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot>\<^sub>\<tau> T[Y \<mapsto> T2]\<^sub>\<tau>"
133.632 +| "X\<sharp>(Y,T,T2) \<Longrightarrow> (\<lambda>X<:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>X<:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])"
133.633 +| "(\<lambda>x:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>x:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])"
133.634 +apply(finite_guess)+
133.635 +apply(rule TrueI)+
133.636 +apply(simp add: abs_fresh ty_vrs_fresh)+
133.637 +apply(simp add: type_subst_fresh)
133.638 +apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
133.639 +done
133.640 +
133.641 +lemma subst_trm_ty_fresh:
133.642 + "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> T \<Longrightarrow> X \<sharp> t[Y \<mapsto>\<^sub>\<tau> T]"
133.643 + by (nominal_induct t avoiding: Y T rule: trm.strong_induct)
133.644 + (auto simp add: abs_fresh type_subst_fresh)
133.645 +
133.646 +lemma subst_trm_ty_fresh':
133.647 + "X \<sharp> T \<Longrightarrow> X \<sharp> t[X \<mapsto>\<^sub>\<tau> T]"
133.648 + by (nominal_induct t avoiding: X T rule: trm.strong_induct)
133.649 + (simp_all add: abs_fresh fresh_type_subst_fresh fresh_atm)
133.650 +
133.651 +lemma subst_trm_ty_eqvt[eqvt]:
133.652 + fixes pi::"tyvrs prm"
133.653 + and t::"trm"
133.654 + shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
133.655 + by (nominal_induct t avoiding: X T rule: trm.strong_induct)
133.656 + (perm_simp add: fresh_bij subst_eqvt)+
133.657 +
133.658 +lemma subst_trm_ty_eqvt'[eqvt]:
133.659 + fixes pi::"vrs prm"
133.660 + and t::"trm"
133.661 + shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
133.662 + by (nominal_induct t avoiding: X T rule: trm.strong_induct)
133.663 + (perm_simp add: fresh_left subst_eqvt')+
133.664 +
133.665 +lemma subst_trm_ty_rename:
133.666 + "Y \<sharp> t \<Longrightarrow> ([(Y, X)] \<bullet> t)[Y \<mapsto>\<^sub>\<tau> U] = t[X \<mapsto>\<^sub>\<tau> U]"
133.667 + by (nominal_induct t avoiding: X Y U rule: trm.strong_induct)
133.668 + (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux type_subst_rename)
133.669 +
133.670 section {* Subtyping-Relation *}
133.671
133.672 text {* The definition for the subtyping-relation follows quite closely what is written
133.673 @@ -269,13 +595,13 @@
133.674 $\alpha$-equivalence classes.) *}
133.675
133.676 inductive
133.677 - subtype_of :: "ty_context \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_\<turnstile>_<:_" [100,100,100] 100)
133.678 + subtype_of :: "env \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_\<turnstile>_<:_" [100,100,100] 100)
133.679 where
133.680 - S_Top[intro]: "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
133.681 -| S_Var[intro]: "\<lbrakk>(X,S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
133.682 -| S_Refl[intro]: "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
133.683 -| S_Arrow[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)"
133.684 -| S_Forall[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; X\<sharp>\<Gamma>; ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"
133.685 + SA_Top[intro]: "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
133.686 +| SA_refl_TVar[intro]: "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> ty_domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
133.687 +| SA_trans_TVar[intro]: "\<lbrakk>(TVarB X S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
133.688 +| SA_arrow[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)"
133.689 +| SA_all[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.690
133.691 lemma subtype_implies_ok:
133.692 fixes X::"tyvrs"
133.693 @@ -288,15 +614,15 @@
133.694 shows "S closed_in \<Gamma> \<and> T closed_in \<Gamma>"
133.695 using a
133.696 proof (induct)
133.697 - case (S_Top \<Gamma> S)
133.698 + case (SA_Top \<Gamma> S)
133.699 have "Top closed_in \<Gamma>" by (simp add: closed_in_def ty.supp)
133.700 moreover
133.701 have "S closed_in \<Gamma>" by fact
133.702 ultimately show "S closed_in \<Gamma> \<and> Top closed_in \<Gamma>" by simp
133.703 next
133.704 - case (S_Var X S \<Gamma> T)
133.705 - have "(X,S)\<in>set \<Gamma>" by fact
133.706 - hence "X \<in> domain \<Gamma>" by (rule domain_inclusion)
133.707 + case (SA_trans_TVar X S \<Gamma> T)
133.708 + have "(TVarB X S)\<in>set \<Gamma>" by fact
133.709 + hence "X \<in> ty_domain \<Gamma>" by (rule ty_domain_inclusion)
133.710 hence "(Tvar X) closed_in \<Gamma>" by (simp add: closed_in_def ty.supp supp_atm)
133.711 moreover
133.712 have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by fact
133.713 @@ -311,20 +637,33 @@
133.714 shows "X\<sharp>S \<and> X\<sharp>T"
133.715 proof -
133.716 from a1 have "\<turnstile> \<Gamma> ok" by (rule subtype_implies_ok)
133.717 - with a2 have "X\<sharp>domain(\<Gamma>)" by (simp add: fresh_domain)
133.718 + with a2 have "X\<sharp>ty_domain(\<Gamma>)" by (simp add: fresh_domain)
133.719 moreover
133.720 from a1 have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by (rule subtype_implies_closed)
133.721 - hence "supp S \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)"
133.722 - and "supp T \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)" by (simp_all add: domain_supp closed_in_def)
133.723 + hence "supp S \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)"
133.724 + and "supp T \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)" by (simp_all add: ty_domain_supp closed_in_def)
133.725 ultimately show "X\<sharp>S \<and> X\<sharp>T" by (force simp add: supp_prod fresh_def)
133.726 qed
133.727
133.728 +lemma valid_ty_domain_fresh:
133.729 + fixes X::"tyvrs"
133.730 + assumes valid: "\<turnstile> \<Gamma> ok"
133.731 + shows "X\<sharp>(ty_domain \<Gamma>) = X\<sharp>\<Gamma>"
133.732 + using valid
133.733 + apply induct
133.734 + apply (simp add: fresh_list_nil fresh_set_empty)
133.735 + apply (simp_all add: binding.fresh fresh_list_cons
133.736 + fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains fresh_atm)
133.737 + apply (auto simp add: closed_in_fresh)
133.738 + done
133.739 +
133.740 equivariance subtype_of
133.741
133.742 -nominal_inductive subtype_of
133.743 - by (simp_all add: abs_fresh subtype_implies_fresh)
133.744 -
133.745 -thm subtype_of.strong_induct
133.746 +nominal_inductive subtype_of
133.747 + apply (simp_all add: abs_fresh)
133.748 + apply (fastsimp simp add: valid_ty_domain_fresh dest: subtype_implies_ok)
133.749 + apply (force simp add: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
133.750 + done
133.751
133.752 section {* Reflexivity of Subtyping *}
133.753
133.754 @@ -338,17 +677,17 @@
133.755 have ih_T\<^isub>1: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>1 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>1 <: T\<^isub>1" by fact
133.756 have ih_T\<^isub>2: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>2 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" by fact
133.757 have fresh_cond: "X\<sharp>\<Gamma>" by fact
133.758 - hence fresh_domain: "X\<sharp>(domain \<Gamma>)" by (simp add: fresh_domain)
133.759 - have "(\<forall>[X<:T\<^isub>2].T\<^isub>1) closed_in \<Gamma>" by fact
133.760 - hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((X,T\<^isub>2)#\<Gamma>)"
133.761 + hence fresh_ty_domain: "X\<sharp>(ty_domain \<Gamma>)" by (simp add: fresh_domain)
133.762 + have "(\<forall>X<:T\<^isub>2. T\<^isub>1) closed_in \<Gamma>" by fact
133.763 + hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((TVarB X T\<^isub>2)#\<Gamma>)"
133.764 by (auto simp add: closed_in_def ty.supp abs_supp)
133.765 have ok: "\<turnstile> \<Gamma> ok" by fact
133.766 - hence ok': "\<turnstile> ((X,T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_domain by simp
133.767 + hence ok': "\<turnstile> ((TVarB X T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_ty_domain by simp
133.768 have "\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" using ih_T\<^isub>2 closed\<^isub>T\<^isub>2 ok by simp
133.769 moreover
133.770 - have "((X,T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
133.771 - ultimately show "\<Gamma> \<turnstile> \<forall>[X<:T\<^isub>2].T\<^isub>1 <: \<forall>[X<:T\<^isub>2].T\<^isub>1" using fresh_cond
133.772 - by (simp add: subtype_of.S_Forall)
133.773 + have "((TVarB X T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
133.774 + ultimately show "\<Gamma> \<turnstile> (\<forall>X<:T\<^isub>2. T\<^isub>1) <: (\<forall>X<:T\<^isub>2. T\<^isub>1)" using fresh_cond
133.775 + by (simp add: subtype_of.SA_all)
133.776 qed (auto simp add: closed_in_def ty.supp supp_atm)
133.777
133.778 lemma subtype_reflexivity_semiautomated:
133.779 @@ -361,11 +700,10 @@
133.780 --{* Too bad that this instantiation cannot be found automatically by
133.781 \isakeyword{auto}; \isakeyword{blast} would find it if we had not used
133.782 an explicit definition for @{text "closed_in_def"}. *}
133.783 -apply(drule_tac x="(tyvrs, ty2)#\<Gamma>" in meta_spec)
133.784 +apply(drule_tac x="(TVarB tyvrs ty2)#\<Gamma>" in meta_spec)
133.785 apply(force dest: fresh_domain simp add: closed_in_def)
133.786 done
133.787
133.788 -
133.789 section {* Weakening *}
133.790
133.791 text {* In order to prove weakening we introduce the notion of a type-context extending
133.792 @@ -373,16 +711,16 @@
133.793 smoother than if we had strictly adhered to the version in the POPLmark-paper. *}
133.794
133.795 constdefs
133.796 - extends :: "ty_context \<Rightarrow> ty_context \<Rightarrow> bool" ("_ extends _" [100,100] 100)
133.797 - "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (X,Q)\<in>set \<Gamma> \<longrightarrow> (X,Q)\<in>set \<Delta>"
133.798 + extends :: "env \<Rightarrow> env \<Rightarrow> bool" ("_ extends _" [100,100] 100)
133.799 + "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (TVarB X Q)\<in>set \<Gamma> \<longrightarrow> (TVarB X Q)\<in>set \<Delta>"
133.800
133.801 -lemma extends_domain:
133.802 +lemma extends_ty_domain:
133.803 assumes a: "\<Delta> extends \<Gamma>"
133.804 - shows "domain \<Gamma> \<subseteq> domain \<Delta>"
133.805 + shows "ty_domain \<Gamma> \<subseteq> ty_domain \<Delta>"
133.806 using a
133.807 apply (auto simp add: extends_def)
133.808 - apply (drule domain_existence)
133.809 - apply (force simp add: domain_inclusion)
133.810 + apply (drule ty_domain_existence)
133.811 + apply (force simp add: ty_domain_inclusion)
133.812 done
133.813
133.814 lemma extends_closed:
133.815 @@ -390,12 +728,12 @@
133.816 and a2: "\<Delta> extends \<Gamma>"
133.817 shows "T closed_in \<Delta>"
133.818 using a1 a2
133.819 - by (auto dest: extends_domain simp add: closed_in_def)
133.820 + by (auto dest: extends_ty_domain simp add: closed_in_def)
133.821
133.822 lemma extends_memb:
133.823 assumes a: "\<Delta> extends \<Gamma>"
133.824 - and b: "(X,T) \<in> set \<Gamma>"
133.825 - shows "(X,T) \<in> set \<Delta>"
133.826 + and b: "(TVarB X T) \<in> set \<Gamma>"
133.827 + shows "(TVarB X T) \<in> set \<Delta>"
133.828 using a b by (simp add: extends_def)
133.829
133.830 lemma weakening:
133.831 @@ -405,7 +743,7 @@
133.832 shows "\<Delta> \<turnstile> S <: T"
133.833 using a b c
133.834 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
133.835 - case (S_Top \<Gamma> S)
133.836 + case (SA_Top \<Gamma> S)
133.837 have lh_drv_prem: "S closed_in \<Gamma>" by fact
133.838 have "\<turnstile> \<Delta> ok" by fact
133.839 moreover
133.840 @@ -413,43 +751,43 @@
133.841 hence "S closed_in \<Delta>" using lh_drv_prem by (simp only: extends_closed)
133.842 ultimately show "\<Delta> \<turnstile> S <: Top" by force
133.843 next
133.844 - case (S_Var X S \<Gamma> T)
133.845 - have lh_drv_prem: "(X,S) \<in> set \<Gamma>" by fact
133.846 + case (SA_trans_TVar X S \<Gamma> T)
133.847 + have lh_drv_prem: "(TVarB X S) \<in> set \<Gamma>" by fact
133.848 have ih: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> S <: T" by fact
133.849 have ok: "\<turnstile> \<Delta> ok" by fact
133.850 have extends: "\<Delta> extends \<Gamma>" by fact
133.851 - have "(X,S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
133.852 + have "(TVarB X S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
133.853 moreover
133.854 have "\<Delta> \<turnstile> S <: T" using ok extends ih by simp
133.855 ultimately show "\<Delta> \<turnstile> Tvar X <: T" using ok by force
133.856 next
133.857 - case (S_Refl \<Gamma> X)
133.858 - have lh_drv_prem: "X \<in> domain \<Gamma>" by fact
133.859 + case (SA_refl_TVar \<Gamma> X)
133.860 + have lh_drv_prem: "X \<in> ty_domain \<Gamma>" by fact
133.861 have "\<turnstile> \<Delta> ok" by fact
133.862 moreover
133.863 have "\<Delta> extends \<Gamma>" by fact
133.864 - hence "X \<in> domain \<Delta>" using lh_drv_prem by (force dest: extends_domain)
133.865 + hence "X \<in> ty_domain \<Delta>" using lh_drv_prem by (force dest: extends_ty_domain)
133.866 ultimately show "\<Delta> \<turnstile> Tvar X <: Tvar X" by force
133.867 next
133.868 - case (S_Arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
133.869 + case (SA_arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
133.870 next
133.871 - case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
133.872 + case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
133.873 have fresh_cond: "X\<sharp>\<Delta>" by fact
133.874 - hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
133.875 + hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
133.876 have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
133.877 - have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
133.878 + have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
133.879 have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
133.880 hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.881 have ok: "\<turnstile> \<Delta> ok" by fact
133.882 have ext: "\<Delta> extends \<Gamma>" by fact
133.883 have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
133.884 - hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force
133.885 + hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force
133.886 moreover
133.887 - have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
133.888 - ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
133.889 + have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
133.890 + ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
133.891 moreover
133.892 have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp
133.893 - ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
133.894 + ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
133.895 qed
133.896
133.897 text {* In fact all ``non-binding" cases can be solved automatically: *}
133.898 @@ -461,44 +799,41 @@
133.899 shows "\<Delta> \<turnstile> S <: T"
133.900 using a b c
133.901 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
133.902 - case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
133.903 + case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
133.904 have fresh_cond: "X\<sharp>\<Delta>" by fact
133.905 - hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
133.906 + hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
133.907 have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
133.908 - have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
133.909 + have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
133.910 have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
133.911 hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.912 have ok: "\<turnstile> \<Delta> ok" by fact
133.913 have ext: "\<Delta> extends \<Gamma>" by fact
133.914 have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
133.915 - hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force
133.916 + hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force
133.917 moreover
133.918 - have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
133.919 - ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
133.920 + have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
133.921 + ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
133.922 moreover
133.923 have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp
133.924 - ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
133.925 -qed (blast intro: extends_closed extends_memb dest: extends_domain)+
133.926 + ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
133.927 +qed (blast intro: extends_closed extends_memb dest: extends_ty_domain)+
133.928
133.929 section {* Transitivity and Narrowing *}
133.930
133.931 text {* Some inversion lemmas that are needed in the transitivity and narrowing proof.*}
133.932
133.933 -lemma S_TopE:
133.934 - assumes a: "\<Gamma> \<turnstile> Top <: T"
133.935 - shows "T = Top"
133.936 -using a by (cases, auto)
133.937 +declare ty.inject [simp add]
133.938
133.939 -lemma S_ArrowE_left:
133.940 - assumes a: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T"
133.941 - shows "T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = T\<^isub>1 \<rightarrow> T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2)"
133.942 -using a by (cases, auto simp add: ty.inject)
133.943 +inductive_cases S_TopE: "\<Gamma> \<turnstile> Top <: T"
133.944 +inductive_cases S_ArrowE_left: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T"
133.945 +
133.946 +declare ty.inject [simp del]
133.947
133.948 lemma S_ForallE_left:
133.949 - shows "\<lbrakk>\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
133.950 - \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = \<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
133.951 + shows "\<lbrakk>\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
133.952 + \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = (\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
133.953 apply(frule subtype_implies_ok)
133.954 - apply(ind_cases "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T")
133.955 + apply(ind_cases "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T")
133.956 apply(auto simp add: ty.inject alpha)
133.957 apply(rule_tac x="[(X,Xa)]\<bullet>T\<^isub>2" in exI)
133.958 apply(rule conjI)
133.959 @@ -509,18 +844,20 @@
133.960 apply(rule at_ds5[OF at_tyvrs_inst])
133.961 apply(rule conjI)
133.962 apply(simp add: pt_fresh_left[OF pt_tyvrs_inst, OF at_tyvrs_inst] calc_atm)
133.963 - apply(drule_tac \<Gamma>="((Xa,T\<^isub>1)#\<Gamma>)" in subtype_implies_closed)+
133.964 + apply(drule_tac \<Gamma>="((TVarB Xa T\<^isub>1)#\<Gamma>)" in subtype_implies_closed)+
133.965 apply(simp add: closed_in_def)
133.966 apply(drule fresh_domain)+
133.967 apply(simp add: fresh_def)
133.968 - apply(subgoal_tac "X \<notin> (insert Xa (domain \<Gamma>))")(*A*)
133.969 + apply(subgoal_tac "X \<notin> (insert Xa (ty_domain \<Gamma>))")(*A*)
133.970 apply(force)
133.971 - (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domain])
133.972 + (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domains(1)])
133.973 (* 2nd conjunct *)apply(frule_tac X="X" in subtype_implies_fresh)
133.974 apply(assumption)
133.975 + apply (frule_tac \<Gamma>="TVarB Xa T\<^isub>1 # \<Gamma>" in subtype_implies_ok)
133.976 + apply (erule validE)
133.977 + apply (simp add: valid_ty_domain_fresh)
133.978 apply(drule_tac X="Xa" in subtype_implies_fresh)
133.979 apply(assumption)
133.980 - apply(simp add: fresh_prod)
133.981 apply(drule_tac pi="[(X,Xa)]" in subtype_of.eqvt(2))
133.982 apply(simp add: calc_atm)
133.983 apply(simp add: pt_fresh_fresh[OF pt_tyvrs_inst, OF at_tyvrs_inst])
133.984 @@ -556,8 +893,8 @@
133.985 that of @{term x} the property @{term "P y"} holds. *}
133.986
133.987 lemma
133.988 - shows trans: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T"
133.989 - and narrow: "(\<Delta>@[(X,Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N"
133.990 + shows subtype_transitivity: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T"
133.991 + and subtype_narrow: "(\<Delta>@[(TVarB X Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N"
133.992 proof (induct Q arbitrary: \<Gamma> S T \<Delta> X P M N taking: "size_ty" rule: measure_induct_rule)
133.993 case (less Q)
133.994 --{* \begin{minipage}[t]{0.9\textwidth}
133.995 @@ -566,8 +903,8 @@
133.996 have IH_trans:
133.997 "\<And>Q' \<Gamma> S T. \<lbrakk>size_ty Q' < size_ty Q; \<Gamma>\<turnstile>S<:Q'; \<Gamma>\<turnstile>Q'<:T\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>S<:T" by fact
133.998 have IH_narrow:
133.999 - "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(X,Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk>
133.1000 - \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N" by fact
133.1001 + "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(TVarB X Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk>
133.1002 + \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N" by fact
133.1003 --{* \begin{minipage}[t]{0.9\textwidth}
133.1004 We proceed with the transitivity proof as an auxiliary lemma, because it needs
133.1005 to be referenced in the narrowing proof.\end{minipage}*}
133.1006 @@ -579,37 +916,36 @@
133.1007 and "\<Gamma>' \<turnstile> Q <: T" --{* right-hand derivation *}
133.1008 thus "\<Gamma>' \<turnstile> S' <: T"
133.1009 proof (nominal_induct \<Gamma>' S' Q\<equiv>Q rule: subtype_of.strong_induct)
133.1010 - case (S_Top \<Gamma> S)
133.1011 + case (SA_Top \<Gamma> S)
133.1012 --{* \begin{minipage}[t]{0.9\textwidth}
133.1013 In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S <: Top"}, giving
133.1014 us @{term "\<turnstile> \<Gamma> ok"} and @{term "S closed_in \<Gamma>"}. This case is straightforward,
133.1015 because the right-hand derivation must be of the form @{term "\<Gamma> \<turnstile> Top <: Top"}
133.1016 giving us the equation @{term "T = Top"}.\end{minipage}*}
133.1017 hence rh_drv: "\<Gamma> \<turnstile> Top <: T" by simp
133.1018 - hence T_inst: "T = Top" by (simp add: S_TopE)
133.1019 - have "\<turnstile> \<Gamma> ok"
133.1020 - and "S closed_in \<Gamma>" by fact+
133.1021 - hence "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.S_Top)
133.1022 + hence T_inst: "T = Top" by (auto elim: S_TopE)
133.1023 + from `\<turnstile> \<Gamma> ok` and `S closed_in \<Gamma>`
133.1024 + have "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
133.1025 thus "\<Gamma> \<turnstile> S <: T" using T_inst by simp
133.1026 next
133.1027 - case (S_Var Y U \<Gamma>)
133.1028 + case (SA_trans_TVar Y U \<Gamma>)
133.1029 -- {* \begin{minipage}[t]{0.9\textwidth}
133.1030 In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> Tvar Y <: Q"}
133.1031 with @{term "S = Tvar Y"}. We have therefore @{term "(Y,U)"}
133.1032 is in @{term "\<Gamma>"} and by inner induction hypothesis that @{term "\<Gamma> \<turnstile> U <: T"}.
133.1033 By @{text "S_Var"} follows @{term "\<Gamma> \<turnstile> Tvar Y <: T"}.\end{minipage}*}
133.1034 hence IH_inner: "\<Gamma> \<turnstile> U <: T" by simp
133.1035 - have "(Y,U) \<in> set \<Gamma>" by fact
133.1036 - with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.S_Var)
133.1037 + have "(TVarB Y U) \<in> set \<Gamma>" by fact
133.1038 + with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.SA_trans_TVar)
133.1039 next
133.1040 - case (S_Refl \<Gamma> X)
133.1041 + case (SA_refl_TVar \<Gamma> X)
133.1042 --{* \begin{minipage}[t]{0.9\textwidth}
133.1043 In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(Tvar X) <: (Tvar X)"} with
133.1044 @{term "Q=Tvar X"}. The goal then follows immediately from the right-hand
133.1045 derivation.\end{minipage}*}
133.1046 thus "\<Gamma> \<turnstile> Tvar X <: T" by simp
133.1047 next
133.1048 - case (S_Arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2)
133.1049 + case (SA_arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2)
133.1050 --{* \begin{minipage}[t]{0.9\textwidth}
133.1051 In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: Q\<^isub>1 \<rightarrow> Q\<^isub>2"} with
133.1052 @{term "S\<^isub>1\<rightarrow>S\<^isub>2=S"} and @{term "Q\<^isub>1\<rightarrow>Q\<^isub>2=Q"}. We know that the @{text "size_ty"} of
133.1053 @@ -629,7 +965,7 @@
133.1054 have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
133.1055 have lh_drv_prm\<^isub>2: "\<Gamma> \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
133.1056 from rh_drv have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=T\<^isub>1\<rightarrow>T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> \<Gamma>\<turnstile>Q\<^isub>2<:T\<^isub>2)"
133.1057 - by (simp add: S_ArrowE_left)
133.1058 + by (auto elim: S_ArrowE_left)
133.1059 moreover
133.1060 have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in \<Gamma>"
133.1061 using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
133.1062 @@ -647,176 +983,1020 @@
133.1063 moreover
133.1064 from IH_trans[of "Q\<^isub>2"]
133.1065 have "\<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 lh_drv_prm\<^isub>2 by simp
133.1066 - ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.S_Arrow)
133.1067 + ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.SA_arrow)
133.1068 hence "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" using T_inst by simp
133.1069 }
133.1070 ultimately show "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" by blast
133.1071 next
133.1072 - case (S_Forall \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2)
133.1073 + case (SA_all \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2)
133.1074 --{* \begin{minipage}[t]{0.9\textwidth}
133.1075 - In this case the left-hand derivation is @{text "\<Gamma>\<turnstile>\<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:Q\<^isub>1].Q\<^isub>2"} with
133.1076 - @{text "\<forall>[X<:S\<^isub>1].S\<^isub>2=S"} and @{text "\<forall>[X<:Q\<^isub>1].Q\<^isub>2=Q"}. We therefore have the sub-derivations
133.1077 - @{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((X,Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
133.1078 + In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:Q\<^isub>1. Q\<^isub>2)"} with
133.1079 + @{term "(\<forall>X<:S\<^isub>1. S\<^isub>2)=S"} and @{term "(\<forall>X<:Q\<^isub>1. Q\<^isub>2)=Q"}. We therefore have the sub-derivations
133.1080 + @{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((TVarB X Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
133.1081 assume that it is sufficiently fresh; in particular we have the freshness conditions
133.1082 @{term "X\<sharp>\<Gamma>"} and @{term "X\<sharp>Q\<^isub>1"} (these assumptions are provided by the strong
133.1083 induction-rule @{text "subtype_of_induct"}). We know that the @{text "size_ty"} of
133.1084 @{term Q\<^isub>1} and @{term Q\<^isub>2} is smaller than that of @{term Q};
133.1085 so we can apply the outer induction hypotheses for @{term Q\<^isub>1} and @{term Q\<^isub>2}.
133.1086 - The right-hand derivation is @{text "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T"}. Since @{term "X\<sharp>\<Gamma>"}
133.1087 + The right-hand derivation is @{term "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T"}. Since @{term "X\<sharp>\<Gamma>"}
133.1088 and @{term "X\<sharp>Q\<^isub>1"} there exists types @{text "T\<^isub>1,T\<^isub>2"} such that
133.1089 - @{text "T=Top \<or> T=\<forall>[X<:T\<^isub>1].T\<^isub>2"}. The @{term "Top"}-case is straightforward once we know
133.1090 - @{text "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have
133.1091 - the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer
133.1092 + @{term "T=Top \<or> T=(\<forall>X<:T\<^isub>1. T\<^isub>2)"}. The @{term "Top"}-case is straightforward once we know
133.1093 + @{term "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have
133.1094 + the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer
133.1095 induction hypothesis for transitivity we can derive @{term "\<Gamma>\<turnstile>T\<^isub>1<:S\<^isub>1"}. From the outer
133.1096 - induction for narrowing we get @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again
133.1097 - induction for transitivity we obtain @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule
133.1098 + induction for narrowing we get @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again
133.1099 + induction for transitivity we obtain @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule
133.1100 @{text "S_Forall"} and the freshness condition @{term "X\<sharp>\<Gamma>"} follows
133.1101 - @{text "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"}, which is @{text "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T\<^isub>"}.
133.1102 + @{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"}, which is @{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T\<^isub>"}.
133.1103 \end{minipage}*}
133.1104 - hence rh_drv: "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T" by simp
133.1105 + hence rh_drv: "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T" by simp
133.1106 have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
133.1107 - have lh_drv_prm\<^isub>2: "((X,Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
133.1108 - have "X\<sharp>\<Gamma>" by fact
133.1109 + have lh_drv_prm\<^isub>2: "((TVarB X Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
133.1110 + then have "X\<sharp>\<Gamma>" by (force dest: subtype_implies_ok simp add: valid_ty_domain_fresh)
133.1111 then have fresh_cond: "X\<sharp>\<Gamma>" "X\<sharp>Q\<^isub>1" using lh_drv_prm\<^isub>1 by (simp_all add: subtype_implies_fresh)
133.1112 - from `\<forall>[X<:Q\<^isub>1].Q\<^isub>2 = Q`
133.1113 + from `(\<forall>X<:Q\<^isub>1. Q\<^isub>2) = Q`
133.1114 have Q\<^isub>1\<^isub>2_less: "size_ty Q\<^isub>1 < size_ty Q" "size_ty Q\<^isub>2 < size_ty Q " using fresh_cond by auto
133.1115 from rh_drv
133.1116 - have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)"
133.1117 + have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)"
133.1118 using fresh_cond by (simp add: S_ForallE_left)
133.1119 moreover
133.1120 - have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((X,Q\<^isub>1)#\<Gamma>)"
133.1121 + have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((TVarB X Q\<^isub>1)#\<Gamma>)"
133.1122 using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
133.1123 - hence "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
133.1124 + hence "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
133.1125 moreover
133.1126 have "\<turnstile> \<Gamma> ok" using rh_drv by (rule subtype_implies_ok)
133.1127 moreover
133.1128 - { assume "\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
133.1129 + { assume "\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
133.1130 then obtain T\<^isub>1 T\<^isub>2
133.1131 - where T_inst: "T = \<forall>[X<:T\<^isub>1].T\<^isub>2"
133.1132 + where T_inst: "T = (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.1133 and rh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> T\<^isub>1 <: Q\<^isub>1"
133.1134 - and rh_drv_prm\<^isub>2:"((X,T\<^isub>1)#\<Gamma>) \<turnstile> Q\<^isub>2 <: T\<^isub>2" by force
133.1135 + and rh_drv_prm\<^isub>2:"((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> Q\<^isub>2 <: T\<^isub>2" by force
133.1136 from IH_trans[of "Q\<^isub>1"]
133.1137 have "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" using lh_drv_prm\<^isub>1 rh_drv_prm\<^isub>1 Q\<^isub>1\<^isub>2_less by blast
133.1138 moreover
133.1139 from IH_narrow[of "Q\<^isub>1" "[]"]
133.1140 - have "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" using Q\<^isub>1\<^isub>2_less lh_drv_prm\<^isub>2 rh_drv_prm\<^isub>1 by simp
133.1141 + have "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" using Q\<^isub>1\<^isub>2_less lh_drv_prm\<^isub>2 rh_drv_prm\<^isub>1 by simp
133.1142 with IH_trans[of "Q\<^isub>2"]
133.1143 - have "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 by simp
133.1144 - ultimately have "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"
133.1145 - using fresh_cond by (simp add: subtype_of.S_Forall)
133.1146 - hence "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T" using T_inst by simp
133.1147 + have "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 by simp
133.1148 + ultimately have "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.1149 + using fresh_cond by (simp add: subtype_of.SA_all)
133.1150 + hence "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T" using T_inst by simp
133.1151 }
133.1152 - ultimately show "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T" by blast
133.1153 + ultimately show "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T" by blast
133.1154 qed
133.1155 qed
133.1156
133.1157 { --{* The transitivity proof is now by the auxiliary lemma. *}
133.1158 case 1
133.1159 - have "\<Gamma> \<turnstile> S <: Q"
133.1160 - and "\<Gamma> \<turnstile> Q <: T" by fact+
133.1161 - thus "\<Gamma> \<turnstile> S <: T" by (rule transitivity_aux)
133.1162 + from `\<Gamma> \<turnstile> S <: Q` and `\<Gamma> \<turnstile> Q <: T`
133.1163 + show "\<Gamma> \<turnstile> S <: T" by (rule transitivity_aux)
133.1164 next
133.1165 - --{* The narrowing proof proceeds by an induction over @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> M <: N"}. *}
133.1166 + --{* The narrowing proof proceeds by an induction over @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N"}. *}
133.1167 case 2
133.1168 - have "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> M <: N" --{* left-hand derivation *}
133.1169 - and "\<Gamma> \<turnstile> P<:Q" by fact+ --{* right-hand derivation *}
133.1170 - thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> M <: N"
133.1171 - proof (nominal_induct \<Gamma>\<equiv>"\<Delta>@[(X,Q)]@\<Gamma>" M N avoiding: \<Delta> \<Gamma> X rule: subtype_of.strong_induct)
133.1172 - case (S_Top _ S \<Delta> \<Gamma> X)
133.1173 + from `(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N` --{* left-hand derivation *}
133.1174 + and `\<Gamma> \<turnstile> P<:Q` --{* right-hand derivation *}
133.1175 + show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> M <: N"
133.1176 + proof (nominal_induct \<Gamma>\<equiv>"\<Delta>@[(TVarB X Q)]@\<Gamma>" M N avoiding: \<Delta> \<Gamma> X rule: subtype_of.strong_induct)
133.1177 + case (SA_Top _ S \<Delta> \<Gamma> X)
133.1178 --{* \begin{minipage}[t]{0.9\textwidth}
133.1179 - In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> S <: Top"}. We show
133.1180 - that the context @{term "\<Delta>@[(X,P)]@\<Gamma>"} is ok and that @{term S} is closed in
133.1181 - @{term "\<Delta>@[(X,P)]@\<Gamma>"}. Then we can apply the @{text "S_Top"}-rule.\end{minipage}*}
133.1182 - hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok"
133.1183 - and lh_drv_prm\<^isub>2: "S closed_in (\<Delta>@[(X,Q)]@\<Gamma>)" by simp_all
133.1184 + In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> S <: Top"}. We show
133.1185 + that the context @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} is ok and that @{term S} is closed in
133.1186 + @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. Then we can apply the @{text "S_Top"}-rule.\end{minipage}*}
133.1187 + hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok"
133.1188 + and lh_drv_prm\<^isub>2: "S closed_in (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp_all
133.1189 have rh_drv: "\<Gamma> \<turnstile> P <: Q" by fact
133.1190 hence "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.1191 - with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1192 + with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1193 moreover
133.1194 - from lh_drv_prm\<^isub>2 have "S closed_in (\<Delta>@[(X,P)]@\<Gamma>)"
133.1195 - by (simp add: closed_in_def domain_append)
133.1196 - ultimately show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: Top" by (simp add: subtype_of.S_Top)
133.1197 + from lh_drv_prm\<^isub>2 have "S closed_in (\<Delta>@[(TVarB X P)]@\<Gamma>)"
133.1198 + by (simp add: closed_in_def domains_append)
133.1199 + ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
133.1200 next
133.1201 - case (S_Var Y S _ N \<Delta> \<Gamma> X)
133.1202 + case (SA_trans_TVar Y S _ N \<Delta> \<Gamma> X)
133.1203 --{* \begin{minipage}[t]{0.9\textwidth}
133.1204 - In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Tvar Y <: N"} and
133.1205 - by inner induction hypothesis we have @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: N"}. We therefore
133.1206 - know that the contexts @{term "\<Delta>@[(X,Q)]@\<Gamma>"} and @{term "\<Delta>@[(X,P)]@\<Gamma>"} are ok, and that
133.1207 - @{term "(Y,S)"} is in @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. We need to show that
133.1208 - @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N"} holds. In case @{term "X\<noteq>Y"} we know that
133.1209 - @{term "(Y,S)"} is in @{term "\<Delta>@[(X,P)]@\<Gamma>"} and can use the inner induction hypothesis
133.1210 + In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Tvar Y <: N"} and
133.1211 + by inner induction hypothesis we have @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: N"}. We therefore
133.1212 + know that the contexts @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"} and @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} are ok, and that
133.1213 + @{term "(Y,S)"} is in @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. We need to show that
133.1214 + @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N"} holds. In case @{term "X\<noteq>Y"} we know that
133.1215 + @{term "(Y,S)"} is in @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} and can use the inner induction hypothesis
133.1216 and rule @{text "S_Var"} to conclude. In case @{term "X=Y"} we can infer that
133.1217 - @{term "S=Q"}; moreover we have that @{term "(\<Delta>@[(X,P)]@\<Gamma>) extends \<Gamma>"} and therefore
133.1218 - by @{text "weakening"} that @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: Q"} holds. By transitivity we
133.1219 - obtain then @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: N"} and can conclude by applying rule
133.1220 + @{term "S=Q"}; moreover we have that @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) extends \<Gamma>"} and therefore
133.1221 + by @{text "weakening"} that @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: Q"} holds. By transitivity we
133.1222 + obtain then @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: N"} and can conclude by applying rule
133.1223 @{text "S_Var"}.\end{minipage}*}
133.1224 - hence IH_inner: "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S <: N"
133.1225 - and lh_drv_prm: "(Y,S) \<in> set (\<Delta>@[(X,Q)]@\<Gamma>)"
133.1226 + hence IH_inner: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: N"
133.1227 + and lh_drv_prm: "(TVarB Y S) \<in> set (\<Delta>@[(TVarB X Q)]@\<Gamma>)"
133.1228 and rh_drv: "\<Gamma> \<turnstile> P<:Q"
133.1229 - and ok\<^isub>Q: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
133.1230 - hence ok\<^isub>P: "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok)
133.1231 - show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N"
133.1232 + and ok\<^isub>Q: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
133.1233 + hence ok\<^isub>P: "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok)
133.1234 + show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N"
133.1235 proof (cases "X=Y")
133.1236 case False
133.1237 have "X\<noteq>Y" by fact
133.1238 - hence "(Y,S)\<in>set (\<Delta>@[(X,P)]@\<Gamma>)" using lh_drv_prm by simp
133.1239 - with IH_inner show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N" by (simp add: subtype_of.S_Var)
133.1240 + hence "(TVarB Y S)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" using lh_drv_prm by (simp add:binding.inject)
133.1241 + with IH_inner show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" by (simp add: subtype_of.SA_trans_TVar)
133.1242 next
133.1243 case True
133.1244 - have memb\<^isub>X\<^isub>Q: "(X,Q)\<in>set (\<Delta>@[(X,Q)]@\<Gamma>)" by simp
133.1245 - have memb\<^isub>X\<^isub>P: "(X,P)\<in>set (\<Delta>@[(X,P)]@\<Gamma>)" by simp
133.1246 + have memb\<^isub>X\<^isub>Q: "(TVarB X Q)\<in>set (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp
133.1247 + have memb\<^isub>X\<^isub>P: "(TVarB X P)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" by simp
133.1248 have eq: "X=Y" by fact
133.1249 hence "S=Q" using ok\<^isub>Q lh_drv_prm memb\<^isub>X\<^isub>Q by (simp only: uniqueness_of_ctxt)
133.1250 - hence "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Q <: N" using IH_inner by simp
133.1251 + hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q <: N" using IH_inner by simp
133.1252 moreover
133.1253 - have "(\<Delta>@[(X,P)]@\<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1254 - hence "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: Q" using rh_drv ok\<^isub>P by (simp only: weakening)
133.1255 - ultimately have "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> P <: N" by (simp add: transitivity_aux)
133.1256 - thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: N" using memb\<^isub>X\<^isub>P eq by (simp only: subtype_of.S_Var)
133.1257 + have "(\<Delta>@[(TVarB X P)]@\<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1258 + hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: Q" using rh_drv ok\<^isub>P by (simp only: weakening)
133.1259 + ultimately have "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: N" by (simp add: transitivity_aux)
133.1260 + thus "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" using memb\<^isub>X\<^isub>P eq by (simp only: subtype_of.SA_trans_TVar)
133.1261 qed
133.1262 next
133.1263 - case (S_Refl _ Y \<Delta> \<Gamma> X)
133.1264 + case (SA_refl_TVar _ Y \<Delta> \<Gamma> X)
133.1265 --{* \begin{minipage}[t]{0.9\textwidth}
133.1266 - In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y"} and we
133.1267 - therefore know that @{term "\<Delta>@[(X,Q)]@\<Gamma>"} is ok and that @{term "Y"} is in
133.1268 - the domain of @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. We therefore know that @{term "\<Delta>@[(X,P)]@\<Gamma>"} is ok
133.1269 - and that @{term Y} is in the domain of @{term "\<Delta>@[(X,P)]@\<Gamma>"}. We can conclude by applying
133.1270 + In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y"} and we
133.1271 + therefore know that @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"} is ok and that @{term "Y"} is in
133.1272 + the domain of @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. We therefore know that @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"} is ok
133.1273 + and that @{term Y} is in the domain of @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. We can conclude by applying
133.1274 rule @{text "S_Refl"}.\end{minipage}*}
133.1275 - hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(X,Q)]@\<Gamma>) ok"
133.1276 - and lh_drv_prm\<^isub>2: "Y \<in> domain (\<Delta>@[(X,Q)]@\<Gamma>)" by simp_all
133.1277 + hence lh_drv_prm\<^isub>1: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok"
133.1278 + and lh_drv_prm\<^isub>2: "Y \<in> ty_domain (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp_all
133.1279 have "\<Gamma> \<turnstile> P <: Q" by fact
133.1280 hence "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
133.1281 - with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(X,P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1282 + with lh_drv_prm\<^isub>1 have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: replace_type)
133.1283 moreover
133.1284 - from lh_drv_prm\<^isub>2 have "Y \<in> domain (\<Delta>@[(X,P)]@\<Gamma>)" by (simp add: domain_append)
133.1285 - ultimately show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y" by (simp add: subtype_of.S_Refl)
133.1286 + from lh_drv_prm\<^isub>2 have "Y \<in> ty_domain (\<Delta>@[(TVarB X P)]@\<Gamma>)" by (simp add: domains_append)
133.1287 + ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y" by (simp add: subtype_of.SA_refl_TVar)
133.1288 next
133.1289 - case (S_Arrow _ S\<^isub>1 Q\<^isub>1 Q\<^isub>2 S\<^isub>2 \<Delta> \<Gamma> X)
133.1290 + case (SA_arrow _ S\<^isub>1 Q\<^isub>1 Q\<^isub>2 S\<^isub>2 \<Delta> \<Gamma> X)
133.1291 --{* \begin{minipage}[t]{0.9\textwidth}
133.1292 - In this case the left-hand derivation is @{term "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2"}
133.1293 + In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2"}
133.1294 and the proof is trivial.\end{minipage}*}
133.1295 - thus "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2" by blast
133.1296 + thus "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q\<^isub>1 \<rightarrow> Q\<^isub>2 <: S\<^isub>1 \<rightarrow> S\<^isub>2" by blast
133.1297 next
133.1298 - case (S_Forall _ T\<^isub>1 S\<^isub>1 Y S\<^isub>2 T\<^isub>2 \<Delta> \<Gamma> X)
133.1299 + case (SA_all \<Gamma>' T\<^isub>1 S\<^isub>1 Y S\<^isub>2 T\<^isub>2 \<Delta> \<Gamma> X)
133.1300 --{* \begin{minipage}[t]{0.9\textwidth}
133.1301 - In this case the left-hand derivation is @{text "(\<Delta>@[(X,Q)]@\<Gamma>) \<turnstile> \<forall>[Y<:S\<^isub>1].S\<^isub>2 <: \<forall>[Y<:T\<^isub>1].T\<^isub>2"}
133.1302 - and therfore we know that the binder @{term Y} is fresh for @{term "\<Delta>@[(X,Q)]@\<Gamma>"}. By
133.1303 - the inner induction hypothesis we have that @{term "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"} and
133.1304 - @{term "((Y,T\<^isub>1)#\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. Since @{term P} is a subtype of @{term Q}
133.1305 + In this case the left-hand derivation is @{term "(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> (\<forall>Y<:S\<^isub>1. S\<^isub>2) <: (\<forall>Y<:T\<^isub>1. T\<^isub>2)"}
133.1306 + and therfore we know that the binder @{term Y} is fresh for @{term "\<Delta>@[(TVarB X Q)]@\<Gamma>"}. By
133.1307 + the inner induction hypothesis we have that @{term "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"} and
133.1308 + @{term "((TVarB Y T\<^isub>1)#\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. Since @{term P} is a subtype of @{term Q}
133.1309 we can infer that @{term Y} is fresh for @{term P} and thus also fresh for
133.1310 - @{term "\<Delta>@[(X,P)]@\<Gamma>"}. We can then conclude by applying rule @{text "S_Forall"}.
133.1311 + @{term "\<Delta>@[(TVarB X P)]@\<Gamma>"}. We can then conclude by applying rule @{text "S_Forall"}.
133.1312 \end{minipage}*}
133.1313 - hence IH_inner\<^isub>1: "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"
133.1314 - and IH_inner\<^isub>2: "((Y,T\<^isub>1)#\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"
133.1315 - and lh_drv_prm: "Y\<sharp>(\<Delta>@[(X,Q)]@\<Gamma>)" by force+
133.1316 - have rh_drv: "\<Gamma> \<turnstile> P <: Q" by fact
133.1317 - hence "Y\<sharp>P" using lh_drv_prm by (simp only: fresh_list_append subtype_implies_fresh)
133.1318 - hence "Y\<sharp>(\<Delta>@[(X,P)]@\<Gamma>)" using lh_drv_prm
133.1319 - by (simp add: fresh_list_append fresh_list_cons fresh_prod)
133.1320 + hence rh_drv: "\<Gamma> \<turnstile> P <: Q"
133.1321 + and IH_inner\<^isub>1: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^isub>1 <: S\<^isub>1"
133.1322 + and "TVarB Y T\<^isub>1 # \<Gamma>' = ((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X Q] @ \<Gamma>" by auto
133.1323 + moreover have " \<lbrakk>\<Gamma>\<turnstile>P<:Q; TVarB Y T\<^isub>1 # \<Gamma>' = ((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X Q] @ \<Gamma>\<rbrakk> \<Longrightarrow> (((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X P] @ \<Gamma>)\<turnstile>S\<^isub>2<:T\<^isub>2" by fact
133.1324 + ultimately have IH_inner\<^isub>2: "(((TVarB Y T\<^isub>1)#\<Delta>) @ [TVarB X P] @ \<Gamma>)\<turnstile>S\<^isub>2<:T\<^isub>2" by auto
133.1325 with IH_inner\<^isub>1 IH_inner\<^isub>2
133.1326 - show "(\<Delta>@[(X,P)]@\<Gamma>) \<turnstile> \<forall>[Y<:S\<^isub>1].S\<^isub>2 <: \<forall>[Y<:T\<^isub>1].T\<^isub>2" by (simp add: subtype_of.S_Forall)
133.1327 + show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> (\<forall>Y<:S\<^isub>1. S\<^isub>2) <: (\<forall>Y<:T\<^isub>1. T\<^isub>2)" by (simp add: subtype_of.SA_all)
133.1328 qed
133.1329 }
133.1330 qed
133.1331
133.1332 -end
133.1333 \ No newline at end of file
133.1334 +section {* Typing *}
133.1335 +
133.1336 +inductive
133.1337 + typing :: "env \<Rightarrow> trm \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _ : _" [60,60,60] 60)
133.1338 +where
133.1339 + T_Var[intro]: "\<lbrakk> VarB x T \<in> set \<Gamma>; \<turnstile> \<Gamma> ok \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> Var x : T"
133.1340 +| T_App[intro]: "\<lbrakk> \<Gamma> \<turnstile> t\<^isub>1 : T\<^isub>1 \<rightarrow> T\<^isub>2; \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^isub>1 \<cdot> t\<^isub>2 : T\<^isub>2"
133.1341 +| T_Abs[intro]: "\<lbrakk> VarB x T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>x:T\<^isub>1. t\<^isub>2) : T\<^isub>1 \<rightarrow> T\<^isub>2"
133.1342 +| T_Sub[intro]: "\<lbrakk> \<Gamma> \<turnstile> t : S; \<Gamma> \<turnstile> S <: T \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t : T"
133.1343 +| T_TAbs[intro]:"\<lbrakk> TVarB X T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>X<:T\<^isub>1. t\<^isub>2) : (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.1344 +| T_TApp[intro]:"\<lbrakk> X \<sharp> (\<Gamma>, t\<^isub>1, T\<^isub>2); \<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2); \<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 : (T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>)"
133.1345 +
133.1346 +equivariance typing
133.1347 +
133.1348 +lemma better_T_TApp:
133.1349 + assumes H1: "\<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T11. T12)"
133.1350 + and H2: "\<Gamma> \<turnstile> T2 <: T11"
133.1351 + shows "\<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T2 : (T12[X \<mapsto> T2]\<^sub>\<tau>)"
133.1352 +proof -
133.1353 + obtain Y::tyvrs where Y: "Y \<sharp> (X, T12, \<Gamma>, t\<^isub>1, T2)"
133.1354 + by (rule exists_fresh) (rule fin_supp)
133.1355 + then have "Y \<sharp> (\<Gamma>, t\<^isub>1, T2)" by simp
133.1356 + moreover from Y have "(\<forall>X<:T11. T12) = (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)"
133.1357 + by (auto simp add: ty.inject alpha' fresh_prod fresh_atm)
133.1358 + with H1 have "\<Gamma> \<turnstile> t\<^isub>1 : (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)" by simp
133.1359 + ultimately have "\<Gamma> \<turnstile> t\<^isub>1 \<cdot>\<^sub>\<tau> T2 : (([(Y, X)] \<bullet> T12)[Y \<mapsto> T2]\<^sub>\<tau>)" using H2
133.1360 + by (rule T_TApp)
133.1361 + with Y show ?thesis by (simp add: type_subst_rename)
133.1362 +qed
133.1363 +
133.1364 +lemma typing_ok:
133.1365 + assumes "\<Gamma> \<turnstile> t : T"
133.1366 + shows "\<turnstile> \<Gamma> ok"
133.1367 +using assms by (induct, auto)
133.1368 +
133.1369 +nominal_inductive typing
133.1370 + by (auto dest!: typing_ok intro: closed_in_fresh fresh_domain
133.1371 + simp: abs_fresh fresh_prod fresh_atm freshs valid_ty_domain_fresh fresh_trm_domain)
133.1372 +
133.1373 +lemma ok_imp_VarB_closed_in:
133.1374 + assumes ok: "\<turnstile> \<Gamma> ok"
133.1375 + shows "VarB x T \<in> set \<Gamma> \<Longrightarrow> T closed_in \<Gamma>" using ok
133.1376 + by induct (auto simp add: binding.inject closed_in_def)
133.1377 +
133.1378 +lemma tyvrs_of_subst: "tyvrs_of (B[X \<mapsto> T]\<^sub>b) = tyvrs_of B"
133.1379 + by (nominal_induct B rule: binding.strong_induct) simp_all
133.1380 +
133.1381 +lemma ty_domain_subst: "ty_domain (\<Gamma>[X \<mapsto> T]\<^sub>e) = ty_domain \<Gamma>"
133.1382 + by (induct \<Gamma>) (simp_all add: tyvrs_of_subst)
133.1383 +
133.1384 +lemma vrs_of_subst: "vrs_of (B[X \<mapsto> T]\<^sub>b) = vrs_of B"
133.1385 + by (nominal_induct B rule: binding.strong_induct) simp_all
133.1386 +
133.1387 +lemma trm_domain_subst: "trm_domain (\<Gamma>[X \<mapsto> T]\<^sub>e) = trm_domain \<Gamma>"
133.1388 + by (induct \<Gamma>) (simp_all add: vrs_of_subst)
133.1389 +
133.1390 +lemma subst_closed_in:
133.1391 + "T closed_in (\<Delta> @ TVarB X S # \<Gamma>) \<Longrightarrow> U closed_in \<Gamma> \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> closed_in (\<Delta>[X \<mapsto> U]\<^sub>e @ \<Gamma>)"
133.1392 + apply (nominal_induct T avoiding: X U \<Gamma> rule: ty.strong_induct)
133.1393 + apply (simp add: closed_in_def ty.supp supp_atm domains_append ty_domain_subst)
133.1394 + apply blast
133.1395 + apply (simp add: closed_in_def ty.supp)
133.1396 + apply (simp add: closed_in_def ty.supp)
133.1397 + apply (simp add: closed_in_def ty.supp abs_supp)
133.1398 + apply (drule_tac x = X in meta_spec)
133.1399 + apply (drule_tac x = U in meta_spec)
133.1400 + apply (drule_tac x = "(TVarB tyvrs ty2) # \<Gamma>" in meta_spec)
133.1401 + apply (simp add: domains_append ty_domain_subst)
133.1402 + apply blast
133.1403 + done
133.1404 +
133.1405 +lemmas subst_closed_in' = subst_closed_in [where \<Delta>="[]", simplified]
133.1406 +
133.1407 +lemma typing_closed_in:
133.1408 + assumes "\<Gamma> \<turnstile> t : T"
133.1409 + shows "T closed_in \<Gamma>"
133.1410 +using assms
133.1411 +proof induct
133.1412 + case (T_Var x T \<Gamma>)
133.1413 + from `\<turnstile> \<Gamma> ok` and `VarB x T \<in> set \<Gamma>`
133.1414 + show ?case by (rule ok_imp_VarB_closed_in)
133.1415 +next
133.1416 + case (T_App \<Gamma> t\<^isub>1 T\<^isub>1 T\<^isub>2 t\<^isub>2)
133.1417 + then show ?case by (auto simp add: ty.supp closed_in_def)
133.1418 +next
133.1419 + case (T_Abs x T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1420 + from `VarB x T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2`
133.1421 + have "T\<^isub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
133.1422 + with T_Abs show ?case by (auto simp add: ty.supp closed_in_def)
133.1423 +next
133.1424 + case (T_Sub \<Gamma> t S T)
133.1425 + from `\<Gamma> \<turnstile> S <: T` show ?case by (simp add: subtype_implies_closed)
133.1426 +next
133.1427 + case (T_TAbs X T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1428 + from `TVarB X T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2`
133.1429 + have "T\<^isub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
133.1430 + with T_TAbs show ?case by (auto simp add: ty.supp closed_in_def abs_supp)
133.1431 +next
133.1432 + case (T_TApp X \<Gamma> t\<^isub>1 T2 T11 T12)
133.1433 + then have "T12 closed_in (TVarB X T11 # \<Gamma>)"
133.1434 + by (auto simp add: closed_in_def ty.supp abs_supp)
133.1435 + moreover from T_TApp have "T2 closed_in \<Gamma>"
133.1436 + by (simp add: subtype_implies_closed)
133.1437 + ultimately show ?case by (rule subst_closed_in')
133.1438 +qed
133.1439 +
133.1440 +
133.1441 +subsection {* Evaluation *}
133.1442 +
133.1443 +inductive
133.1444 + val :: "trm \<Rightarrow> bool"
133.1445 +where
133.1446 + Abs[intro]: "val (\<lambda>x:T. t)"
133.1447 +| TAbs[intro]: "val (\<lambda>X<:T. t)"
133.1448 +
133.1449 +equivariance val
133.1450 +
133.1451 +inductive_cases val_inv_auto[elim]:
133.1452 + "val (Var x)"
133.1453 + "val (t1 \<cdot> t2)"
133.1454 + "val (t1 \<cdot>\<^sub>\<tau> t2)"
133.1455 +
133.1456 +inductive
133.1457 + eval :: "trm \<Rightarrow> trm \<Rightarrow> bool" ("_ \<longmapsto> _" [60,60] 60)
133.1458 +where
133.1459 + E_Abs : "\<lbrakk> x \<sharp> v\<^isub>2; val v\<^isub>2 \<rbrakk> \<Longrightarrow> (\<lambda>x:T\<^isub>1\<^isub>1. t\<^isub>1\<^isub>2) \<cdot> v\<^isub>2 \<longmapsto> t\<^isub>1\<^isub>2[x \<mapsto> v\<^isub>2]"
133.1460 +| E_App1 [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot> u \<longmapsto> t' \<cdot> u"
133.1461 +| E_App2 [intro]: "\<lbrakk> val v; t \<longmapsto> t' \<rbrakk> \<Longrightarrow> v \<cdot> t \<longmapsto> v \<cdot> t'"
133.1462 +| E_TAbs : "X \<sharp> (T\<^isub>1\<^isub>1, T\<^isub>2) \<Longrightarrow> (\<lambda>X<:T\<^isub>1\<^isub>1. t\<^isub>1\<^isub>2) \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t\<^isub>1\<^isub>2[X \<mapsto>\<^sub>\<tau> T\<^isub>2]"
133.1463 +| E_TApp [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot>\<^sub>\<tau> T \<longmapsto> t' \<cdot>\<^sub>\<tau> T"
133.1464 +
133.1465 +lemma better_E_Abs[intro]:
133.1466 + assumes H: "val v2"
133.1467 + shows "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> t12[x \<mapsto> v2]"
133.1468 +proof -
133.1469 + obtain y::vrs where y: "y \<sharp> (x, t12, v2)" by (rule exists_fresh) (rule fin_supp)
133.1470 + then have "y \<sharp> v2" by simp
133.1471 + then have "(\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]" using H
133.1472 + by (rule E_Abs)
133.1473 + moreover from y have "(\<lambda>x:T11. t12) \<cdot> v2 = (\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2"
133.1474 + by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
133.1475 + ultimately have "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]"
133.1476 + by simp
133.1477 + with y show ?thesis by (simp add: subst_trm_rename)
133.1478 +qed
133.1479 +
133.1480 +lemma better_E_TAbs[intro]: "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> t12[X \<mapsto>\<^sub>\<tau> T2]"
133.1481 +proof -
133.1482 + obtain Y::tyvrs where Y: "Y \<sharp> (X, t12, T11, T2)" by (rule exists_fresh) (rule fin_supp)
133.1483 + then have "Y \<sharp> (T11, T2)" by simp
133.1484 + then have "(\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
133.1485 + by (rule E_TAbs)
133.1486 + moreover from Y have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 = (\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2"
133.1487 + by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
133.1488 + ultimately have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
133.1489 + by simp
133.1490 + with Y show ?thesis by (simp add: subst_trm_ty_rename)
133.1491 +qed
133.1492 +
133.1493 +equivariance eval
133.1494 +
133.1495 +nominal_inductive eval
133.1496 + by (simp_all add: abs_fresh ty_vrs_fresh subst_trm_fresh_tyvar
133.1497 + subst_trm_fresh_var subst_trm_ty_fresh')
133.1498 +
133.1499 +inductive_cases eval_inv_auto[elim]:
133.1500 + "Var x \<longmapsto> t'"
133.1501 + "(\<lambda>x:T. t) \<longmapsto> t'"
133.1502 + "(\<lambda>X<:T. t) \<longmapsto> t'"
133.1503 +
133.1504 +lemma ty_domain_cons:
133.1505 + shows "ty_domain (\<Gamma>@[VarB X Q]@\<Delta>) = ty_domain (\<Gamma>@\<Delta>)"
133.1506 +by (induct \<Gamma>, auto)
133.1507 +
133.1508 +lemma closed_in_cons:
133.1509 + assumes "S closed_in (\<Gamma> @ VarB X Q # \<Delta>)"
133.1510 + shows "S closed_in (\<Gamma>@\<Delta>)"
133.1511 +using assms ty_domain_cons closed_in_def by auto
133.1512 +
133.1513 +lemma closed_in_weaken: "T closed_in (\<Delta> @ \<Gamma>) \<Longrightarrow> T closed_in (\<Delta> @ B # \<Gamma>)"
133.1514 + by (auto simp add: closed_in_def domains_append)
133.1515 +
133.1516 +lemma closed_in_weaken': "T closed_in \<Gamma> \<Longrightarrow> T closed_in (\<Delta> @ \<Gamma>)"
133.1517 + by (auto simp add: closed_in_def domains_append)
133.1518 +
133.1519 +lemma valid_subst:
133.1520 + assumes ok: "\<turnstile> (\<Delta> @ TVarB X Q # \<Gamma>) ok"
133.1521 + and closed: "P closed_in \<Gamma>"
133.1522 + shows "\<turnstile> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using ok closed
133.1523 + apply (induct \<Delta>)
133.1524 + apply simp_all
133.1525 + apply (erule validE)
133.1526 + apply assumption
133.1527 + apply (erule validE)
133.1528 + apply simp
133.1529 + apply (rule valid_consT)
133.1530 + apply assumption
133.1531 + apply (simp add: domains_append ty_domain_subst)
133.1532 + apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)
133.1533 + apply (rule_tac S=Q in subst_closed_in')
133.1534 + apply (simp add: closed_in_def domains_append ty_domain_subst)
133.1535 + apply (simp add: closed_in_def domains_append)
133.1536 + apply blast
133.1537 + apply simp
133.1538 + apply (rule valid_cons)
133.1539 + apply assumption
133.1540 + apply (simp add: domains_append trm_domain_subst)
133.1541 + apply (rule_tac S=Q in subst_closed_in')
133.1542 + apply (simp add: closed_in_def domains_append ty_domain_subst)
133.1543 + apply (simp add: closed_in_def domains_append)
133.1544 + apply blast
133.1545 + done
133.1546 +
133.1547 +lemma ty_domain_vrs:
133.1548 + shows "ty_domain (G @ [VarB x Q] @ D) = ty_domain (G @ D)"
133.1549 +by (induct G, auto)
133.1550 +
133.1551 +lemma valid_cons':
133.1552 + assumes "\<turnstile> (\<Gamma> @ VarB x Q # \<Delta>) ok"
133.1553 + shows "\<turnstile> (\<Gamma> @ \<Delta>) ok"
133.1554 + using assms
133.1555 +proof (induct \<Gamma>' \<equiv> "\<Gamma> @ VarB x Q # \<Delta>" arbitrary: \<Gamma> \<Delta>)
133.1556 + case valid_nil
133.1557 + have "[] = \<Gamma> @ VarB x Q # \<Delta>" by fact
133.1558 + then have "False" by auto
133.1559 + then show ?case by auto
133.1560 +next
133.1561 + case (valid_consT G X T)
133.1562 + then show ?case
133.1563 + proof (cases \<Gamma>)
133.1564 + case Nil
133.1565 + with valid_consT show ?thesis by simp
133.1566 + next
133.1567 + case (Cons b bs)
133.1568 + with valid_consT
133.1569 + have "\<turnstile> (bs @ \<Delta>) ok" by simp
133.1570 + moreover from Cons and valid_consT have "X \<sharp> ty_domain (bs @ \<Delta>)"
133.1571 + by (simp add: domains_append)
133.1572 + moreover from Cons and valid_consT have "T closed_in (bs @ \<Delta>)"
133.1573 + by (simp add: closed_in_def domains_append)
133.1574 + ultimately have "\<turnstile> (TVarB X T # bs @ \<Delta>) ok"
133.1575 + by (rule valid_rel.valid_consT)
133.1576 + with Cons and valid_consT show ?thesis by simp
133.1577 + qed
133.1578 +next
133.1579 + case (valid_cons G x T)
133.1580 + then show ?case
133.1581 + proof (cases \<Gamma>)
133.1582 + case Nil
133.1583 + with valid_cons show ?thesis by simp
133.1584 + next
133.1585 + case (Cons b bs)
133.1586 + with valid_cons
133.1587 + have "\<turnstile> (bs @ \<Delta>) ok" by simp
133.1588 + moreover from Cons and valid_cons have "x \<sharp> trm_domain (bs @ \<Delta>)"
133.1589 + by (simp add: domains_append finite_domains
133.1590 + fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst])
133.1591 + moreover from Cons and valid_cons have "T closed_in (bs @ \<Delta>)"
133.1592 + by (simp add: closed_in_def domains_append)
133.1593 + ultimately have "\<turnstile> (VarB x T # bs @ \<Delta>) ok"
133.1594 + by (rule valid_rel.valid_cons)
133.1595 + with Cons and valid_cons show ?thesis by simp
133.1596 + qed
133.1597 +qed
133.1598 +
133.1599 +text {* A.5(6) *}
133.1600 +
133.1601 +lemma type_weaken:
133.1602 + assumes "(\<Delta>@\<Gamma>) \<turnstile> t : T"
133.1603 + and "\<turnstile> (\<Delta> @ B # \<Gamma>) ok"
133.1604 + shows "(\<Delta> @ B # \<Gamma>) \<turnstile> t : T"
133.1605 +using assms
133.1606 +proof(nominal_induct \<Gamma>'\<equiv> "\<Delta> @ \<Gamma>" t T avoiding: \<Delta> \<Gamma> B rule: typing.strong_induct)
133.1607 + case (T_Var x' T \<Gamma>' \<Gamma>'' \<Delta>')
133.1608 + then show ?case by auto
133.1609 +next
133.1610 + case (T_App \<Gamma> t\<^isub>1 T\<^isub>1 T\<^isub>2 t\<^isub>2 \<Gamma> \<Delta>)
133.1611 + then show ?case by force
133.1612 +next
133.1613 + case (T_Abs y T\<^isub>1 \<Gamma>' t\<^isub>2 T\<^isub>2 \<Delta> \<Gamma>)
133.1614 + then have "VarB y T\<^isub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1615 + then have closed: "T\<^isub>1 closed_in (\<Delta> @ \<Gamma>)"
133.1616 + by (auto dest: typing_ok)
133.1617 + have "\<turnstile> (VarB y T\<^isub>1 # \<Delta> @ B # \<Gamma>) ok"
133.1618 + apply (rule valid_cons)
133.1619 + apply (rule T_Abs)
133.1620 + apply (simp add: domains_append
133.1621 + fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.1622 + fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
133.1623 + finite_domains finite_vrs fresh_vrs_of T_Abs fresh_trm_domain)
133.1624 + apply (rule closed_in_weaken)
133.1625 + apply (rule closed)
133.1626 + done
133.1627 + then have "\<turnstile> ((VarB y T\<^isub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
133.1628 + then have "(VarB y T\<^isub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2"
133.1629 + by (rule T_Abs) (simp add: T_Abs)
133.1630 + then have "VarB y T\<^isub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1631 + then show ?case by (rule typing.T_Abs)
133.1632 +next
133.1633 + case (T_Sub \<Gamma>' t S T \<Delta> \<Gamma>)
133.1634 + from `\<turnstile> (\<Delta> @ B # \<Gamma>) ok` and `\<Gamma>' = \<Delta> @ \<Gamma>`
133.1635 + have "\<Delta> @ B # \<Gamma> \<turnstile> t : S" by (rule T_Sub)
133.1636 + moreover from `\<Gamma>'\<turnstile>S<:T` and `\<turnstile> (\<Delta> @ B # \<Gamma>) ok`
133.1637 + have "(\<Delta> @ B # \<Gamma>)\<turnstile>S<:T"
133.1638 + by (rule weakening) (simp add: extends_def T_Sub)
133.1639 + ultimately show ?case by (rule typing.T_Sub)
133.1640 +next
133.1641 + case (T_TAbs X T\<^isub>1 \<Gamma>' t\<^isub>2 T\<^isub>2 \<Delta> \<Gamma>)
133.1642 + then have "TVarB X T\<^isub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1643 + then have closed: "T\<^isub>1 closed_in (\<Delta> @ \<Gamma>)"
133.1644 + by (auto dest: typing_ok)
133.1645 + have "\<turnstile> (TVarB X T\<^isub>1 # \<Delta> @ B # \<Gamma>) ok"
133.1646 + apply (rule valid_consT)
133.1647 + apply (rule T_TAbs)
133.1648 + apply (simp add: domains_append
133.1649 + fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
133.1650 + fresh_fin_union [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
133.1651 + finite_domains finite_vrs tyvrs_fresh T_TAbs fresh_domain)
133.1652 + apply (rule closed_in_weaken)
133.1653 + apply (rule closed)
133.1654 + done
133.1655 + then have "\<turnstile> ((TVarB X T\<^isub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
133.1656 + then have "(TVarB X T\<^isub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2"
133.1657 + by (rule T_TAbs) (simp add: T_TAbs)
133.1658 + then have "TVarB X T\<^isub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2" by simp
133.1659 + then show ?case by (rule typing.T_TAbs)
133.1660 +next
133.1661 + case (T_TApp X \<Gamma>' t\<^isub>1 T2 T11 T12 \<Delta> \<Gamma>)
133.1662 + have "\<Delta> @ B # \<Gamma> \<turnstile> t\<^isub>1 : (\<forall>X<:T11. T12)"
133.1663 + by (rule T_TApp)+
133.1664 + moreover from `\<Gamma>'\<turnstile>T2<:T11` and `\<turnstile> (\<Delta> @ B # \<Gamma>) ok`
133.1665 + have "(\<Delta> @ B # \<Gamma>)\<turnstile>T2<:T11"
133.1666 + by (rule weakening) (simp add: extends_def T_TApp)
133.1667 + ultimately show ?case by (rule better_T_TApp)
133.1668 +qed
133.1669 +
133.1670 +lemma type_weaken':
133.1671 + "\<Gamma> \<turnstile> t : T \<Longrightarrow> \<turnstile> (\<Delta>@\<Gamma>) ok \<Longrightarrow> (\<Delta>@\<Gamma>) \<turnstile> t : T"
133.1672 + apply (induct \<Delta>)
133.1673 + apply simp_all
133.1674 + apply (erule validE)
133.1675 + apply (insert type_weaken [of "[]", simplified])
133.1676 + apply simp_all
133.1677 + done
133.1678 +
133.1679 +text {* A.6 *}
133.1680 +
133.1681 +lemma strengthening:
133.1682 + assumes "(\<Gamma> @ VarB x Q # \<Delta>) \<turnstile> S <: T"
133.1683 + shows "(\<Gamma>@\<Delta>) \<turnstile> S <: T"
133.1684 + using assms
133.1685 +proof (induct \<Gamma>' \<equiv> "\<Gamma> @ VarB x Q # \<Delta>" S T arbitrary: \<Gamma>)
133.1686 + case (SA_Top G' S G)
133.1687 + then have "\<turnstile> (G @ \<Delta>) ok" by (auto dest: valid_cons')
133.1688 + moreover have "S closed_in (G @ \<Delta>)" using SA_Top by (auto dest: closed_in_cons)
133.1689 + ultimately show ?case using subtype_of.SA_Top by auto
133.1690 +next
133.1691 + case (SA_refl_TVar G X' G')
133.1692 + then have "\<turnstile> (G' @ VarB x Q # \<Delta>) ok" by simp
133.1693 + then have h1:"\<turnstile> (G' @ \<Delta>) ok" by (auto dest: valid_cons')
133.1694 + have "X' \<in> ty_domain (G' @ VarB x Q # \<Delta>)" using SA_refl_TVar by auto
133.1695 + then have h2:"X' \<in> ty_domain (G' @ \<Delta>)" using ty_domain_vrs by auto
133.1696 + show ?case using h1 h2 by auto
133.1697 +next
133.1698 + case (SA_all G T1 S1 X S2 T2 G')
133.1699 + have ih1:"TVarB X T1 # G = (TVarB X T1 # G') @ VarB x Q # \<Delta> \<Longrightarrow> ((TVarB X T1 # G') @ \<Delta>)\<turnstile>S2<:T2" by fact
133.1700 + then have h1:"(TVarB X T1 # (G' @ \<Delta>))\<turnstile>S2<:T2" using SA_all by auto
133.1701 + have ih2:"G = G' @ VarB x Q # \<Delta> \<Longrightarrow> (G' @ \<Delta>)\<turnstile>T1<:S1" by fact
133.1702 + then have h2:"(G' @ \<Delta>)\<turnstile>T1<:S1" using SA_all by auto
133.1703 + then show ?case using h1 h2 by auto
133.1704 +qed (auto)
133.1705 +
133.1706 +lemma narrow_type: -- {* A.7 *}
133.1707 + assumes H: "\<Delta> @ (TVarB X Q) # \<Gamma> \<turnstile> t : T"
133.1708 + shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> \<Delta> @ (TVarB X P) # \<Gamma> \<turnstile> t : T"
133.1709 + using H
133.1710 + proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ (TVarB X Q) # \<Gamma>" t T avoiding: P arbitrary: \<Delta> rule: typing.strong_induct)
133.1711 + case (T_Var x T G P D)
133.1712 + then have "VarB x T \<in> set (D @ TVarB X P # \<Gamma>)"
133.1713 + and "\<turnstile> (D @ TVarB X P # \<Gamma>) ok"
133.1714 + by (auto intro: replace_type dest!: subtype_implies_closed)
133.1715 + then show ?case by auto
133.1716 + next
133.1717 + case (T_App G t1 T1 T2 t2 P D)
133.1718 + then show ?case by force
133.1719 + next
133.1720 + case (T_Abs x T1 G t2 T2 P D)
133.1721 + then show ?case by (fastsimp dest: typing_ok)
133.1722 + next
133.1723 + case (T_Sub G t S T D)
133.1724 + then show ?case using subtype_narrow by fastsimp
133.1725 + next
133.1726 + case (T_TAbs X' T1 G t2 T2 P D)
133.1727 + then show ?case by (fastsimp dest: typing_ok)
133.1728 + next
133.1729 + case (T_TApp X' G t1 T2 T11 T12 P D)
133.1730 + then have "D @ TVarB X P # \<Gamma> \<turnstile> t1 : Forall X' T12 T11" by fastsimp
133.1731 + moreover have "(D @ [TVarB X Q] @ \<Gamma>) \<turnstile> T2<:T11" using T_TApp by auto
133.1732 + then have "(D @ [TVarB X P] @ \<Gamma>) \<turnstile> T2<:T11" using `\<Gamma>\<turnstile>P<:Q`
133.1733 + by (rule subtype_narrow)
133.1734 + moreover from T_TApp have "X' \<sharp> (D @ TVarB X P # \<Gamma>, t1, T2)"
133.1735 + by (simp add: fresh_list_append fresh_list_cons fresh_prod)
133.1736 + ultimately show ?case by auto
133.1737 +qed
133.1738 +
133.1739 +subsection {* Substitution lemmas *}
133.1740 +
133.1741 +subsubsection {* Substition Preserves Typing *}
133.1742 +
133.1743 +theorem subst_type: -- {* A.8 *}
133.1744 + assumes H: "(\<Delta> @ (VarB x U) # \<Gamma>) \<turnstile> t : T"
133.1745 + shows "\<Gamma> \<turnstile> u : U \<Longrightarrow> \<Delta> @ \<Gamma> \<turnstile> t[x \<mapsto> u] : T" using H
133.1746 + proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ (VarB x U) # \<Gamma>" t T avoiding: x u arbitrary: \<Delta> rule: typing.strong_induct)
133.1747 + case (T_Var y T G x u D)
133.1748 + show ?case
133.1749 + proof (cases "x = y")
133.1750 + assume eq:"x=y"
133.1751 + then have "T=U" using T_Var uniqueness_of_ctxt' by auto
133.1752 + then show ?case using eq T_Var
133.1753 + by (auto intro: type_weaken' dest: valid_cons')
133.1754 + next
133.1755 + assume "x\<noteq>y"
133.1756 + then show ?case using T_Var
133.1757 + by (auto simp add:binding.inject dest: valid_cons')
133.1758 + qed
133.1759 + next
133.1760 + case (T_App G t1 T1 T2 t2 x u D)
133.1761 + then show ?case by force
133.1762 + next
133.1763 + case (T_Abs y T1 G t2 T2 x u D)
133.1764 + then show ?case by force
133.1765 + next
133.1766 + case (T_Sub G t S T x u D)
133.1767 + then have "D @ \<Gamma> \<turnstile> t[x \<mapsto> u] : S" by auto
133.1768 + moreover have "(D @ \<Gamma>) \<turnstile> S<:T" using T_Sub by (auto dest: strengthening)
133.1769 + ultimately show ?case by auto
133.1770 + next
133.1771 + case (T_TAbs X T1 G t2 T2 x u D)
133.1772 + from `TVarB X T1 # G \<turnstile> t2 : T2` have "X \<sharp> T1"
133.1773 + by (auto simp add: valid_ty_domain_fresh dest: typing_ok intro!: closed_in_fresh)
133.1774 + with `X \<sharp> u` and T_TAbs show ?case by fastsimp
133.1775 + next
133.1776 + case (T_TApp X G t1 T2 T11 T12 x u D)
133.1777 + then have "(D@\<Gamma>) \<turnstile>T2<:T11" using T_TApp by (auto dest: strengthening)
133.1778 + then show "((D @ \<Gamma>) \<turnstile> ((t1 \<cdot>\<^sub>\<tau> T2)[x \<mapsto> u]) : (T12[X \<mapsto> T2]\<^sub>\<tau>))" using T_TApp
133.1779 + by (force simp add: fresh_prod fresh_list_append fresh_list_cons subst_trm_fresh_tyvar)
133.1780 +qed
133.1781 +
133.1782 +subsubsection {* Type Substitution Preserves Subtyping *}
133.1783 +
133.1784 +lemma substT_subtype: -- {* A.10 *}
133.1785 + assumes H: "(\<Delta> @ ((TVarB X Q) # \<Gamma>)) \<turnstile> S <: T"
133.1786 + shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>"
133.1787 + using H
133.1788 +proof (nominal_induct \<Gamma>' \<equiv> "\<Delta> @ TVarB X Q # \<Gamma>" S T avoiding: X P arbitrary: \<Delta> rule: subtype_of.strong_induct)
133.1789 + case (SA_Top G S X P D)
133.1790 + then have "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by simp
133.1791 + moreover have closed: "P closed_in \<Gamma>" using SA_Top subtype_implies_closed by auto
133.1792 + ultimately have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule valid_subst)
133.1793 + moreover from SA_Top have "S closed_in (D @ TVarB X Q # \<Gamma>)" by simp
133.1794 + then have "S[X \<mapsto> P]\<^sub>\<tau> closed_in (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" using closed by (rule subst_closed_in)
133.1795 + ultimately show ?case by auto
133.1796 +next
133.1797 + case (SA_trans_TVar Y S G T X P D)
133.1798 + have h:"G\<turnstile>S<:T" by fact
133.1799 + then have ST: "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>" using SA_trans_TVar by auto
133.1800 + from `G\<turnstile>S<:T` have G_ok: "\<turnstile> G ok" by (rule subtype_implies_ok)
133.1801 + from G_ok and SA_trans_TVar have X\<Gamma>_ok: "\<turnstile> (TVarB X Q # \<Gamma>) ok"
133.1802 + by (auto intro: validE_append)
133.1803 + show "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> Tvar Y[X \<mapsto> P]\<^sub>\<tau><:T[X \<mapsto> P]\<^sub>\<tau>"
133.1804 + proof (cases "X = Y")
133.1805 + assume eq: "X = Y"
133.1806 + from eq and SA_trans_TVar have "TVarB Y Q \<in> set G" by simp
133.1807 + with G_ok have QS: "Q = S" using `TVarB Y S \<in> set G` by (rule uniqueness_of_ctxt)
133.1808 + from X\<Gamma>_ok have "X \<sharp> ty_domain \<Gamma>" and "Q closed_in \<Gamma>" by auto
133.1809 + then have XQ: "X \<sharp> Q" by (rule closed_in_fresh)
133.1810 + note `\<Gamma>\<turnstile>P<:Q`
133.1811 + moreover from ST have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule subtype_implies_ok)
133.1812 + moreover have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) extends \<Gamma>" by (simp add: extends_def)
133.1813 + ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:Q" by (rule weakening)
133.1814 + with QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:S" by simp
133.1815 + moreover from XQ and ST and QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1816 + by (simp add: type_subst_identity)
133.1817 + ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1818 + by (rule subtype_transitivity)
133.1819 + with eq show ?case by simp
133.1820 + next
133.1821 + assume neq: "X \<noteq> Y"
133.1822 + with SA_trans_TVar have "TVarB Y S \<in> set D \<or> TVarB Y S \<in> set \<Gamma>"
133.1823 + by (simp add: binding.inject)
133.1824 + then show ?case
133.1825 + proof
133.1826 + assume "TVarB Y S \<in> set D"
133.1827 + then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e)"
133.1828 + by (rule ctxt_subst_mem_TVarB)
133.1829 + then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
133.1830 + with neq and ST show ?thesis by auto
133.1831 + next
133.1832 + assume Y: "TVarB Y S \<in> set \<Gamma>"
133.1833 + from X\<Gamma>_ok have "X \<sharp> ty_domain \<Gamma>" and "\<turnstile> \<Gamma> ok" by auto
133.1834 + then have "X \<sharp> \<Gamma>" by (simp add: valid_ty_domain_fresh)
133.1835 + with Y have "X \<sharp> S"
133.1836 + by (induct \<Gamma>) (auto simp add: fresh_list_nil fresh_list_cons)
133.1837 + with ST have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S<:T[X \<mapsto> P]\<^sub>\<tau>"
133.1838 + by (simp add: type_subst_identity)
133.1839 + moreover from Y have "TVarB Y S \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
133.1840 + ultimately show ?thesis using neq by auto
133.1841 + qed
133.1842 + qed
133.1843 +next
133.1844 + case (SA_refl_TVar G Y X P D)
133.1845 + then have "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by simp
133.1846 + moreover from SA_refl_TVar have closed: "P closed_in \<Gamma>"
133.1847 + by (auto dest: subtype_implies_closed)
133.1848 + ultimately have ok: "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using valid_subst by auto
133.1849 + from closed have closed': "P closed_in (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
133.1850 + by (simp add: closed_in_weaken')
133.1851 + show ?case
133.1852 + proof (cases "X = Y")
133.1853 + assume "X = Y"
133.1854 + with closed' and ok show ?thesis
133.1855 + by (auto intro: subtype_reflexivity)
133.1856 + next
133.1857 + assume neq: "X \<noteq> Y"
133.1858 + with SA_refl_TVar have "Y \<in> ty_domain (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
133.1859 + by (simp add: ty_domain_subst domains_append)
133.1860 + with neq and ok show ?thesis by auto
133.1861 + qed
133.1862 +next
133.1863 + case (SA_arrow G T1 S1 S2 T2 X P D)
133.1864 + then have h1:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>T1[X \<mapsto> P]\<^sub>\<tau><:S1[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
133.1865 + from SA_arrow have h2:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S2[X \<mapsto> P]\<^sub>\<tau><:T2[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
133.1866 + show ?case using subtype_of.SA_arrow h1 h2 by auto
133.1867 +next
133.1868 + case (SA_all G T1 S1 Y S2 T2 X P D)
133.1869 + then have Y: "Y \<sharp> ty_domain (D @ TVarB X Q # \<Gamma>)"
133.1870 + by (auto dest: subtype_implies_ok intro: fresh_domain)
133.1871 + moreover from SA_all have "S1 closed_in (D @ TVarB X Q # \<Gamma>)"
133.1872 + by (auto dest: subtype_implies_closed)
133.1873 + ultimately have S1: "Y \<sharp> S1" by (rule closed_in_fresh)
133.1874 + from SA_all have "T1 closed_in (D @ TVarB X Q # \<Gamma>)"
133.1875 + by (auto dest: subtype_implies_closed)
133.1876 + with Y have T1: "Y \<sharp> T1" by (rule closed_in_fresh)
133.1877 + with SA_all and S1 show ?case by force
133.1878 +qed
133.1879 +
133.1880 +subsubsection {* Type Substitution Preserves Typing *}
133.1881 +
133.1882 +theorem substT_type: -- {* A.11 *}
133.1883 + assumes H: "(D @ TVarB X Q # G) \<turnstile> t : T"
133.1884 + shows "G \<turnstile> P <: Q \<Longrightarrow>
133.1885 + (D[X \<mapsto> P]\<^sub>e @ G) \<turnstile> t[X \<mapsto>\<^sub>\<tau> P] : T[X \<mapsto> P]\<^sub>\<tau>" using H
133.1886 +proof (nominal_induct \<Gamma>'\<equiv>"(D @ TVarB X Q # G)" t T avoiding: X P arbitrary: D rule: typing.strong_induct)
133.1887 + case (T_Var x T G' X P D')
133.1888 + have "G\<turnstile>P<:Q" by fact
133.1889 + then have "P closed_in G" using subtype_implies_closed by auto
133.1890 + moreover have "\<turnstile> (D' @ TVarB X Q # G) ok" using T_Var by auto
133.1891 + ultimately have "\<turnstile> (D'[X \<mapsto> P]\<^sub>e @ G) ok" using valid_subst by auto
133.1892 + moreover have "VarB x T \<in> set (D' @ TVarB X Q # G)" using T_Var by auto
133.1893 + then have "VarB x T \<in> set D' \<or> VarB x T \<in> set G" by simp
133.1894 + then have "(VarB x (T[X \<mapsto> P]\<^sub>\<tau>)) \<in> set (D'[X \<mapsto> P]\<^sub>e @ G)"
133.1895 + proof
133.1896 + assume "VarB x T \<in> set D'"
133.1897 + then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D'[X \<mapsto> P]\<^sub>e)"
133.1898 + by (rule ctxt_subst_mem_VarB)
133.1899 + then show ?thesis by simp
133.1900 + next
133.1901 + assume x: "VarB x T \<in> set G"
133.1902 + from T_Var have ok: "\<turnstile> G ok" by (auto dest: subtype_implies_ok)
133.1903 + then have "X \<sharp> ty_domain G" using T_Var by (auto dest: validE_append)
133.1904 + with ok have "X \<sharp> G" by (simp add: valid_ty_domain_fresh)
133.1905 + moreover from x have "VarB x T \<in> set (D' @ G)" by simp
133.1906 + then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set ((D' @ G)[X \<mapsto> P]\<^sub>e)"
133.1907 + by (rule ctxt_subst_mem_VarB)
133.1908 + ultimately show ?thesis
133.1909 + by (simp add: ctxt_subst_append ctxt_subst_identity)
133.1910 + qed
133.1911 + ultimately show ?case by auto
133.1912 +next
133.1913 + case (T_App G' t1 T1 T2 t2 X P D')
133.1914 + then have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (T1 \<rightarrow> T2)[X \<mapsto> P]\<^sub>\<tau>" by auto
133.1915 + moreover from T_App have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t2[X \<mapsto>\<^sub>\<tau> P] : T1[X \<mapsto> P]\<^sub>\<tau>" by auto
133.1916 + ultimately show ?case by auto
133.1917 +next
133.1918 + case (T_Abs x T1 G' t2 T2 X P D')
133.1919 + then show ?case by force
133.1920 +next
133.1921 + case (T_Sub G' t S T X P D')
133.1922 + then show ?case using substT_subtype by force
133.1923 +next
133.1924 + case (T_TAbs X' G' T1 t2 T2 X P D')
133.1925 + then have "X' \<sharp> ty_domain (D' @ TVarB X Q # G)"
133.1926 + and "G' closed_in (D' @ TVarB X Q # G)"
133.1927 + by (auto dest: typing_ok)
133.1928 + then have "X' \<sharp> G'" by (rule closed_in_fresh)
133.1929 + with T_TAbs show ?case by force
133.1930 +next
133.1931 + case (T_TApp X' G' t1 T2 T11 T12 X P D')
133.1932 + then have "X' \<sharp> ty_domain (D' @ TVarB X Q # G)"
133.1933 + by (simp add: fresh_domain)
133.1934 + moreover from T_TApp have "T11 closed_in (D' @ TVarB X Q # G)"
133.1935 + by (auto dest: subtype_implies_closed)
133.1936 + ultimately have X': "X' \<sharp> T11" by (rule closed_in_fresh)
133.1937 + from T_TApp have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (\<forall>X'<:T11. T12)[X \<mapsto> P]\<^sub>\<tau>"
133.1938 + by simp
133.1939 + with X' and T_TApp show ?case
133.1940 + by (auto simp add: fresh_atm type_substitution_lemma
133.1941 + fresh_list_append fresh_list_cons
133.1942 + ctxt_subst_fresh' type_subst_fresh subst_trm_ty_fresh
133.1943 + intro: substT_subtype)
133.1944 +qed
133.1945 +
133.1946 +lemma Abs_type: -- {* A.13(1) *}
133.1947 + assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : T"
133.1948 + and H': "\<Gamma> \<turnstile> T <: U \<rightarrow> U'"
133.1949 + and H'': "x \<sharp> \<Gamma>"
133.1950 + obtains S' where "\<Gamma> \<turnstile> U <: S"
133.1951 + and "(VarB x S) # \<Gamma> \<turnstile> s : S'"
133.1952 + and "\<Gamma> \<turnstile> S' <: U'"
133.1953 + using H H' H''
133.1954 +proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>x:S. s" T avoiding: x arbitrary: U U' S s rule: typing.strong_induct)
133.1955 + case (T_Abs y T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1956 + from `\<Gamma> \<turnstile> T\<^isub>1 \<rightarrow> T\<^isub>2 <: U \<rightarrow> U'`
133.1957 + obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "\<Gamma> \<turnstile> T\<^isub>2 <: U'" using T_Abs
133.1958 + by cases (simp_all add: ty.inject trm.inject alpha fresh_atm)
133.1959 + from T_Abs have "VarB y S # \<Gamma> \<turnstile> [(y, x)] \<bullet> s : T\<^isub>2"
133.1960 + by (simp add: trm.inject alpha fresh_atm)
133.1961 + then have "[(y, x)] \<bullet> (VarB y S # \<Gamma>) \<turnstile> [(y, x)] \<bullet> [(y, x)] \<bullet> s : [(y, x)] \<bullet> T\<^isub>2"
133.1962 + by (rule typing.eqvt)
133.1963 + moreover from T_Abs have "y \<sharp> \<Gamma>"
133.1964 + by (auto dest!: typing_ok simp add: fresh_trm_domain)
133.1965 + ultimately have "VarB x S # \<Gamma> \<turnstile> s : T\<^isub>2" using T_Abs
133.1966 + by (perm_simp add: ty_vrs_prm_simp)
133.1967 + with ty1 show ?case using ty2 by (rule T_Abs)
133.1968 +next
133.1969 + case (T_Sub \<Gamma> t S T)
133.1970 + then show ?case using subtype_transitivity by blast
133.1971 +qed simp_all
133.1972 +
133.1973 +lemma subtype_reflexivity_from_typing:
133.1974 + assumes "\<Gamma> \<turnstile> t : T"
133.1975 + shows "\<Gamma> \<turnstile> T <: T"
133.1976 +using assms subtype_reflexivity typing_ok typing_closed_in by simp
133.1977 +
133.1978 +lemma Abs_type':
133.1979 + assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : U \<rightarrow> U'"
133.1980 + and H': "x \<sharp> \<Gamma>"
133.1981 + obtains S'
133.1982 + where "\<Gamma> \<turnstile> U <: S"
133.1983 + and "(VarB x S) # \<Gamma> \<turnstile> s : S'"
133.1984 + and "\<Gamma> \<turnstile> S' <: U'"
133.1985 + using H subtype_reflexivity_from_typing [OF H] H'
133.1986 + by (rule Abs_type)
133.1987 +
133.1988 +lemma TAbs_type: -- {* A.13(2) *}
133.1989 + assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : T"
133.1990 + and H': "\<Gamma> \<turnstile> T <: (\<forall>X<:U. U')"
133.1991 + and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
133.1992 + obtains S'
133.1993 + where "\<Gamma> \<turnstile> U <: S"
133.1994 + and "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
133.1995 + and "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
133.1996 + using H H' fresh
133.1997 +proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>X<:S. s" T avoiding: X U U' S arbitrary: s rule: typing.strong_induct)
133.1998 + case (T_TAbs Y T\<^isub>1 \<Gamma> t\<^isub>2 T\<^isub>2)
133.1999 + from `TVarB Y T\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>2` have Y: "Y \<sharp> \<Gamma>"
133.2000 + by (auto dest!: typing_ok simp add: valid_ty_domain_fresh)
133.2001 + from `Y \<sharp> U'` and `Y \<sharp> X`
133.2002 + have "(\<forall>X<:U. U') = (\<forall>Y<:U. [(Y, X)] \<bullet> U')"
133.2003 + by (simp add: ty.inject alpha' fresh_atm)
133.2004 + with T_TAbs have "\<Gamma> \<turnstile> (\<forall>Y<:S. T\<^isub>2) <: (\<forall>Y<:U. [(Y, X)] \<bullet> U')" by (simp add: trm.inject)
133.2005 + then obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "(TVarB Y U # \<Gamma>) \<turnstile> T\<^isub>2 <: ([(Y, X)] \<bullet> U')" using T_TAbs Y
133.2006 + by (cases rule: subtype_of.strong_cases [where X=Y]) (simp_all add: ty.inject alpha abs_fresh)
133.2007 + note ty1
133.2008 + moreover from T_TAbs have "TVarB Y S # \<Gamma> \<turnstile> ([(Y, X)] \<bullet> s) : T\<^isub>2"
133.2009 + by (simp add: trm.inject alpha fresh_atm)
133.2010 + then have "[(Y, X)] \<bullet> (TVarB Y S # \<Gamma>) \<turnstile> [(Y, X)] \<bullet> [(Y, X)] \<bullet> s : [(Y, X)] \<bullet> T\<^isub>2"
133.2011 + by (rule typing.eqvt)
133.2012 + with `X \<sharp> \<Gamma>` `X \<sharp> S` Y `Y \<sharp> S` have "TVarB X S # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^isub>2"
133.2013 + by perm_simp
133.2014 + then have "TVarB X U # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^isub>2" using ty1
133.2015 + by (rule narrow_type [of "[]", simplified])
133.2016 + moreover from ty2 have "([(Y, X)] \<bullet> (TVarB Y U # \<Gamma>)) \<turnstile> ([(Y, X)] \<bullet> T\<^isub>2) <: ([(Y, X)] \<bullet> [(Y, X)] \<bullet> U')"
133.2017 + by (rule subtype_of.eqvt)
133.2018 + with `X \<sharp> \<Gamma>` `X \<sharp> U` Y `Y \<sharp> U` have "(TVarB X U # \<Gamma>) \<turnstile> ([(Y, X)] \<bullet> T\<^isub>2) <: U'"
133.2019 + by perm_simp
133.2020 + ultimately show ?case by (rule T_TAbs)
133.2021 +next
133.2022 + case (T_Sub \<Gamma> t S T)
133.2023 + then show ?case using subtype_transitivity by blast
133.2024 +qed simp_all
133.2025 +
133.2026 +lemma TAbs_type':
133.2027 + assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : (\<forall>X<:U. U')"
133.2028 + and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
133.2029 + obtains S'
133.2030 + where "\<Gamma> \<turnstile> U <: S"
133.2031 + and "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
133.2032 + and "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
133.2033 + using H subtype_reflexivity_from_typing [OF H] fresh
133.2034 + by (rule TAbs_type)
133.2035 +
133.2036 +theorem preservation: -- {* A.20 *}
133.2037 + assumes H: "\<Gamma> \<turnstile> t : T"
133.2038 + shows "t \<longmapsto> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : T" using H
133.2039 +proof (nominal_induct avoiding: t' rule: typing.strong_induct)
133.2040 + case (T_App \<Gamma> t\<^isub>1 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2 t\<^isub>2 t')
133.2041 + obtain x::vrs where x_fresh: "x \<sharp> (\<Gamma>, t\<^isub>1 \<cdot> t\<^isub>2, t')"
133.2042 + by (rule exists_fresh) (rule fin_supp)
133.2043 + obtain X::tyvrs where "X \<sharp> (t\<^isub>1 \<cdot> t\<^isub>2, t')"
133.2044 + by (rule exists_fresh) (rule fin_supp)
133.2045 + with `t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t'` show ?case
133.2046 + proof (cases rule: eval.strong_cases [where x=x and X=X])
133.2047 + case (E_Abs v\<^isub>2 T\<^isub>1\<^isub>1' t\<^isub>1\<^isub>2)
133.2048 + with T_App and x_fresh have h: "\<Gamma> \<turnstile> (\<lambda>x:T\<^isub>1\<^isub>1'. t\<^isub>1\<^isub>2) : T\<^isub>1\<^isub>1 \<rightarrow> T\<^isub>1\<^isub>2"
133.2049 + by (simp add: trm.inject fresh_prod)
133.2050 + moreover from x_fresh have "x \<sharp> \<Gamma>" by simp
133.2051 + ultimately obtain S'
133.2052 + where T\<^isub>1\<^isub>1: "\<Gamma> \<turnstile> T\<^isub>1\<^isub>1 <: T\<^isub>1\<^isub>1'"
133.2053 + and t\<^isub>1\<^isub>2: "(VarB x T\<^isub>1\<^isub>1') # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : S'"
133.2054 + and S': "\<Gamma> \<turnstile> S' <: T\<^isub>1\<^isub>2"
133.2055 + by (rule Abs_type') blast
133.2056 + from `\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1`
133.2057 + have "\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1'" using T\<^isub>1\<^isub>1 by (rule T_Sub)
133.2058 + with t\<^isub>1\<^isub>2 have "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[x \<mapsto> t\<^isub>2] : S'"
133.2059 + by (rule subst_type [where \<Delta>="[]", simplified])
133.2060 + hence "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[x \<mapsto> t\<^isub>2] : T\<^isub>1\<^isub>2" using S' by (rule T_Sub)
133.2061 + with E_Abs and x_fresh show ?thesis by (simp add: trm.inject fresh_prod)
133.2062 + next
133.2063 + case (E_App1 t''' t'' u)
133.2064 + hence "t\<^isub>1 \<longmapsto> t''" by (simp add:trm.inject)
133.2065 + hence "\<Gamma> \<turnstile> t'' : T\<^isub>1\<^isub>1 \<rightarrow> T\<^isub>1\<^isub>2" by (rule T_App)
133.2066 + hence "\<Gamma> \<turnstile> t'' \<cdot> t\<^isub>2 : T\<^isub>1\<^isub>2" using `\<Gamma> \<turnstile> t\<^isub>2 : T\<^isub>1\<^isub>1`
133.2067 + by (rule typing.T_App)
133.2068 + with E_App1 show ?thesis by (simp add:trm.inject)
133.2069 + next
133.2070 + case (E_App2 v t''' t'')
133.2071 + hence "t\<^isub>2 \<longmapsto> t''" by (simp add:trm.inject)
133.2072 + hence "\<Gamma> \<turnstile> t'' : T\<^isub>1\<^isub>1" by (rule T_App)
133.2073 + with T_App(1) have "\<Gamma> \<turnstile> t\<^isub>1 \<cdot> t'' : T\<^isub>1\<^isub>2"
133.2074 + by (rule typing.T_App)
133.2075 + with E_App2 show ?thesis by (simp add:trm.inject)
133.2076 + qed (simp_all add: fresh_prod)
133.2077 +next
133.2078 + case (T_TApp X \<Gamma> t\<^isub>1 T\<^isub>2 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2 t')
133.2079 + obtain x::vrs where "x \<sharp> (t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2, t')"
133.2080 + by (rule exists_fresh) (rule fin_supp)
133.2081 + with `t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t'`
133.2082 + show ?case
133.2083 + proof (cases rule: eval.strong_cases [where X=X and x=x])
133.2084 + case (E_TAbs T\<^isub>1\<^isub>1' T\<^isub>2' t\<^isub>1\<^isub>2)
133.2085 + with T_TApp have "\<Gamma> \<turnstile> (\<lambda>X<:T\<^isub>1\<^isub>1'. t\<^isub>1\<^isub>2) : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2)" and "X \<sharp> \<Gamma>" and "X \<sharp> T\<^isub>1\<^isub>1'"
133.2086 + by (simp_all add: trm.inject)
133.2087 + moreover from `\<Gamma>\<turnstile>T\<^isub>2<:T\<^isub>1\<^isub>1` and `X \<sharp> \<Gamma>` have "X \<sharp> T\<^isub>1\<^isub>1"
133.2088 + by (blast intro: closed_in_fresh fresh_domain dest: subtype_implies_closed)
133.2089 + ultimately obtain S'
133.2090 + where "TVarB X T\<^isub>1\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : S'"
133.2091 + and "(TVarB X T\<^isub>1\<^isub>1 # \<Gamma>) \<turnstile> S' <: T\<^isub>1\<^isub>2"
133.2092 + by (rule TAbs_type') blast
133.2093 + hence "TVarB X T\<^isub>1\<^isub>1 # \<Gamma> \<turnstile> t\<^isub>1\<^isub>2 : T\<^isub>1\<^isub>2" by (rule T_Sub)
133.2094 + hence "\<Gamma> \<turnstile> t\<^isub>1\<^isub>2[X \<mapsto>\<^sub>\<tau> T\<^isub>2] : T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>" using `\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1`
133.2095 + by (rule substT_type [where D="[]", simplified])
133.2096 + with T_TApp and E_TAbs show ?thesis by (simp add: trm.inject)
133.2097 + next
133.2098 + case (E_TApp t''' t'' T)
133.2099 + from E_TApp have "t\<^isub>1 \<longmapsto> t''" by (simp add: trm.inject)
133.2100 + then have "\<Gamma> \<turnstile> t'' : (\<forall>X<:T\<^isub>1\<^isub>1. T\<^isub>1\<^isub>2)" by (rule T_TApp)
133.2101 + then have "\<Gamma> \<turnstile> t'' \<cdot>\<^sub>\<tau> T\<^isub>2 : T\<^isub>1\<^isub>2[X \<mapsto> T\<^isub>2]\<^sub>\<tau>" using `\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>1\<^isub>1`
133.2102 + by (rule better_T_TApp)
133.2103 + with E_TApp show ?thesis by (simp add: trm.inject)
133.2104 + qed (simp_all add: fresh_prod)
133.2105 +next
133.2106 + case (T_Sub \<Gamma> t S T t')
133.2107 + have "t \<longmapsto> t'" by fact
133.2108 + hence "\<Gamma> \<turnstile> t' : S" by (rule T_Sub)
133.2109 + moreover have "\<Gamma> \<turnstile> S <: T" by fact
133.2110 + ultimately show ?case by (rule typing.T_Sub)
133.2111 +qed (auto)
133.2112 +
133.2113 +lemma Fun_canonical: -- {* A.14(1) *}
133.2114 + assumes ty: "[] \<turnstile> v : T\<^isub>1 \<rightarrow> T\<^isub>2"
133.2115 + shows "val v \<Longrightarrow> \<exists>x t S. v = (\<lambda>x:S. t)" using ty
133.2116 +proof (induct \<Gamma>\<equiv>"[]::env" v T\<equiv>"T\<^isub>1 \<rightarrow> T\<^isub>2" arbitrary: T\<^isub>1 T\<^isub>2)
133.2117 + case (T_Sub \<Gamma> t S T)
133.2118 + hence "\<Gamma> \<turnstile> S <: T\<^isub>1 \<rightarrow> T\<^isub>2" by simp
133.2119 + then obtain S\<^isub>1 S\<^isub>2 where S: "S = S\<^isub>1 \<rightarrow> S\<^isub>2"
133.2120 + by cases (auto simp add: T_Sub)
133.2121 + with `val t` and `\<Gamma> = []` show ?case by (rule T_Sub)
133.2122 +qed (auto)
133.2123 +
133.2124 +lemma TyAll_canonical: -- {* A.14(3) *}
133.2125 + fixes X::tyvrs
133.2126 + assumes ty: "[] \<turnstile> v : (\<forall>X<:T\<^isub>1. T\<^isub>2)"
133.2127 + shows "val v \<Longrightarrow> \<exists>X t S. v = (\<lambda>X<:S. t)" using ty
133.2128 +proof (induct \<Gamma>\<equiv>"[]::env" v T\<equiv>"\<forall>X<:T\<^isub>1. T\<^isub>2" arbitrary: X T\<^isub>1 T\<^isub>2)
133.2129 + case (T_Sub \<Gamma> t S T)
133.2130 + hence "\<Gamma> \<turnstile> S <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" by simp
133.2131 + then obtain X S\<^isub>1 S\<^isub>2 where S: "S = (\<forall>X<:S\<^isub>1. S\<^isub>2)"
133.2132 + by cases (auto simp add: T_Sub)
133.2133 + then show ?case using T_Sub by auto
133.2134 +qed (auto)
133.2135 +
133.2136 +theorem progress:
133.2137 + assumes "[] \<turnstile> t : T"
133.2138 + shows "val t \<or> (\<exists>t'. t \<longmapsto> t')"
133.2139 +using assms
133.2140 +proof (induct \<Gamma> \<equiv> "[]::env" t T)
133.2141 + case (T_App \<Gamma> t\<^isub>1 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2 t\<^isub>2)
133.2142 + hence "val t\<^isub>1 \<or> (\<exists>t'. t\<^isub>1 \<longmapsto> t')" by simp
133.2143 + thus ?case
133.2144 + proof
133.2145 + assume t\<^isub>1_val: "val t\<^isub>1"
133.2146 + with T_App obtain x t3 S where t\<^isub>1: "t\<^isub>1 = (\<lambda>x:S. t3)"
133.2147 + by (auto dest!: Fun_canonical)
133.2148 + from T_App have "val t\<^isub>2 \<or> (\<exists>t'. t\<^isub>2 \<longmapsto> t')" by simp
133.2149 + thus ?case
133.2150 + proof
133.2151 + assume "val t\<^isub>2"
133.2152 + with t\<^isub>1 have "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t3[x \<mapsto> t\<^isub>2]" by auto
133.2153 + thus ?case by auto
133.2154 + next
133.2155 + assume "\<exists>t'. t\<^isub>2 \<longmapsto> t'"
133.2156 + then obtain t' where "t\<^isub>2 \<longmapsto> t'" by auto
133.2157 + with t\<^isub>1_val have "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t\<^isub>1 \<cdot> t'" by auto
133.2158 + thus ?case by auto
133.2159 + qed
133.2160 + next
133.2161 + assume "\<exists>t'. t\<^isub>1 \<longmapsto> t'"
133.2162 + then obtain t' where "t\<^isub>1 \<longmapsto> t'" by auto
133.2163 + hence "t\<^isub>1 \<cdot> t\<^isub>2 \<longmapsto> t' \<cdot> t\<^isub>2" by auto
133.2164 + thus ?case by auto
133.2165 + qed
133.2166 +next
133.2167 + case (T_TApp X \<Gamma> t\<^isub>1 T\<^isub>2 T\<^isub>1\<^isub>1 T\<^isub>1\<^isub>2)
133.2168 + hence "val t\<^isub>1 \<or> (\<exists>t'. t\<^isub>1 \<longmapsto> t')" by simp
133.2169 + thus ?case
133.2170 + proof
133.2171 + assume "val t\<^isub>1"
133.2172 + with T_TApp obtain x t S where "t\<^isub>1 = (\<lambda>x<:S. t)"
133.2173 + by (auto dest!: TyAll_canonical)
133.2174 + hence "t\<^isub>1 \<cdot>\<^sub>\<tau> T\<^isub>2 \<longmapsto> t[x \<mapsto>\<^sub>\<tau> T\<^isub>2]" by auto
133.2175 + thus ?case by auto
133.2176 + next
133.2177 + assume "\<exists>t'. t\<^isub>1 \<longmapsto> t'" thus ?case by auto
133.2178 + qed
133.2179 +qed (auto)
133.2180 +
133.2181 +end
134.1 --- a/src/HOL/Nominal/Nominal.thy Wed Mar 04 10:43:39 2009 +0100
134.2 +++ b/src/HOL/Nominal/Nominal.thy Wed Mar 04 10:45:52 2009 +0100
134.3 @@ -397,6 +397,37 @@
134.4
134.5 lemmas fresh_star_prod = fresh_star_prod_list fresh_star_prod_set
134.6
134.7 +lemma fresh_star_set_eq: "set xs \<sharp>* c = xs \<sharp>* c"
134.8 + by (simp add: fresh_star_def)
134.9 +
134.10 +lemma fresh_star_Un_elim:
134.11 + "((S \<union> T) \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (S \<sharp>* c \<Longrightarrow> T \<sharp>* c \<Longrightarrow> PROP C)"
134.12 + apply rule
134.13 + apply (simp_all add: fresh_star_def)
134.14 + apply (erule meta_mp)
134.15 + apply blast
134.16 + done
134.17 +
134.18 +lemma fresh_star_insert_elim:
134.19 + "(insert x S \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (x \<sharp> c \<Longrightarrow> S \<sharp>* c \<Longrightarrow> PROP C)"
134.20 + by rule (simp_all add: fresh_star_def)
134.21 +
134.22 +lemma fresh_star_empty_elim:
134.23 + "({} \<sharp>* c \<Longrightarrow> PROP C) \<equiv> PROP C"
134.24 + by (simp add: fresh_star_def)
134.25 +
134.26 +text {* Normalization of freshness results; cf.\ @{text nominal_induct} *}
134.27 +
134.28 +lemma fresh_star_unit_elim:
134.29 + shows "((a::'a set)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
134.30 + and "((b::'a list)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
134.31 + by (simp_all add: fresh_star_def fresh_def supp_unit)
134.32 +
134.33 +lemma fresh_star_prod_elim:
134.34 + shows "((a::'a set)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>*x \<Longrightarrow> a\<sharp>*y \<Longrightarrow> PROP C)"
134.35 + and "((b::'a list)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (b\<sharp>*x \<Longrightarrow> b\<sharp>*y \<Longrightarrow> PROP C)"
134.36 + by (rule, simp_all add: fresh_star_prod)+
134.37 +
134.38 section {* Abstract Properties for Permutations and Atoms *}
134.39 (*=========================================================*)
134.40
134.41 @@ -1645,6 +1676,31 @@
134.42 apply(rule at)
134.43 done
134.44
134.45 +lemma pt_fresh_star_eqvt:
134.46 + fixes pi :: "'x prm"
134.47 + and x :: "'a"
134.48 + and a :: "'x set"
134.49 + and b :: "'x list"
134.50 + assumes pt: "pt TYPE('a) TYPE('x)"
134.51 + and at: "at TYPE('x)"
134.52 + shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
134.53 + and "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
134.54 + by (simp_all add: perm_bool pt_fresh_star_bij[OF pt, OF at])
134.55 +
134.56 +lemma pt_fresh_star_eqvt_ineq:
134.57 + fixes pi::"'x prm"
134.58 + and a::"'y set"
134.59 + and b::"'y list"
134.60 + and x::"'a"
134.61 + assumes pta: "pt TYPE('a) TYPE('x)"
134.62 + and ptb: "pt TYPE('y) TYPE('x)"
134.63 + and at: "at TYPE('x)"
134.64 + and cp: "cp TYPE('a) TYPE('x) TYPE('y)"
134.65 + and dj: "disjoint TYPE('y) TYPE('x)"
134.66 + shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
134.67 + and "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
134.68 + by (simp_all add: pt_fresh_star_bij_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
134.69 +
134.70 lemma pt_fresh_bij1:
134.71 fixes pi :: "'x prm"
134.72 and x :: "'a"
135.1 --- a/src/HOL/Nominal/nominal_atoms.ML Wed Mar 04 10:43:39 2009 +0100
135.2 +++ b/src/HOL/Nominal/nominal_atoms.ML Wed Mar 04 10:45:52 2009 +0100
135.3 @@ -1,5 +1,4 @@
135.4 (* title: HOL/Nominal/nominal_atoms.ML
135.5 - ID: $Id$
135.6 Author: Christian Urban and Stefan Berghofer, TU Muenchen
135.7
135.8 Declaration of atom types to be used in nominal datatypes.
135.9 @@ -784,6 +783,8 @@
135.10 val fresh_star_bij = @{thms "Nominal.pt_fresh_star_bij"};
135.11 val fresh_eqvt = @{thm "Nominal.pt_fresh_eqvt"};
135.12 val fresh_eqvt_ineq = @{thm "Nominal.pt_fresh_eqvt_ineq"};
135.13 + val fresh_star_eqvt = @{thms "Nominal.pt_fresh_star_eqvt"};
135.14 + val fresh_star_eqvt_ineq= @{thms "Nominal.pt_fresh_star_eqvt_ineq"};
135.15 val set_diff_eqvt = @{thm "Nominal.pt_set_diff_eqvt"};
135.16 val in_eqvt = @{thm "Nominal.pt_in_eqvt"};
135.17 val eq_eqvt = @{thm "Nominal.pt_eq_eqvt"};
135.18 @@ -947,13 +948,17 @@
135.19 in [(("fresh_bij", thms1 @ thms2),[])] end
135.20 ||>> add_thmss_string
135.21 let val thms1 = inst_pt_at fresh_star_bij
135.22 - and thms2 = flat (map (fn ti => inst_pt_pt_at_cp [ti]) fresh_star_bij_ineq);
135.23 + and thms2 = maps (fn ti => inst_pt_pt_at_cp [ti]) fresh_star_bij_ineq
135.24 in [(("fresh_star_bij", thms1 @ thms2),[])] end
135.25 ||>> add_thmss_string
135.26 let val thms1 = inst_pt_at [fresh_eqvt]
135.27 and thms2 = inst_pt_pt_at_cp_dj [fresh_eqvt_ineq]
135.28 in [(("fresh_eqvt", thms1 @ thms2),[NominalThmDecls.eqvt_add])] end
135.29 ||>> add_thmss_string
135.30 + let val thms1 = inst_pt_at fresh_star_eqvt
135.31 + and thms2 = maps (fn ti => inst_pt_pt_at_cp_dj [ti]) fresh_star_eqvt_ineq
135.32 + in [(("fresh_star_eqvt", thms1 @ thms2),[NominalThmDecls.eqvt_add])] end
135.33 + ||>> add_thmss_string
135.34 let val thms1 = inst_pt_at [in_eqvt]
135.35 in [(("in_eqvt", thms1),[NominalThmDecls.eqvt_add])] end
135.36 ||>> add_thmss_string
136.1 --- a/src/HOL/Nominal/nominal_induct.ML Wed Mar 04 10:43:39 2009 +0100
136.2 +++ b/src/HOL/Nominal/nominal_induct.ML Wed Mar 04 10:45:52 2009 +0100
136.3 @@ -1,5 +1,4 @@
136.4 -(* ID: $Id$
136.5 - Author: Christian Urban and Makarius
136.6 +(* Author: Christian Urban and Makarius
136.7
136.8 The nominal induct proof method.
136.9 *)
136.10 @@ -24,7 +23,8 @@
136.11
136.12 val split_all_tuples =
136.13 Simplifier.full_simplify (HOL_basic_ss addsimps
136.14 - [split_conv, split_paired_all, unit_all_eq1, thm "fresh_unit_elim", thm "fresh_prod_elim"]);
136.15 + [split_conv, split_paired_all, unit_all_eq1, @{thm fresh_unit_elim}, @{thm fresh_prod_elim}] @
136.16 + @{thms fresh_star_unit_elim} @ @{thms fresh_star_prod_elim});
136.17
136.18
136.19 (* prepare rule *)
137.1 --- a/src/HOL/Nominal/nominal_inductive.ML Wed Mar 04 10:43:39 2009 +0100
137.2 +++ b/src/HOL/Nominal/nominal_inductive.ML Wed Mar 04 10:45:52 2009 +0100
137.3 @@ -7,8 +7,8 @@
137.4
137.5 signature NOMINAL_INDUCTIVE =
137.6 sig
137.7 - val prove_strong_ind: string -> (string * string list) list -> theory -> Proof.state
137.8 - val prove_eqvt: string -> string list -> theory -> theory
137.9 + val prove_strong_ind: string -> (string * string list) list -> local_theory -> Proof.state
137.10 + val prove_eqvt: string -> string list -> local_theory -> local_theory
137.11 end
137.12
137.13 structure NominalInductive : NOMINAL_INDUCTIVE =
137.14 @@ -28,6 +28,8 @@
137.15 fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
137.16 (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
137.17
137.18 +fun preds_of ps t = gen_inter (op = o apfst dest_Free) (ps, Term.add_frees t []);
137.19 +
137.20 val fresh_prod = thm "fresh_prod";
137.21
137.22 val perm_bool = mk_meta_eq (thm "perm_bool");
137.23 @@ -142,9 +144,9 @@
137.24 fun first_order_mrs ths th = ths MRS
137.25 Thm.instantiate (first_order_matchs (cprems_of th) (map cprop_of ths)) th;
137.26
137.27 -fun prove_strong_ind s avoids thy =
137.28 +fun prove_strong_ind s avoids ctxt =
137.29 let
137.30 - val ctxt = ProofContext.init thy;
137.31 + val thy = ProofContext.theory_of ctxt;
137.32 val ({names, ...}, {raw_induct, intrs, elims, ...}) =
137.33 InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
137.34 val ind_params = InductivePackage.params_of raw_induct;
137.35 @@ -158,8 +160,7 @@
137.36 commas_quote xs));
137.37 val induct_cases = map fst (fst (RuleCases.get (the
137.38 (Induct.lookup_inductP ctxt (hd names)))));
137.39 - val raw_induct' = Logic.unvarify (prop_of raw_induct);
137.40 - val elims' = map (Logic.unvarify o prop_of) elims;
137.41 + val ([raw_induct'], ctxt') = Variable.import_terms false [prop_of raw_induct] ctxt;
137.42 val concls = raw_induct' |> Logic.strip_imp_concl |> HOLogic.dest_Trueprop |>
137.43 HOLogic.dest_conj |> map (HOLogic.dest_imp ##> strip_comb);
137.44 val ps = map (fst o snd) concls;
137.45 @@ -199,8 +200,8 @@
137.46 val ind_sort = if null atomTs then HOLogic.typeS
137.47 else Sign.certify_sort thy (map (fn T => Sign.intern_class thy
137.48 ("fs_" ^ Sign.base_name (fst (dest_Type T)))) atomTs);
137.49 - val fs_ctxt_tyname = Name.variant (map fst (OldTerm.term_tfrees raw_induct')) "'n";
137.50 - val fs_ctxt_name = Name.variant (OldTerm.add_term_names (raw_induct', [])) "z";
137.51 + val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
137.52 + val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
137.53 val fsT = TFree (fs_ctxt_tyname, ind_sort);
137.54
137.55 val inductive_forall_def' = Drule.instantiate'
137.56 @@ -237,7 +238,7 @@
137.57 val prem = Logic.list_implies
137.58 (map mk_fresh bvars @ mk_distinct bvars @
137.59 map (fn prem =>
137.60 - if null (OldTerm.term_frees prem inter ps) then prem
137.61 + if null (preds_of ps prem) then prem
137.62 else lift_prem prem) prems,
137.63 HOLogic.mk_Trueprop (lift_pred p ts));
137.64 val vs = map (Var o apfst (rpair 0)) (Term.rename_wrt_term prem params')
137.65 @@ -263,7 +264,7 @@
137.66 val vc_compat = map (fn (params, bvars, prems, (p, ts)) =>
137.67 map (fn q => list_all (params, incr_boundvars ~1 (Logic.list_implies
137.68 (List.mapPartial (fn prem =>
137.69 - if null (ps inter OldTerm.term_frees prem) then SOME prem
137.70 + if null (preds_of ps prem) then SOME prem
137.71 else map_term (split_conj (K o I) names) prem prem) prems, q))))
137.72 (mk_distinct bvars @
137.73 maps (fn (t, T) => map (fn (u, U) => HOLogic.mk_Trueprop
137.74 @@ -309,8 +310,8 @@
137.75 [ex] ctxt
137.76 in (freshs1 @ [term_of cx], freshs2 @ ths, ctxt') end;
137.77
137.78 - fun mk_ind_proof thy thss =
137.79 - Goal.prove_global thy [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
137.80 + fun mk_ind_proof ctxt' thss =
137.81 + Goal.prove ctxt' [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
137.82 let val th = Goal.prove ctxt [] [] concl (fn {context, ...} =>
137.83 rtac raw_induct 1 THEN
137.84 EVERY (maps (fn ((((_, bvars, oprems, _), vc_compat_ths), ihyp), (vs, ihypt)) =>
137.85 @@ -352,7 +353,7 @@
137.86 (rev pis' @ pis) th));
137.87 val (gprems1, gprems2) = split_list
137.88 (map (fn (th, t) =>
137.89 - if null (OldTerm.term_frees t inter ps) then (SOME th, mk_pi th)
137.90 + if null (preds_of ps t) then (SOME th, mk_pi th)
137.91 else
137.92 (map_thm ctxt (split_conj (K o I) names)
137.93 (etac conjunct1 1) monos NONE th,
137.94 @@ -403,42 +404,42 @@
137.95 REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
137.96 etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
137.97 asm_full_simp_tac (simpset_of thy) 1)
137.98 - end);
137.99 + end) |> singleton (ProofContext.export ctxt' ctxt);
137.100
137.101 (** strong case analysis rule **)
137.102
137.103 val cases_prems = map (fn ((name, avoids), rule) =>
137.104 let
137.105 - val prem :: prems = Logic.strip_imp_prems rule;
137.106 - val concl = Logic.strip_imp_concl rule;
137.107 - val used = Term.add_free_names rule [];
137.108 + val ([rule'], ctxt') = Variable.import_terms false [prop_of rule] ctxt;
137.109 + val prem :: prems = Logic.strip_imp_prems rule';
137.110 + val concl = Logic.strip_imp_concl rule'
137.111 in
137.112 (prem,
137.113 List.drop (snd (strip_comb (HOLogic.dest_Trueprop prem)), length ind_params),
137.114 concl,
137.115 - fst (fold_map (fn (prem, (_, avoid)) => fn used =>
137.116 + fold_map (fn (prem, (_, avoid)) => fn ctxt =>
137.117 let
137.118 val prems = Logic.strip_assums_hyp prem;
137.119 val params = Logic.strip_params prem;
137.120 val bnds = fold (add_binders thy 0) prems [] @ mk_avoids params avoid;
137.121 - fun mk_subst (p as (s, T)) (i, j, used, ps, qs, is, ts) =
137.122 + fun mk_subst (p as (s, T)) (i, j, ctxt, ps, qs, is, ts) =
137.123 if member (op = o apsnd fst) bnds (Bound i) then
137.124 let
137.125 - val s' = Name.variant used s;
137.126 + val ([s'], ctxt') = Variable.variant_fixes [s] ctxt;
137.127 val t = Free (s', T)
137.128 - in (i + 1, j, s' :: used, ps, (t, T) :: qs, i :: is, t :: ts) end
137.129 - else (i + 1, j + 1, used, p :: ps, qs, is, Bound j :: ts);
137.130 - val (_, _, used', ps, qs, is, ts) = fold_rev mk_subst params
137.131 - (0, 0, used, [], [], [], [])
137.132 + in (i + 1, j, ctxt', ps, (t, T) :: qs, i :: is, t :: ts) end
137.133 + else (i + 1, j + 1, ctxt, p :: ps, qs, is, Bound j :: ts);
137.134 + val (_, _, ctxt', ps, qs, is, ts) = fold_rev mk_subst params
137.135 + (0, 0, ctxt, [], [], [], [])
137.136 in
137.137 - ((ps, qs, is, map (curry subst_bounds (rev ts)) prems), used')
137.138 - end) (prems ~~ avoids) used))
137.139 + ((ps, qs, is, map (curry subst_bounds (rev ts)) prems), ctxt')
137.140 + end) (prems ~~ avoids) ctxt')
137.141 end)
137.142 (InductivePackage.partition_rules' raw_induct (intrs ~~ avoids') ~~
137.143 - elims');
137.144 + elims);
137.145
137.146 val cases_prems' =
137.147 - map (fn (prem, args, concl, prems) =>
137.148 + map (fn (prem, args, concl, (prems, _)) =>
137.149 let
137.150 fun mk_prem (ps, [], _, prems) =
137.151 list_all (ps, Logic.list_implies (prems, concl))
137.152 @@ -462,9 +463,9 @@
137.153 val simp_fresh_atm = map
137.154 (Simplifier.simplify (HOL_basic_ss addsimps fresh_atm));
137.155
137.156 - fun mk_cases_proof thy ((((name, thss), elim), (prem, args, concl, prems)),
137.157 + fun mk_cases_proof ((((name, thss), elim), (prem, args, concl, (prems, ctxt'))),
137.158 prems') =
137.159 - (name, Goal.prove_global thy [] (prem :: prems') concl
137.160 + (name, Goal.prove ctxt' [] (prem :: prems') concl
137.161 (fn {prems = hyp :: hyps, context = ctxt1} =>
137.162 EVERY (rtac (hyp RS elim) 1 ::
137.163 map (fn (((_, vc_compat_ths), case_hyp), (_, qs, is, _)) =>
137.164 @@ -537,52 +538,54 @@
137.165 end) ctxt4 1)
137.166 val final = ProofContext.export ctxt3 ctxt2 [th]
137.167 in resolve_tac final 1 end) ctxt1 1)
137.168 - (thss ~~ hyps ~~ prems))))
137.169 + (thss ~~ hyps ~~ prems))) |>
137.170 + singleton (ProofContext.export ctxt' ctxt))
137.171
137.172 in
137.173 - thy |>
137.174 - ProofContext.init |>
137.175 - Proof.theorem_i NONE (fn thss => ProofContext.theory (fn thy =>
137.176 + ctxt'' |>
137.177 + Proof.theorem_i NONE (fn thss => fn ctxt =>
137.178 let
137.179 - val ctxt = ProofContext.init thy;
137.180 val rec_name = space_implode "_" (map Sign.base_name names);
137.181 + val rec_qualified = Binding.qualify false rec_name;
137.182 val ind_case_names = RuleCases.case_names induct_cases;
137.183 val induct_cases' = InductivePackage.partition_rules' raw_induct
137.184 (intrs ~~ induct_cases);
137.185 val thss' = map (map atomize_intr) thss;
137.186 val thsss = InductivePackage.partition_rules' raw_induct (intrs ~~ thss');
137.187 val strong_raw_induct =
137.188 - mk_ind_proof thy thss' |> InductivePackage.rulify;
137.189 - val strong_cases = map (mk_cases_proof thy ##> InductivePackage.rulify)
137.190 + mk_ind_proof ctxt thss' |> InductivePackage.rulify;
137.191 + val strong_cases = map (mk_cases_proof ##> InductivePackage.rulify)
137.192 (thsss ~~ elims ~~ cases_prems ~~ cases_prems');
137.193 val strong_induct =
137.194 if length names > 1 then
137.195 (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
137.196 else (strong_raw_induct RSN (2, rev_mp),
137.197 [ind_case_names, RuleCases.consumes 1]);
137.198 - val ([strong_induct'], thy') = thy |>
137.199 - Sign.add_path rec_name |>
137.200 - PureThy.add_thms [((Binding.name "strong_induct", #1 strong_induct), #2 strong_induct)];
137.201 + val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
137.202 + ((rec_qualified (Binding.name "strong_induct"),
137.203 + map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
137.204 + ctxt;
137.205 val strong_inducts =
137.206 ProjectRule.projects ctxt (1 upto length names) strong_induct'
137.207 in
137.208 - thy' |>
137.209 - PureThy.add_thmss [((Binding.name "strong_inducts", strong_inducts),
137.210 - [ind_case_names, RuleCases.consumes 1])] |> snd |>
137.211 - Sign.parent_path |>
137.212 - fold (fn ((name, elim), (_, cases)) =>
137.213 - Sign.add_path (Sign.base_name name) #>
137.214 - PureThy.add_thms [((Binding.name "strong_cases", elim),
137.215 - [RuleCases.case_names (map snd cases),
137.216 - RuleCases.consumes 1])] #> snd #>
137.217 - Sign.parent_path) (strong_cases ~~ induct_cases')
137.218 - end))
137.219 + ctxt' |>
137.220 + LocalTheory.note Thm.theoremK
137.221 + ((rec_qualified (Binding.name "strong_inducts"),
137.222 + [Attrib.internal (K ind_case_names),
137.223 + Attrib.internal (K (RuleCases.consumes 1))]),
137.224 + strong_inducts) |> snd |>
137.225 + LocalTheory.notes Thm.theoremK (map (fn ((name, elim), (_, cases)) =>
137.226 + ((Binding.name (NameSpace.qualified (Sign.base_name name) "strong_cases"),
137.227 + [Attrib.internal (K (RuleCases.case_names (map snd cases))),
137.228 + Attrib.internal (K (RuleCases.consumes 1))]), [([elim], [])]))
137.229 + (strong_cases ~~ induct_cases')) |> snd
137.230 + end)
137.231 (map (map (rulify_term thy #> rpair [])) vc_compat)
137.232 end;
137.233
137.234 -fun prove_eqvt s xatoms thy =
137.235 +fun prove_eqvt s xatoms ctxt =
137.236 let
137.237 - val ctxt = ProofContext.init thy;
137.238 + val thy = ProofContext.theory_of ctxt;
137.239 val ({names, ...}, {raw_induct, intrs, elims, ...}) =
137.240 InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
137.241 val raw_induct = atomize_induct ctxt raw_induct;
137.242 @@ -594,6 +597,7 @@
137.243 (s, ths ~~ InductivePackage.infer_intro_vars th k ths))
137.244 (InductivePackage.partition_rules raw_induct intrs ~~
137.245 InductivePackage.arities_of raw_induct ~~ elims));
137.246 + val k = length (InductivePackage.params_of raw_induct);
137.247 val atoms' = NominalAtoms.atoms_of thy;
137.248 val atoms =
137.249 if null xatoms then atoms' else
137.250 @@ -612,19 +616,21 @@
137.251 (NominalThmDecls.get_eqvt_thms ctxt @ perm_pi_simp) addsimprocs
137.252 [mk_perm_bool_simproc names,
137.253 NominalPermeq.perm_simproc_app, NominalPermeq.perm_simproc_fun];
137.254 - val t = Logic.unvarify (concl_of raw_induct);
137.255 - val pi = Name.variant (OldTerm.add_term_names (t, [])) "pi";
137.256 + val (([t], [pi]), ctxt') = ctxt |>
137.257 + Variable.import_terms false [concl_of raw_induct] ||>>
137.258 + Variable.variant_fixes ["pi"];
137.259 val ps = map (fst o HOLogic.dest_imp)
137.260 (HOLogic.dest_conj (HOLogic.dest_Trueprop t));
137.261 - fun eqvt_tac pi (intr, vs) st =
137.262 + fun eqvt_tac ctxt'' pi (intr, vs) st =
137.263 let
137.264 - fun eqvt_err s = error
137.265 - ("Could not prove equivariance for introduction rule\n" ^
137.266 - Syntax.string_of_term_global (theory_of_thm intr)
137.267 - (Logic.unvarify (prop_of intr)) ^ "\n" ^ s);
137.268 + fun eqvt_err s =
137.269 + let val ([t], ctxt''') = Variable.import_terms true [prop_of intr] ctxt
137.270 + in error ("Could not prove equivariance for introduction rule\n" ^
137.271 + Syntax.string_of_term ctxt''' t ^ "\n" ^ s)
137.272 + end;
137.273 val res = SUBPROOF (fn {prems, params, ...} =>
137.274 let
137.275 - val prems' = map (fn th => the_default th (map_thm ctxt
137.276 + val prems' = map (fn th => the_default th (map_thm ctxt'
137.277 (split_conj (K I) names) (etac conjunct2 1) monos NONE th)) prems;
137.278 val prems'' = map (fn th => Simplifier.simplify eqvt_ss
137.279 (mk_perm_bool (cterm_of thy pi) th)) prems';
137.280 @@ -632,29 +638,36 @@
137.281 map (cterm_of thy o NominalPackage.mk_perm [] pi o term_of) params)
137.282 intr
137.283 in (rtac intr' THEN_ALL_NEW (TRY o resolve_tac prems'')) 1
137.284 - end) ctxt 1 st
137.285 + end) ctxt' 1 st
137.286 in
137.287 case (Seq.pull res handle THM (s, _, _) => eqvt_err s) of
137.288 NONE => eqvt_err ("Rule does not match goal\n" ^
137.289 - Syntax.string_of_term_global (theory_of_thm st) (hd (prems_of st)))
137.290 + Syntax.string_of_term ctxt'' (hd (prems_of st)))
137.291 | SOME (th, _) => Seq.single th
137.292 end;
137.293 val thss = map (fn atom =>
137.294 let val pi' = Free (pi, NominalAtoms.mk_permT (Type (atom, [])))
137.295 in map (fn th => zero_var_indexes (th RS mp))
137.296 - (DatatypeAux.split_conj_thm (Goal.prove_global thy [] []
137.297 + (DatatypeAux.split_conj_thm (Goal.prove ctxt' [] []
137.298 (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map (fn p =>
137.299 - HOLogic.mk_imp (p, list_comb
137.300 - (apsnd (map (NominalPackage.mk_perm [] pi')) (strip_comb p)))) ps)))
137.301 - (fn _ => EVERY (rtac raw_induct 1 :: map (fn intr_vs =>
137.302 + let
137.303 + val (h, ts) = strip_comb p;
137.304 + val (ts1, ts2) = chop k ts
137.305 + in
137.306 + HOLogic.mk_imp (p, list_comb (h, ts1 @
137.307 + map (NominalPackage.mk_perm [] pi') ts2))
137.308 + end) ps)))
137.309 + (fn {context, ...} => EVERY (rtac raw_induct 1 :: map (fn intr_vs =>
137.310 full_simp_tac eqvt_ss 1 THEN
137.311 - eqvt_tac pi' intr_vs) intrs'))))
137.312 + eqvt_tac context pi' intr_vs) intrs')) |>
137.313 + singleton (ProofContext.export ctxt' ctxt)))
137.314 end) atoms
137.315 in
137.316 - fold (fn (name, ths) =>
137.317 - Sign.add_path (Sign.base_name name) #>
137.318 - PureThy.add_thmss [((Binding.name "eqvt", ths), [NominalThmDecls.eqvt_add])] #> snd #>
137.319 - Sign.parent_path) (names ~~ transp thss) thy
137.320 + ctxt |>
137.321 + LocalTheory.notes Thm.theoremK (map (fn (name, ths) =>
137.322 + ((Binding.name (NameSpace.qualified (Sign.base_name name) "eqvt"),
137.323 + [Attrib.internal (K NominalThmDecls.eqvt_add)]), [(ths, [])]))
137.324 + (names ~~ transp thss)) |> snd
137.325 end;
137.326
137.327
137.328 @@ -665,17 +678,17 @@
137.329 val _ = OuterKeyword.keyword "avoids";
137.330
137.331 val _ =
137.332 - OuterSyntax.command "nominal_inductive"
137.333 + OuterSyntax.local_theory_to_proof "nominal_inductive"
137.334 "prove equivariance and strong induction theorem for inductive predicate involving nominal datatypes" K.thy_goal
137.335 - (P.name -- Scan.optional (P.$$$ "avoids" |-- P.and_list1 (P.name --
137.336 + (P.xname -- Scan.optional (P.$$$ "avoids" |-- P.and_list1 (P.name --
137.337 (P.$$$ ":" |-- Scan.repeat1 P.name))) [] >> (fn (name, avoids) =>
137.338 - Toplevel.print o Toplevel.theory_to_proof (prove_strong_ind name avoids)));
137.339 + prove_strong_ind name avoids));
137.340
137.341 val _ =
137.342 - OuterSyntax.command "equivariance"
137.343 + OuterSyntax.local_theory "equivariance"
137.344 "prove equivariance for inductive predicate involving nominal datatypes" K.thy_decl
137.345 - (P.name -- Scan.optional (P.$$$ "[" |-- P.list1 P.name --| P.$$$ "]") [] >>
137.346 - (fn (name, atoms) => Toplevel.theory (prove_eqvt name atoms)));
137.347 + (P.xname -- Scan.optional (P.$$$ "[" |-- P.list1 P.name --| P.$$$ "]") [] >>
137.348 + (fn (name, atoms) => prove_eqvt name atoms));
137.349
137.350 end;
137.351
138.1 --- a/src/HOL/Nominal/nominal_inductive2.ML Wed Mar 04 10:43:39 2009 +0100
138.2 +++ b/src/HOL/Nominal/nominal_inductive2.ML Wed Mar 04 10:45:52 2009 +0100
138.3 @@ -8,7 +8,7 @@
138.4
138.5 signature NOMINAL_INDUCTIVE2 =
138.6 sig
138.7 - val prove_strong_ind: string -> (string * string list) list -> theory -> Proof.state
138.8 + val prove_strong_ind: string -> (string * string list) list -> local_theory -> Proof.state
138.9 end
138.10
138.11 structure NominalInductive2 : NOMINAL_INDUCTIVE2 =
138.12 @@ -28,6 +28,13 @@
138.13 fun atomize_induct ctxt = Conv.fconv_rule (Conv.prems_conv ~1
138.14 (Conv.params_conv ~1 (K (Conv.prems_conv ~1 atomize_conv)) ctxt));
138.15
138.16 +val fresh_postprocess =
138.17 + Simplifier.full_simplify (HOL_basic_ss addsimps
138.18 + [@{thm fresh_star_set_eq}, @{thm fresh_star_Un_elim},
138.19 + @{thm fresh_star_insert_elim}, @{thm fresh_star_empty_elim}]);
138.20 +
138.21 +fun preds_of ps t = gen_inter (op = o apfst dest_Free) (ps, Term.add_frees t []);
138.22 +
138.23 val perm_bool = mk_meta_eq (thm "perm_bool");
138.24 val perm_boolI = thm "perm_boolI";
138.25 val (_, [perm_boolI_pi, _]) = Drule.strip_comb (snd (Thm.dest_comb
138.26 @@ -148,9 +155,9 @@
138.27 map (Envir.subst_vars env #> cterm_of thy) vs ~~ cts) th
138.28 end;
138.29
138.30 -fun prove_strong_ind s avoids thy =
138.31 +fun prove_strong_ind s avoids ctxt =
138.32 let
138.33 - val ctxt = ProofContext.init thy;
138.34 + val thy = ProofContext.theory_of ctxt;
138.35 val ({names, ...}, {raw_induct, intrs, elims, ...}) =
138.36 InductivePackage.the_inductive ctxt (Sign.intern_const thy s);
138.37 val ind_params = InductivePackage.params_of raw_induct;
138.38 @@ -166,8 +173,7 @@
138.39 (Induct.lookup_inductP ctxt (hd names)))));
138.40 val induct_cases' = if null induct_cases then replicate (length intrs) ""
138.41 else induct_cases;
138.42 - val raw_induct' = Logic.unvarify (prop_of raw_induct);
138.43 - val elims' = map (Logic.unvarify o prop_of) elims;
138.44 + val ([raw_induct'], ctxt') = Variable.import_terms false [prop_of raw_induct] ctxt;
138.45 val concls = raw_induct' |> Logic.strip_imp_concl |> HOLogic.dest_Trueprop |>
138.46 HOLogic.dest_conj |> map (HOLogic.dest_imp ##> strip_comb);
138.47 val ps = map (fst o snd) concls;
138.48 @@ -191,12 +197,15 @@
138.49 handle TERM _ =>
138.50 error ("Expression " ^ quote s ^ " to be avoided in case " ^
138.51 quote name ^ " is not a set type");
138.52 - val ps = map mk sets
138.53 + fun add_set p [] = [p]
138.54 + | add_set (t, T) ((u, U) :: ps) =
138.55 + if T = U then
138.56 + let val S = HOLogic.mk_setT T
138.57 + in (Const (@{const_name "op Un"}, S --> S --> S) $ u $ t, T) :: ps
138.58 + end
138.59 + else (u, U) :: add_set (t, T) ps
138.60 in
138.61 - case duplicates op = (map snd ps) of
138.62 - [] => ps
138.63 - | Ts => error ("More than one set in case " ^ quote name ^
138.64 - " for type(s) " ^ commas_quote (map (Syntax.string_of_typ ctxt') Ts))
138.65 + fold (mk #> add_set) sets []
138.66 end;
138.67
138.68 val prems = map (fn (prem, name) =>
138.69 @@ -221,8 +230,8 @@
138.70 val ind_sort = if null atomTs then HOLogic.typeS
138.71 else Sign.certify_sort thy (map (fn a => Sign.intern_class thy
138.72 ("fs_" ^ Sign.base_name a)) atoms);
138.73 - val fs_ctxt_tyname = Name.variant (map fst (OldTerm.term_tfrees raw_induct')) "'n";
138.74 - val fs_ctxt_name = Name.variant (OldTerm.add_term_names (raw_induct', [])) "z";
138.75 + val ([fs_ctxt_tyname], _) = Name.variants ["'n"] (Variable.names_of ctxt');
138.76 + val ([fs_ctxt_name], ctxt'') = Variable.variant_fixes ["z"] ctxt';
138.77 val fsT = TFree (fs_ctxt_tyname, ind_sort);
138.78
138.79 val inductive_forall_def' = Drule.instantiate'
138.80 @@ -253,7 +262,7 @@
138.81 val prem = Logic.list_implies
138.82 (map mk_fresh sets @
138.83 map (fn prem =>
138.84 - if null (OldTerm.term_frees prem inter ps) then prem
138.85 + if null (preds_of ps prem) then prem
138.86 else lift_prem prem) prems,
138.87 HOLogic.mk_Trueprop (lift_pred p ts));
138.88 in abs_params params' prem end) prems);
138.89 @@ -276,7 +285,7 @@
138.90 val (vc_compat, vc_compat') = map (fn (params, sets, prems, (p, ts)) =>
138.91 map (fn q => abs_params params (incr_boundvars ~1 (Logic.list_implies
138.92 (List.mapPartial (fn prem =>
138.93 - if null (ps inter OldTerm.term_frees prem) then SOME prem
138.94 + if null (preds_of ps prem) then SOME prem
138.95 else map_term (split_conj (K o I) names) prem prem) prems, q))))
138.96 (maps (fn (t, T) => map (fn (u, U) => HOLogic.mk_Trueprop
138.97 (NominalPackage.fresh_star_const U T $ u $ t)) sets)
138.98 @@ -345,8 +354,8 @@
138.99 ths1 @ ths, ths2 @ [th1], ths3 @ [th2'], ctxt')
138.100 end;
138.101
138.102 - fun mk_ind_proof thy thss =
138.103 - Goal.prove_global thy [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
138.104 + fun mk_ind_proof ctxt' thss =
138.105 + Goal.prove ctxt' [] prems' concl' (fn {prems = ihyps, context = ctxt} =>
138.106 let val th = Goal.prove ctxt [] [] concl (fn {context, ...} =>
138.107 rtac raw_induct 1 THEN
138.108 EVERY (maps (fn (((((_, sets, oprems, _),
138.109 @@ -363,7 +372,7 @@
138.110 fold_rev (NominalPackage.mk_perm []) pis t) sets';
138.111 val (P, ts) = strip_comb (HOLogic.dest_Trueprop (term_of concl));
138.112 val gprems1 = List.mapPartial (fn (th, t) =>
138.113 - if null (OldTerm.term_frees t inter ps) then SOME th
138.114 + if null (preds_of ps t) then SOME th
138.115 else
138.116 map_thm ctxt' (split_conj (K o I) names)
138.117 (etac conjunct1 1) monos NONE th)
138.118 @@ -405,7 +414,7 @@
138.119 (fold_rev (mk_perm_bool o cterm_of thy)
138.120 (pis' @ pis) th));
138.121 val gprems2 = map (fn (th, t) =>
138.122 - if null (OldTerm.term_frees t inter ps) then mk_pi th
138.123 + if null (preds_of ps t) then mk_pi th
138.124 else
138.125 mk_pi (the (map_thm ctxt (inst_conj_all names ps (rev pis''))
138.126 (inst_conj_all_tac (length pis'')) monos (SOME t) th)))
138.127 @@ -435,38 +444,42 @@
138.128 REPEAT (REPEAT (resolve_tac [conjI, impI] 1) THEN
138.129 etac impE 1 THEN atac 1 THEN REPEAT (etac @{thm allE_Nil} 1) THEN
138.130 asm_full_simp_tac (simpset_of thy) 1)
138.131 - end);
138.132 + end) |>
138.133 + fresh_postprocess |>
138.134 + singleton (ProofContext.export ctxt' ctxt);
138.135
138.136 in
138.137 - thy |>
138.138 - ProofContext.init |>
138.139 - Proof.theorem_i NONE (fn thss => ProofContext.theory (fn thy =>
138.140 + ctxt'' |>
138.141 + Proof.theorem_i NONE (fn thss => fn ctxt =>
138.142 let
138.143 - val ctxt = ProofContext.init thy;
138.144 val rec_name = space_implode "_" (map Sign.base_name names);
138.145 + val rec_qualified = Binding.qualify false rec_name;
138.146 val ind_case_names = RuleCases.case_names induct_cases;
138.147 val induct_cases' = InductivePackage.partition_rules' raw_induct
138.148 (intrs ~~ induct_cases);
138.149 val thss' = map (map atomize_intr) thss;
138.150 val thsss = InductivePackage.partition_rules' raw_induct (intrs ~~ thss');
138.151 val strong_raw_induct =
138.152 - mk_ind_proof thy thss' |> InductivePackage.rulify;
138.153 + mk_ind_proof ctxt thss' |> InductivePackage.rulify;
138.154 val strong_induct =
138.155 if length names > 1 then
138.156 (strong_raw_induct, [ind_case_names, RuleCases.consumes 0])
138.157 else (strong_raw_induct RSN (2, rev_mp),
138.158 [ind_case_names, RuleCases.consumes 1]);
138.159 - val ([strong_induct'], thy') = thy |>
138.160 - Sign.add_path rec_name |>
138.161 - PureThy.add_thms [((Binding.name "strong_induct", #1 strong_induct), #2 strong_induct)];
138.162 + val ((_, [strong_induct']), ctxt') = LocalTheory.note Thm.theoremK
138.163 + ((rec_qualified (Binding.name "strong_induct"),
138.164 + map (Attrib.internal o K) (#2 strong_induct)), [#1 strong_induct])
138.165 + ctxt;
138.166 val strong_inducts =
138.167 - ProjectRule.projects ctxt (1 upto length names) strong_induct'
138.168 + ProjectRule.projects ctxt' (1 upto length names) strong_induct'
138.169 in
138.170 - thy' |>
138.171 - PureThy.add_thmss [((Binding.name "strong_inducts", strong_inducts),
138.172 - [ind_case_names, RuleCases.consumes 1])] |> snd |>
138.173 - Sign.parent_path
138.174 - end))
138.175 + ctxt' |>
138.176 + LocalTheory.note Thm.theoremK
138.177 + ((rec_qualified (Binding.name "strong_inducts"),
138.178 + [Attrib.internal (K ind_case_names),
138.179 + Attrib.internal (K (RuleCases.consumes 1))]),
138.180 + strong_inducts) |> snd
138.181 + end)
138.182 (map (map (rulify_term thy #> rpair [])) vc_compat)
138.183 end;
138.184
138.185 @@ -476,11 +489,11 @@
138.186 local structure P = OuterParse and K = OuterKeyword in
138.187
138.188 val _ =
138.189 - OuterSyntax.command "nominal_inductive2"
138.190 + OuterSyntax.local_theory_to_proof "nominal_inductive2"
138.191 "prove strong induction theorem for inductive predicate involving nominal datatypes" K.thy_goal
138.192 - (P.name -- Scan.optional (P.$$$ "avoids" |-- P.enum1 "|" (P.name --
138.193 + (P.xname -- Scan.optional (P.$$$ "avoids" |-- P.enum1 "|" (P.name --
138.194 (P.$$$ ":" |-- P.and_list1 P.term))) [] >> (fn (name, avoids) =>
138.195 - Toplevel.print o Toplevel.theory_to_proof (prove_strong_ind name avoids)));
138.196 + prove_strong_ind name avoids));
138.197
138.198 end;
138.199
139.1 --- a/src/HOL/Nominal/nominal_package.ML Wed Mar 04 10:43:39 2009 +0100
139.2 +++ b/src/HOL/Nominal/nominal_package.ML Wed Mar 04 10:45:52 2009 +0100
139.3 @@ -547,10 +547,10 @@
139.4 HOLogic.mk_Trueprop (Free (List.nth (rep_set_names, k),
139.5 T --> HOLogic.boolT) $ free')) :: prems
139.6 | _ => prems,
139.7 - snd (foldr mk_abs_fun (j', free) Ts) :: ts)
139.8 + snd (List.foldr mk_abs_fun (j', free) Ts) :: ts)
139.9 end;
139.10
139.11 - val (_, _, prems, ts) = foldr mk_prem (1, 1, [], []) cargs;
139.12 + val (_, _, prems, ts) = List.foldr mk_prem (1, 1, [], []) cargs;
139.13 val concl = HOLogic.mk_Trueprop (Free (s, T --> HOLogic.boolT) $
139.14 list_comb (Const (cname, map fastype_of ts ---> T), ts))
139.15 in Logic.list_implies (prems, concl)
139.16 @@ -716,7 +716,7 @@
139.17 Type ("Nominal.noption", [U])) $ x $ t
139.18 end;
139.19
139.20 - val (ty_idxs, _) = foldl
139.21 + val (ty_idxs, _) = List.foldl
139.22 (fn ((i, ("Nominal.noption", _, _)), p) => p
139.23 | ((i, _), (ty_idxs, j)) => (ty_idxs @ [(i, j)], j + 1)) ([], 0) descr;
139.24
139.25 @@ -738,7 +738,7 @@
139.26 val SOME index = AList.lookup op = ty_idxs i;
139.27 val (constrs1, constrs2) = ListPair.unzip
139.28 (map (fn (cname, cargs) => apfst (pair (strip_nth_name 2 (strip_nth_name 1 cname)))
139.29 - (foldl_map (fn (dts, dt) =>
139.30 + (Library.foldl_map (fn (dts, dt) =>
139.31 let val (dts', dt') = strip_option dt
139.32 in (dts @ dts' @ [reindex dt'], (length dts, length dts')) end)
139.33 ([], cargs))) constrs)
139.34 @@ -780,7 +780,7 @@
139.35 in
139.36 (j + length dts + 1,
139.37 xs @ x :: l_args,
139.38 - foldr mk_abs_fun
139.39 + List.foldr mk_abs_fun
139.40 (case dt of
139.41 DtRec k => if k < length new_type_names then
139.42 Const (List.nth (rep_names, k), typ_of_dtyp descr'' sorts dt -->
139.43 @@ -789,7 +789,7 @@
139.44 | _ => x) xs :: r_args)
139.45 end
139.46
139.47 - val (_, l_args, r_args) = foldr constr_arg (1, [], []) cargs;
139.48 + val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) cargs;
139.49 val abs_name = Sign.intern_const thy ("Abs_" ^ tname);
139.50 val rep_name = Sign.intern_const thy ("Rep_" ^ tname);
139.51 val constrT = map fastype_of l_args ---> T;
139.52 @@ -909,7 +909,7 @@
139.53 map perm (xs @ [x]) @ r_args)
139.54 end
139.55
139.56 - val (_, l_args, r_args) = foldr constr_arg (1, [], []) dts;
139.57 + val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) dts;
139.58 val c = Const (cname, map fastype_of l_args ---> T)
139.59 in
139.60 Goal.prove_global thy8 [] []
139.61 @@ -958,10 +958,10 @@
139.62 (j + length dts + 1,
139.63 xs @ (x :: args1), ys @ (y :: args2),
139.64 HOLogic.mk_eq
139.65 - (foldr mk_abs_fun x xs, foldr mk_abs_fun y ys) :: eqs)
139.66 + (List.foldr mk_abs_fun x xs, List.foldr mk_abs_fun y ys) :: eqs)
139.67 end;
139.68
139.69 - val (_, args1, args2, eqs) = foldr make_inj (1, [], [], []) dts;
139.70 + val (_, args1, args2, eqs) = List.foldr make_inj (1, [], [], []) dts;
139.71 val Ts = map fastype_of args1;
139.72 val c = Const (cname, Ts ---> T)
139.73 in
139.74 @@ -997,10 +997,10 @@
139.75 val x = mk_Free "x" (typ_of_dtyp descr'' sorts dt) (j + length dts)
139.76 in
139.77 (j + length dts + 1,
139.78 - xs @ (x :: args1), foldr mk_abs_fun x xs :: args2)
139.79 + xs @ (x :: args1), List.foldr mk_abs_fun x xs :: args2)
139.80 end;
139.81
139.82 - val (_, args1, args2) = foldr process_constr (1, [], []) dts;
139.83 + val (_, args1, args2) = List.foldr process_constr (1, [], []) dts;
139.84 val Ts = map fastype_of args1;
139.85 val c = list_comb (Const (cname, Ts ---> T), args1);
139.86 fun supp t =
139.87 @@ -1413,7 +1413,7 @@
139.88
139.89 val _ = warning "defining recursion combinator ...";
139.90
139.91 - val used = foldr OldTerm.add_typ_tfree_names [] recTs;
139.92 + val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
139.93
139.94 val (rec_result_Ts', rec_fn_Ts') = DatatypeProp.make_primrec_Ts descr' sorts used;
139.95
140.1 --- a/src/HOL/Nominal/nominal_primrec.ML Wed Mar 04 10:43:39 2009 +0100
140.2 +++ b/src/HOL/Nominal/nominal_primrec.ML Wed Mar 04 10:45:52 2009 +0100
140.3 @@ -210,7 +210,7 @@
140.4 val def_name = Thm.def_name (Sign.base_name fname);
140.5 val rhs = singleton (Syntax.check_terms ctxt) raw_rhs;
140.6 val SOME var = get_first (fn ((b, _), mx) =>
140.7 - if Binding.base_name b = fname then SOME (b, mx) else NONE) fixes;
140.8 + if Binding.name_of b = fname then SOME (b, mx) else NONE) fixes;
140.9 in
140.10 ((var, ((Binding.name def_name, []), rhs)),
140.11 subst_bounds (rev (map Free frees), strip_abs_body rhs))
140.12 @@ -248,7 +248,7 @@
140.13 val (names_atts, spec') = split_list spec;
140.14 val eqns' = map unquantify spec'
140.15 val eqns = fold_rev (process_eqn lthy (fn v => Variable.is_fixed lthy v
140.16 - orelse exists (fn ((w, _), _) => v = Binding.base_name w) fixes)) spec' [];
140.17 + orelse exists (fn ((w, _), _) => v = Binding.name_of w) fixes)) spec' [];
140.18 val dt_info = NominalPackage.get_nominal_datatypes (ProofContext.theory_of lthy);
140.19 val lsrs :: lsrss = maps (fn (_, (_, _, eqns)) =>
140.20 map (fn (_, (ls, _, rs, _, _)) => ls @ rs) eqns) eqns
140.21 @@ -285,7 +285,7 @@
140.22 set_group ? LocalTheory.set_group (serial_string ()) |>
140.23 fold_map (apfst (snd o snd) oo
140.24 LocalTheory.define Thm.definitionK o fst) defs';
140.25 - val qualify = Binding.qualify
140.26 + val qualify = Binding.qualify false
140.27 (space_implode "_" (map (Sign.base_name o #1) defs));
140.28 val names_atts' = map (apfst qualify) names_atts;
140.29 val cert = cterm_of (ProofContext.theory_of lthy');
141.1 --- a/src/HOL/Nominal/nominal_thmdecls.ML Wed Mar 04 10:43:39 2009 +0100
141.2 +++ b/src/HOL/Nominal/nominal_thmdecls.ML Wed Mar 04 10:45:52 2009 +0100
141.3 @@ -1,5 +1,4 @@
141.4 -(* ID: "$Id$"
141.5 - Authors: Julien Narboux and Christian Urban
141.6 +(* Authors: Julien Narboux and Christian Urban
141.7
141.8 This file introduces the infrastructure for the lemma
141.9 declaration "eqvts" "bijs" and "freshs".
141.10 @@ -63,10 +62,11 @@
141.11 then tac THEN print_tac ("after "^msg)
141.12 else tac
141.13
141.14 -fun tactic_eqvt ctx orig_thm pi typi =
141.15 +fun tactic_eqvt ctx orig_thm pi pi' =
141.16 let
141.17 - val mypi = Thm.cterm_of ctx (Var (pi,typi))
141.18 - val mypifree = Thm.cterm_of ctx (Const ("List.rev",typi --> typi) $ Free (fst pi,typi))
141.19 + val mypi = Thm.cterm_of ctx pi
141.20 + val T = fastype_of pi'
141.21 + val mypifree = Thm.cterm_of ctx (Const ("List.rev", T --> T) $ pi')
141.22 val perm_pi_simp = PureThy.get_thms ctx "perm_pi_simp"
141.23 in
141.24 EVERY [tactic ("iffI applied",rtac iffI 1),
141.25 @@ -80,14 +80,19 @@
141.26 full_simp_tac (HOL_basic_ss addsimps perm_pi_simp) 1)]
141.27 end;
141.28
141.29 -fun get_derived_thm thy hyp concl orig_thm pi typi =
141.30 - let
141.31 - val lhs = (Const("Nominal.perm", typi --> HOLogic.boolT --> HOLogic.boolT) $ Var(pi,typi) $ hyp)
141.32 - val goal_term = Logic.unvarify (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs,concl)))
141.33 - val _ = Display.print_cterm (cterm_of thy goal_term)
141.34 - in
141.35 - Goal.prove_global thy [] [] goal_term (fn _ => (tactic_eqvt thy orig_thm pi typi))
141.36 - end
141.37 +fun get_derived_thm ctxt hyp concl orig_thm pi typi =
141.38 + let
141.39 + val thy = ProofContext.theory_of ctxt;
141.40 + val pi' = Var (pi, typi);
141.41 + val lhs = Const ("Nominal.perm", typi --> HOLogic.boolT --> HOLogic.boolT) $ pi' $ hyp;
141.42 + val ([goal_term, pi''], ctxt') = Variable.import_terms false
141.43 + [HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, concl)), pi'] ctxt
141.44 + val _ = Display.print_cterm (cterm_of thy goal_term)
141.45 + in
141.46 + Goal.prove ctxt' [] [] goal_term
141.47 + (fn _ => tactic_eqvt thy orig_thm pi' pi'') |>
141.48 + singleton (ProofContext.export ctxt' ctxt)
141.49 + end
141.50
141.51 (* replaces every variable x in t with pi o x *)
141.52 fun apply_pi trm (pi,typi) =
141.53 @@ -145,7 +150,8 @@
141.54 if (apply_pi hyp (pi,typi) = concl)
141.55 then
141.56 (warning ("equivariance lemma of the relational form");
141.57 - [orig_thm, get_derived_thm thy hyp concl orig_thm pi typi])
141.58 + [orig_thm,
141.59 + get_derived_thm (Context.proof_of context) hyp concl orig_thm pi typi])
141.60 else raise EQVT_FORM "Type Implication"
141.61 end
141.62 (* case: eqvt-lemma is of the equational form *)
142.1 --- a/src/HOL/NumberTheory/Chinese.thy Wed Mar 04 10:43:39 2009 +0100
142.2 +++ b/src/HOL/NumberTheory/Chinese.thy Wed Mar 04 10:45:52 2009 +0100
142.3 @@ -90,10 +90,8 @@
142.4 "k \<le> i --> i \<le> k + l --> mf i dvd funprod mf k l"
142.5 apply (induct l)
142.6 apply auto
142.7 - apply (rule_tac [1] zdvd_zmult2)
142.8 - apply (rule_tac [2] zdvd_zmult)
142.9 - apply (subgoal_tac "i = Suc (k + l)")
142.10 - apply (simp_all (no_asm_simp))
142.11 + apply (subgoal_tac "i = Suc (k + l)")
142.12 + apply (simp_all (no_asm_simp))
142.13 done
142.14
142.15 lemma funsum_mod:
142.16 @@ -103,7 +101,7 @@
142.17 apply (rule trans)
142.18 apply (rule mod_add_eq)
142.19 apply simp
142.20 - apply (rule zmod_zadd_right_eq [symmetric])
142.21 + apply (rule mod_add_right_eq [symmetric])
142.22 done
142.23
142.24 lemma funsum_zero [rule_format (no_asm)]:
142.25 @@ -196,8 +194,8 @@
142.26 apply (case_tac [2] "i = n")
142.27 apply (simp_all (no_asm_simp))
142.28 apply (case_tac [3] "j < i")
142.29 - apply (rule_tac [3] zdvd_zmult2)
142.30 - apply (rule_tac [4] zdvd_zmult)
142.31 + apply (rule_tac [3] dvd_mult2)
142.32 + apply (rule_tac [4] dvd_mult)
142.33 apply (rule_tac [!] funprod_zdvd)
142.34 apply arith
142.35 apply arith
142.36 @@ -217,8 +215,8 @@
142.37 apply (subst funsum_mod)
142.38 apply (subst funsum_oneelem)
142.39 apply auto
142.40 - apply (subst zdvd_iff_zmod_eq_0 [symmetric])
142.41 - apply (rule zdvd_zmult)
142.42 + apply (subst dvd_eq_mod_eq_0 [symmetric])
142.43 + apply (rule dvd_mult)
142.44 apply (rule x_sol_lin_aux)
142.45 apply auto
142.46 done
142.47 @@ -238,20 +236,20 @@
142.48 apply safe
142.49 apply (tactic {* stac (thm "zcong_zmod") 3 *})
142.50 apply (tactic {* stac (thm "mod_mult_eq") 3 *})
142.51 - apply (tactic {* stac (thm "zmod_zdvd_zmod") 3 *})
142.52 - apply (tactic {* stac (thm "x_sol_lin") 5 *})
142.53 - apply (tactic {* stac (thm "mod_mult_eq" RS sym) 7 *})
142.54 - apply (tactic {* stac (thm "zcong_zmod" RS sym) 7 *})
142.55 - apply (subgoal_tac [7]
142.56 + apply (tactic {* stac (thm "mod_mod_cancel") 3 *})
142.57 + apply (tactic {* stac (thm "x_sol_lin") 4 *})
142.58 + apply (tactic {* stac (thm "mod_mult_eq" RS sym) 6 *})
142.59 + apply (tactic {* stac (thm "zcong_zmod" RS sym) 6 *})
142.60 + apply (subgoal_tac [6]
142.61 "0 \<le> xilin_sol i n kf bf mf \<and> xilin_sol i n kf bf mf < mf i
142.62 \<and> [kf i * mhf mf n i * xilin_sol i n kf bf mf = bf i] (mod mf i)")
142.63 - prefer 7
142.64 + prefer 6
142.65 apply (simp add: zmult_ac)
142.66 apply (unfold xilin_sol_def)
142.67 - apply (tactic {* asm_simp_tac @{simpset} 7 *})
142.68 - apply (rule_tac [7] ex1_implies_ex [THEN someI_ex])
142.69 - apply (rule_tac [7] unique_xi_sol)
142.70 - apply (rule_tac [4] funprod_zdvd)
142.71 + apply (tactic {* asm_simp_tac @{simpset} 6 *})
142.72 + apply (rule_tac [6] ex1_implies_ex [THEN someI_ex])
142.73 + apply (rule_tac [6] unique_xi_sol)
142.74 + apply (rule_tac [3] funprod_zdvd)
142.75 apply (unfold m_cond_def)
142.76 apply (rule funprod_pos [THEN pos_mod_sign])
142.77 apply (rule_tac [2] funprod_pos [THEN pos_mod_bound])
143.1 --- a/src/HOL/NumberTheory/Euler.thy Wed Mar 04 10:43:39 2009 +0100
143.2 +++ b/src/HOL/NumberTheory/Euler.thy Wed Mar 04 10:45:52 2009 +0100
143.3 @@ -272,7 +272,7 @@
143.4 text {* \medskip Prove the final part of Euler's Criterion: *}
143.5
143.6 lemma aux__1: "[| ~([x = 0] (mod p)); [y ^ 2 = x] (mod p)|] ==> ~(p dvd y)"
143.7 - by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div zdvd_trans)
143.8 + by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div dvd_trans)
143.9
143.10 lemma aux__2: "2 * nat((p - 1) div 2) = nat (2 * ((p - 1) div 2))"
143.11 by (auto simp add: nat_mult_distrib)
144.1 --- a/src/HOL/NumberTheory/EulerFermat.thy Wed Mar 04 10:43:39 2009 +0100
144.2 +++ b/src/HOL/NumberTheory/EulerFermat.thy Wed Mar 04 10:45:52 2009 +0100
144.3 @@ -155,7 +155,7 @@
144.4 prefer 2
144.5 apply (subst zdvd_iff_zgcd [symmetric])
144.6 apply (rule_tac [4] zgcd_zcong_zgcd)
144.7 - apply (simp_all add: zdvd_zminus_iff zcong_sym)
144.8 + apply (simp_all add: zcong_sym)
144.9 done
144.10
144.11
145.1 --- a/src/HOL/NumberTheory/Gauss.thy Wed Mar 04 10:43:39 2009 +0100
145.2 +++ b/src/HOL/NumberTheory/Gauss.thy Wed Mar 04 10:45:52 2009 +0100
145.3 @@ -64,14 +64,14 @@
145.4 qed
145.5
145.6 lemma p_eq: "p = (2 * (p - 1) div 2) + 1"
145.7 - using zdiv_zmult_self2 [of 2 "p - 1"] by auto
145.8 + using div_mult_self1_is_id [of 2 "p - 1"] by auto
145.9
145.10
145.11 lemma (in -) zodd_imp_zdiv_eq: "x \<in> zOdd ==> 2 * (x - 1) div 2 = 2 * ((x - 1) div 2)"
145.12 apply (frule odd_minus_one_even)
145.13 apply (simp add: zEven_def)
145.14 apply (subgoal_tac "2 \<noteq> 0")
145.15 - apply (frule_tac b = "2 :: int" and a = "x - 1" in zdiv_zmult_self2)
145.16 + apply (frule_tac b = "2 :: int" and a = "x - 1" in div_mult_self1_is_id)
145.17 apply (auto simp add: even_div_2_prop2)
145.18 done
145.19
146.1 --- a/src/HOL/NumberTheory/Int2.thy Wed Mar 04 10:43:39 2009 +0100
146.2 +++ b/src/HOL/NumberTheory/Int2.thy Wed Mar 04 10:45:52 2009 +0100
146.3 @@ -18,7 +18,7 @@
146.4
146.5 lemma zpower_zdvd_prop1:
146.6 "0 < n \<Longrightarrow> p dvd y \<Longrightarrow> p dvd ((y::int) ^ n)"
146.7 - by (induct n) (auto simp add: zdvd_zmult zdvd_zmult2 [of p y])
146.8 + by (induct n) (auto simp add: dvd_mult2 [of p y])
146.9
146.10 lemma zdvd_bounds: "n dvd m ==> m \<le> (0::int) | n \<le> m"
146.11 proof -
146.12 @@ -42,7 +42,7 @@
146.13 apply simp
146.14 apply (frule zprime_zdvd_zmult_better)
146.15 apply simp
146.16 - apply force
146.17 + apply (force simp del:dvd_mult)
146.18 done
146.19
146.20 lemma div_prop1: "[| 0 < z; (x::int) < y * z |] ==> x div z < y"
146.21 @@ -86,7 +86,7 @@
146.22 by (auto simp add: zcong_def)
146.23
146.24 lemma zcong_id: "[m = 0] (mod m)"
146.25 - by (auto simp add: zcong_def zdvd_0_right)
146.26 + by (auto simp add: zcong_def)
146.27
146.28 lemma zcong_shift: "[a = b] (mod m) ==> [a + c = b + c] (mod m)"
146.29 by (auto simp add: zcong_refl zcong_zadd)
147.1 --- a/src/HOL/NumberTheory/IntPrimes.thy Wed Mar 04 10:43:39 2009 +0100
147.2 +++ b/src/HOL/NumberTheory/IntPrimes.thy Wed Mar 04 10:45:52 2009 +0100
147.3 @@ -50,7 +50,7 @@
147.4
147.5 lemma zrelprime_zdvd_zmult_aux:
147.6 "zgcd n k = 1 ==> k dvd m * n ==> 0 \<le> m ==> k dvd m"
147.7 - by (metis abs_of_nonneg zdvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right)
147.8 + by (metis abs_of_nonneg dvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right)
147.9
147.10 lemma zrelprime_zdvd_zmult: "zgcd n k = 1 ==> k dvd m * n ==> k dvd m"
147.11 apply (case_tac "0 \<le> m")
147.12 @@ -73,7 +73,7 @@
147.13 lemma zprime_imp_zrelprime:
147.14 "zprime p ==> \<not> p dvd n ==> zgcd n p = 1"
147.15 apply (auto simp add: zprime_def)
147.16 - apply (metis zgcd_commute zgcd_geq_zero zgcd_zdvd1 zgcd_zdvd2)
147.17 + apply (metis zgcd_geq_zero zgcd_zdvd1 zgcd_zdvd2)
147.18 done
147.19
147.20 lemma zless_zprime_imp_zrelprime:
147.21 @@ -93,9 +93,7 @@
147.22 done
147.23
147.24 lemma zgcd_zdvd_zgcd_zmult: "zgcd m n dvd zgcd (k * m) n"
147.25 - apply (simp add: zgcd_greatest_iff)
147.26 - apply (blast intro: zdvd_trans dvd_triv_right)
147.27 - done
147.28 +by (simp add: zgcd_greatest_iff)
147.29
147.30 lemma zgcd_zmult_zdvd_zgcd:
147.31 "zgcd k n = 1 ==> zgcd (k * m) n dvd zgcd m n"
147.32 @@ -127,20 +125,20 @@
147.33 by (unfold zcong_def, auto)
147.34
147.35 lemma zcong_sym: "[a = b] (mod m) = [b = a] (mod m)"
147.36 - unfolding zcong_def minus_diff_eq [of a, symmetric] zdvd_zminus_iff ..
147.37 + unfolding zcong_def minus_diff_eq [of a, symmetric] dvd_minus_iff ..
147.38
147.39 lemma zcong_zadd:
147.40 "[a = b] (mod m) ==> [c = d] (mod m) ==> [a + c = b + d] (mod m)"
147.41 apply (unfold zcong_def)
147.42 apply (rule_tac s = "(a - b) + (c - d)" in subst)
147.43 - apply (rule_tac [2] zdvd_zadd, auto)
147.44 + apply (rule_tac [2] dvd_add, auto)
147.45 done
147.46
147.47 lemma zcong_zdiff:
147.48 "[a = b] (mod m) ==> [c = d] (mod m) ==> [a - c = b - d] (mod m)"
147.49 apply (unfold zcong_def)
147.50 apply (rule_tac s = "(a - b) - (c - d)" in subst)
147.51 - apply (rule_tac [2] zdvd_zdiff, auto)
147.52 + apply (rule_tac [2] dvd_diff, auto)
147.53 done
147.54
147.55 lemma zcong_trans:
147.56 @@ -151,8 +149,8 @@
147.57 "[a = b] (mod m) ==> [c = d] (mod m) ==> [a * c = b * d] (mod m)"
147.58 apply (rule_tac b = "b * c" in zcong_trans)
147.59 apply (unfold zcong_def)
147.60 - apply (metis zdiff_zmult_distrib2 zdvd_zmult zmult_commute)
147.61 - apply (metis zdiff_zmult_distrib2 zdvd_zmult)
147.62 + apply (metis zdiff_zmult_distrib2 dvd_mult zmult_commute)
147.63 + apply (metis zdiff_zmult_distrib2 dvd_mult)
147.64 done
147.65
147.66 lemma zcong_scalar: "[a = b] (mod m) ==> [a * k = b * k] (mod m)"
147.67 @@ -163,7 +161,7 @@
147.68
147.69 lemma zcong_zmult_self: "[a * m = b * m] (mod m)"
147.70 apply (unfold zcong_def)
147.71 - apply (rule zdvd_zdiff, simp_all)
147.72 + apply (rule dvd_diff, simp_all)
147.73 done
147.74
147.75 lemma zcong_square:
147.76 @@ -191,7 +189,7 @@
147.77 apply (simp_all add: zdiff_zmult_distrib)
147.78 apply (subgoal_tac "m dvd (-(a * k - b * k))")
147.79 apply simp
147.80 - apply (subst zdvd_zminus_iff, assumption)
147.81 + apply (subst dvd_minus_iff, assumption)
147.82 done
147.83
147.84 lemma zcong_cancel2:
147.85 @@ -206,10 +204,10 @@
147.86 apply (subgoal_tac "m dvd n * ka")
147.87 apply (subgoal_tac "m dvd ka")
147.88 apply (case_tac [2] "0 \<le> ka")
147.89 - apply (metis zdvd_mult_div_cancel zdvd_refl zdvd_zminus2_iff zdvd_zmultD2 zgcd_zminus zmult_commute zmult_zminus zrelprime_zdvd_zmult)
147.90 - apply (metis IntDiv.zdvd_abs1 abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute)
147.91 - apply (metis abs_eq_0 int_0_neq_1 mult_le_0_iff zdvd_mono zdvd_mult_cancel zdvd_mult_cancel1 zdvd_refl zdvd_triv_left zdvd_zmult2 zero_le_mult_iff zgcd_greatest_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult)
147.92 - apply (metis zdvd_triv_left)
147.93 + apply (metis zdvd_mult_div_cancel dvd_refl dvd_mult_left zmult_commute zrelprime_zdvd_zmult)
147.94 + apply (metis abs_dvd_iff abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute)
147.95 + apply (metis mult_le_0_iff zdvd_mono zdvd_mult_cancel dvd_triv_left zero_le_mult_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult)
147.96 + apply (metis dvd_triv_left)
147.97 done
147.98
147.99 lemma zcong_zless_imp_eq:
147.100 @@ -217,7 +215,7 @@
147.101 a < m ==> 0 \<le> b ==> b < m ==> [a = b] (mod m) ==> a = b"
147.102 apply (unfold zcong_def dvd_def, auto)
147.103 apply (drule_tac f = "\<lambda>z. z mod m" in arg_cong)
147.104 - apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_commute zmod_eq_0_iff zmod_zadd_right_eq)
147.105 + apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_commute zmod_eq_0_iff mod_add_right_eq)
147.106 done
147.107
147.108 lemma zcong_square_zless:
147.109 @@ -237,7 +235,7 @@
147.110 lemma zcong_zless_0:
147.111 "0 \<le> a ==> a < m ==> [a = 0] (mod m) ==> a = 0"
147.112 apply (unfold zcong_def dvd_def, auto)
147.113 - apply (metis div_pos_pos_trivial linorder_not_less zdiv_zmult_self2 zle_refl zle_trans)
147.114 + apply (metis div_pos_pos_trivial linorder_not_less div_mult_self1_is_id)
147.115 done
147.116
147.117 lemma zcong_zless_unique:
147.118 @@ -302,7 +300,7 @@
147.119
147.120 lemma zmod_zdvd_zmod:
147.121 "0 < (m::int) ==> m dvd b ==> (a mod b mod m) = (a mod m)"
147.122 - by (rule zmod_zmod_cancel)
147.123 + by (rule mod_mod_cancel)
147.124
147.125
147.126 subsection {* Extended GCD *}
147.127 @@ -403,7 +401,7 @@
147.128 prefer 2
147.129 apply simp
147.130 apply (unfold zcong_def)
147.131 - apply (simp (no_asm) add: zmult_commute zdvd_zminus_iff)
147.132 + apply (simp (no_asm) add: zmult_commute)
147.133 done
147.134
147.135 lemma zcong_lineq_unique:
148.1 --- a/src/HOL/NumberTheory/Quadratic_Reciprocity.thy Wed Mar 04 10:43:39 2009 +0100
148.2 +++ b/src/HOL/NumberTheory/Quadratic_Reciprocity.thy Wed Mar 04 10:45:52 2009 +0100
148.3 @@ -322,7 +322,7 @@
148.4 by (rule zdiv_mono1) (insert p_g_2, auto)
148.5 then show "b \<le> (q * a) div p"
148.6 apply (subgoal_tac "p \<noteq> 0")
148.7 - apply (frule zdiv_zmult_self2, force)
148.8 + apply (frule div_mult_self1_is_id, force)
148.9 apply (insert p_g_2, auto)
148.10 done
148.11 qed
148.12 @@ -356,7 +356,7 @@
148.13 by (rule zdiv_mono1) (insert q_g_2, auto)
148.14 then show "a \<le> (p * b) div q"
148.15 apply (subgoal_tac "q \<noteq> 0")
148.16 - apply (frule zdiv_zmult_self2, force)
148.17 + apply (frule div_mult_self1_is_id, force)
148.18 apply (insert q_g_2, auto)
148.19 done
148.20 qed
149.1 --- a/src/HOL/NumberTheory/Residues.thy Wed Mar 04 10:43:39 2009 +0100
149.2 +++ b/src/HOL/NumberTheory/Residues.thy Wed Mar 04 10:45:52 2009 +0100
149.3 @@ -48,7 +48,7 @@
149.4 by (auto simp add: StandardRes_def zcong_zmod_eq)
149.5
149.6 lemma StandardRes_prop3: "(~[x = 0] (mod p)) = (~(StandardRes p x = 0))"
149.7 - by (auto simp add: StandardRes_def zcong_def zdvd_iff_zmod_eq_0)
149.8 + by (auto simp add: StandardRes_def zcong_def dvd_eq_mod_eq_0)
149.9
149.10 lemma StandardRes_prop4: "2 < m
149.11 ==> [StandardRes m x * StandardRes m y = (x * y)] (mod m)"
150.1 --- a/src/HOL/NumberTheory/WilsonBij.thy Wed Mar 04 10:43:39 2009 +0100
150.2 +++ b/src/HOL/NumberTheory/WilsonBij.thy Wed Mar 04 10:45:52 2009 +0100
150.3 @@ -57,7 +57,7 @@
150.4 apply (rule_tac [2] zdvd_not_zless)
150.5 apply (subgoal_tac "p dvd 1")
150.6 prefer 2
150.7 - apply (subst zdvd_zminus_iff [symmetric])
150.8 + apply (subst dvd_minus_iff [symmetric])
150.9 apply auto
150.10 done
150.11
150.12 @@ -79,7 +79,7 @@
150.13 apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2)
150.14 apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
150.15 apply (simp add: mult_commute)
150.16 - apply (subst zdvd_zminus_iff)
150.17 + apply (subst dvd_minus_iff)
150.18 apply (subst zdvd_reduce)
150.19 apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
150.20 apply (subst zdvd_reduce)
151.1 --- a/src/HOL/NumberTheory/WilsonRuss.thy Wed Mar 04 10:43:39 2009 +0100
151.2 +++ b/src/HOL/NumberTheory/WilsonRuss.thy Wed Mar 04 10:45:52 2009 +0100
151.3 @@ -68,7 +68,7 @@
151.4 apply (rule_tac [2] zdvd_not_zless)
151.5 apply (subgoal_tac "p dvd 1")
151.6 prefer 2
151.7 - apply (subst zdvd_zminus_iff [symmetric], auto)
151.8 + apply (subst dvd_minus_iff [symmetric], auto)
151.9 done
151.10
151.11 lemma inv_not_1:
151.12 @@ -87,7 +87,7 @@
151.13 apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2)
151.14 apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
151.15 apply (simp add: mult_commute)
151.16 - apply (subst zdvd_zminus_iff)
151.17 + apply (subst dvd_minus_iff)
151.18 apply (subst zdvd_reduce)
151.19 apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
151.20 apply (subst zdvd_reduce, auto)
152.1 --- a/src/HOL/Orderings.thy Wed Mar 04 10:43:39 2009 +0100
152.2 +++ b/src/HOL/Orderings.thy Wed Mar 04 10:45:52 2009 +0100
152.3 @@ -331,7 +331,7 @@
152.4
152.5 fun struct_tac ((s, [eq, le, less]), thms) prems =
152.6 let
152.7 - fun decomp thy (Trueprop $ t) =
152.8 + fun decomp thy (@{const Trueprop} $ t) =
152.9 let
152.10 fun excluded t =
152.11 (* exclude numeric types: linear arithmetic subsumes transitivity *)
152.12 @@ -350,7 +350,8 @@
152.13 of NONE => NONE
152.14 | SOME (t1, rel, t2) => SOME (t1, "~" ^ rel, t2))
152.15 | dec x = rel x;
152.16 - in dec t end;
152.17 + in dec t end
152.18 + | decomp thy _ = NONE;
152.19 in
152.20 case s of
152.21 "order" => Order_Tac.partial_tac decomp thms prems
153.1 --- a/src/HOL/Parity.thy Wed Mar 04 10:43:39 2009 +0100
153.2 +++ b/src/HOL/Parity.thy Wed Mar 04 10:45:52 2009 +0100
153.3 @@ -228,20 +228,9 @@
153.4
153.5 lemma zero_le_odd_power: "odd n ==>
153.6 (0 <= (x::'a::{recpower,ordered_idom}) ^ n) = (0 <= x)"
153.7 - apply (simp add: odd_nat_equiv_def2)
153.8 - apply (erule exE)
153.9 - apply (erule ssubst)
153.10 - apply (subst power_Suc)
153.11 - apply (subst power_add)
153.12 - apply (subst zero_le_mult_iff)
153.13 - apply auto
153.14 - apply (subgoal_tac "x = 0 & y > 0")
153.15 - apply (erule conjE, assumption)
153.16 - apply (subst power_eq_0_iff [symmetric])
153.17 - apply (subgoal_tac "0 <= x^y * x^y")
153.18 - apply simp
153.19 - apply (rule zero_le_square)+
153.20 - done
153.21 +apply (auto simp: odd_nat_equiv_def2 power_Suc power_add zero_le_mult_iff)
153.22 +apply (metis field_power_not_zero no_zero_divirors_neq0 order_antisym_conv zero_le_square)
153.23 +done
153.24
153.25 lemma zero_le_power_eq[presburger]: "(0 <= (x::'a::{recpower,ordered_idom}) ^ n) =
153.26 (even n | (odd n & 0 <= x))"
154.1 --- a/src/HOL/Plain.thy Wed Mar 04 10:43:39 2009 +0100
154.2 +++ b/src/HOL/Plain.thy Wed Mar 04 10:45:52 2009 +0100
154.3 @@ -1,7 +1,7 @@
154.4 header {* Plain HOL *}
154.5
154.6 theory Plain
154.7 -imports Datatype FunDef Record Extraction Divides Fact
154.8 +imports Datatype FunDef Record Extraction Divides
154.9 begin
154.10
154.11 text {*
155.1 --- a/src/HOL/Power.thy Wed Mar 04 10:43:39 2009 +0100
155.2 +++ b/src/HOL/Power.thy Wed Mar 04 10:45:52 2009 +0100
155.3 @@ -31,7 +31,7 @@
155.4 by (induct n) (simp_all add: power_Suc)
155.5
155.6 lemma power_one_right [simp]: "(a::'a::recpower) ^ 1 = a"
155.7 - by (simp add: power_Suc)
155.8 + unfolding One_nat_def by (simp add: power_Suc)
155.9
155.10 lemma power_commutes: "(a::'a::recpower) ^ n * a = a * a ^ n"
155.11 by (induct n) (simp_all add: power_Suc mult_assoc)
155.12 @@ -143,11 +143,13 @@
155.13 done
155.14
155.15 lemma power_eq_0_iff [simp]:
155.16 - "(a^n = 0) = (a = (0::'a::{ring_1_no_zero_divisors,recpower}) & n>0)"
155.17 + "(a^n = 0) \<longleftrightarrow>
155.18 + (a = (0::'a::{mult_zero,zero_neq_one,no_zero_divisors,recpower}) & n\<noteq>0)"
155.19 apply (induct "n")
155.20 -apply (auto simp add: power_Suc zero_neq_one [THEN not_sym])
155.21 +apply (auto simp add: power_Suc zero_neq_one [THEN not_sym] no_zero_divisors)
155.22 done
155.23
155.24 +
155.25 lemma field_power_not_zero:
155.26 "a \<noteq> (0::'a::{ring_1_no_zero_divisors,recpower}) ==> a^n \<noteq> 0"
155.27 by force
155.28 @@ -324,6 +326,24 @@
155.29 shows "\<lbrakk>a ^ n = b ^ n; 0 \<le> a; 0 \<le> b; 0 < n\<rbrakk> \<Longrightarrow> a = b"
155.30 by (cases n, simp_all, rule power_inject_base)
155.31
155.32 +text {* The divides relation *}
155.33 +
155.34 +lemma le_imp_power_dvd:
155.35 + fixes a :: "'a::{comm_semiring_1,recpower}"
155.36 + assumes "m \<le> n" shows "a^m dvd a^n"
155.37 +proof
155.38 + have "a^n = a^(m + (n - m))"
155.39 + using `m \<le> n` by simp
155.40 + also have "\<dots> = a^m * a^(n - m)"
155.41 + by (rule power_add)
155.42 + finally show "a^n = a^m * a^(n - m)" .
155.43 +qed
155.44 +
155.45 +lemma power_le_dvd:
155.46 + fixes a b :: "'a::{comm_semiring_1,recpower}"
155.47 + shows "a^n dvd b \<Longrightarrow> m \<le> n \<Longrightarrow> a^m dvd b"
155.48 + by (rule dvd_trans [OF le_imp_power_dvd])
155.49 +
155.50
155.51 subsection{*Exponentiation for the Natural Numbers*}
155.52
155.53 @@ -346,12 +366,19 @@
155.54 "of_nat (m ^ n) = (of_nat m::'a::{semiring_1,recpower}) ^ n"
155.55 by (induct n, simp_all add: power_Suc of_nat_mult)
155.56
155.57 -lemma nat_one_le_power [simp]: "1 \<le> i ==> Suc 0 \<le> i^n"
155.58 -by (insert one_le_power [of i n], simp)
155.59 +lemma nat_one_le_power [simp]: "Suc 0 \<le> i ==> Suc 0 \<le> i^n"
155.60 +by (rule one_le_power [of i n, unfolded One_nat_def])
155.61
155.62 lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
155.63 by (induct "n", auto)
155.64
155.65 +lemma nat_power_eq_Suc_0_iff [simp]:
155.66 + "((x::nat)^m = Suc 0) = (m = 0 | x = Suc 0)"
155.67 +by (induct_tac m, auto)
155.68 +
155.69 +lemma power_Suc_0[simp]: "(Suc 0)^n = Suc 0"
155.70 +by simp
155.71 +
155.72 text{*Valid for the naturals, but what if @{text"0<i<1"}?
155.73 Premises cannot be weakened: consider the case where @{term "i=0"},
155.74 @{term "m=1"} and @{term "n=0"}.*}
155.75 @@ -425,4 +452,3 @@
155.76 *}
155.77
155.78 end
155.79 -
156.1 --- a/src/HOL/Presburger.thy Wed Mar 04 10:43:39 2009 +0100
156.2 +++ b/src/HOL/Presburger.thy Wed Mar 04 10:45:52 2009 +0100
156.3 @@ -412,19 +412,15 @@
156.4 "(((number_of v)::int) = (number_of w)) = iszero ((number_of (v + (uminus w)))::int)"
156.5 by (rule eq_number_of_eq)
156.6
156.7 -lemma mod_eq0_dvd_iff[presburger]: "(m::nat) mod n = 0 \<longleftrightarrow> n dvd m"
156.8 -unfolding dvd_eq_mod_eq_0[symmetric] ..
156.9 -
156.10 -lemma zmod_eq0_zdvd_iff[presburger]: "(m::int) mod n = 0 \<longleftrightarrow> n dvd m"
156.11 -unfolding zdvd_iff_zmod_eq_0[symmetric] ..
156.12 +declare dvd_eq_mod_eq_0[symmetric, presburger]
156.13 declare mod_1[presburger]
156.14 declare mod_0[presburger]
156.15 -declare zmod_1[presburger]
156.16 +declare mod_by_1[presburger]
156.17 declare zmod_zero[presburger]
156.18 declare zmod_self[presburger]
156.19 declare mod_self[presburger]
156.20 declare mod_by_0[presburger]
156.21 -declare nat_mod_div_trivial[presburger]
156.22 +declare mod_div_trivial[presburger]
156.23 declare div_mod_equality2[presburger]
156.24 declare div_mod_equality[presburger]
156.25 declare mod_div_equality2[presburger]
157.1 --- a/src/HOL/RComplete.thy Wed Mar 04 10:43:39 2009 +0100
157.2 +++ b/src/HOL/RComplete.thy Wed Mar 04 10:45:52 2009 +0100
157.3 @@ -1,8 +1,8 @@
157.4 -(* Title : HOL/RComplete.thy
157.5 - Author : Jacques D. Fleuriot, University of Edinburgh
157.6 - Author : Larry Paulson, University of Cambridge
157.7 - Author : Jeremy Avigad, Carnegie Mellon University
157.8 - Author : Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen
157.9 +(* Title: HOL/RComplete.thy
157.10 + Author: Jacques D. Fleuriot, University of Edinburgh
157.11 + Author: Larry Paulson, University of Cambridge
157.12 + Author: Jeremy Avigad, Carnegie Mellon University
157.13 + Author: Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen
157.14 *)
157.15
157.16 header {* Completeness of the Reals; Floor and Ceiling Functions *}
157.17 @@ -380,33 +380,28 @@
157.18 thus "\<exists>(n::nat). x < real n" ..
157.19 qed
157.20
157.21 +instance real :: archimedean_field
157.22 +proof
157.23 + fix r :: real
157.24 + obtain n :: nat where "r < real n"
157.25 + using reals_Archimedean2 ..
157.26 + then have "r \<le> of_int (int n)"
157.27 + unfolding real_eq_of_nat by simp
157.28 + then show "\<exists>z. r \<le> of_int z" ..
157.29 +qed
157.30 +
157.31 lemma reals_Archimedean3:
157.32 assumes x_greater_zero: "0 < x"
157.33 shows "\<forall>(y::real). \<exists>(n::nat). y < real n * x"
157.34 -proof
157.35 - fix y
157.36 - have x_not_zero: "x \<noteq> 0" using x_greater_zero by simp
157.37 - obtain n where "y * inverse x < real (n::nat)"
157.38 - using reals_Archimedean2 ..
157.39 - hence "y * inverse x * x < real n * x"
157.40 - using x_greater_zero by (simp add: mult_strict_right_mono)
157.41 - hence "x * inverse x * y < x * real n"
157.42 - by (simp add: algebra_simps)
157.43 - hence "y < real (n::nat) * x"
157.44 - using x_not_zero by (simp add: algebra_simps)
157.45 - thus "\<exists>(n::nat). y < real n * x" ..
157.46 -qed
157.47 + unfolding real_of_nat_def using `0 < x`
157.48 + by (auto intro: ex_less_of_nat_mult)
157.49
157.50 lemma reals_Archimedean6:
157.51 "0 \<le> r ==> \<exists>(n::nat). real (n - 1) \<le> r & r < real (n)"
157.52 -apply (insert reals_Archimedean2 [of r], safe)
157.53 -apply (subgoal_tac "\<exists>x::nat. r < real x \<and> (\<forall>y. r < real y \<longrightarrow> x \<le> y)", auto)
157.54 -apply (rule_tac x = x in exI)
157.55 -apply (case_tac x, simp)
157.56 -apply (rename_tac x')
157.57 -apply (drule_tac x = x' in spec, simp)
157.58 -apply (rule_tac x="LEAST n. r < real n" in exI, safe)
157.59 -apply (erule LeastI, erule Least_le)
157.60 +unfolding real_of_nat_def
157.61 +apply (rule exI [where x="nat (floor r + 1)"])
157.62 +apply (insert floor_correct [of r])
157.63 +apply (simp add: nat_add_distrib of_nat_nat)
157.64 done
157.65
157.66 lemma reals_Archimedean6a: "0 \<le> r ==> \<exists>n. real (n) \<le> r & r < real (Suc n)"
157.67 @@ -414,19 +409,11 @@
157.68
157.69 lemma reals_Archimedean_6b_int:
157.70 "0 \<le> r ==> \<exists>n::int. real n \<le> r & r < real (n+1)"
157.71 -apply (drule reals_Archimedean6a, auto)
157.72 -apply (rule_tac x = "int n" in exI)
157.73 -apply (simp add: real_of_int_real_of_nat real_of_nat_Suc)
157.74 -done
157.75 + unfolding real_of_int_def by (rule floor_exists)
157.76
157.77 lemma reals_Archimedean_6c_int:
157.78 "r < 0 ==> \<exists>n::int. real n \<le> r & r < real (n+1)"
157.79 -apply (rule reals_Archimedean_6b_int [of "-r", THEN exE], simp, auto)
157.80 -apply (rename_tac n)
157.81 -apply (drule order_le_imp_less_or_eq, auto)
157.82 -apply (rule_tac x = "- n - 1" in exI)
157.83 -apply (rule_tac [2] x = "- n" in exI, auto)
157.84 -done
157.85 + unfolding real_of_int_def by (rule floor_exists)
157.86
157.87
157.88 subsection{*Density of the Rational Reals in the Reals*}
157.89 @@ -485,23 +472,6 @@
157.90
157.91 subsection{*Floor and Ceiling Functions from the Reals to the Integers*}
157.92
157.93 -definition
157.94 - floor :: "real => int" where
157.95 - [code del]: "floor r = (LEAST n::int. r < real (n+1))"
157.96 -
157.97 -definition
157.98 - ceiling :: "real => int" where
157.99 - "ceiling r = - floor (- r)"
157.100 -
157.101 -notation (xsymbols)
157.102 - floor ("\<lfloor>_\<rfloor>") and
157.103 - ceiling ("\<lceil>_\<rceil>")
157.104 -
157.105 -notation (HTML output)
157.106 - floor ("\<lfloor>_\<rfloor>") and
157.107 - ceiling ("\<lceil>_\<rceil>")
157.108 -
157.109 -
157.110 lemma number_of_less_real_of_int_iff [simp]:
157.111 "((number_of n) < real (m::int)) = (number_of n < m)"
157.112 apply auto
157.113 @@ -524,51 +494,23 @@
157.114 "(real (m::int) \<le> (number_of n)) = (m \<le> number_of n)"
157.115 by (simp add: linorder_not_less [symmetric])
157.116
157.117 -lemma floor_zero [simp]: "floor 0 = 0"
157.118 -apply (simp add: floor_def del: real_of_int_add)
157.119 -apply (rule Least_equality)
157.120 -apply simp_all
157.121 -done
157.122 -
157.123 -lemma floor_real_of_nat_zero [simp]: "floor (real (0::nat)) = 0"
157.124 -by auto
157.125 +lemma floor_real_of_nat_zero: "floor (real (0::nat)) = 0"
157.126 +by auto (* delete? *)
157.127
157.128 lemma floor_real_of_nat [simp]: "floor (real (n::nat)) = int n"
157.129 -apply (simp only: floor_def)
157.130 -apply (rule Least_equality)
157.131 -apply (drule_tac [2] real_of_int_of_nat_eq [THEN ssubst])
157.132 -apply (drule_tac [2] real_of_int_less_iff [THEN iffD1])
157.133 -apply simp_all
157.134 -done
157.135 +unfolding real_of_nat_def by simp
157.136
157.137 lemma floor_minus_real_of_nat [simp]: "floor (- real (n::nat)) = - int n"
157.138 -apply (simp only: floor_def)
157.139 -apply (rule Least_equality)
157.140 -apply (drule_tac [2] real_of_int_of_nat_eq [THEN ssubst])
157.141 -apply (drule_tac [2] real_of_int_minus [THEN sym, THEN subst])
157.142 -apply (drule_tac [2] real_of_int_less_iff [THEN iffD1])
157.143 -apply simp_all
157.144 -done
157.145 +unfolding real_of_nat_def by (simp add: floor_minus)
157.146
157.147 lemma floor_real_of_int [simp]: "floor (real (n::int)) = n"
157.148 -apply (simp only: floor_def)
157.149 -apply (rule Least_equality)
157.150 -apply auto
157.151 -done
157.152 +unfolding real_of_int_def by simp
157.153
157.154 lemma floor_minus_real_of_int [simp]: "floor (- real (n::int)) = - n"
157.155 -apply (simp only: floor_def)
157.156 -apply (rule Least_equality)
157.157 -apply (drule_tac [2] real_of_int_minus [THEN sym, THEN subst])
157.158 -apply auto
157.159 -done
157.160 +unfolding real_of_int_def by (simp add: floor_minus)
157.161
157.162 lemma real_lb_ub_int: " \<exists>n::int. real n \<le> r & r < real (n+1)"
157.163 -apply (case_tac "r < 0")
157.164 -apply (blast intro: reals_Archimedean_6c_int)
157.165 -apply (simp only: linorder_not_less)
157.166 -apply (blast intro: reals_Archimedean_6b_int reals_Archimedean_6c_int)
157.167 -done
157.168 +unfolding real_of_int_def by (rule floor_exists)
157.169
157.170 lemma lemma_floor:
157.171 assumes a1: "real m \<le> r" and a2: "r < real n + 1"
157.172 @@ -581,48 +523,20 @@
157.173 qed
157.174
157.175 lemma real_of_int_floor_le [simp]: "real (floor r) \<le> r"
157.176 -apply (simp add: floor_def Least_def)
157.177 -apply (insert real_lb_ub_int [of r], safe)
157.178 -apply (rule theI2)
157.179 -apply auto
157.180 -done
157.181 -
157.182 -lemma floor_mono: "x < y ==> floor x \<le> floor y"
157.183 -apply (simp add: floor_def Least_def)
157.184 -apply (insert real_lb_ub_int [of x])
157.185 -apply (insert real_lb_ub_int [of y], safe)
157.186 -apply (rule theI2)
157.187 -apply (rule_tac [3] theI2)
157.188 -apply simp
157.189 -apply (erule conjI)
157.190 -apply (auto simp add: order_eq_iff int_le_real_less)
157.191 -done
157.192 -
157.193 -lemma floor_mono2: "x \<le> y ==> floor x \<le> floor y"
157.194 -by (auto dest: order_le_imp_less_or_eq simp add: floor_mono)
157.195 +unfolding real_of_int_def by (rule of_int_floor_le)
157.196
157.197 lemma lemma_floor2: "real n < real (x::int) + 1 ==> n \<le> x"
157.198 by (auto intro: lemma_floor)
157.199
157.200 lemma real_of_int_floor_cancel [simp]:
157.201 "(real (floor x) = x) = (\<exists>n::int. x = real n)"
157.202 -apply (simp add: floor_def Least_def)
157.203 -apply (insert real_lb_ub_int [of x], erule exE)
157.204 -apply (rule theI2)
157.205 -apply (auto intro: lemma_floor)
157.206 -done
157.207 + using floor_real_of_int by metis
157.208
157.209 lemma floor_eq: "[| real n < x; x < real n + 1 |] ==> floor x = n"
157.210 -apply (simp add: floor_def)
157.211 -apply (rule Least_equality)
157.212 -apply (auto intro: lemma_floor)
157.213 -done
157.214 + unfolding real_of_int_def using floor_unique [of n x] by simp
157.215
157.216 lemma floor_eq2: "[| real n \<le> x; x < real n + 1 |] ==> floor x = n"
157.217 -apply (simp add: floor_def)
157.218 -apply (rule Least_equality)
157.219 -apply (auto intro: lemma_floor)
157.220 -done
157.221 + unfolding real_of_int_def by (rule floor_unique)
157.222
157.223 lemma floor_eq3: "[| real n < x; x < real (Suc n) |] ==> nat(floor x) = n"
157.224 apply (rule inj_int [THEN injD])
157.225 @@ -635,353 +549,205 @@
157.226 apply (auto intro: floor_eq3)
157.227 done
157.228
157.229 -lemma floor_number_of_eq [simp]:
157.230 +lemma floor_number_of_eq:
157.231 "floor(number_of n :: real) = (number_of n :: int)"
157.232 -apply (subst real_number_of [symmetric])
157.233 -apply (rule floor_real_of_int)
157.234 -done
157.235 -
157.236 -lemma floor_one [simp]: "floor 1 = 1"
157.237 - apply (rule trans)
157.238 - prefer 2
157.239 - apply (rule floor_real_of_int)
157.240 - apply simp
157.241 -done
157.242 + by (rule floor_number_of) (* already declared [simp] *)
157.243
157.244 lemma real_of_int_floor_ge_diff_one [simp]: "r - 1 \<le> real(floor r)"
157.245 -apply (simp add: floor_def Least_def)
157.246 -apply (insert real_lb_ub_int [of r], safe)
157.247 -apply (rule theI2)
157.248 -apply (auto intro: lemma_floor)
157.249 -done
157.250 + unfolding real_of_int_def using floor_correct [of r] by simp
157.251
157.252 lemma real_of_int_floor_gt_diff_one [simp]: "r - 1 < real(floor r)"
157.253 -apply (simp add: floor_def Least_def)
157.254 -apply (insert real_lb_ub_int [of r], safe)
157.255 -apply (rule theI2)
157.256 -apply (auto intro: lemma_floor)
157.257 -done
157.258 + unfolding real_of_int_def using floor_correct [of r] by simp
157.259
157.260 lemma real_of_int_floor_add_one_ge [simp]: "r \<le> real(floor r) + 1"
157.261 -apply (insert real_of_int_floor_ge_diff_one [of r])
157.262 -apply (auto simp del: real_of_int_floor_ge_diff_one)
157.263 -done
157.264 + unfolding real_of_int_def using floor_correct [of r] by simp
157.265
157.266 lemma real_of_int_floor_add_one_gt [simp]: "r < real(floor r) + 1"
157.267 -apply (insert real_of_int_floor_gt_diff_one [of r])
157.268 -apply (auto simp del: real_of_int_floor_gt_diff_one)
157.269 -done
157.270 + unfolding real_of_int_def using floor_correct [of r] by simp
157.271
157.272 lemma le_floor: "real a <= x ==> a <= floor x"
157.273 - apply (subgoal_tac "a < floor x + 1")
157.274 - apply arith
157.275 - apply (subst real_of_int_less_iff [THEN sym])
157.276 - apply simp
157.277 - apply (insert real_of_int_floor_add_one_gt [of x])
157.278 - apply arith
157.279 -done
157.280 + unfolding real_of_int_def by (simp add: le_floor_iff)
157.281
157.282 lemma real_le_floor: "a <= floor x ==> real a <= x"
157.283 - apply (rule order_trans)
157.284 - prefer 2
157.285 - apply (rule real_of_int_floor_le)
157.286 - apply (subst real_of_int_le_iff)
157.287 - apply assumption
157.288 -done
157.289 + unfolding real_of_int_def by (simp add: le_floor_iff)
157.290
157.291 lemma le_floor_eq: "(a <= floor x) = (real a <= x)"
157.292 - apply (rule iffI)
157.293 - apply (erule real_le_floor)
157.294 - apply (erule le_floor)
157.295 -done
157.296 + unfolding real_of_int_def by (rule le_floor_iff)
157.297
157.298 -lemma le_floor_eq_number_of [simp]:
157.299 +lemma le_floor_eq_number_of:
157.300 "(number_of n <= floor x) = (number_of n <= x)"
157.301 -by (simp add: le_floor_eq)
157.302 + by (rule number_of_le_floor) (* already declared [simp] *)
157.303
157.304 -lemma le_floor_eq_zero [simp]: "(0 <= floor x) = (0 <= x)"
157.305 -by (simp add: le_floor_eq)
157.306 +lemma le_floor_eq_zero: "(0 <= floor x) = (0 <= x)"
157.307 + by (rule zero_le_floor) (* already declared [simp] *)
157.308
157.309 -lemma le_floor_eq_one [simp]: "(1 <= floor x) = (1 <= x)"
157.310 -by (simp add: le_floor_eq)
157.311 +lemma le_floor_eq_one: "(1 <= floor x) = (1 <= x)"
157.312 + by (rule one_le_floor) (* already declared [simp] *)
157.313
157.314 lemma floor_less_eq: "(floor x < a) = (x < real a)"
157.315 - apply (subst linorder_not_le [THEN sym])+
157.316 - apply simp
157.317 - apply (rule le_floor_eq)
157.318 -done
157.319 + unfolding real_of_int_def by (rule floor_less_iff)
157.320
157.321 -lemma floor_less_eq_number_of [simp]:
157.322 +lemma floor_less_eq_number_of:
157.323 "(floor x < number_of n) = (x < number_of n)"
157.324 -by (simp add: floor_less_eq)
157.325 + by (rule floor_less_number_of) (* already declared [simp] *)
157.326
157.327 -lemma floor_less_eq_zero [simp]: "(floor x < 0) = (x < 0)"
157.328 -by (simp add: floor_less_eq)
157.329 +lemma floor_less_eq_zero: "(floor x < 0) = (x < 0)"
157.330 + by (rule floor_less_zero) (* already declared [simp] *)
157.331
157.332 -lemma floor_less_eq_one [simp]: "(floor x < 1) = (x < 1)"
157.333 -by (simp add: floor_less_eq)
157.334 +lemma floor_less_eq_one: "(floor x < 1) = (x < 1)"
157.335 + by (rule floor_less_one) (* already declared [simp] *)
157.336
157.337 lemma less_floor_eq: "(a < floor x) = (real a + 1 <= x)"
157.338 - apply (insert le_floor_eq [of "a + 1" x])
157.339 - apply auto
157.340 -done
157.341 + unfolding real_of_int_def by (rule less_floor_iff)
157.342
157.343 -lemma less_floor_eq_number_of [simp]:
157.344 +lemma less_floor_eq_number_of:
157.345 "(number_of n < floor x) = (number_of n + 1 <= x)"
157.346 -by (simp add: less_floor_eq)
157.347 + by (rule number_of_less_floor) (* already declared [simp] *)
157.348
157.349 -lemma less_floor_eq_zero [simp]: "(0 < floor x) = (1 <= x)"
157.350 -by (simp add: less_floor_eq)
157.351 +lemma less_floor_eq_zero: "(0 < floor x) = (1 <= x)"
157.352 + by (rule zero_less_floor) (* already declared [simp] *)
157.353
157.354 -lemma less_floor_eq_one [simp]: "(1 < floor x) = (2 <= x)"
157.355 -by (simp add: less_floor_eq)
157.356 +lemma less_floor_eq_one: "(1 < floor x) = (2 <= x)"
157.357 + by (rule one_less_floor) (* already declared [simp] *)
157.358
157.359 lemma floor_le_eq: "(floor x <= a) = (x < real a + 1)"
157.360 - apply (insert floor_less_eq [of x "a + 1"])
157.361 - apply auto
157.362 -done
157.363 + unfolding real_of_int_def by (rule floor_le_iff)
157.364
157.365 -lemma floor_le_eq_number_of [simp]:
157.366 +lemma floor_le_eq_number_of:
157.367 "(floor x <= number_of n) = (x < number_of n + 1)"
157.368 -by (simp add: floor_le_eq)
157.369 + by (rule floor_le_number_of) (* already declared [simp] *)
157.370
157.371 -lemma floor_le_eq_zero [simp]: "(floor x <= 0) = (x < 1)"
157.372 -by (simp add: floor_le_eq)
157.373 +lemma floor_le_eq_zero: "(floor x <= 0) = (x < 1)"
157.374 + by (rule floor_le_zero) (* already declared [simp] *)
157.375
157.376 -lemma floor_le_eq_one [simp]: "(floor x <= 1) = (x < 2)"
157.377 -by (simp add: floor_le_eq)
157.378 +lemma floor_le_eq_one: "(floor x <= 1) = (x < 2)"
157.379 + by (rule floor_le_one) (* already declared [simp] *)
157.380
157.381 lemma floor_add [simp]: "floor (x + real a) = floor x + a"
157.382 - apply (subst order_eq_iff)
157.383 - apply (rule conjI)
157.384 - prefer 2
157.385 - apply (subgoal_tac "floor x + a < floor (x + real a) + 1")
157.386 - apply arith
157.387 - apply (subst real_of_int_less_iff [THEN sym])
157.388 - apply simp
157.389 - apply (subgoal_tac "x + real a < real(floor(x + real a)) + 1")
157.390 - apply (subgoal_tac "real (floor x) <= x")
157.391 - apply arith
157.392 - apply (rule real_of_int_floor_le)
157.393 - apply (rule real_of_int_floor_add_one_gt)
157.394 - apply (subgoal_tac "floor (x + real a) < floor x + a + 1")
157.395 - apply arith
157.396 - apply (subst real_of_int_less_iff [THEN sym])
157.397 - apply simp
157.398 - apply (subgoal_tac "real(floor(x + real a)) <= x + real a")
157.399 - apply (subgoal_tac "x < real(floor x) + 1")
157.400 - apply arith
157.401 - apply (rule real_of_int_floor_add_one_gt)
157.402 - apply (rule real_of_int_floor_le)
157.403 -done
157.404 -
157.405 -lemma floor_add_number_of [simp]:
157.406 - "floor (x + number_of n) = floor x + number_of n"
157.407 - apply (subst floor_add [THEN sym])
157.408 - apply simp
157.409 -done
157.410 -
157.411 -lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
157.412 - apply (subst floor_add [THEN sym])
157.413 - apply simp
157.414 -done
157.415 + unfolding real_of_int_def by (rule floor_add_of_int)
157.416
157.417 lemma floor_subtract [simp]: "floor (x - real a) = floor x - a"
157.418 - apply (subst diff_minus)+
157.419 - apply (subst real_of_int_minus [THEN sym])
157.420 - apply (rule floor_add)
157.421 -done
157.422 + unfolding real_of_int_def by (rule floor_diff_of_int)
157.423
157.424 -lemma floor_subtract_number_of [simp]: "floor (x - number_of n) =
157.425 +lemma floor_subtract_number_of: "floor (x - number_of n) =
157.426 floor x - number_of n"
157.427 - apply (subst floor_subtract [THEN sym])
157.428 - apply simp
157.429 -done
157.430 + by (rule floor_diff_number_of) (* already declared [simp] *)
157.431
157.432 -lemma floor_subtract_one [simp]: "floor (x - 1) = floor x - 1"
157.433 - apply (subst floor_subtract [THEN sym])
157.434 - apply simp
157.435 -done
157.436 -
157.437 -lemma ceiling_zero [simp]: "ceiling 0 = 0"
157.438 -by (simp add: ceiling_def)
157.439 +lemma floor_subtract_one: "floor (x - 1) = floor x - 1"
157.440 + by (rule floor_diff_one) (* already declared [simp] *)
157.441
157.442 lemma ceiling_real_of_nat [simp]: "ceiling (real (n::nat)) = int n"
157.443 -by (simp add: ceiling_def)
157.444 + unfolding real_of_nat_def by simp
157.445
157.446 -lemma ceiling_real_of_nat_zero [simp]: "ceiling (real (0::nat)) = 0"
157.447 -by auto
157.448 +lemma ceiling_real_of_nat_zero: "ceiling (real (0::nat)) = 0"
157.449 +by auto (* delete? *)
157.450
157.451 lemma ceiling_floor [simp]: "ceiling (real (floor r)) = floor r"
157.452 -by (simp add: ceiling_def)
157.453 + unfolding real_of_int_def by simp
157.454
157.455 lemma floor_ceiling [simp]: "floor (real (ceiling r)) = ceiling r"
157.456 -by (simp add: ceiling_def)
157.457 + unfolding real_of_int_def by simp
157.458
157.459 lemma real_of_int_ceiling_ge [simp]: "r \<le> real (ceiling r)"
157.460 -apply (simp add: ceiling_def)
157.461 -apply (subst le_minus_iff, simp)
157.462 -done
157.463 + unfolding real_of_int_def by (rule le_of_int_ceiling)
157.464
157.465 -lemma ceiling_mono: "x < y ==> ceiling x \<le> ceiling y"
157.466 -by (simp add: floor_mono ceiling_def)
157.467 -
157.468 -lemma ceiling_mono2: "x \<le> y ==> ceiling x \<le> ceiling y"
157.469 -by (simp add: floor_mono2 ceiling_def)
157.470 +lemma ceiling_real_of_int [simp]: "ceiling (real (n::int)) = n"
157.471 + unfolding real_of_int_def by simp
157.472
157.473 lemma real_of_int_ceiling_cancel [simp]:
157.474 "(real (ceiling x) = x) = (\<exists>n::int. x = real n)"
157.475 -apply (auto simp add: ceiling_def)
157.476 -apply (drule arg_cong [where f = uminus], auto)
157.477 -apply (rule_tac x = "-n" in exI, auto)
157.478 -done
157.479 + using ceiling_real_of_int by metis
157.480
157.481 lemma ceiling_eq: "[| real n < x; x < real n + 1 |] ==> ceiling x = n + 1"
157.482 -apply (simp add: ceiling_def)
157.483 -apply (rule minus_equation_iff [THEN iffD1])
157.484 -apply (simp add: floor_eq [where n = "-(n+1)"])
157.485 -done
157.486 + unfolding real_of_int_def using ceiling_unique [of "n + 1" x] by simp
157.487
157.488 lemma ceiling_eq2: "[| real n < x; x \<le> real n + 1 |] ==> ceiling x = n + 1"
157.489 -by (simp add: ceiling_def floor_eq2 [where n = "-(n+1)"])
157.490 + unfolding real_of_int_def using ceiling_unique [of "n + 1" x] by simp
157.491
157.492 lemma ceiling_eq3: "[| real n - 1 < x; x \<le> real n |] ==> ceiling x = n"
157.493 -by (simp add: ceiling_def floor_eq2 [where n = "-n"])
157.494 + unfolding real_of_int_def using ceiling_unique [of n x] by simp
157.495
157.496 -lemma ceiling_real_of_int [simp]: "ceiling (real (n::int)) = n"
157.497 -by (simp add: ceiling_def)
157.498 -
157.499 -lemma ceiling_number_of_eq [simp]:
157.500 +lemma ceiling_number_of_eq:
157.501 "ceiling (number_of n :: real) = (number_of n)"
157.502 -apply (subst real_number_of [symmetric])
157.503 -apply (rule ceiling_real_of_int)
157.504 -done
157.505 -
157.506 -lemma ceiling_one [simp]: "ceiling 1 = 1"
157.507 - by (unfold ceiling_def, simp)
157.508 + by (rule ceiling_number_of) (* already declared [simp] *)
157.509
157.510 lemma real_of_int_ceiling_diff_one_le [simp]: "real (ceiling r) - 1 \<le> r"
157.511 -apply (rule neg_le_iff_le [THEN iffD1])
157.512 -apply (simp add: ceiling_def diff_minus)
157.513 -done
157.514 + unfolding real_of_int_def using ceiling_correct [of r] by simp
157.515
157.516 lemma real_of_int_ceiling_le_add_one [simp]: "real (ceiling r) \<le> r + 1"
157.517 -apply (insert real_of_int_ceiling_diff_one_le [of r])
157.518 -apply (simp del: real_of_int_ceiling_diff_one_le)
157.519 -done
157.520 + unfolding real_of_int_def using ceiling_correct [of r] by simp
157.521
157.522 lemma ceiling_le: "x <= real a ==> ceiling x <= a"
157.523 - apply (unfold ceiling_def)
157.524 - apply (subgoal_tac "-a <= floor(- x)")
157.525 - apply simp
157.526 - apply (rule le_floor)
157.527 - apply simp
157.528 -done
157.529 + unfolding real_of_int_def by (simp add: ceiling_le_iff)
157.530
157.531 lemma ceiling_le_real: "ceiling x <= a ==> x <= real a"
157.532 - apply (unfold ceiling_def)
157.533 - apply (subgoal_tac "real(- a) <= - x")
157.534 - apply simp
157.535 - apply (rule real_le_floor)
157.536 - apply simp
157.537 -done
157.538 + unfolding real_of_int_def by (simp add: ceiling_le_iff)
157.539
157.540 lemma ceiling_le_eq: "(ceiling x <= a) = (x <= real a)"
157.541 - apply (rule iffI)
157.542 - apply (erule ceiling_le_real)
157.543 - apply (erule ceiling_le)
157.544 -done
157.545 + unfolding real_of_int_def by (rule ceiling_le_iff)
157.546
157.547 -lemma ceiling_le_eq_number_of [simp]:
157.548 +lemma ceiling_le_eq_number_of:
157.549 "(ceiling x <= number_of n) = (x <= number_of n)"
157.550 -by (simp add: ceiling_le_eq)
157.551 + by (rule ceiling_le_number_of) (* already declared [simp] *)
157.552
157.553 -lemma ceiling_le_zero_eq [simp]: "(ceiling x <= 0) = (x <= 0)"
157.554 -by (simp add: ceiling_le_eq)
157.555 +lemma ceiling_le_zero_eq: "(ceiling x <= 0) = (x <= 0)"
157.556 + by (rule ceiling_le_zero) (* already declared [simp] *)
157.557
157.558 -lemma ceiling_le_eq_one [simp]: "(ceiling x <= 1) = (x <= 1)"
157.559 -by (simp add: ceiling_le_eq)
157.560 +lemma ceiling_le_eq_one: "(ceiling x <= 1) = (x <= 1)"
157.561 + by (rule ceiling_le_one) (* already declared [simp] *)
157.562
157.563 lemma less_ceiling_eq: "(a < ceiling x) = (real a < x)"
157.564 - apply (subst linorder_not_le [THEN sym])+
157.565 - apply simp
157.566 - apply (rule ceiling_le_eq)
157.567 -done
157.568 + unfolding real_of_int_def by (rule less_ceiling_iff)
157.569
157.570 -lemma less_ceiling_eq_number_of [simp]:
157.571 +lemma less_ceiling_eq_number_of:
157.572 "(number_of n < ceiling x) = (number_of n < x)"
157.573 -by (simp add: less_ceiling_eq)
157.574 + by (rule number_of_less_ceiling) (* already declared [simp] *)
157.575
157.576 -lemma less_ceiling_eq_zero [simp]: "(0 < ceiling x) = (0 < x)"
157.577 -by (simp add: less_ceiling_eq)
157.578 +lemma less_ceiling_eq_zero: "(0 < ceiling x) = (0 < x)"
157.579 + by (rule zero_less_ceiling) (* already declared [simp] *)
157.580
157.581 -lemma less_ceiling_eq_one [simp]: "(1 < ceiling x) = (1 < x)"
157.582 -by (simp add: less_ceiling_eq)
157.583 +lemma less_ceiling_eq_one: "(1 < ceiling x) = (1 < x)"
157.584 + by (rule one_less_ceiling) (* already declared [simp] *)
157.585
157.586 lemma ceiling_less_eq: "(ceiling x < a) = (x <= real a - 1)"
157.587 - apply (insert ceiling_le_eq [of x "a - 1"])
157.588 - apply auto
157.589 -done
157.590 + unfolding real_of_int_def by (rule ceiling_less_iff)
157.591
157.592 -lemma ceiling_less_eq_number_of [simp]:
157.593 +lemma ceiling_less_eq_number_of:
157.594 "(ceiling x < number_of n) = (x <= number_of n - 1)"
157.595 -by (simp add: ceiling_less_eq)
157.596 + by (rule ceiling_less_number_of) (* already declared [simp] *)
157.597
157.598 -lemma ceiling_less_eq_zero [simp]: "(ceiling x < 0) = (x <= -1)"
157.599 -by (simp add: ceiling_less_eq)
157.600 +lemma ceiling_less_eq_zero: "(ceiling x < 0) = (x <= -1)"
157.601 + by (rule ceiling_less_zero) (* already declared [simp] *)
157.602
157.603 -lemma ceiling_less_eq_one [simp]: "(ceiling x < 1) = (x <= 0)"
157.604 -by (simp add: ceiling_less_eq)
157.605 +lemma ceiling_less_eq_one: "(ceiling x < 1) = (x <= 0)"
157.606 + by (rule ceiling_less_one) (* already declared [simp] *)
157.607
157.608 lemma le_ceiling_eq: "(a <= ceiling x) = (real a - 1 < x)"
157.609 - apply (insert less_ceiling_eq [of "a - 1" x])
157.610 - apply auto
157.611 -done
157.612 + unfolding real_of_int_def by (rule le_ceiling_iff)
157.613
157.614 -lemma le_ceiling_eq_number_of [simp]:
157.615 +lemma le_ceiling_eq_number_of:
157.616 "(number_of n <= ceiling x) = (number_of n - 1 < x)"
157.617 -by (simp add: le_ceiling_eq)
157.618 + by (rule number_of_le_ceiling) (* already declared [simp] *)
157.619
157.620 -lemma le_ceiling_eq_zero [simp]: "(0 <= ceiling x) = (-1 < x)"
157.621 -by (simp add: le_ceiling_eq)
157.622 +lemma le_ceiling_eq_zero: "(0 <= ceiling x) = (-1 < x)"
157.623 + by (rule zero_le_ceiling) (* already declared [simp] *)
157.624
157.625 -lemma le_ceiling_eq_one [simp]: "(1 <= ceiling x) = (0 < x)"
157.626 -by (simp add: le_ceiling_eq)
157.627 +lemma le_ceiling_eq_one: "(1 <= ceiling x) = (0 < x)"
157.628 + by (rule one_le_ceiling) (* already declared [simp] *)
157.629
157.630 lemma ceiling_add [simp]: "ceiling (x + real a) = ceiling x + a"
157.631 - apply (unfold ceiling_def, simp)
157.632 - apply (subst real_of_int_minus [THEN sym])
157.633 - apply (subst floor_add)
157.634 - apply simp
157.635 -done
157.636 -
157.637 -lemma ceiling_add_number_of [simp]: "ceiling (x + number_of n) =
157.638 - ceiling x + number_of n"
157.639 - apply (subst ceiling_add [THEN sym])
157.640 - apply simp
157.641 -done
157.642 -
157.643 -lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
157.644 - apply (subst ceiling_add [THEN sym])
157.645 - apply simp
157.646 -done
157.647 + unfolding real_of_int_def by (rule ceiling_add_of_int)
157.648
157.649 lemma ceiling_subtract [simp]: "ceiling (x - real a) = ceiling x - a"
157.650 - apply (subst diff_minus)+
157.651 - apply (subst real_of_int_minus [THEN sym])
157.652 - apply (rule ceiling_add)
157.653 -done
157.654 + unfolding real_of_int_def by (rule ceiling_diff_of_int)
157.655
157.656 -lemma ceiling_subtract_number_of [simp]: "ceiling (x - number_of n) =
157.657 +lemma ceiling_subtract_number_of: "ceiling (x - number_of n) =
157.658 ceiling x - number_of n"
157.659 - apply (subst ceiling_subtract [THEN sym])
157.660 - apply simp
157.661 -done
157.662 + by (rule ceiling_diff_number_of) (* already declared [simp] *)
157.663
157.664 -lemma ceiling_subtract_one [simp]: "ceiling (x - 1) = ceiling x - 1"
157.665 - apply (subst ceiling_subtract [THEN sym])
157.666 - apply simp
157.667 -done
157.668 +lemma ceiling_subtract_one: "ceiling (x - 1) = ceiling x - 1"
157.669 + by (rule ceiling_diff_one) (* already declared [simp] *)
157.670 +
157.671
157.672 subsection {* Versions for the natural numbers *}
157.673
157.674 @@ -1015,7 +781,7 @@
157.675 apply (unfold natfloor_def)
157.676 apply (subgoal_tac "floor x <= floor 0")
157.677 apply simp
157.678 - apply (erule floor_mono2)
157.679 + apply (erule floor_mono)
157.680 done
157.681
157.682 lemma natfloor_mono: "x <= y ==> natfloor x <= natfloor y"
157.683 @@ -1023,7 +789,7 @@
157.684 apply (subst natfloor_def)+
157.685 apply (subst nat_le_eq_zle)
157.686 apply force
157.687 - apply (erule floor_mono2)
157.688 + apply (erule floor_mono)
157.689 apply (subst natfloor_neg)
157.690 apply simp
157.691 apply simp
157.692 @@ -1144,7 +910,7 @@
157.693 apply (subst real_nat_eq_real)
157.694 apply (subgoal_tac "ceiling 0 <= ceiling x")
157.695 apply simp
157.696 - apply (rule ceiling_mono2)
157.697 + apply (rule ceiling_mono)
157.698 apply simp
157.699 apply simp
157.700 done
157.701 @@ -1165,7 +931,7 @@
157.702 apply simp
157.703 apply (erule order_trans)
157.704 apply simp
157.705 - apply (erule ceiling_mono2)
157.706 + apply (erule ceiling_mono)
157.707 apply (subst natceiling_neg)
157.708 apply simp_all
157.709 done
157.710 @@ -1215,7 +981,7 @@
157.711 apply (subst eq_nat_nat_iff)
157.712 apply (subgoal_tac "ceiling 0 <= ceiling x")
157.713 apply simp
157.714 - apply (rule ceiling_mono2)
157.715 + apply (rule ceiling_mono)
157.716 apply force
157.717 apply force
157.718 apply (rule ceiling_eq2)
157.719 @@ -1233,7 +999,7 @@
157.720 apply (subst nat_add_distrib)
157.721 apply (subgoal_tac "0 = ceiling 0")
157.722 apply (erule ssubst)
157.723 - apply (erule ceiling_mono2)
157.724 + apply (erule ceiling_mono)
157.725 apply simp_all
157.726 done
157.727
158.1 --- a/src/HOL/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
158.2 +++ b/src/HOL/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
158.3 @@ -1,7 +1,5 @@
158.4 (* Classical Higher-order Logic -- batteries included *)
158.5
158.6 -use_thy "Main";
158.7 -share_common_data ();
158.8 use_thy "Complex_Main";
158.9
158.10 val HOL_proofs = ! Proofterm.proofs;
159.1 --- a/src/HOL/Rational.thy Wed Mar 04 10:43:39 2009 +0100
159.2 +++ b/src/HOL/Rational.thy Wed Mar 04 10:45:52 2009 +0100
159.3 @@ -5,7 +5,7 @@
159.4 header {* Rational numbers *}
159.5
159.6 theory Rational
159.7 -imports GCD
159.8 +imports GCD Archimedean_Field
159.9 uses ("Tools/rat_arith.ML")
159.10 begin
159.11
159.12 @@ -21,8 +21,8 @@
159.13 "(x, y) \<in> ratrel \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
159.14 by (simp add: ratrel_def)
159.15
159.16 -lemma refl_ratrel: "refl {x. snd x \<noteq> 0} ratrel"
159.17 - by (auto simp add: refl_def ratrel_def)
159.18 +lemma refl_on_ratrel: "refl_on {x. snd x \<noteq> 0} ratrel"
159.19 + by (auto simp add: refl_on_def ratrel_def)
159.20
159.21 lemma sym_ratrel: "sym ratrel"
159.22 by (simp add: ratrel_def sym_def)
159.23 @@ -44,7 +44,7 @@
159.24 qed
159.25
159.26 lemma equiv_ratrel: "equiv {x. snd x \<noteq> 0} ratrel"
159.27 - by (rule equiv.intro [OF refl_ratrel sym_ratrel trans_ratrel])
159.28 + by (rule equiv.intro [OF refl_on_ratrel sym_ratrel trans_ratrel])
159.29
159.30 lemmas UN_ratrel = UN_equiv_class [OF equiv_ratrel]
159.31 lemmas UN_ratrel2 = UN_equiv_class2 [OF equiv_ratrel equiv_ratrel]
159.32 @@ -255,7 +255,6 @@
159.33 with `b \<noteq> 0` have "a \<noteq> 0" by (simp add: Zero_rat_def eq_rat)
159.34 with Fract `q = Fract a b` `b \<noteq> 0` show C by auto
159.35 qed
159.36 -
159.37
159.38
159.39 subsubsection {* The field of rational numbers *}
159.40 @@ -532,8 +531,67 @@
159.41 qed
159.42
159.43 lemma zero_less_Fract_iff:
159.44 - "0 < b ==> (0 < Fract a b) = (0 < a)"
159.45 -by (simp add: Zero_rat_def order_less_imp_not_eq2 zero_less_mult_iff)
159.46 + "0 < b \<Longrightarrow> 0 < Fract a b \<longleftrightarrow> 0 < a"
159.47 + by (simp add: Zero_rat_def zero_less_mult_iff)
159.48 +
159.49 +lemma Fract_less_zero_iff:
159.50 + "0 < b \<Longrightarrow> Fract a b < 0 \<longleftrightarrow> a < 0"
159.51 + by (simp add: Zero_rat_def mult_less_0_iff)
159.52 +
159.53 +lemma zero_le_Fract_iff:
159.54 + "0 < b \<Longrightarrow> 0 \<le> Fract a b \<longleftrightarrow> 0 \<le> a"
159.55 + by (simp add: Zero_rat_def zero_le_mult_iff)
159.56 +
159.57 +lemma Fract_le_zero_iff:
159.58 + "0 < b \<Longrightarrow> Fract a b \<le> 0 \<longleftrightarrow> a \<le> 0"
159.59 + by (simp add: Zero_rat_def mult_le_0_iff)
159.60 +
159.61 +lemma one_less_Fract_iff:
159.62 + "0 < b \<Longrightarrow> 1 < Fract a b \<longleftrightarrow> b < a"
159.63 + by (simp add: One_rat_def mult_less_cancel_right_disj)
159.64 +
159.65 +lemma Fract_less_one_iff:
159.66 + "0 < b \<Longrightarrow> Fract a b < 1 \<longleftrightarrow> a < b"
159.67 + by (simp add: One_rat_def mult_less_cancel_right_disj)
159.68 +
159.69 +lemma one_le_Fract_iff:
159.70 + "0 < b \<Longrightarrow> 1 \<le> Fract a b \<longleftrightarrow> b \<le> a"
159.71 + by (simp add: One_rat_def mult_le_cancel_right)
159.72 +
159.73 +lemma Fract_le_one_iff:
159.74 + "0 < b \<Longrightarrow> Fract a b \<le> 1 \<longleftrightarrow> a \<le> b"
159.75 + by (simp add: One_rat_def mult_le_cancel_right)
159.76 +
159.77 +
159.78 +subsubsection {* Rationals are an Archimedean field *}
159.79 +
159.80 +lemma rat_floor_lemma:
159.81 + assumes "0 < b"
159.82 + shows "of_int (a div b) \<le> Fract a b \<and> Fract a b < of_int (a div b + 1)"
159.83 +proof -
159.84 + have "Fract a b = of_int (a div b) + Fract (a mod b) b"
159.85 + using `0 < b` by (simp add: of_int_rat)
159.86 + moreover have "0 \<le> Fract (a mod b) b \<and> Fract (a mod b) b < 1"
159.87 + using `0 < b` by (simp add: zero_le_Fract_iff Fract_less_one_iff)
159.88 + ultimately show ?thesis by simp
159.89 +qed
159.90 +
159.91 +instance rat :: archimedean_field
159.92 +proof
159.93 + fix r :: rat
159.94 + show "\<exists>z. r \<le> of_int z"
159.95 + proof (induct r)
159.96 + case (Fract a b)
159.97 + then have "Fract a b \<le> of_int (a div b + 1)"
159.98 + using rat_floor_lemma [of b a] by simp
159.99 + then show "\<exists>z. Fract a b \<le> of_int z" ..
159.100 + qed
159.101 +qed
159.102 +
159.103 +lemma floor_Fract:
159.104 + assumes "0 < b" shows "floor (Fract a b) = a div b"
159.105 + using rat_floor_lemma [OF `0 < b`, of a]
159.106 + by (simp add: floor_unique)
159.107
159.108
159.109 subsection {* Arithmetic setup *}
160.1 --- a/src/HOL/RealDef.thy Wed Mar 04 10:43:39 2009 +0100
160.2 +++ b/src/HOL/RealDef.thy Wed Mar 04 10:45:52 2009 +0100
160.3 @@ -94,7 +94,7 @@
160.4 by (simp add: realrel_def)
160.5
160.6 lemma equiv_realrel: "equiv UNIV realrel"
160.7 -apply (auto simp add: equiv_def refl_def sym_def trans_def realrel_def)
160.8 +apply (auto simp add: equiv_def refl_on_def sym_def trans_def realrel_def)
160.9 apply (blast dest: preal_trans_lemma)
160.10 done
160.11
160.12 @@ -655,7 +655,7 @@
160.13 real(n div d) = real n / real d"
160.14 apply (frule real_of_int_div_aux [of d n])
160.15 apply simp
160.16 - apply (simp add: zdvd_iff_zmod_eq_0)
160.17 + apply (simp add: dvd_eq_mod_eq_0)
160.18 done
160.19
160.20 lemma real_of_int_div2:
160.21 @@ -705,6 +705,9 @@
160.22 lemma real_of_nat_zero [simp]: "real (0::nat) = 0"
160.23 by (simp add: real_of_nat_def)
160.24
160.25 +lemma real_of_nat_1 [simp]: "real (1::nat) = 1"
160.26 +by (simp add: real_of_nat_def)
160.27 +
160.28 lemma real_of_nat_one [simp]: "real (Suc 0) = (1::real)"
160.29 by (simp add: real_of_nat_def)
160.30
161.1 --- a/src/HOL/RealPow.thy Wed Mar 04 10:43:39 2009 +0100
161.2 +++ b/src/HOL/RealPow.thy Wed Mar 04 10:45:52 2009 +0100
161.3 @@ -44,7 +44,8 @@
161.4 by (insert power_decreasing [of 1 "Suc n" r], simp)
161.5
161.6 lemma realpow_minus_mult [rule_format]:
161.7 - "0 < n --> (x::real) ^ (n - 1) * x = x ^ n"
161.8 + "0 < n --> (x::real) ^ (n - 1) * x = x ^ n"
161.9 +unfolding One_nat_def
161.10 apply (simp split add: nat_diff_split)
161.11 done
161.12
162.1 --- a/src/HOL/RealVector.thy Wed Mar 04 10:43:39 2009 +0100
162.2 +++ b/src/HOL/RealVector.thy Wed Mar 04 10:45:52 2009 +0100
162.3 @@ -46,8 +46,10 @@
162.4
162.5 locale vector_space =
162.6 fixes scale :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b"
162.7 - assumes scale_right_distrib: "scale a (x + y) = scale a x + scale a y"
162.8 - and scale_left_distrib: "scale (a + b) x = scale a x + scale b x"
162.9 + assumes scale_right_distrib [algebra_simps]:
162.10 + "scale a (x + y) = scale a x + scale a y"
162.11 + and scale_left_distrib [algebra_simps]:
162.12 + "scale (a + b) x = scale a x + scale b x"
162.13 and scale_scale [simp]: "scale a (scale b x) = scale (a * b) x"
162.14 and scale_one [simp]: "scale 1 x = x"
162.15 begin
162.16 @@ -58,7 +60,8 @@
162.17
162.18 lemma scale_zero_left [simp]: "scale 0 x = 0"
162.19 and scale_minus_left [simp]: "scale (- a) x = - (scale a x)"
162.20 - and scale_left_diff_distrib: "scale (a - b) x = scale a x - scale b x"
162.21 + and scale_left_diff_distrib [algebra_simps]:
162.22 + "scale (a - b) x = scale a x - scale b x"
162.23 proof -
162.24 interpret s: additive "\<lambda>a. scale a x"
162.25 proof qed (rule scale_left_distrib)
162.26 @@ -69,7 +72,8 @@
162.27
162.28 lemma scale_zero_right [simp]: "scale a 0 = 0"
162.29 and scale_minus_right [simp]: "scale a (- x) = - (scale a x)"
162.30 - and scale_right_diff_distrib: "scale a (x - y) = scale a x - scale a y"
162.31 + and scale_right_diff_distrib [algebra_simps]:
162.32 + "scale a (x - y) = scale a x - scale a y"
162.33 proof -
162.34 interpret s: additive "\<lambda>x. scale a x"
162.35 proof qed (rule scale_right_distrib)
162.36 @@ -135,21 +139,11 @@
162.37
162.38 end
162.39
162.40 -instantiation real :: scaleR
162.41 -begin
162.42 -
162.43 -definition
162.44 - real_scaleR_def [simp]: "scaleR a x = a * x"
162.45 -
162.46 -instance ..
162.47 -
162.48 -end
162.49 -
162.50 class real_vector = scaleR + ab_group_add +
162.51 assumes scaleR_right_distrib: "scaleR a (x + y) = scaleR a x + scaleR a y"
162.52 and scaleR_left_distrib: "scaleR (a + b) x = scaleR a x + scaleR b x"
162.53 - and scaleR_scaleR [simp]: "scaleR a (scaleR b x) = scaleR (a * b) x"
162.54 - and scaleR_one [simp]: "scaleR 1 x = x"
162.55 + and scaleR_scaleR: "scaleR a (scaleR b x) = scaleR (a * b) x"
162.56 + and scaleR_one: "scaleR 1 x = x"
162.57
162.58 interpretation real_vector!:
162.59 vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a::real_vector"
162.60 @@ -185,15 +179,16 @@
162.61
162.62 class real_field = real_div_algebra + field
162.63
162.64 -instance real :: real_field
162.65 -apply (intro_classes, unfold real_scaleR_def)
162.66 -apply (rule right_distrib)
162.67 -apply (rule left_distrib)
162.68 -apply (rule mult_assoc [symmetric])
162.69 -apply (rule mult_1_left)
162.70 -apply (rule mult_assoc)
162.71 -apply (rule mult_left_commute)
162.72 -done
162.73 +instantiation real :: real_field
162.74 +begin
162.75 +
162.76 +definition
162.77 + real_scaleR_def [simp]: "scaleR a x = a * x"
162.78 +
162.79 +instance proof
162.80 +qed (simp_all add: algebra_simps)
162.81 +
162.82 +end
162.83
162.84 interpretation scaleR_left!: additive "(\<lambda>a. scaleR a x::'a::real_vector)"
162.85 proof qed (rule scaleR_left_distrib)
162.86 @@ -307,7 +302,7 @@
162.87
162.88 definition
162.89 Reals :: "'a::real_algebra_1 set" where
162.90 - [code del]: "Reals \<equiv> range of_real"
162.91 + [code del]: "Reals = range of_real"
162.92
162.93 notation (xsymbols)
162.94 Reals ("\<real>")
162.95 @@ -421,16 +416,6 @@
162.96 class norm =
162.97 fixes norm :: "'a \<Rightarrow> real"
162.98
162.99 -instantiation real :: norm
162.100 -begin
162.101 -
162.102 -definition
162.103 - real_norm_def [simp]: "norm r \<equiv> \<bar>r\<bar>"
162.104 -
162.105 -instance ..
162.106 -
162.107 -end
162.108 -
162.109 class sgn_div_norm = scaleR + norm + sgn +
162.110 assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x"
162.111
162.112 @@ -462,7 +447,13 @@
162.113 thus "norm (1::'a) = 1" by simp
162.114 qed
162.115
162.116 -instance real :: real_normed_field
162.117 +instantiation real :: real_normed_field
162.118 +begin
162.119 +
162.120 +definition
162.121 + real_norm_def [simp]: "norm r = \<bar>r\<bar>"
162.122 +
162.123 +instance
162.124 apply (intro_classes, unfold real_norm_def real_scaleR_def)
162.125 apply (simp add: real_sgn_def)
162.126 apply (rule abs_ge_zero)
162.127 @@ -472,6 +463,8 @@
162.128 apply (rule abs_mult)
162.129 done
162.130
162.131 +end
162.132 +
162.133 lemma norm_zero [simp]: "norm (0::'a::real_normed_vector) = 0"
162.134 by simp
162.135
163.1 --- a/src/HOL/Relation.thy Wed Mar 04 10:43:39 2009 +0100
163.2 +++ b/src/HOL/Relation.thy Wed Mar 04 10:45:52 2009 +0100
163.3 @@ -34,8 +34,8 @@
163.4 "Id == {p. EX x. p = (x,x)}"
163.5
163.6 definition
163.7 - diag :: "'a set => ('a * 'a) set" where -- {* diagonal: identity over a set *}
163.8 - "diag A == \<Union>x\<in>A. {(x,x)}"
163.9 + Id_on :: "'a set => ('a * 'a) set" where -- {* diagonal: identity over a set *}
163.10 + "Id_on A == \<Union>x\<in>A. {(x,x)}"
163.11
163.12 definition
163.13 Domain :: "('a * 'b) set => 'a set" where
163.14 @@ -50,12 +50,12 @@
163.15 "Field r == Domain r \<union> Range r"
163.16
163.17 definition
163.18 - refl :: "['a set, ('a * 'a) set] => bool" where -- {* reflexivity over a set *}
163.19 - "refl A r == r \<subseteq> A \<times> A & (ALL x: A. (x,x) : r)"
163.20 + refl_on :: "['a set, ('a * 'a) set] => bool" where -- {* reflexivity over a set *}
163.21 + "refl_on A r == r \<subseteq> A \<times> A & (ALL x: A. (x,x) : r)"
163.22
163.23 abbreviation
163.24 - reflexive :: "('a * 'a) set => bool" where -- {* reflexivity over a type *}
163.25 - "reflexive == refl UNIV"
163.26 + refl :: "('a * 'a) set => bool" where -- {* reflexivity over a type *}
163.27 + "refl == refl_on UNIV"
163.28
163.29 definition
163.30 sym :: "('a * 'a) set => bool" where -- {* symmetry predicate *}
163.31 @@ -99,8 +99,8 @@
163.32 lemma pair_in_Id_conv [iff]: "((a, b) : Id) = (a = b)"
163.33 by (unfold Id_def) blast
163.34
163.35 -lemma reflexive_Id: "reflexive Id"
163.36 -by (simp add: refl_def)
163.37 +lemma refl_Id: "refl Id"
163.38 +by (simp add: refl_on_def)
163.39
163.40 lemma antisym_Id: "antisym Id"
163.41 -- {* A strange result, since @{text Id} is also symmetric. *}
163.42 @@ -115,24 +115,24 @@
163.43
163.44 subsection {* Diagonal: identity over a set *}
163.45
163.46 -lemma diag_empty [simp]: "diag {} = {}"
163.47 -by (simp add: diag_def)
163.48 +lemma Id_on_empty [simp]: "Id_on {} = {}"
163.49 +by (simp add: Id_on_def)
163.50
163.51 -lemma diag_eqI: "a = b ==> a : A ==> (a, b) : diag A"
163.52 -by (simp add: diag_def)
163.53 +lemma Id_on_eqI: "a = b ==> a : A ==> (a, b) : Id_on A"
163.54 +by (simp add: Id_on_def)
163.55
163.56 -lemma diagI [intro!,noatp]: "a : A ==> (a, a) : diag A"
163.57 -by (rule diag_eqI) (rule refl)
163.58 +lemma Id_onI [intro!,noatp]: "a : A ==> (a, a) : Id_on A"
163.59 +by (rule Id_on_eqI) (rule refl)
163.60
163.61 -lemma diagE [elim!]:
163.62 - "c : diag A ==> (!!x. x : A ==> c = (x, x) ==> P) ==> P"
163.63 +lemma Id_onE [elim!]:
163.64 + "c : Id_on A ==> (!!x. x : A ==> c = (x, x) ==> P) ==> P"
163.65 -- {* The general elimination rule. *}
163.66 -by (unfold diag_def) (iprover elim!: UN_E singletonE)
163.67 +by (unfold Id_on_def) (iprover elim!: UN_E singletonE)
163.68
163.69 -lemma diag_iff: "((x, y) : diag A) = (x = y & x : A)"
163.70 +lemma Id_on_iff: "((x, y) : Id_on A) = (x = y & x : A)"
163.71 by blast
163.72
163.73 -lemma diag_subset_Times: "diag A \<subseteq> A \<times> A"
163.74 +lemma Id_on_subset_Times: "Id_on A \<subseteq> A \<times> A"
163.75 by blast
163.76
163.77
163.78 @@ -184,37 +184,37 @@
163.79
163.80 subsection {* Reflexivity *}
163.81
163.82 -lemma reflI: "r \<subseteq> A \<times> A ==> (!!x. x : A ==> (x, x) : r) ==> refl A r"
163.83 -by (unfold refl_def) (iprover intro!: ballI)
163.84 +lemma refl_onI: "r \<subseteq> A \<times> A ==> (!!x. x : A ==> (x, x) : r) ==> refl_on A r"
163.85 +by (unfold refl_on_def) (iprover intro!: ballI)
163.86
163.87 -lemma reflD: "refl A r ==> a : A ==> (a, a) : r"
163.88 -by (unfold refl_def) blast
163.89 +lemma refl_onD: "refl_on A r ==> a : A ==> (a, a) : r"
163.90 +by (unfold refl_on_def) blast
163.91
163.92 -lemma reflD1: "refl A r ==> (x, y) : r ==> x : A"
163.93 -by (unfold refl_def) blast
163.94 +lemma refl_onD1: "refl_on A r ==> (x, y) : r ==> x : A"
163.95 +by (unfold refl_on_def) blast
163.96
163.97 -lemma reflD2: "refl A r ==> (x, y) : r ==> y : A"
163.98 -by (unfold refl_def) blast
163.99 +lemma refl_onD2: "refl_on A r ==> (x, y) : r ==> y : A"
163.100 +by (unfold refl_on_def) blast
163.101
163.102 -lemma refl_Int: "refl A r ==> refl B s ==> refl (A \<inter> B) (r \<inter> s)"
163.103 -by (unfold refl_def) blast
163.104 +lemma refl_on_Int: "refl_on A r ==> refl_on B s ==> refl_on (A \<inter> B) (r \<inter> s)"
163.105 +by (unfold refl_on_def) blast
163.106
163.107 -lemma refl_Un: "refl A r ==> refl B s ==> refl (A \<union> B) (r \<union> s)"
163.108 -by (unfold refl_def) blast
163.109 +lemma refl_on_Un: "refl_on A r ==> refl_on B s ==> refl_on (A \<union> B) (r \<union> s)"
163.110 +by (unfold refl_on_def) blast
163.111
163.112 -lemma refl_INTER:
163.113 - "ALL x:S. refl (A x) (r x) ==> refl (INTER S A) (INTER S r)"
163.114 -by (unfold refl_def) fast
163.115 +lemma refl_on_INTER:
163.116 + "ALL x:S. refl_on (A x) (r x) ==> refl_on (INTER S A) (INTER S r)"
163.117 +by (unfold refl_on_def) fast
163.118
163.119 -lemma refl_UNION:
163.120 - "ALL x:S. refl (A x) (r x) \<Longrightarrow> refl (UNION S A) (UNION S r)"
163.121 -by (unfold refl_def) blast
163.122 +lemma refl_on_UNION:
163.123 + "ALL x:S. refl_on (A x) (r x) \<Longrightarrow> refl_on (UNION S A) (UNION S r)"
163.124 +by (unfold refl_on_def) blast
163.125
163.126 -lemma refl_empty[simp]: "refl {} {}"
163.127 -by(simp add:refl_def)
163.128 +lemma refl_on_empty[simp]: "refl_on {} {}"
163.129 +by(simp add:refl_on_def)
163.130
163.131 -lemma refl_diag: "refl A (diag A)"
163.132 -by (rule reflI [OF diag_subset_Times diagI])
163.133 +lemma refl_on_Id_on: "refl_on A (Id_on A)"
163.134 +by (rule refl_onI [OF Id_on_subset_Times Id_onI])
163.135
163.136
163.137 subsection {* Antisymmetry *}
163.138 @@ -232,7 +232,7 @@
163.139 lemma antisym_empty [simp]: "antisym {}"
163.140 by (unfold antisym_def) blast
163.141
163.142 -lemma antisym_diag [simp]: "antisym (diag A)"
163.143 +lemma antisym_Id_on [simp]: "antisym (Id_on A)"
163.144 by (unfold antisym_def) blast
163.145
163.146
163.147 @@ -256,7 +256,7 @@
163.148 lemma sym_UNION: "ALL x:S. sym (r x) ==> sym (UNION S r)"
163.149 by (fast intro: symI dest: symD)
163.150
163.151 -lemma sym_diag [simp]: "sym (diag A)"
163.152 +lemma sym_Id_on [simp]: "sym (Id_on A)"
163.153 by (rule symI) clarify
163.154
163.155
163.156 @@ -275,7 +275,7 @@
163.157 lemma trans_INTER: "ALL x:S. trans (r x) ==> trans (INTER S r)"
163.158 by (fast intro: transI elim: transD)
163.159
163.160 -lemma trans_diag [simp]: "trans (diag A)"
163.161 +lemma trans_Id_on [simp]: "trans (Id_on A)"
163.162 by (fast intro: transI elim: transD)
163.163
163.164 lemma trans_diff_Id: " trans r \<Longrightarrow> antisym r \<Longrightarrow> trans (r-Id)"
163.165 @@ -331,11 +331,11 @@
163.166 lemma converse_Id [simp]: "Id^-1 = Id"
163.167 by blast
163.168
163.169 -lemma converse_diag [simp]: "(diag A)^-1 = diag A"
163.170 +lemma converse_Id_on [simp]: "(Id_on A)^-1 = Id_on A"
163.171 by blast
163.172
163.173 -lemma refl_converse [simp]: "refl A (converse r) = refl A r"
163.174 -by (unfold refl_def) auto
163.175 +lemma refl_on_converse [simp]: "refl_on A (converse r) = refl_on A r"
163.176 +by (unfold refl_on_def) auto
163.177
163.178 lemma sym_converse [simp]: "sym (converse r) = sym r"
163.179 by (unfold sym_def) blast
163.180 @@ -382,7 +382,7 @@
163.181 lemma Domain_Id [simp]: "Domain Id = UNIV"
163.182 by blast
163.183
163.184 -lemma Domain_diag [simp]: "Domain (diag A) = A"
163.185 +lemma Domain_Id_on [simp]: "Domain (Id_on A) = A"
163.186 by blast
163.187
163.188 lemma Domain_Un_eq: "Domain(A \<union> B) = Domain(A) \<union> Domain(B)"
163.189 @@ -433,7 +433,7 @@
163.190 lemma Range_Id [simp]: "Range Id = UNIV"
163.191 by blast
163.192
163.193 -lemma Range_diag [simp]: "Range (diag A) = A"
163.194 +lemma Range_Id_on [simp]: "Range (Id_on A) = A"
163.195 by auto
163.196
163.197 lemma Range_Un_eq: "Range(A \<union> B) = Range(A) \<union> Range(B)"
163.198 @@ -506,7 +506,7 @@
163.199 lemma Image_Id [simp]: "Id `` A = A"
163.200 by blast
163.201
163.202 -lemma Image_diag [simp]: "diag A `` B = A \<inter> B"
163.203 +lemma Image_Id_on [simp]: "Id_on A `` B = A \<inter> B"
163.204 by blast
163.205
163.206 lemma Image_Int_subset: "R `` (A \<inter> B) \<subseteq> R `` A \<inter> R `` B"
163.207 @@ -571,7 +571,7 @@
163.208 lemma single_valued_Id [simp]: "single_valued Id"
163.209 by (unfold single_valued_def) blast
163.210
163.211 -lemma single_valued_diag [simp]: "single_valued (diag A)"
163.212 +lemma single_valued_Id_on [simp]: "single_valued (Id_on A)"
163.213 by (unfold single_valued_def) blast
163.214
163.215
164.1 --- a/src/HOL/Relation_Power.thy Wed Mar 04 10:43:39 2009 +0100
164.2 +++ b/src/HOL/Relation_Power.thy Wed Mar 04 10:45:52 2009 +0100
164.3 @@ -61,16 +61,16 @@
164.4
164.5 lemma funpow_swap1: "f((f^n) x) = (f^n)(f x)"
164.6 proof -
164.7 - have "f((f^n) x) = (f^(n+1)) x" by simp
164.8 + have "f((f^n) x) = (f^(n+1)) x" unfolding One_nat_def by simp
164.9 also have "\<dots> = (f^n o f^1) x" by (simp only: funpow_add)
164.10 - also have "\<dots> = (f^n)(f x)" by simp
164.11 + also have "\<dots> = (f^n)(f x)" unfolding One_nat_def by simp
164.12 finally show ?thesis .
164.13 qed
164.14
164.15 lemma rel_pow_1 [simp]:
164.16 fixes R :: "('a*'a)set"
164.17 shows "R^1 = R"
164.18 - by simp
164.19 + unfolding One_nat_def by simp
164.20
164.21 lemma rel_pow_0_I: "(x,x) : R^0"
164.22 by simp
165.1 --- a/src/HOL/Ring_and_Field.thy Wed Mar 04 10:43:39 2009 +0100
165.2 +++ b/src/HOL/Ring_and_Field.thy Wed Mar 04 10:45:52 2009 +0100
165.3 @@ -147,10 +147,10 @@
165.4 lemma one_dvd [simp]: "1 dvd a"
165.5 by (auto intro!: dvdI)
165.6
165.7 -lemma dvd_mult: "a dvd c \<Longrightarrow> a dvd (b * c)"
165.8 +lemma dvd_mult[simp]: "a dvd c \<Longrightarrow> a dvd (b * c)"
165.9 by (auto intro!: mult_left_commute dvdI elim!: dvdE)
165.10
165.11 -lemma dvd_mult2: "a dvd b \<Longrightarrow> a dvd (b * c)"
165.12 +lemma dvd_mult2[simp]: "a dvd b \<Longrightarrow> a dvd (b * c)"
165.13 apply (subst mult_commute)
165.14 apply (erule dvd_mult)
165.15 done
165.16 @@ -162,12 +162,12 @@
165.17 by (rule dvd_mult2) (rule dvd_refl)
165.18
165.19 lemma mult_dvd_mono:
165.20 - assumes ab: "a dvd b"
165.21 - and "cd": "c dvd d"
165.22 + assumes "a dvd b"
165.23 + and "c dvd d"
165.24 shows "a * c dvd b * d"
165.25 proof -
165.26 - from ab obtain b' where "b = a * b'" ..
165.27 - moreover from "cd" obtain d' where "d = c * d'" ..
165.28 + from `a dvd b` obtain b' where "b = a * b'" ..
165.29 + moreover from `c dvd d` obtain d' where "d = c * d'" ..
165.30 ultimately have "b * d = (a * c) * (b' * d')" by (simp add: mult_ac)
165.31 then show ?thesis ..
165.32 qed
165.33 @@ -310,8 +310,8 @@
165.34 then show "- x dvd y" ..
165.35 qed
165.36
165.37 -lemma dvd_diff: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
165.38 -by (simp add: diff_minus dvd_add dvd_minus_iff)
165.39 +lemma dvd_diff[simp]: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
165.40 +by (simp add: diff_minus dvd_minus_iff)
165.41
165.42 end
165.43
165.44 @@ -384,6 +384,26 @@
165.45 then show "a * a = b * b" by auto
165.46 qed
165.47
165.48 +lemma dvd_mult_cancel_right [simp]:
165.49 + "a * c dvd b * c \<longleftrightarrow> c = 0 \<or> a dvd b"
165.50 +proof -
165.51 + have "a * c dvd b * c \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
165.52 + unfolding dvd_def by (simp add: mult_ac)
165.53 + also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
165.54 + unfolding dvd_def by simp
165.55 + finally show ?thesis .
165.56 +qed
165.57 +
165.58 +lemma dvd_mult_cancel_left [simp]:
165.59 + "c * a dvd c * b \<longleftrightarrow> c = 0 \<or> a dvd b"
165.60 +proof -
165.61 + have "c * a dvd c * b \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
165.62 + unfolding dvd_def by (simp add: mult_ac)
165.63 + also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
165.64 + unfolding dvd_def by simp
165.65 + finally show ?thesis .
165.66 +qed
165.67 +
165.68 end
165.69
165.70 class division_ring = ring_1 + inverse +
166.1 --- a/src/HOL/SEQ.thy Wed Mar 04 10:43:39 2009 +0100
166.2 +++ b/src/HOL/SEQ.thy Wed Mar 04 10:45:52 2009 +0100
166.3 @@ -338,10 +338,10 @@
166.4 done
166.5
166.6 lemma LIMSEQ_Suc: "f ----> l \<Longrightarrow> (\<lambda>n. f (Suc n)) ----> l"
166.7 -by (drule_tac k="1" in LIMSEQ_ignore_initial_segment, simp)
166.8 +by (drule_tac k="Suc 0" in LIMSEQ_ignore_initial_segment, simp)
166.9
166.10 lemma LIMSEQ_imp_Suc: "(\<lambda>n. f (Suc n)) ----> l \<Longrightarrow> f ----> l"
166.11 -by (rule_tac k="1" in LIMSEQ_offset, simp)
166.12 +by (rule_tac k="Suc 0" in LIMSEQ_offset, simp)
166.13
166.14 lemma LIMSEQ_Suc_iff: "(\<lambda>n. f (Suc n)) ----> l = f ----> l"
166.15 by (blast intro: LIMSEQ_imp_Suc LIMSEQ_Suc)
166.16 @@ -646,8 +646,21 @@
166.17 apply (drule LIMSEQ_minus, auto)
166.18 done
166.19
166.20 +text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
166.21
166.22 -subsection {* Bounded Monotonic Sequences *}
166.23 +lemma nat_function_unique: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
166.24 + unfolding Ex1_def
166.25 + apply (rule_tac x="nat_rec e f" in exI)
166.26 + apply (rule conjI)+
166.27 +apply (rule def_nat_rec_0, simp)
166.28 +apply (rule allI, rule def_nat_rec_Suc, simp)
166.29 +apply (rule allI, rule impI, rule ext)
166.30 +apply (erule conjE)
166.31 +apply (induct_tac x)
166.32 +apply (simp add: nat_rec_0)
166.33 +apply (erule_tac x="n" in allE)
166.34 +apply (simp)
166.35 +done
166.36
166.37 text{*Subsequence (alternative definition, (e.g. Hoskins)*}
166.38
166.39 @@ -746,6 +759,136 @@
166.40 qed auto
166.41 qed
166.42
166.43 +text{* for any sequence, there is a mootonic subsequence *}
166.44 +lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
166.45 +proof-
166.46 + {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
166.47 + let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
166.48 + from nat_function_unique[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
166.49 + obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
166.50 + have "?P (f 0) 0" unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
166.51 + using H apply -
166.52 + apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI)
166.53 + unfolding order_le_less by blast
166.54 + hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
166.55 + {fix n
166.56 + have "?P (f (Suc n)) (f n)"
166.57 + unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
166.58 + using H apply -
166.59 + apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI)
166.60 + unfolding order_le_less by blast
166.61 + hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
166.62 + note fSuc = this
166.63 + {fix p q assume pq: "p \<ge> f q"
166.64 + have "s p \<le> s(f(q))" using f0(2)[rule_format, of p] pq fSuc
166.65 + by (cases q, simp_all) }
166.66 + note pqth = this
166.67 + {fix q
166.68 + have "f (Suc q) > f q" apply (induct q)
166.69 + using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
166.70 + note fss = this
166.71 + from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
166.72 + {fix a b
166.73 + have "f a \<le> f (a + b)"
166.74 + proof(induct b)
166.75 + case 0 thus ?case by simp
166.76 + next
166.77 + case (Suc b)
166.78 + from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
166.79 + qed}
166.80 + note fmon0 = this
166.81 + have "monoseq (\<lambda>n. s (f n))"
166.82 + proof-
166.83 + {fix n
166.84 + have "s (f n) \<ge> s (f (Suc n))"
166.85 + proof(cases n)
166.86 + case 0
166.87 + assume n0: "n = 0"
166.88 + from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
166.89 + from f0(2)[rule_format, OF th0] show ?thesis using n0 by simp
166.90 + next
166.91 + case (Suc m)
166.92 + assume m: "n = Suc m"
166.93 + from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
166.94 + from m fSuc(2)[rule_format, OF th0] show ?thesis by simp
166.95 + qed}
166.96 + thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast
166.97 + qed
166.98 + with th1 have ?thesis by blast}
166.99 + moreover
166.100 + {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
166.101 + {fix p assume p: "p \<ge> Suc N"
166.102 + hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
166.103 + have "m \<noteq> p" using m(2) by auto
166.104 + with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
166.105 + note th0 = this
166.106 + let ?P = "\<lambda>m x. m > x \<and> s x < s m"
166.107 + from nat_function_unique[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
166.108 + obtain f where f: "f 0 = (SOME x. ?P x (Suc N))"
166.109 + "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
166.110 + have "?P (f 0) (Suc N)" unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
166.111 + using N apply -
166.112 + apply (erule allE[where x="Suc N"], clarsimp)
166.113 + apply (rule_tac x="m" in exI)
166.114 + apply auto
166.115 + apply (subgoal_tac "Suc N \<noteq> m")
166.116 + apply simp
166.117 + apply (rule ccontr, simp)
166.118 + done
166.119 + hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
166.120 + {fix n
166.121 + have "f n > N \<and> ?P (f (Suc n)) (f n)"
166.122 + unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
166.123 + proof (induct n)
166.124 + case 0 thus ?case
166.125 + using f0 N apply auto
166.126 + apply (erule allE[where x="f 0"], clarsimp)
166.127 + apply (rule_tac x="m" in exI, simp)
166.128 + by (subgoal_tac "f 0 \<noteq> m", auto)
166.129 + next
166.130 + case (Suc n)
166.131 + from Suc.hyps have Nfn: "N < f n" by blast
166.132 + from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
166.133 + with Nfn have mN: "m > N" by arith
166.134 + note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
166.135 +
166.136 + from key have th0: "f (Suc n) > N" by simp
166.137 + from N[rule_format, OF th0]
166.138 + obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
166.139 + have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
166.140 + hence "m' > f (Suc n)" using m'(1) by simp
166.141 + with key m'(2) show ?case by auto
166.142 + qed}
166.143 + note fSuc = this
166.144 + {fix n
166.145 + have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto
166.146 + hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
166.147 + note thf = this
166.148 + have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
166.149 + have "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc using thf
166.150 + apply -
166.151 + apply (rule disjI1)
166.152 + apply auto
166.153 + apply (rule order_less_imp_le)
166.154 + apply blast
166.155 + done
166.156 + then have ?thesis using sqf by blast}
166.157 + ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
166.158 +qed
166.159 +
166.160 +lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
166.161 +proof(induct n)
166.162 + case 0 thus ?case by simp
166.163 +next
166.164 + case (Suc n)
166.165 + from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
166.166 + have "n < f (Suc n)" by arith
166.167 + thus ?case by arith
166.168 +qed
166.169 +
166.170 +subsection {* Bounded Monotonic Sequences *}
166.171 +
166.172 +
166.173 text{*Bounded Sequence*}
166.174
166.175 lemma BseqD: "Bseq X ==> \<exists>K. 0 < K & (\<forall>n. norm (X n) \<le> K)"
167.1 --- a/src/HOL/Series.thy Wed Mar 04 10:43:39 2009 +0100
167.2 +++ b/src/HOL/Series.thy Wed Mar 04 10:45:52 2009 +0100
167.3 @@ -312,6 +312,7 @@
167.4 shows "\<lbrakk>summable f;
167.5 \<forall>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
167.6 \<Longrightarrow> setsum f {0..<k} < suminf f"
167.7 +unfolding One_nat_def
167.8 apply (subst suminf_split_initial_segment [where k="k"])
167.9 apply assumption
167.10 apply simp
167.11 @@ -537,7 +538,7 @@
167.12 apply (safe, subgoal_tac "\<forall>n. N < n --> f (n) = 0")
167.13 prefer 2
167.14 apply clarify
167.15 - apply(erule_tac x = "n - 1" in allE)
167.16 + apply(erule_tac x = "n - Suc 0" in allE)
167.17 apply (simp add:diff_Suc split:nat.splits)
167.18 apply (blast intro: norm_ratiotest_lemma)
167.19 apply (rule_tac x = "Suc N" in exI, clarify)
168.1 --- a/src/HOL/SetInterval.thy Wed Mar 04 10:43:39 2009 +0100
168.2 +++ b/src/HOL/SetInterval.thy Wed Mar 04 10:45:52 2009 +0100
168.3 @@ -66,10 +66,10 @@
168.4 "@INTER_less" :: "nat => nat => 'b set => 'b set" ("(3\<Inter> _<_./ _)" 10)
168.5
168.6 syntax (xsymbols)
168.7 - "@UNION_le" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Union>(00\<^bsub>_ \<le> _\<^esub>)/ _)" 10)
168.8 - "@UNION_less" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Union>(00\<^bsub>_ < _\<^esub>)/ _)" 10)
168.9 - "@INTER_le" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Inter>(00\<^bsub>_ \<le> _\<^esub>)/ _)" 10)
168.10 - "@INTER_less" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Inter>(00\<^bsub>_ < _\<^esub>)/ _)" 10)
168.11 + "@UNION_le" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Union>(00_ \<le> _)/ _)" 10)
168.12 + "@UNION_less" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Union>(00_ < _)/ _)" 10)
168.13 + "@INTER_le" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Inter>(00_ \<le> _)/ _)" 10)
168.14 + "@INTER_less" :: "nat \<Rightarrow> nat => 'b set => 'b set" ("(3\<Inter>(00_ < _)/ _)" 10)
168.15
168.16 translations
168.17 "UN i<=n. A" == "UN i:{..n}. A"
168.18 @@ -352,11 +352,11 @@
168.19
168.20 corollary image_Suc_atLeastAtMost[simp]:
168.21 "Suc ` {i..j} = {Suc i..Suc j}"
168.22 -using image_add_atLeastAtMost[where k=1] by simp
168.23 +using image_add_atLeastAtMost[where k="Suc 0"] by simp
168.24
168.25 corollary image_Suc_atLeastLessThan[simp]:
168.26 "Suc ` {i..<j} = {Suc i..<Suc j}"
168.27 -using image_add_atLeastLessThan[where k=1] by simp
168.28 +using image_add_atLeastLessThan[where k="Suc 0"] by simp
168.29
168.30 lemma image_add_int_atLeastLessThan:
168.31 "(%x. x + (l::int)) ` {0..<u-l} = {l..<u}"
168.32 @@ -556,7 +556,7 @@
168.33 qed
168.34
168.35 lemma card_less_Suc2: "0 \<notin> M \<Longrightarrow> card {k. Suc k \<in> M \<and> k < i} = card {k \<in> M. k < Suc i}"
168.36 -apply (rule card_bij_eq [of "Suc" _ _ "\<lambda>x. x - 1"])
168.37 +apply (rule card_bij_eq [of "Suc" _ _ "\<lambda>x. x - Suc 0"])
168.38 apply simp
168.39 apply fastsimp
168.40 apply auto
168.41 @@ -803,7 +803,7 @@
168.42
168.43 lemma setsum_head_upt_Suc:
168.44 "m < n \<Longrightarrow> setsum f {m..<n} = f m + setsum f {Suc m..<n}"
168.45 -apply(insert setsum_head_Suc[of m "n - 1" f])
168.46 +apply(insert setsum_head_Suc[of m "n - Suc 0" f])
168.47 apply (simp add: atLeastLessThanSuc_atLeastAtMost[symmetric] algebra_simps)
168.48 done
168.49
168.50 @@ -835,11 +835,11 @@
168.51
168.52 corollary setsum_shift_bounds_cl_Suc_ivl:
168.53 "setsum f {Suc m..Suc n} = setsum (%i. f(Suc i)){m..n}"
168.54 -by (simp add:setsum_shift_bounds_cl_nat_ivl[where k=1,simplified])
168.55 +by (simp add:setsum_shift_bounds_cl_nat_ivl[where k="Suc 0", simplified])
168.56
168.57 corollary setsum_shift_bounds_Suc_ivl:
168.58 "setsum f {Suc m..<Suc n} = setsum (%i. f(Suc i)){m..<n}"
168.59 -by (simp add:setsum_shift_bounds_nat_ivl[where k=1,simplified])
168.60 +by (simp add:setsum_shift_bounds_nat_ivl[where k="Suc 0", simplified])
168.61
168.62 lemma setsum_shift_lb_Suc0_0:
168.63 "f(0::nat) = (0::nat) \<Longrightarrow> setsum f {Suc 0..k} = setsum f {0..k}"
168.64 @@ -883,6 +883,7 @@
168.65 by (rule setsum_addf)
168.66 also from ngt1 have "\<dots> = ?n*a + (\<Sum>i\<in>{..<n}. ?I i*d)" by simp
168.67 also from ngt1 have "\<dots> = (?n*a + d*(\<Sum>i\<in>{1..<n}. ?I i))"
168.68 + unfolding One_nat_def
168.69 by (simp add: setsum_right_distrib atLeast0LessThan[symmetric] setsum_shift_lb_Suc0_0_upt mult_ac)
168.70 also have "(1+1)*\<dots> = (1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..<n}. ?I i)"
168.71 by (simp add: left_distrib right_distrib)
168.72 @@ -890,7 +891,7 @@
168.73 by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost)
168.74 also from ngt1
168.75 have "(1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..n - 1}. ?I i) = ((1+1)*?n*a + d*?I (n - 1)*?I n)"
168.76 - by (simp only: mult_ac gauss_sum [of "n - 1"])
168.77 + by (simp only: mult_ac gauss_sum [of "n - 1"], unfold One_nat_def)
168.78 (simp add: mult_ac trans [OF add_commute of_nat_Suc [symmetric]])
168.79 finally show ?thesis by (simp add: algebra_simps)
168.80 next
168.81 @@ -906,7 +907,8 @@
168.82 "((1::nat) + 1) * (\<Sum>i\<in>{..<n::nat}. a + of_nat(i)*d) =
168.83 of_nat(n) * (a + (a + of_nat(n - 1)*d))"
168.84 by (rule arith_series_general)
168.85 - thus ?thesis by (auto simp add: of_nat_id)
168.86 + thus ?thesis
168.87 + unfolding One_nat_def by (auto simp add: of_nat_id)
168.88 qed
168.89
168.90 lemma arith_series_int:
168.91 @@ -946,4 +948,37 @@
168.92 show ?case by simp
168.93 qed
168.94
168.95 +subsection {* Products indexed over intervals *}
168.96 +
168.97 +syntax
168.98 + "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _ = _.._./ _)" [0,0,0,10] 10)
168.99 + "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _ = _..<_./ _)" [0,0,0,10] 10)
168.100 + "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _<_./ _)" [0,0,10] 10)
168.101 + "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(PROD _<=_./ _)" [0,0,10] 10)
168.102 +syntax (xsymbols)
168.103 + "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
168.104 + "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
168.105 + "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_<_./ _)" [0,0,10] 10)
168.106 + "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
168.107 +syntax (HTML output)
168.108 + "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
168.109 + "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
168.110 + "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_<_./ _)" [0,0,10] 10)
168.111 + "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b" ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
168.112 +syntax (latex_prod output)
168.113 + "_from_to_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
168.114 + ("(3\<^raw:$\prod_{>_ = _\<^raw:}^{>_\<^raw:}$> _)" [0,0,0,10] 10)
168.115 + "_from_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
168.116 + ("(3\<^raw:$\prod_{>_ = _\<^raw:}^{<>_\<^raw:}$> _)" [0,0,0,10] 10)
168.117 + "_upt_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
168.118 + ("(3\<^raw:$\prod_{>_ < _\<^raw:}$> _)" [0,0,10] 10)
168.119 + "_upto_setprod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
168.120 + ("(3\<^raw:$\prod_{>_ \<le> _\<^raw:}$> _)" [0,0,10] 10)
168.121 +
168.122 +translations
168.123 + "\<Prod>x=a..b. t" == "CONST setprod (%x. t) {a..b}"
168.124 + "\<Prod>x=a..<b. t" == "CONST setprod (%x. t) {a..<b}"
168.125 + "\<Prod>i\<le>n. t" == "CONST setprod (\<lambda>i. t) {..n}"
168.126 + "\<Prod>i<n. t" == "CONST setprod (\<lambda>i. t) {..<n}"
168.127 +
168.128 end
169.1 --- a/src/HOL/Tools/Qelim/langford.ML Wed Mar 04 10:43:39 2009 +0100
169.2 +++ b/src/HOL/Tools/Qelim/langford.ML Wed Mar 04 10:45:52 2009 +0100
169.3 @@ -113,11 +113,6 @@
169.4 val eqI = instantiate' [] [SOME ll, SOME rr] @{thm iffI}
169.5 in implies_elim (implies_elim eqI thl) thr |> mk_meta_eq end;
169.6
169.7 -fun partition f [] = ([],[])
169.8 - | partition f (x::xs) =
169.9 - let val (yes,no) = partition f xs
169.10 - in if f x then (x::yes,no) else (yes, x::no) end;
169.11 -
169.12 fun contains x ct = member (op aconv) (OldTerm.term_frees (term_of ct)) (term_of x);
169.13
169.14 fun is_eqx x eq = case term_of eq of
169.15 @@ -132,11 +127,11 @@
169.16 val e = Thm.dest_fun ct
169.17 val (x,p) = Thm.dest_abs (SOME xn) (Thm.dest_arg ct)
169.18 val Pp = Thm.capply @{cterm "Trueprop"} p
169.19 - val (eqs,neqs) = partition (is_eqx x) (all_conjuncts p)
169.20 + val (eqs,neqs) = List.partition (is_eqx x) (all_conjuncts p)
169.21 in case eqs of
169.22 [] =>
169.23 let
169.24 - val (dx,ndx) = partition (contains x) neqs
169.25 + val (dx,ndx) = List.partition (contains x) neqs
169.26 in case ndx of [] => NONE
169.27 | _ =>
169.28 conj_aci_rule (Thm.mk_binop @{cterm "op == :: prop => _"} Pp
170.1 --- a/src/HOL/Tools/Qelim/presburger.ML Wed Mar 04 10:43:39 2009 +0100
170.2 +++ b/src/HOL/Tools/Qelim/presburger.ML Wed Mar 04 10:45:52 2009 +0100
170.3 @@ -122,14 +122,13 @@
170.4 addcongs [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
170.5 val div_mod_ss = HOL_basic_ss addsimps simp_thms
170.6 @ map (symmetric o mk_meta_eq)
170.7 - [@{thm "dvd_eq_mod_eq_0"}, @{thm "zdvd_iff_zmod_eq_0"}, @{thm "mod_add1_eq"},
170.8 + [@{thm "dvd_eq_mod_eq_0"},
170.9 @{thm "mod_add_left_eq"}, @{thm "mod_add_right_eq"},
170.10 - @{thm "mod_add_eq"}, @{thm "zmod_zadd_left_eq"},
170.11 - @{thm "zmod_zadd_right_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
170.12 + @{thm "mod_add_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
170.13 @ [@{thm "mod_self"}, @{thm "zmod_self"}, @{thm "mod_by_0"},
170.14 @{thm "div_by_0"}, @{thm "DIVISION_BY_ZERO"} RS conjunct1,
170.15 @{thm "DIVISION_BY_ZERO"} RS conjunct2, @{thm "zdiv_zero"}, @{thm "zmod_zero"},
170.16 - @{thm "div_0"}, @{thm "mod_0"}, @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"},
170.17 + @{thm "div_0"}, @{thm "mod_0"}, @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"},
170.18 @{thm "mod_1"}, @{thm "Suc_plus1"}]
170.19 @ @{thms add_ac}
170.20 addsimprocs [cancel_div_mod_proc]
170.21 @@ -170,14 +169,14 @@
170.22 THEN_ALL_NEW simp_tac ss
170.23 THEN_ALL_NEW (TRY o generalize_tac (int_nat_terms ctxt))
170.24 THEN_ALL_NEW ObjectLogic.full_atomize_tac
170.25 - THEN_ALL_NEW (TRY o thin_prems_tac (is_relevant ctxt))
170.26 + THEN_ALL_NEW (thin_prems_tac (is_relevant ctxt))
170.27 THEN_ALL_NEW ObjectLogic.full_atomize_tac
170.28 THEN_ALL_NEW div_mod_tac ctxt
170.29 THEN_ALL_NEW splits_tac ctxt
170.30 THEN_ALL_NEW simp_tac ss
170.31 THEN_ALL_NEW CONVERSION Thm.eta_long_conversion
170.32 THEN_ALL_NEW nat_to_int_tac ctxt
170.33 - THEN_ALL_NEW core_cooper_tac ctxt
170.34 + THEN_ALL_NEW (core_cooper_tac ctxt)
170.35 THEN_ALL_NEW finish_tac elim
170.36 end;
170.37
171.1 --- a/src/HOL/Tools/TFL/post.ML Wed Mar 04 10:43:39 2009 +0100
171.2 +++ b/src/HOL/Tools/TFL/post.ML Wed Mar 04 10:45:52 2009 +0100
171.3 @@ -1,5 +1,4 @@
171.4 (* Title: HOL/Tools/TFL/post.ML
171.5 - ID: $Id$
171.6 Author: Konrad Slind, Cambridge University Computer Laboratory
171.7 Copyright 1997 University of Cambridge
171.8
171.9 @@ -31,7 +30,7 @@
171.10 *--------------------------------------------------------------------------*)
171.11 fun termination_goals rules =
171.12 map (Type.freeze o HOLogic.dest_Trueprop)
171.13 - (foldr (fn (th,A) => gen_union (op aconv) (prems_of th, A)) [] rules);
171.14 + (List.foldr (fn (th,A) => gen_union (op aconv) (prems_of th, A)) [] rules);
171.15
171.16 (*---------------------------------------------------------------------------
171.17 * Finds the termination conditions in (highly massaged) definition and
172.1 --- a/src/HOL/Tools/TFL/rules.ML Wed Mar 04 10:43:39 2009 +0100
172.2 +++ b/src/HOL/Tools/TFL/rules.ML Wed Mar 04 10:45:52 2009 +0100
172.3 @@ -131,7 +131,7 @@
172.4
172.5 fun FILTER_DISCH_ALL P thm =
172.6 let fun check tm = P (#t (Thm.rep_cterm tm))
172.7 - in foldr (fn (tm,th) => if check tm then DISCH tm th else th)
172.8 + in List.foldr (fn (tm,th) => if check tm then DISCH tm th else th)
172.9 thm (chyps thm)
172.10 end;
172.11
173.1 --- a/src/HOL/Tools/TFL/tfl.ML Wed Mar 04 10:43:39 2009 +0100
173.2 +++ b/src/HOL/Tools/TFL/tfl.ML Wed Mar 04 10:45:52 2009 +0100
173.3 @@ -330,7 +330,7 @@
173.4 val dummy = map (no_repeat_vars thy) pats
173.5 val rows = ListPair.zip (map (fn x => ([]:term list,[x])) pats,
173.6 map (fn (t,i) => (t,(i,true))) (enumerate R))
173.7 - val names = foldr OldTerm.add_term_names [] R
173.8 + val names = List.foldr OldTerm.add_term_names [] R
173.9 val atype = type_of(hd pats)
173.10 and aname = Name.variant names "a"
173.11 val a = Free(aname,atype)
173.12 @@ -492,7 +492,7 @@
173.13 val tych = Thry.typecheck thy
173.14 val WFREC_THM0 = R.ISPEC (tych functional) Thms.WFREC_COROLLARY
173.15 val Const("All",_) $ Abs(Rname,Rtype,_) = concl WFREC_THM0
173.16 - val R = Free (Name.variant (foldr OldTerm.add_term_names [] eqns) Rname,
173.17 + val R = Free (Name.variant (List.foldr OldTerm.add_term_names [] eqns) Rname,
173.18 Rtype)
173.19 val WFREC_THM = R.ISPECL [tych R, tych g] WFREC_THM0
173.20 val ([proto_def, WFR],_) = S.strip_imp(concl WFREC_THM)
173.21 @@ -533,7 +533,7 @@
173.22 Display.prths extractants;
173.23 ())
173.24 else ()
173.25 - val TCs = foldr (gen_union (op aconv)) [] TCl
173.26 + val TCs = List.foldr (gen_union (op aconv)) [] TCl
173.27 val full_rqt = WFR::TCs
173.28 val R' = S.mk_select{Bvar=R1, Body=S.list_mk_conj full_rqt}
173.29 val R'abs = S.rand R'
173.30 @@ -690,7 +690,7 @@
173.31 let val tych = Thry.typecheck thy
173.32 val ty_info = Thry.induct_info thy
173.33 in fn pats =>
173.34 - let val names = foldr OldTerm.add_term_names [] pats
173.35 + let val names = List.foldr OldTerm.add_term_names [] pats
173.36 val T = type_of (hd pats)
173.37 val aname = Name.variant names "a"
173.38 val vname = Name.variant (aname::names) "v"
173.39 @@ -843,7 +843,7 @@
173.40 val (pats,TCsl) = ListPair.unzip pat_TCs_list
173.41 val case_thm = complete_cases thy pats
173.42 val domain = (type_of o hd) pats
173.43 - val Pname = Name.variant (foldr (Library.foldr OldTerm.add_term_names)
173.44 + val Pname = Name.variant (List.foldr (Library.foldr OldTerm.add_term_names)
173.45 [] (pats::TCsl)) "P"
173.46 val P = Free(Pname, domain --> HOLogic.boolT)
173.47 val Sinduct = R.SPEC (tych P) Sinduction
173.48 @@ -854,7 +854,7 @@
173.49 val cases = map (fn pat => Term.betapply (Sinduct_assumf, pat)) pats
173.50 val tasks = U.zip3 cases TCl' (R.CONJUNCTS Rinduct_assum)
173.51 val proved_cases = map (prove_case fconst thy) tasks
173.52 - val v = Free (Name.variant (foldr OldTerm.add_term_names [] (map concl proved_cases))
173.53 + val v = Free (Name.variant (List.foldr OldTerm.add_term_names [] (map concl proved_cases))
173.54 "v",
173.55 domain)
173.56 val vtyped = tych v
174.1 --- a/src/HOL/Tools/atp_wrapper.ML Wed Mar 04 10:43:39 2009 +0100
174.2 +++ b/src/HOL/Tools/atp_wrapper.ML Wed Mar 04 10:45:52 2009 +0100
174.3 @@ -78,10 +78,14 @@
174.4 val failure = find_failure proof
174.5 val success = rc = 0 andalso is_none failure
174.6 val message =
174.7 - if isSome failure then "Could not prove: " ^ the failure
174.8 - else if rc <> 0
174.9 - then "Exited with return code " ^ string_of_int rc ^ ": " ^ proof
174.10 - else "Try this command: " ^ produce_answer (proof, thm_names, ctxt, goal, subgoalno)
174.11 + if success then "Try this command: " ^ produce_answer (proof, thm_names, ctxt, goal, subgoalno)
174.12 + else "Could not prove goal."
174.13 + val _ = if isSome failure
174.14 + then Output.debug (fn () => "Sledgehammer failure: " ^ the failure ^ "\nOutput: " ^ proof)
174.15 + else ()
174.16 + val _ = if rc <> 0
174.17 + then Output.debug (fn () => "Sledgehammer exited with return code " ^ string_of_int rc ^ ":\n" ^ proof)
174.18 + else ()
174.19 in (success, message) end;
174.20
174.21
174.22 @@ -92,7 +96,7 @@
174.23
174.24 fun tptp_prover_opts_full max_new theory_const full command =
174.25 external_prover
174.26 - (ResAtp.write_problem_files ResHolClause.tptp_write_file max_new theory_const)
174.27 + (ResAtp.write_problem_files false max_new theory_const)
174.28 command
174.29 ResReconstruct.find_failure_e_vamp_spass
174.30 (if full then ResReconstruct.structured_proof else ResReconstruct.lemma_list_tstp);
174.31 @@ -149,7 +153,7 @@
174.32 (* SPASS *)
174.33
174.34 fun spass_opts max_new theory_const = external_prover
174.35 - (ResAtp.write_problem_files ResHolClause.dfg_write_file max_new theory_const)
174.36 + (ResAtp.write_problem_files true max_new theory_const)
174.37 (Path.explode "$SPASS_HOME/SPASS", "-Auto -SOS=1 -PGiven=0 -PProblem=0 -Splits=0 -FullRed=0 -DocProof")
174.38 ResReconstruct.find_failure_e_vamp_spass
174.39 ResReconstruct.lemma_list_dfg;
175.1 --- a/src/HOL/Tools/datatype_abs_proofs.ML Wed Mar 04 10:43:39 2009 +0100
175.2 +++ b/src/HOL/Tools/datatype_abs_proofs.ML Wed Mar 04 10:45:52 2009 +0100
175.3 @@ -96,7 +96,7 @@
175.4
175.5 val descr' = List.concat descr;
175.6 val recTs = get_rec_types descr' sorts;
175.7 - val used = foldr OldTerm.add_typ_tfree_names [] recTs;
175.8 + val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
175.9 val newTs = Library.take (length (hd descr), recTs);
175.10
175.11 val induct_Ps = map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (concl_of induct)));
175.12 @@ -140,7 +140,7 @@
175.13 end;
175.14
175.15 val Ts = map (typ_of_dtyp descr' sorts) cargs;
175.16 - val (_, _, prems, t1s, t2s) = foldr mk_prem (1, 1, [], [], []) (cargs ~~ Ts)
175.17 + val (_, _, prems, t1s, t2s) = List.foldr mk_prem (1, 1, [], [], []) (cargs ~~ Ts)
175.18
175.19 in (rec_intr_ts @ [Logic.list_implies (prems, HOLogic.mk_Trueprop
175.20 (rec_set $ list_comb (Const (cname, Ts ---> T), t1s) $
175.21 @@ -280,7 +280,7 @@
175.22
175.23 val descr' = List.concat descr;
175.24 val recTs = get_rec_types descr' sorts;
175.25 - val used = foldr OldTerm.add_typ_tfree_names [] recTs;
175.26 + val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
175.27 val newTs = Library.take (length (hd descr), recTs);
175.28 val T' = TFree (Name.variant used "'t", HOLogic.typeS);
175.29
176.1 --- a/src/HOL/Tools/datatype_aux.ML Wed Mar 04 10:43:39 2009 +0100
176.2 +++ b/src/HOL/Tools/datatype_aux.ML Wed Mar 04 10:45:52 2009 +0100
176.3 @@ -155,7 +155,7 @@
176.4 val prem' = hd (prems_of exhaustion);
176.5 val _ $ (_ $ lhs $ _) = hd (rev (Logic.strip_assums_hyp prem'));
176.6 val exhaustion' = cterm_instantiate [(cterm_of thy (head_of lhs),
176.7 - cterm_of thy (foldr (fn ((_, T), t) => Abs ("z", T, t))
176.8 + cterm_of thy (List.foldr (fn ((_, T), t) => Abs ("z", T, t))
176.9 (Bound 0) params))] exhaustion
176.10 in compose_tac (false, exhaustion', nprems_of exhaustion) i state
176.11 end;
177.1 --- a/src/HOL/Tools/datatype_codegen.ML Wed Mar 04 10:43:39 2009 +0100
177.2 +++ b/src/HOL/Tools/datatype_codegen.ML Wed Mar 04 10:45:52 2009 +0100
177.3 @@ -6,8 +6,8 @@
177.4
177.5 signature DATATYPE_CODEGEN =
177.6 sig
177.7 - val get_eq: theory -> string -> thm list
177.8 - val get_case_cert: theory -> string -> thm
177.9 + val mk_eq: theory -> string -> thm list
177.10 + val mk_case_cert: theory -> string -> thm
177.11 val setup: theory -> theory
177.12 end;
177.13
177.14 @@ -85,7 +85,7 @@
177.15 val dts' = map (DatatypeAux.typ_of_dtyp descr sorts) dts;
177.16 val T = Type (tname, dts');
177.17 val rest = mk_term_of_def gr "and " xs;
177.18 - val (_, eqs) = foldl_map (fn (prfx, (cname, Ts)) =>
177.19 + val (_, eqs) = Library.foldl_map (fn (prfx, (cname, Ts)) =>
177.20 let val args = map (fn i =>
177.21 str ("x" ^ string_of_int i)) (1 upto length Ts)
177.22 in (" | ", Pretty.blk (4,
177.23 @@ -216,8 +216,8 @@
177.24 let
177.25 val ts1 = Library.take (i, ts);
177.26 val t :: ts2 = Library.drop (i, ts);
177.27 - val names = foldr OldTerm.add_term_names
177.28 - (map (fst o fst o dest_Var) (foldr OldTerm.add_term_vars [] ts1)) ts1;
177.29 + val names = List.foldr OldTerm.add_term_names
177.30 + (map (fst o fst o dest_Var) (List.foldr OldTerm.add_term_vars [] ts1)) ts1;
177.31 val (Ts, dT) = split_last (Library.take (i+1, fst (strip_type T)));
177.32
177.33 fun pcase [] [] [] gr = ([], gr)
177.34 @@ -323,7 +323,7 @@
177.35
177.36 (* case certificates *)
177.37
177.38 -fun get_case_cert thy tyco =
177.39 +fun mk_case_cert thy tyco =
177.40 let
177.41 val raw_thms =
177.42 (#case_rewrites o DatatypePackage.the_datatype thy) tyco;
177.43 @@ -357,10 +357,13 @@
177.44 fun add_datatype_cases dtco thy =
177.45 let
177.46 val {case_rewrites, ...} = DatatypePackage.the_datatype thy dtco;
177.47 - val certs = get_case_cert thy dtco;
177.48 + val cert = mk_case_cert thy dtco;
177.49 + fun add_case_liberal thy = thy
177.50 + |> try (Code.add_case cert)
177.51 + |> the_default thy;
177.52 in
177.53 thy
177.54 - |> Code.add_case certs
177.55 + |> add_case_liberal
177.56 |> fold_rev Code.add_default_eqn case_rewrites
177.57 end;
177.58
177.59 @@ -369,10 +372,10 @@
177.60
177.61 local
177.62
177.63 -val not_sym = thm "HOL.not_sym";
177.64 -val not_false_true = iffD2 OF [nth (thms "HOL.simp_thms") 7, TrueI];
177.65 -val refl = thm "refl";
177.66 -val eqTrueI = thm "eqTrueI";
177.67 +val not_sym = @{thm HOL.not_sym};
177.68 +val not_false_true = iffD2 OF [nth @{thms HOL.simp_thms} 7, TrueI];
177.69 +val refl = @{thm refl};
177.70 +val eqTrueI = @{thm eqTrueI};
177.71
177.72 fun mk_distinct cos =
177.73 let
177.74 @@ -397,7 +400,7 @@
177.75
177.76 in
177.77
177.78 -fun get_eq thy dtco =
177.79 +fun mk_eq thy dtco =
177.80 let
177.81 val (vs, cs) = DatatypePackage.the_datatype_spec thy dtco;
177.82 fun mk_triv_inject co =
177.83 @@ -445,7 +448,7 @@
177.84 in (thm', lthy') end;
177.85 fun tac thms = Class.intro_classes_tac []
177.86 THEN ALLGOALS (ProofContext.fact_tac thms);
177.87 - fun get_eq' thy dtco = get_eq thy dtco
177.88 + fun mk_eq' thy dtco = mk_eq thy dtco
177.89 |> map (Code_Unit.constrain_thm thy [HOLogic.class_eq])
177.90 |> map Simpdata.mk_eq
177.91 |> map (MetaSimplifier.rewrite_rule [Thm.transfer thy @{thm equals_eq}])
177.92 @@ -460,10 +463,10 @@
177.93 ([pairself (Thm.ctyp_of thy) (TVar (("'a", 0), @{sort eq}), Logic.varifyT ty)], [])
177.94 |> Simpdata.mk_eq
177.95 |> AxClass.unoverload thy;
177.96 - fun get_thms () = (eq_refl, false)
177.97 - :: rev (map (rpair true) (get_eq' (Theory.deref thy_ref) dtco));
177.98 + fun mk_thms () = (eq_refl, false)
177.99 + :: rev (map (rpair true) (mk_eq' (Theory.deref thy_ref) dtco));
177.100 in
177.101 - Code.add_eqnl (const, Lazy.lazy get_thms) thy
177.102 + Code.add_eqnl (const, Lazy.lazy mk_thms) thy
177.103 end;
177.104 in
177.105 thy
178.1 --- a/src/HOL/Tools/datatype_package.ML Wed Mar 04 10:43:39 2009 +0100
178.2 +++ b/src/HOL/Tools/datatype_package.ML Wed Mar 04 10:45:52 2009 +0100
178.3 @@ -631,8 +631,8 @@
178.4
178.5 local
178.6
178.7 -val sym_datatype = Pretty.str "\\isacommand{datatype}";
178.8 -val sym_binder = Pretty.str "\\ {\\isacharequal}";
178.9 +val sym_datatype = Pretty.command "datatype";
178.10 +val sym_binder = Pretty.str "\\ {\\isacharequal}"; (*FIXME use proper symbol*)
178.11 val sym_sep = Pretty.str "{\\isacharbar}\\ ";
178.12
178.13 in
178.14 @@ -659,7 +659,7 @@
178.15 | pretty_constr (co, [ty']) =
178.16 (Pretty.block o Pretty.breaks)
178.17 [Syntax.pretty_term ctxt (Const (co, ty' --> ty)),
178.18 - Syntax.pretty_typ ctxt ty']
178.19 + pretty_typ_br ty']
178.20 | pretty_constr (co, tys) =
178.21 (Pretty.block o Pretty.breaks)
178.22 (Syntax.pretty_term ctxt (Const (co, tys ---> ty)) ::
179.1 --- a/src/HOL/Tools/datatype_prop.ML Wed Mar 04 10:43:39 2009 +0100
179.2 +++ b/src/HOL/Tools/datatype_prop.ML Wed Mar 04 10:45:52 2009 +0100
179.3 @@ -205,7 +205,7 @@
179.4 let
179.5 val descr' = List.concat descr;
179.6 val recTs = get_rec_types descr' sorts;
179.7 - val used = foldr OldTerm.add_typ_tfree_names [] recTs;
179.8 + val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
179.9
179.10 val (rec_result_Ts, reccomb_fn_Ts) = make_primrec_Ts descr sorts used;
179.11
179.12 @@ -255,7 +255,7 @@
179.13 let
179.14 val descr' = List.concat descr;
179.15 val recTs = get_rec_types descr' sorts;
179.16 - val used = foldr OldTerm.add_typ_tfree_names [] recTs;
179.17 + val used = List.foldr OldTerm.add_typ_tfree_names [] recTs;
179.18 val newTs = Library.take (length (hd descr), recTs);
179.19 val T' = TFree (Name.variant used "'t", HOLogic.typeS);
179.20
179.21 @@ -302,7 +302,7 @@
179.22 let
179.23 val descr' = List.concat descr;
179.24 val recTs = get_rec_types descr' sorts;
179.25 - val used' = foldr OldTerm.add_typ_tfree_names [] recTs;
179.26 + val used' = List.foldr OldTerm.add_typ_tfree_names [] recTs;
179.27 val newTs = Library.take (length (hd descr), recTs);
179.28 val T' = TFree (Name.variant used' "'t", HOLogic.typeS);
179.29 val P = Free ("P", T' --> HOLogic.boolT);
179.30 @@ -319,13 +319,13 @@
179.31 val eqn = HOLogic.mk_eq (Free ("x", T),
179.32 list_comb (Const (cname, Ts ---> T), frees));
179.33 val P' = P $ list_comb (f, frees)
179.34 - in ((foldr (fn (Free (s, T), t) => HOLogic.mk_all (s, T, t))
179.35 + in ((List.foldr (fn (Free (s, T), t) => HOLogic.mk_all (s, T, t))
179.36 (HOLogic.imp $ eqn $ P') frees)::t1s,
179.37 - (foldr (fn (Free (s, T), t) => HOLogic.mk_exists (s, T, t))
179.38 + (List.foldr (fn (Free (s, T), t) => HOLogic.mk_exists (s, T, t))
179.39 (HOLogic.conj $ eqn $ (HOLogic.Not $ P')) frees)::t2s)
179.40 end;
179.41
179.42 - val (t1s, t2s) = foldr process_constr ([], []) (constrs ~~ fs);
179.43 + val (t1s, t2s) = List.foldr process_constr ([], []) (constrs ~~ fs);
179.44 val lhs = P $ (comb_t $ Free ("x", T))
179.45 in
179.46 (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, mk_conj t1s)),
179.47 @@ -422,7 +422,7 @@
179.48 val tnames = Name.variant_list ["v"] (make_tnames Ts);
179.49 val frees = tnames ~~ Ts
179.50 in
179.51 - foldr (fn ((s, T'), t) => HOLogic.mk_exists (s, T', t))
179.52 + List.foldr (fn ((s, T'), t) => HOLogic.mk_exists (s, T', t))
179.53 (HOLogic.mk_eq (Free ("v", T),
179.54 list_comb (Const (cname, Ts ---> T), map Free frees))) frees
179.55 end
180.1 --- a/src/HOL/Tools/datatype_realizer.ML Wed Mar 04 10:43:39 2009 +0100
180.2 +++ b/src/HOL/Tools/datatype_realizer.ML Wed Mar 04 10:45:52 2009 +0100
180.3 @@ -1,5 +1,4 @@
180.4 (* Title: HOL/Tools/datatype_realizer.ML
180.5 - ID: $Id$
180.6 Author: Stefan Berghofer, TU Muenchen
180.7
180.8 Porgram extraction from proofs involving datatypes:
180.9 @@ -57,8 +56,8 @@
180.10 fun mk_all i s T t =
180.11 if i mem is then list_all_free ([(s, T)], t) else t;
180.12
180.13 - val (prems, rec_fns) = split_list (List.concat (snd (foldl_map
180.14 - (fn (j, ((i, (_, _, constrs)), T)) => foldl_map (fn (j, (cname, cargs)) =>
180.15 + val (prems, rec_fns) = split_list (List.concat (snd (Library.foldl_map
180.16 + (fn (j, ((i, (_, _, constrs)), T)) => Library.foldl_map (fn (j, (cname, cargs)) =>
180.17 let
180.18 val Ts = map (typ_of_dtyp descr sorts) cargs;
180.19 val tnames = Name.variant_list pnames (DatatypeProp.make_tnames Ts);
180.20 @@ -139,8 +138,8 @@
180.21 tname_of (body_type T) mem ["set", "bool"]) ivs);
180.22 val ivs2 = map (fn (ixn, _) => Var (ixn, valOf (AList.lookup (op =) rvs ixn))) ivs;
180.23
180.24 - val prf = foldr forall_intr_prf
180.25 - (foldr (fn ((f, p), prf) =>
180.26 + val prf = List.foldr forall_intr_prf
180.27 + (List.foldr (fn ((f, p), prf) =>
180.28 (case head_of (strip_abs_body f) of
180.29 Free (s, T) =>
180.30 let val T' = Logic.varifyT T
180.31 @@ -151,7 +150,7 @@
180.32 (Proofterm.proof_combP
180.33 (prf_of thm', map PBound (length prems - 1 downto 0))) (rec_fns ~~ prems_of thm)) ivs2;
180.34
180.35 - val r' = if null is then r else Logic.varify (foldr (uncurry lambda)
180.36 + val r' = if null is then r else Logic.varify (List.foldr (uncurry lambda)
180.37 r (map Logic.unvarify ivs1 @ filter_out is_unit
180.38 (map (head_of o strip_abs_body) rec_fns)));
180.39
180.40 @@ -201,7 +200,7 @@
180.41
180.42 val P = Var (("P", 0), rT' --> HOLogic.boolT);
180.43 val prf = forall_intr_prf (y, forall_intr_prf (P,
180.44 - foldr (fn ((p, r), prf) =>
180.45 + List.foldr (fn ((p, r), prf) =>
180.46 forall_intr_prf (Logic.legacy_varify r, AbsP ("H", SOME (Logic.varify p),
180.47 prf))) (Proofterm.proof_combP (prf_of thm',
180.48 map PBound (length prems - 1 downto 0))) (prems ~~ rs)));
181.1 --- a/src/HOL/Tools/datatype_rep_proofs.ML Wed Mar 04 10:43:39 2009 +0100
181.2 +++ b/src/HOL/Tools/datatype_rep_proofs.ML Wed Mar 04 10:45:52 2009 +0100
181.3 @@ -83,7 +83,7 @@
181.4 val branchT = if null branchTs then HOLogic.unitT
181.5 else BalancedTree.make (fn (T, U) => Type ("+", [T, U])) branchTs;
181.6 val arities = get_arities descr' \ 0;
181.7 - val unneeded_vars = hd tyvars \\ foldr OldTerm.add_typ_tfree_names [] (leafTs' @ branchTs);
181.8 + val unneeded_vars = hd tyvars \\ List.foldr OldTerm.add_typ_tfree_names [] (leafTs' @ branchTs);
181.9 val leafTs = leafTs' @ (map (fn n => TFree (n, (the o AList.lookup (op =) sorts) n)) unneeded_vars);
181.10 val recTs = get_rec_types descr' sorts;
181.11 val newTs = Library.take (length (hd descr), recTs);
181.12 @@ -143,7 +143,7 @@
181.13 in mk_inj branchT (length branchTs) (1 + find_index_eq T' branchTs)
181.14 end;
181.15
181.16 - val mk_lim = foldr (fn (T, t) => Lim $ mk_fun_inj T (Abs ("x", T, t)));
181.17 + val mk_lim = List.foldr (fn (T, t) => Lim $ mk_fun_inj T (Abs ("x", T, t)));
181.18
181.19 (************** generate introduction rules for representing set **********)
181.20
181.21 @@ -169,7 +169,7 @@
181.22 in (j + 1, prems, (Leaf $ mk_inj T (mk_Free "x" T j))::ts)
181.23 end);
181.24
181.25 - val (_, prems, ts) = foldr mk_prem (1, [], []) cargs;
181.26 + val (_, prems, ts) = List.foldr mk_prem (1, [], []) cargs;
181.27 val concl = HOLogic.mk_Trueprop
181.28 (Free (s, UnivT') $ mk_univ_inj ts n i)
181.29 in Logic.list_implies (prems, concl)
181.30 @@ -229,7 +229,7 @@
181.31 | _ => (j + 1, free_t::l_args, (Leaf $ mk_inj T free_t)::r_args))
181.32 end;
181.33
181.34 - val (_, l_args, r_args) = foldr constr_arg (1, [], []) cargs;
181.35 + val (_, l_args, r_args) = List.foldr constr_arg (1, [], []) cargs;
181.36 val constrT = (map (typ_of_dtyp descr' sorts) cargs) ---> T;
181.37 val abs_name = Sign.intern_const thy ("Abs_" ^ tname);
181.38 val rep_name = Sign.intern_const thy ("Rep_" ^ tname);
181.39 @@ -357,7 +357,7 @@
181.40
181.41 in (thy', char_thms' @ char_thms) end;
181.42
181.43 - val (thy5, iso_char_thms) = apfst Theory.checkpoint (foldr make_iso_defs
181.44 + val (thy5, iso_char_thms) = apfst Theory.checkpoint (List.foldr make_iso_defs
181.45 (add_path flat_names big_name thy4, []) (tl descr));
181.46
181.47 (* prove isomorphism properties *)
181.48 @@ -447,7 +447,7 @@
181.49 in (inj_thms'' @ inj_thms, elem_thms @ (split_conj_thm elem_thm))
181.50 end;
181.51
181.52 - val (iso_inj_thms_unfolded, iso_elem_thms) = foldr prove_iso_thms
181.53 + val (iso_inj_thms_unfolded, iso_elem_thms) = List.foldr prove_iso_thms
181.54 ([], map #3 newT_iso_axms) (tl descr);
181.55 val iso_inj_thms = map snd newT_iso_inj_thms @
181.56 map (fn r => r RS @{thm injD}) iso_inj_thms_unfolded;
182.1 --- a/src/HOL/Tools/function_package/fundef_common.ML Wed Mar 04 10:43:39 2009 +0100
182.2 +++ b/src/HOL/Tools/function_package/fundef_common.ML Wed Mar 04 10:45:52 2009 +0100
182.3 @@ -82,7 +82,7 @@
182.4 psimps, pinducts, termination, defname}) phi =
182.5 let
182.6 val term = Morphism.term phi val thm = Morphism.thm phi val fact = Morphism.fact phi
182.7 - val name = Binding.base_name o Morphism.binding phi o Binding.name
182.8 + val name = Binding.name_of o Morphism.binding phi o Binding.name
182.9 in
182.10 FundefCtxData { add_simps = add_simps, case_names = case_names,
182.11 fs = map term fs, R = term R, psimps = fact psimps,
183.1 --- a/src/HOL/Tools/function_package/fundef_package.ML Wed Mar 04 10:43:39 2009 +0100
183.2 +++ b/src/HOL/Tools/function_package/fundef_package.ML Wed Mar 04 10:45:52 2009 +0100
183.3 @@ -99,8 +99,8 @@
183.4 val constrn_fxs = map (fn (b, T, mx) => (b, SOME (the_default default_constraint T), mx))
183.5 val ((fixes0, spec0), ctxt') =
183.6 prep (constrn_fxs fixspec) (map (single o apsnd single) eqnss) lthy
183.7 - val fixes = map (apfst (apfst Binding.base_name)) fixes0;
183.8 - val spec = map (apfst (apfst Binding.base_name)) spec0;
183.9 + val fixes = map (apfst (apfst Binding.name_of)) fixes0;
183.10 + val spec = map (apfst (apfst Binding.name_of)) spec0;
183.11 val (eqs, post, sort_cont, cnames) = FundefCommon.get_preproc lthy config flags ctxt' fixes spec
183.12
183.13 val defname = mk_defname fixes
184.1 --- a/src/HOL/Tools/function_package/scnp_solve.ML Wed Mar 04 10:43:39 2009 +0100
184.2 +++ b/src/HOL/Tools/function_package/scnp_solve.ML Wed Mar 04 10:45:52 2009 +0100
184.3 @@ -46,7 +46,7 @@
184.4 fun num_prog_pts (GP (arities, _)) = length arities ;
184.5 fun num_graphs (GP (_, gs)) = length gs ;
184.6 fun arity (GP (arities, gl)) i = nth arities i ;
184.7 -fun ndigits (GP (arities, _)) = IntInf.log2 (foldl (op +) 0 arities) + 1
184.8 +fun ndigits (GP (arities, _)) = IntInf.log2 (List.foldl (op +) 0 arities) + 1
184.9
184.10
184.11 (** Propositional formulas **)
184.12 @@ -79,7 +79,7 @@
184.13 fun var_constrs (gp as GP (arities, gl)) =
184.14 let
184.15 val n = Int.max (num_graphs gp, num_prog_pts gp)
184.16 - val k = foldl Int.max 1 arities
184.17 + val k = List.foldl Int.max 1 arities
184.18
184.19 (* Injective, provided a < 8, x < n, and i < k. *)
184.20 fun prod a x i j = ((j * k + i) * n + x) * 8 + a + 1
185.1 --- a/src/HOL/Tools/function_package/size.ML Wed Mar 04 10:43:39 2009 +0100
185.2 +++ b/src/HOL/Tools/function_package/size.ML Wed Mar 04 10:45:52 2009 +0100
185.3 @@ -115,7 +115,7 @@
185.4 then HOLogic.zero
185.5 else foldl1 plus (ts @ [HOLogic.Suc_zero])
185.6 in
185.7 - foldr (fn (T, t') => Abs ("x", T, t')) t (Ts @ replicate k HOLogic.natT)
185.8 + List.foldr (fn (T, t') => Abs ("x", T, t')) t (Ts @ replicate k HOLogic.natT)
185.9 end;
185.10
185.11 val fs = maps (fn (_, (name, _, constrs)) =>
186.1 --- a/src/HOL/Tools/inductive_codegen.ML Wed Mar 04 10:43:39 2009 +0100
186.2 +++ b/src/HOL/Tools/inductive_codegen.ML Wed Mar 04 10:45:52 2009 +0100
186.3 @@ -71,7 +71,7 @@
186.4 {intros = intros |>
186.5 Symtab.update (s, (AList.update Thm.eq_thm_prop
186.6 (thm, (thyname_of s, nparms)) rules)),
186.7 - graph = foldr (uncurry (Graph.add_edge o pair s))
186.8 + graph = List.foldr (uncurry (Graph.add_edge o pair s))
186.9 (Library.foldl add_node (graph, s :: cs)) cs,
186.10 eqns = eqns} thy
186.11 end
186.12 @@ -152,7 +152,7 @@
186.13 fun cprod ([], ys) = []
186.14 | cprod (x :: xs, ys) = map (pair x) ys @ cprod (xs, ys);
186.15
186.16 -fun cprods xss = foldr (map op :: o cprod) [[]] xss;
186.17 +fun cprods xss = List.foldr (map op :: o cprod) [[]] xss;
186.18
186.19 datatype mode = Mode of (int list option list * int list) * int list * mode option list;
186.20
186.21 @@ -357,7 +357,7 @@
186.22
186.23 val (in_ts, out_ts) = get_args is 1 ts;
186.24 val ((all_vs', eqs), in_ts') =
186.25 - foldl_map check_constrt ((all_vs, []), in_ts);
186.26 + Library.foldl_map check_constrt ((all_vs, []), in_ts);
186.27
186.28 fun compile_prems out_ts' vs names [] gr =
186.29 let
186.30 @@ -365,8 +365,8 @@
186.31 (invoke_codegen thy defs dep module false) out_ts gr;
186.32 val (eq_ps, gr3) = fold_map compile_eq eqs gr2;
186.33 val ((names', eqs'), out_ts'') =
186.34 - foldl_map check_constrt ((names, []), out_ts');
186.35 - val (nvs, out_ts''') = foldl_map distinct_v
186.36 + Library.foldl_map check_constrt ((names, []), out_ts');
186.37 + val (nvs, out_ts''') = Library.foldl_map distinct_v
186.38 ((names', map (fn x => (x, [x])) vs), out_ts'');
186.39 val (out_ps', gr4) = fold_map
186.40 (invoke_codegen thy defs dep module false) (out_ts''') gr3;
186.41 @@ -383,8 +383,8 @@
186.42 select_mode_prem thy modes' vs' ps;
186.43 val ps' = filter_out (equal p) ps;
186.44 val ((names', eqs), out_ts') =
186.45 - foldl_map check_constrt ((names, []), out_ts);
186.46 - val (nvs, out_ts'') = foldl_map distinct_v
186.47 + Library.foldl_map check_constrt ((names, []), out_ts);
186.48 + val (nvs, out_ts'') = Library.foldl_map distinct_v
186.49 ((names', map (fn x => (x, [x])) vs), out_ts');
186.50 val (out_ps, gr0) = fold_map
186.51 (invoke_codegen thy defs dep module false) out_ts'' gr;
187.1 --- a/src/HOL/Tools/inductive_package.ML Wed Mar 04 10:43:39 2009 +0100
187.2 +++ b/src/HOL/Tools/inductive_package.ML Wed Mar 04 10:45:52 2009 +0100
187.3 @@ -260,7 +260,7 @@
187.4
187.5 fun check_rule ctxt cs params ((binding, att), rule) =
187.6 let
187.7 - val err_name = Binding.display binding;
187.8 + val err_name = Binding.str_of binding;
187.9 val params' = Term.variant_frees rule (Logic.strip_params rule);
187.10 val frees = rev (map Free params');
187.11 val concl = subst_bounds (frees, Logic.strip_assums_concl rule);
187.12 @@ -517,7 +517,7 @@
187.13 (HOLogic.dest_Trueprop (Logic.strip_assums_concl r))
187.14
187.15 in list_all_free (Logic.strip_params r,
187.16 - Logic.list_implies (map HOLogic.mk_Trueprop (foldr mk_prem
187.17 + Logic.list_implies (map HOLogic.mk_Trueprop (List.foldr mk_prem
187.18 [] (map HOLogic.dest_Trueprop (Logic.strip_assums_hyp r))),
187.19 HOLogic.mk_Trueprop (list_comb (List.nth (preds, i), ys))))
187.20 end;
187.21 @@ -541,7 +541,7 @@
187.22 (* make predicate for instantiation of abstract induction rule *)
187.23
187.24 val ind_pred = fold_rev lambda (bs @ xs) (foldr1 HOLogic.mk_conj
187.25 - (map_index (fn (i, P) => foldr HOLogic.mk_imp
187.26 + (map_index (fn (i, P) => List.foldr HOLogic.mk_imp
187.27 (list_comb (P, make_args' argTs xs (binder_types (fastype_of P))))
187.28 (make_bool_args HOLogic.mk_not I bs i)) preds));
187.29
187.30 @@ -624,7 +624,7 @@
187.31 map HOLogic.mk_eq (make_args' argTs xs Ts ~~ ts) @
187.32 map (subst o HOLogic.dest_Trueprop)
187.33 (Logic.strip_assums_hyp r)
187.34 - in foldr (fn ((x, T), P) => HOLogic.exists_const T $ (Abs (x, T, P)))
187.35 + in List.foldr (fn ((x, T), P) => HOLogic.exists_const T $ (Abs (x, T, P)))
187.36 (if null ps then HOLogic.true_const else foldr1 HOLogic.mk_conj ps)
187.37 (Logic.strip_params r)
187.38 end
187.39 @@ -639,7 +639,7 @@
187.40
187.41 val rec_name =
187.42 if Binding.is_empty alt_name then
187.43 - Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
187.44 + Binding.name (space_implode "_" (map (Binding.name_of o fst) cnames_syn))
187.45 else alt_name;
187.46
187.47 val ((rec_const, (_, fp_def)), ctxt') = ctxt |>
187.48 @@ -674,9 +674,9 @@
187.49 fun declare_rules kind rec_binding coind no_ind cnames intrs intr_bindings intr_atts
187.50 elims raw_induct ctxt =
187.51 let
187.52 - val rec_name = Binding.base_name rec_binding;
187.53 - val rec_qualified = Binding.qualify rec_name;
187.54 - val intr_names = map Binding.base_name intr_bindings;
187.55 + val rec_name = Binding.name_of rec_binding;
187.56 + val rec_qualified = Binding.qualify false rec_name;
187.57 + val intr_names = map Binding.name_of intr_bindings;
187.58 val ind_case_names = RuleCases.case_names intr_names;
187.59 val induct =
187.60 if coind then
187.61 @@ -734,11 +734,11 @@
187.62 cs intros monos params cnames_syn ctxt =
187.63 let
187.64 val _ = null cnames_syn andalso error "No inductive predicates given";
187.65 - val names = map (Binding.base_name o fst) cnames_syn;
187.66 + val names = map (Binding.name_of o fst) cnames_syn;
187.67 val _ = message (quiet_mode andalso not verbose)
187.68 ("Proofs for " ^ coind_prefix coind ^ "inductive predicate(s) " ^ commas_quote names);
187.69
187.70 - val cnames = map (Sign.full_name (ProofContext.theory_of ctxt) o #1) cnames_syn; (* FIXME *)
187.71 + val cnames = map (LocalTheory.full_name ctxt o #1) cnames_syn; (* FIXME *)
187.72 val ((intr_names, intr_atts), intr_ts) =
187.73 apfst split_list (split_list (map (check_rule ctxt cs params) intros));
187.74
187.75 @@ -749,7 +749,7 @@
187.76 val (intrs, unfold) = prove_intrs quiet_mode coind mono fp_def (length bs + length xs)
187.77 params intr_ts rec_preds_defs ctxt1;
187.78 val elims = if no_elim then [] else
187.79 - prove_elims quiet_mode cs params intr_ts (map Binding.base_name intr_names)
187.80 + prove_elims quiet_mode cs params intr_ts (map Binding.name_of intr_names)
187.81 unfold rec_preds_defs ctxt1;
187.82 val raw_induct = zero_var_indexes
187.83 (if no_ind then Drule.asm_rl else
187.84 @@ -793,7 +793,7 @@
187.85
187.86 (* abbrevs *)
187.87
187.88 - val (_, ctxt1) = Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn) lthy;
187.89 + val (_, ctxt1) = Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn) lthy;
187.90
187.91 fun get_abbrev ((name, atts), t) =
187.92 if can (Logic.strip_assums_concl #> Logic.dest_equals) t then
187.93 @@ -802,7 +802,7 @@
187.94 error "Abbreviations may not have names or attributes";
187.95 val ((x, T), rhs) = LocalDefs.abs_def (snd (LocalDefs.cert_def ctxt1 t));
187.96 val var =
187.97 - (case find_first (fn ((c, _), _) => Binding.base_name c = x) cnames_syn of
187.98 + (case find_first (fn ((c, _), _) => Binding.name_of c = x) cnames_syn of
187.99 NONE => error ("Undeclared head of abbreviation " ^ quote x)
187.100 | SOME ((b, T'), mx) =>
187.101 if T <> T' then error ("Bad type specification for abbreviation " ^ quote x)
187.102 @@ -811,17 +811,17 @@
187.103 else NONE;
187.104
187.105 val abbrevs = map_filter get_abbrev spec;
187.106 - val bs = map (Binding.base_name o fst o fst) abbrevs;
187.107 + val bs = map (Binding.name_of o fst o fst) abbrevs;
187.108
187.109
187.110 (* predicates *)
187.111
187.112 val pre_intros = filter_out (is_some o get_abbrev) spec;
187.113 - val cnames_syn' = filter_out (member (op =) bs o Binding.base_name o fst o fst) cnames_syn;
187.114 - val cs = map (Free o apfst Binding.base_name o fst) cnames_syn';
187.115 + val cnames_syn' = filter_out (member (op =) bs o Binding.name_of o fst o fst) cnames_syn;
187.116 + val cs = map (Free o apfst Binding.name_of o fst) cnames_syn';
187.117 val ps = map Free pnames;
187.118
187.119 - val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.base_name o fst o fst) cnames_syn');
187.120 + val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn');
187.121 val _ = map (fn abbr => LocalDefs.fixed_abbrev abbr ctxt2) abbrevs;
187.122 val ctxt3 = ctxt2 |> fold (snd oo LocalDefs.fixed_abbrev) abbrevs;
187.123 val expand = Assumption.export_term ctxt3 lthy #> ProofContext.cert_term lthy;
187.124 @@ -854,7 +854,7 @@
187.125 in
187.126 lthy
187.127 |> LocalTheory.set_group (serial_string ())
187.128 - |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.base_name o fst) ps) intrs monos
187.129 + |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.name_of o fst) ps) intrs monos
187.130 end;
187.131
187.132 val add_inductive_i = gen_add_inductive_i add_ind_def;
187.133 @@ -954,7 +954,7 @@
187.134 else if Binding.is_empty b then ((a, atts), B)
187.135 else error "Illegal nested case names"
187.136 | ((b, _), _) => error "Illegal simultaneous specification")
187.137 - | (a, _) => error ("Illegal local specification parameters for " ^ quote (Binding.base_name a)));
187.138 + | (a, _) => error ("Illegal local specification parameters for " ^ quote (Binding.str_of a)));
187.139
187.140 fun gen_ind_decl mk_def coind =
187.141 P.fixes -- P.for_fixes --
188.1 --- a/src/HOL/Tools/inductive_realizer.ML Wed Mar 04 10:43:39 2009 +0100
188.2 +++ b/src/HOL/Tools/inductive_realizer.ML Wed Mar 04 10:45:52 2009 +0100
188.3 @@ -55,7 +55,7 @@
188.4 (subst_bound (Free (name, T), P), subst_bound (Free (name, T), Q))
188.5 | strip_one _ (Const ("==>", _) $ P $ Q) = (P, Q);
188.6
188.7 -fun relevant_vars prop = foldr (fn
188.8 +fun relevant_vars prop = List.foldr (fn
188.9 (Var ((a, i), T), vs) => (case strip_type T of
188.10 (_, Type (s, _)) => if s mem ["bool"] then (a, T) :: vs else vs
188.11 | _ => vs)
188.12 @@ -264,7 +264,7 @@
188.13 val rlz'' = fold_rev Logic.all vs2 rlz
188.14 in (name, (vs,
188.15 if rt = Extraction.nullt then rt else
188.16 - foldr (uncurry lambda) rt vs1,
188.17 + List.foldr (uncurry lambda) rt vs1,
188.18 ProofRewriteRules.un_hhf_proof rlz' rlz''
188.19 (fold_rev forall_intr_prf (vs2 @ rs) (prf_of rrule))))
188.20 end;
188.21 @@ -315,7 +315,7 @@
188.22 fun get f = (these oo Option.map) f;
188.23 val rec_names = distinct (op =) (map (fst o dest_Const o head_of o fst o
188.24 HOLogic.dest_eq o HOLogic.dest_Trueprop o prop_of) (get #rec_thms dt_info));
188.25 - val (_, constrss) = foldl_map (fn ((recs, dummies), (s, rs)) =>
188.26 + val (_, constrss) = Library.foldl_map (fn ((recs, dummies), (s, rs)) =>
188.27 if s mem rsets then
188.28 let
188.29 val (d :: dummies') = dummies;
189.1 --- a/src/HOL/Tools/inductive_set_package.ML Wed Mar 04 10:43:39 2009 +0100
189.2 +++ b/src/HOL/Tools/inductive_set_package.ML Wed Mar 04 10:45:52 2009 +0100
189.3 @@ -464,7 +464,7 @@
189.4 | NONE => u)) |>
189.5 Pattern.rewrite_term thy [] [to_pred_proc thy eqns'] |>
189.6 eta_contract (member op = cs' orf is_pred pred_arities))) intros;
189.7 - val cnames_syn' = map (fn (b, _) => (Binding.map_base (suffix "p") b, NoSyn)) cnames_syn;
189.8 + val cnames_syn' = map (fn (b, _) => (Binding.map_name (suffix "p") b, NoSyn)) cnames_syn;
189.9 val monos' = map (to_pred [] (Context.Proof ctxt)) monos;
189.10 val ({preds, intrs, elims, raw_induct, ...}, ctxt1) =
189.11 InductivePackage.add_ind_def
189.12 @@ -501,9 +501,9 @@
189.13 (* convert theorems to set notation *)
189.14 val rec_name =
189.15 if Binding.is_empty alt_name then
189.16 - Binding.name (space_implode "_" (map (Binding.base_name o fst) cnames_syn))
189.17 + Binding.name (space_implode "_" (map (Binding.name_of o fst) cnames_syn))
189.18 else alt_name;
189.19 - val cnames = map (Sign.full_name (ProofContext.theory_of ctxt3) o #1) cnames_syn; (* FIXME *)
189.20 + val cnames = map (LocalTheory.full_name ctxt3 o #1) cnames_syn; (* FIXME *)
189.21 val (intr_names, intr_atts) = split_list (map fst intros);
189.22 val raw_induct' = to_set [] (Context.Proof ctxt3) raw_induct;
189.23 val (intrs', elims', induct, ctxt4) =
190.1 --- a/src/HOL/Tools/int_factor_simprocs.ML Wed Mar 04 10:43:39 2009 +0100
190.2 +++ b/src/HOL/Tools/int_factor_simprocs.ML Wed Mar 04 10:45:52 2009 +0100
190.3 @@ -216,7 +216,7 @@
190.4
190.5 (** Final simplification for the CancelFactor simprocs **)
190.6 val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq
190.7 - [@{thm mult_1_left}, @{thm mult_1_right}, @{thm zdiv_1}, @{thm numeral_1_eq_1}];
190.8 + [@{thm mult_1_left}, @{thm mult_1_right}, @{thm div_by_1}, @{thm numeral_1_eq_1}];
190.9
190.10 fun cancel_simplify_meta_eq cancel_th ss th =
190.11 simplify_one ss (([th, cancel_th]) MRS trans);
190.12 @@ -263,8 +263,8 @@
190.13 (open CancelFactorCommon
190.14 val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
190.15 val mk_bal = HOLogic.mk_binrel @{const_name Ring_and_Field.dvd}
190.16 - val dest_bal = HOLogic.dest_bin @{const_name Ring_and_Field.dvd} HOLogic.intT
190.17 - val simplify_meta_eq = cancel_simplify_meta_eq @{thm zdvd_zmult_cancel_disj}
190.18 + val dest_bal = HOLogic.dest_bin @{const_name Ring_and_Field.dvd} Term.dummyT
190.19 + val simplify_meta_eq = cancel_simplify_meta_eq @{thm dvd_mult_cancel_left}
190.20 );
190.21
190.22 (*Version for all fields, including unordered ones (type complex).*)
190.23 @@ -288,8 +288,8 @@
190.24 ("int_mod_cancel_factor",
190.25 ["((l::int) * m) mod n", "(l::int) mod (m * n)"],
190.26 K IntModCancelFactor.proc),
190.27 - ("int_dvd_cancel_factor",
190.28 - ["((l::int) * m) dvd n", "(l::int) dvd (m * n)"],
190.29 + ("dvd_cancel_factor",
190.30 + ["((l::'a::idom) * m) dvd n", "(l::'a::idom) dvd (m * n)"],
190.31 K IntDvdCancelFactor.proc),
190.32 ("divide_cancel_factor",
190.33 ["((l::'a::{division_by_zero,field}) * m) / n",
191.1 --- a/src/HOL/Tools/lin_arith.ML Wed Mar 04 10:43:39 2009 +0100
191.2 +++ b/src/HOL/Tools/lin_arith.ML Wed Mar 04 10:45:52 2009 +0100
191.3 @@ -672,7 +672,7 @@
191.4 let
191.5 fun filter_prems (t, (left, right)) =
191.6 if p t then (left, right @ [t]) else (left @ right, [])
191.7 - val (left, right) = foldl filter_prems ([], []) terms
191.8 + val (left, right) = List.foldl filter_prems ([], []) terms
191.9 in
191.10 right @ left
191.11 end;
192.1 --- a/src/HOL/Tools/meson.ML Wed Mar 04 10:43:39 2009 +0100
192.2 +++ b/src/HOL/Tools/meson.ML Wed Mar 04 10:45:52 2009 +0100
192.3 @@ -92,7 +92,7 @@
192.4 | pairs =>
192.5 let val thy = theory_of_thm th
192.6 val (tyenv,tenv) =
192.7 - foldl (uncurry (Pattern.first_order_match thy)) (tyenv0,tenv0) pairs
192.8 + List.foldl (uncurry (Pattern.first_order_match thy)) (tyenv0,tenv0) pairs
192.9 val t_pairs = map term_pair_of (Vartab.dest tenv)
192.10 val th' = Thm.instantiate ([], map (pairself (cterm_of thy)) t_pairs) th
192.11 in th' end
192.12 @@ -428,7 +428,7 @@
192.13 fun name_thms label =
192.14 let fun name1 (th, (k,ths)) =
192.15 (k-1, Thm.put_name_hint (label ^ string_of_int k) th :: ths)
192.16 - in fn ths => #2 (foldr name1 (length ths, []) ths) end;
192.17 + in fn ths => #2 (List.foldr name1 (length ths, []) ths) end;
192.18
192.19 (*Is the given disjunction an all-negative support clause?*)
192.20 fun is_negative th = forall (not o #1) (literals (prop_of th));
192.21 @@ -477,7 +477,7 @@
192.22 (*Sums the sizes of the subgoals, ignoring hypotheses (ancestors)*)
192.23 fun addconcl(prem,sz) = size_of_term(Logic.strip_assums_concl prem) + sz
192.24
192.25 -fun size_of_subgoals st = foldr addconcl 0 (prems_of st);
192.26 +fun size_of_subgoals st = List.foldr addconcl 0 (prems_of st);
192.27
192.28
192.29 (*Negation Normal Form*)
192.30 @@ -544,12 +544,12 @@
192.31
192.32 (*Make clauses from a list of theorems, previously Skolemized and put into nnf.
192.33 The resulting clauses are HOL disjunctions.*)
192.34 -fun make_clauses ths = sort_clauses (foldr add_clauses [] ths);
192.35 +fun make_clauses ths = sort_clauses (List.foldr add_clauses [] ths);
192.36
192.37 (*Convert a list of clauses (disjunctions) to Horn clauses (contrapositives)*)
192.38 fun make_horns ths =
192.39 name_thms "Horn#"
192.40 - (distinct Thm.eq_thm_prop (foldr (add_contras clause_rules) [] ths));
192.41 + (distinct Thm.eq_thm_prop (List.foldr (add_contras clause_rules) [] ths));
192.42
192.43 (*Could simply use nprems_of, which would count remaining subgoals -- no
192.44 discrimination as to their size! With BEST_FIRST, fails for problem 41.*)
193.1 --- a/src/HOL/Tools/metis_tools.ML Wed Mar 04 10:43:39 2009 +0100
193.2 +++ b/src/HOL/Tools/metis_tools.ML Wed Mar 04 10:45:52 2009 +0100
193.3 @@ -543,9 +543,9 @@
193.4 val all_thms_FO = forall (Meson.is_fol_term thy o prop_of)
193.5 val isFO = (mode = ResAtp.Fol) orelse
193.6 (mode <> ResAtp.Hol andalso all_thms_FO (cls @ ths))
193.7 - val lmap0 = foldl (add_thm true ctxt)
193.8 + val lmap0 = List.foldl (add_thm true ctxt)
193.9 {isFO = isFO, axioms = [], tfrees = init_tfrees ctxt} cls
193.10 - val lmap = foldl (add_thm false ctxt) (add_tfrees lmap0) ths
193.11 + val lmap = List.foldl (add_thm false ctxt) (add_tfrees lmap0) ths
193.12 val clause_lists = map (Metis.Thm.clause o #1) (#axioms lmap)
193.13 fun used c = exists (Metis.LiteralSet.exists (const_in_metis c)) clause_lists
193.14 (*Now check for the existence of certain combinators*)
193.15 @@ -556,7 +556,7 @@
193.16 val thS = if used "c_COMBS" then [comb_S] else []
193.17 val thEQ = if used "c_fequal" then [fequal_imp_equal', equal_imp_fequal'] else []
193.18 val lmap' = if isFO then lmap
193.19 - else foldl (add_thm false ctxt) lmap (thEQ @ thS @ thC @ thB @ thK @ thI)
193.20 + else List.foldl (add_thm false ctxt) lmap (thEQ @ thS @ thC @ thB @ thK @ thI)
193.21 in
193.22 add_type_thm (type_ext thy (map prop_of (cls @ ths))) lmap'
193.23 end;
194.1 --- a/src/HOL/Tools/old_primrec_package.ML Wed Mar 04 10:43:39 2009 +0100
194.2 +++ b/src/HOL/Tools/old_primrec_package.ML Wed Mar 04 10:45:52 2009 +0100
194.3 @@ -37,8 +37,8 @@
194.4 fun varify (t, (i, ts)) =
194.5 let val t' = map_types (Logic.incr_tvar (i + 1)) (snd (Type.varify [] t))
194.6 in (maxidx_of_term t', t'::ts) end;
194.7 - val (i, cs') = foldr varify (~1, []) cs;
194.8 - val (i', intr_ts') = foldr varify (i, []) intr_ts;
194.9 + val (i, cs') = List.foldr varify (~1, []) cs;
194.10 + val (i', intr_ts') = List.foldr varify (i, []) intr_ts;
194.11 val rec_consts = fold Term.add_consts cs' [];
194.12 val intr_consts = fold Term.add_consts intr_ts' [];
194.13 fun unify (cname, cT) =
195.1 --- a/src/HOL/Tools/primrec_package.ML Wed Mar 04 10:43:39 2009 +0100
195.2 +++ b/src/HOL/Tools/primrec_package.ML Wed Mar 04 10:45:52 2009 +0100
195.3 @@ -194,7 +194,7 @@
195.4 val def_name = Thm.def_name (Sign.base_name fname);
195.5 val rhs = singleton (Syntax.check_terms ctxt) raw_rhs;
195.6 val SOME var = get_first (fn ((b, _), mx) =>
195.7 - if Binding.base_name b = fname then SOME (b, mx) else NONE) fixes;
195.8 + if Binding.name_of b = fname then SOME (b, mx) else NONE) fixes;
195.9 in (var, ((Binding.name def_name, []), rhs)) end;
195.10
195.11
195.12 @@ -231,7 +231,7 @@
195.13 let
195.14 val (fixes, spec) = prepare_spec prep_spec lthy raw_fixes raw_spec;
195.15 val eqns = fold_rev (process_eqn (fn v => Variable.is_fixed lthy v
195.16 - orelse exists (fn ((w, _), _) => v = Binding.base_name w) fixes) o snd) spec [];
195.17 + orelse exists (fn ((w, _), _) => v = Binding.name_of w) fixes) o snd) spec [];
195.18 val tnames = distinct (op =) (map (#1 o snd) eqns);
195.19 val dts = find_dts (DatatypePackage.get_datatypes (ProofContext.theory_of lthy)) tnames tnames;
195.20 val main_fns = map (fn (tname, {index, ...}) =>
195.21 @@ -248,7 +248,7 @@
195.22 else primrec_error ("functions " ^ commas_quote names2 ^
195.23 "\nare not mutually recursive");
195.24 val prefix = space_implode "_" (map (Sign.base_name o #1) defs);
195.25 - val qualify = Binding.qualify prefix;
195.26 + val qualify = Binding.qualify false prefix;
195.27 val spec' = (map o apfst)
195.28 (fn (b, attrs) => (qualify b, Code.add_default_eqn_attrib :: attrs)) spec;
195.29 val simp_atts = map (Attrib.internal o K)
195.30 @@ -299,7 +299,7 @@
195.31 P.name >> pair false) --| P.$$$ ")")) (false, "");
195.32
195.33 val old_primrec_decl =
195.34 - opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop);
195.35 + opt_unchecked_name -- Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop);
195.36
195.37 fun pipe_error t = P.!!! (Scan.fail_with (K
195.38 (cat_lines ["Equations must be separated by " ^ quote "|", quote t])));
196.1 --- a/src/HOL/Tools/recdef_package.ML Wed Mar 04 10:43:39 2009 +0100
196.2 +++ b/src/HOL/Tools/recdef_package.ML Wed Mar 04 10:45:52 2009 +0100
196.3 @@ -320,7 +320,7 @@
196.4 val _ =
196.5 OuterSyntax.local_theory_to_proof' "recdef_tc" "recommence proof of termination condition (TFL)"
196.6 K.thy_goal
196.7 - ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.xname --
196.8 + ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.xname --
196.9 Scan.option (P.$$$ "(" |-- P.nat --| P.$$$ ")")
196.10 >> (fn ((thm_name, name), i) => recdef_tc thm_name name i));
196.11
197.1 --- a/src/HOL/Tools/recfun_codegen.ML Wed Mar 04 10:43:39 2009 +0100
197.2 +++ b/src/HOL/Tools/recfun_codegen.ML Wed Mar 04 10:45:52 2009 +0100
197.3 @@ -143,7 +143,7 @@
197.4 val eqs'' = map (dest_eq o prop_of) (List.concat (map fst thmss));
197.5 val (fundef', gr3) = mk_fundef module' "" true eqs''
197.6 (add_edge (dname, dep)
197.7 - (foldr (uncurry new_node) (del_nodes xs gr2)
197.8 + (List.foldr (uncurry new_node) (del_nodes xs gr2)
197.9 (map (fn k =>
197.10 (k, (SOME (EQN ("", dummyT, dname)), module', ""))) xs)))
197.11 in (module', put_code module' fundef' gr3) end
198.1 --- a/src/HOL/Tools/record_package.ML Wed Mar 04 10:43:39 2009 +0100
198.2 +++ b/src/HOL/Tools/record_package.ML Wed Mar 04 10:45:52 2009 +0100
198.3 @@ -1778,7 +1778,7 @@
198.4 val names = map fst fields;
198.5 val extN = full bname;
198.6 val types = map snd fields;
198.7 - val alphas_fields = foldr OldTerm.add_typ_tfree_names [] types;
198.8 + val alphas_fields = List.foldr OldTerm.add_typ_tfree_names [] types;
198.9 val alphas_ext = alphas inter alphas_fields;
198.10 val len = length fields;
198.11 val variants = Name.variant_list (moreN::rN::rN ^ "'"::wN::parent_variants) (map fst bfields);
198.12 @@ -1835,7 +1835,7 @@
198.13 let val (args',more) = chop_last args;
198.14 fun mk_ext' (((name,T),args),more) = mk_ext (name,T) (args@[more]);
198.15 fun build Ts =
198.16 - foldr mk_ext' more (prune n (extension_names ~~ Ts ~~ (chunks parent_chunks args')))
198.17 + List.foldr mk_ext' more (prune n (extension_names ~~ Ts ~~ (chunks parent_chunks args')))
198.18 in
198.19 if more = HOLogic.unit
198.20 then build (map recT (0 upto parent_len))
198.21 @@ -2003,13 +2003,13 @@
198.22 end;
198.23
198.24 val split_object_prop =
198.25 - let fun ALL vs t = foldr (fn ((v,T),t) => HOLogic.mk_all (v,T,t)) t vs
198.26 + let fun ALL vs t = List.foldr (fn ((v,T),t) => HOLogic.mk_all (v,T,t)) t vs
198.27 in (ALL [dest_Free r0] (P $ r0)) === (ALL (map dest_Free all_vars_more) (P $ r_rec0))
198.28 end;
198.29
198.30
198.31 val split_ex_prop =
198.32 - let fun EX vs t = foldr (fn ((v,T),t) => HOLogic.mk_exists (v,T,t)) t vs
198.33 + let fun EX vs t = List.foldr (fn ((v,T),t) => HOLogic.mk_exists (v,T,t)) t vs
198.34 in (EX [dest_Free r0] (P $ r0)) === (EX (map dest_Free all_vars_more) (P $ r_rec0))
198.35 end;
198.36
198.37 @@ -2228,7 +2228,7 @@
198.38 val init_env =
198.39 (case parent of
198.40 NONE => []
198.41 - | SOME (types, _) => foldr OldTerm.add_typ_tfrees [] types);
198.42 + | SOME (types, _) => List.foldr OldTerm.add_typ_tfrees [] types);
198.43
198.44
198.45 (* fields *)
199.1 --- a/src/HOL/Tools/refute.ML Wed Mar 04 10:43:39 2009 +0100
199.2 +++ b/src/HOL/Tools/refute.ML Wed Mar 04 10:45:52 2009 +0100
199.3 @@ -63,7 +63,6 @@
199.4
199.5 val close_form : Term.term -> Term.term
199.6 val get_classdef : theory -> string -> (string * Term.term) option
199.7 - val norm_rhs : Term.term -> Term.term
199.8 val get_def : theory -> string * Term.typ -> (string * Term.term) option
199.9 val get_typedef : theory -> Term.typ -> (string * Term.term) option
199.10 val is_IDT_constructor : theory -> string * Term.typ -> bool
199.11 @@ -549,21 +548,6 @@
199.12 end;
199.13
199.14 (* ------------------------------------------------------------------------- *)
199.15 -(* norm_rhs: maps f ?t1 ... ?tn == rhs to %t1...tn. rhs *)
199.16 -(* ------------------------------------------------------------------------- *)
199.17 -
199.18 - (* Term.term -> Term.term *)
199.19 - fun norm_rhs eqn =
199.20 - let
199.21 - fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
199.22 - | lambda v t = raise TERM ("lambda", [v, t])
199.23 - val (lhs, rhs) = Logic.dest_equals eqn
199.24 - val (_, args) = Term.strip_comb lhs
199.25 - in
199.26 - fold lambda (rev args) rhs
199.27 - end
199.28 -
199.29 -(* ------------------------------------------------------------------------- *)
199.30 (* get_def: looks up the definition of a constant, as created by "constdefs" *)
199.31 (* ------------------------------------------------------------------------- *)
199.32
199.33 @@ -571,6 +555,16 @@
199.34
199.35 fun get_def thy (s, T) =
199.36 let
199.37 + (* maps f ?t1 ... ?tn == rhs to %t1...tn. rhs *)
199.38 + fun norm_rhs eqn =
199.39 + let
199.40 + fun lambda (v as Var ((x, _), T)) t = Abs (x, T, abstract_over (v, t))
199.41 + | lambda v t = raise TERM ("lambda", [v, t])
199.42 + val (lhs, rhs) = Logic.dest_equals eqn
199.43 + val (_, args) = Term.strip_comb lhs
199.44 + in
199.45 + fold lambda (rev args) rhs
199.46 + end
199.47 (* (string * Term.term) list -> (string * Term.term) option *)
199.48 fun get_def_ax [] = NONE
199.49 | get_def_ax ((axname, ax) :: axioms) =
199.50 @@ -991,7 +985,7 @@
199.51 DatatypeAux.DtTFree _ =>
199.52 collect_types dT acc
199.53 | DatatypeAux.DtType (_, ds) =>
199.54 - collect_types dT (foldr collect_dtyp acc ds)
199.55 + collect_types dT (List.foldr collect_dtyp acc ds)
199.56 | DatatypeAux.DtRec i =>
199.57 if dT mem acc then
199.58 acc (* prevent infinite recursion *)
199.59 @@ -1005,9 +999,9 @@
199.60 insert (op =) dT acc
199.61 else acc
199.62 (* collect argument types *)
199.63 - val acc_dtyps = foldr collect_dtyp acc_dT dtyps
199.64 + val acc_dtyps = List.foldr collect_dtyp acc_dT dtyps
199.65 (* collect constructor types *)
199.66 - val acc_dconstrs = foldr collect_dtyp acc_dtyps
199.67 + val acc_dconstrs = List.foldr collect_dtyp acc_dtyps
199.68 (List.concat (map snd dconstrs))
199.69 in
199.70 acc_dconstrs
199.71 @@ -1108,7 +1102,7 @@
199.72 case next (maxsize-minsize) 0 0 diffs of
199.73 SOME diffs' =>
199.74 (* merge with those types for which the size is fixed *)
199.75 - SOME (snd (foldl_map (fn (ds, (T, _)) =>
199.76 + SOME (snd (Library.foldl_map (fn (ds, (T, _)) =>
199.77 case AList.lookup (op =) sizes (string_of_typ T) of
199.78 (* return the fixed size *)
199.79 SOME n => (ds, (T, n))
199.80 @@ -1202,7 +1196,7 @@
199.81 val _ = Output.immediate_output ("Translating term (sizes: "
199.82 ^ commas (map (fn (_, n) => string_of_int n) universe) ^ ") ...")
199.83 (* translate 'u' and all axioms *)
199.84 - val ((model, args), intrs) = foldl_map (fn ((m, a), t') =>
199.85 + val ((model, args), intrs) = Library.foldl_map (fn ((m, a), t') =>
199.86 let
199.87 val (i, m', a') = interpret thy m a t'
199.88 in
199.89 @@ -1618,7 +1612,7 @@
199.90 val Ts = Term.binder_types (Term.fastype_of t)
199.91 val t' = Term.incr_boundvars i t
199.92 in
199.93 - foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
199.94 + List.foldr (fn (T, term) => Abs ("<eta_expand>", T, term))
199.95 (Term.list_comb (t', map Bound (i-1 downto 0))) (List.take (Ts, i))
199.96 end;
199.97
199.98 @@ -1628,7 +1622,7 @@
199.99
199.100 (* int list -> int *)
199.101
199.102 - fun sum xs = foldl op+ 0 xs;
199.103 + fun sum xs = List.foldl op+ 0 xs;
199.104
199.105 (* ------------------------------------------------------------------------- *)
199.106 (* product: returns the product of a list 'xs' of integers *)
199.107 @@ -1636,7 +1630,7 @@
199.108
199.109 (* int list -> int *)
199.110
199.111 - fun product xs = foldl op* 1 xs;
199.112 + fun product xs = List.foldl op* 1 xs;
199.113
199.114 (* ------------------------------------------------------------------------- *)
199.115 (* size_of_dtyp: the size of (an initial fragment of) an inductive data type *)
199.116 @@ -1756,7 +1750,7 @@
199.117 (* create all constants of type 'T' *)
199.118 val constants = make_constants thy model T
199.119 (* interpret the 'body' separately for each constant *)
199.120 - val ((model', args'), bodies) = foldl_map
199.121 + val ((model', args'), bodies) = Library.foldl_map
199.122 (fn ((m, a), c) =>
199.123 let
199.124 (* add 'c' to 'bounds' *)
199.125 @@ -2100,7 +2094,7 @@
199.126 Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
199.127 in
199.128 (* functions as graphs, i.e. as a (HOL) set of pairs "(x, y)" *)
199.129 - map (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
199.130 + map (List.foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
199.131 HOLogic_empty_set) pairss
199.132 end
199.133 | Type (s, Ts) =>
199.134 @@ -2292,7 +2286,7 @@
199.135 | search [] _ = ()
199.136 in search terms' terms end
199.137 (* int * interpretation list *)
199.138 - val (new_offset, intrs) = foldl_map (fn (off, t_elem) =>
199.139 + val (new_offset, intrs) = Library.foldl_map (fn (off, t_elem) =>
199.140 (* if 't_elem' existed at the previous depth, *)
199.141 (* proceed recursively, otherwise map the entire *)
199.142 (* subtree to "undefined" *)
199.143 @@ -2358,7 +2352,7 @@
199.144 else (* mconstrs_count = length params *)
199.145 let
199.146 (* interpret each parameter separately *)
199.147 - val ((model', args'), p_intrs) = foldl_map (fn ((m, a), p) =>
199.148 + val ((model', args'), p_intrs) = Library.foldl_map (fn ((m, a), p) =>
199.149 let
199.150 val (i, m', a') = interpret thy m a p
199.151 in
199.152 @@ -2470,7 +2464,7 @@
199.153 end) descr
199.154 (* associate constructors with corresponding parameters *)
199.155 (* (int * (interpretation * interpretation) list) list *)
199.156 - val (p_intrs', mc_p_intrs) = foldl_map
199.157 + val (p_intrs', mc_p_intrs) = Library.foldl_map
199.158 (fn (p_intrs', (idx, c_intrs)) =>
199.159 let
199.160 val len = length c_intrs
199.161 @@ -2636,7 +2630,7 @@
199.162 (* interpretation list *)
199.163 val arg_intrs = map (uncurry rec_intr) rec_dtyps_intrs
199.164 (* apply 'intr' to all recursive arguments *)
199.165 - val result = foldl (fn (arg_i, i) =>
199.166 + val result = List.foldl (fn (arg_i, i) =>
199.167 interpretation_apply (i, arg_i)) intr arg_intrs
199.168 (* update 'REC_OPERATORS' *)
199.169 val _ = Array.update (arr, elem, (true, result))
199.170 @@ -2916,7 +2910,7 @@
199.171 (* of width 'size_elem' and depth 'length_list' (with 'size_list' *)
199.172 (* nodes total) *)
199.173 (* (int * (int * int)) list *)
199.174 - val (_, lenoff_lists) = foldl_map (fn ((offsets, off), elem) =>
199.175 + val (_, lenoff_lists) = Library.foldl_map (fn ((offsets, off), elem) =>
199.176 (* corresponds to a pre-order traversal of the tree *)
199.177 let
199.178 val len = length offsets
199.179 @@ -3010,7 +3004,7 @@
199.180 "intersection: interpretation for set is not a node")
199.181 (* interpretation -> interpretaion *)
199.182 fun lfp (Node resultsets) =
199.183 - foldl (fn ((set, resultset), acc) =>
199.184 + List.foldl (fn ((set, resultset), acc) =>
199.185 if is_subset (resultset, set) then
199.186 intersection (acc, set)
199.187 else
199.188 @@ -3061,7 +3055,7 @@
199.189 "union: interpretation for set is not a node")
199.190 (* interpretation -> interpretaion *)
199.191 fun gfp (Node resultsets) =
199.192 - foldl (fn ((set, resultset), acc) =>
199.193 + List.foldl (fn ((set, resultset), acc) =>
199.194 if is_subset (set, resultset) then
199.195 union (acc, set)
199.196 else
199.197 @@ -3164,7 +3158,7 @@
199.198 val HOLogic_insert =
199.199 Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
199.200 in
199.201 - SOME (foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
199.202 + SOME (List.foldr (fn (pair, acc) => HOLogic_insert $ pair $ acc)
199.203 HOLogic_empty_set pairs)
199.204 end
199.205 | Type ("prop", []) =>
199.206 @@ -3299,8 +3293,6 @@
199.207 (* subterms that are then passed to other interpreters! *)
199.208 (* ------------------------------------------------------------------------- *)
199.209
199.210 - (* (theory -> theory) list *)
199.211 -
199.212 val setup =
199.213 add_interpreter "stlc" stlc_interpreter #>
199.214 add_interpreter "Pure" Pure_interpreter #>
200.1 --- a/src/HOL/Tools/res_atp.ML Wed Mar 04 10:43:39 2009 +0100
200.2 +++ b/src/HOL/Tools/res_atp.ML Wed Mar 04 10:45:52 2009 +0100
200.3 @@ -6,10 +6,7 @@
200.4 val tvar_classes_of_terms : term list -> string list
200.5 val tfree_classes_of_terms : term list -> string list
200.6 val type_consts_of_terms : theory -> term list -> string list
200.7 - val write_problem_files : (theory -> bool -> Thm.thm list -> string ->
200.8 - (thm * (ResHolClause.axiom_name * ResHolClause.clause_id)) list * ResClause.classrelClause list *
200.9 - ResClause.arityClause list -> string list -> ResHolClause.axiom_name list)
200.10 - -> int -> bool
200.11 + val write_problem_files : bool -> int -> bool
200.12 -> (int -> Path.T) -> Proof.context * thm list * thm
200.13 -> string list * ResHolClause.axiom_name Vector.vector list
200.14 end;
200.15 @@ -118,9 +115,9 @@
200.16 fun add_standard_const (s,tab) = Symtab.update (s,[]) tab;
200.17
200.18 val null_const_tab : const_typ list list Symtab.table =
200.19 - foldl add_standard_const Symtab.empty standard_consts;
200.20 + List.foldl add_standard_const Symtab.empty standard_consts;
200.21
200.22 -fun get_goal_consts_typs thy = foldl (add_term_consts_typs_rm thy) null_const_tab;
200.23 +fun get_goal_consts_typs thy = List.foldl (add_term_consts_typs_rm thy) null_const_tab;
200.24
200.25 (*Inserts a dummy "constant" referring to the theory name, so that relevance
200.26 takes the given theory into account.*)
200.27 @@ -193,7 +190,7 @@
200.28 end;
200.29
200.30 (*Multiplies out to a list of pairs: 'a * 'b list -> ('a * 'b) list -> ('a * 'b) list*)
200.31 -fun add_expand_pairs (x,ys) xys = foldl (fn (y,acc) => (x,y)::acc) xys ys;
200.32 +fun add_expand_pairs (x,ys) xys = List.foldl (fn (y,acc) => (x,y)::acc) xys ys;
200.33
200.34 fun consts_typs_of_term thy t =
200.35 let val tab = add_term_consts_typs_rm thy (t, null_const_tab)
200.36 @@ -253,7 +250,7 @@
200.37 | relevant (newpairs,rejects) [] =
200.38 let val (newrels,more_rejects) = take_best max_new newpairs
200.39 val new_consts = List.concat (map #2 newrels)
200.40 - val rel_consts' = foldl add_const_typ_table rel_consts new_consts
200.41 + val rel_consts' = List.foldl add_const_typ_table rel_consts new_consts
200.42 val newp = p + (1.0-p) / convergence
200.43 in
200.44 Output.debug (fn () => ("relevant this iteration: " ^ Int.toString (length newrels)));
200.45 @@ -379,7 +376,7 @@
200.46
200.47 fun add_single_names ((a, []), pairs) = pairs
200.48 | add_single_names ((a, [th]), pairs) = (a,th)::pairs
200.49 - | add_single_names ((a, ths), pairs) = #2 (foldl (multi_name a) (1,pairs) ths);
200.50 + | add_single_names ((a, ths), pairs) = #2 (List.foldl (multi_name a) (1,pairs) ths);
200.51
200.52 (*Ignore blacklisted basenames*)
200.53 fun add_multi_names ((a, ths), pairs) =
200.54 @@ -396,7 +393,7 @@
200.55 in
200.56 app (fn th => ignore (Polyhash.peekInsert ht (th,()))) (ResBlacklist.get ctxt);
200.57 filter (not o blacklisted o #2)
200.58 - (foldl add_single_names (foldl add_multi_names [] mults) singles)
200.59 + (List.foldl add_single_names (List.foldl add_multi_names [] mults) singles)
200.60 end;
200.61
200.62 fun check_named ("",th) = (warning ("No name for theorem " ^ Display.string_of_thm th); false)
200.63 @@ -434,18 +431,18 @@
200.64 (* Type Classes Present in the Axiom or Conjecture Clauses *)
200.65 (***************************************************************)
200.66
200.67 -fun add_classes (sorts, cset) = foldl setinsert cset (List.concat sorts);
200.68 +fun add_classes (sorts, cset) = List.foldl setinsert cset (List.concat sorts);
200.69
200.70 (*Remove this trivial type class*)
200.71 fun delete_type cset = Symtab.delete_safe "HOL.type" cset;
200.72
200.73 fun tvar_classes_of_terms ts =
200.74 let val sorts_list = map (map #2 o OldTerm.term_tvars) ts
200.75 - in Symtab.keys (delete_type (foldl add_classes Symtab.empty sorts_list)) end;
200.76 + in Symtab.keys (delete_type (List.foldl add_classes Symtab.empty sorts_list)) end;
200.77
200.78 fun tfree_classes_of_terms ts =
200.79 let val sorts_list = map (map #2 o OldTerm.term_tfrees) ts
200.80 - in Symtab.keys (delete_type (foldl add_classes Symtab.empty sorts_list)) end;
200.81 + in Symtab.keys (delete_type (List.foldl add_classes Symtab.empty sorts_list)) end;
200.82
200.83 (*fold type constructors*)
200.84 fun fold_type_consts f (Type (a, Ts)) x = fold (fold_type_consts f) Ts (f (a,x))
200.85 @@ -524,11 +521,10 @@
200.86 (* TODO: problem file for *one* subgoal would be sufficient *)
200.87 (*Write out problem files for each subgoal.
200.88 Argument probfile generates filenames from subgoal-number
200.89 - Argument writer is either a tptp_write_file or dfg_write_file from ResHolClause
200.90 Arguments max_new and theory_const are booleans controlling relevance_filter
200.91 (necessary for different provers)
200.92 - *)
200.93 -fun write_problem_files writer max_new theory_const probfile (ctxt, chain_ths, th) =
200.94 +*)
200.95 +fun write_problem_files dfg max_new theory_const probfile (ctxt, chain_ths, th) =
200.96 let val goals = Thm.prems_of th
200.97 val thy = ProofContext.theory_of ctxt
200.98 fun get_neg_subgoals [] _ = []
200.99 @@ -548,6 +544,7 @@
200.100 val white_cls = ResAxioms.cnf_rules_pairs thy white_thms
200.101 (*clauses relevant to goal gl*)
200.102 val axcls_list = map (fn ngcls => white_cls @ relevance_filter max_new theory_const thy included_cls (map prop_of ngcls)) goal_cls
200.103 + val writer = if dfg then ResHolClause.dfg_write_file else ResHolClause.tptp_write_file
200.104 fun write_all [] [] _ = []
200.105 | write_all (ccls::ccls_list) (axcls::axcls_list) k =
200.106 let val fname = File.platform_path (probfile k)
200.107 @@ -561,7 +558,7 @@
200.108 and supers = tvar_classes_of_terms axtms
200.109 and tycons = type_consts_of_terms thy (ccltms@axtms)
200.110 (*TFrees in conjecture clauses; TVars in axiom clauses*)
200.111 - val (supers',arity_clauses) = ResClause.make_arity_clauses thy tycons supers
200.112 + val (supers',arity_clauses) = ResClause.make_arity_clauses_dfg dfg thy tycons supers
200.113 val classrel_clauses = ResClause.make_classrel_clauses thy subs supers'
200.114 val clnames = writer thy isFO ccls fname (axcls,classrel_clauses,arity_clauses) []
200.115 val thm_names = Vector.fromList clnames
201.1 --- a/src/HOL/Tools/res_axioms.ML Wed Mar 04 10:43:39 2009 +0100
201.2 +++ b/src/HOL/Tools/res_axioms.ML Wed Mar 04 10:45:52 2009 +0100
201.3 @@ -494,7 +494,7 @@
201.4 val remaining_hyps = filter_out (member (op aconv) (map Thm.term_of defs))
201.5 (map Thm.term_of hyps)
201.6 val fixed = OldTerm.term_frees (concl_of st) @
201.7 - foldl (gen_union (op aconv)) [] (map OldTerm.term_frees remaining_hyps)
201.8 + List.foldl (gen_union (op aconv)) [] (map OldTerm.term_frees remaining_hyps)
201.9 in Seq.of_list [LocalDefs.expand (filter (is_okdef fixed o Thm.term_of) defs) st] end;
201.10
201.11
202.1 --- a/src/HOL/Tools/res_clause.ML Wed Mar 04 10:43:39 2009 +0100
202.2 +++ b/src/HOL/Tools/res_clause.ML Wed Mar 04 10:45:52 2009 +0100
202.3 @@ -1,5 +1,4 @@
202.4 (* Author: Jia Meng, Cambridge University Computer Laboratory
202.5 - ID: $Id$
202.6 Copyright 2004 University of Cambridge
202.7
202.8 Storing/printing FOL clauses and arity clauses.
202.9 @@ -27,9 +26,8 @@
202.10 val make_fixed_var : string -> string
202.11 val make_schematic_type_var : string * int -> string
202.12 val make_fixed_type_var : string -> string
202.13 - val dfg_format: bool ref
202.14 - val make_fixed_const : string -> string
202.15 - val make_fixed_type_const : string -> string
202.16 + val make_fixed_const : bool -> string -> string
202.17 + val make_fixed_type_const : bool -> string -> string
202.18 val make_type_class : string -> string
202.19 datatype kind = Axiom | Conjecture
202.20 type axiom_name = string
202.21 @@ -50,6 +48,7 @@
202.22 datatype classrelClause = ClassrelClause of
202.23 {axiom_name: axiom_name, subclass: class, superclass: class}
202.24 val make_classrel_clauses: theory -> class list -> class list -> classrelClause list
202.25 + val make_arity_clauses_dfg: bool -> theory -> string list -> class list -> class list * arityClause list
202.26 val make_arity_clauses: theory -> string list -> class list -> class list * arityClause list
202.27 val add_type_sort_preds: typ * int Symtab.table -> int Symtab.table
202.28 val add_classrelClause_preds : classrelClause * int Symtab.table -> int Symtab.table
202.29 @@ -95,7 +94,7 @@
202.30 val tconst_prefix = "tc_";
202.31 val class_prefix = "class_";
202.32
202.33 -fun union_all xss = foldl (op union) [] xss;
202.34 +fun union_all xss = List.foldl (op union) [] xss;
202.35
202.36 (*Provide readable names for the more common symbolic functions*)
202.37 val const_trans_table =
202.38 @@ -197,28 +196,26 @@
202.39 fun make_fixed_type_var x = tfree_prefix ^ (ascii_of (trim_type_var x));
202.40
202.41 (*HACK because SPASS truncates identifiers to 63 characters :-(( *)
202.42 -val dfg_format = ref false;
202.43 -
202.44 (*32-bit hash,so we expect no collisions unless there are around 65536 long identifiers...*)
202.45 -fun controlled_length s =
202.46 - if size s > 60 andalso !dfg_format
202.47 +fun controlled_length dfg_format s =
202.48 + if size s > 60 andalso dfg_format
202.49 then Word.toString (Polyhash.hashw_string(s,0w0))
202.50 else s;
202.51
202.52 -fun lookup_const c =
202.53 +fun lookup_const dfg c =
202.54 case Symtab.lookup const_trans_table c of
202.55 SOME c' => c'
202.56 - | NONE => controlled_length (ascii_of c);
202.57 + | NONE => controlled_length dfg (ascii_of c);
202.58
202.59 -fun lookup_type_const c =
202.60 +fun lookup_type_const dfg c =
202.61 case Symtab.lookup type_const_trans_table c of
202.62 SOME c' => c'
202.63 - | NONE => controlled_length (ascii_of c);
202.64 + | NONE => controlled_length dfg (ascii_of c);
202.65
202.66 -fun make_fixed_const "op =" = "equal" (*MUST BE "equal" because it's built-in to ATPs*)
202.67 - | make_fixed_const c = const_prefix ^ lookup_const c;
202.68 +fun make_fixed_const _ "op =" = "equal" (*MUST BE "equal" because it's built-in to ATPs*)
202.69 + | make_fixed_const dfg c = const_prefix ^ lookup_const dfg c;
202.70
202.71 -fun make_fixed_type_const c = tconst_prefix ^ lookup_type_const c;
202.72 +fun make_fixed_type_const dfg c = tconst_prefix ^ lookup_type_const dfg c;
202.73
202.74 fun make_type_class clas = class_prefix ^ ascii_of clas;
202.75
202.76 @@ -251,13 +248,13 @@
202.77
202.78 (*Flatten a type to a fol_type while accumulating sort constraints on the TFrees and
202.79 TVars it contains.*)
202.80 -fun type_of (Type (a, Ts)) =
202.81 - let val (folTyps, ts) = types_of Ts
202.82 - val t = make_fixed_type_const a
202.83 +fun type_of dfg (Type (a, Ts)) =
202.84 + let val (folTyps, ts) = types_of dfg Ts
202.85 + val t = make_fixed_type_const dfg a
202.86 in (Comp(t,folTyps), ts) end
202.87 - | type_of T = (atomic_type T, [T])
202.88 -and types_of Ts =
202.89 - let val (folTyps,ts) = ListPair.unzip (map type_of Ts)
202.90 + | type_of dfg T = (atomic_type T, [T])
202.91 +and types_of dfg Ts =
202.92 + let val (folTyps,ts) = ListPair.unzip (map (type_of dfg) Ts)
202.93 in (folTyps, union_all ts) end;
202.94
202.95 (*Make literals for sorted type variables*)
202.96 @@ -277,7 +274,7 @@
202.97 | pred_of_sort (LTFree (s,ty)) = (s,1)
202.98
202.99 (*Given a list of sorted type variables, return a list of type literals.*)
202.100 -fun add_typs Ts = foldl (op union) [] (map sorts_on_typs Ts);
202.101 +fun add_typs Ts = List.foldl (op union) [] (map sorts_on_typs Ts);
202.102
202.103 (*The correct treatment of TFrees like 'a in lemmas (axiom clauses) is not clear.
202.104 * Ignoring them leads to unsound proofs, since we do nothing to ensure that 'a
202.105 @@ -317,12 +314,12 @@
202.106 | pack_sort(tvar, cls::srt) = (cls, tvar) :: pack_sort(tvar, srt);
202.107
202.108 (*Arity of type constructor tcon :: (arg1,...,argN)res*)
202.109 -fun make_axiom_arity_clause (tcons, axiom_name, (cls,args)) =
202.110 +fun make_axiom_arity_clause dfg (tcons, axiom_name, (cls,args)) =
202.111 let val tvars = gen_TVars (length args)
202.112 val tvars_srts = ListPair.zip (tvars,args)
202.113 in
202.114 ArityClause {axiom_name = axiom_name,
202.115 - conclLit = TConsLit (cls, make_fixed_type_const tcons, tvars),
202.116 + conclLit = TConsLit (cls, make_fixed_type_const dfg tcons, tvars),
202.117 premLits = map TVarLit (union_all(map pack_sort tvars_srts))}
202.118 end;
202.119
202.120 @@ -340,8 +337,8 @@
202.121 let val class_less = Sorts.class_less(Sign.classes_of thy)
202.122 fun add_super sub (super,pairs) =
202.123 if class_less (sub,super) then (sub,super)::pairs else pairs
202.124 - fun add_supers (sub,pairs) = foldl (add_super sub) pairs supers
202.125 - in foldl add_supers [] subs end;
202.126 + fun add_supers (sub,pairs) = List.foldl (add_super sub) pairs supers
202.127 + in List.foldl add_supers [] subs end;
202.128
202.129 fun make_classrelClause (sub,super) =
202.130 ClassrelClause {axiom_name = clrelclause_prefix ^ ascii_of sub ^ "_" ^ ascii_of super,
202.131 @@ -354,20 +351,20 @@
202.132
202.133 (** Isabelle arities **)
202.134
202.135 -fun arity_clause _ _ (tcons, []) = []
202.136 - | arity_clause seen n (tcons, ("HOL.type",_)::ars) = (*ignore*)
202.137 - arity_clause seen n (tcons,ars)
202.138 - | arity_clause seen n (tcons, (ar as (class,_)) :: ars) =
202.139 +fun arity_clause dfg _ _ (tcons, []) = []
202.140 + | arity_clause dfg seen n (tcons, ("HOL.type",_)::ars) = (*ignore*)
202.141 + arity_clause dfg seen n (tcons,ars)
202.142 + | arity_clause dfg seen n (tcons, (ar as (class,_)) :: ars) =
202.143 if class mem_string seen then (*multiple arities for the same tycon, class pair*)
202.144 - make_axiom_arity_clause (tcons, lookup_type_const tcons ^ "_" ^ class ^ "_" ^ Int.toString n, ar) ::
202.145 - arity_clause seen (n+1) (tcons,ars)
202.146 + make_axiom_arity_clause dfg (tcons, lookup_type_const dfg tcons ^ "_" ^ class ^ "_" ^ Int.toString n, ar) ::
202.147 + arity_clause dfg seen (n+1) (tcons,ars)
202.148 else
202.149 - make_axiom_arity_clause (tcons, lookup_type_const tcons ^ "_" ^ class, ar) ::
202.150 - arity_clause (class::seen) n (tcons,ars)
202.151 + make_axiom_arity_clause dfg (tcons, lookup_type_const dfg tcons ^ "_" ^ class, ar) ::
202.152 + arity_clause dfg (class::seen) n (tcons,ars)
202.153
202.154 -fun multi_arity_clause [] = []
202.155 - | multi_arity_clause ((tcons,ars) :: tc_arlists) =
202.156 - arity_clause [] 1 (tcons, ars) @ multi_arity_clause tc_arlists
202.157 +fun multi_arity_clause dfg [] = []
202.158 + | multi_arity_clause dfg ((tcons,ars) :: tc_arlists) =
202.159 + arity_clause dfg [] 1 (tcons, ars) @ multi_arity_clause dfg tc_arlists
202.160
202.161 (*Generate all pairs (tycon,class,sorts) such that tycon belongs to class in theory thy
202.162 provided its arguments have the corresponding sorts.*)
202.163 @@ -377,7 +374,7 @@
202.164 fun add_class tycon (class,pairs) =
202.165 (class, domain_sorts(tycon,class))::pairs
202.166 handle Sorts.CLASS_ERROR _ => pairs
202.167 - fun try_classes tycon = (tycon, foldl (add_class tycon) [] classes)
202.168 + fun try_classes tycon = (tycon, List.foldl (add_class tycon) [] classes)
202.169 in map try_classes tycons end;
202.170
202.171 (*Proving one (tycon, class) membership may require proving others, so iterate.*)
202.172 @@ -390,17 +387,17 @@
202.173 val (classes', cpairs') = iter_type_class_pairs thy tycons newclasses
202.174 in (classes' union classes, cpairs' union cpairs) end;
202.175
202.176 -fun make_arity_clauses thy tycons classes =
202.177 +fun make_arity_clauses_dfg dfg thy tycons classes =
202.178 let val (classes', cpairs) = iter_type_class_pairs thy tycons classes
202.179 - in (classes', multi_arity_clause cpairs) end;
202.180 -
202.181 + in (classes', multi_arity_clause dfg cpairs) end;
202.182 +val make_arity_clauses = make_arity_clauses_dfg false;
202.183
202.184 (**** Find occurrences of predicates in clauses ****)
202.185
202.186 (*FIXME: multiple-arity checking doesn't work, as update_new is the wrong
202.187 function (it flags repeated declarations of a function, even with the same arity)*)
202.188
202.189 -fun update_many (tab, keypairs) = foldl (uncurry Symtab.update) tab keypairs;
202.190 +fun update_many (tab, keypairs) = List.foldl (uncurry Symtab.update) tab keypairs;
202.191
202.192 fun add_type_sort_preds (T, preds) =
202.193 update_many (preds, map pred_of_sort (sorts_on_typs T));
202.194 @@ -414,14 +411,14 @@
202.195 fun add_arityClause_preds (ArityClause {conclLit,premLits,...}, preds) =
202.196 let val classes = map (make_type_class o class_of_arityLit) (conclLit::premLits)
202.197 fun upd (class,preds) = Symtab.update (class,1) preds
202.198 - in foldl upd preds classes end;
202.199 + in List.foldl upd preds classes end;
202.200
202.201 (*** Find occurrences of functions in clauses ***)
202.202
202.203 fun add_foltype_funcs (AtomV _, funcs) = funcs
202.204 | add_foltype_funcs (AtomF a, funcs) = Symtab.update (a,0) funcs
202.205 | add_foltype_funcs (Comp(a,tys), funcs) =
202.206 - foldl add_foltype_funcs (Symtab.update (a, length tys) funcs) tys;
202.207 + List.foldl add_foltype_funcs (Symtab.update (a, length tys) funcs) tys;
202.208
202.209 (*TFrees are recorded as constants*)
202.210 fun add_type_sort_funcs (TVar _, funcs) = funcs
203.1 --- a/src/HOL/Tools/res_hol_clause.ML Wed Mar 04 10:43:39 2009 +0100
203.2 +++ b/src/HOL/Tools/res_hol_clause.ML Wed Mar 04 10:45:52 2009 +0100
203.3 @@ -1,4 +1,4 @@
203.4 -(* ID: $Id$
203.5 +(*
203.6 Author: Jia Meng, NICTA
203.7
203.8 FOL clauses translated from HOL formulae.
203.9 @@ -13,8 +13,8 @@
203.10 val comb_C: thm
203.11 val comb_S: thm
203.12 datatype type_level = T_FULL | T_CONST
203.13 - val typ_level: type_level ref
203.14 - val minimize_applies: bool ref
203.15 + val typ_level: type_level
203.16 + val minimize_applies: bool
203.17 type axiom_name = string
203.18 type polarity = bool
203.19 type clause_id = int
203.20 @@ -53,22 +53,18 @@
203.21 (*The different translations of types*)
203.22 datatype type_level = T_FULL | T_CONST;
203.23
203.24 -val typ_level = ref T_CONST;
203.25 +val typ_level = T_CONST;
203.26
203.27 (*If true, each function will be directly applied to as many arguments as possible, avoiding
203.28 use of the "apply" operator. Use of hBOOL is also minimized.*)
203.29 -val minimize_applies = ref true;
203.30 +val minimize_applies = true;
203.31
203.32 -val const_min_arity = ref (Symtab.empty : int Symtab.table);
203.33 -
203.34 -val const_needs_hBOOL = ref (Symtab.empty : bool Symtab.table);
203.35 -
203.36 -fun min_arity_of c = getOpt (Symtab.lookup(!const_min_arity) c, 0);
203.37 +fun min_arity_of const_min_arity c = getOpt (Symtab.lookup const_min_arity c, 0);
203.38
203.39 (*True if the constant ever appears outside of the top-level position in literals.
203.40 If false, the constant always receives all of its arguments and is used as a predicate.*)
203.41 -fun needs_hBOOL c = not (!minimize_applies) orelse
203.42 - getOpt (Symtab.lookup(!const_needs_hBOOL) c, false);
203.43 +fun needs_hBOOL const_needs_hBOOL c = not minimize_applies orelse
203.44 + getOpt (Symtab.lookup const_needs_hBOOL c, false);
203.45
203.46
203.47 (******************************************************)
203.48 @@ -110,67 +106,68 @@
203.49
203.50 fun isTaut (Clause {literals,...}) = exists isTrue literals;
203.51
203.52 -fun type_of (Type (a, Ts)) =
203.53 - let val (folTypes,ts) = types_of Ts
203.54 - in (RC.Comp(RC.make_fixed_type_const a, folTypes), ts) end
203.55 - | type_of (tp as (TFree(a,s))) =
203.56 +fun type_of dfg (Type (a, Ts)) =
203.57 + let val (folTypes,ts) = types_of dfg Ts
203.58 + in (RC.Comp(RC.make_fixed_type_const dfg a, folTypes), ts) end
203.59 + | type_of dfg (tp as (TFree(a,s))) =
203.60 (RC.AtomF (RC.make_fixed_type_var a), [tp])
203.61 - | type_of (tp as (TVar(v,s))) =
203.62 + | type_of dfg (tp as (TVar(v,s))) =
203.63 (RC.AtomV (RC.make_schematic_type_var v), [tp])
203.64 -and types_of Ts =
203.65 - let val (folTyps,ts) = ListPair.unzip (map type_of Ts)
203.66 +and types_of dfg Ts =
203.67 + let val (folTyps,ts) = ListPair.unzip (map (type_of dfg) Ts)
203.68 in (folTyps, RC.union_all ts) end;
203.69
203.70 (* same as above, but no gathering of sort information *)
203.71 -fun simp_type_of (Type (a, Ts)) =
203.72 - RC.Comp(RC.make_fixed_type_const a, map simp_type_of Ts)
203.73 - | simp_type_of (TFree (a,s)) = RC.AtomF(RC.make_fixed_type_var a)
203.74 - | simp_type_of (TVar (v,s)) = RC.AtomV(RC.make_schematic_type_var v);
203.75 +fun simp_type_of dfg (Type (a, Ts)) =
203.76 + RC.Comp(RC.make_fixed_type_const dfg a, map (simp_type_of dfg) Ts)
203.77 + | simp_type_of dfg (TFree (a,s)) = RC.AtomF(RC.make_fixed_type_var a)
203.78 + | simp_type_of dfg (TVar (v,s)) = RC.AtomV(RC.make_schematic_type_var v);
203.79
203.80
203.81 -fun const_type_of thy (c,t) =
203.82 - let val (tp,ts) = type_of t
203.83 - in (tp, ts, map simp_type_of (Sign.const_typargs thy (c,t))) end;
203.84 +fun const_type_of dfg thy (c,t) =
203.85 + let val (tp,ts) = type_of dfg t
203.86 + in (tp, ts, map (simp_type_of dfg) (Sign.const_typargs thy (c,t))) end;
203.87
203.88 (* convert a Term.term (with combinators) into a combterm, also accummulate sort info *)
203.89 -fun combterm_of thy (Const(c,t)) =
203.90 - let val (tp,ts,tvar_list) = const_type_of thy (c,t)
203.91 - val c' = CombConst(RC.make_fixed_const c, tp, tvar_list)
203.92 +fun combterm_of dfg thy (Const(c,t)) =
203.93 + let val (tp,ts,tvar_list) = const_type_of dfg thy (c,t)
203.94 + val c' = CombConst(RC.make_fixed_const dfg c, tp, tvar_list)
203.95 in (c',ts) end
203.96 - | combterm_of thy (Free(v,t)) =
203.97 - let val (tp,ts) = type_of t
203.98 + | combterm_of dfg thy (Free(v,t)) =
203.99 + let val (tp,ts) = type_of dfg t
203.100 val v' = CombConst(RC.make_fixed_var v, tp, [])
203.101 in (v',ts) end
203.102 - | combterm_of thy (Var(v,t)) =
203.103 - let val (tp,ts) = type_of t
203.104 + | combterm_of dfg thy (Var(v,t)) =
203.105 + let val (tp,ts) = type_of dfg t
203.106 val v' = CombVar(RC.make_schematic_var v,tp)
203.107 in (v',ts) end
203.108 - | combterm_of thy (P $ Q) =
203.109 - let val (P',tsP) = combterm_of thy P
203.110 - val (Q',tsQ) = combterm_of thy Q
203.111 + | combterm_of dfg thy (P $ Q) =
203.112 + let val (P',tsP) = combterm_of dfg thy P
203.113 + val (Q',tsQ) = combterm_of dfg thy Q
203.114 in (CombApp(P',Q'), tsP union tsQ) end
203.115 - | combterm_of thy (t as Abs _) = raise RC.CLAUSE("HOL CLAUSE",t);
203.116 + | combterm_of _ thy (t as Abs _) = raise RC.CLAUSE("HOL CLAUSE",t);
203.117
203.118 -fun predicate_of thy ((Const("Not",_) $ P), polarity) = predicate_of thy (P, not polarity)
203.119 - | predicate_of thy (t,polarity) = (combterm_of thy (Envir.eta_contract t), polarity);
203.120 +fun predicate_of dfg thy ((Const("Not",_) $ P), polarity) = predicate_of dfg thy (P, not polarity)
203.121 + | predicate_of dfg thy (t,polarity) = (combterm_of dfg thy (Envir.eta_contract t), polarity);
203.122
203.123 -fun literals_of_term1 thy args (Const("Trueprop",_) $ P) = literals_of_term1 thy args P
203.124 - | literals_of_term1 thy args (Const("op |",_) $ P $ Q) =
203.125 - literals_of_term1 thy (literals_of_term1 thy args P) Q
203.126 - | literals_of_term1 thy (lits,ts) P =
203.127 - let val ((pred,ts'),pol) = predicate_of thy (P,true)
203.128 +fun literals_of_term1 dfg thy args (Const("Trueprop",_) $ P) = literals_of_term1 dfg thy args P
203.129 + | literals_of_term1 dfg thy args (Const("op |",_) $ P $ Q) =
203.130 + literals_of_term1 dfg thy (literals_of_term1 dfg thy args P) Q
203.131 + | literals_of_term1 dfg thy (lits,ts) P =
203.132 + let val ((pred,ts'),pol) = predicate_of dfg thy (P,true)
203.133 in
203.134 (Literal(pol,pred)::lits, ts union ts')
203.135 end;
203.136
203.137 -fun literals_of_term thy P = literals_of_term1 thy ([],[]) P;
203.138 +fun literals_of_term_dfg dfg thy P = literals_of_term1 dfg thy ([],[]) P;
203.139 +val literals_of_term = literals_of_term_dfg false;
203.140
203.141 (* Problem too trivial for resolution (empty clause) *)
203.142 exception TOO_TRIVIAL;
203.143
203.144 (* making axiom and conjecture clauses *)
203.145 -fun make_clause thy (clause_id,axiom_name,kind,th) =
203.146 - let val (lits,ctypes_sorts) = literals_of_term thy (prop_of th)
203.147 +fun make_clause dfg thy (clause_id,axiom_name,kind,th) =
203.148 + let val (lits,ctypes_sorts) = literals_of_term_dfg dfg thy (prop_of th)
203.149 in
203.150 if forall isFalse lits
203.151 then raise TOO_TRIVIAL
203.152 @@ -180,20 +177,20 @@
203.153 end;
203.154
203.155
203.156 -fun add_axiom_clause thy ((th,(name,id)), pairs) =
203.157 - let val cls = make_clause thy (id, name, RC.Axiom, th)
203.158 +fun add_axiom_clause dfg thy ((th,(name,id)), pairs) =
203.159 + let val cls = make_clause dfg thy (id, name, RC.Axiom, th)
203.160 in
203.161 if isTaut cls then pairs else (name,cls)::pairs
203.162 end;
203.163
203.164 -fun make_axiom_clauses thy = foldl (add_axiom_clause thy) [];
203.165 +fun make_axiom_clauses dfg thy = List.foldl (add_axiom_clause dfg thy) [];
203.166
203.167 -fun make_conjecture_clauses_aux _ _ [] = []
203.168 - | make_conjecture_clauses_aux thy n (th::ths) =
203.169 - make_clause thy (n,"conjecture", RC.Conjecture, th) ::
203.170 - make_conjecture_clauses_aux thy (n+1) ths;
203.171 +fun make_conjecture_clauses_aux dfg _ _ [] = []
203.172 + | make_conjecture_clauses_aux dfg thy n (th::ths) =
203.173 + make_clause dfg thy (n,"conjecture", RC.Conjecture, th) ::
203.174 + make_conjecture_clauses_aux dfg thy (n+1) ths;
203.175
203.176 -fun make_conjecture_clauses thy = make_conjecture_clauses_aux thy 0;
203.177 +fun make_conjecture_clauses dfg thy = make_conjecture_clauses_aux dfg thy 0;
203.178
203.179
203.180 (**********************************************************************)
203.181 @@ -218,11 +215,11 @@
203.182
203.183 val type_wrapper = "ti";
203.184
203.185 -fun head_needs_hBOOL (CombConst(c,_,_)) = needs_hBOOL c
203.186 - | head_needs_hBOOL _ = true;
203.187 +fun head_needs_hBOOL const_needs_hBOOL (CombConst(c,_,_)) = needs_hBOOL const_needs_hBOOL c
203.188 + | head_needs_hBOOL const_needs_hBOOL _ = true;
203.189
203.190 fun wrap_type (s, tp) =
203.191 - if !typ_level=T_FULL then
203.192 + if typ_level=T_FULL then
203.193 type_wrapper ^ RC.paren_pack [s, RC.string_of_fol_type tp]
203.194 else s;
203.195
203.196 @@ -235,43 +232,43 @@
203.197
203.198 (*Apply an operator to the argument strings, using either the "apply" operator or
203.199 direct function application.*)
203.200 -fun string_of_applic (CombConst(c,tp,tvars), args) =
203.201 +fun string_of_applic cma (CombConst(c,tp,tvars), args) =
203.202 let val c = if c = "equal" then "c_fequal" else c
203.203 - val nargs = min_arity_of c
203.204 + val nargs = min_arity_of cma c
203.205 val args1 = List.take(args, nargs)
203.206 handle Subscript => error ("string_of_applic: " ^ c ^ " has arity " ^
203.207 Int.toString nargs ^ " but is applied to " ^
203.208 space_implode ", " args)
203.209 val args2 = List.drop(args, nargs)
203.210 - val targs = if !typ_level = T_CONST then map RC.string_of_fol_type tvars
203.211 + val targs = if typ_level = T_CONST then map RC.string_of_fol_type tvars
203.212 else []
203.213 in
203.214 string_apply (c ^ RC.paren_pack (args1@targs), args2)
203.215 end
203.216 - | string_of_applic (CombVar(v,tp), args) = string_apply (v, args)
203.217 - | string_of_applic _ = error "string_of_applic";
203.218 + | string_of_applic cma (CombVar(v,tp), args) = string_apply (v, args)
203.219 + | string_of_applic _ _ = error "string_of_applic";
203.220
203.221 -fun wrap_type_if (head, s, tp) = if head_needs_hBOOL head then wrap_type (s, tp) else s;
203.222 +fun wrap_type_if cnh (head, s, tp) = if head_needs_hBOOL cnh head then wrap_type (s, tp) else s;
203.223
203.224 -fun string_of_combterm t =
203.225 +fun string_of_combterm cma cnh t =
203.226 let val (head, args) = strip_comb t
203.227 - in wrap_type_if (head,
203.228 - string_of_applic (head, map string_of_combterm args),
203.229 + in wrap_type_if cnh (head,
203.230 + string_of_applic cma (head, map (string_of_combterm cma cnh) args),
203.231 type_of_combterm t)
203.232 end;
203.233
203.234 (*Boolean-valued terms are here converted to literals.*)
203.235 -fun boolify t = "hBOOL" ^ RC.paren_pack [string_of_combterm t];
203.236 +fun boolify cma cnh t = "hBOOL" ^ RC.paren_pack [string_of_combterm cma cnh t];
203.237
203.238 -fun string_of_predicate t =
203.239 +fun string_of_predicate cma cnh t =
203.240 case t of
203.241 (CombApp(CombApp(CombConst("equal",_,_), t1), t2)) =>
203.242 (*DFG only: new TPTP prefers infix equality*)
203.243 - ("equal" ^ RC.paren_pack [string_of_combterm t1, string_of_combterm t2])
203.244 + ("equal" ^ RC.paren_pack [string_of_combterm cma cnh t1, string_of_combterm cma cnh t2])
203.245 | _ =>
203.246 case #1 (strip_comb t) of
203.247 - CombConst(c,_,_) => if needs_hBOOL c then boolify t else string_of_combterm t
203.248 - | _ => boolify t;
203.249 + CombConst(c,_,_) => if needs_hBOOL cnh c then boolify cma cnh t else string_of_combterm cma cnh t
203.250 + | _ => boolify cma cnh t;
203.251
203.252 fun string_of_clausename (cls_id,ax_name) =
203.253 RC.clause_prefix ^ RC.ascii_of ax_name ^ "_" ^ Int.toString cls_id;
203.254 @@ -282,23 +279,23 @@
203.255
203.256 (*** tptp format ***)
203.257
203.258 -fun tptp_of_equality pol (t1,t2) =
203.259 +fun tptp_of_equality cma cnh pol (t1,t2) =
203.260 let val eqop = if pol then " = " else " != "
203.261 - in string_of_combterm t1 ^ eqop ^ string_of_combterm t2 end;
203.262 + in string_of_combterm cma cnh t1 ^ eqop ^ string_of_combterm cma cnh t2 end;
203.263
203.264 -fun tptp_literal (Literal(pol, CombApp(CombApp(CombConst("equal",_,_), t1), t2))) =
203.265 - tptp_of_equality pol (t1,t2)
203.266 - | tptp_literal (Literal(pol,pred)) =
203.267 - RC.tptp_sign pol (string_of_predicate pred);
203.268 +fun tptp_literal cma cnh (Literal(pol, CombApp(CombApp(CombConst("equal",_,_), t1), t2))) =
203.269 + tptp_of_equality cma cnh pol (t1,t2)
203.270 + | tptp_literal cma cnh (Literal(pol,pred)) =
203.271 + RC.tptp_sign pol (string_of_predicate cma cnh pred);
203.272
203.273 (*Given a clause, returns its literals paired with a list of literals concerning TFrees;
203.274 the latter should only occur in conjecture clauses.*)
203.275 -fun tptp_type_lits pos (Clause{literals, ctypes_sorts, ...}) =
203.276 - (map tptp_literal literals,
203.277 +fun tptp_type_lits cma cnh pos (Clause{literals, ctypes_sorts, ...}) =
203.278 + (map (tptp_literal cma cnh) literals,
203.279 map (RC.tptp_of_typeLit pos) (RC.add_typs ctypes_sorts));
203.280
203.281 -fun clause2tptp (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
203.282 - let val (lits,tylits) = tptp_type_lits (kind = RC.Conjecture) cls
203.283 +fun clause2tptp cma cnh (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
203.284 + let val (lits,tylits) = tptp_type_lits cma cnh (kind = RC.Conjecture) cls
203.285 in
203.286 (RC.gen_tptp_cls(clause_id,axiom_name,kind,lits,tylits), tylits)
203.287 end;
203.288 @@ -306,10 +303,10 @@
203.289
203.290 (*** dfg format ***)
203.291
203.292 -fun dfg_literal (Literal(pol,pred)) = RC.dfg_sign pol (string_of_predicate pred);
203.293 +fun dfg_literal cma cnh (Literal(pol,pred)) = RC.dfg_sign pol (string_of_predicate cma cnh pred);
203.294
203.295 -fun dfg_type_lits pos (Clause{literals, ctypes_sorts, ...}) =
203.296 - (map dfg_literal literals,
203.297 +fun dfg_type_lits cma cnh pos (Clause{literals, ctypes_sorts, ...}) =
203.298 + (map (dfg_literal cma cnh) literals,
203.299 map (RC.dfg_of_typeLit pos) (RC.add_typs ctypes_sorts));
203.300
203.301 fun get_uvars (CombConst _) vars = vars
203.302 @@ -320,8 +317,8 @@
203.303
203.304 fun dfg_vars (Clause {literals,...}) = RC.union_all (map get_uvars_l literals);
203.305
203.306 -fun clause2dfg (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
203.307 - let val (lits,tylits) = dfg_type_lits (kind = RC.Conjecture) cls
203.308 +fun clause2dfg cma cnh (cls as Clause{axiom_name,clause_id,kind,ctypes_sorts,...}) =
203.309 + let val (lits,tylits) = dfg_type_lits cma cnh (kind = RC.Conjecture) cls
203.310 val vars = dfg_vars cls
203.311 val tvars = RC.get_tvar_strs ctypes_sorts
203.312 in
203.313 @@ -331,47 +328,47 @@
203.314
203.315 (** For DFG format: accumulate function and predicate declarations **)
203.316
203.317 -fun addtypes tvars tab = foldl RC.add_foltype_funcs tab tvars;
203.318 +fun addtypes tvars tab = List.foldl RC.add_foltype_funcs tab tvars;
203.319
203.320 -fun add_decls (CombConst(c,tp,tvars), (funcs,preds)) =
203.321 +fun add_decls cma cnh (CombConst(c,tp,tvars), (funcs,preds)) =
203.322 if c = "equal" then (addtypes tvars funcs, preds)
203.323 else
203.324 - let val arity = min_arity_of c
203.325 - val ntys = if !typ_level = T_CONST then length tvars else 0
203.326 + let val arity = min_arity_of cma c
203.327 + val ntys = if typ_level = T_CONST then length tvars else 0
203.328 val addit = Symtab.update(c, arity+ntys)
203.329 in
203.330 - if needs_hBOOL c then (addtypes tvars (addit funcs), preds)
203.331 + if needs_hBOOL cnh c then (addtypes tvars (addit funcs), preds)
203.332 else (addtypes tvars funcs, addit preds)
203.333 end
203.334 - | add_decls (CombVar(_,ctp), (funcs,preds)) =
203.335 + | add_decls _ _ (CombVar(_,ctp), (funcs,preds)) =
203.336 (RC.add_foltype_funcs (ctp,funcs), preds)
203.337 - | add_decls (CombApp(P,Q),decls) = add_decls(P,add_decls (Q,decls));
203.338 + | add_decls cma cnh (CombApp(P,Q),decls) = add_decls cma cnh (P,add_decls cma cnh (Q,decls));
203.339
203.340 -fun add_literal_decls (Literal(_,c), decls) = add_decls (c,decls);
203.341 +fun add_literal_decls cma cnh (Literal(_,c), decls) = add_decls cma cnh (c,decls);
203.342
203.343 -fun add_clause_decls (Clause {literals, ...}, decls) =
203.344 - foldl add_literal_decls decls literals
203.345 +fun add_clause_decls cma cnh (Clause {literals, ...}, decls) =
203.346 + List.foldl (add_literal_decls cma cnh) decls literals
203.347 handle Symtab.DUP a => error ("function " ^ a ^ " has multiple arities")
203.348
203.349 -fun decls_of_clauses clauses arity_clauses =
203.350 +fun decls_of_clauses cma cnh clauses arity_clauses =
203.351 let val init_functab = Symtab.update (type_wrapper,2) (Symtab.update ("hAPP",2) RC.init_functab)
203.352 val init_predtab = Symtab.update ("hBOOL",1) Symtab.empty
203.353 - val (functab,predtab) = (foldl add_clause_decls (init_functab, init_predtab) clauses)
203.354 + val (functab,predtab) = (List.foldl (add_clause_decls cma cnh) (init_functab, init_predtab) clauses)
203.355 in
203.356 - (Symtab.dest (foldl RC.add_arityClause_funcs functab arity_clauses),
203.357 + (Symtab.dest (List.foldl RC.add_arityClause_funcs functab arity_clauses),
203.358 Symtab.dest predtab)
203.359 end;
203.360
203.361 fun add_clause_preds (Clause {ctypes_sorts, ...}, preds) =
203.362 - foldl RC.add_type_sort_preds preds ctypes_sorts
203.363 + List.foldl RC.add_type_sort_preds preds ctypes_sorts
203.364 handle Symtab.DUP a => error ("predicate " ^ a ^ " has multiple arities")
203.365
203.366 (*Higher-order clauses have only the predicates hBOOL and type classes.*)
203.367 fun preds_of_clauses clauses clsrel_clauses arity_clauses =
203.368 Symtab.dest
203.369 - (foldl RC.add_classrelClause_preds
203.370 - (foldl RC.add_arityClause_preds
203.371 - (foldl add_clause_preds Symtab.empty clauses)
203.372 + (List.foldl RC.add_classrelClause_preds
203.373 + (List.foldl RC.add_arityClause_preds
203.374 + (List.foldl add_clause_preds Symtab.empty clauses)
203.375 arity_clauses)
203.376 clsrel_clauses)
203.377
203.378 @@ -393,20 +390,20 @@
203.379
203.380 fun count_literal (Literal(_,t), ct) = count_combterm(t,ct);
203.381
203.382 -fun count_clause (Clause{literals,...}, ct) = foldl count_literal ct literals;
203.383 +fun count_clause (Clause{literals,...}, ct) = List.foldl count_literal ct literals;
203.384
203.385 fun count_user_clause user_lemmas (Clause{axiom_name,literals,...}, ct) =
203.386 - if axiom_name mem_string user_lemmas then foldl count_literal ct literals
203.387 + if axiom_name mem_string user_lemmas then List.foldl count_literal ct literals
203.388 else ct;
203.389
203.390 fun cnf_helper_thms thy =
203.391 ResAxioms.cnf_rules_pairs thy o map ResAxioms.pairname
203.392
203.393 -fun get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas) =
203.394 +fun get_helper_clauses dfg thy isFO (conjectures, axclauses, user_lemmas) =
203.395 if isFO then [] (*first-order*)
203.396 else
203.397 - let val ct0 = foldl count_clause init_counters conjectures
203.398 - val ct = foldl (count_user_clause user_lemmas) ct0 axclauses
203.399 + let val ct0 = List.foldl count_clause init_counters conjectures
203.400 + val ct = List.foldl (count_user_clause user_lemmas) ct0 axclauses
203.401 fun needed c = valOf (Symtab.lookup ct c) > 0
203.402 val IK = if needed "c_COMBI" orelse needed "c_COMBK"
203.403 then (Output.debug (fn () => "Include combinator I K"); cnf_helper_thms thy [comb_I,comb_K])
203.404 @@ -419,66 +416,67 @@
203.405 else []
203.406 val other = cnf_helper_thms thy [ext,fequal_imp_equal,equal_imp_fequal]
203.407 in
203.408 - map #2 (make_axiom_clauses thy (other @ IK @ BC @ S))
203.409 + map #2 (make_axiom_clauses dfg thy (other @ IK @ BC @ S))
203.410 end;
203.411
203.412 (*Find the minimal arity of each function mentioned in the term. Also, note which uses
203.413 are not at top level, to see if hBOOL is needed.*)
203.414 -fun count_constants_term toplev t =
203.415 +fun count_constants_term toplev t (const_min_arity, const_needs_hBOOL) =
203.416 let val (head, args) = strip_comb t
203.417 val n = length args
203.418 - val _ = List.app (count_constants_term false) args
203.419 + val (const_min_arity, const_needs_hBOOL) = fold (count_constants_term false) args (const_min_arity, const_needs_hBOOL)
203.420 in
203.421 case head of
203.422 CombConst (a,_,_) => (*predicate or function version of "equal"?*)
203.423 let val a = if a="equal" andalso not toplev then "c_fequal" else a
203.424 + val const_min_arity = Symtab.map_default (a,n) (curry Int.min n) const_min_arity
203.425 in
203.426 - const_min_arity := Symtab.map_default (a,n) (curry Int.min n) (!const_min_arity);
203.427 - if toplev then ()
203.428 - else const_needs_hBOOL := Symtab.update (a,true) (!const_needs_hBOOL)
203.429 + if toplev then (const_min_arity, const_needs_hBOOL)
203.430 + else (const_min_arity, Symtab.update (a,true) (const_needs_hBOOL))
203.431 end
203.432 - | ts => ()
203.433 + | ts => (const_min_arity, const_needs_hBOOL)
203.434 end;
203.435
203.436 (*A literal is a top-level term*)
203.437 -fun count_constants_lit (Literal (_,t)) = count_constants_term true t;
203.438 +fun count_constants_lit (Literal (_,t)) (const_min_arity, const_needs_hBOOL) =
203.439 + count_constants_term true t (const_min_arity, const_needs_hBOOL);
203.440
203.441 -fun count_constants_clause (Clause{literals,...}) = List.app count_constants_lit literals;
203.442 +fun count_constants_clause (Clause{literals,...}) (const_min_arity, const_needs_hBOOL) =
203.443 + fold count_constants_lit literals (const_min_arity, const_needs_hBOOL);
203.444
203.445 -fun display_arity (c,n) =
203.446 +fun display_arity const_needs_hBOOL (c,n) =
203.447 Output.debug (fn () => "Constant: " ^ c ^ " arity:\t" ^ Int.toString n ^
203.448 - (if needs_hBOOL c then " needs hBOOL" else ""));
203.449 + (if needs_hBOOL const_needs_hBOOL c then " needs hBOOL" else ""));
203.450
203.451 fun count_constants (conjectures, axclauses, helper_clauses) =
203.452 - if !minimize_applies then
203.453 - (const_min_arity := Symtab.empty;
203.454 - const_needs_hBOOL := Symtab.empty;
203.455 - List.app count_constants_clause conjectures;
203.456 - List.app count_constants_clause axclauses;
203.457 - List.app count_constants_clause helper_clauses;
203.458 - List.app display_arity (Symtab.dest (!const_min_arity)))
203.459 - else ();
203.460 + if minimize_applies then
203.461 + let val (const_min_arity, const_needs_hBOOL) =
203.462 + fold count_constants_clause conjectures (Symtab.empty, Symtab.empty)
203.463 + |> fold count_constants_clause axclauses
203.464 + |> fold count_constants_clause helper_clauses
203.465 + val _ = List.app (display_arity const_needs_hBOOL) (Symtab.dest (const_min_arity))
203.466 + in (const_min_arity, const_needs_hBOOL) end
203.467 + else (Symtab.empty, Symtab.empty);
203.468
203.469 (* tptp format *)
203.470
203.471 (* write TPTP format to a single file *)
203.472 fun tptp_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
203.473 let val _ = Output.debug (fn () => ("Preparing to write the TPTP file " ^ filename))
203.474 - val _ = RC.dfg_format := false
203.475 - val conjectures = make_conjecture_clauses thy thms
203.476 - val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
203.477 - val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
203.478 - val _ = count_constants (conjectures, axclauses, helper_clauses);
203.479 - val (tptp_clss,tfree_litss) = ListPair.unzip (map clause2tptp conjectures)
203.480 - val tfree_clss = map RC.tptp_tfree_clause (foldl (op union_string) [] tfree_litss)
203.481 + val conjectures = make_conjecture_clauses false thy thms
203.482 + val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses false thy ax_tuples)
203.483 + val helper_clauses = get_helper_clauses false thy isFO (conjectures, axclauses, user_lemmas)
203.484 + val (const_min_arity, const_needs_hBOOL) = count_constants (conjectures, axclauses, helper_clauses);
203.485 + val (tptp_clss,tfree_litss) = ListPair.unzip (map (clause2tptp const_min_arity const_needs_hBOOL) conjectures)
203.486 + val tfree_clss = map RC.tptp_tfree_clause (List.foldl (op union_string) [] tfree_litss)
203.487 val out = TextIO.openOut filename
203.488 in
203.489 - List.app (curry TextIO.output out o #1 o clause2tptp) axclauses;
203.490 + List.app (curry TextIO.output out o #1 o (clause2tptp const_min_arity const_needs_hBOOL)) axclauses;
203.491 RC.writeln_strs out tfree_clss;
203.492 RC.writeln_strs out tptp_clss;
203.493 List.app (curry TextIO.output out o RC.tptp_classrelClause) classrel_clauses;
203.494 List.app (curry TextIO.output out o RC.tptp_arity_clause) arity_clauses;
203.495 - List.app (curry TextIO.output out o #1 o clause2tptp) helper_clauses;
203.496 + List.app (curry TextIO.output out o #1 o (clause2tptp const_min_arity const_needs_hBOOL)) helper_clauses;
203.497 TextIO.closeOut out;
203.498 clnames
203.499 end;
203.500 @@ -488,18 +486,17 @@
203.501
203.502 fun dfg_write_file thy isFO thms filename (ax_tuples,classrel_clauses,arity_clauses) user_lemmas =
203.503 let val _ = Output.debug (fn () => ("Preparing to write the DFG file " ^ filename))
203.504 - val _ = RC.dfg_format := true
203.505 - val conjectures = make_conjecture_clauses thy thms
203.506 - val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses thy ax_tuples)
203.507 - val helper_clauses = get_helper_clauses thy isFO (conjectures, axclauses, user_lemmas)
203.508 - val _ = count_constants (conjectures, axclauses, helper_clauses);
203.509 - val (dfg_clss, tfree_litss) = ListPair.unzip (map clause2dfg conjectures)
203.510 + val conjectures = make_conjecture_clauses true thy thms
203.511 + val (clnames,axclauses) = ListPair.unzip (make_axiom_clauses true thy ax_tuples)
203.512 + val helper_clauses = get_helper_clauses true thy isFO (conjectures, axclauses, user_lemmas)
203.513 + val (const_min_arity, const_needs_hBOOL) = count_constants (conjectures, axclauses, helper_clauses);
203.514 + val (dfg_clss, tfree_litss) = ListPair.unzip (map (clause2dfg const_min_arity const_needs_hBOOL) conjectures)
203.515 and probname = Path.implode (Path.base (Path.explode filename))
203.516 - val axstrs = map (#1 o clause2dfg) axclauses
203.517 + val axstrs = map (#1 o (clause2dfg const_min_arity const_needs_hBOOL)) axclauses
203.518 val tfree_clss = map RC.dfg_tfree_clause (RC.union_all tfree_litss)
203.519 val out = TextIO.openOut filename
203.520 - val helper_clauses_strs = map (#1 o clause2dfg) helper_clauses
203.521 - val (funcs,cl_preds) = decls_of_clauses (helper_clauses @ conjectures @ axclauses) arity_clauses
203.522 + val helper_clauses_strs = map (#1 o (clause2dfg const_min_arity const_needs_hBOOL)) helper_clauses
203.523 + val (funcs,cl_preds) = decls_of_clauses const_min_arity const_needs_hBOOL (helper_clauses @ conjectures @ axclauses) arity_clauses
203.524 and ty_preds = preds_of_clauses axclauses classrel_clauses arity_clauses
203.525 in
203.526 TextIO.output (out, RC.string_of_start probname);
204.1 --- a/src/HOL/Tools/res_reconstruct.ML Wed Mar 04 10:43:39 2009 +0100
204.2 +++ b/src/HOL/Tools/res_reconstruct.ML Wed Mar 04 10:45:52 2009 +0100
204.3 @@ -51,7 +51,7 @@
204.4 fun atom x = Br(x,[]);
204.5
204.6 fun scons (x,y) = Br("cons", [x,y]);
204.7 -val listof = foldl scons (atom "nil");
204.8 +val listof = List.foldl scons (atom "nil");
204.9
204.10 (*Strings enclosed in single quotes, e.g. filenames*)
204.11 val quoted = $$"'" |-- Scan.repeat (~$$"'") --| $$"'" >> implode;
204.12 @@ -243,7 +243,7 @@
204.13 fun gen_all_vars t = fold_rev Logic.all (OldTerm.term_vars t) t;
204.14
204.15 fun ints_of_stree_aux (Int n, ns) = n::ns
204.16 - | ints_of_stree_aux (Br(_,ts), ns) = foldl ints_of_stree_aux ns ts;
204.17 + | ints_of_stree_aux (Br(_,ts), ns) = List.foldl ints_of_stree_aux ns ts;
204.18
204.19 fun ints_of_stree t = ints_of_stree_aux (t, []);
204.20
204.21 @@ -362,7 +362,7 @@
204.22 fun replace_dep (old:int, new) dep = if dep=old then new else [dep];
204.23
204.24 fun replace_deps (old:int, new) (lno, t, deps) =
204.25 - (lno, t, foldl (op union_int) [] (map (replace_dep (old, new)) deps));
204.26 + (lno, t, List.foldl (op union_int) [] (map (replace_dep (old, new)) deps));
204.27
204.28 (*Discard axioms; consolidate adjacent lines that prove the same clause, since they differ
204.29 only in type information.*)
204.30 @@ -392,7 +392,7 @@
204.31 then delete_dep lno lines
204.32 else (lno, t, []) :: lines
204.33 | add_nonnull_prfline ((lno, t, deps), lines) = (lno, t, deps) :: lines
204.34 -and delete_dep lno lines = foldr add_nonnull_prfline [] (map (replace_deps (lno, [])) lines);
204.35 +and delete_dep lno lines = List.foldr add_nonnull_prfline [] (map (replace_deps (lno, [])) lines);
204.36
204.37 fun bad_free (Free (a,_)) = String.isPrefix "sko_" a
204.38 | bad_free _ = false;
204.39 @@ -435,11 +435,11 @@
204.40 val tuples = map (dest_tstp o tstp_line o explode) cnfs
204.41 val _ = trace (Int.toString (length tuples) ^ " tuples extracted\n")
204.42 val ctxt = ProofContext.set_mode ProofContext.mode_schematic ctxt
204.43 - val raw_lines = foldr add_prfline [] (decode_tstp_list ctxt tuples)
204.44 + val raw_lines = List.foldr add_prfline [] (decode_tstp_list ctxt tuples)
204.45 val _ = trace (Int.toString (length raw_lines) ^ " raw_lines extracted\n")
204.46 - val nonnull_lines = foldr add_nonnull_prfline [] raw_lines
204.47 + val nonnull_lines = List.foldr add_nonnull_prfline [] raw_lines
204.48 val _ = trace (Int.toString (length nonnull_lines) ^ " nonnull_lines extracted\n")
204.49 - val (_,lines) = foldr (add_wanted_prfline ctxt) (0,[]) nonnull_lines
204.50 + val (_,lines) = List.foldr (add_wanted_prfline ctxt) (0,[]) nonnull_lines
204.51 val _ = trace (Int.toString (length lines) ^ " lines extracted\n")
204.52 val (ccls,fixes) = ResAxioms.neg_conjecture_clauses th sgno
204.53 val _ = trace (Int.toString (length ccls) ^ " conjecture clauses\n")
205.1 --- a/src/HOL/Tools/sat_solver.ML Wed Mar 04 10:43:39 2009 +0100
205.2 +++ b/src/HOL/Tools/sat_solver.ML Wed Mar 04 10:45:52 2009 +0100
205.3 @@ -914,6 +914,10 @@
205.4 fun zchaff fm =
205.5 let
205.6 val _ = if (getenv "ZCHAFF_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
205.7 + val _ = if (getenv "ZCHAFF_VERSION") <> "2004.5.13" andalso
205.8 + (getenv "ZCHAFF_VERSION") <> "2004.11.15" then raise SatSolver.NOT_CONFIGURED else ()
205.9 + (* both versions of zChaff appear to have the same interface, so we do *)
205.10 + (* not actually need to distinguish between them in the following code *)
205.11 val serial_str = serial_string ()
205.12 val inpath = File.tmp_path (Path.explode ("isabelle" ^ serial_str ^ ".cnf"))
205.13 val outpath = File.tmp_path (Path.explode ("result" ^ serial_str))
205.14 @@ -939,12 +943,11 @@
205.15 let
205.16 fun berkmin fm =
205.17 let
205.18 - val _ = if (getenv "BERKMIN_HOME") = "" then raise SatSolver.NOT_CONFIGURED else ()
205.19 + val _ = if (getenv "BERKMIN_HOME") = "" orelse (getenv "BERKMIN_EXE") = "" then raise SatSolver.NOT_CONFIGURED else ()
205.20 val serial_str = serial_string ()
205.21 val inpath = File.tmp_path (Path.explode ("isabelle" ^ serial_str ^ ".cnf"))
205.22 val outpath = File.tmp_path (Path.explode ("result" ^ serial_str))
205.23 - val exec = getenv "BERKMIN_EXE"
205.24 - val cmd = (getenv "BERKMIN_HOME") ^ "/" ^ (if exec = "" then "BerkMin561" else exec) ^ " " ^ (Path.implode inpath) ^ " > " ^ (Path.implode outpath)
205.25 + val cmd = (getenv "BERKMIN_HOME") ^ "/" ^ (getenv "BERKMIN_EXE") ^ " " ^ (Path.implode inpath) ^ " > " ^ (Path.implode outpath)
205.26 fun writefn fm = SatSolver.write_dimacs_cnf_file inpath (PropLogic.defcnf fm)
205.27 fun readfn () = SatSolver.read_std_result_file outpath ("Satisfiable !!", "solution =", "UNSATISFIABLE !!")
205.28 val _ = if File.exists inpath then warning ("overwriting existing file " ^ quote (Path.implode inpath)) else ()
206.1 --- a/src/HOL/Tools/simpdata.ML Wed Mar 04 10:43:39 2009 +0100
206.2 +++ b/src/HOL/Tools/simpdata.ML Wed Mar 04 10:45:52 2009 +0100
206.3 @@ -1,5 +1,4 @@
206.4 (* Title: HOL/simpdata.ML
206.5 - ID: $Id$
206.6 Author: Tobias Nipkow
206.7 Copyright 1991 University of Cambridge
206.8
206.9 @@ -65,7 +64,7 @@
206.10 else
206.11 let
206.12 val Ps = map (fn k => Free ("P" ^ string_of_int k, propT)) (1 upto j);
206.13 - fun mk_simp_implies Q = foldr (fn (R, S) =>
206.14 + fun mk_simp_implies Q = List.foldr (fn (R, S) =>
206.15 Const ("HOL.simp_implies", propT --> propT --> propT) $ R $ S) Q Ps
206.16 val aT = TFree ("'a", HOLogic.typeS);
206.17 val x = Free ("x", aT);
207.1 --- a/src/HOL/Tools/specification_package.ML Wed Mar 04 10:43:39 2009 +0100
207.2 +++ b/src/HOL/Tools/specification_package.ML Wed Mar 04 10:45:52 2009 +0100
207.3 @@ -120,7 +120,7 @@
207.4 val frees = OldTerm.term_frees prop
207.5 val _ = forall (fn v => Sign.of_sort thy (type_of v,HOLogic.typeS)) frees
207.6 orelse error "Specificaton: Only free variables of sort 'type' allowed"
207.7 - val prop_closed = foldr (fn ((vname,T),prop) => HOLogic.mk_all (vname,T,prop)) prop (map dest_Free frees)
207.8 + val prop_closed = List.foldr (fn ((vname,T),prop) => HOLogic.mk_all (vname,T,prop)) prop (map dest_Free frees)
207.9 in
207.10 (prop_closed,frees)
207.11 end
207.12 @@ -161,7 +161,7 @@
207.13 in
207.14 HOLogic.exists_const T $ Abs(vname,T,Term.abstract_over (c,prop))
207.15 end
207.16 - val ex_prop = foldr mk_exist prop proc_consts
207.17 + val ex_prop = List.foldr mk_exist prop proc_consts
207.18 val cnames = map (fst o dest_Const) proc_consts
207.19 fun post_process (arg as (thy,thm)) =
207.20 let
207.21 @@ -232,7 +232,7 @@
207.22
207.23 val specification_decl =
207.24 P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
207.25 - Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop)
207.26 + Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop)
207.27
207.28 val _ =
207.29 OuterSyntax.command "specification" "define constants by specification" K.thy_goal
207.30 @@ -243,7 +243,7 @@
207.31 val ax_specification_decl =
207.32 P.name --
207.33 (P.$$$ "(" |-- Scan.repeat1 (opt_name -- P.term -- opt_overloaded) --| P.$$$ ")" --
207.34 - Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.base_name) -- P.prop))
207.35 + Scan.repeat1 ((SpecParse.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop))
207.36
207.37 val _ =
207.38 OuterSyntax.command "ax_specification" "define constants by specification" K.thy_goal
208.1 --- a/src/HOL/Transcendental.thy Wed Mar 04 10:43:39 2009 +0100
208.2 +++ b/src/HOL/Transcendental.thy Wed Mar 04 10:45:52 2009 +0100
208.3 @@ -120,7 +120,7 @@
208.4 case (Suc n)
208.5 have "(\<Sum> i = 0 ..< 2 * Suc n. if even i then f i else g i) =
208.6 (\<Sum> i = 0 ..< n. f (2 * i)) + (\<Sum> i = 0 ..< n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
208.7 - using Suc.hyps by auto
208.8 + using Suc.hyps unfolding One_nat_def by auto
208.9 also have "\<dots> = (\<Sum> i = 0 ..< Suc n. f (2 * i)) + (\<Sum> i = 0 ..< Suc n. g (2 * i + 1))" by auto
208.10 finally show ?case .
208.11 qed auto
208.12 @@ -187,16 +187,18 @@
208.13 ((\<forall>n. l \<le> (\<Sum>i=0..<2*n + 1. -1^i*a i)) \<and> (\<lambda> n. \<Sum>i=0..<2*n + 1. -1^i*a i) ----> l)"
208.14 (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
208.15 proof -
208.16 - have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" by auto
208.17 + have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" unfolding One_nat_def by auto
208.18
208.19 have "\<forall> n. ?f n \<le> ?f (Suc n)"
208.20 proof fix n show "?f n \<le> ?f (Suc n)" using mono[of "2*n"] by auto qed
208.21 moreover
208.22 have "\<forall> n. ?g (Suc n) \<le> ?g n"
208.23 - proof fix n show "?g (Suc n) \<le> ?g n" using mono[of "Suc (2*n)"] by auto qed
208.24 + proof fix n show "?g (Suc n) \<le> ?g n" using mono[of "Suc (2*n)"]
208.25 + unfolding One_nat_def by auto qed
208.26 moreover
208.27 have "\<forall> n. ?f n \<le> ?g n"
208.28 - proof fix n show "?f n \<le> ?g n" using fg_diff a_pos by auto qed
208.29 + proof fix n show "?f n \<le> ?g n" using fg_diff a_pos
208.30 + unfolding One_nat_def by auto qed
208.31 moreover
208.32 have "(\<lambda> n. ?f n - ?g n) ----> 0" unfolding fg_diff
208.33 proof (rule LIMSEQ_I)
208.34 @@ -904,7 +906,7 @@
208.35 proof -
208.36 have "(\<Sum>n = 0..<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
208.37 by (rule sums_unique [OF series_zero], simp add: power_0_left)
208.38 - thus ?thesis by simp
208.39 + thus ?thesis unfolding One_nat_def by simp
208.40 qed
208.41
208.42 lemma exp_zero [simp]: "exp 0 = 1"
208.43 @@ -1234,10 +1236,11 @@
208.44 show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1" using `0 < x` `x < 2` by auto
208.45 { fix x :: real assume "x \<in> {- 1<..<1}" hence "norm (-x) < 1" by auto
208.46 show "summable (\<lambda>n. -1 ^ n * (1 / real (n + 1)) * real (Suc n) * x ^ n)"
208.47 + unfolding One_nat_def
208.48 by (auto simp del: power_mult_distrib simp add: power_mult_distrib[symmetric] summable_geometric[OF `norm (-x) < 1`])
208.49 }
208.50 qed
208.51 - hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)" by auto
208.52 + hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)" unfolding One_nat_def by auto
208.53 hence "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)" unfolding DERIV_iff repos .
208.54 ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> (suminf (?f' x) - suminf (?f' x))"
208.55 by (rule DERIV_diff)
208.56 @@ -1514,6 +1517,7 @@
208.57
208.58 lemma DERIV_fun_pow: "DERIV g x :> m ==>
208.59 DERIV (%x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
208.60 +unfolding One_nat_def
208.61 apply (rule lemma_DERIV_subst)
208.62 apply (rule_tac f = "(%x. x ^ n)" in DERIV_chain2)
208.63 apply (rule DERIV_pow, auto)
208.64 @@ -1635,7 +1639,7 @@
208.65 sums sin x"
208.66 unfolding sin_def
208.67 by (rule sin_converges [THEN sums_summable, THEN sums_group], simp)
208.68 - thus ?thesis by (simp add: mult_ac)
208.69 + thus ?thesis unfolding One_nat_def by (simp add: mult_ac)
208.70 qed
208.71
208.72 lemma sin_gt_zero: "[|0 < x; x < 2 |] ==> 0 < sin x"
208.73 @@ -1647,6 +1651,7 @@
208.74 apply (rule sin_paired [THEN sums_summable, THEN sums_group], simp)
208.75 apply (rotate_tac 2)
208.76 apply (drule sin_paired [THEN sums_unique, THEN ssubst])
208.77 +unfolding One_nat_def
208.78 apply (auto simp del: fact_Suc realpow_Suc)
208.79 apply (frule sums_unique)
208.80 apply (auto simp del: fact_Suc realpow_Suc)
208.81 @@ -1720,6 +1725,7 @@
208.82 apply (simp (no_asm) add: mult_assoc del: setsum_op_ivl_Suc)
208.83 apply (rule sumr_pos_lt_pair)
208.84 apply (erule sums_summable, safe)
208.85 +unfolding One_nat_def
208.86 apply (simp (no_asm) add: divide_inverse real_0_less_add_iff mult_assoc [symmetric]
208.87 del: fact_Suc)
208.88 apply (rule real_mult_inverse_cancel2)
208.89 @@ -2792,7 +2798,7 @@
208.90
208.91 lemma monoseq_arctan_series: fixes x :: real
208.92 assumes "\<bar>x\<bar> \<le> 1" shows "monoseq (\<lambda> n. 1 / real (n*2+1) * x^(n*2+1))" (is "monoseq ?a")
208.93 -proof (cases "x = 0") case True thus ?thesis unfolding monoseq_def by auto
208.94 +proof (cases "x = 0") case True thus ?thesis unfolding monoseq_def One_nat_def by auto
208.95 next
208.96 case False
208.97 have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
208.98 @@ -2823,7 +2829,7 @@
208.99
208.100 lemma zeroseq_arctan_series: fixes x :: real
208.101 assumes "\<bar>x\<bar> \<le> 1" shows "(\<lambda> n. 1 / real (n*2+1) * x^(n*2+1)) ----> 0" (is "?a ----> 0")
208.102 -proof (cases "x = 0") case True thus ?thesis by (auto simp add: LIMSEQ_const)
208.103 +proof (cases "x = 0") case True thus ?thesis unfolding One_nat_def by (auto simp add: LIMSEQ_const)
208.104 next
208.105 case False
208.106 have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
208.107 @@ -2831,12 +2837,14 @@
208.108 proof (cases "\<bar>x\<bar> < 1")
208.109 case True hence "norm x < 1" by auto
208.110 from LIMSEQ_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF `norm x < 1`, THEN LIMSEQ_Suc]]
208.111 - show ?thesis unfolding inverse_eq_divide Suc_plus1 using LIMSEQ_linear[OF _ pos2] by auto
208.112 + have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) ----> 0"
208.113 + unfolding inverse_eq_divide Suc_plus1 by simp
208.114 + then show ?thesis using pos2 by (rule LIMSEQ_linear)
208.115 next
208.116 case False hence "x = -1 \<or> x = 1" using `\<bar>x\<bar> \<le> 1` by auto
208.117 - hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x" by auto
208.118 + hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x" unfolding One_nat_def by auto
208.119 from LIMSEQ_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] LIMSEQ_const[of x]]
208.120 - show ?thesis unfolding n_eq by auto
208.121 + show ?thesis unfolding n_eq Suc_plus1 by auto
208.122 qed
208.123 qed
208.124
208.125 @@ -2989,7 +2997,7 @@
208.126 from `even n` obtain m where "2 * m = n" unfolding even_mult_two_ex by auto
208.127 from bounds[of m, unfolded this atLeastAtMost_iff]
208.128 have "\<bar>arctan x - (\<Sum>i = 0..<n. (?c x i))\<bar> \<le> (\<Sum>i = 0..<n + 1. (?c x i)) - (\<Sum>i = 0..<n. (?c x i))" by auto
208.129 - also have "\<dots> = ?c x n" by auto
208.130 + also have "\<dots> = ?c x n" unfolding One_nat_def by auto
208.131 also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
208.132 finally show ?thesis .
208.133 next
208.134 @@ -2998,7 +3006,7 @@
208.135 hence m_plus: "2 * (m + 1) = n + 1" by auto
208.136 from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
208.137 have "\<bar>arctan x - (\<Sum>i = 0..<n. (?c x i))\<bar> \<le> (\<Sum>i = 0..<n. (?c x i)) - (\<Sum>i = 0..<n+1. (?c x i))" by auto
208.138 - also have "\<dots> = - ?c x n" by auto
208.139 + also have "\<dots> = - ?c x n" unfolding One_nat_def by auto
208.140 also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
208.141 finally show ?thesis .
208.142 qed
208.143 @@ -3011,7 +3019,9 @@
208.144 ultimately have "0 \<le> ?a 1 n - ?diff 1 n" by (rule LIM_less_bound)
208.145 hence "?diff 1 n \<le> ?a 1 n" by auto
208.146 }
208.147 - have "?a 1 ----> 0" unfolding LIMSEQ_rabs_zero power_one divide_inverse by (auto intro!: LIMSEQ_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
208.148 + have "?a 1 ----> 0"
208.149 + unfolding LIMSEQ_rabs_zero power_one divide_inverse One_nat_def
208.150 + by (auto intro!: LIMSEQ_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
208.151 have "?diff 1 ----> 0"
208.152 proof (rule LIMSEQ_I)
208.153 fix r :: real assume "0 < r"
208.154 @@ -3031,7 +3041,7 @@
208.155 have "- (pi / 2) < 0" using pi_gt_zero by auto
208.156 have "- (2 * pi) < 0" using pi_gt_zero by auto
208.157
208.158 - have c_minus_minus: "\<And> i. ?c (- 1) i = - ?c 1 i" by auto
208.159 + have c_minus_minus: "\<And> i. ?c (- 1) i = - ?c 1 i" unfolding One_nat_def by auto
208.160
208.161 have "arctan (- 1) = arctan (tan (-(pi / 4)))" unfolding tan_45 tan_minus ..
208.162 also have "\<dots> = - (pi / 4)" by (rule arctan_tan, auto simp add: order_less_trans[OF `- (pi / 2) < 0` pi_gt_zero])
208.163 @@ -3179,4 +3189,4 @@
208.164 apply (erule polar_ex2)
208.165 done
208.166
208.167 -end
208.168 +end
209.1 --- a/src/HOL/Transitive_Closure.thy Wed Mar 04 10:43:39 2009 +0100
209.2 +++ b/src/HOL/Transitive_Closure.thy Wed Mar 04 10:45:52 2009 +0100
209.3 @@ -64,8 +64,8 @@
209.4
209.5 subsection {* Reflexive closure *}
209.6
209.7 -lemma reflexive_reflcl[simp]: "reflexive(r^=)"
209.8 -by(simp add:refl_def)
209.9 +lemma refl_reflcl[simp]: "refl(r^=)"
209.10 +by(simp add:refl_on_def)
209.11
209.12 lemma antisym_reflcl[simp]: "antisym(r^=) = antisym r"
209.13 by(simp add:antisym_def)
209.14 @@ -118,8 +118,8 @@
209.15 rtrancl_induct[of "(ax,ay)" "(bx,by)", split_format (complete),
209.16 consumes 1, case_names refl step]
209.17
209.18 -lemma reflexive_rtrancl: "reflexive (r^*)"
209.19 - by (unfold refl_def) fast
209.20 +lemma refl_rtrancl: "refl (r^*)"
209.21 +by (unfold refl_on_def) fast
209.22
209.23 text {* Transitivity of transitive closure. *}
209.24 lemma trans_rtrancl: "trans (r^*)"
209.25 @@ -646,7 +646,7 @@
209.26 val trancl_rtrancl_trancl = @{thm trancl_rtrancl_trancl};
209.27 val rtrancl_trans = @{thm rtrancl_trans};
209.28
209.29 - fun decomp (Trueprop $ t) =
209.30 + fun decomp (@{const Trueprop} $ t) =
209.31 let fun dec (Const ("op :", _) $ (Const ("Pair", _) $ a $ b) $ rel ) =
209.32 let fun decr (Const ("Transitive_Closure.rtrancl", _ ) $ r) = (r,"r*")
209.33 | decr (Const ("Transitive_Closure.trancl", _ ) $ r) = (r,"r+")
209.34 @@ -654,7 +654,8 @@
209.35 val (rel,r) = decr (Envir.beta_eta_contract rel);
209.36 in SOME (a,b,rel,r) end
209.37 | dec _ = NONE
209.38 - in dec t end;
209.39 + in dec t end
209.40 + | decomp _ = NONE;
209.41
209.42 end);
209.43
209.44 @@ -669,7 +670,7 @@
209.45 val trancl_rtrancl_trancl = @{thm tranclp_rtranclp_tranclp};
209.46 val rtrancl_trans = @{thm rtranclp_trans};
209.47
209.48 - fun decomp (Trueprop $ t) =
209.49 + fun decomp (@{const Trueprop} $ t) =
209.50 let fun dec (rel $ a $ b) =
209.51 let fun decr (Const ("Transitive_Closure.rtranclp", _ ) $ r) = (r,"r*")
209.52 | decr (Const ("Transitive_Closure.tranclp", _ ) $ r) = (r,"r+")
209.53 @@ -677,7 +678,8 @@
209.54 val (rel,r) = decr rel;
209.55 in SOME (a, b, rel, r) end
209.56 | dec _ = NONE
209.57 - in dec t end;
209.58 + in dec t end
209.59 + | decomp _ = NONE;
209.60
209.61 end);
209.62 *}
210.1 --- a/src/HOL/UNITY/ListOrder.thy Wed Mar 04 10:43:39 2009 +0100
210.2 +++ b/src/HOL/UNITY/ListOrder.thy Wed Mar 04 10:45:52 2009 +0100
210.3 @@ -90,16 +90,15 @@
210.4
210.5 subsection{*genPrefix is a partial order*}
210.6
210.7 -lemma refl_genPrefix: "reflexive r ==> reflexive (genPrefix r)"
210.8 -
210.9 -apply (unfold refl_def, auto)
210.10 +lemma refl_genPrefix: "refl r ==> refl (genPrefix r)"
210.11 +apply (unfold refl_on_def, auto)
210.12 apply (induct_tac "x")
210.13 prefer 2 apply (blast intro: genPrefix.prepend)
210.14 apply (blast intro: genPrefix.Nil)
210.15 done
210.16
210.17 -lemma genPrefix_refl [simp]: "reflexive r ==> (l,l) : genPrefix r"
210.18 -by (erule reflD [OF refl_genPrefix UNIV_I])
210.19 +lemma genPrefix_refl [simp]: "refl r ==> (l,l) : genPrefix r"
210.20 +by (erule refl_onD [OF refl_genPrefix UNIV_I])
210.21
210.22 lemma genPrefix_mono: "r<=s ==> genPrefix r <= genPrefix s"
210.23 apply clarify
210.24 @@ -178,8 +177,8 @@
210.25 done
210.26
210.27 lemma same_genPrefix_genPrefix [simp]:
210.28 - "reflexive r ==> ((xs@ys, xs@zs) : genPrefix r) = ((ys,zs) : genPrefix r)"
210.29 -apply (unfold refl_def)
210.30 + "refl r ==> ((xs@ys, xs@zs) : genPrefix r) = ((ys,zs) : genPrefix r)"
210.31 +apply (unfold refl_on_def)
210.32 apply (induct_tac "xs")
210.33 apply (simp_all (no_asm_simp))
210.34 done
210.35 @@ -190,7 +189,7 @@
210.36 by (case_tac "xs", auto)
210.37
210.38 lemma genPrefix_take_append:
210.39 - "[| reflexive r; (xs,ys) : genPrefix r |]
210.40 + "[| refl r; (xs,ys) : genPrefix r |]
210.41 ==> (xs@zs, take (length xs) ys @ zs) : genPrefix r"
210.42 apply (erule genPrefix.induct)
210.43 apply (frule_tac [3] genPrefix_length_le)
210.44 @@ -198,7 +197,7 @@
210.45 done
210.46
210.47 lemma genPrefix_append_both:
210.48 - "[| reflexive r; (xs,ys) : genPrefix r; length xs = length ys |]
210.49 + "[| refl r; (xs,ys) : genPrefix r; length xs = length ys |]
210.50 ==> (xs@zs, ys @ zs) : genPrefix r"
210.51 apply (drule genPrefix_take_append, assumption)
210.52 apply (simp add: take_all)
210.53 @@ -210,7 +209,7 @@
210.54 by auto
210.55
210.56 lemma aolemma:
210.57 - "[| (xs,ys) : genPrefix r; reflexive r |]
210.58 + "[| (xs,ys) : genPrefix r; refl r |]
210.59 ==> length xs < length ys --> (xs @ [ys ! length xs], ys) : genPrefix r"
210.60 apply (erule genPrefix.induct)
210.61 apply blast
210.62 @@ -225,7 +224,7 @@
210.63 done
210.64
210.65 lemma append_one_genPrefix:
210.66 - "[| (xs,ys) : genPrefix r; length xs < length ys; reflexive r |]
210.67 + "[| (xs,ys) : genPrefix r; length xs < length ys; refl r |]
210.68 ==> (xs @ [ys ! length xs], ys) : genPrefix r"
210.69 by (blast intro: aolemma [THEN mp])
210.70
210.71 @@ -259,7 +258,7 @@
210.72
210.73 subsection{*The type of lists is partially ordered*}
210.74
210.75 -declare reflexive_Id [iff]
210.76 +declare refl_Id [iff]
210.77 antisym_Id [iff]
210.78 trans_Id [iff]
210.79
210.80 @@ -383,8 +382,8 @@
210.81
210.82 (** pfixLe **)
210.83
210.84 -lemma reflexive_Le [iff]: "reflexive Le"
210.85 -by (unfold refl_def Le_def, auto)
210.86 +lemma refl_Le [iff]: "refl Le"
210.87 +by (unfold refl_on_def Le_def, auto)
210.88
210.89 lemma antisym_Le [iff]: "antisym Le"
210.90 by (unfold antisym_def Le_def, auto)
210.91 @@ -406,8 +405,8 @@
210.92 apply (blast intro: genPrefix_mono [THEN [2] rev_subsetD])
210.93 done
210.94
210.95 -lemma reflexive_Ge [iff]: "reflexive Ge"
210.96 -by (unfold refl_def Ge_def, auto)
210.97 +lemma refl_Ge [iff]: "refl Ge"
210.98 +by (unfold refl_on_def Ge_def, auto)
210.99
210.100 lemma antisym_Ge [iff]: "antisym Ge"
210.101 by (unfold antisym_def Ge_def, auto)
211.1 --- a/src/HOL/UNITY/ProgressSets.thy Wed Mar 04 10:43:39 2009 +0100
211.2 +++ b/src/HOL/UNITY/ProgressSets.thy Wed Mar 04 10:45:52 2009 +0100
211.3 @@ -344,8 +344,8 @@
211.4 apply (blast intro: clD cl_in_lattice)
211.5 done
211.6
211.7 -lemma refl_relcl: "lattice L ==> refl UNIV (relcl L)"
211.8 -by (simp add: reflI relcl_def subset_cl [THEN subsetD])
211.9 +lemma refl_relcl: "lattice L ==> refl (relcl L)"
211.10 +by (simp add: refl_onI relcl_def subset_cl [THEN subsetD])
211.11
211.12 lemma trans_relcl: "lattice L ==> trans (relcl L)"
211.13 by (blast intro: relcl_trans transI)
211.14 @@ -362,12 +362,12 @@
211.15
211.16 text{*Equation (4.71) of Meier's thesis. He gives no proof.*}
211.17 lemma cl_latticeof:
211.18 - "[|refl UNIV r; trans r|]
211.19 + "[|refl r; trans r|]
211.20 ==> cl (latticeof r) X = {t. \<exists>s. s\<in>X & (s,t) \<in> r}"
211.21 apply (rule equalityI)
211.22 apply (rule cl_least)
211.23 apply (simp (no_asm_use) add: latticeof_def trans_def, blast)
211.24 - apply (simp add: latticeof_def refl_def, blast)
211.25 + apply (simp add: latticeof_def refl_on_def, blast)
211.26 apply (simp add: latticeof_def, clarify)
211.27 apply (unfold cl_def, blast)
211.28 done
211.29 @@ -400,7 +400,7 @@
211.30 done
211.31
211.32 theorem relcl_latticeof_eq:
211.33 - "[|refl UNIV r; trans r|] ==> relcl (latticeof r) = r"
211.34 + "[|refl r; trans r|] ==> relcl (latticeof r) = r"
211.35 by (simp add: relcl_def cl_latticeof)
211.36
211.37
212.1 --- a/src/HOL/UNITY/UNITY.thy Wed Mar 04 10:43:39 2009 +0100
212.2 +++ b/src/HOL/UNITY/UNITY.thy Wed Mar 04 10:45:52 2009 +0100
212.3 @@ -359,7 +359,7 @@
212.4
212.5 constdefs
212.6 totalize_act :: "('a * 'a)set => ('a * 'a)set"
212.7 - "totalize_act act == act \<union> diag (-(Domain act))"
212.8 + "totalize_act act == act \<union> Id_on (-(Domain act))"
212.9
212.10 totalize :: "'a program => 'a program"
212.11 "totalize F == mk_program (Init F,
213.1 --- a/src/HOL/Word/BinGeneral.thy Wed Mar 04 10:43:39 2009 +0100
213.2 +++ b/src/HOL/Word/BinGeneral.thy Wed Mar 04 10:45:52 2009 +0100
213.3 @@ -433,7 +433,7 @@
213.4 "!!w. sbintrunc n w = ((w + 2 ^ n) mod 2 ^ (Suc n) - 2 ^ n :: int)"
213.5 apply (induct n)
213.6 apply clarsimp
213.7 - apply (subst zmod_zadd_left_eq)
213.8 + apply (subst mod_add_left_eq)
213.9 apply (simp add: bin_last_mod)
213.10 apply (simp add: number_of_eq)
213.11 apply clarsimp
213.12 @@ -767,23 +767,23 @@
213.13 lemmas zpower_zmod' = zpower_zmod [where m="c" and y="k", standard]
213.14
213.15 lemmas brdmod1s' [symmetric] =
213.16 - zmod_zadd_left_eq zmod_zadd_right_eq
213.17 + mod_add_left_eq mod_add_right_eq
213.18 zmod_zsub_left_eq zmod_zsub_right_eq
213.19 zmod_zmult1_eq zmod_zmult1_eq_rev
213.20
213.21 lemmas brdmods' [symmetric] =
213.22 zpower_zmod' [symmetric]
213.23 - trans [OF zmod_zadd_left_eq zmod_zadd_right_eq]
213.24 + trans [OF mod_add_left_eq mod_add_right_eq]
213.25 trans [OF zmod_zsub_left_eq zmod_zsub_right_eq]
213.26 trans [OF zmod_zmult1_eq zmod_zmult1_eq_rev]
213.27 zmod_uminus' [symmetric]
213.28 - zmod_zadd_left_eq [where b = "1"]
213.29 + mod_add_left_eq [where b = "1::int"]
213.30 zmod_zsub_left_eq [where b = "1"]
213.31
213.32 lemmas bintr_arith1s =
213.33 - brdmod1s' [where c="2^n", folded pred_def succ_def bintrunc_mod2p, standard]
213.34 + brdmod1s' [where c="2^n::int", folded pred_def succ_def bintrunc_mod2p, standard]
213.35 lemmas bintr_ariths =
213.36 - brdmods' [where c="2^n", folded pred_def succ_def bintrunc_mod2p, standard]
213.37 + brdmods' [where c="2^n::int", folded pred_def succ_def bintrunc_mod2p, standard]
213.38
213.39 lemmas m2pths = pos_mod_sign pos_mod_bound [OF zless2p, standard]
213.40
214.1 --- a/src/HOL/Word/Num_Lemmas.thy Wed Mar 04 10:43:39 2009 +0100
214.2 +++ b/src/HOL/Word/Num_Lemmas.thy Wed Mar 04 10:45:52 2009 +0100
214.3 @@ -95,7 +95,7 @@
214.4 lemma z1pdiv2:
214.5 "(2 * b + 1) div 2 = (b::int)" by arith
214.6
214.7 -lemmas zdiv_le_dividend = xtr3 [OF zdiv_1 [symmetric] zdiv_mono2,
214.8 +lemmas zdiv_le_dividend = xtr3 [OF div_by_1 [symmetric] zdiv_mono2,
214.9 simplified int_one_le_iff_zero_less, simplified, standard]
214.10
214.11 lemma axxbyy:
214.12 @@ -127,12 +127,12 @@
214.13
214.14 lemma zmod_zsub_right_eq: "((a::int) - b) mod c = (a - b mod c) mod c"
214.15 apply (unfold diff_int_def)
214.16 - apply (rule trans [OF _ zmod_zadd_right_eq [symmetric]])
214.17 - apply (simp add : zmod_uminus zmod_zadd_right_eq [symmetric])
214.18 + apply (rule trans [OF _ mod_add_right_eq [symmetric]])
214.19 + apply (simp add : zmod_uminus mod_add_right_eq [symmetric])
214.20 done
214.21
214.22 lemma zmod_zsub_left_eq: "((a::int) - b) mod c = (a mod c - b) mod c"
214.23 - by (rule zmod_zadd_left_eq [where b = "- b", simplified diff_int_def [symmetric]])
214.24 + by (rule mod_add_left_eq [where b = "- b", simplified diff_int_def [symmetric]])
214.25
214.26 lemma zmod_zsub_self [simp]:
214.27 "((b :: int) - a) mod a = b mod a"
214.28 @@ -146,8 +146,8 @@
214.29 done
214.30
214.31 lemmas rdmods [symmetric] = zmod_uminus [symmetric]
214.32 - zmod_zsub_left_eq zmod_zsub_right_eq zmod_zadd_left_eq
214.33 - zmod_zadd_right_eq zmod_zmult1_eq zmod_zmult1_eq_rev
214.34 + zmod_zsub_left_eq zmod_zsub_right_eq mod_add_left_eq
214.35 + mod_add_right_eq zmod_zmult1_eq zmod_zmult1_eq_rev
214.36
214.37 lemma mod_plus_right:
214.38 "((a + x) mod m = (b + x) mod m) = (a mod m = b mod (m :: nat))"
214.39 @@ -169,7 +169,8 @@
214.40 lemmas push_mods = push_mods' [THEN eq_reflection, standard]
214.41 lemmas pull_mods = push_mods [symmetric] rdmods [THEN eq_reflection, standard]
214.42 lemmas mod_simps =
214.43 - zmod_zmult_self1 [THEN eq_reflection] zmod_zmult_self2 [THEN eq_reflection]
214.44 + mod_mult_self2_is_0 [THEN eq_reflection]
214.45 + mod_mult_self1_is_0 [THEN eq_reflection]
214.46 mod_mod_trivial [THEN eq_reflection]
214.47
214.48 lemma nat_mod_eq:
214.49 @@ -259,7 +260,7 @@
214.50
214.51 (** Rep_Integ **)
214.52 lemma eqne: "equiv A r ==> X : A // r ==> X ~= {}"
214.53 - unfolding equiv_def refl_def quotient_def Image_def by auto
214.54 + unfolding equiv_def refl_on_def quotient_def Image_def by auto
214.55
214.56 lemmas Rep_Integ_ne = Integ.Rep_Integ
214.57 [THEN equiv_intrel [THEN eqne, simplified Integ_def [symmetric]], standard]
214.58 @@ -313,7 +314,7 @@
214.59 "a > 1 ==> a ^ n mod a ^ m = (if m <= n then 0 else (a :: int) ^ n)"
214.60 apply clarsimp
214.61 apply safe
214.62 - apply (simp add: zdvd_iff_zmod_eq_0 [symmetric])
214.63 + apply (simp add: dvd_eq_mod_eq_0 [symmetric])
214.64 apply (drule le_iff_add [THEN iffD1])
214.65 apply (force simp: zpower_zadd_distrib)
214.66 apply (rule mod_pos_pos_trivial)
215.1 --- a/src/HOL/Word/WordGenLib.thy Wed Mar 04 10:43:39 2009 +0100
215.2 +++ b/src/HOL/Word/WordGenLib.thy Wed Mar 04 10:45:52 2009 +0100
215.3 @@ -273,7 +273,7 @@
215.4 have x: "2^len_of TYPE('a) - i = -i + 2^len_of TYPE('a)" by simp
215.5 show ?thesis
215.6 apply (subst x)
215.7 - apply (subst word_uint.Abs_norm [symmetric], subst zmod_zadd_self2)
215.8 + apply (subst word_uint.Abs_norm [symmetric], subst mod_add_self2)
215.9 apply simp
215.10 done
215.11 qed
216.1 --- a/src/HOL/Word/WordShift.thy Wed Mar 04 10:43:39 2009 +0100
216.2 +++ b/src/HOL/Word/WordShift.thy Wed Mar 04 10:45:52 2009 +0100
216.3 @@ -530,7 +530,7 @@
216.4 done
216.5
216.6 lemma and_mask_dvd: "2 ^ n dvd uint w = (w AND mask n = 0)"
216.7 - apply (simp add: zdvd_iff_zmod_eq_0 and_mask_mod_2p)
216.8 + apply (simp add: dvd_eq_mod_eq_0 and_mask_mod_2p)
216.9 apply (simp add: word_uint.norm_eq_iff [symmetric] word_of_int_homs)
216.10 apply (subst word_uint.norm_Rep [symmetric])
216.11 apply (simp only: bintrunc_bintrunc_min bintrunc_mod2p [symmetric] min_def)
217.1 --- a/src/HOL/ZF/Games.thy Wed Mar 04 10:43:39 2009 +0100
217.2 +++ b/src/HOL/ZF/Games.thy Wed Mar 04 10:45:52 2009 +0100
217.3 @@ -847,7 +847,7 @@
217.4 by (auto simp add: quotient_def)
217.5
217.6 lemma equiv_eq_game[simp]: "equiv UNIV eq_game_rel"
217.7 - by (auto simp add: equiv_def refl_def sym_def trans_def eq_game_rel_def
217.8 + by (auto simp add: equiv_def refl_on_def sym_def trans_def eq_game_rel_def
217.9 eq_game_sym intro: eq_game_refl eq_game_trans)
217.10
217.11 instantiation Pg :: "{ord, zero, plus, minus, uminus}"
218.1 --- a/src/HOL/ex/ApproximationEx.thy Wed Mar 04 10:43:39 2009 +0100
218.2 +++ b/src/HOL/ex/ApproximationEx.thy Wed Mar 04 10:45:52 2009 +0100
218.3 @@ -1,6 +1,7 @@
218.4 -(* Title: HOL/ex/ApproximationEx.thy
218.5 - Author: Johannes Hoelzl <hoelzl@in.tum.de> 2009
218.6 +(* Title: HOL/ex/ApproximationEx.thy
218.7 + Author: Johannes Hoelzl <hoelzl@in.tum.de> 2009
218.8 *)
218.9 +
218.10 theory ApproximationEx
218.11 imports "~~/src/HOL/Reflection/Approximation"
218.12 begin
219.1 --- a/src/HOL/ex/Eval_Examples.thy Wed Mar 04 10:43:39 2009 +0100
219.2 +++ b/src/HOL/ex/Eval_Examples.thy Wed Mar 04 10:45:52 2009 +0100
219.3 @@ -1,6 +1,4 @@
219.4 -(* ID: $Id$
219.5 - Author: Florian Haftmann, TU Muenchen
219.6 -*)
219.7 +(* Author: Florian Haftmann, TU Muenchen *)
219.8
219.9 header {* Small examples for evaluation mechanisms *}
219.10
220.1 --- a/src/HOL/ex/Numeral.thy Wed Mar 04 10:43:39 2009 +0100
220.2 +++ b/src/HOL/ex/Numeral.thy Wed Mar 04 10:45:52 2009 +0100
220.3 @@ -157,6 +157,18 @@
220.4 by (simp_all add: num_eq_iff nat_of_num_add nat_of_num_mult
220.5 left_distrib right_distrib)
220.6
220.7 +lemma Dig_eq:
220.8 + "One = One \<longleftrightarrow> True"
220.9 + "One = Dig0 n \<longleftrightarrow> False"
220.10 + "One = Dig1 n \<longleftrightarrow> False"
220.11 + "Dig0 m = One \<longleftrightarrow> False"
220.12 + "Dig1 m = One \<longleftrightarrow> False"
220.13 + "Dig0 m = Dig0 n \<longleftrightarrow> m = n"
220.14 + "Dig0 m = Dig1 n \<longleftrightarrow> False"
220.15 + "Dig1 m = Dig0 n \<longleftrightarrow> False"
220.16 + "Dig1 m = Dig1 n \<longleftrightarrow> m = n"
220.17 + by simp_all
220.18 +
220.19 lemma less_eq_num_code [numeral, simp, code]:
220.20 "One \<le> n \<longleftrightarrow> True"
220.21 "Dig0 m \<le> One \<longleftrightarrow> False"
220.22 @@ -433,21 +445,12 @@
220.23
220.24 text {* Could be perhaps more general than here. *}
220.25
220.26 -lemma (in ordered_semidom) of_num_pos: "0 < of_num n"
220.27 -proof -
220.28 - have "(0::nat) < of_num n"
220.29 - by (induct n) (simp_all add: semiring_numeral_class.of_num.simps)
220.30 - then have "of_nat 0 \<noteq> of_nat (of_num n)"
220.31 - by (cases n) (simp_all only: semiring_numeral_class.of_num.simps of_nat_eq_iff)
220.32 - then have "0 \<noteq> of_num n"
220.33 - by (simp add: of_nat_of_num)
220.34 - moreover have "0 \<le> of_nat (of_num n)" by simp
220.35 - ultimately show ?thesis by (simp add: of_nat_of_num)
220.36 -qed
220.37 -
220.38 context ordered_semidom
220.39 begin
220.40
220.41 +lemma of_num_pos [numeral]: "0 < of_num n"
220.42 + by (induct n) (simp_all add: of_num.simps add_pos_pos)
220.43 +
220.44 lemma of_num_less_eq_iff [numeral]: "of_num m \<le> of_num n \<longleftrightarrow> m \<le> n"
220.45 proof -
220.46 have "of_nat (of_num m) \<le> of_nat (of_num n) \<longleftrightarrow> m \<le> n"
220.47 @@ -490,6 +493,68 @@
220.48 then show ?thesis by (simp add: of_num_one)
220.49 qed
220.50
220.51 +lemma of_num_nonneg [numeral]: "0 \<le> of_num n"
220.52 + by (induct n) (simp_all add: of_num.simps add_nonneg_nonneg)
220.53 +
220.54 +lemma of_num_less_zero_iff [numeral]: "\<not> of_num n < 0"
220.55 + by (simp add: not_less of_num_nonneg)
220.56 +
220.57 +lemma of_num_le_zero_iff [numeral]: "\<not> of_num n \<le> 0"
220.58 + by (simp add: not_le of_num_pos)
220.59 +
220.60 +end
220.61 +
220.62 +context ordered_idom
220.63 +begin
220.64 +
220.65 +lemma minus_of_num_less_of_num_iff [numeral]: "- of_num m < of_num n"
220.66 +proof -
220.67 + have "- of_num m < 0" by (simp add: of_num_pos)
220.68 + also have "0 < of_num n" by (simp add: of_num_pos)
220.69 + finally show ?thesis .
220.70 +qed
220.71 +
220.72 +lemma minus_of_num_less_one_iff [numeral]: "- of_num n < 1"
220.73 +proof -
220.74 + have "- of_num n < 0" by (simp add: of_num_pos)
220.75 + also have "0 < 1" by simp
220.76 + finally show ?thesis .
220.77 +qed
220.78 +
220.79 +lemma minus_one_less_of_num_iff [numeral]: "- 1 < of_num n"
220.80 +proof -
220.81 + have "- 1 < 0" by simp
220.82 + also have "0 < of_num n" by (simp add: of_num_pos)
220.83 + finally show ?thesis .
220.84 +qed
220.85 +
220.86 +lemma minus_of_num_le_of_num_iff [numeral]: "- of_num m \<le> of_num n"
220.87 + by (simp add: less_imp_le minus_of_num_less_of_num_iff)
220.88 +
220.89 +lemma minus_of_num_le_one_iff [numeral]: "- of_num n \<le> 1"
220.90 + by (simp add: less_imp_le minus_of_num_less_one_iff)
220.91 +
220.92 +lemma minus_one_le_of_num_iff [numeral]: "- 1 \<le> of_num n"
220.93 + by (simp add: less_imp_le minus_one_less_of_num_iff)
220.94 +
220.95 +lemma of_num_le_minus_of_num_iff [numeral]: "\<not> of_num m \<le> - of_num n"
220.96 + by (simp add: not_le minus_of_num_less_of_num_iff)
220.97 +
220.98 +lemma one_le_minus_of_num_iff [numeral]: "\<not> 1 \<le> - of_num n"
220.99 + by (simp add: not_le minus_of_num_less_one_iff)
220.100 +
220.101 +lemma of_num_le_minus_one_iff [numeral]: "\<not> of_num n \<le> - 1"
220.102 + by (simp add: not_le minus_one_less_of_num_iff)
220.103 +
220.104 +lemma of_num_less_minus_of_num_iff [numeral]: "\<not> of_num m < - of_num n"
220.105 + by (simp add: not_less minus_of_num_le_of_num_iff)
220.106 +
220.107 +lemma one_less_minus_of_num_iff [numeral]: "\<not> 1 < - of_num n"
220.108 + by (simp add: not_less minus_of_num_le_one_iff)
220.109 +
220.110 +lemma of_num_less_minus_one_iff [numeral]: "\<not> of_num n < - 1"
220.111 + by (simp add: not_less minus_one_le_of_num_iff)
220.112 +
220.113 end
220.114
220.115 subsubsection {*
221.1 --- a/src/HOL/ex/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
221.2 +++ b/src/HOL/ex/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
221.3 @@ -93,4 +93,5 @@
221.4 use_thy "Sudoku"
221.5 else ();
221.6
221.7 -HTML.with_charset "utf-8" (no_document use_thys) ["Hebrew", "Chinese"];
221.8 +HTML.with_charset "utf-8" (no_document use_thys)
221.9 + ["Hebrew", "Chinese", "Serbian"];
222.1 --- a/src/HOL/ex/Tarski.thy Wed Mar 04 10:43:39 2009 +0100
222.2 +++ b/src/HOL/ex/Tarski.thy Wed Mar 04 10:45:52 2009 +0100
222.3 @@ -73,7 +73,7 @@
222.4
222.5 definition
222.6 PartialOrder :: "('a potype) set" where
222.7 - "PartialOrder = {P. refl (pset P) (order P) & antisym (order P) &
222.8 + "PartialOrder = {P. refl_on (pset P) (order P) & antisym (order P) &
222.9 trans (order P)}"
222.10
222.11 definition
222.12 @@ -158,7 +158,7 @@
222.13 unfolding PartialOrder_def dual_def
222.14 by auto
222.15
222.16 -lemma (in PO) PO_imp_refl [simp]: "refl A r"
222.17 +lemma (in PO) PO_imp_refl_on [simp]: "refl_on A r"
222.18 apply (insert cl_po)
222.19 apply (simp add: PartialOrder_def A_def r_def)
222.20 done
222.21 @@ -175,7 +175,7 @@
222.22
222.23 lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
222.24 apply (insert cl_po)
222.25 -apply (simp add: PartialOrder_def refl_def A_def r_def)
222.26 +apply (simp add: PartialOrder_def refl_on_def A_def r_def)
222.27 done
222.28
222.29 lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
222.30 @@ -198,7 +198,7 @@
222.31 apply (simp (no_asm) add: PartialOrder_def)
222.32 apply auto
222.33 -- {* refl *}
222.34 -apply (simp add: refl_def induced_def)
222.35 +apply (simp add: refl_on_def induced_def)
222.36 apply (blast intro: reflE)
222.37 -- {* antisym *}
222.38 apply (simp add: antisym_def induced_def)
222.39 @@ -235,7 +235,7 @@
222.40
222.41 lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
222.42 apply (insert cl_po)
222.43 -apply (simp add: PartialOrder_def dual_def refl_converse
222.44 +apply (simp add: PartialOrder_def dual_def refl_on_converse
222.45 trans_converse antisym_converse)
222.46 done
222.47
222.48 @@ -266,8 +266,8 @@
222.49 declare CL_imp_PO [THEN PO.PO_imp_sym, simp]
222.50 declare CL_imp_PO [THEN PO.PO_imp_trans, simp]*)
222.51
222.52 -lemma (in CL) CO_refl: "refl A r"
222.53 -by (rule PO_imp_refl)
222.54 +lemma (in CL) CO_refl_on: "refl_on A r"
222.55 +by (rule PO_imp_refl_on)
222.56
222.57 lemma (in CL) CO_antisym: "antisym r"
222.58 by (rule PO_imp_sym)
222.59 @@ -533,7 +533,7 @@
222.60
222.61 lemma (in CLF) fix_in_H:
222.62 "[| H = {x. (x, f x) \<in> r & x \<in> A}; x \<in> P |] ==> x \<in> H"
222.63 -by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl
222.64 +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
222.65 fix_subset [of f A, THEN subsetD])
222.66
222.67 lemma (in CLF) fixf_le_lubH:
222.68 @@ -583,8 +583,8 @@
222.69 subsection {* interval *}
222.70
222.71 lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
222.72 -apply (insert CO_refl)
222.73 -apply (simp add: refl_def, blast)
222.74 +apply (insert CO_refl_on)
222.75 +apply (simp add: refl_on_def, blast)
222.76 done
222.77
222.78 lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
222.79 @@ -754,7 +754,7 @@
222.80 apply (rule notI)
222.81 apply (drule_tac a = "Top cl" in equals0D)
222.82 apply (simp add: interval_def)
222.83 -apply (simp add: refl_def Top_in_lattice Top_prop)
222.84 +apply (simp add: refl_on_def Top_in_lattice Top_prop)
222.85 done
222.86
222.87 lemma (in CLF) Bot_intv_not_empty: "x \<in> A ==> interval r (Bot cl) x \<noteq> {}"
223.1 --- a/src/HOL/ex/ThreeDivides.thy Wed Mar 04 10:43:39 2009 +0100
223.2 +++ b/src/HOL/ex/ThreeDivides.thy Wed Mar 04 10:45:52 2009 +0100
223.3 @@ -187,9 +187,8 @@
223.4 "nd = nlen (m div 10) \<Longrightarrow>
223.5 m div 10 = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x)"
223.6 by blast
223.7 - have "\<exists>c. m = 10*(m div 10) + c \<and> c < 10" by presburger
223.8 - then obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10" ..
223.9 - then have cdef: "c = m mod 10" by arith
223.10 + obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10"
223.11 + and cdef: "c = m mod 10" by simp
223.12 show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)"
223.13 proof -
223.14 from `Suc nd = nlen m`
224.1 --- a/src/HOLCF/ConvexPD.thy Wed Mar 04 10:43:39 2009 +0100
224.2 +++ b/src/HOLCF/ConvexPD.thy Wed Mar 04 10:45:52 2009 +0100
224.3 @@ -291,22 +291,26 @@
224.4 apply (simp add: PDPlus_commute)
224.5 done
224.6
224.7 -lemma convex_plus_absorb: "xs +\<natural> xs = xs"
224.8 +lemma convex_plus_absorb [simp]: "xs +\<natural> xs = xs"
224.9 apply (induct xs rule: convex_pd.principal_induct, simp)
224.10 apply (simp add: PDPlus_absorb)
224.11 done
224.12
224.13 -interpretation aci_convex_plus!: ab_semigroup_idem_mult "op +\<natural>"
224.14 - proof qed (rule convex_plus_assoc convex_plus_commute convex_plus_absorb)+
224.15 +lemma convex_plus_left_commute: "xs +\<natural> (ys +\<natural> zs) = ys +\<natural> (xs +\<natural> zs)"
224.16 +by (rule mk_left_commute
224.17 + [of "op +\<natural>", OF convex_plus_assoc convex_plus_commute])
224.18
224.19 -lemma convex_plus_left_commute: "xs +\<natural> (ys +\<natural> zs) = ys +\<natural> (xs +\<natural> zs)"
224.20 -by (rule aci_convex_plus.mult_left_commute)
224.21 +lemma convex_plus_left_absorb [simp]: "xs +\<natural> (xs +\<natural> ys) = xs +\<natural> ys"
224.22 +by (simp only: convex_plus_assoc [symmetric] convex_plus_absorb)
224.23
224.24 -lemma convex_plus_left_absorb: "xs +\<natural> (xs +\<natural> ys) = xs +\<natural> ys"
224.25 -by (rule aci_convex_plus.mult_left_idem)
224.26 -(*
224.27 -lemmas convex_plus_aci = aci_convex_plus.mult_ac_idem
224.28 -*)
224.29 +text {* Useful for @{text "simp add: convex_plus_ac"} *}
224.30 +lemmas convex_plus_ac =
224.31 + convex_plus_assoc convex_plus_commute convex_plus_left_commute
224.32 +
224.33 +text {* Useful for @{text "simp only: convex_plus_aci"} *}
224.34 +lemmas convex_plus_aci =
224.35 + convex_plus_ac convex_plus_absorb convex_plus_left_absorb
224.36 +
224.37 lemma convex_unit_less_plus_iff [simp]:
224.38 "{x}\<natural> \<sqsubseteq> ys +\<natural> zs \<longleftrightarrow> {x}\<natural> \<sqsubseteq> ys \<and> {x}\<natural> \<sqsubseteq> zs"
224.39 apply (rule iffI)
224.40 @@ -413,7 +417,7 @@
224.41 apply unfold_locales
224.42 apply (simp add: convex_plus_assoc)
224.43 apply (simp add: convex_plus_commute)
224.44 -apply (simp add: convex_plus_absorb eta_cfun)
224.45 +apply (simp add: eta_cfun)
224.46 done
224.47
224.48 lemma convex_bind_basis_simps [simp]:
225.1 --- a/src/HOLCF/Fixrec.thy Wed Mar 04 10:43:39 2009 +0100
225.2 +++ b/src/HOLCF/Fixrec.thy Wed Mar 04 10:45:52 2009 +0100
225.3 @@ -583,6 +583,20 @@
225.4
225.5 use "Tools/fixrec_package.ML"
225.6
225.7 +setup {* FixrecPackage.setup *}
225.8 +
225.9 +setup {*
225.10 + FixrecPackage.add_matchers
225.11 + [ (@{const_name up}, @{const_name match_up}),
225.12 + (@{const_name sinl}, @{const_name match_sinl}),
225.13 + (@{const_name sinr}, @{const_name match_sinr}),
225.14 + (@{const_name spair}, @{const_name match_spair}),
225.15 + (@{const_name cpair}, @{const_name match_cpair}),
225.16 + (@{const_name ONE}, @{const_name match_ONE}),
225.17 + (@{const_name TT}, @{const_name match_TT}),
225.18 + (@{const_name FF}, @{const_name match_FF}) ]
225.19 +*}
225.20 +
225.21 hide (open) const return bind fail run cases
225.22
225.23 end
226.1 --- a/src/HOLCF/IsaMakefile Wed Mar 04 10:43:39 2009 +0100
226.2 +++ b/src/HOLCF/IsaMakefile Wed Mar 04 10:45:52 2009 +0100
226.3 @@ -89,6 +89,7 @@
226.4
226.5 $(LOG)/HOLCF-ex.gz: $(OUT)/HOLCF ex/Stream.thy ex/Dagstuhl.thy \
226.6 ex/Dnat.thy ex/Fix2.thy ex/Focus_ex.thy ex/Hoare.thy ex/Loop.thy \
226.7 + ex/Powerdomain_ex.thy \
226.8 ex/ROOT.ML ex/Fixrec_ex.thy ../HOL/Library/Nat_Infinity.thy
226.9 @$(ISABELLE_TOOL) usedir $(OUT)/HOLCF ex
226.10
227.1 --- a/src/HOLCF/LowerPD.thy Wed Mar 04 10:43:39 2009 +0100
227.2 +++ b/src/HOLCF/LowerPD.thy Wed Mar 04 10:45:52 2009 +0100
227.3 @@ -245,22 +245,25 @@
227.4 apply (simp add: PDPlus_commute)
227.5 done
227.6
227.7 -lemma lower_plus_absorb: "xs +\<flat> xs = xs"
227.8 +lemma lower_plus_absorb [simp]: "xs +\<flat> xs = xs"
227.9 apply (induct xs rule: lower_pd.principal_induct, simp)
227.10 apply (simp add: PDPlus_absorb)
227.11 done
227.12
227.13 -interpretation aci_lower_plus!: ab_semigroup_idem_mult "op +\<flat>"
227.14 - proof qed (rule lower_plus_assoc lower_plus_commute lower_plus_absorb)+
227.15 +lemma lower_plus_left_commute: "xs +\<flat> (ys +\<flat> zs) = ys +\<flat> (xs +\<flat> zs)"
227.16 +by (rule mk_left_commute [of "op +\<flat>", OF lower_plus_assoc lower_plus_commute])
227.17
227.18 -lemma lower_plus_left_commute: "xs +\<flat> (ys +\<flat> zs) = ys +\<flat> (xs +\<flat> zs)"
227.19 -by (rule aci_lower_plus.mult_left_commute)
227.20 +lemma lower_plus_left_absorb [simp]: "xs +\<flat> (xs +\<flat> ys) = xs +\<flat> ys"
227.21 +by (simp only: lower_plus_assoc [symmetric] lower_plus_absorb)
227.22
227.23 -lemma lower_plus_left_absorb: "xs +\<flat> (xs +\<flat> ys) = xs +\<flat> ys"
227.24 -by (rule aci_lower_plus.mult_left_idem)
227.25 -(*
227.26 -lemmas lower_plus_aci = aci_lower_plus.mult_ac_idem
227.27 -*)
227.28 +text {* Useful for @{text "simp add: lower_plus_ac"} *}
227.29 +lemmas lower_plus_ac =
227.30 + lower_plus_assoc lower_plus_commute lower_plus_left_commute
227.31 +
227.32 +text {* Useful for @{text "simp only: lower_plus_aci"} *}
227.33 +lemmas lower_plus_aci =
227.34 + lower_plus_ac lower_plus_absorb lower_plus_left_absorb
227.35 +
227.36 lemma lower_plus_less1: "xs \<sqsubseteq> xs +\<flat> ys"
227.37 apply (induct xs ys rule: lower_pd.principal_induct2, simp, simp)
227.38 apply (simp add: PDPlus_lower_less)
227.39 @@ -315,14 +318,8 @@
227.40 lower_plus_less_iff
227.41 lower_unit_less_plus_iff
227.42
227.43 -lemma fooble:
227.44 - fixes f :: "'a::po \<Rightarrow> 'b::po"
227.45 - assumes f: "\<And>x y. f x \<sqsubseteq> f y \<longleftrightarrow> x \<sqsubseteq> y"
227.46 - shows "f x = f y \<longleftrightarrow> x = y"
227.47 -unfolding po_eq_conv by (simp add: f)
227.48 -
227.49 lemma lower_unit_eq_iff [simp]: "{x}\<flat> = {y}\<flat> \<longleftrightarrow> x = y"
227.50 -by (rule lower_unit_less_iff [THEN fooble])
227.51 +by (simp add: po_eq_conv)
227.52
227.53 lemma lower_unit_strict [simp]: "{\<bottom>}\<flat> = \<bottom>"
227.54 unfolding inst_lower_pd_pcpo Rep_compact_bot [symmetric] by simp
227.55 @@ -399,7 +396,7 @@
227.56 apply unfold_locales
227.57 apply (simp add: lower_plus_assoc)
227.58 apply (simp add: lower_plus_commute)
227.59 -apply (simp add: lower_plus_absorb eta_cfun)
227.60 +apply (simp add: eta_cfun)
227.61 done
227.62
227.63 lemma lower_bind_basis_simps [simp]:
228.1 --- a/src/HOLCF/Tools/domain/domain_axioms.ML Wed Mar 04 10:43:39 2009 +0100
228.2 +++ b/src/HOLCF/Tools/domain/domain_axioms.ML Wed Mar 04 10:45:52 2009 +0100
228.3 @@ -1,5 +1,4 @@
228.4 (* Title: HOLCF/Tools/domain/domain_axioms.ML
228.5 - ID: $Id$
228.6 Author: David von Oheimb
228.7
228.8 Syntax generator for domain command.
228.9 @@ -29,7 +28,7 @@
228.10 val rep_iso_ax = ("rep_iso", mk_trp(dc_abs`(dc_rep`%x_name') === %:x_name'));
228.11
228.12 val when_def = ("when_def",%%:(dname^"_when") ==
228.13 - foldr (uncurry /\ ) (/\x_name'((when_body cons (fn (x,y) =>
228.14 + List.foldr (uncurry /\ ) (/\x_name'((when_body cons (fn (x,y) =>
228.15 Bound(1+length cons+x-y)))`(dc_rep`Bound 0))) (when_funs cons));
228.16
228.17 val copy_def = let
228.18 @@ -37,9 +36,9 @@
228.19 then (cproj (Bound z) eqs (rec_of arg))`Bound(z-x)
228.20 else Bound(z-x);
228.21 fun one_con (con,args) =
228.22 - foldr /\# (list_ccomb (%%:con, mapn (idxs (length args)) 1 args)) args;
228.23 + List.foldr /\# (list_ccomb (%%:con, mapn (idxs (length args)) 1 args)) args;
228.24 in ("copy_def", %%:(dname^"_copy") ==
228.25 - /\"f" (list_ccomb (%%:(dname^"_when"), map one_con cons))) end;
228.26 + /\ "f" (list_ccomb (%%:(dname^"_when"), map one_con cons))) end;
228.27
228.28 (* -- definitions concerning the constructors, discriminators and selectors - *)
228.29
228.30 @@ -49,7 +48,7 @@
228.31 fun inj y 1 _ = y
228.32 | inj y _ 0 = mk_sinl y
228.33 | inj y i j = mk_sinr (inj y (i-1) (j-1));
228.34 - in foldr /\# (dc_abs`(inj (parms args) m n)) args end;
228.35 + in List.foldr /\# (dc_abs`(inj (parms args) m n)) args end;
228.36
228.37 val con_defs = mapn (fn n => fn (con,args) =>
228.38 (extern_name con ^"_def", %%:con == con_def (length cons) n (con,args))) 0 cons;
228.39 @@ -57,14 +56,14 @@
228.40 val dis_defs = let
228.41 fun ddef (con,_) = (dis_name con ^"_def",%%:(dis_name con) ==
228.42 list_ccomb(%%:(dname^"_when"),map
228.43 - (fn (con',args) => (foldr /\#
228.44 + (fn (con',args) => (List.foldr /\#
228.45 (if con'=con then TT else FF) args)) cons))
228.46 in map ddef cons end;
228.47
228.48 val mat_defs = let
228.49 fun mdef (con,_) = (mat_name con ^"_def",%%:(mat_name con) ==
228.50 list_ccomb(%%:(dname^"_when"),map
228.51 - (fn (con',args) => (foldr /\#
228.52 + (fn (con',args) => (List.foldr /\#
228.53 (if con'=con
228.54 then mk_return (mk_ctuple (map (bound_arg args) args))
228.55 else mk_fail) args)) cons))
228.56 @@ -79,7 +78,7 @@
228.57 val r = Bound (length args);
228.58 val rhs = case args of [] => mk_return HOLogic.unit
228.59 | _ => mk_ctuple_pat ps ` mk_ctuple xs;
228.60 - fun one_con (con',args') = foldr /\# (if con'=con then rhs else mk_fail) args';
228.61 + fun one_con (con',args') = List.foldr /\# (if con'=con then rhs else mk_fail) args';
228.62 in (pat_name con ^"_def", list_comb (%%:(pat_name con), ps) ==
228.63 list_ccomb(%%:(dname^"_when"), map one_con cons))
228.64 end
228.65 @@ -89,7 +88,7 @@
228.66 fun sdef con n arg = Option.map (fn sel => (sel^"_def",%%:sel ==
228.67 list_ccomb(%%:(dname^"_when"),map
228.68 (fn (con',args) => if con'<>con then UU else
228.69 - foldr /\# (Bound (length args - n)) args) cons))) (sel_of arg);
228.70 + List.foldr /\# (Bound (length args - n)) args) cons))) (sel_of arg);
228.71 in List.mapPartial I (List.concat(map (fn (con,args) => mapn (sdef con) 1 args) cons)) end;
228.72
228.73
228.74 @@ -107,7 +106,7 @@
228.75 [when_def, copy_def] @
228.76 con_defs @ dis_defs @ mat_defs @ pat_defs @ sel_defs @
228.77 [take_def, finite_def])
228.78 -end; (* let *)
228.79 +end; (* let (calc_axioms) *)
228.80
228.81 fun infer_props thy = map (apsnd (FixrecPackage.legacy_infer_prop thy));
228.82
228.83 @@ -117,6 +116,14 @@
228.84 fun add_defs_i x = snd o (PureThy.add_defs false) (map (Thm.no_attributes o apfst Binding.name) x);
228.85 fun add_defs_infer defs thy = add_defs_i (infer_props thy defs) thy;
228.86
228.87 +fun add_matchers (((dname,_),cons) : eq) thy =
228.88 + let
228.89 + val con_names = map fst cons;
228.90 + val mat_names = map mat_name con_names;
228.91 + fun qualify n = Sign.full_name thy (Binding.name n);
228.92 + val ms = map qualify con_names ~~ map qualify mat_names;
228.93 + in FixrecPackage.add_matchers ms thy end;
228.94 +
228.95 in (* local *)
228.96
228.97 fun add_axioms (comp_dnam, eqs : eq list) thy' = let
228.98 @@ -125,7 +132,7 @@
228.99 val x_name = idx_name dnames "x";
228.100 fun copy_app dname = %%:(dname^"_copy")`Bound 0;
228.101 val copy_def = ("copy_def" , %%:(comp_dname^"_copy") ==
228.102 - /\"f"(mk_ctuple (map copy_app dnames)));
228.103 + /\ "f"(mk_ctuple (map copy_app dnames)));
228.104 val bisim_def = ("bisim_def",%%:(comp_dname^"_bisim")==mk_lam("R",
228.105 let
228.106 fun one_con (con,args) = let
228.107 @@ -144,11 +151,11 @@
228.108 (allargs~~((allargs_cnt-1) downto 0)));
228.109 fun rel_app i ra = proj (Bound(allargs_cnt+2)) eqs (rec_of ra) $
228.110 Bound (2*recs_cnt-i) $ Bound (recs_cnt-i);
228.111 - val capps = foldr mk_conj (mk_conj(
228.112 + val capps = List.foldr mk_conj (mk_conj(
228.113 Bound(allargs_cnt+1)===list_ccomb(%%:con,map (bound_arg allvns) vns1),
228.114 Bound(allargs_cnt+0)===list_ccomb(%%:con,map (bound_arg allvns) vns2)))
228.115 (mapn rel_app 1 rec_args);
228.116 - in foldr mk_ex (Library.foldr mk_conj
228.117 + in List.foldr mk_ex (Library.foldr mk_conj
228.118 (map (defined o Bound) nonlazy_idxs,capps)) allvns end;
228.119 fun one_comp n (_,cons) =mk_all(x_name(n+1),mk_all(x_name(n+1)^"'",mk_imp(
228.120 proj (Bound 2) eqs n $ Bound 1 $ Bound 0,
228.121 @@ -164,7 +171,8 @@
228.122 in thy |> Sign.add_path comp_dnam
228.123 |> add_defs_infer (bisim_def::(if length eqs>1 then [copy_def] else []))
228.124 |> Sign.parent_path
228.125 -end;
228.126 + |> fold add_matchers eqs
228.127 +end; (* let (add_axioms) *)
228.128
228.129 end; (* local *)
228.130 end; (* struct *)
229.1 --- a/src/HOLCF/Tools/domain/domain_library.ML Wed Mar 04 10:43:39 2009 +0100
229.2 +++ b/src/HOLCF/Tools/domain/domain_library.ML Wed Mar 04 10:45:52 2009 +0100
229.3 @@ -1,5 +1,4 @@
229.4 (* Title: HOLCF/Tools/domain/domain_library.ML
229.5 - ID: $Id$
229.6 Author: David von Oheimb
229.7
229.8 Library for domain command.
229.9 @@ -15,7 +14,7 @@
229.10 | itr [a] = f2 a
229.11 | itr (a::l) = f(a, itr l)
229.12 in itr l end;
229.13 -fun map_cumulr f start xs = foldr (fn (x,(ys,res))=>case f(x,res) of (y,res2) =>
229.14 +fun map_cumulr f start xs = List.foldr (fn (x,(ys,res))=>case f(x,res) of (y,res2) =>
229.15 (y::ys,res2)) ([],start) xs;
229.16
229.17
230.1 --- a/src/HOLCF/Tools/domain/domain_syntax.ML Wed Mar 04 10:43:39 2009 +0100
230.2 +++ b/src/HOLCF/Tools/domain/domain_syntax.ML Wed Mar 04 10:45:52 2009 +0100
230.3 @@ -1,5 +1,4 @@
230.4 (* Title: HOLCF/Tools/domain/domain_syntax.ML
230.5 - ID: $Id$
230.6 Author: David von Oheimb
230.7
230.8 Syntax generator for domain command.
230.9 @@ -22,14 +21,14 @@
230.10 else foldr1 mk_sprodT (map opt_lazy args);
230.11 fun freetvar s = let val tvar = mk_TFree s in
230.12 if tvar mem typevars then freetvar ("t"^s) else tvar end;
230.13 - fun when_type (_ ,_,args) = foldr (op ->>) (freetvar "t") (map third args);
230.14 + fun when_type (_ ,_,args) = List.foldr (op ->>) (freetvar "t") (map third args);
230.15 in
230.16 val dtype = Type(dname,typevars);
230.17 val dtype2 = foldr1 mk_ssumT (map prod cons');
230.18 val dnam = Sign.base_name dname;
230.19 val const_rep = (dnam^"_rep" , dtype ->> dtype2, NoSyn);
230.20 val const_abs = (dnam^"_abs" , dtype2 ->> dtype , NoSyn);
230.21 - val const_when = (dnam^"_when",foldr (op ->>) (dtype ->> freetvar "t") (map when_type cons'), NoSyn);
230.22 + val const_when = (dnam^"_when", List.foldr (op ->>) (dtype ->> freetvar "t") (map when_type cons'), NoSyn);
230.23 val const_copy = (dnam^"_copy", dtypeprod ->> dtype ->> dtype , NoSyn);
230.24 end;
230.25
230.26 @@ -41,7 +40,7 @@
230.27 else c::esc cs
230.28 | esc [] = []
230.29 in implode o esc o Symbol.explode end;
230.30 - fun con (name,s,args) = (name,foldr (op ->>) dtype (map third args),s);
230.31 + fun con (name,s,args) = (name, List.foldr (op ->>) dtype (map third args),s);
230.32 fun dis (con ,s,_ ) = (dis_name_ con, dtype->>trT,
230.33 Mixfix(escape ("is_" ^ con), [], Syntax.max_pri));
230.34 (* strictly speaking, these constants have one argument,
230.35 @@ -86,7 +85,7 @@
230.36 val capp = app "Rep_CFun";
230.37 fun con1 n (con,mx,args) = Library.foldl capp (c_ast con mx, argvars n args);
230.38 fun case1 n (con,mx,args) = app "_case1" (con1 n (con,mx,args), expvar n);
230.39 - fun arg1 n (con,_,args) = foldr cabs (expvar n) (argvars n args);
230.40 + fun arg1 n (con,_,args) = List.foldr cabs (expvar n) (argvars n args);
230.41 fun when1 n m = if n = m then arg1 n else K (Constant "UU");
230.42
230.43 fun app_var x = mk_appl (Constant "_variable") [x, Variable "rhs"];
231.1 --- a/src/HOLCF/Tools/fixrec_package.ML Wed Mar 04 10:43:39 2009 +0100
231.2 +++ b/src/HOLCF/Tools/fixrec_package.ML Wed Mar 04 10:45:52 2009 +0100
231.3 @@ -8,17 +8,24 @@
231.4 sig
231.5 val legacy_infer_term: theory -> term -> term
231.6 val legacy_infer_prop: theory -> term -> term
231.7 - val add_fixrec: bool -> (Attrib.binding * string) list list -> theory -> theory
231.8 - val add_fixrec_i: bool -> ((binding * attribute list) * term) list list -> theory -> theory
231.9 +
231.10 + val add_fixrec: bool -> (binding * string option * mixfix) list
231.11 + -> (Attrib.binding * string) list -> local_theory -> local_theory
231.12 +
231.13 + val add_fixrec_i: bool -> (binding * typ option * mixfix) list
231.14 + -> (Attrib.binding * term) list -> local_theory -> local_theory
231.15 +
231.16 val add_fixpat: Attrib.binding * string list -> theory -> theory
231.17 - val add_fixpat_i: (binding * attribute list) * term list -> theory -> theory
231.18 + val add_fixpat_i: Thm.binding * term list -> theory -> theory
231.19 + val add_matchers: (string * string) list -> theory -> theory
231.20 + val setup: theory -> theory
231.21 end;
231.22
231.23 structure FixrecPackage: FIXREC_PACKAGE =
231.24 struct
231.25
231.26 (* legacy type inference *)
231.27 -
231.28 +(* used by the domain package *)
231.29 fun legacy_infer_term thy t =
231.30 singleton (Syntax.check_terms (ProofContext.init thy)) (Sign.intern_term thy t);
231.31
231.32 @@ -33,15 +40,41 @@
231.33 fun fixrec_eq_err thy s eq =
231.34 fixrec_err (s ^ "\nin\n" ^ quote (Syntax.string_of_term_global thy eq));
231.35
231.36 +(*************************************************************************)
231.37 +(***************************** building types ****************************)
231.38 +(*************************************************************************)
231.39 +
231.40 (* ->> is taken from holcf_logic.ML *)
231.41 -(* TODO: fix dependencies so we can import HOLCFLogic here *)
231.42 -infixr 6 ->>;
231.43 -fun S ->> T = Type (@{type_name "->"},[S,T]);
231.44 +fun cfunT (T, U) = Type(@{type_name "->"}, [T, U]);
231.45
231.46 -(* extern_name is taken from domain/library.ML *)
231.47 -fun extern_name con = case Symbol.explode con of
231.48 - ("o"::"p"::" "::rest) => implode rest
231.49 - | _ => con;
231.50 +infixr 6 ->>; val (op ->>) = cfunT;
231.51 +
231.52 +fun dest_cfunT (Type(@{type_name "->"}, [T, U])) = (T, U)
231.53 + | dest_cfunT T = raise TYPE ("dest_cfunT", [T], []);
231.54 +
231.55 +fun binder_cfun (Type(@{type_name "->"},[T, U])) = T :: binder_cfun U
231.56 + | binder_cfun _ = [];
231.57 +
231.58 +fun body_cfun (Type(@{type_name "->"},[T, U])) = body_cfun U
231.59 + | body_cfun T = T;
231.60 +
231.61 +fun strip_cfun T : typ list * typ =
231.62 + (binder_cfun T, body_cfun T);
231.63 +
231.64 +fun maybeT T = Type(@{type_name "maybe"}, [T]);
231.65 +
231.66 +fun dest_maybeT (Type(@{type_name "maybe"}, [T])) = T
231.67 + | dest_maybeT T = raise TYPE ("dest_maybeT", [T], []);
231.68 +
231.69 +fun tupleT [] = @{typ "unit"}
231.70 + | tupleT [T] = T
231.71 + | tupleT (T :: Ts) = HOLogic.mk_prodT (T, tupleT Ts);
231.72 +
231.73 +fun matchT T = body_cfun T ->> maybeT (tupleT (binder_cfun T));
231.74 +
231.75 +(*************************************************************************)
231.76 +(***************************** building terms ****************************)
231.77 +(*************************************************************************)
231.78
231.79 val mk_trp = HOLogic.mk_Trueprop;
231.80
231.81 @@ -52,60 +85,119 @@
231.82 fun chead_of (Const(@{const_name Rep_CFun},_)$f$t) = chead_of f
231.83 | chead_of u = u;
231.84
231.85 -(* these are helpful functions copied from HOLCF/domain/library.ML *)
231.86 -fun %: s = Free(s,dummyT);
231.87 -fun %%: s = Const(s,dummyT);
231.88 -infix 0 ==; fun S == T = %%:"==" $ S $ T;
231.89 -infix 1 ===; fun S === T = %%:"op =" $ S $ T;
231.90 -infix 9 ` ; fun f ` x = %%:@{const_name Rep_CFun} $ f $ x;
231.91 +fun capply_const (S, T) =
231.92 + Const(@{const_name Rep_CFun}, (S ->> T) --> (S --> T));
231.93 +
231.94 +fun cabs_const (S, T) =
231.95 + Const(@{const_name Abs_CFun}, (S --> T) --> (S ->> T));
231.96 +
231.97 +fun mk_capply (t, u) =
231.98 + let val (S, T) =
231.99 + case Term.fastype_of t of
231.100 + Type(@{type_name "->"}, [S, T]) => (S, T)
231.101 + | _ => raise TERM ("mk_capply " ^ ML_Syntax.print_list ML_Syntax.print_term [t, u], [t, u]);
231.102 + in capply_const (S, T) $ t $ u end;
231.103 +
231.104 +infix 0 ==; val (op ==) = Logic.mk_equals;
231.105 +infix 1 ===; val (op ===) = HOLogic.mk_eq;
231.106 +infix 9 ` ; val (op `) = mk_capply;
231.107 +
231.108 +
231.109 +fun mk_cpair (t, u) =
231.110 + let val T = Term.fastype_of t
231.111 + val U = Term.fastype_of u
231.112 + val cpairT = T ->> U ->> HOLogic.mk_prodT (T, U)
231.113 + in Const(@{const_name cpair}, cpairT) ` t ` u end;
231.114 +
231.115 +fun mk_cfst t =
231.116 + let val T = Term.fastype_of t;
231.117 + val (U, _) = HOLogic.dest_prodT T;
231.118 + in Const(@{const_name cfst}, T ->> U) ` t end;
231.119 +
231.120 +fun mk_csnd t =
231.121 + let val T = Term.fastype_of t;
231.122 + val (_, U) = HOLogic.dest_prodT T;
231.123 + in Const(@{const_name csnd}, T ->> U) ` t end;
231.124 +
231.125 +fun mk_csplit t =
231.126 + let val (S, TU) = dest_cfunT (Term.fastype_of t);
231.127 + val (T, U) = dest_cfunT TU;
231.128 + val csplitT = (S ->> T ->> U) ->> HOLogic.mk_prodT (S, T) ->> U;
231.129 + in Const(@{const_name csplit}, csplitT) ` t end;
231.130
231.131 (* builds the expression (LAM v. rhs) *)
231.132 -fun big_lambda v rhs = %%:@{const_name Abs_CFun}$(Term.lambda v rhs);
231.133 +fun big_lambda v rhs =
231.134 + cabs_const (Term.fastype_of v, Term.fastype_of rhs) $ Term.lambda v rhs;
231.135
231.136 (* builds the expression (LAM v1 v2 .. vn. rhs) *)
231.137 fun big_lambdas [] rhs = rhs
231.138 | big_lambdas (v::vs) rhs = big_lambda v (big_lambdas vs rhs);
231.139
231.140 (* builds the expression (LAM <v1,v2,..,vn>. rhs) *)
231.141 -fun lambda_ctuple [] rhs = big_lambda (%:"unit") rhs
231.142 +fun lambda_ctuple [] rhs = big_lambda (Free("unit", HOLogic.unitT)) rhs
231.143 | lambda_ctuple (v::[]) rhs = big_lambda v rhs
231.144 | lambda_ctuple (v::vs) rhs =
231.145 - %%:@{const_name csplit}`(big_lambda v (lambda_ctuple vs rhs));
231.146 + mk_csplit (big_lambda v (lambda_ctuple vs rhs));
231.147
231.148 (* builds the expression <v1,v2,..,vn> *)
231.149 -fun mk_ctuple [] = %%:"UU"
231.150 +fun mk_ctuple [] = @{term "UU::unit"}
231.151 | mk_ctuple (t::[]) = t
231.152 -| mk_ctuple (t::ts) = %%:@{const_name cpair}`t`(mk_ctuple ts);
231.153 +| mk_ctuple (t::ts) = mk_cpair (t, mk_ctuple ts);
231.154 +
231.155 +fun mk_return t =
231.156 + let val T = Term.fastype_of t
231.157 + in Const(@{const_name Fixrec.return}, T ->> maybeT T) ` t end;
231.158 +
231.159 +fun mk_bind (t, u) =
231.160 + let val (T, mU) = dest_cfunT (Term.fastype_of u);
231.161 + val bindT = maybeT T ->> (T ->> mU) ->> mU;
231.162 + in Const(@{const_name Fixrec.bind}, bindT) ` t ` u end;
231.163 +
231.164 +fun mk_mplus (t, u) =
231.165 + let val mT = Term.fastype_of t
231.166 + in Const(@{const_name Fixrec.mplus}, mT ->> mT ->> mT) ` t ` u end;
231.167 +
231.168 +fun mk_run t =
231.169 + let val mT = Term.fastype_of t
231.170 + val T = dest_maybeT mT
231.171 + in Const(@{const_name Fixrec.run}, mT ->> T) ` t end;
231.172 +
231.173 +fun mk_fix t =
231.174 + let val (T, _) = dest_cfunT (Term.fastype_of t)
231.175 + in Const(@{const_name fix}, (T ->> T) ->> T) ` t end;
231.176
231.177 (*************************************************************************)
231.178 (************* fixed-point definitions and unfolding theorems ************)
231.179 (*************************************************************************)
231.180
231.181 -fun add_fixdefs eqs thy =
231.182 +fun add_fixdefs
231.183 + (fixes : ((binding * typ) * mixfix) list)
231.184 + (spec : (Attrib.binding * term) list)
231.185 + (lthy : local_theory) =
231.186 let
231.187 - val (lhss,rhss) = ListPair.unzip (map dest_eqs eqs);
231.188 - val fixpoint = %%:@{const_name fix}`lambda_ctuple lhss (mk_ctuple rhss);
231.189 + val names = map (Binding.name_of o fst o fst) fixes;
231.190 + val all_names = space_implode "_" names;
231.191 + val (lhss,rhss) = ListPair.unzip (map (dest_eqs o snd) spec);
231.192 + val fixpoint = mk_fix (lambda_ctuple lhss (mk_ctuple rhss));
231.193
231.194 - fun one_def (l as Const(n,T)) r =
231.195 - let val b = Sign.base_name n in (b, (b^"_def", l == r)) end
231.196 + fun one_def (l as Free(n,_)) r =
231.197 + let val b = Sign.base_name n
231.198 + in ((Binding.name (b^"_def"), []), r) end
231.199 | one_def _ _ = fixrec_err "fixdefs: lhs not of correct form";
231.200 fun defs [] _ = []
231.201 | defs (l::[]) r = [one_def l r]
231.202 - | defs (l::ls) r = one_def l (%%:@{const_name cfst}`r) :: defs ls (%%:@{const_name csnd}`r);
231.203 - val (names, pre_fixdefs) = ListPair.unzip (defs lhss fixpoint);
231.204 -
231.205 - val fixdefs = map (apsnd (legacy_infer_prop thy)) pre_fixdefs;
231.206 - val (fixdef_thms, thy') =
231.207 - PureThy.add_defs false (map (Thm.no_attributes o apfst Binding.name) fixdefs) thy;
231.208 - val ctuple_fixdef_thm = foldr1 (fn (x,y) => @{thm cpair_equalI} OF [x,y]) fixdef_thms;
231.209 -
231.210 - val ctuple_unfold = legacy_infer_term thy' (mk_trp (mk_ctuple lhss === mk_ctuple rhss));
231.211 - val ctuple_unfold_thm = Goal.prove_global thy' [] [] ctuple_unfold
231.212 - (fn _ => EVERY [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
231.213 - simp_tac (simpset_of thy') 1]);
231.214 - val ctuple_induct_thm =
231.215 - (space_implode "_" names ^ "_induct", ctuple_fixdef_thm RS def_fix_ind);
231.216 -
231.217 + | defs (l::ls) r = one_def l (mk_cfst r) :: defs ls (mk_csnd r);
231.218 + val fixdefs = defs lhss fixpoint;
231.219 + val define_all = fold_map (LocalTheory.define Thm.definitionK);
231.220 + val (fixdef_thms : (term * (string * thm)) list, lthy') = lthy
231.221 + |> define_all (map (apfst fst) fixes ~~ fixdefs);
231.222 + fun cpair_equalI (thm1, thm2) = @{thm cpair_equalI} OF [thm1, thm2];
231.223 + val ctuple_fixdef_thm = foldr1 cpair_equalI (map (snd o snd) fixdef_thms);
231.224 + val ctuple_induct_thm = ctuple_fixdef_thm RS def_fix_ind;
231.225 + val ctuple_unfold_thm =
231.226 + Goal.prove lthy' [] [] (mk_trp (mk_ctuple lhss === mk_ctuple rhss))
231.227 + (fn _ => EVERY [rtac (ctuple_fixdef_thm RS fix_eq2 RS trans) 1,
231.228 + simp_tac (local_simpset_of lthy') 1]);
231.229 fun unfolds [] thm = []
231.230 | unfolds (n::[]) thm = [(n^"_unfold", thm)]
231.231 | unfolds (n::ns) thm = let
231.232 @@ -113,93 +205,117 @@
231.233 val thmR = thm RS @{thm cpair_eqD2};
231.234 in (n^"_unfold", thmL) :: unfolds ns thmR end;
231.235 val unfold_thms = unfolds names ctuple_unfold_thm;
231.236 - val thms = ctuple_induct_thm :: unfold_thms;
231.237 - val (_, thy'') = PureThy.add_thms (map (Thm.no_attributes o apfst Binding.name) thms) thy';
231.238 + fun mk_note (n, thm) = ((Binding.name n, []), [thm]);
231.239 + val (thmss, lthy'') = lthy'
231.240 + |> fold_map (LocalTheory.note Thm.theoremK o mk_note)
231.241 + ((all_names ^ "_induct", ctuple_induct_thm) :: unfold_thms);
231.242 in
231.243 - (thy'', names, fixdef_thms, map snd unfold_thms)
231.244 + (lthy'', names, fixdef_thms, map snd unfold_thms)
231.245 end;
231.246
231.247 (*************************************************************************)
231.248 (*********** monadic notation and pattern matching compilation ***********)
231.249 (*************************************************************************)
231.250
231.251 -fun add_names (Const(a,_), bs) = insert (op =) (Sign.base_name a) bs
231.252 - | add_names (Free(a,_) , bs) = insert (op =) a bs
231.253 - | add_names (f $ u , bs) = add_names (f, add_names(u, bs))
231.254 - | add_names (Abs(a,_,t), bs) = add_names (t, insert (op =) a bs)
231.255 - | add_names (_ , bs) = bs;
231.256 +structure FixrecMatchData = TheoryDataFun (
231.257 + type T = string Symtab.table;
231.258 + val empty = Symtab.empty;
231.259 + val copy = I;
231.260 + val extend = I;
231.261 + fun merge _ tabs : T = Symtab.merge (K true) tabs;
231.262 +);
231.263
231.264 -fun add_terms ts xs = foldr add_names xs ts;
231.265 +(* associate match functions with pattern constants *)
231.266 +fun add_matchers ms = FixrecMatchData.map (fold Symtab.update ms);
231.267 +
231.268 +fun taken_names (t : term) : bstring list =
231.269 + let
231.270 + fun taken (Const(a,_), bs) = insert (op =) (Sign.base_name a) bs
231.271 + | taken (Free(a,_) , bs) = insert (op =) a bs
231.272 + | taken (f $ u , bs) = taken (f, taken (u, bs))
231.273 + | taken (Abs(a,_,t), bs) = taken (t, insert (op =) a bs)
231.274 + | taken (_ , bs) = bs;
231.275 + in
231.276 + taken (t, [])
231.277 + end;
231.278
231.279 (* builds a monadic term for matching a constructor pattern *)
231.280 -fun pre_build pat rhs vs taken =
231.281 +fun pre_build match_name pat rhs vs taken =
231.282 case pat of
231.283 Const(@{const_name Rep_CFun},_)$f$(v as Free(n,T)) =>
231.284 - pre_build f rhs (v::vs) taken
231.285 + pre_build match_name f rhs (v::vs) taken
231.286 | Const(@{const_name Rep_CFun},_)$f$x =>
231.287 - let val (rhs', v, taken') = pre_build x rhs [] taken;
231.288 - in pre_build f rhs' (v::vs) taken' end
231.289 + let val (rhs', v, taken') = pre_build match_name x rhs [] taken;
231.290 + in pre_build match_name f rhs' (v::vs) taken' end
231.291 | Const(c,T) =>
231.292 let
231.293 val n = Name.variant taken "v";
231.294 fun result_type (Type(@{type_name "->"},[_,T])) (x::xs) = result_type T xs
231.295 | result_type T _ = T;
231.296 val v = Free(n, result_type T vs);
231.297 - val m = "match_"^(extern_name(Sign.base_name c));
231.298 + val m = Const(match_name c, matchT T);
231.299 val k = lambda_ctuple vs rhs;
231.300 in
231.301 - (%%:@{const_name Fixrec.bind}`(%%:m`v)`k, v, n::taken)
231.302 + (mk_bind (m`v, k), v, n::taken)
231.303 end
231.304 | Free(n,_) => fixrec_err ("expected constructor, found free variable " ^ quote n)
231.305 | _ => fixrec_err "pre_build: invalid pattern";
231.306
231.307 (* builds a monadic term for matching a function definition pattern *)
231.308 (* returns (name, arity, matcher) *)
231.309 -fun building pat rhs vs taken =
231.310 +fun building match_name pat rhs vs taken =
231.311 case pat of
231.312 Const(@{const_name Rep_CFun}, _)$f$(v as Free(n,T)) =>
231.313 - building f rhs (v::vs) taken
231.314 + building match_name f rhs (v::vs) taken
231.315 | Const(@{const_name Rep_CFun}, _)$f$x =>
231.316 - let val (rhs', v, taken') = pre_build x rhs [] taken;
231.317 - in building f rhs' (v::vs) taken' end
231.318 - | Const(name,_) => (name, length vs, big_lambdas vs rhs)
231.319 - | _ => fixrec_err "function is not declared as constant in theory";
231.320 + let val (rhs', v, taken') = pre_build match_name x rhs [] taken;
231.321 + in building match_name f rhs' (v::vs) taken' end
231.322 + | Free(_,_) => ((pat, length vs), big_lambdas vs rhs)
231.323 + | Const(_,_) => ((pat, length vs), big_lambdas vs rhs)
231.324 + | _ => fixrec_err ("function is not declared as constant in theory: "
231.325 + ^ ML_Syntax.print_term pat);
231.326
231.327 -fun match_eq eq =
231.328 - let val (lhs,rhs) = dest_eqs eq;
231.329 - in building lhs (%%:@{const_name Fixrec.return}`rhs) [] (add_terms [eq] []) end;
231.330 +fun strip_alls t =
231.331 + if Logic.is_all t then strip_alls (snd (Logic.dest_all t)) else t;
231.332 +
231.333 +fun match_eq match_name eq =
231.334 + let
231.335 + val (lhs,rhs) = dest_eqs (Logic.strip_imp_concl (strip_alls eq));
231.336 + in
231.337 + building match_name lhs (mk_return rhs) [] (taken_names eq)
231.338 + end;
231.339
231.340 (* returns the sum (using +++) of the terms in ms *)
231.341 (* also applies "run" to the result! *)
231.342 fun fatbar arity ms =
231.343 let
231.344 + fun LAM_Ts 0 t = ([], Term.fastype_of t)
231.345 + | LAM_Ts n (_ $ Abs(_,T,t)) =
231.346 + let val (Ts, U) = LAM_Ts (n-1) t in (T::Ts, U) end
231.347 + | LAM_Ts _ _ = fixrec_err "fatbar: internal error, not enough LAMs";
231.348 fun unLAM 0 t = t
231.349 | unLAM n (_$Abs(_,_,t)) = unLAM (n-1) t
231.350 | unLAM _ _ = fixrec_err "fatbar: internal error, not enough LAMs";
231.351 - fun reLAM 0 t = t
231.352 - | reLAM n t = reLAM (n-1) (%%:@{const_name Abs_CFun} $ Abs("",dummyT,t));
231.353 - fun mplus (x,y) = %%:@{const_name Fixrec.mplus}`x`y;
231.354 - val msum = foldr1 mplus (map (unLAM arity) ms);
231.355 + fun reLAM ([], U) t = t
231.356 + | reLAM (T::Ts, U) t = reLAM (Ts, T ->> U) (cabs_const(T,U)$Abs("",T,t));
231.357 + val msum = foldr1 mk_mplus (map (unLAM arity) ms);
231.358 + val (Ts, U) = LAM_Ts arity (hd ms)
231.359 in
231.360 - reLAM arity (%%:@{const_name Fixrec.run}`msum)
231.361 + reLAM (rev Ts, dest_maybeT U) (mk_run msum)
231.362 end;
231.363
231.364 -fun unzip3 [] = ([],[],[])
231.365 - | unzip3 ((x,y,z)::ts) =
231.366 - let val (xs,ys,zs) = unzip3 ts
231.367 - in (x::xs, y::ys, z::zs) end;
231.368 -
231.369 (* this is the pattern-matching compiler function *)
231.370 -fun compile_pats eqs =
231.371 +fun compile_pats match_name eqs =
231.372 let
231.373 - val ((n::names),(a::arities),mats) = unzip3 (map match_eq eqs);
231.374 + val (((n::names),(a::arities)),mats) =
231.375 + apfst ListPair.unzip (ListPair.unzip (map (match_eq match_name) eqs));
231.376 val cname = if forall (fn x => n=x) names then n
231.377 else fixrec_err "all equations in block must define the same function";
231.378 val arity = if forall (fn x => a=x) arities then a
231.379 else fixrec_err "all equations in block must have the same arity";
231.380 val rhs = fatbar arity mats;
231.381 in
231.382 - mk_trp (%%:cname === rhs)
231.383 + mk_trp (cname === rhs)
231.384 end;
231.385
231.386 (*************************************************************************)
231.387 @@ -207,11 +323,13 @@
231.388 (*************************************************************************)
231.389
231.390 (* proves a block of pattern matching equations as theorems, using unfold *)
231.391 -fun make_simps thy (unfold_thm, eqns) =
231.392 +fun make_simps lthy (unfold_thm, eqns : (Attrib.binding * term) list) =
231.393 let
231.394 - val tacs = [rtac (unfold_thm RS @{thm ssubst_lhs}) 1, asm_simp_tac (simpset_of thy) 1];
231.395 - fun prove_term t = Goal.prove_global thy [] [] t (K (EVERY tacs));
231.396 - fun prove_eqn ((name, eqn_t), atts) = ((name, prove_term eqn_t), atts);
231.397 + val tacs =
231.398 + [rtac (unfold_thm RS @{thm ssubst_lhs}) 1,
231.399 + asm_simp_tac (local_simpset_of lthy) 1];
231.400 + fun prove_term t = Goal.prove lthy [] [] t (K (EVERY tacs));
231.401 + fun prove_eqn (bind, eqn_t) = (bind, prove_term eqn_t);
231.402 in
231.403 map prove_eqn eqns
231.404 end;
231.405 @@ -220,42 +338,77 @@
231.406 (************************* Main fixrec function **************************)
231.407 (*************************************************************************)
231.408
231.409 -fun gen_add_fixrec prep_prop prep_attrib strict blocks thy =
231.410 +local
231.411 +(* code adapted from HOL/Tools/primrec_package.ML *)
231.412 +
231.413 +fun prepare_spec prep_spec ctxt raw_fixes raw_spec =
231.414 let
231.415 - val eqns = List.concat blocks;
231.416 - val lengths = map length blocks;
231.417 -
231.418 - val ((bindings, srcss), strings) = apfst split_list (split_list eqns);
231.419 - val names = map Binding.base_name bindings;
231.420 - val atts = map (map (prep_attrib thy)) srcss;
231.421 - val eqn_ts = map (prep_prop thy) strings;
231.422 - val rec_ts = map (fn eq => chead_of (fst (dest_eqs (Logic.strip_imp_concl eq)))
231.423 - handle TERM _ => fixrec_eq_err thy "not a proper equation" eq) eqn_ts;
231.424 - val (_, eqn_ts') = OldPrimrecPackage.unify_consts thy rec_ts eqn_ts;
231.425 -
231.426 - fun unconcat [] _ = []
231.427 - | unconcat (n::ns) xs = List.take (xs,n) :: unconcat ns (List.drop (xs,n));
231.428 - val pattern_blocks = unconcat lengths (map Logic.strip_imp_concl eqn_ts');
231.429 - val compiled_ts = map (legacy_infer_term thy o compile_pats) pattern_blocks;
231.430 - val (thy', cnames, fixdef_thms, unfold_thms) = add_fixdefs compiled_ts thy;
231.431 + val ((fixes, spec), _) = prep_spec
231.432 + raw_fixes (map (single o apsnd single) raw_spec) ctxt
231.433 + in (fixes, map (apsnd the_single) spec) end;
231.434 +
231.435 +fun gen_fixrec
231.436 + (set_group : bool)
231.437 + (prep_spec : (binding * 'a option * mixfix) list ->
231.438 + (Attrib.binding * 'b list) list list ->
231.439 + Proof.context ->
231.440 + (((binding * typ) * mixfix) list * (Attrib.binding * term list) list)
231.441 + * Proof.context
231.442 + )
231.443 + (strict : bool)
231.444 + raw_fixes
231.445 + raw_spec
231.446 + (lthy : local_theory) =
231.447 + let
231.448 + val (fixes : ((binding * typ) * mixfix) list,
231.449 + spec : (Attrib.binding * term) list) =
231.450 + prepare_spec prep_spec lthy raw_fixes raw_spec;
231.451 + val chead_of_spec =
231.452 + chead_of o fst o dest_eqs o Logic.strip_imp_concl o strip_alls o snd;
231.453 + fun name_of (Free (n, _)) = n
231.454 + | name_of t = fixrec_err ("unknown term");
231.455 + val all_names = map (name_of o chead_of_spec) spec;
231.456 + val names = distinct (op =) all_names;
231.457 + fun block_of_name n =
231.458 + map_filter
231.459 + (fn (m,eq) => if m = n then SOME eq else NONE)
231.460 + (all_names ~~ spec);
231.461 + val blocks = map block_of_name names;
231.462 +
231.463 + val matcher_tab = FixrecMatchData.get (ProofContext.theory_of lthy);
231.464 + fun match_name c =
231.465 + case Symtab.lookup matcher_tab c of SOME m => m
231.466 + | NONE => fixrec_err ("unknown pattern constructor: " ^ c);
231.467 +
231.468 + val matches = map (compile_pats match_name) (map (map snd) blocks);
231.469 + val spec' = map (pair Attrib.empty_binding) matches;
231.470 + val (lthy', cnames, fixdef_thms, unfold_thms) =
231.471 + add_fixdefs fixes spec' lthy;
231.472 in
231.473 if strict then let (* only prove simp rules if strict = true *)
231.474 - val eqn_blocks = unconcat lengths ((names ~~ eqn_ts') ~~ atts);
231.475 - val simps = maps (make_simps thy') (unfold_thms ~~ eqn_blocks);
231.476 - val (simp_thms, thy'') = PureThy.add_thms ((map o apfst o apfst) Binding.name simps) thy';
231.477 -
231.478 - val simp_names = map (fn name => name^"_simps") cnames;
231.479 - val simp_attribute = rpair [Simplifier.simp_add];
231.480 - val simps' = map simp_attribute (simp_names ~~ unconcat lengths simp_thms);
231.481 + val simps : (Attrib.binding * thm) list list =
231.482 + map (make_simps lthy') (unfold_thms ~~ blocks);
231.483 + fun mk_bind n : Attrib.binding =
231.484 + (Binding.name (n ^ "_simps"),
231.485 + [Attrib.internal (K Simplifier.simp_add)]);
231.486 + val simps1 : (Attrib.binding * thm list) list =
231.487 + map (fn (n,xs) => (mk_bind n, map snd xs)) (names ~~ simps);
231.488 + val simps2 : (Attrib.binding * thm list) list =
231.489 + map (apsnd (fn thm => [thm])) (List.concat simps);
231.490 + val (_, lthy'') = lthy'
231.491 + |> fold_map (LocalTheory.note Thm.theoremK) (simps1 @ simps2);
231.492 in
231.493 - (snd o PureThy.add_thmss ((map o apfst o apfst) Binding.name simps')) thy''
231.494 + lthy''
231.495 end
231.496 - else thy'
231.497 + else lthy'
231.498 end;
231.499
231.500 -val add_fixrec = gen_add_fixrec Syntax.read_prop_global Attrib.attribute;
231.501 -val add_fixrec_i = gen_add_fixrec Sign.cert_prop (K I);
231.502 +in
231.503
231.504 +val add_fixrec_i = gen_fixrec false Specification.check_specification;
231.505 +val add_fixrec = gen_fixrec true Specification.read_specification;
231.506 +
231.507 +end; (* local *)
231.508
231.509 (*************************************************************************)
231.510 (******************************** Fixpat *********************************)
231.511 @@ -291,17 +444,34 @@
231.512
231.513 local structure P = OuterParse and K = OuterKeyword in
231.514
231.515 -val fixrec_eqn = SpecParse.opt_thm_name ":" -- P.prop;
231.516 -
231.517 +(* bool parser *)
231.518 val fixrec_strict = P.opt_keyword "permissive" >> not;
231.519
231.520 -val fixrec_decl = fixrec_strict -- P.and_list1 (Scan.repeat1 fixrec_eqn);
231.521 +fun pipe_error t = P.!!! (Scan.fail_with (K
231.522 + (cat_lines ["Equations must be separated by " ^ quote "|", quote t])));
231.523 +
231.524 +(* (Attrib.binding * string) parser *)
231.525 +val statement = SpecParse.opt_thm_name ":" -- P.prop --| Scan.ahead
231.526 + ((P.term :-- pipe_error) || Scan.succeed ("",""));
231.527 +
231.528 +(* ((Attrib.binding * string) list) parser *)
231.529 +val statements = P.enum1 "|" statement;
231.530 +
231.531 +(* (((xstring option * bool) * (Binding.binding * string option * Mixfix.mixfix) list)
231.532 + * (Attrib.binding * string) list) parser *)
231.533 +val fixrec_decl =
231.534 + P.opt_target -- fixrec_strict -- P.fixes --| P.$$$ "where" -- statements;
231.535
231.536 (* this builds a parser for a new keyword, fixrec, whose functionality
231.537 is defined by add_fixrec *)
231.538 val _ =
231.539 - OuterSyntax.command "fixrec" "define recursive functions (HOLCF)" K.thy_decl
231.540 - (fixrec_decl >> (Toplevel.theory o uncurry add_fixrec));
231.541 + let
231.542 + val desc = "define recursive functions (HOLCF)";
231.543 + fun fixrec (((opt_target, strict), raw_fixes), raw_spec) =
231.544 + Toplevel.local_theory opt_target (add_fixrec strict raw_fixes raw_spec);
231.545 + in
231.546 + OuterSyntax.command "fixrec" desc K.thy_decl (fixrec_decl >> fixrec)
231.547 + end;
231.548
231.549 (* fixpat parser *)
231.550 val fixpat_decl = SpecParse.opt_thm_name ":" -- Scan.repeat1 P.prop;
231.551 @@ -309,7 +479,9 @@
231.552 val _ =
231.553 OuterSyntax.command "fixpat" "define rewrites for fixrec functions" K.thy_decl
231.554 (fixpat_decl >> (Toplevel.theory o add_fixpat));
231.555 -
231.556 +
231.557 end; (* local structure *)
231.558
231.559 +val setup = FixrecMatchData.init;
231.560 +
231.561 end;
232.1 --- a/src/HOLCF/UpperPD.thy Wed Mar 04 10:43:39 2009 +0100
232.2 +++ b/src/HOLCF/UpperPD.thy Wed Mar 04 10:45:52 2009 +0100
232.3 @@ -243,22 +243,25 @@
232.4 apply (simp add: PDPlus_commute)
232.5 done
232.6
232.7 -lemma upper_plus_absorb: "xs +\<sharp> xs = xs"
232.8 +lemma upper_plus_absorb [simp]: "xs +\<sharp> xs = xs"
232.9 apply (induct xs rule: upper_pd.principal_induct, simp)
232.10 apply (simp add: PDPlus_absorb)
232.11 done
232.12
232.13 -interpretation aci_upper_plus!: ab_semigroup_idem_mult "op +\<sharp>"
232.14 - proof qed (rule upper_plus_assoc upper_plus_commute upper_plus_absorb)+
232.15 +lemma upper_plus_left_commute: "xs +\<sharp> (ys +\<sharp> zs) = ys +\<sharp> (xs +\<sharp> zs)"
232.16 +by (rule mk_left_commute [of "op +\<sharp>", OF upper_plus_assoc upper_plus_commute])
232.17
232.18 -lemma upper_plus_left_commute: "xs +\<sharp> (ys +\<sharp> zs) = ys +\<sharp> (xs +\<sharp> zs)"
232.19 -by (rule aci_upper_plus.mult_left_commute)
232.20 +lemma upper_plus_left_absorb [simp]: "xs +\<sharp> (xs +\<sharp> ys) = xs +\<sharp> ys"
232.21 +by (simp only: upper_plus_assoc [symmetric] upper_plus_absorb)
232.22
232.23 -lemma upper_plus_left_absorb: "xs +\<sharp> (xs +\<sharp> ys) = xs +\<sharp> ys"
232.24 -by (rule aci_upper_plus.mult_left_idem)
232.25 -(*
232.26 -lemmas upper_plus_aci = aci_upper_plus.mult_ac_idem
232.27 -*)
232.28 +text {* Useful for @{text "simp add: upper_plus_ac"} *}
232.29 +lemmas upper_plus_ac =
232.30 + upper_plus_assoc upper_plus_commute upper_plus_left_commute
232.31 +
232.32 +text {* Useful for @{text "simp only: upper_plus_aci"} *}
232.33 +lemmas upper_plus_aci =
232.34 + upper_plus_ac upper_plus_absorb upper_plus_left_absorb
232.35 +
232.36 lemma upper_plus_less1: "xs +\<sharp> ys \<sqsubseteq> xs"
232.37 apply (induct xs ys rule: upper_pd.principal_induct2, simp, simp)
232.38 apply (simp add: PDPlus_upper_less)
232.39 @@ -388,7 +391,7 @@
232.40 apply unfold_locales
232.41 apply (simp add: upper_plus_assoc)
232.42 apply (simp add: upper_plus_commute)
232.43 -apply (simp add: upper_plus_absorb eta_cfun)
232.44 +apply (simp add: eta_cfun)
232.45 done
232.46
232.47 lemma upper_bind_basis_simps [simp]:
233.1 --- a/src/HOLCF/ex/Fixrec_ex.thy Wed Mar 04 10:43:39 2009 +0100
233.2 +++ b/src/HOLCF/ex/Fixrec_ex.thy Wed Mar 04 10:45:52 2009 +0100
233.3 @@ -1,5 +1,4 @@
233.4 (* Title: HOLCF/ex/Fixrec_ex.thy
233.5 - ID: $Id$
233.6 Author: Brian Huffman
233.7 *)
233.8
233.9 @@ -19,18 +18,18 @@
233.10
233.11 text {* typical usage is with lazy constructors *}
233.12
233.13 -consts down :: "'a u \<rightarrow> 'a"
233.14 -fixrec "down\<cdot>(up\<cdot>x) = x"
233.15 +fixrec down :: "'a u \<rightarrow> 'a"
233.16 +where "down\<cdot>(up\<cdot>x) = x"
233.17
233.18 text {* with strict constructors, rewrite rules may require side conditions *}
233.19
233.20 -consts from_sinl :: "'a \<oplus> 'b \<rightarrow> 'a"
233.21 -fixrec "x \<noteq> \<bottom> \<Longrightarrow> from_sinl\<cdot>(sinl\<cdot>x) = x"
233.22 +fixrec from_sinl :: "'a \<oplus> 'b \<rightarrow> 'a"
233.23 +where "x \<noteq> \<bottom> \<Longrightarrow> from_sinl\<cdot>(sinl\<cdot>x) = x"
233.24
233.25 text {* lifting can turn a strict constructor into a lazy one *}
233.26
233.27 -consts from_sinl_up :: "'a u \<oplus> 'b \<rightarrow> 'a"
233.28 -fixrec "from_sinl_up\<cdot>(sinl\<cdot>(up\<cdot>x)) = x"
233.29 +fixrec from_sinl_up :: "'a u \<oplus> 'b \<rightarrow> 'a"
233.30 +where "from_sinl_up\<cdot>(sinl\<cdot>(up\<cdot>x)) = x"
233.31
233.32
233.33 subsection {* fixpat examples *}
233.34 @@ -41,13 +40,13 @@
233.35
233.36 text {* zip function for lazy lists *}
233.37
233.38 -consts lzip :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
233.39 -
233.40 text {* notice that the patterns are not exhaustive *}
233.41
233.42 fixrec
233.43 + lzip :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
233.44 +where
233.45 "lzip\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)"
233.46 - "lzip\<cdot>lNil\<cdot>lNil = lNil"
233.47 +| "lzip\<cdot>lNil\<cdot>lNil = lNil"
233.48
233.49 text {* fixpat is useful for producing strictness theorems *}
233.50 text {* note that pattern matching is done in left-to-right order *}
233.51 @@ -68,8 +67,6 @@
233.52
233.53 text {* another zip function for lazy lists *}
233.54
233.55 -consts lzip2 :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
233.56 -
233.57 text {*
233.58 Notice that this version has overlapping patterns.
233.59 The second equation cannot be proved as a theorem
233.60 @@ -77,8 +74,10 @@
233.61 *}
233.62
233.63 fixrec (permissive)
233.64 + lzip2 :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist"
233.65 +where
233.66 "lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)"
233.67 - "lzip2\<cdot>xs\<cdot>ys = lNil"
233.68 +| "lzip2\<cdot>xs\<cdot>ys = lNil"
233.69
233.70 text {*
233.71 Usually fixrec tries to prove all equations as theorems.
233.72 @@ -105,21 +104,20 @@
233.73 domain 'a tree = Leaf (lazy 'a) | Branch (lazy "'a forest")
233.74 and 'a forest = Empty | Trees (lazy "'a tree") "'a forest"
233.75
233.76 -consts
233.77 - map_tree :: "('a \<rightarrow> 'b) \<rightarrow> ('a tree \<rightarrow> 'b tree)"
233.78 - map_forest :: "('a \<rightarrow> 'b) \<rightarrow> ('a forest \<rightarrow> 'b forest)"
233.79 -
233.80 text {*
233.81 To define mutually recursive functions, separate the equations
233.82 for each function using the keyword "and".
233.83 *}
233.84
233.85 fixrec
233.86 + map_tree :: "('a \<rightarrow> 'b) \<rightarrow> ('a tree \<rightarrow> 'b tree)"
233.87 +and
233.88 + map_forest :: "('a \<rightarrow> 'b) \<rightarrow> ('a forest \<rightarrow> 'b forest)"
233.89 +where
233.90 "map_tree\<cdot>f\<cdot>(Leaf\<cdot>x) = Leaf\<cdot>(f\<cdot>x)"
233.91 - "map_tree\<cdot>f\<cdot>(Branch\<cdot>ts) = Branch\<cdot>(map_forest\<cdot>f\<cdot>ts)"
233.92 -and
233.93 - "map_forest\<cdot>f\<cdot>Empty = Empty"
233.94 - "ts \<noteq> \<bottom> \<Longrightarrow>
233.95 +| "map_tree\<cdot>f\<cdot>(Branch\<cdot>ts) = Branch\<cdot>(map_forest\<cdot>f\<cdot>ts)"
233.96 +| "map_forest\<cdot>f\<cdot>Empty = Empty"
233.97 +| "ts \<noteq> \<bottom> \<Longrightarrow>
233.98 map_forest\<cdot>f\<cdot>(Trees\<cdot>t\<cdot>ts) = Trees\<cdot>(map_tree\<cdot>f\<cdot>t)\<cdot>(map_forest\<cdot>f\<cdot>ts)"
233.99
233.100 fixpat map_tree_strict [simp]: "map_tree\<cdot>f\<cdot>\<bottom>"
234.1 --- a/src/HOLCF/ex/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
234.2 +++ b/src/HOLCF/ex/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
234.3 @@ -1,8 +1,7 @@
234.4 (* Title: HOLCF/ex/ROOT.ML
234.5 - ID: $Id$
234.6
234.7 Misc HOLCF examples.
234.8 *)
234.9
234.10 use_thys ["Dnat", "Stream", "Dagstuhl", "Focus_ex", "Fix2", "Hoare",
234.11 - "Loop", "Fixrec_ex"];
234.12 + "Loop", "Fixrec_ex", "Powerdomain_ex"];
235.1 --- a/src/Provers/README Wed Mar 04 10:43:39 2009 +0100
235.2 +++ b/src/Provers/README Wed Mar 04 10:45:52 2009 +0100
235.3 @@ -2,19 +2,13 @@
235.4
235.5 This directory contains ML sources of generic theorem proving tools.
235.6 Typically, they can be applied to various logics, provided rules of a
235.7 -certain form are derivable. Some of these are documented in the
235.8 -Reference Manual.
235.9 +certain form are derivable.
235.10
235.11 blast.ML generic tableau prover with proof reconstruction
235.12 clasimp.ML combination of classical reasoner and simplifier
235.13 classical.ML theorem prover for classical logics
235.14 hypsubst.ML tactic to substitute in the hypotheses
235.15 - ind.ML a simple induction package
235.16 - induct_method.ML proof by cases and induction on sets and types (Isar)
235.17 - linorder.ML transitivity reasoner for linear (total) orders
235.18 quantifier1.ML simplification procedures for "1 point rules"
235.19 - simp.ML powerful but slow simplifier
235.20 - split_paired_all.ML turn surjective pairing into split rule
235.21 splitter.ML performs case splits for simplifier
235.22 typedsimp.ML basic simplifier for explicitly typed logics
235.23
236.1 --- a/src/Provers/blast.ML Wed Mar 04 10:43:39 2009 +0100
236.2 +++ b/src/Provers/blast.ML Wed Mar 04 10:45:52 2009 +0100
236.3 @@ -1,5 +1,4 @@
236.4 (* Title: Provers/blast.ML
236.5 - ID: $Id$
236.6 Author: Lawrence C Paulson, Cambridge University Computer Laboratory
236.7 Copyright 1997 University of Cambridge
236.8
236.9 @@ -764,8 +763,8 @@
236.10 end
236.11 (*substitute throughout "stack frame"; extract affected formulae*)
236.12 fun subFrame ((Gs,Hs), (changed, frames)) =
236.13 - let val (changed', Gs') = foldr subForm (changed, []) Gs
236.14 - val (changed'', Hs') = foldr subForm (changed', []) Hs
236.15 + let val (changed', Gs') = List.foldr subForm (changed, []) Gs
236.16 + val (changed'', Hs') = List.foldr subForm (changed', []) Hs
236.17 in (changed'', (Gs',Hs')::frames) end
236.18 (*substitute throughout literals; extract affected ones*)
236.19 fun subLit (lit, (changed, nlits)) =
236.20 @@ -773,8 +772,8 @@
236.21 in if nlit aconv lit then (changed, nlit::nlits)
236.22 else ((nlit,true)::changed, nlits)
236.23 end
236.24 - val (changed, lits') = foldr subLit ([], []) lits
236.25 - val (changed', pairs') = foldr subFrame (changed, []) pairs
236.26 + val (changed, lits') = List.foldr subLit ([], []) lits
236.27 + val (changed', pairs') = List.foldr subFrame (changed, []) pairs
236.28 in if !trace then writeln ("Substituting " ^ traceTerm thy u ^
236.29 " for " ^ traceTerm thy t ^ " in branch" )
236.30 else ();
236.31 @@ -913,7 +912,7 @@
236.32
236.33 fun printStats (State {ntried, nclosed, ...}) (b, start, tacs) =
236.34 if b then
236.35 - writeln (end_timing start ^ " for search. Closed: "
236.36 + writeln (#message (end_timing start) ^ " for search. Closed: "
236.37 ^ Int.toString (!nclosed) ^
236.38 " tried: " ^ Int.toString (!ntried) ^
236.39 " tactics: " ^ Int.toString (length tacs))
236.40 @@ -971,7 +970,7 @@
236.41 then lim - (1+log(length rules))
236.42 else lim (*discourage branching updates*)
236.43 val vars = vars_in_vars vars
236.44 - val vars' = foldr add_terms_vars vars prems
236.45 + val vars' = List.foldr add_terms_vars vars prems
236.46 val choices' = (ntrl, nbrs, PRV) :: choices
236.47 val tacs' = (tac(updated,false,true))
236.48 :: tacs (*no duplication; rotate*)
236.49 @@ -1098,7 +1097,7 @@
236.50 then
236.51 let val updated = ntrl < !ntrail (*branch updated*)
236.52 val vars = vars_in_vars vars
236.53 - val vars' = foldr add_terms_vars vars prems
236.54 + val vars' = List.foldr add_terms_vars vars prems
236.55 (*duplicate H if md permits*)
236.56 val dup = md (*earlier had "andalso vars' <> vars":
236.57 duplicate only if the subgoal has new vars*)
236.58 @@ -1264,7 +1263,7 @@
236.59 else ();
236.60 backtrack choices)
236.61 | cell => (if (!trace orelse !stats)
236.62 - then writeln (end_timing start ^ " for reconstruction")
236.63 + then writeln (#message (end_timing start) ^ " for reconstruction")
236.64 else ();
236.65 Seq.make(fn()=> cell))
236.66 end
237.1 --- a/src/Provers/clasimp.ML Wed Mar 04 10:43:39 2009 +0100
237.2 +++ b/src/Provers/clasimp.ML Wed Mar 04 10:45:52 2009 +0100
237.3 @@ -1,5 +1,4 @@
237.4 (* Title: Provers/clasimp.ML
237.5 - ID: $Id$
237.6 Author: David von Oheimb, TU Muenchen
237.7
237.8 Combination of classical reasoner and simplifier (depends on
237.9 @@ -153,7 +152,7 @@
237.10 end;
237.11
237.12 fun modifier att (x, ths) =
237.13 - fst (foldl_map (Library.apply [att]) (x, rev ths));
237.14 + fst (Library.foldl_map (Library.apply [att]) (x, rev ths));
237.15
237.16 val addXIs = modifier (ContextRules.intro_query NONE);
237.17 val addXEs = modifier (ContextRules.elim_query NONE);
238.1 --- a/src/Provers/classical.ML Wed Mar 04 10:43:39 2009 +0100
238.2 +++ b/src/Provers/classical.ML Wed Mar 04 10:45:52 2009 +0100
238.3 @@ -223,7 +223,7 @@
238.4 let fun addrl (rl,brls) = (false, rl) :: (true, rl RSN (2, Data.swap)) :: brls
238.5 in assume_tac ORELSE'
238.6 contr_tac ORELSE'
238.7 - biresolve_tac (foldr addrl [] rls)
238.8 + biresolve_tac (List.foldr addrl [] rls)
238.9 end;
238.10
238.11 (*Duplication of hazardous rules, for complete provers*)
239.1 --- a/src/Provers/order.ML Wed Mar 04 10:43:39 2009 +0100
239.2 +++ b/src/Provers/order.ML Wed Mar 04 10:45:52 2009 +0100
239.3 @@ -639,7 +639,7 @@
239.4
239.5 (* Compute, for each adjacency list, the list with reversed edges,
239.6 and concatenate these lists. *)
239.7 - val flipped = foldr (op @) nil (map flip g)
239.8 + val flipped = List.foldr (op @) nil (map flip g)
239.9
239.10 in assemble g flipped end
239.11
239.12 @@ -677,7 +677,7 @@
239.13 let
239.14 val _ = visited := u :: !visited
239.15 val descendents =
239.16 - foldr (fn ((v,l),ds) => if been_visited v then ds
239.17 + List.foldr (fn ((v,l),ds) => if been_visited v then ds
239.18 else v :: dfs_visit g v @ ds)
239.19 nil (adjacent (op aconv) g u)
239.20 in
239.21 @@ -727,7 +727,7 @@
239.22 let
239.23 val _ = visited := u :: !visited
239.24 val descendents =
239.25 - foldr (fn ((v,l),ds) => if been_visited v then ds
239.26 + List.foldr (fn ((v,l),ds) => if been_visited v then ds
239.27 else v :: dfs_visit g v @ ds)
239.28 nil (adjacent (op =) g u)
239.29 in descendents end
240.1 --- a/src/Provers/trancl.ML Wed Mar 04 10:43:39 2009 +0100
240.2 +++ b/src/Provers/trancl.ML Wed Mar 04 10:45:52 2009 +0100
240.3 @@ -1,8 +1,6 @@
240.4 (*
240.5 - Title: Transitivity reasoner for transitive closures of relations
240.6 - Id: $Id$
240.7 - Author: Oliver Kutter
240.8 - Copyright: TU Muenchen
240.9 + Title: Transitivity reasoner for transitive closures of relations
240.10 + Author: Oliver Kutter, TU Muenchen
240.11 *)
240.12
240.13 (*
240.14 @@ -335,7 +333,7 @@
240.15
240.16 (* Compute, for each adjacency list, the list with reversed edges,
240.17 and concatenate these lists. *)
240.18 - val flipped = foldr (op @) nil (map flip g)
240.19 + val flipped = List.foldr (op @) nil (map flip g)
240.20
240.21 in assemble g flipped end
240.22
240.23 @@ -359,7 +357,7 @@
240.24 let
240.25 val _ = visited := u :: !visited
240.26 val descendents =
240.27 - foldr (fn ((v,l),ds) => if been_visited v then ds
240.28 + List.foldr (fn ((v,l),ds) => if been_visited v then ds
240.29 else v :: dfs_visit g v @ ds)
240.30 nil (adjacent eq_comp g u)
240.31 in descendents end
241.1 --- a/src/Provers/typedsimp.ML Wed Mar 04 10:43:39 2009 +0100
241.2 +++ b/src/Provers/typedsimp.ML Wed Mar 04 10:45:52 2009 +0100
241.3 @@ -1,5 +1,4 @@
241.4 (* Title: typedsimp
241.5 - ID: $Id$
241.6 Author: Lawrence C Paulson, Cambridge University Computer Laboratory
241.7 Copyright 1993 University of Cambridge
241.8
241.9 @@ -70,7 +69,7 @@
241.10 handle THM _ => (simp_rls, rl :: other_rls);
241.11
241.12 (*Given the list rls, return the pair (simp_rls, other_rls).*)
241.13 -fun process_rules rls = foldr add_rule ([],[]) rls;
241.14 +fun process_rules rls = List.foldr add_rule ([],[]) rls;
241.15
241.16 (*Given list of rewrite rules, return list of both forms, reject others*)
241.17 fun process_rewrites rls =
242.1 --- a/src/Pure/General/binding.ML Wed Mar 04 10:43:39 2009 +0100
242.2 +++ b/src/Pure/General/binding.ML Wed Mar 04 10:45:52 2009 +0100
242.3 @@ -1,98 +1,104 @@
242.4 (* Title: Pure/General/binding.ML
242.5 Author: Florian Haftmann, TU Muenchen
242.6 + Author: Makarius
242.7
242.8 Structured name bindings.
242.9 *)
242.10
242.11 -signature BASIC_BINDING =
242.12 -sig
242.13 - type binding
242.14 - val long_names: bool ref
242.15 - val short_names: bool ref
242.16 - val unique_names: bool ref
242.17 -end;
242.18 +type bstring = string; (*primitive names to be bound*)
242.19
242.20 signature BINDING =
242.21 sig
242.22 - include BASIC_BINDING
242.23 - val name_pos: string * Position.T -> binding
242.24 - val name: string -> binding
242.25 + type binding
242.26 + val dest: binding -> (string * bool) list * (string * bool) list * bstring
242.27 + val verbose: bool ref
242.28 + val str_of: binding -> string
242.29 + val make: bstring * Position.T -> binding
242.30 + val name: bstring -> binding
242.31 + val pos_of: binding -> Position.T
242.32 + val name_of: binding -> string
242.33 + val map_name: (bstring -> bstring) -> binding -> binding
242.34 val empty: binding
242.35 - val map_base: (string -> string) -> binding -> binding
242.36 - val qualify: string -> binding -> binding
242.37 + val is_empty: binding -> bool
242.38 + val qualify: bool -> string -> binding -> binding
242.39 + val map_prefix: ((string * bool) list -> (string * bool) list) -> binding -> binding
242.40 val add_prefix: bool -> string -> binding -> binding
242.41 - val map_prefix: ((string * bool) list -> binding -> binding) -> binding -> binding
242.42 - val is_empty: binding -> bool
242.43 - val base_name: binding -> string
242.44 - val pos_of: binding -> Position.T
242.45 - val dest: binding -> (string * bool) list * string
242.46 - val separator: string
242.47 - val is_qualified: string -> bool
242.48 - val display: binding -> string
242.49 end;
242.50
242.51 -structure Binding : BINDING =
242.52 +structure Binding: BINDING =
242.53 struct
242.54
242.55 -(** global flags **)
242.56 +(** representation **)
242.57
242.58 -val long_names = ref false;
242.59 -val short_names = ref false;
242.60 -val unique_names = ref true;
242.61 +(* datatype *)
242.62
242.63 +type component = string * bool; (*name with mandatory flag*)
242.64
242.65 -(** qualification **)
242.66 +datatype binding = Binding of
242.67 + {prefix: component list, (*system prefix*)
242.68 + qualifier: component list, (*user qualifier*)
242.69 + name: bstring, (*base name*)
242.70 + pos: Position.T}; (*source position*)
242.71
242.72 -val separator = ".";
242.73 -val is_qualified = exists_string (fn s => s = separator);
242.74 +fun make_binding (prefix, qualifier, name, pos) =
242.75 + Binding {prefix = prefix, qualifier = qualifier, name = name, pos = pos};
242.76
242.77 -fun reject_qualified kind s =
242.78 - if is_qualified s then
242.79 - error ("Attempt to declare qualified " ^ kind ^ " " ^ quote s)
242.80 - else s;
242.81 +fun map_binding f (Binding {prefix, qualifier, name, pos}) =
242.82 + make_binding (f (prefix, qualifier, name, pos));
242.83
242.84 +fun dest (Binding {prefix, qualifier, name, ...}) = (prefix, qualifier, name);
242.85
242.86 -(** binding representation **)
242.87
242.88 -datatype binding = Binding of ((string * bool) list * string) * Position.T;
242.89 - (* (prefix components (with mandatory flag), base name, position) *)
242.90 +(* diagnostic output *)
242.91
242.92 -fun name_pos (name, pos) = Binding (([], name), pos);
242.93 -fun name name = name_pos (name, Position.none);
242.94 +val verbose = ref false;
242.95 +
242.96 +val str_of_components = implode o map (fn (s, true) => s ^ "!" | (s, false) => s ^ "?");
242.97 +
242.98 +fun str_of (Binding {prefix, qualifier, name, pos}) =
242.99 + let
242.100 + val text =
242.101 + if ! verbose then
242.102 + (if null prefix then "" else enclose "(" ")" (str_of_components prefix)) ^
242.103 + str_of_components qualifier ^ name
242.104 + else name;
242.105 + val props = Position.properties_of pos;
242.106 + in Markup.markup (Markup.properties props (Markup.binding name)) text end;
242.107 +
242.108 +
242.109 +
242.110 +(** basic operations **)
242.111 +
242.112 +(* name and position *)
242.113 +
242.114 +fun make (name, pos) = make_binding ([], [], name, pos);
242.115 +fun name name = make (name, Position.none);
242.116 +
242.117 +fun pos_of (Binding {pos, ...}) = pos;
242.118 +fun name_of (Binding {name, ...}) = name;
242.119 +
242.120 +fun map_name f = map_binding (fn (prefix, qualifier, name, pos) => (prefix, qualifier, f name, pos));
242.121 +
242.122 val empty = name "";
242.123 +fun is_empty b = name_of b = "";
242.124
242.125 -fun map_binding f (Binding (prefix_name, pos)) = Binding (f prefix_name, pos);
242.126
242.127 -val map_base = map_binding o apsnd;
242.128 +(* user qualifier *)
242.129
242.130 -fun qualify_base path name =
242.131 - if path = "" orelse name = "" then name
242.132 - else path ^ separator ^ name;
242.133 +fun qualify _ "" = I
242.134 + | qualify mandatory qual = map_binding (fn (prefix, qualifier, name, pos) =>
242.135 + (prefix, (qual, mandatory) :: qualifier, name, pos));
242.136
242.137 -val qualify = map_base o qualify_base;
242.138 - (*FIXME should all operations on bare names move here from name_space.ML ?*)
242.139
242.140 -fun add_prefix sticky "" b = b
242.141 - | add_prefix sticky prfx b = (map_binding o apfst)
242.142 - (cons ((*reject_qualified "prefix"*) prfx, sticky)) b;
242.143 +(* system prefix *)
242.144
242.145 -fun map_prefix f (Binding ((prefix, name), pos)) =
242.146 - f prefix (name_pos (name, pos));
242.147 +fun map_prefix f = map_binding (fn (prefix, qualifier, name, pos) =>
242.148 + (f prefix, qualifier, name, pos));
242.149
242.150 -fun is_empty (Binding ((_, name), _)) = name = "";
242.151 -fun base_name (Binding ((_, name), _)) = name;
242.152 -fun pos_of (Binding (_, pos)) = pos;
242.153 -fun dest (Binding (prefix_name, _)) = prefix_name;
242.154 -
242.155 -fun display (Binding ((prefix, name), _)) =
242.156 - let
242.157 - fun mk_prefix (prfx, true) = prfx
242.158 - | mk_prefix (prfx, false) = enclose "(" ")" prfx
242.159 - in if not (! long_names) orelse null prefix orelse name = "" then name
242.160 - else space_implode "." (map mk_prefix prefix) ^ ":" ^ name
242.161 - end;
242.162 +fun add_prefix _ "" = I
242.163 + | add_prefix mandatory prfx = map_prefix (cons (prfx, mandatory));
242.164
242.165 end;
242.166
242.167 -structure Basic_Binding : BASIC_BINDING = Binding;
242.168 -open Basic_Binding;
242.169 +type binding = Binding.binding;
242.170 +
243.1 --- a/src/Pure/General/markup.ML Wed Mar 04 10:43:39 2009 +0100
243.2 +++ b/src/Pure/General/markup.ML Wed Mar 04 10:45:52 2009 +0100
243.3 @@ -12,9 +12,9 @@
243.4 val properties: (string * string) list -> T -> T
243.5 val nameN: string
243.6 val name: string -> T -> T
243.7 + val bindingN: string val binding: string -> T
243.8 val groupN: string
243.9 val theory_nameN: string
243.10 - val idN: string
243.11 val kindN: string
243.12 val internalK: string
243.13 val property_internal: Properties.property
243.14 @@ -25,6 +25,7 @@
243.15 val end_columnN: string
243.16 val end_offsetN: string
243.17 val fileN: string
243.18 + val idN: string
243.19 val position_properties': string list
243.20 val position_properties: string list
243.21 val positionN: string val position: T
243.22 @@ -107,6 +108,8 @@
243.23 structure Markup: MARKUP =
243.24 struct
243.25
243.26 +(** markup elements **)
243.27 +
243.28 (* basic markup *)
243.29
243.30 type T = string * Properties.T;
243.31 @@ -130,6 +133,8 @@
243.32 val nameN = "name";
243.33 fun name a = properties [(nameN, a)];
243.34
243.35 +val (bindingN, binding) = markup_string "binding" nameN;
243.36 +
243.37 val groupN = "group";
243.38 val theory_nameN = "theory_name";
243.39
243.40 @@ -278,7 +283,7 @@
243.41
243.42
243.43
243.44 -(* print mode operations *)
243.45 +(** print mode operations **)
243.46
243.47 val no_output = ("", "");
243.48 fun default_output (_: T) = no_output;
244.1 --- a/src/Pure/General/name_space.ML Wed Mar 04 10:43:39 2009 +0100
244.2 +++ b/src/Pure/General/name_space.ML Wed Mar 04 10:45:52 2009 +0100
244.3 @@ -3,15 +3,20 @@
244.4
244.5 Generic name spaces with declared and hidden entries. Unknown names
244.6 are considered global; no support for absolute addressing.
244.7 -Cf. Pure/General/binding.ML
244.8 *)
244.9
244.10 -type bstring = string; (*simple names to be bound -- legacy*)
244.11 type xstring = string; (*external names*)
244.12
244.13 +signature BASIC_NAME_SPACE =
244.14 +sig
244.15 + val long_names: bool ref
244.16 + val short_names: bool ref
244.17 + val unique_names: bool ref
244.18 +end;
244.19 +
244.20 signature NAME_SPACE =
244.21 sig
244.22 - include BASIC_BINDING
244.23 + include BASIC_NAME_SPACE
244.24 val hidden: string -> string
244.25 val is_hidden: string -> bool
244.26 val separator: string (*single char*)
244.27 @@ -27,8 +32,9 @@
244.28 val empty: T
244.29 val intern: T -> xstring -> string
244.30 val extern: T -> string -> xstring
244.31 + val extern_flags: {long_names: bool, short_names: bool, unique_names: bool} ->
244.32 + T -> string -> xstring
244.33 val hide: bool -> string -> T -> T
244.34 - val get_accesses: T -> string -> xstring list
244.35 val merge: T * T -> T
244.36 type naming
244.37 val default_naming: naming
244.38 @@ -41,12 +47,11 @@
244.39 val qualified_names: naming -> naming
244.40 val sticky_prefix: string -> naming -> naming
244.41 type 'a table = T * 'a Symtab.table
244.42 + val bind: naming -> binding * 'a -> 'a table -> string * 'a table (*exception Symtab.DUP*)
244.43 val empty_table: 'a table
244.44 - val bind: naming -> binding * 'a
244.45 - -> 'a table -> string * 'a table (*exception Symtab.DUP*)
244.46 - val merge_tables: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table
244.47 - val join_tables: (string -> 'a * 'a -> 'a)
244.48 - -> 'a table * 'a table -> 'a table
244.49 + val merge_tables: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table (*exception Symtab.DUP*)
244.50 + val join_tables: (string -> 'a * 'a -> 'a) (*exception Symtab.DUP/Symtab.SAME*) ->
244.51 + 'a table * 'a table -> 'a table (*exception Symtab.DUP*)
244.52 val dest_table: 'a table -> (string * 'a) list
244.53 val extern_table: 'a table -> (xstring * 'a) list
244.54 end;
244.55 @@ -54,16 +59,13 @@
244.56 structure NameSpace: NAME_SPACE =
244.57 struct
244.58
244.59 -open Basic_Binding;
244.60 -
244.61 -
244.62 (** long identifiers **)
244.63
244.64 fun hidden name = "??." ^ name;
244.65 val is_hidden = String.isPrefix "??.";
244.66
244.67 -val separator = Binding.separator;
244.68 -val is_qualified = Binding.is_qualified;
244.69 +val separator = ".";
244.70 +val is_qualified = exists_string (fn s => s = separator);
244.71
244.72 val implode_name = space_implode separator;
244.73 val explode_name = space_explode separator;
244.74 @@ -120,37 +122,28 @@
244.75
244.76 datatype T =
244.77 NameSpace of
244.78 - ((string list * string list) * stamp) Symtab.table * (*internals, hidden internals*)
244.79 - (string list * stamp) Symtab.table; (*externals*)
244.80 + (string list * string list) Symtab.table * (*internals, hidden internals*)
244.81 + string list Symtab.table; (*externals*)
244.82
244.83 val empty = NameSpace (Symtab.empty, Symtab.empty);
244.84
244.85 fun lookup (NameSpace (tab, _)) xname =
244.86 (case Symtab.lookup tab xname of
244.87 NONE => (xname, true)
244.88 - | SOME (([], []), _) => (xname, true)
244.89 - | SOME (([name], _), _) => (name, true)
244.90 - | SOME ((name :: _, _), _) => (name, false)
244.91 - | SOME (([], name' :: _), _) => (hidden name', true));
244.92 + | SOME ([], []) => (xname, true)
244.93 + | SOME ([name], _) => (name, true)
244.94 + | SOME (name :: _, _) => (name, false)
244.95 + | SOME ([], name' :: _) => (hidden name', true));
244.96
244.97 -fun ex_mapsto_in (NameSpace (tab, _)) name xname =
244.98 - (case Symtab.lookup tab xname of
244.99 - SOME ((name'::_, _), _) => name' = name
244.100 - | _ => false);
244.101 -
244.102 -fun get_accesses' valid_only (ns as (NameSpace (_, tab))) name =
244.103 - (case Symtab.lookup tab name of
244.104 +fun get_accesses (NameSpace (_, xtab)) name =
244.105 + (case Symtab.lookup xtab name of
244.106 NONE => [name]
244.107 - | SOME (xnames, _) => if valid_only
244.108 - then filter (ex_mapsto_in ns name) xnames
244.109 - else xnames);
244.110 -
244.111 -val get_accesses = get_accesses' true;
244.112 + | SOME xnames => xnames);
244.113
244.114 fun put_accesses name xnames (NameSpace (tab, xtab)) =
244.115 - NameSpace (tab, Symtab.update (name, (xnames, stamp ())) xtab);
244.116 + NameSpace (tab, Symtab.update (name, xnames) xtab);
244.117
244.118 -fun valid_accesses (NameSpace (tab, _)) name = Symtab.fold (fn (xname, ((names, _), _)) =>
244.119 +fun valid_accesses (NameSpace (tab, _)) name = Symtab.fold (fn (xname, (names, _)) =>
244.120 if not (null names) andalso hd names = name then cons xname else I) tab [];
244.121
244.122
244.123 @@ -158,28 +151,37 @@
244.124
244.125 fun intern space xname = #1 (lookup space xname);
244.126
244.127 -fun extern space name =
244.128 +fun extern_flags {long_names, short_names, unique_names} space name =
244.129 let
244.130 fun valid unique xname =
244.131 let val (name', uniq) = lookup space xname
244.132 in name = name' andalso (uniq orelse not unique) end;
244.133
244.134 fun ext [] = if valid false name then name else hidden name
244.135 - | ext (nm :: nms) = if valid (! unique_names) nm then nm else ext nms;
244.136 + | ext (nm :: nms) = if valid unique_names nm then nm else ext nms;
244.137 in
244.138 - if ! long_names then name
244.139 - else if ! short_names then base name
244.140 - else ext (get_accesses' false space name)
244.141 + if long_names then name
244.142 + else if short_names then base name
244.143 + else ext (get_accesses space name)
244.144 end;
244.145
244.146 +val long_names = ref false;
244.147 +val short_names = ref false;
244.148 +val unique_names = ref true;
244.149 +
244.150 +fun extern space name =
244.151 + extern_flags
244.152 + {long_names = ! long_names,
244.153 + short_names = ! short_names,
244.154 + unique_names = ! unique_names} space name;
244.155 +
244.156
244.157 (* basic operations *)
244.158
244.159 local
244.160
244.161 fun map_space f xname (NameSpace (tab, xtab)) =
244.162 - NameSpace (Symtab.map_default (xname, (([], []), stamp ()))
244.163 - (fn (entry, _) => (f entry, stamp ())) tab, xtab);
244.164 + NameSpace (Symtab.map_default (xname, ([], [])) f tab, xtab);
244.165
244.166 in
244.167
244.168 @@ -203,7 +205,7 @@
244.169 space
244.170 |> add_name' name name
244.171 |> fold (del_name name) (if fully then names else names inter_string [base name])
244.172 - |> fold (del_name_extra name) (get_accesses' false space name)
244.173 + |> fold (del_name_extra name) (get_accesses space name)
244.174 end;
244.175
244.176
244.177 @@ -212,15 +214,13 @@
244.178 fun merge (NameSpace (tab1, xtab1), NameSpace (tab2, xtab2)) =
244.179 let
244.180 val tab' = (tab1, tab2) |> Symtab.join
244.181 - (K (fn (((names1, names1'), stamp1), ((names2, names2'), stamp2)) =>
244.182 - if stamp1 = stamp2 then raise Symtab.SAME
244.183 - else
244.184 - ((Library.merge (op =) (names1, names2),
244.185 - Library.merge (op =) (names1', names2')), stamp ())));
244.186 + (K (fn names as ((names1, names1'), (names2, names2')) =>
244.187 + if pointer_eq names then raise Symtab.SAME
244.188 + else (Library.merge (op =) (names1, names2), Library.merge (op =) (names1', names2'))));
244.189 val xtab' = (xtab1, xtab2) |> Symtab.join
244.190 - (K (fn ((xnames1, stamp1), (xnames2, stamp2)) =>
244.191 - if stamp1 = stamp2 then raise Symtab.SAME
244.192 - else (Library.merge (op =) (xnames1, xnames2), stamp ())));
244.193 + (K (fn xnames =>
244.194 + if pointer_eq xnames then raise Symtab.SAME
244.195 + else (Library.merge (op =) xnames)));
244.196 in NameSpace (tab', xtab') end;
244.197
244.198
244.199 @@ -272,32 +272,33 @@
244.200 in fold mk_prefix end;
244.201
244.202
244.203 -(* declarations *)
244.204 +(* full name *)
244.205
244.206 -fun full_internal (Naming (path, (qualify, _))) = qualify path;
244.207 +fun full (Naming (path, (qualify, _))) = qualify path;
244.208
244.209 -fun declare_internal naming name space =
244.210 - if is_hidden name then
244.211 - error ("Attempt to declare hidden name " ^ quote name)
244.212 - else
244.213 - let
244.214 - val names = explode_name name;
244.215 - val _ = (null names orelse exists (fn s => s = "") names
244.216 - orelse exists_string (fn s => s = "\"") name) andalso
244.217 - error ("Bad name declaration " ^ quote name);
244.218 - val (accs, accs') = pairself (map implode_name) (accesses naming names);
244.219 - in space |> fold (add_name name) accs |> put_accesses name accs' end;
244.220 +fun full_name naming binding =
244.221 + let
244.222 + val (prefix, qualifier, bname) = Binding.dest binding;
244.223 + val naming' = apply_prefix (prefix @ qualifier) naming;
244.224 + in full naming' bname end;
244.225
244.226 -fun full_name naming b =
244.227 - let val (prefix, bname) = Binding.dest b
244.228 - in full_internal (apply_prefix prefix naming) bname end;
244.229
244.230 -fun declare bnaming b =
244.231 +(* declaration *)
244.232 +
244.233 +fun declare naming binding space =
244.234 let
244.235 - val (prefix, bname) = Binding.dest b;
244.236 - val naming = apply_prefix prefix bnaming;
244.237 - val name = full_internal naming bname;
244.238 - in declare_internal naming name #> pair name end;
244.239 + val (prefix, qualifier, bname) = Binding.dest binding;
244.240 + val naming' = apply_prefix (prefix @ qualifier) naming;
244.241 + val name = full naming' bname;
244.242 + val names = explode_name name;
244.243 +
244.244 + val _ = (null names orelse exists (fn s => s = "" orelse s = "??") names
244.245 + orelse exists_string (fn s => s = "\"") name) andalso
244.246 + error ("Bad name declaration " ^ quote (Binding.str_of binding));
244.247 +
244.248 + val (accs, accs') = pairself (map implode_name) (accesses naming' names);
244.249 + val space' = space |> fold (add_name name) accs |> put_accesses name accs';
244.250 + in (name, space') end;
244.251
244.252
244.253
244.254 @@ -305,13 +306,12 @@
244.255
244.256 type 'a table = T * 'a Symtab.table;
244.257
244.258 +fun bind naming (binding, x) (space, tab) =
244.259 + let val (name, space') = declare naming binding space
244.260 + in (name, (space', Symtab.update_new (name, x) tab)) end;
244.261 +
244.262 val empty_table = (empty, Symtab.empty);
244.263
244.264 -fun bind naming (b, x) (space, tab) =
244.265 - let
244.266 - val (name, space') = declare naming b space;
244.267 - in (name, (space', Symtab.update_new (name, x) tab)) end;
244.268 -
244.269 fun merge_tables eq ((space1, tab1), (space2, tab2)) =
244.270 (merge (space1, space2), Symtab.merge eq (tab1, tab2));
244.271
244.272 @@ -331,3 +331,7 @@
244.273 val explode = explode_name;
244.274
244.275 end;
244.276 +
244.277 +structure BasicNameSpace: BASIC_NAME_SPACE = NameSpace;
244.278 +open BasicNameSpace;
244.279 +
245.1 --- a/src/Pure/General/output.ML Wed Mar 04 10:43:39 2009 +0100
245.2 +++ b/src/Pure/General/output.ML Wed Mar 04 10:45:52 2009 +0100
245.3 @@ -135,7 +135,7 @@
245.4 let
245.5 val start = start_timing ();
245.6 val result = Exn.capture e ();
245.7 - val end_msg = end_timing start;
245.8 + val end_msg = #message (end_timing start);
245.9 val _ = warning (if msg = "" then end_msg else msg ^ "\n" ^ end_msg);
245.10 in Exn.release result end
245.11 else e ();
246.1 --- a/src/Pure/General/swing.scala Wed Mar 04 10:43:39 2009 +0100
246.2 +++ b/src/Pure/General/swing.scala Wed Mar 04 10:45:52 2009 +0100
246.3 @@ -10,9 +10,11 @@
246.4
246.5 object Swing
246.6 {
246.7 - def now(body: => Unit) {
246.8 - if (SwingUtilities.isEventDispatchThread) body
246.9 - else SwingUtilities.invokeAndWait(new Runnable { def run = body })
246.10 + def now[A](body: => A): A = {
246.11 + var result: Option[A] = None
246.12 + if (SwingUtilities.isEventDispatchThread) { result = Some(body) }
246.13 + else SwingUtilities.invokeAndWait(new Runnable { def run = { result = Some(body) } })
246.14 + result.get
246.15 }
246.16
246.17 def later(body: => Unit) {
247.1 --- a/src/Pure/IsaMakefile Wed Mar 04 10:43:39 2009 +0100
247.2 +++ b/src/Pure/IsaMakefile Wed Mar 04 10:45:52 2009 +0100
247.3 @@ -19,9 +19,29 @@
247.4
247.5 ## Pure
247.6
247.7 +BOOTSTRAP_FILES = ML-Systems/exn.ML ML-Systems/ml_name_space.ML \
247.8 + ML-Systems/mosml.ML ML-Systems/multithreading.ML \
247.9 + ML-Systems/multithreading_polyml.ML ML-Systems/overloading_smlnj.ML \
247.10 + ML-Systems/polyml-4.1.3.ML ML-Systems/polyml-4.1.4.ML \
247.11 + ML-Systems/polyml-4.2.0.ML ML-Systems/polyml-5.0.ML \
247.12 + ML-Systems/polyml-5.1.ML ML-Systems/polyml-experimental.ML \
247.13 + ML-Systems/polyml.ML ML-Systems/polyml_common.ML \
247.14 + ML-Systems/polyml_old_compiler4.ML \
247.15 + ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML \
247.16 + ML-Systems/smlnj.ML ML-Systems/system_shell.ML \
247.17 + ML-Systems/thread_dummy.ML ML-Systems/time_limit.ML \
247.18 + ML-Systems/universal.ML
247.19 +
247.20 +RAW: $(OUT)/RAW
247.21 +
247.22 +$(OUT)/RAW: $(BOOTSTRAP_FILES)
247.23 + @./mk -r
247.24 +
247.25 +
247.26 Pure: $(OUT)/Pure
247.27
247.28 -$(OUT)/Pure: Concurrent/ROOT.ML Concurrent/future.ML \
247.29 +$(OUT)/Pure: $(BOOTSTRAP_FILES) ../Tools/auto_solve.ML \
247.30 + ../Tools/quickcheck.ML Concurrent/ROOT.ML Concurrent/future.ML \
247.31 Concurrent/mailbox.ML Concurrent/par_list.ML \
247.32 Concurrent/par_list_dummy.ML Concurrent/simple_thread.ML \
247.33 Concurrent/synchronized.ML Concurrent/task_queue.ML General/ROOT.ML \
247.34 @@ -38,33 +58,21 @@
247.35 Isar/attrib.ML Isar/auto_bind.ML Isar/calculation.ML Isar/class.ML \
247.36 Isar/class_target.ML Isar/code.ML Isar/code_unit.ML \
247.37 Isar/constdefs.ML Isar/context_rules.ML Isar/element.ML \
247.38 - Isar/expression.ML Isar/find_theorems.ML Isar/find_consts.ML \
247.39 - Isar/isar.ML Isar/isar_document.ML Isar/isar_cmd.ML Isar/isar_syn.ML \
247.40 - Isar/local_defs.ML Isar/local_syntax.ML Isar/local_theory.ML \
247.41 - Isar/locale.ML Isar/method.ML Isar/net_rules.ML \
247.42 + Isar/expression.ML Isar/isar_cmd.ML Isar/isar_document.ML \
247.43 + Isar/isar_syn.ML Isar/local_defs.ML Isar/local_syntax.ML \
247.44 + Isar/local_theory.ML Isar/locale.ML Isar/method.ML Isar/net_rules.ML \
247.45 Isar/object_logic.ML Isar/obtain.ML Isar/outer_keyword.ML \
247.46 Isar/outer_lex.ML Isar/outer_parse.ML Isar/outer_syntax.ML \
247.47 Isar/overloading.ML Isar/proof.ML Isar/proof_context.ML \
247.48 Isar/proof_display.ML Isar/proof_node.ML Isar/rule_cases.ML \
247.49 - Isar/rule_insts.ML Isar/session.ML Isar/skip_proof.ML \
247.50 - Isar/spec_parse.ML Isar/specification.ML Isar/theory_target.ML \
247.51 - Isar/toplevel.ML Isar/value_parse.ML ML-Systems/alice.ML \
247.52 - ML-Systems/exn.ML ML-Systems/install_pp_polyml.ML \
247.53 - ML-Systems/ml_name_space.ML ML-Systems/multithreading.ML \
247.54 - ML-Systems/mosml.ML ML-Systems/multithreading_polyml.ML \
247.55 - ML-Systems/overloading_smlnj.ML ML-Systems/polyml-4.1.3.ML \
247.56 - ML-Systems/polyml-4.1.4.ML ML-Systems/polyml-4.2.0.ML \
247.57 - ML-Systems/polyml-5.0.ML ML-Systems/polyml-5.1.ML \
247.58 - ML-Systems/polyml_common.ML ML-Systems/polyml.ML \
247.59 - ML-Systems/polyml_old_compiler4.ML \
247.60 - ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML \
247.61 - ML-Systems/smlnj.ML ML-Systems/system_shell.ML \
247.62 - ML-Systems/time_limit.ML ML-Systems/thread_dummy.ML \
247.63 - ML-Systems/universal.ML ML/ml_context.ML ML/ml_antiquote.ML \
247.64 - ML/ml_lex.ML ML/ml_parse.ML ML/ml_syntax.ML ML/ml_thms.ML \
247.65 - Proof/extraction.ML Proof/proof_rewrite_rules.ML \
247.66 - Proof/proof_syntax.ML Proof/proofchecker.ML Proof/reconstruct.ML \
247.67 - ProofGeneral/ROOT.ML ProofGeneral/pgip.ML ProofGeneral/pgip_input.ML \
247.68 + Isar/rule_insts.ML Isar/skip_proof.ML Isar/spec_parse.ML \
247.69 + Isar/specification.ML Isar/theory_target.ML Isar/toplevel.ML \
247.70 + Isar/value_parse.ML ML/ml_antiquote.ML ML/ml_context.ML ML/ml_lex.ML \
247.71 + ML/ml_parse.ML ML/ml_syntax.ML ML/ml_thms.ML \
247.72 + ML-Systems/install_pp_polyml.ML Proof/extraction.ML \
247.73 + Proof/proof_rewrite_rules.ML Proof/proof_syntax.ML \
247.74 + Proof/proofchecker.ML Proof/reconstruct.ML ProofGeneral/ROOT.ML \
247.75 + ProofGeneral/pgip.ML ProofGeneral/pgip_input.ML \
247.76 ProofGeneral/pgip_isabelle.ML ProofGeneral/pgip_markup.ML \
247.77 ProofGeneral/pgip_output.ML ProofGeneral/pgip_parser.ML \
247.78 ProofGeneral/pgip_tests.ML ProofGeneral/pgip_types.ML \
247.79 @@ -72,24 +80,25 @@
247.80 ProofGeneral/proof_general_pgip.ML Pure.thy ROOT.ML Syntax/ast.ML \
247.81 Syntax/lexicon.ML Syntax/mixfix.ML Syntax/parser.ML \
247.82 Syntax/printer.ML Syntax/simple_syntax.ML Syntax/syn_ext.ML \
247.83 - Syntax/syn_trans.ML Syntax/syntax.ML Syntax/type_ext.ML Thy/html.ML \
247.84 - Thy/latex.ML Thy/present.ML Thy/term_style.ML Thy/thm_deps.ML \
247.85 - Thy/thy_header.ML Thy/thy_info.ML Thy/thy_load.ML Thy/thy_output.ML \
247.86 - Thy/thy_syntax.ML Tools/ROOT.ML \
247.87 - Tools/isabelle_process.ML Tools/named_thms.ML Tools/xml_syntax.ML \
247.88 - assumption.ML axclass.ML codegen.ML config.ML conjunction.ML \
247.89 - consts.ML context.ML context_position.ML conv.ML defs.ML display.ML \
247.90 - drule.ML envir.ML facts.ML goal.ML interpretation.ML library.ML \
247.91 - logic.ML meta_simplifier.ML more_thm.ML morphism.ML name.ML net.ML \
247.92 - old_goals.ML old_term.ML pattern.ML primitive_defs.ML proofterm.ML \
247.93 - pure_setup.ML pure_thy.ML search.ML sign.ML simplifier.ML sorts.ML \
247.94 - subgoal.ML tactic.ML tctical.ML term.ML term_ord.ML term_subst.ML \
247.95 - theory.ML thm.ML type.ML type_infer.ML unify.ML variable.ML \
247.96 - ../Tools/quickcheck.ML ../Tools/auto_solve.ML
247.97 + Syntax/syn_trans.ML Syntax/syntax.ML Syntax/type_ext.ML \
247.98 + System/isabelle_process.ML System/isar.ML System/session.ML \
247.99 + Thy/html.ML Thy/latex.ML Thy/present.ML Thy/term_style.ML \
247.100 + Thy/thm_deps.ML Thy/thy_header.ML Thy/thy_info.ML Thy/thy_load.ML \
247.101 + Thy/thy_output.ML Thy/thy_syntax.ML Tools/ROOT.ML \
247.102 + Tools/find_consts.ML Tools/find_theorems.ML Tools/named_thms.ML \
247.103 + Tools/xml_syntax.ML assumption.ML axclass.ML codegen.ML config.ML \
247.104 + conjunction.ML consts.ML context.ML context_position.ML conv.ML \
247.105 + defs.ML display.ML drule.ML envir.ML facts.ML goal.ML \
247.106 + interpretation.ML library.ML logic.ML meta_simplifier.ML more_thm.ML \
247.107 + morphism.ML name.ML net.ML old_goals.ML old_term.ML pattern.ML \
247.108 + primitive_defs.ML proofterm.ML pure_setup.ML pure_thy.ML search.ML \
247.109 + sign.ML simplifier.ML sorts.ML subgoal.ML tactic.ML tctical.ML \
247.110 + term.ML term_ord.ML term_subst.ML theory.ML thm.ML type.ML \
247.111 + type_infer.ML unify.ML variable.ML
247.112 @./mk
247.113
247.114
247.115 -## special targets
247.116 +## Proof General keywords
247.117
247.118 Pure-ProofGeneral: Pure $(LOG)/Pure-ProofGeneral.gz
247.119
247.120 @@ -97,28 +106,11 @@
247.121 @$(ISABELLE_TOOL) usedir -f proof_general_keywords.ML $(OUT)/Pure ProofGeneral
247.122
247.123
247.124 -RAW: $(OUT)/RAW
247.125 -
247.126 -$(OUT)/RAW: ML-Systems/alice.ML ML-Systems/exn.ML \
247.127 - ML-Systems/ml_name_space.ML ML-Systems/multithreading.ML \
247.128 - ML-Systems/mosml.ML ML-Systems/multithreading_polyml.ML \
247.129 - ML-Systems/overloading_smlnj.ML ML-Systems/polyml-4.1.3.ML \
247.130 - ML-Systems/polyml-4.1.4.ML ML-Systems/polyml-4.2.0.ML \
247.131 - ML-Systems/polyml-5.0.ML ML-Systems/polyml-5.1.ML \
247.132 - ML-Systems/polyml_common.ML ML-Systems/polyml.ML \
247.133 - ML-Systems/polyml_old_compiler4.ML \
247.134 - ML-Systems/polyml_old_compiler5.ML ML-Systems/proper_int.ML \
247.135 - ML-Systems/smlnj.ML ML-Systems/system_shell.ML \
247.136 - ML-Systems/time_limit.ML ML-Systems/thread_dummy.ML \
247.137 - ML-Systems/universal.ML
247.138 - @./mk -r
247.139 -
247.140 -
247.141 ## clean
247.142
247.143 clean:
247.144 - @rm -f $(OUT)/Pure $(LOG)/Pure.gz $(LOG)/Pure-ProofGeneral.gz \
247.145 - $(OUT)/RAW $(LOG)/RAW.gz
247.146 + @rm -f $(OUT)/Pure $(LOG)/Pure.gz $(OUT)/RAW $(LOG)/RAW.gz \
247.147 + $(LOG)/Pure-ProofGeneral.gz
247.148
247.149
247.150 ## Scala material
247.151 @@ -127,8 +119,8 @@
247.152 General/position.scala General/swing.scala General/symbol.scala \
247.153 General/xml.scala General/yxml.scala Isar/isar.scala \
247.154 Isar/isar_document.scala Isar/outer_keyword.scala \
247.155 - Thy/thy_header.scala Tools/isabelle_process.scala \
247.156 - Tools/isabelle_syntax.scala Tools/isabelle_system.scala
247.157 + System/isabelle_process.scala System/isabelle_system.scala \
247.158 + Thy/thy_header.scala Tools/isabelle_syntax.scala
247.159
247.160
247.161 SCALA_TARGET = $(ISABELLE_HOME)/lib/classes/Pure.jar
248.1 --- a/src/Pure/Isar/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
248.2 +++ b/src/Pure/Isar/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
248.3 @@ -82,14 +82,12 @@
248.4 use "../old_goals.ML";
248.5 use "outer_syntax.ML";
248.6 use "../Thy/thy_info.ML";
248.7 -use "session.ML";
248.8 -use "isar.ML";
248.9 use "isar_document.ML";
248.10
248.11 (*theory and proof operations*)
248.12 use "rule_insts.ML";
248.13 use "../Thy/thm_deps.ML";
248.14 -use "find_theorems.ML";
248.15 -use "find_consts.ML";
248.16 use "isar_cmd.ML";
248.17 use "isar_syn.ML";
248.18 +
248.19 +
249.1 --- a/src/Pure/Isar/args.ML Wed Mar 04 10:43:39 2009 +0100
249.2 +++ b/src/Pure/Isar/args.ML Wed Mar 04 10:45:52 2009 +0100
249.3 @@ -170,7 +170,7 @@
249.4 val name_source_position = named >> T.source_position_of;
249.5
249.6 val name = named >> T.content_of;
249.7 -val binding = P.position name >> Binding.name_pos;
249.8 +val binding = P.position name >> Binding.make;
249.9 val alt_name = alt_string >> T.content_of;
249.10 val symbol = symbolic >> T.content_of;
249.11 val liberal_name = symbol || name;
250.1 --- a/src/Pure/Isar/attrib.ML Wed Mar 04 10:43:39 2009 +0100
250.2 +++ b/src/Pure/Isar/attrib.ML Wed Mar 04 10:45:52 2009 +0100
250.3 @@ -118,8 +118,7 @@
250.4 fun attribute thy = attribute_i thy o intern_src thy;
250.5
250.6 fun eval_thms ctxt args = ProofContext.note_thmss Thm.theoremK
250.7 - [((Binding.empty, []),
250.8 - map (apsnd (map (attribute (ProofContext.theory_of ctxt)))) args)] ctxt
250.9 + [(Thm.empty_binding, map (apsnd (map (attribute (ProofContext.theory_of ctxt)))) args)] ctxt
250.10 |> fst |> maps snd;
250.11
250.12
250.13 @@ -198,7 +197,7 @@
250.14 let
250.15 val ths = Facts.select thmref fact;
250.16 val atts = map (attribute_i thy) srcs;
250.17 - val (context', ths') = foldl_map (Library.apply atts) (context, ths);
250.18 + val (context', ths') = Library.foldl_map (Library.apply atts) (context, ths);
250.19 in (context', pick name ths') end)
250.20 end);
250.21
251.1 --- a/src/Pure/Isar/calculation.ML Wed Mar 04 10:43:39 2009 +0100
251.2 +++ b/src/Pure/Isar/calculation.ML Wed Mar 04 10:45:52 2009 +0100
251.3 @@ -15,7 +15,7 @@
251.4 val symmetric: attribute
251.5 val also: (Facts.ref * Attrib.src list) list option -> bool -> Proof.state -> Proof.state Seq.seq
251.6 val also_i: thm list option -> bool -> Proof.state -> Proof.state Seq.seq
251.7 - val finally_: (Facts.ref * Attrib.src list) list option -> bool ->
251.8 + val finally: (Facts.ref * Attrib.src list) list option -> bool ->
251.9 Proof.state -> Proof.state Seq.seq
251.10 val finally_i: thm list option -> bool -> Proof.state -> Proof.state Seq.seq
251.11 val moreover: bool -> Proof.state -> Proof.state
251.12 @@ -150,7 +150,7 @@
251.13
251.14 val also = calculate Proof.get_thmss false;
251.15 val also_i = calculate (K I) false;
251.16 -val finally_ = calculate Proof.get_thmss true;
251.17 +val finally = calculate Proof.get_thmss true;
251.18 val finally_i = calculate (K I) true;
251.19
251.20
252.1 --- a/src/Pure/Isar/class.ML Wed Mar 04 10:43:39 2009 +0100
252.2 +++ b/src/Pure/Isar/class.ML Wed Mar 04 10:45:52 2009 +0100
252.3 @@ -201,7 +201,7 @@
252.4 | check_element e = [()];
252.5 val _ = map check_element syntax_elems;
252.6 fun fork_syn (Element.Fixes xs) =
252.7 - fold_map (fn (c, ty, syn) => cons (Binding.base_name c, syn) #> pair (c, ty, NoSyn)) xs
252.8 + fold_map (fn (c, ty, syn) => cons (Binding.name_of c, syn) #> pair (c, ty, NoSyn)) xs
252.9 #>> Element.Fixes
252.10 | fork_syn x = pair x;
252.11 val (elems, global_syntax) = fold_map fork_syn syntax_elems [];
252.12 @@ -228,7 +228,7 @@
252.13 val raw_params = (snd o chop (length supparams)) all_params;
252.14 fun add_const (b, SOME raw_ty, _) thy =
252.15 let
252.16 - val v = Binding.base_name b;
252.17 + val v = Binding.name_of b;
252.18 val c = Sign.full_bname thy v;
252.19 val ty = map_atyps (K (TFree (Name.aT, base_sort))) raw_ty;
252.20 val ty0 = Type.strip_sorts ty;
252.21 @@ -265,8 +265,7 @@
252.22 |> add_consts bname class base_sort sups supparams global_syntax
252.23 |-> (fn (param_map, params) => AxClass.define_class (bname, supsort)
252.24 (map (fst o snd) params)
252.25 - [((Binding.empty, []),
252.26 - Option.map (globalize param_map) raw_pred |> the_list)]
252.27 + [(Thm.empty_binding, Option.map (globalize param_map) raw_pred |> the_list)]
252.28 #> snd
252.29 #> `get_axiom
252.30 #-> (fn assm_axiom => fold (Sign.add_const_constraint o apsnd SOME o snd) params
253.1 --- a/src/Pure/Isar/class_target.ML Wed Mar 04 10:43:39 2009 +0100
253.2 +++ b/src/Pure/Isar/class_target.ML Wed Mar 04 10:45:52 2009 +0100
253.3 @@ -493,7 +493,7 @@
253.4 fun init_instantiation (tycos, vs, sort) thy =
253.5 let
253.6 val _ = if null tycos then error "At least one arity must be given" else ();
253.7 - val params = these_params thy sort;
253.8 + val params = these_params thy (filter (can (AxClass.get_info thy)) sort);
253.9 fun get_param tyco (param, (_, (c, ty))) =
253.10 if can (AxClass.param_of_inst thy) (c, tyco)
253.11 then NONE else SOME ((c, tyco),
253.12 @@ -513,7 +513,8 @@
253.13 | SOME ts' => SOME (ts', ctxt);
253.14 fun improve (c, ty) = case AxClass.inst_tyco_of thy (c, ty)
253.15 of SOME tyco => (case AList.lookup (op =) inst_params (c, tyco)
253.16 - of SOME (_, ty') => if Type.raw_instance (ty', ty) then SOME (ty, ty') else NONE
253.17 + of SOME (_, ty') => if Type.typ_instance (Sign.tsig_of thy) (ty', ty)
253.18 + then SOME (ty, ty') else NONE
253.19 | NONE => NONE)
253.20 | NONE => NONE;
253.21 in
253.22 @@ -523,8 +524,7 @@
253.23 |> fold (Variable.declare_typ o TFree) vs
253.24 |> fold (Variable.declare_names o Free o snd) inst_params
253.25 |> (Overloading.map_improvable_syntax o apfst)
253.26 - (fn ((_, _), ((_, subst), unchecks)) =>
253.27 - ((primary_constraints, []), (((improve, K NONE), false), [])))
253.28 + (K ((primary_constraints, []), (((improve, K NONE), false), [])))
253.29 |> Overloading.add_improvable_syntax
253.30 |> Context.proof_map (Syntax.add_term_check 0 "resorting" resort_check)
253.31 |> synchronize_inst_syntax
254.1 --- a/src/Pure/Isar/code.ML Wed Mar 04 10:43:39 2009 +0100
254.2 +++ b/src/Pure/Isar/code.ML Wed Mar 04 10:45:52 2009 +0100
254.3 @@ -35,7 +35,7 @@
254.4 val these_raw_eqns: theory -> string -> (thm * bool) list
254.5 val get_datatype: theory -> string -> ((string * sort) list * (string * typ list) list)
254.6 val get_datatype_of_constr: theory -> string -> string option
254.7 - val get_case_data: theory -> string -> (int * string list) option
254.8 + val get_case_scheme: theory -> string -> (int * (int * string list)) option
254.9 val is_undefined: theory -> string -> bool
254.10 val default_typscheme: theory -> string -> (string * sort) list * typ
254.11
254.12 @@ -111,7 +111,7 @@
254.13
254.14 (** logical and syntactical specification of executable code **)
254.15
254.16 -(* defining equations *)
254.17 +(* code equations *)
254.18
254.19 type eqns = bool * (thm * bool) list lazy;
254.20 (*default flag, theorems with linear flag (perhaps lazy)*)
254.21 @@ -136,7 +136,7 @@
254.22 Pattern.matchess thy (args, (map incr_idx o curry Library.take (length args)) args');
254.23 fun drop (thm', linear') = if (linear orelse not linear')
254.24 andalso matches_args (args_of thm') then
254.25 - (warning ("Code generator: dropping redundant defining equation\n" ^ Display.string_of_thm thm'); true)
254.26 + (warning ("Code generator: dropping redundant code equation\n" ^ Display.string_of_thm thm'); true)
254.27 else false;
254.28 in (thm, linear) :: filter_out drop thms end;
254.29
254.30 @@ -157,7 +157,7 @@
254.31 (*with explicit history*),
254.32 dtyps: ((serial * ((string * sort) list * (string * typ list) list)) list) Symtab.table
254.33 (*with explicit history*),
254.34 - cases: (int * string list) Symtab.table * unit Symtab.table
254.35 + cases: (int * (int * string list)) Symtab.table * unit Symtab.table
254.36 };
254.37
254.38 fun mk_spec ((concluded_history, eqns), (dtyps, cases)) =
254.39 @@ -409,7 +409,7 @@
254.40 in
254.41 (Pretty.writeln o Pretty.chunks) [
254.42 Pretty.block (
254.43 - Pretty.str "defining equations:"
254.44 + Pretty.str "code equations:"
254.45 :: Pretty.fbrk
254.46 :: (Pretty.fbreaks o map pretty_eqn) eqns
254.47 ),
254.48 @@ -452,7 +452,7 @@
254.49 val ty1 :: tys = map (snd o Code_Unit.const_typ_eqn) thms';
254.50 fun unify ty env = Sign.typ_unify thy (ty1, ty) env
254.51 handle Type.TUNIFY =>
254.52 - error ("Type unificaton failed, while unifying defining equations\n"
254.53 + error ("Type unificaton failed, while unifying code equations\n"
254.54 ^ (cat_lines o map Display.string_of_thm) thms
254.55 ^ "\nwith types\n"
254.56 ^ (cat_lines o map (Code_Unit.string_of_typ thy)) (ty1 :: tys));
254.57 @@ -463,7 +463,7 @@
254.58
254.59 fun check_linear (eqn as (thm, linear)) =
254.60 if linear then eqn else Code_Unit.bad_thm
254.61 - ("Duplicate variables on left hand side of defining equation:\n"
254.62 + ("Duplicate variables on left hand side of code equation:\n"
254.63 ^ Display.string_of_thm thm);
254.64
254.65 fun mk_eqn thy linear =
254.66 @@ -489,7 +489,7 @@
254.67
254.68 fun retrieve_algebra thy operational =
254.69 Sorts.subalgebra (Syntax.pp_global thy) operational
254.70 - (arity_constraints thy (Sign.classes_of thy))
254.71 + (SOME o arity_constraints thy (Sign.classes_of thy))
254.72 (Sign.classes_of thy);
254.73
254.74 in
254.75 @@ -525,22 +525,13 @@
254.76 then SOME tyco else NONE
254.77 | _ => NONE;
254.78
254.79 -fun get_constr_typ thy c =
254.80 - case get_datatype_of_constr thy c
254.81 - of SOME tyco => let
254.82 - val (vs, cos) = get_datatype thy tyco;
254.83 - val SOME tys = AList.lookup (op =) cos c;
254.84 - val ty = tys ---> Type (tyco, map TFree vs);
254.85 - in SOME (Logic.varifyT ty) end
254.86 - | NONE => NONE;
254.87 -
254.88 fun recheck_eqn thy = Code_Unit.error_thm
254.89 (Code_Unit.assert_linear (is_some o get_datatype_of_constr thy) o apfst (Code_Unit.assert_eqn thy));
254.90
254.91 fun recheck_eqns_const thy c eqns =
254.92 let
254.93 fun cert (eqn as (thm, _)) = if c = Code_Unit.const_eqn thm
254.94 - then eqn else error ("Wrong head of defining equation,\nexpected constant "
254.95 + then eqn else error ("Wrong head of code equation,\nexpected constant "
254.96 ^ Code_Unit.string_of_const thy c ^ "\n" ^ Display.string_of_thm thm)
254.97 in map (cert o recheck_eqn thy) eqns end;
254.98
254.99 @@ -554,11 +545,11 @@
254.100 let
254.101 val c = Code_Unit.const_eqn thm;
254.102 val _ = if not default andalso (is_some o AxClass.class_of_param thy) c
254.103 - then error ("Rejected polymorphic equation for overloaded constant:\n"
254.104 + then error ("Rejected polymorphic code equation for overloaded constant:\n"
254.105 ^ Display.string_of_thm thm)
254.106 else ();
254.107 val _ = if not default andalso (is_some o get_datatype_of_constr thy) c
254.108 - then error ("Rejected equation for datatype constructor:\n"
254.109 + then error ("Rejected code equation for datatype constructor:\n"
254.110 ^ Display.string_of_thm thm)
254.111 else ();
254.112 in change_eqns false c (add_thm thy default (thm, linear)) thy end
254.113 @@ -583,7 +574,7 @@
254.114
254.115 fun del_eqns c = change_eqns true c (K (false, Lazy.value []));
254.116
254.117 -val get_case_data = Symtab.lookup o fst o the_cases o the_exec;
254.118 +fun get_case_scheme thy = Symtab.lookup ((fst o the_cases o the_exec) thy);
254.119
254.120 val is_undefined = Symtab.defined o snd o the_cases o the_exec;
254.121
254.122 @@ -593,11 +584,17 @@
254.123 let
254.124 val cs = map (fn c_ty as (_, ty) => (AxClass.unoverload_const thy c_ty, ty)) raw_cs;
254.125 val (tyco, vs_cos) = Code_Unit.constrset_of_consts thy cs;
254.126 + val old_cs = (map fst o snd o get_datatype thy) tyco;
254.127 + fun drop_outdated_cases cases = fold Symtab.delete_safe
254.128 + (Symtab.fold (fn (c, (_, (_, cos))) =>
254.129 + if exists (member (op =) old_cs) cos
254.130 + then insert (op =) c else I) cases []) cases;
254.131 in
254.132 thy
254.133 |> map_exec_purge NONE
254.134 ((map_dtyps o Symtab.map_default (tyco, [])) (cons (serial (), vs_cos))
254.135 - #> map_eqns (fold (Symtab.delete_safe o fst) cs))
254.136 + #> map_eqns (fold (Symtab.delete_safe o fst) cs)
254.137 + #> (map_cases o apfst) drop_outdated_cases)
254.138 |> TypeInterpretation.data (tyco, serial ())
254.139 end;
254.140
254.141 @@ -611,10 +608,12 @@
254.142
254.143 fun add_case thm thy =
254.144 let
254.145 - val entry as (c, _) = Code_Unit.case_cert thm;
254.146 - in
254.147 - (map_exec_purge (SOME [c]) o map_cases o apfst) (Symtab.update entry) thy
254.148 - end;
254.149 + val (c, (k, case_pats)) = Code_Unit.case_cert thm;
254.150 + val _ = case filter (is_none o get_datatype_of_constr thy) case_pats
254.151 + of [] => ()
254.152 + | cs => error ("Non-constructor(s) in case certificate: " ^ commas (map quote cs));
254.153 + val entry = (1 + Int.max (1, length case_pats), (k, case_pats))
254.154 + in (map_exec_purge (SOME [c]) o map_cases o apfst) (Symtab.update (c, entry)) thy end;
254.155
254.156 fun add_undefined c thy =
254.157 (map_exec_purge (SOME [c]) o map_cases o apsnd) (Symtab.update (c, ())) thy;
254.158 @@ -727,18 +726,16 @@
254.159
254.160 fun default_typscheme thy c =
254.161 let
254.162 - val typscheme = curry (Code_Unit.typscheme thy) c
254.163 - val the_const_type = snd o dest_Const o TermSubst.zero_var_indexes
254.164 - o curry Const "" o Sign.the_const_type thy;
254.165 + fun the_const_typscheme c = (curry (Code_Unit.typscheme thy) c o snd o dest_Const
254.166 + o TermSubst.zero_var_indexes o curry Const "" o Sign.the_const_type thy) c;
254.167 + fun strip_sorts (vs, ty) = (map (fn (v, _) => (v, [])) vs, ty);
254.168 in case AxClass.class_of_param thy c
254.169 - of SOME class => the_const_type c
254.170 - |> Term.map_type_tvar (K (TVar ((Name.aT, 0), [class])))
254.171 - |> typscheme
254.172 - | NONE => (case get_constr_typ thy c
254.173 - of SOME ty => typscheme ty
254.174 - | NONE => (case get_eqns thy c
254.175 - of (thm, _) :: _ => snd (Code_Unit.head_eqn thy (Drule.zero_var_indexes thm))
254.176 - | [] => typscheme (the_const_type c))) end;
254.177 + of SOME class => ([(Name.aT, [class])], snd (the_const_typscheme c))
254.178 + | NONE => if is_some (get_datatype_of_constr thy c)
254.179 + then strip_sorts (the_const_typscheme c)
254.180 + else case get_eqns thy c
254.181 + of (thm, _) :: _ => snd (Code_Unit.head_eqn thy (Drule.zero_var_indexes thm))
254.182 + | [] => strip_sorts (the_const_typscheme c) end;
254.183
254.184 end; (*local*)
254.185
255.1 --- a/src/Pure/Isar/code_unit.ML Wed Mar 04 10:43:39 2009 +0100
255.2 +++ b/src/Pure/Isar/code_unit.ML Wed Mar 04 10:45:52 2009 +0100
255.3 @@ -34,7 +34,7 @@
255.4 val constrset_of_consts: theory -> (string * typ) list
255.5 -> string * ((string * sort) list * (string * typ list) list)
255.6
255.7 - (*defining equations*)
255.8 + (*code equations*)
255.9 val assert_eqn: theory -> thm -> thm
255.10 val mk_eqn: theory -> thm -> thm * bool
255.11 val assert_linear: (string -> bool) -> thm * bool -> thm * bool
255.12 @@ -76,10 +76,11 @@
255.13
255.14 fun typscheme thy (c, ty) =
255.15 let
255.16 - fun dest (TVar ((v, 0), sort)) = (v, sort)
255.17 + val ty' = Logic.unvarifyT ty;
255.18 + fun dest (TFree (v, sort)) = (v, sort)
255.19 | dest ty = error ("Illegal type parameter in type scheme: " ^ Syntax.string_of_typ_global thy ty);
255.20 - val vs = map dest (Sign.const_typargs thy (c, ty));
255.21 - in (vs, ty) end;
255.22 + val vs = map dest (Sign.const_typargs thy (c, ty'));
255.23 + in (vs, Type.strip_sorts ty') end;
255.24
255.25 fun inst_thm thy tvars' thm =
255.26 let
255.27 @@ -313,10 +314,10 @@
255.28 val ((tyco, sorts), cs'') = fold add cs' (apsnd single c');
255.29 val vs = Name.names Name.context Name.aT sorts;
255.30 val cs''' = map (inst vs) cs'';
255.31 - in (tyco, (vs, cs''')) end;
255.32 + in (tyco, (vs, rev cs''')) end;
255.33
255.34
255.35 -(* defining equations *)
255.36 +(* code equations *)
255.37
255.38 fun assert_eqn thy thm =
255.39 let
255.40 @@ -351,7 +352,7 @@
255.41 ^ Display.string_of_thm thm)
255.42 | check 0 (Var _) = ()
255.43 | check _ (Var _) = bad_thm
255.44 - ("Variable with application on left hand side of defining equation\n"
255.45 + ("Variable with application on left hand side of code equation\n"
255.46 ^ Display.string_of_thm thm)
255.47 | check n (t1 $ t2) = (check (n+1) t1; check 0 t2)
255.48 | check n (Const (_, ty)) = if n <> (length o fst o strip_type) ty
255.49 @@ -363,7 +364,7 @@
255.50 val ty_decl = Sign.the_const_type thy c;
255.51 val _ = if Sign.typ_equiv thy (Type.strip_sorts ty_decl, Type.strip_sorts ty)
255.52 then () else bad_thm ("Type\n" ^ string_of_typ thy ty
255.53 - ^ "\nof defining equation\n"
255.54 + ^ "\nof code equation\n"
255.55 ^ Display.string_of_thm thm
255.56 ^ "\nis incompatible with declared function type\n"
255.57 ^ string_of_typ thy ty_decl)
255.58 @@ -388,7 +389,7 @@
255.59 fun assert_linear is_cons (thm, false) = (thm, false)
255.60 | assert_linear is_cons (thm, true) = if snd (add_linear (assert_pat is_cons thm)) then (thm, true)
255.61 else bad_thm
255.62 - ("Duplicate variables on left hand side of defining equation:\n"
255.63 + ("Duplicate variables on left hand side of code equation:\n"
255.64 ^ Display.string_of_thm thm);
255.65
255.66
256.1 --- a/src/Pure/Isar/constdefs.ML Wed Mar 04 10:43:39 2009 +0100
256.2 +++ b/src/Pure/Isar/constdefs.ML Wed Mar 04 10:45:52 2009 +0100
256.3 @@ -9,11 +9,9 @@
256.4 signature CONSTDEFS =
256.5 sig
256.6 val add_constdefs: (binding * string option) list *
256.7 - ((binding * string option * mixfix) option *
256.8 - (Attrib.binding * string)) list -> theory -> theory
256.9 + ((binding * string option * mixfix) option * (Attrib.binding * string)) list -> theory -> theory
256.10 val add_constdefs_i: (binding * typ option) list *
256.11 - ((binding * typ option * mixfix) option *
256.12 - ((binding * attribute list) * term)) list -> theory -> theory
256.13 + ((binding * typ option * mixfix) option * (Thm.binding * term)) list -> theory -> theory
256.14 end;
256.15
256.16 structure Constdefs: CONSTDEFS =
256.17 @@ -38,7 +36,7 @@
256.18 val prop = prep_prop var_ctxt raw_prop;
256.19 val (c, T) = #1 (LocalDefs.cert_def thy_ctxt (Logic.strip_imp_concl prop));
256.20 val _ =
256.21 - (case Option.map Binding.base_name d of
256.22 + (case Option.map Binding.name_of d of
256.23 NONE => ()
256.24 | SOME c' =>
256.25 if c <> c' then
256.26 @@ -46,7 +44,7 @@
256.27 else ());
256.28
256.29 val def = Term.subst_atomic [(Free (c, T), Const (Sign.full_bname thy c, T))] prop;
256.30 - val name = Thm.def_name_optional c (Binding.base_name raw_name);
256.31 + val name = Thm.def_name_optional c (Binding.name_of raw_name);
256.32 val atts = map (prep_att thy) raw_atts;
256.33
256.34 val thy' =
257.1 --- a/src/Pure/Isar/element.ML Wed Mar 04 10:43:39 2009 +0100
257.2 +++ b/src/Pure/Isar/element.ML Wed Mar 04 10:45:52 2009 +0100
257.3 @@ -96,7 +96,7 @@
257.4 fun map_ctxt {binding, typ, term, pattern, fact, attrib} =
257.5 fn Fixes fixes => Fixes (fixes |> map (fn (x, T, mx) => (binding x, Option.map typ T, mx)))
257.6 | Constrains xs => Constrains (xs |> map (fn (x, T) =>
257.7 - (Binding.base_name (binding (Binding.name x)), typ T)))
257.8 + (Binding.name_of (binding (Binding.name x)), typ T)))
257.9 | Assumes asms => Assumes (asms |> map (fn ((a, atts), propps) =>
257.10 ((binding a, map attrib atts), propps |> map (fn (t, ps) => (term t, map pattern ps)))))
257.11 | Defines defs => Defines (defs |> map (fn ((a, atts), (t, ps)) =>
257.12 @@ -125,11 +125,9 @@
257.13 map (fn y => Pretty.block [Pretty.str " ", Pretty.keyword sep, Pretty.brk 1, y]) ys;
257.14
257.15 fun pretty_name_atts ctxt (b, atts) sep =
257.16 - let val name = Binding.display b in
257.17 - if name = "" andalso null atts then []
257.18 - else [Pretty.block
257.19 - (Pretty.breaks (Pretty.str name :: Attrib.pretty_attribs ctxt atts @ [Pretty.str sep]))]
257.20 - end;
257.21 + if Binding.is_empty b andalso null atts then []
257.22 + else [Pretty.block (Pretty.breaks
257.23 + (Pretty.str (Binding.str_of b) :: Attrib.pretty_attribs ctxt atts @ [Pretty.str sep]))];
257.24
257.25
257.26 (* pretty_stmt *)
257.27 @@ -145,8 +143,8 @@
257.28 Pretty.block (Pretty.breaks (prt_name_atts a ":" @ prt_terms (map fst ts)));
257.29
257.30 fun prt_var (x, SOME T) = Pretty.block
257.31 - [Pretty.str (Binding.base_name x ^ " ::"), Pretty.brk 1, prt_typ T]
257.32 - | prt_var (x, NONE) = Pretty.str (Binding.base_name x);
257.33 + [Pretty.str (Binding.name_of x ^ " ::"), Pretty.brk 1, prt_typ T]
257.34 + | prt_var (x, NONE) = Pretty.str (Binding.name_of x);
257.35 val prt_vars = separate (Pretty.keyword "and") o map prt_var;
257.36
257.37 fun prt_obtain (_, ([], ts)) = Pretty.block (Pretty.breaks (prt_terms ts))
257.38 @@ -170,9 +168,9 @@
257.39 fun prt_mixfix NoSyn = []
257.40 | prt_mixfix mx = [Pretty.brk 2, Syntax.pretty_mixfix mx];
257.41
257.42 - fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.base_name x ^ " ::") ::
257.43 + fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.name_of x ^ " ::") ::
257.44 Pretty.brk 1 :: prt_typ T :: Pretty.brk 1 :: prt_mixfix mx)
257.45 - | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.base_name x) ::
257.46 + | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.name_of x) ::
257.47 Pretty.brk 1 :: prt_mixfix mx);
257.48 fun prt_constrain (x, T) = prt_fix (Binding.name x, SOME T, NoSyn);
257.49
257.50 @@ -296,7 +294,7 @@
257.51 gen_witness_proof (fn after_qed' => fn propss =>
257.52 Proof.map_context (K goal_ctxt)
257.53 #> Proof.local_goal (ProofDisplay.print_results int) (K I) ProofContext.bind_propp_i
257.54 - cmd NONE after_qed' (map (pair (Binding.empty, [])) propss))
257.55 + cmd NONE after_qed' (map (pair Thm.empty_binding) propss))
257.56 (fn wits => fn _ => after_qed wits) wit_propss [];
257.57
257.58 end;
257.59 @@ -504,7 +502,7 @@
257.60 val defs' = Attrib.map_specs (Attrib.attribute_i (ProofContext.theory_of ctxt)) defs;
257.61 val asms = defs' |> map (fn ((name, atts), (t, ps)) =>
257.62 let val ((c, _), t') = LocalDefs.cert_def ctxt t
257.63 - in (t', ((Binding.map_base (Thm.def_name_optional c) name, atts), [(t', ps)])) end);
257.64 + in (t', ((Binding.map_name (Thm.def_name_optional c) name, atts), [(t', ps)])) end);
257.65 val (_, ctxt') =
257.66 ctxt |> fold (Variable.auto_fixes o #1) asms
257.67 |> ProofContext.add_assms_i LocalDefs.def_export (map #2 asms);
257.68 @@ -529,7 +527,7 @@
257.69
257.70 fun prep_facts prep_name get intern ctxt =
257.71 map_ctxt
257.72 - {binding = Binding.map_base prep_name,
257.73 + {binding = Binding.map_name prep_name,
257.74 typ = I,
257.75 term = I,
257.76 pattern = I,
258.1 --- a/src/Pure/Isar/expression.ML Wed Mar 04 10:43:39 2009 +0100
258.2 +++ b/src/Pure/Isar/expression.ML Wed Mar 04 10:45:52 2009 +0100
258.3 @@ -88,17 +88,13 @@
258.4 if null dups then () else error (message ^ commas dups)
258.5 end;
258.6
258.7 - fun match_bind (n, b) = (n = Binding.base_name b);
258.8 + fun match_bind (n, b) = (n = Binding.name_of b);
258.9 fun parm_eq ((b1, mx1: mixfix), (b2, mx2)) =
258.10 (* FIXME: cannot compare bindings for equality, instead check for equal name and syntax *)
258.11 - (Binding.base_name b1 = Binding.base_name b2) andalso
258.12 - (if mx1 = mx2 then true
258.13 - else error ("Conflicting syntax for parameter" ^ quote (Binding.display b1) ^
258.14 - " in expression."));
258.15 + Binding.name_of b1 = Binding.name_of b2 andalso
258.16 + (mx1 = mx2 orelse
258.17 + error ("Conflicting syntax for parameter " ^ quote (Binding.str_of b1) ^ " in expression"));
258.18
258.19 - fun bind_eq (b1, b2) = (Binding.base_name b1 = Binding.base_name b2);
258.20 - (* FIXME: cannot compare bindings for equality. *)
258.21 -
258.22 fun params_loc loc =
258.23 (Locale.params_of thy loc |> map (fn (p, _, mx) => (p, mx)), loc);
258.24 fun params_inst (expr as (loc, (prfx, Positional insts))) =
258.25 @@ -133,8 +129,8 @@
258.26
258.27 val (implicit, expr') = params_expr expr;
258.28
258.29 - val implicit' = map (#1 #> Binding.base_name) implicit;
258.30 - val fixed' = map (#1 #> Binding.base_name) fixed;
258.31 + val implicit' = map (#1 #> Binding.name_of) implicit;
258.32 + val fixed' = map (#1 #> Binding.name_of) fixed;
258.33 val _ = reject_dups "Duplicate fixed parameter(s): " fixed';
258.34 val implicit'' = if strict then []
258.35 else let val _ = reject_dups
258.36 @@ -310,14 +306,12 @@
258.37 (a, map (fn (t, ps) => (close_frees t, no_binds ps)) propps)))
258.38 | Defines defs => Defines (defs |> map (fn ((name, atts), (t, ps)) =>
258.39 let val ((c, _), t') = LocalDefs.cert_def ctxt (close_frees t)
258.40 - in
258.41 - ((Binding.map_base (Thm.def_name_optional c) name, atts), (t', no_binds ps))
258.42 - end))
258.43 + in ((Binding.map_name (Thm.def_name_optional c) name, atts), (t', no_binds ps)) end))
258.44 | e => e)
258.45 end;
258.46
258.47 fun finish_primitive parms _ (Fixes fixes) = Fixes (map (fn (binding, _, mx) =>
258.48 - let val x = Binding.base_name binding
258.49 + let val x = Binding.name_of binding
258.50 in (binding, AList.lookup (op =) parms x, mx) end) fixes)
258.51 | finish_primitive _ _ (Constrains _) = Constrains []
258.52 | finish_primitive _ close (Assumes asms) = close (Assumes asms)
258.53 @@ -328,7 +322,7 @@
258.54 let
258.55 val thy = ProofContext.theory_of ctxt;
258.56 val (parm_names, parm_types) = Locale.params_of thy loc |>
258.57 - map_split (fn (b, SOME T, _) => (Binding.base_name b, T));
258.58 + map_split (fn (b, SOME T, _) => (Binding.name_of b, T));
258.59 val (morph, _) = inst_morph (parm_names, parm_types) (prfx, inst) ctxt;
258.60 in (loc, morph) end;
258.61
258.62 @@ -360,7 +354,7 @@
258.63 fun prep_insts (loc, (prfx, inst)) (i, insts, ctxt) =
258.64 let
258.65 val (parm_names, parm_types) = Locale.params_of thy loc |>
258.66 - map_split (fn (b, SOME T, _) => (Binding.base_name b, T))
258.67 + map_split (fn (b, SOME T, _) => (Binding.name_of b, T))
258.68 (*FIXME return value of Locale.params_of has strange type*)
258.69 val inst' = prep_inst ctxt parm_names inst;
258.70 val parm_types' = map (TypeInfer.paramify_vars o
258.71 @@ -394,7 +388,7 @@
258.72 prep_concl raw_concl (insts', elems, ctxt5);
258.73
258.74 (* Retrieve parameter types *)
258.75 - val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.base_name o #1) fixes)
258.76 + val xs = fold (fn Fixes fixes => (fn ps => ps @ map (Binding.name_of o #1) fixes)
258.77 | _ => fn ps => ps) (Fixes fors :: elems') [];
258.78 val (Ts, ctxt7) = fold_map ProofContext.inferred_param xs ctxt6;
258.79 val parms = xs ~~ Ts; (* params from expression and elements *)
258.80 @@ -726,14 +720,14 @@
258.81 | defines_to_notes _ e = e;
258.82
258.83 fun gen_add_locale prep_decl
258.84 - bname raw_predicate_bname raw_imprt raw_body thy =
258.85 + bname raw_predicate_bname raw_import raw_body thy =
258.86 let
258.87 val name = Sign.full_bname thy bname;
258.88 val _ = Locale.defined thy name andalso
258.89 error ("Duplicate definition of locale " ^ quote name);
258.90
258.91 val ((fixed, deps, body_elems), (parms, ctxt')) =
258.92 - prep_decl raw_imprt I raw_body (ProofContext.init thy);
258.93 + prep_decl raw_import I raw_body (ProofContext.init thy);
258.94 val text as (((_, exts'), _), defs) = eval ctxt' deps body_elems;
258.95
258.96 val predicate_bname = if raw_predicate_bname = "" then bname
259.1 --- a/src/Pure/Isar/isar_cmd.ML Wed Mar 04 10:43:39 2009 +0100
259.2 +++ b/src/Pure/Isar/isar_cmd.ML Wed Mar 04 10:45:52 2009 +0100
259.3 @@ -32,7 +32,6 @@
259.4 val skip_proof: Toplevel.transition -> Toplevel.transition
259.5 val init_theory: string * string list * (string * bool) list ->
259.6 Toplevel.transition -> Toplevel.transition
259.7 - val welcome: Toplevel.transition -> Toplevel.transition
259.8 val exit: Toplevel.transition -> Toplevel.transition
259.9 val quit: Toplevel.transition -> Toplevel.transition
259.10 val pr: string list * (int option * int option) -> Toplevel.transition -> Toplevel.transition
259.11 @@ -62,10 +61,6 @@
259.12 val class_deps: Toplevel.transition -> Toplevel.transition
259.13 val thy_deps: Toplevel.transition -> Toplevel.transition
259.14 val thm_deps: (Facts.ref * Attrib.src list) list -> Toplevel.transition -> Toplevel.transition
259.15 - val find_theorems: (int option * bool) * (bool * string FindTheorems.criterion) list
259.16 - -> Toplevel.transition -> Toplevel.transition
259.17 - val find_consts: (bool * FindConsts.criterion) list ->
259.18 - Toplevel.transition -> Toplevel.transition
259.19 val unused_thms: (string list * string list option) option ->
259.20 Toplevel.transition -> Toplevel.transition
259.21 val print_binds: Toplevel.transition -> Toplevel.transition
259.22 @@ -166,7 +161,7 @@
259.23 (* axioms *)
259.24
259.25 fun add_axms f args thy =
259.26 - f (map (fn ((b, ax), srcs) => ((Binding.base_name b, ax), map (Attrib.attribute thy) srcs)) args) thy;
259.27 + f (map (fn ((b, ax), srcs) => ((Binding.name_of b, ax), map (Attrib.attribute thy) srcs)) args) thy;
259.28
259.29 val add_axioms = add_axms (snd oo PureThy.add_axioms_cmd);
259.30
259.31 @@ -269,8 +264,6 @@
259.32 if ThyInfo.check_known_thy (Context.theory_name thy)
259.33 then ThyInfo.end_theory thy else ());
259.34
259.35 -val welcome = Toplevel.imperative (writeln o Session.welcome);
259.36 -
259.37 val exit = Toplevel.keep (fn state =>
259.38 (Context.set_thread_data (try Toplevel.generic_theory_of state);
259.39 raise Toplevel.TERMINATE));
259.40 @@ -403,20 +396,9 @@
259.41 |> sort (int_ord o pairself #1) |> map #2;
259.42 in Present.display_graph gr end);
259.43
259.44 -
259.45 -(* retrieve theorems *)
259.46 -
259.47 fun thm_deps args = Toplevel.unknown_theory o Toplevel.keep (fn state =>
259.48 ThmDeps.thm_deps (Proof.get_thmss (Toplevel.enter_proof_body state) args));
259.49
259.50 -fun find_theorems ((opt_lim, rem_dups), spec) =
259.51 - Toplevel.unknown_theory o Toplevel.keep (fn state =>
259.52 - let
259.53 - val proof_state = Toplevel.enter_proof_body state;
259.54 - val ctxt = Proof.context_of proof_state;
259.55 - val opt_goal = try Proof.get_goal proof_state |> Option.map (#2 o #2);
259.56 - in FindTheorems.print_theorems ctxt opt_goal opt_lim rem_dups spec end);
259.57 -
259.58
259.59 (* find unused theorems *)
259.60
259.61 @@ -434,12 +416,6 @@
259.62 |> map pretty_thm |> Pretty.chunks |> Pretty.writeln
259.63 end);
259.64
259.65 -(* retrieve constants *)
259.66 -
259.67 -fun find_consts spec =
259.68 - Toplevel.unknown_theory o Toplevel.keep (fn state =>
259.69 - let val ctxt = (Proof.context_of o Toplevel.enter_proof_body) state
259.70 - in FindConsts.find_consts ctxt spec end);
259.71
259.72 (* print proof context contents *)
259.73
260.1 --- a/src/Pure/Isar/isar_syn.ML Wed Mar 04 10:43:39 2009 +0100
260.2 +++ b/src/Pure/Isar/isar_syn.ML Wed Mar 04 10:45:52 2009 +0100
260.3 @@ -37,6 +37,7 @@
260.4 (Scan.succeed (Toplevel.exit o Toplevel.end_local_theory));
260.5
260.6
260.7 +
260.8 (** markup commands **)
260.9
260.10 val _ = OuterSyntax.markup_command ThyOutput.Markup "header" "theory header" K.diag
260.11 @@ -79,7 +80,7 @@
260.12
260.13
260.14
260.15 -(** theory sections **)
260.16 +(** theory commands **)
260.17
260.18 (* classes and sorts *)
260.19
260.20 @@ -692,7 +693,7 @@
260.21 val _ =
260.22 OuterSyntax.command "finally" "combine calculation and current facts, exhibit result"
260.23 (K.tag_proof K.prf_chain)
260.24 - (calc_args >> (Toplevel.proofs' o Calculation.finally_));
260.25 + (calc_args >> (Toplevel.proofs' o Calculation.finally));
260.26
260.27 val _ =
260.28 OuterSyntax.command "moreover" "augment calculation by current facts"
260.29 @@ -728,39 +729,6 @@
260.30 handle ERROR msg => Scan.fail_with (K msg)));
260.31
260.32
260.33 -(* global history commands *)
260.34 -
260.35 -val _ =
260.36 - OuterSyntax.improper_command "init_toplevel" "init toplevel point-of-interest" K.control
260.37 - (Scan.succeed (Toplevel.no_timing o Toplevel.imperative Isar.init));
260.38 -
260.39 -val _ =
260.40 - OuterSyntax.improper_command "linear_undo" "undo commands" K.control
260.41 - (Scan.optional P.nat 1 >>
260.42 - (fn n => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.linear_undo n)));
260.43 -
260.44 -val _ =
260.45 - OuterSyntax.improper_command "undo" "undo commands (skipping closed proofs)" K.control
260.46 - (Scan.optional P.nat 1 >>
260.47 - (fn n => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.undo n)));
260.48 -
260.49 -val _ =
260.50 - OuterSyntax.improper_command "undos_proof" "undo commands (skipping closed proofs)" K.control
260.51 - (Scan.optional P.nat 1 >> (fn n => Toplevel.no_timing o
260.52 - Toplevel.keep (fn state =>
260.53 - if Toplevel.is_proof state then (Isar.undo n; Isar.print ()) else raise Toplevel.UNDEF)));
260.54 -
260.55 -val _ =
260.56 - OuterSyntax.improper_command "cannot_undo" "partial undo -- Proof General legacy" K.control
260.57 - (P.name >>
260.58 - (fn "end" => Toplevel.no_timing o Toplevel.imperative (fn () => Isar.undo 1)
260.59 - | txt => Toplevel.imperative (fn () => error ("Cannot undo " ^ quote txt))));
260.60 -
260.61 -val _ =
260.62 - OuterSyntax.improper_command "kill" "kill partial proof or theory development" K.control
260.63 - (Scan.succeed (Toplevel.no_timing o Toplevel.imperative Isar.kill));
260.64 -
260.65 -
260.66
260.67 (** diagnostic commands (for interactive mode only) **)
260.68
260.69 @@ -853,47 +821,6 @@
260.70 OuterSyntax.improper_command "thm_deps" "visualize theorem dependencies"
260.71 K.diag (SpecParse.xthms1 >> (Toplevel.no_timing oo IsarCmd.thm_deps));
260.72
260.73 -local
260.74 -
260.75 -val criterion =
260.76 - P.reserved "name" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindTheorems.Name ||
260.77 - P.reserved "intro" >> K FindTheorems.Intro ||
260.78 - P.reserved "elim" >> K FindTheorems.Elim ||
260.79 - P.reserved "dest" >> K FindTheorems.Dest ||
260.80 - P.reserved "solves" >> K FindTheorems.Solves ||
260.81 - P.reserved "simp" |-- P.!!! (P.$$$ ":" |-- P.term) >> FindTheorems.Simp ||
260.82 - P.term >> FindTheorems.Pattern;
260.83 -
260.84 -val options =
260.85 - Scan.optional
260.86 - (P.$$$ "(" |--
260.87 - P.!!! (Scan.option P.nat -- Scan.optional (P.reserved "with_dups" >> K false) true
260.88 - --| P.$$$ ")")) (NONE, true);
260.89 -in
260.90 -
260.91 -val _ =
260.92 - OuterSyntax.improper_command "find_theorems" "print theorems meeting specified criteria" K.diag
260.93 - (options -- Scan.repeat (((Scan.option P.minus >> is_none) -- criterion))
260.94 - >> (Toplevel.no_timing oo IsarCmd.find_theorems));
260.95 -
260.96 -end;
260.97 -
260.98 -local
260.99 -
260.100 -val criterion =
260.101 - P.reserved "strict" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindConsts.Strict ||
260.102 - P.reserved "name" |-- P.!!! (P.$$$ ":" |-- P.xname) >> FindConsts.Name ||
260.103 - P.xname >> FindConsts.Loose;
260.104 -
260.105 -in
260.106 -
260.107 -val _ =
260.108 - OuterSyntax.improper_command "find_consts" "search constants by type pattern"
260.109 - K.diag (Scan.repeat (((Scan.option P.minus >> is_none) -- criterion))
260.110 - >> (Toplevel.no_timing oo IsarCmd.find_consts));
260.111 -
260.112 -end;
260.113 -
260.114 val _ =
260.115 OuterSyntax.improper_command "print_binds" "print term bindings of proof context" K.diag
260.116 (Scan.succeed (Toplevel.no_timing o IsarCmd.print_binds));
260.117 @@ -948,6 +875,7 @@
260.118 (Toplevel.no_timing oo IsarCmd.unused_thms));
260.119
260.120
260.121 +
260.122 (** system commands (for interactive mode only) **)
260.123
260.124 val _ =
260.125 @@ -1013,9 +941,5 @@
260.126 OuterSyntax.improper_command "exit" "exit Isar loop" K.control
260.127 (Scan.succeed (Toplevel.no_timing o IsarCmd.exit));
260.128
260.129 -val _ =
260.130 - OuterSyntax.improper_command "welcome" "print welcome message" K.diag
260.131 - (Scan.succeed (Toplevel.no_timing o IsarCmd.welcome));
260.132 -
260.133 end;
260.134
261.1 --- a/src/Pure/Isar/local_defs.ML Wed Mar 04 10:43:39 2009 +0100
261.2 +++ b/src/Pure/Isar/local_defs.ML Wed Mar 04 10:45:52 2009 +0100
261.3 @@ -11,8 +11,8 @@
261.4 val mk_def: Proof.context -> (string * term) list -> term list
261.5 val expand: cterm list -> thm -> thm
261.6 val def_export: Assumption.export
261.7 - val add_defs: ((binding * mixfix) * ((binding * attribute list) * term)) list ->
261.8 - Proof.context -> (term * (string * thm)) list * Proof.context
261.9 + val add_defs: ((binding * mixfix) * (Thm.binding * term)) list -> Proof.context ->
261.10 + (term * (string * thm)) list * Proof.context
261.11 val add_def: (binding * mixfix) * term -> Proof.context -> (term * thm) * Proof.context
261.12 val fixed_abbrev: (binding * mixfix) * term -> Proof.context ->
261.13 (term * term) * Proof.context
261.14 @@ -90,8 +90,8 @@
261.15 let
261.16 val ((bvars, mxs), specs) = defs |> split_list |>> split_list;
261.17 val ((bfacts, atts), rhss) = specs |> split_list |>> split_list;
261.18 - val xs = map Binding.base_name bvars;
261.19 - val names = map2 (Binding.map_base o Thm.def_name_optional) xs bfacts;
261.20 + val xs = map Binding.name_of bvars;
261.21 + val names = map2 (Binding.map_name o Thm.def_name_optional) xs bfacts;
261.22 val eqs = mk_def ctxt (xs ~~ rhss);
261.23 val lhss = map (fst o Logic.dest_equals) eqs;
261.24 in
261.25 @@ -104,7 +104,7 @@
261.26 end;
261.27
261.28 fun add_def (var, rhs) ctxt =
261.29 - let val ([(lhs, (_, th))], ctxt') = add_defs [(var, ((Binding.empty, []), rhs))] ctxt
261.30 + let val ([(lhs, (_, th))], ctxt') = add_defs [(var, (Thm.empty_binding, rhs))] ctxt
261.31 in ((lhs, th), ctxt') end;
261.32
261.33
262.1 --- a/src/Pure/Isar/locale.ML Wed Mar 04 10:43:39 2009 +0100
262.2 +++ b/src/Pure/Isar/locale.ML Wed Mar 04 10:45:52 2009 +0100
262.3 @@ -194,7 +194,7 @@
262.4 fun axioms_of thy = #axioms o the_locale thy;
262.5
262.6 fun instance_of thy name morph = params_of thy name |>
262.7 - map ((fn (b, T, _) => Free (Binding.base_name b, the T)) #> Morphism.term morph);
262.8 + map ((fn (b, T, _) => Free (Binding.name_of b, the T)) #> Morphism.term morph);
262.9
262.10 fun specification_of thy = #spec o the_locale thy;
262.11
262.12 @@ -464,8 +464,7 @@
262.13 fun decl_attrib decl phi = Thm.declaration_attribute (K (decl phi));
262.14
262.15 fun add_decls add loc decl =
262.16 - ProofContext.theory ((change_locale loc o apfst o apfst) (add (decl, stamp ())))
262.17 - #>
262.18 + ProofContext.theory ((change_locale loc o apfst o apfst) (add (decl, stamp ()))) #>
262.19 add_thmss loc Thm.internalK
262.20 [((Binding.empty, [Attrib.internal (decl_attrib decl)]), [([Drule.dummy_thm], [])])];
262.21
263.1 --- a/src/Pure/Isar/method.ML Wed Mar 04 10:43:39 2009 +0100
263.2 +++ b/src/Pure/Isar/method.ML Wed Mar 04 10:45:52 2009 +0100
263.3 @@ -38,7 +38,7 @@
263.4 val atomize: bool -> method
263.5 val this: method
263.6 val fact: thm list -> Proof.context -> method
263.7 - val assumption_tac: Proof.context -> int -> tactic
263.8 + val assm_tac: Proof.context -> int -> tactic
263.9 val assumption: Proof.context -> method
263.10 val close: bool -> Proof.context -> method
263.11 val trace: Proof.context -> thm list -> unit
263.12 @@ -49,7 +49,6 @@
263.13 val erule: int -> thm list -> method
263.14 val drule: int -> thm list -> method
263.15 val frule: int -> thm list -> method
263.16 - val iprover_tac: Proof.context -> int option -> int -> tactic
263.17 val set_tactic: (thm list -> tactic) -> Proof.context -> Proof.context
263.18 val tactic: string * Position.T -> Proof.context -> method
263.19 val raw_tactic: string * Position.T -> Proof.context -> method
263.20 @@ -225,20 +224,20 @@
263.21
263.22 in
263.23
263.24 -fun assumption_tac ctxt =
263.25 +fun assm_tac ctxt =
263.26 assume_tac APPEND'
263.27 Goal.assume_rule_tac ctxt APPEND'
263.28 cond_rtac (can Logic.dest_equals) Drule.reflexive_thm APPEND'
263.29 cond_rtac (can Logic.dest_term) Drule.termI;
263.30
263.31 fun assumption ctxt = METHOD (HEADGOAL o
263.32 - (fn [] => assumption_tac ctxt
263.33 + (fn [] => assm_tac ctxt
263.34 | [fact] => solve_tac [fact]
263.35 | _ => K no_tac));
263.36
263.37 fun close immed ctxt = METHOD (K
263.38 (FILTER Thm.no_prems
263.39 - ((if immed then ALLGOALS (assumption_tac ctxt) else all_tac) THEN flexflex_tac)));
263.40 + ((if immed then ALLGOALS (assm_tac ctxt) else all_tac) THEN flexflex_tac)));
263.41
263.42 end;
263.43
263.44 @@ -296,55 +295,6 @@
263.45 THEN Tactic.distinct_subgoals_tac;
263.46
263.47
263.48 -(* iprover -- intuitionistic proof search *)
263.49 -
263.50 -local
263.51 -
263.52 -val remdups_tac = SUBGOAL (fn (g, i) =>
263.53 - let val prems = Logic.strip_assums_hyp g in
263.54 - REPEAT_DETERM_N (length prems - length (distinct op aconv prems))
263.55 - (Tactic.ematch_tac [Drule.remdups_rl] i THEN Tactic.eq_assume_tac i)
263.56 - end);
263.57 -
263.58 -fun REMDUPS tac = tac THEN_ALL_NEW remdups_tac;
263.59 -
263.60 -val bires_tac = Tactic.biresolution_from_nets_tac ContextRules.orderlist;
263.61 -
263.62 -fun safe_step_tac ctxt =
263.63 - ContextRules.Swrap ctxt
263.64 - (eq_assume_tac ORELSE'
263.65 - bires_tac true (ContextRules.netpair_bang ctxt));
263.66 -
263.67 -fun unsafe_step_tac ctxt =
263.68 - ContextRules.wrap ctxt
263.69 - (assume_tac APPEND'
263.70 - bires_tac false (ContextRules.netpair_bang ctxt) APPEND'
263.71 - bires_tac false (ContextRules.netpair ctxt));
263.72 -
263.73 -fun step_tac ctxt i =
263.74 - REPEAT_DETERM1 (REMDUPS (safe_step_tac ctxt) i) ORELSE
263.75 - REMDUPS (unsafe_step_tac ctxt) i;
263.76 -
263.77 -fun intprover_tac ctxt gs d lim = SUBGOAL (fn (g, i) => if d > lim then no_tac else
263.78 - let
263.79 - val ps = Logic.strip_assums_hyp g;
263.80 - val c = Logic.strip_assums_concl g;
263.81 - in
263.82 - if member (fn ((ps1, c1), (ps2, c2)) =>
263.83 - c1 aconv c2 andalso
263.84 - length ps1 = length ps2 andalso
263.85 - gen_eq_set (op aconv) (ps1, ps2)) gs (ps, c) then no_tac
263.86 - else (step_tac ctxt THEN_ALL_NEW intprover_tac ctxt ((ps, c) :: gs) (d + 1) lim) i
263.87 - end);
263.88 -
263.89 -in
263.90 -
263.91 -fun iprover_tac ctxt opt_lim =
263.92 - SELECT_GOAL (DEEPEN (2, the_default 20 opt_lim) (intprover_tac ctxt [] 0) 4 1);
263.93 -
263.94 -end;
263.95 -
263.96 -
263.97 (* ML tactics *)
263.98
263.99 structure TacticData = ProofDataFun
263.100 @@ -486,7 +436,7 @@
263.101 local
263.102
263.103 fun thms ss = Scan.repeat (Scan.unless (Scan.lift (Scan.first ss)) Attrib.multi_thm) >> flat;
263.104 -fun app (f, att) (context, ths) = foldl_map att (Context.map_proof f context, ths);
263.105 +fun app (f, att) (context, ths) = Library.foldl_map att (Context.map_proof f context, ths);
263.106
263.107 fun section ss = Scan.depend (fn context => (Scan.first ss -- Scan.pass context (thms ss)) :|--
263.108 (fn (m, ths) => Scan.succeed (app m (context, ths))));
263.109 @@ -511,39 +461,6 @@
263.110 end;
263.111
263.112
263.113 -(* iprover syntax *)
263.114 -
263.115 -local
263.116 -
263.117 -val introN = "intro";
263.118 -val elimN = "elim";
263.119 -val destN = "dest";
263.120 -val ruleN = "rule";
263.121 -
263.122 -fun modifier name kind kind' att =
263.123 - Args.$$$ name |-- (kind >> K NONE || kind' |-- P.nat --| Args.colon >> SOME)
263.124 - >> (pair (I: Proof.context -> Proof.context) o att);
263.125 -
263.126 -val iprover_modifiers =
263.127 - [modifier destN Args.bang_colon Args.bang ContextRules.dest_bang,
263.128 - modifier destN Args.colon (Scan.succeed ()) ContextRules.dest,
263.129 - modifier elimN Args.bang_colon Args.bang ContextRules.elim_bang,
263.130 - modifier elimN Args.colon (Scan.succeed ()) ContextRules.elim,
263.131 - modifier introN Args.bang_colon Args.bang ContextRules.intro_bang,
263.132 - modifier introN Args.colon (Scan.succeed ()) ContextRules.intro,
263.133 - Args.del -- Args.colon >> K (I, ContextRules.rule_del)];
263.134 -
263.135 -in
263.136 -
263.137 -val iprover_meth =
263.138 - bang_sectioned_args' iprover_modifiers (Scan.lift (Scan.option P.nat))
263.139 - (fn n => fn prems => fn ctxt => METHOD (fn facts =>
263.140 - HEADGOAL (insert_tac (prems @ facts) THEN'
263.141 - ObjectLogic.atomize_prems_tac THEN' iprover_tac ctxt n)));
263.142 -
263.143 -end;
263.144 -
263.145 -
263.146 (* tactic syntax *)
263.147
263.148 fun nat_thms_args f = uncurry f oo
263.149 @@ -599,7 +516,6 @@
263.150 ("fold", thms_ctxt_args fold_meth, "fold definitions"),
263.151 ("atomize", (atomize o fst) oo syntax (Args.mode "full"),
263.152 "present local premises as object-level statements"),
263.153 - ("iprover", iprover_meth, "intuitionistic proof search"),
263.154 ("rule", thms_ctxt_args some_rule, "apply some intro/elim rule"),
263.155 ("erule", nat_thms_args erule, "apply rule in elimination manner (improper)"),
263.156 ("drule", nat_thms_args drule, "apply rule in destruct manner (improper)"),
264.1 --- a/src/Pure/Isar/obtain.ML Wed Mar 04 10:43:39 2009 +0100
264.2 +++ b/src/Pure/Isar/obtain.ML Wed Mar 04 10:45:52 2009 +0100
264.3 @@ -40,11 +40,9 @@
264.4 sig
264.5 val thatN: string
264.6 val obtain: string -> (binding * string option * mixfix) list ->
264.7 - (Attrib.binding * (string * string list) list) list ->
264.8 - bool -> Proof.state -> Proof.state
264.9 + (Attrib.binding * (string * string list) list) list -> bool -> Proof.state -> Proof.state
264.10 val obtain_i: string -> (binding * typ option * mixfix) list ->
264.11 - ((binding * attribute list) * (term * term list) list) list ->
264.12 - bool -> Proof.state -> Proof.state
264.13 + (Thm.binding * (term * term list) list) list -> bool -> Proof.state -> Proof.state
264.14 val result: (Proof.context -> tactic) -> thm list -> Proof.context ->
264.15 (cterm list * thm list) * Proof.context
264.16 val guess: (binding * string option * mixfix) list -> bool -> Proof.state -> Proof.state
264.17 @@ -121,7 +119,7 @@
264.18 (*obtain vars*)
264.19 val (vars, vars_ctxt) = prep_vars raw_vars ctxt;
264.20 val (_, fix_ctxt) = vars_ctxt |> ProofContext.add_fixes_i vars;
264.21 - val xs = map (Binding.base_name o #1) vars;
264.22 + val xs = map (Binding.name_of o #1) vars;
264.23
264.24 (*obtain asms*)
264.25 val (asms_ctxt, proppss) = prep_propp (fix_ctxt, map snd raw_asms);
264.26 @@ -155,14 +153,14 @@
264.27 in
264.28 state
264.29 |> Proof.enter_forward
264.30 - |> Proof.have_i NONE (K I) [((Binding.empty, []), [(obtain_prop, [])])] int
264.31 + |> Proof.have_i NONE (K I) [(Thm.empty_binding, [(obtain_prop, [])])] int
264.32 |> Proof.proof (SOME Method.succeed_text) |> Seq.hd
264.33 |> Proof.fix_i [(Binding.name thesisN, NONE, NoSyn)]
264.34 |> Proof.assume_i
264.35 [((Binding.name that_name, [ContextRules.intro_query NONE]), [(that_prop, [])])]
264.36 |> `Proof.the_facts
264.37 ||> Proof.chain_facts chain_facts
264.38 - ||> Proof.show_i NONE after_qed [((Binding.empty, []), [(thesis, [])])] false
264.39 + ||> Proof.show_i NONE after_qed [(Thm.empty_binding, [(thesis, [])])] false
264.40 |-> Proof.refine_insert
264.41 end;
264.42
264.43 @@ -260,7 +258,7 @@
264.44
264.45 fun inferred_type (binding, _, mx) ctxt =
264.46 let
264.47 - val x = Binding.base_name binding;
264.48 + val x = Binding.name_of binding;
264.49 val (T, ctxt') = ProofContext.inferred_param x ctxt
264.50 in ((x, T, mx), ctxt') end;
264.51
264.52 @@ -295,7 +293,7 @@
264.53 |> Proof.map_context (K ctxt')
264.54 |> Proof.fix_i (map (fn ((x, T), mx) => (Binding.name x, SOME T, mx)) parms)
264.55 |> `Proof.context_of |-> (fn fix_ctxt => Proof.assm_i
264.56 - (obtain_export fix_ctxt rule (map cert ts)) [((Binding.empty, []), asms)])
264.57 + (obtain_export fix_ctxt rule (map cert ts)) [(Thm.empty_binding, asms)])
264.58 |> Proof.add_binds_i AutoBind.no_facts
264.59 end;
264.60
264.61 @@ -313,7 +311,7 @@
264.62 |> Proof.fix_i [(Binding.name AutoBind.thesisN, NONE, NoSyn)]
264.63 |> Proof.chain_facts chain_facts
264.64 |> Proof.local_goal print_result (K I) (apsnd (rpair I))
264.65 - "guess" before_qed after_qed [((Binding.empty, []), [Logic.mk_term goal, goal])]
264.66 + "guess" before_qed after_qed [(Thm.empty_binding, [Logic.mk_term goal, goal])]
264.67 |> Proof.refine (Method.primitive_text (K (Goal.init (cert thesis)))) |> Seq.hd
264.68 end;
264.69
265.1 --- a/src/Pure/Isar/outer_parse.ML Wed Mar 04 10:43:39 2009 +0100
265.2 +++ b/src/Pure/Isar/outer_parse.ML Wed Mar 04 10:45:52 2009 +0100
265.3 @@ -228,7 +228,7 @@
265.4 (* names and text *)
265.5
265.6 val name = group "name declaration" (short_ident || sym_ident || string || number);
265.7 -val binding = position name >> Binding.name_pos;
265.8 +val binding = position name >> Binding.make;
265.9 val xname = group "name reference" (short_ident || long_ident || sym_ident || string || number);
265.10 val text = group "text" (short_ident || long_ident || sym_ident || string || number || verbatim);
265.11 val path = group "file name/path specification" name >> Path.explode;
266.1 --- a/src/Pure/Isar/proof.ML Wed Mar 04 10:43:39 2009 +0100
266.2 +++ b/src/Pure/Isar/proof.ML Wed Mar 04 10:45:52 2009 +0100
266.3 @@ -48,23 +48,18 @@
266.4 val assm: Assumption.export ->
266.5 (Attrib.binding * (string * string list) list) list -> state -> state
266.6 val assm_i: Assumption.export ->
266.7 - ((binding * attribute list) * (term * term list) list) list -> state -> state
266.8 + (Thm.binding * (term * term list) list) list -> state -> state
266.9 val assume: (Attrib.binding * (string * string list) list) list -> state -> state
266.10 - val assume_i: ((binding * attribute list) * (term * term list) list) list ->
266.11 - state -> state
266.12 + val assume_i: (Thm.binding * (term * term list) list) list -> state -> state
266.13 val presume: (Attrib.binding * (string * string list) list) list -> state -> state
266.14 - val presume_i: ((binding * attribute list) * (term * term list) list) list ->
266.15 - state -> state
266.16 - val def: (Attrib.binding * ((binding * mixfix) * (string * string list))) list ->
266.17 - state -> state
266.18 - val def_i: ((binding * attribute list) *
266.19 - ((binding * mixfix) * (term * term list))) list -> state -> state
266.20 + val presume_i: (Thm.binding * (term * term list) list) list -> state -> state
266.21 + val def: (Attrib.binding * ((binding * mixfix) * (string * string list))) list -> state -> state
266.22 + val def_i: (Thm.binding * ((binding * mixfix) * (term * term list))) list -> state -> state
266.23 val chain: state -> state
266.24 val chain_facts: thm list -> state -> state
266.25 val get_thmss: state -> (Facts.ref * Attrib.src list) list -> thm list
266.26 val note_thmss: (Attrib.binding * (Facts.ref * Attrib.src list) list) list -> state -> state
266.27 - val note_thmss_i: ((binding * attribute list) *
266.28 - (thm list * attribute list) list) list -> state -> state
266.29 + val note_thmss_i: (Thm.binding * (thm list * attribute list) list) list -> state -> state
266.30 val from_thmss: ((Facts.ref * Attrib.src list) list) list -> state -> state
266.31 val from_thmss_i: ((thm list * attribute list) list) list -> state -> state
266.32 val with_thmss: ((Facts.ref * Attrib.src list) list) list -> state -> state
266.33 @@ -107,11 +102,11 @@
266.34 val have: Method.text option -> (thm list list -> state -> state) ->
266.35 (Attrib.binding * (string * string list) list) list -> bool -> state -> state
266.36 val have_i: Method.text option -> (thm list list -> state -> state) ->
266.37 - ((binding * attribute list) * (term * term list) list) list -> bool -> state -> state
266.38 + (Thm.binding * (term * term list) list) list -> bool -> state -> state
266.39 val show: Method.text option -> (thm list list -> state -> state) ->
266.40 (Attrib.binding * (string * string list) list) list -> bool -> state -> state
266.41 val show_i: Method.text option -> (thm list list -> state -> state) ->
266.42 - ((binding * attribute list) * (term * term list) list) list -> bool -> state -> state
266.43 + (Thm.binding * (term * term list) list) list -> bool -> state -> state
266.44 val schematic_goal: state -> bool
266.45 val is_relevant: state -> bool
266.46 val local_future_proof: (state -> ('a * state) Future.future) ->
267.1 --- a/src/Pure/Isar/proof_context.ML Wed Mar 04 10:43:39 2009 +0100
267.2 +++ b/src/Pure/Isar/proof_context.ML Wed Mar 04 10:45:52 2009 +0100
267.3 @@ -103,12 +103,10 @@
267.4 val sticky_prefix: string -> Proof.context -> Proof.context
267.5 val restore_naming: Proof.context -> Proof.context -> Proof.context
267.6 val reset_naming: Proof.context -> Proof.context
267.7 - val note_thmss: string ->
267.8 - ((binding * attribute list) * (Facts.ref * attribute list) list) list ->
267.9 - Proof.context -> (string * thm list) list * Proof.context
267.10 - val note_thmss_i: string ->
267.11 - ((binding * attribute list) * (thm list * attribute list) list) list ->
267.12 - Proof.context -> (string * thm list) list * Proof.context
267.13 + val note_thmss: string -> (Thm.binding * (Facts.ref * attribute list) list) list ->
267.14 + Proof.context -> (string * thm list) list * Proof.context
267.15 + val note_thmss_i: string -> (Thm.binding * (thm list * attribute list) list) list ->
267.16 + Proof.context -> (string * thm list) list * Proof.context
267.17 val put_thms: bool -> string * thm list option -> Proof.context -> Proof.context
267.18 val read_vars: (binding * string option * mixfix) list -> Proof.context ->
267.19 (binding * typ option * mixfix) list * Proof.context
267.20 @@ -121,10 +119,10 @@
267.21 val auto_fixes: Proof.context * (term list list * 'a) -> Proof.context * (term list list * 'a)
267.22 val bind_fixes: string list -> Proof.context -> (term -> term) * Proof.context
267.23 val add_assms: Assumption.export ->
267.24 - ((binding * attribute list) * (string * string list) list) list ->
267.25 + (Thm.binding * (string * string list) list) list ->
267.26 Proof.context -> (string * thm list) list * Proof.context
267.27 val add_assms_i: Assumption.export ->
267.28 - ((binding * attribute list) * (term * term list) list) list ->
267.29 + (Thm.binding * (term * term list) list) list ->
267.30 Proof.context -> (string * thm list) list * Proof.context
267.31 val add_cases: bool -> (string * RuleCases.T option) list -> Proof.context -> Proof.context
267.32 val apply_case: RuleCases.T -> Proof.context -> (string * term list) list * Proof.context
267.33 @@ -975,7 +973,7 @@
267.34
267.35 val facts = PureThy.name_thmss false pos name (map (apfst (get ctxt)) raw_facts);
267.36 fun app (th, attrs) x =
267.37 - swap (foldl_map (Thm.proof_attributes (surround (Thm.kind k) (attrs @ more_attrs))) (x, th));
267.38 + swap (Library.foldl_map (Thm.proof_attributes (surround (Thm.kind k) (attrs @ more_attrs))) (x, th));
267.39 val (res, ctxt') = fold_map app facts ctxt;
267.40 val thms = PureThy.name_thms false false pos name (flat res);
267.41 val Mode {stmt, ...} = get_mode ctxt;
267.42 @@ -1010,7 +1008,7 @@
267.43 fun prep_vars prep_typ internal =
267.44 fold_map (fn (raw_b, raw_T, raw_mx) => fn ctxt =>
267.45 let
267.46 - val raw_x = Binding.base_name raw_b;
267.47 + val raw_x = Binding.name_of raw_b;
267.48 val (x, mx) = Syntax.const_mixfix raw_x raw_mx;
267.49 val _ = Syntax.is_identifier (no_skolem internal x) orelse
267.50 error ("Illegal variable name: " ^ quote x);
267.51 @@ -1019,7 +1017,7 @@
267.52 if internal then T
267.53 else Type.no_tvars T handle TYPE (msg, _, _) => error msg;
267.54 val opt_T = Option.map (cond_tvars o cert_typ ctxt o prep_typ ctxt) raw_T;
267.55 - val var = (Binding.map_base (K x) raw_b, opt_T, mx);
267.56 + val var = (Binding.map_name (K x) raw_b, opt_T, mx);
267.57 in (var, ctxt |> declare_var (x, opt_T, mx) |> #2) end);
267.58
267.59 in
267.60 @@ -1093,7 +1091,7 @@
267.61 fun add_abbrev mode tags (b, raw_t) ctxt =
267.62 let
267.63 val t0 = cert_term (ctxt |> set_mode mode_abbrev) raw_t
267.64 - handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.display b));
267.65 + handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b));
267.66 val [t] = Variable.exportT_terms (Variable.declare_term t0 ctxt) ctxt [t0];
267.67 val ((lhs, rhs), consts') = consts_of ctxt
267.68 |> Consts.abbreviate (Syntax.pp ctxt) (tsig_of ctxt) (naming_of ctxt) mode tags (b, t);
267.69 @@ -1120,7 +1118,7 @@
267.70 fun gen_fixes prep raw_vars ctxt =
267.71 let
267.72 val (vars, _) = prep raw_vars ctxt;
267.73 - val (xs', ctxt') = Variable.add_fixes (map (Binding.base_name o #1) vars) ctxt;
267.74 + val (xs', ctxt') = Variable.add_fixes (map (Binding.name_of o #1) vars) ctxt;
267.75 val ctxt'' =
267.76 ctxt'
267.77 |> fold_map declare_var (map2 (fn x' => fn (_, T, mx) => (x', T, mx)) xs' vars)
268.1 --- a/src/Pure/Isar/specification.ML Wed Mar 04 10:43:39 2009 +0100
268.2 +++ b/src/Pure/Isar/specification.ML Wed Mar 04 10:45:52 2009 +0100
268.3 @@ -140,7 +140,7 @@
268.4 fun gen_axioms do_print prep raw_vars raw_specs thy =
268.5 let
268.6 val ((vars, specs), _) = prep raw_vars [raw_specs] (ProofContext.init thy);
268.7 - val xs = map (fn ((b, T), _) => (Binding.base_name b, T)) vars;
268.8 + val xs = map (fn ((b, T), _) => (Binding.name_of b, T)) vars;
268.9
268.10 (*consts*)
268.11 val (consts, consts_thy) = thy |> fold_map (Theory.specify_const []) vars;
268.12 @@ -148,8 +148,8 @@
268.13
268.14 (*axioms*)
268.15 val (axioms, axioms_thy) = consts_thy |> fold_map (fn ((b, atts), props) =>
268.16 - fold_map Thm.add_axiom
268.17 - ((map o apfst) Binding.name (PureThy.name_multi (Binding.base_name b) (map subst props)))
268.18 + fold_map Thm.add_axiom (* FIXME proper use of binding!? *)
268.19 + ((map o apfst) Binding.name (PureThy.name_multi (Binding.name_of b) (map subst props)))
268.20 #>> (fn ths => ((b, atts), [(map Drule.standard' ths, [])]))) specs;
268.21 val (facts, thy') = axioms_thy |> PureThy.note_thmss Thm.axiomK
268.22 (Attrib.map_facts (Attrib.attribute_i axioms_thy) axioms);
268.23 @@ -169,19 +169,19 @@
268.24 val (vars, [((raw_name, atts), [prop])]) =
268.25 fst (prep (the_list raw_var) [(raw_a, [raw_prop])] lthy);
268.26 val (((x, T), rhs), prove) = LocalDefs.derived_def lthy true prop;
268.27 - val name = Binding.map_base (Thm.def_name_optional x) raw_name;
268.28 + val name = Binding.map_name (Thm.def_name_optional x) raw_name;
268.29 val var =
268.30 (case vars of
268.31 [] => (Binding.name x, NoSyn)
268.32 | [((b, _), mx)] =>
268.33 let
268.34 - val y = Binding.base_name b;
268.35 + val y = Binding.name_of b;
268.36 val _ = x = y orelse
268.37 error ("Head of definition " ^ quote x ^ " differs from declaration " ^ quote y ^
268.38 Position.str_of (Binding.pos_of b));
268.39 in (b, mx) end);
268.40 val ((lhs, (_, th)), lthy2) = lthy |> LocalTheory.define Thm.definitionK
268.41 - (var, ((Binding.map_base (suffix "_raw") name, []), rhs));
268.42 + (var, ((Binding.map_name (suffix "_raw") name, []), rhs));
268.43 val ((def_name, [th']), lthy3) = lthy2 |> LocalTheory.note Thm.definitionK
268.44 ((name, Code.add_default_eqn_attrib :: atts), [prove lthy2 th]);
268.45
268.46 @@ -208,7 +208,7 @@
268.47 [] => (Binding.name x, NoSyn)
268.48 | [((b, _), mx)] =>
268.49 let
268.50 - val y = Binding.base_name b;
268.51 + val y = Binding.name_of b;
268.52 val _ = x = y orelse
268.53 error ("Head of abbreviation " ^ quote x ^ " differs from declaration " ^ quote y ^
268.54 Position.str_of (Binding.pos_of b));
268.55 @@ -269,11 +269,10 @@
268.56 | Element.Obtains obtains =>
268.57 let
268.58 val case_names = obtains |> map_index (fn (i, (b, _)) =>
268.59 - let val name = Binding.base_name b
268.60 - in if name = "" then string_of_int (i + 1) else name end);
268.61 + if Binding.is_empty b then string_of_int (i + 1) else Binding.name_of b);
268.62 val constraints = obtains |> map (fn (_, (vars, _)) =>
268.63 Element.Constrains
268.64 - (vars |> map_filter (fn (x, SOME T) => SOME (Binding.base_name x, T) | _ => NONE)));
268.65 + (vars |> map_filter (fn (x, SOME T) => SOME (Binding.name_of x, T) | _ => NONE)));
268.66
268.67 val raw_propp = obtains |> map (fn (_, (_, props)) => map (rpair []) props);
268.68 val (propp, elems_ctxt) = prep_stmt (elems @ constraints) raw_propp ctxt;
268.69 @@ -283,7 +282,7 @@
268.70 fun assume_case ((name, (vars, _)), asms) ctxt' =
268.71 let
268.72 val bs = map fst vars;
268.73 - val xs = map Binding.base_name bs;
268.74 + val xs = map Binding.name_of bs;
268.75 val props = map fst asms;
268.76 val (Ts, _) = ctxt'
268.77 |> fold Variable.declare_term props
269.1 --- a/src/Pure/Isar/theory_target.ML Wed Mar 04 10:43:39 2009 +0100
269.2 +++ b/src/Pure/Isar/theory_target.ML Wed Mar 04 10:45:52 2009 +0100
269.3 @@ -13,7 +13,7 @@
269.4 val begin: string -> Proof.context -> local_theory
269.5 val context: xstring -> theory -> local_theory
269.6 val instantiation: string list * (string * sort) list * sort -> theory -> local_theory
269.7 - val instantiation_cmd: xstring list * sort * xstring -> theory -> local_theory
269.8 + val instantiation_cmd: xstring list * xstring list * xstring -> theory -> local_theory
269.9 val overloading: (string * (string * typ) * bool) list -> theory -> local_theory
269.10 val overloading_cmd: (string * string * bool) list -> theory -> local_theory
269.11 end;
269.12 @@ -188,8 +188,8 @@
269.13 val arg = (b', Term.close_schematic_term rhs');
269.14 val similar_body = Type.similar_types (rhs, rhs');
269.15 (* FIXME workaround based on educated guess *)
269.16 - val (prefix', _) = Binding.dest b';
269.17 - val class_global = Binding.base_name b = Binding.base_name b'
269.18 + val (prefix', _, _) = Binding.dest b';
269.19 + val class_global = Binding.name_of b = Binding.name_of b'
269.20 andalso not (null prefix')
269.21 andalso (fst o snd o split_last) prefix' = Class_Target.class_prefix target;
269.22 in
269.23 @@ -206,14 +206,15 @@
269.24 Morphism.form (ProofContext.target_notation true prmode [(lhs', mx)]))))
269.25 end;
269.26
269.27 +fun syntax_error c = error ("Illegal mixfix syntax for overloaded constant " ^ quote c);
269.28 +
269.29 fun declare_const (ta as Target {target, is_locale, is_class, ...}) depends ((b, T), mx) lthy =
269.30 let
269.31 - val c = Binding.base_name b;
269.32 + val c = Binding.name_of b;
269.33 val tags = LocalTheory.group_position_of lthy;
269.34 val xs = filter depends (#1 (ProofContext.inferred_fixes (LocalTheory.target_of lthy)));
269.35 val U = map #2 xs ---> T;
269.36 val (mx1, mx2, mx3) = fork_mixfix ta mx;
269.37 - fun syntax_error c = error ("Illegal mixfix syntax for overloaded constant " ^ quote c);
269.38 val declare_const =
269.39 (case Class_Target.instantiation_param lthy c of
269.40 SOME c' =>
269.41 @@ -241,7 +242,7 @@
269.42
269.43 fun abbrev (ta as Target {target, is_locale, is_class, ...}) prmode ((b, mx), t) lthy =
269.44 let
269.45 - val c = Binding.base_name b;
269.46 + val c = Binding.name_of b;
269.47 val tags = LocalTheory.group_position_of lthy;
269.48 val thy_ctxt = ProofContext.init (ProofContext.theory_of lthy);
269.49 val target_ctxt = LocalTheory.target_of lthy;
269.50 @@ -278,8 +279,8 @@
269.51 val thy = ProofContext.theory_of lthy;
269.52 val thy_ctxt = ProofContext.init thy;
269.53
269.54 - val c = Binding.base_name b;
269.55 - val name' = Binding.map_base (Thm.def_name_optional c) name;
269.56 + val c = Binding.name_of b;
269.57 + val name' = Binding.map_name (Thm.def_name_optional c) name;
269.58 val (rhs', rhs_conv) =
269.59 LocalDefs.export_cterm lthy thy_ctxt (Thm.cterm_of thy rhs) |>> Thm.term_of;
269.60 val xs = Variable.add_fixed (LocalTheory.target_of lthy) rhs' [];
269.61 @@ -299,7 +300,7 @@
269.62 then (fn name => fn eq => Thm.add_def false false (Binding.name name, Logic.mk_equals eq))
269.63 else (fn name => fn (Const (c, _), rhs) => AxClass.define_overloaded name (c, rhs)));
269.64 val (global_def, lthy3) = lthy2
269.65 - |> LocalTheory.theory_result (define_const (Binding.base_name name') (lhs', rhs'));
269.66 + |> LocalTheory.theory_result (define_const (Binding.name_of name') (lhs', rhs'));
269.67 val def = LocalDefs.trans_terms lthy3
269.68 [(*c == global.c xs*) local_def,
269.69 (*global.c xs == rhs'*) global_def,
270.1 --- a/src/Pure/ML-Systems/mosml.ML Wed Mar 04 10:43:39 2009 +0100
270.2 +++ b/src/Pure/ML-Systems/mosml.ML Wed Mar 04 10:45:52 2009 +0100
270.3 @@ -141,19 +141,19 @@
270.4 load "Timer";
270.5
270.6 fun start_timing () =
270.7 - let val CPUtimer = Timer.startCPUTimer();
270.8 - val time = Timer.checkCPUTimer(CPUtimer)
270.9 - in (CPUtimer,time) end;
270.10 + let
270.11 + val timer = Timer.startCPUTimer ();
270.12 + val time = Timer.checkCPUTimer timer;
270.13 + in (timer, time) end;
270.14
270.15 -fun end_timing (CPUtimer, {gc,sys,usr}) =
270.16 - let open Time (*...for Time.toString, Time.+ and Time.- *)
270.17 - val {gc=gc2,sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
270.18 - in "User " ^ toString (usr2-usr) ^
270.19 - " GC " ^ toString (gc2-gc) ^
270.20 - " All "^ toString (sys2-sys + usr2-usr + gc2-gc) ^
270.21 - " secs"
270.22 - handle Time => ""
270.23 - end;
270.24 +fun end_timing (timer, {gc, sys, usr}) =
270.25 + let
270.26 + open Time; (*...for Time.toString, Time.+ and Time.- *)
270.27 + val {gc = gc2, sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
270.28 + val user = usr2 - usr + gc2 - gc;
270.29 + val all = user + sys2 - sys;
270.30 + val message = "User " ^ toString user ^ " All "^ toString all ^ " secs" handle Time => "";
270.31 + in {message = message, user = user, all = all} end;
270.32
270.33 fun check_timer timer =
270.34 let val {sys, usr, gc} = Timer.checkCPUTimer timer
271.1 --- a/src/Pure/ML-Systems/polyml-experimental.ML Wed Mar 04 10:43:39 2009 +0100
271.2 +++ b/src/Pure/ML-Systems/polyml-experimental.ML Wed Mar 04 10:45:52 2009 +0100
271.3 @@ -49,16 +49,17 @@
271.4 | c :: cs =>
271.5 (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
271.6 fun put s = out_buffer := s :: ! out_buffer;
271.7 - fun put_message (prt, is_err, {file, line, offset}) =
271.8 - (put (if is_err then "Error: " else "Warning: ");
271.9 - PolyML.prettyPrint (put, 76) prt;
271.10 + fun put_message {message, hard, location = {startLine = line, ...}, context} =
271.11 + (put (if hard then "Error: " else "Warning: ");
271.12 + PolyML.prettyPrint (put, 76) message;
271.13 put (str_of_pos line name ^ "\n"));
271.14
271.15 val parameters =
271.16 [PolyML.Compiler.CPOutStream put,
271.17 PolyML.Compiler.CPLineNo (fn () => ! current_line),
271.18 PolyML.Compiler.CPErrorMessageProc put_message,
271.19 - PolyML.Compiler.CPNameSpace name_space];
271.20 + PolyML.Compiler.CPNameSpace name_space,
271.21 + PolyML.Compiler.CPPrintInAlphabeticalOrder false];
271.22 val _ =
271.23 (while not (List.null (! in_buffer)) do
271.24 PolyML.compiler (get, parameters) ())
272.1 --- a/src/Pure/ML-Systems/polyml_common.ML Wed Mar 04 10:43:39 2009 +0100
272.2 +++ b/src/Pure/ML-Systems/polyml_common.ML Wed Mar 04 10:45:52 2009 +0100
272.3 @@ -47,18 +47,19 @@
272.4 (* compiler-independent timing functions *)
272.5
272.6 fun start_timing () =
272.7 - let val CPUtimer = Timer.startCPUTimer();
272.8 - val time = Timer.checkCPUTimer(CPUtimer)
272.9 - in (CPUtimer,time) end;
272.10 + let
272.11 + val timer = Timer.startCPUTimer ();
272.12 + val time = Timer.checkCPUTimer timer;
272.13 + in (timer, time) end;
272.14
272.15 -fun end_timing (CPUtimer, {sys,usr}) =
272.16 - let open Time (*...for Time.toString, Time.+ and Time.- *)
272.17 - val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
272.18 - in "User " ^ toString (usr2-usr) ^
272.19 - " All "^ toString (sys2-sys + usr2-usr) ^
272.20 - " secs"
272.21 - handle Time => ""
272.22 - end;
272.23 +fun end_timing (timer, {sys, usr}) =
272.24 + let
272.25 + open Time; (*...for Time.toString, Time.+ and Time.- *)
272.26 + val {sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
272.27 + val user = usr2 - usr;
272.28 + val all = user + sys2 - sys;
272.29 + val message = "User " ^ toString user ^ " All "^ toString all ^ " secs" handle Time => "";
272.30 + in {message = message, user = user, all = all} end;
272.31
272.32 fun check_timer timer =
272.33 let
273.1 --- a/src/Pure/ML-Systems/smlnj.ML Wed Mar 04 10:43:39 2009 +0100
273.2 +++ b/src/Pure/ML-Systems/smlnj.ML Wed Mar 04 10:45:52 2009 +0100
273.3 @@ -59,18 +59,19 @@
273.4 (* compiler-independent timing functions *)
273.5
273.6 fun start_timing () =
273.7 - let val CPUtimer = Timer.startCPUTimer();
273.8 - val time = Timer.checkCPUTimer(CPUtimer)
273.9 - in (CPUtimer,time) end;
273.10 + let
273.11 + val timer = Timer.startCPUTimer ();
273.12 + val time = Timer.checkCPUTimer timer;
273.13 + in (timer, time) end;
273.14
273.15 -fun end_timing (CPUtimer, {sys,usr}) =
273.16 - let open Time (*...for Time.toString, Time.+ and Time.- *)
273.17 - val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
273.18 - in "User " ^ toString (usr2-usr) ^
273.19 - " All "^ toString (sys2-sys + usr2-usr) ^
273.20 - " secs"
273.21 - handle Time => ""
273.22 - end;
273.23 +fun end_timing (timer, {sys, usr}) =
273.24 + let
273.25 + open Time; (*...for Time.toString, Time.+ and Time.- *)
273.26 + val {sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
273.27 + val user = usr2 - usr;
273.28 + val all = user + sys2 - sys;
273.29 + val message = "User " ^ toString user ^ " All "^ toString all ^ " secs" handle Time => "";
273.30 + in {message = message, user = user, all = all} end;
273.31
273.32 fun check_timer timer =
273.33 let
274.1 --- a/src/Pure/ML/ml_antiquote.ML Wed Mar 04 10:43:39 2009 +0100
274.2 +++ b/src/Pure/ML/ml_antiquote.ML Wed Mar 04 10:45:52 2009 +0100
274.3 @@ -59,12 +59,13 @@
274.4
274.5
274.6
274.7 -(** concrete antiquotations **)
274.8 +(** misc antiquotations **)
274.9
274.10 structure P = OuterParse;
274.11
274.12 -
274.13 -(* misc *)
274.14 +val _ = inline "binding" (Scan.lift (P.position Args.name) >> (fn b =>
274.15 + ML_Syntax.atomic ("Binding.make " ^
274.16 + ML_Syntax.print_pair ML_Syntax.print_string ML_Syntax.print_position b)));
274.17
274.18 val _ = value "theory"
274.19 (Scan.lift Args.name >> (fn name => "ThyInfo.get_theory " ^ ML_Syntax.print_string name)
275.1 --- a/src/Pure/ML/ml_syntax.ML Wed Mar 04 10:43:39 2009 +0100
275.2 +++ b/src/Pure/ML/ml_syntax.ML Wed Mar 04 10:45:52 2009 +0100
275.3 @@ -18,6 +18,8 @@
275.4 val print_char: string -> string
275.5 val print_string: string -> string
275.6 val print_strings: string list -> string
275.7 + val print_properties: Properties.T -> string
275.8 + val print_position: Position.T -> string
275.9 val print_indexname: indexname -> string
275.10 val print_class: class -> string
275.11 val print_sort: sort -> string
275.12 @@ -68,6 +70,9 @@
275.13 val print_string = quote o translate_string print_char;
275.14 val print_strings = print_list print_string;
275.15
275.16 +val print_properties = print_list (print_pair print_string print_string);
275.17 +fun print_position pos = "Position.of_properties " ^ print_properties (Position.properties_of pos);
275.18 +
275.19 val print_indexname = print_pair print_string print_int;
275.20
275.21 val print_class = print_string;
276.1 --- a/src/Pure/Proof/proofchecker.ML Wed Mar 04 10:43:39 2009 +0100
276.2 +++ b/src/Pure/Proof/proofchecker.ML Wed Mar 04 10:45:52 2009 +0100
276.3 @@ -56,7 +56,7 @@
276.4 | thm_of _ _ (PAxm (name, _, SOME Ts)) =
276.5 thm_of_atom (Thm.axiom thy name) Ts
276.6
276.7 - | thm_of _ Hs (PBound i) = List.nth (Hs, i)
276.8 + | thm_of _ Hs (PBound i) = nth Hs i
276.9
276.10 | thm_of (vs, names) Hs (Abst (s, SOME T, prf)) =
276.11 let
277.1 --- a/src/Pure/Proof/reconstruct.ML Wed Mar 04 10:43:39 2009 +0100
277.2 +++ b/src/Pure/Proof/reconstruct.ML Wed Mar 04 10:45:52 2009 +0100
277.3 @@ -98,7 +98,7 @@
277.4 let val (env3, V) = mk_tvar (env2, [])
277.5 in (t' $ u', V, vTs2, unifyT thy env3 T (U --> V)) end)
277.6 end
277.7 - | infer_type thy env Ts vTs (t as Bound i) = ((t, List.nth (Ts, i), vTs, env)
277.8 + | infer_type thy env Ts vTs (t as Bound i) = ((t, nth Ts i, vTs, env)
277.9 handle Subscript => error ("infer_type: bad variable index " ^ string_of_int i));
277.10
277.11 fun cantunify thy (t, u) = error ("Non-unifiable terms:\n" ^
277.12 @@ -106,7 +106,7 @@
277.13
277.14 fun decompose thy Ts (env, p as (t, u)) =
277.15 let fun rigrig (a, T) (b, U) uT ts us = if a <> b then cantunify thy p
277.16 - else apsnd flat (foldl_map (decompose thy Ts) (uT env T U, ts ~~ us))
277.17 + else apsnd flat (Library.foldl_map (decompose thy Ts) (uT env T U, ts ~~ us))
277.18 in case pairself (strip_comb o Envir.head_norm env) p of
277.19 ((Const c, ts), (Const d, us)) => rigrig c d (unifyT thy) ts us
277.20 | ((Free c, ts), (Free d, us)) => rigrig c d (unifyT thy) ts us
277.21 @@ -141,7 +141,7 @@
277.22 val tvars = OldTerm.term_tvars prop;
277.23 val tfrees = OldTerm.term_tfrees prop;
277.24 val (env', Ts) = (case opTs of
277.25 - NONE => foldl_map mk_tvar (env, map snd tvars @ map snd tfrees)
277.26 + NONE => Library.foldl_map mk_tvar (env, map snd tvars @ map snd tfrees)
277.27 | SOME Ts => (env, Ts));
277.28 val prop' = subst_atomic_types (map TVar tvars @ map TFree tfrees ~~ Ts)
277.29 (forall_intr_vfs prop) handle Library.UnequalLengths =>
277.30 @@ -152,7 +152,7 @@
277.31 fun head_norm (prop, prf, cnstrts, env, vTs) =
277.32 (Envir.head_norm env prop, prf, cnstrts, env, vTs);
277.33
277.34 - fun mk_cnstrts env _ Hs vTs (PBound i) = ((List.nth (Hs, i), PBound i, [], env, vTs)
277.35 + fun mk_cnstrts env _ Hs vTs (PBound i) = ((nth Hs i, PBound i, [], env, vTs)
277.36 handle Subscript => error ("mk_cnstrts: bad variable index " ^ string_of_int i))
277.37 | mk_cnstrts env Ts Hs vTs (Abst (s, opT, cprf)) =
277.38 let
277.39 @@ -304,7 +304,7 @@
277.40
277.41 val head_norm = Envir.head_norm (Envir.empty 0);
277.42
277.43 -fun prop_of0 Hs (PBound i) = List.nth (Hs, i)
277.44 +fun prop_of0 Hs (PBound i) = nth Hs i
277.45 | prop_of0 Hs (Abst (s, SOME T, prf)) =
277.46 Term.all T $ (Abs (s, T, prop_of0 Hs prf))
277.47 | prop_of0 Hs (AbsP (s, SOME t, prf)) =
278.1 --- a/src/Pure/ProofGeneral/README Wed Mar 04 10:43:39 2009 +0100
278.2 +++ b/src/Pure/ProofGeneral/README Wed Mar 04 10:45:52 2009 +0100
278.3 @@ -34,4 +34,4 @@
278.4 http://proofgeneral.inf.ed.ac.uk/wiki/Main/PGIP
278.5
278.6 David Aspinall, Dec. 2006.
278.7 -$Id$
278.8 +
279.1 --- a/src/Pure/README Wed Mar 04 10:43:39 2009 +0100
279.2 +++ b/src/Pure/README Wed Mar 04 10:45:52 2009 +0100
279.3 @@ -19,5 +19,3 @@
279.4
279.5 See ROOT.ML for further information.
279.6
279.7 -
279.8 -$Id$
280.1 --- a/src/Pure/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
280.2 +++ b/src/Pure/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
280.3 @@ -81,12 +81,18 @@
280.4 use "goal.ML";
280.5 use "axclass.ML";
280.6
280.7 -(*the main Isar system*)
280.8 +(*main Isar stuff*)
280.9 cd "Isar"; use "ROOT.ML"; cd "..";
280.10 use "subgoal.ML";
280.11
280.12 use "Proof/extraction.ML";
280.13
280.14 +(*Isabelle/Isar system*)
280.15 +use "System/session.ML";
280.16 +use "System/isar.ML";
280.17 +use "System/isabelle_process.ML";
280.18 +
280.19 +(*additional tools*)
280.20 cd "Tools"; use "ROOT.ML"; cd "..";
280.21
280.22 use "codegen.ML";
281.1 --- a/src/Pure/Syntax/parser.ML Wed Mar 04 10:43:39 2009 +0100
281.2 +++ b/src/Pure/Syntax/parser.ML Wed Mar 04 10:45:52 2009 +0100
281.3 @@ -73,10 +73,10 @@
281.4 val chain_from = case (pri, rhs) of (~1, [Nonterminal (id, ~1)]) => SOME id | _ => NONE;
281.5
281.6 (*store chain if it does not already exist*)
281.7 - val (new_chain, chains') = case chain_from of NONE => (NONE, chains) | SOME from_ =>
281.8 - let val old_tos = these (AList.lookup (op =) chains from_) in
281.9 + val (new_chain, chains') = case chain_from of NONE => (NONE, chains) | SOME from =>
281.10 + let val old_tos = these (AList.lookup (op =) chains from) in
281.11 if member (op =) old_tos lhs then (NONE, chains)
281.12 - else (SOME from_, AList.update (op =) (from_, insert (op =) lhs old_tos) chains)
281.13 + else (SOME from, AList.update (op =) (from, insert (op =) lhs old_tos) chains)
281.14 end;
281.15
281.16 (*propagate new chain in lookahead and lambda lists;
281.17 @@ -410,7 +410,7 @@
281.18
281.19 fun pretty_nt (name, tag) =
281.20 let
281.21 - fun prod_of_chain from_ = ([Nonterminal (from_, ~1)], "", ~1);
281.22 + fun prod_of_chain from = ([Nonterminal (from, ~1)], "", ~1);
281.23
281.24 val nt_prods =
281.25 Library.foldl (gen_union op =) ([], map snd (snd (Array.sub (prods, tag)))) @
281.26 @@ -552,8 +552,8 @@
281.27 val to_tag = convert_tag to;
281.28
281.29 fun make [] result = result
281.30 - | make (from_ :: froms) result = make froms ((to_tag,
281.31 - ([Nonterminal (convert_tag from_, ~1)], "", ~1)) :: result);
281.32 + | make (from :: froms) result = make froms ((to_tag,
281.33 + ([Nonterminal (convert_tag from, ~1)], "", ~1)) :: result);
281.34 in mk_chain_prods cs (make froms [] @ result) end;
281.35
281.36 val chain_prods = mk_chain_prods chains2 [];
282.1 --- a/src/Pure/Syntax/syn_ext.ML Wed Mar 04 10:43:39 2009 +0100
282.2 +++ b/src/Pure/Syntax/syn_ext.ML Wed Mar 04 10:45:52 2009 +0100
282.3 @@ -26,7 +26,7 @@
282.4 val logic: string
282.5 val args: string
282.6 val cargs: string
282.7 - val any_: string
282.8 + val any: string
282.9 val sprop: string
282.10 val typ_to_nonterm: typ -> string
282.11 datatype xsymb =
282.12 @@ -108,8 +108,8 @@
282.13 val sprop = "#prop";
282.14 val spropT = Type (sprop, []);
282.15
282.16 -val any_ = "any";
282.17 -val anyT = Type (any_, []);
282.18 +val any = "any";
282.19 +val anyT = Type (any, []);
282.20
282.21
282.22
282.23 @@ -181,7 +181,7 @@
282.24 | typ_to_nt default _ = default;
282.25
282.26 (*get nonterminal for rhs*)
282.27 -val typ_to_nonterm = typ_to_nt any_;
282.28 +val typ_to_nonterm = typ_to_nt any;
282.29
282.30 (*get nonterminal for lhs*)
282.31 val typ_to_nonterm1 = typ_to_nt logic;
283.1 --- a/src/Pure/Syntax/syn_trans.ML Wed Mar 04 10:43:39 2009 +0100
283.2 +++ b/src/Pure/Syntax/syn_trans.ML Wed Mar 04 10:45:52 2009 +0100
283.3 @@ -222,7 +222,7 @@
283.4 (* implicit structures *)
283.5
283.6 fun the_struct structs i =
283.7 - if 1 <= i andalso i <= length structs then List.nth (structs, i - 1)
283.8 + if 1 <= i andalso i <= length structs then nth structs (i - 1)
283.9 else raise error ("Illegal reference to implicit structure #" ^ string_of_int i);
283.10
283.11 fun struct_tr structs (*"_struct"*) [Const ("_indexdefault", _)] =
284.1 --- a/src/Pure/Syntax/syntax.ML Wed Mar 04 10:43:39 2009 +0100
284.2 +++ b/src/Pure/Syntax/syntax.ML Wed Mar 04 10:45:52 2009 +0100
284.3 @@ -390,7 +390,7 @@
284.4 val basic_nonterms =
284.5 (Lexicon.terminals @ [SynExt.logic, "type", "types", "sort", "classes",
284.6 SynExt.args, SynExt.cargs, "pttrn", "pttrns", "idt", "idts", "aprop",
284.7 - "asms", SynExt.any_, SynExt.sprop, "num_const", "float_const",
284.8 + "asms", SynExt.any, SynExt.sprop, "num_const", "float_const",
284.9 "index", "struct"]);
284.10
284.11
285.1 --- a/src/Pure/Thy/thy_output.ML Wed Mar 04 10:43:39 2009 +0100
285.2 +++ b/src/Pure/Thy/thy_output.ML Wed Mar 04 10:45:52 2009 +0100
285.3 @@ -519,9 +519,9 @@
285.4 fun ml_type txt = "val _ = NONE : (" ^ txt ^ ") option;";
285.5 fun ml_struct txt = "functor DUMMY_FUNCTOR() = struct structure DUMMY = " ^ txt ^ " end;"
285.6
285.7 -fun output_ml ml src ctxt (txt, pos) =
285.8 +fun output_ml ml _ ctxt (txt, pos) =
285.9 (ML_Context.eval_in (SOME ctxt) false pos (ml txt);
285.10 - (if ! source then str_of_source src else SymbolPos.content (SymbolPos.explode (txt, pos)))
285.11 + SymbolPos.content (SymbolPos.explode (txt, pos))
285.12 |> (if ! quotes then quote else I)
285.13 |> (if ! display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
285.14 else
286.1 --- a/src/Pure/Tools/ROOT.ML Wed Mar 04 10:43:39 2009 +0100
286.2 +++ b/src/Pure/Tools/ROOT.ML Wed Mar 04 10:45:52 2009 +0100
286.3 @@ -4,11 +4,13 @@
286.4 *)
286.5
286.6 use "named_thms.ML";
286.7 -use "isabelle_process.ML";
286.8
286.9 (*basic XML support*)
286.10 use "xml_syntax.ML";
286.11
286.12 +use "find_theorems.ML";
286.13 +use "find_consts.ML";
286.14 +
286.15 (*quickcheck/autosolve needed here because of pg preferences*)
286.16 use "../../Tools/quickcheck.ML";
286.17 use "../../Tools/auto_solve.ML";
287.1 --- a/src/Pure/axclass.ML Wed Mar 04 10:43:39 2009 +0100
287.2 +++ b/src/Pure/axclass.ML Wed Mar 04 10:45:52 2009 +0100
287.3 @@ -8,7 +8,7 @@
287.4 signature AX_CLASS =
287.5 sig
287.6 val define_class: bstring * class list -> string list ->
287.7 - ((binding * attribute list) * term list) list -> theory -> class * theory
287.8 + (Thm.binding * term list) list -> theory -> class * theory
287.9 val add_classrel: thm -> theory -> theory
287.10 val add_arity: thm -> theory -> theory
287.11 val prove_classrel: class * class -> tactic -> theory -> theory
288.1 --- a/src/Pure/conv.ML Wed Mar 04 10:43:39 2009 +0100
288.2 +++ b/src/Pure/conv.ML Wed Mar 04 10:45:52 2009 +0100
288.3 @@ -7,12 +7,17 @@
288.4 infix 1 then_conv;
288.5 infix 0 else_conv;
288.6
288.7 +signature BASIC_CONV =
288.8 +sig
288.9 + val then_conv: conv * conv -> conv
288.10 + val else_conv: conv * conv -> conv
288.11 +end;
288.12 +
288.13 signature CONV =
288.14 sig
288.15 + include BASIC_CONV
288.16 val no_conv: conv
288.17 val all_conv: conv
288.18 - val then_conv: conv * conv -> conv
288.19 - val else_conv: conv * conv -> conv
288.20 val first_conv: conv list -> conv
288.21 val every_conv: conv list -> conv
288.22 val try_conv: conv -> conv
288.23 @@ -171,3 +176,6 @@
288.24 | NONE => raise THM ("gconv_rule", i, [th]));
288.25
288.26 end;
288.27 +
288.28 +structure BasicConv: BASIC_CONV = Conv;
288.29 +open BasicConv;
289.1 --- a/src/Pure/display.ML Wed Mar 04 10:43:39 2009 +0100
289.2 +++ b/src/Pure/display.ML Wed Mar 04 10:45:52 2009 +0100
289.3 @@ -20,7 +20,6 @@
289.4 val pretty_thm_aux: Pretty.pp -> bool -> bool -> term list -> thm -> Pretty.T
289.5 val pretty_thm: thm -> Pretty.T
289.6 val string_of_thm: thm -> string
289.7 - val pretty_fact: Facts.ref * thm -> Pretty.T
289.8 val pretty_thms: thm list -> Pretty.T
289.9 val pretty_thm_sg: theory -> thm -> Pretty.T
289.10 val pretty_thms_sg: theory -> thm list -> Pretty.T
289.11 @@ -93,10 +92,6 @@
289.12
289.13 val string_of_thm = Pretty.string_of o pretty_thm;
289.14
289.15 -fun pretty_fact (thmref, thm) = Pretty.block
289.16 - [Pretty.str (Facts.string_of_ref thmref), Pretty.str ":", Pretty.brk 1,
289.17 - pretty_thm thm];
289.18 -
289.19 fun pretty_thms [th] = pretty_thm th
289.20 | pretty_thms ths = Pretty.block (Pretty.fbreaks (map pretty_thm ths));
289.21
290.1 --- a/src/Pure/envir.ML Wed Mar 04 10:43:39 2009 +0100
290.2 +++ b/src/Pure/envir.ML Wed Mar 04 10:45:52 2009 +0100
290.3 @@ -265,7 +265,7 @@
290.4 | fast Ts (Const (_, T)) = T
290.5 | fast Ts (Free (_, T)) = T
290.6 | fast Ts (Bound i) =
290.7 - (List.nth (Ts, i)
290.8 + (nth Ts i
290.9 handle Subscript => raise TERM ("fastype: Bound", [Bound i]))
290.10 | fast Ts (Var (_, T)) = T
290.11 | fast Ts (Abs (_, T, u)) = T --> fast (T :: Ts) u
291.1 --- a/src/Pure/library.ML Wed Mar 04 10:43:39 2009 +0100
291.2 +++ b/src/Pure/library.ML Wed Mar 04 10:45:52 2009 +0100
291.3 @@ -76,7 +76,6 @@
291.4 val perhaps_loop: ('a -> 'a option) -> 'a -> 'a option
291.5 val foldl1: ('a * 'a -> 'a) -> 'a list -> 'a
291.6 val foldr1: ('a * 'a -> 'a) -> 'a list -> 'a
291.7 - val foldl_map: ('a * 'b -> 'a * 'c) -> 'a * 'b list -> 'a * 'c list
291.8 val flat: 'a list list -> 'a list
291.9 val unflat: 'a list list -> 'b list -> 'b list list
291.10 val burrow: ('a list -> 'b list) -> 'a list list -> 'b list list
291.11 @@ -238,6 +237,7 @@
291.12 include BASIC_LIBRARY
291.13 val foldl: ('a * 'b -> 'a) -> 'a * 'b list -> 'a
291.14 val foldr: ('a * 'b -> 'b) -> 'a list * 'b -> 'b
291.15 + val foldl_map: ('a * 'b -> 'a * 'c) -> 'a * 'b list -> 'a * 'c list
291.16 val take: int * 'a list -> 'a list
291.17 val drop: int * 'a list -> 'a list
291.18 val last_elem: 'a list -> 'a
292.1 --- a/src/Pure/mk Wed Mar 04 10:43:39 2009 +0100
292.2 +++ b/src/Pure/mk Wed Mar 04 10:45:52 2009 +0100
292.3 @@ -1,6 +1,5 @@
292.4 #!/usr/bin/env bash
292.5 #
292.6 -# $Id$
292.7 # Author: Markus Wenzel, TU Muenchen
292.8 #
292.9 # mk - build Pure Isabelle.
293.1 --- a/src/Pure/more_thm.ML Wed Mar 04 10:43:39 2009 +0100
293.2 +++ b/src/Pure/more_thm.ML Wed Mar 04 10:45:52 2009 +0100
293.3 @@ -40,6 +40,8 @@
293.4 val close_derivation: thm -> thm
293.5 val add_axiom: binding * term -> theory -> thm * theory
293.6 val add_def: bool -> bool -> binding * term -> theory -> thm * theory
293.7 + type binding = binding * attribute list
293.8 + val empty_binding: binding
293.9 val rule_attribute: (Context.generic -> thm -> thm) -> attribute
293.10 val declaration_attribute: (thm -> Context.generic -> Context.generic) -> attribute
293.11 val theory_attributes: attribute list -> theory * thm -> theory * thm
293.12 @@ -301,6 +303,9 @@
293.13
293.14 (** attributes **)
293.15
293.16 +type binding = binding * attribute list;
293.17 +val empty_binding: binding = (Binding.empty, []);
293.18 +
293.19 fun rule_attribute f (x, th) = (x, f x th);
293.20 fun declaration_attribute f (x, th) = (f th x, th);
293.21
294.1 --- a/src/Pure/proofterm.ML Wed Mar 04 10:43:39 2009 +0100
294.2 +++ b/src/Pure/proofterm.ML Wed Mar 04 10:45:52 2009 +0100
294.3 @@ -470,8 +470,8 @@
294.4 val n = length args;
294.5 fun subst' lev (Bound i) =
294.6 (if i<lev then raise SAME (*var is locally bound*)
294.7 - else incr_boundvars lev (List.nth (args, i-lev))
294.8 - handle Subscript => Bound (i-n) (*loose: change it*))
294.9 + else incr_boundvars lev (nth args (i-lev))
294.10 + handle Subscript => Bound (i-n)) (*loose: change it*)
294.11 | subst' lev (Abs (a, T, body)) = Abs (a, T, subst' (lev+1) body)
294.12 | subst' lev (f $ t) = (subst' lev f $ substh' lev t
294.13 handle SAME => f $ subst' lev t)
294.14 @@ -494,7 +494,7 @@
294.15 val n = length args;
294.16 fun subst (PBound i) Plev tlev =
294.17 (if i < Plev then raise SAME (*var is locally bound*)
294.18 - else incr_pboundvars Plev tlev (List.nth (args, i-Plev))
294.19 + else incr_pboundvars Plev tlev (nth args (i-Plev))
294.20 handle Subscript => PBound (i-n) (*loose: change it*))
294.21 | subst (AbsP (a, t, body)) Plev tlev = AbsP (a, t, subst body (Plev+1) tlev)
294.22 | subst (Abst (a, T, body)) Plev tlev = Abst (a, T, subst body Plev (tlev+1))
294.23 @@ -935,7 +935,7 @@
294.24 in (is, ch orelse ch', ts',
294.25 if ch orelse ch' then prf' % t' else prf) end
294.26 | shrink' ls lev ts prfs (prf as PBound i) =
294.27 - (if exists (fn SOME (Bound j) => lev-j <= List.nth (ls, i) | _ => true) ts
294.28 + (if exists (fn SOME (Bound j) => lev-j <= nth ls i | _ => true) ts
294.29 orelse has_duplicates (op =)
294.30 (Library.foldl (fn (js, SOME (Bound j)) => j :: js | (js, _) => js) ([], ts))
294.31 orelse exists #1 prfs then [i] else [], false, map (pair false) ts, prf)
295.1 --- a/src/Pure/pure_setup.ML Wed Mar 04 10:43:39 2009 +0100
295.2 +++ b/src/Pure/pure_setup.ML Wed Mar 04 10:45:52 2009 +0100
295.3 @@ -33,7 +33,7 @@
295.4 map (fn (x, y) => Pretty.str (x ^ "=" ^ y)) o Position.properties_of));
295.5 install_pp (make_pp ["Thm", "thm"] ProofDisplay.pprint_thm);
295.6 install_pp (make_pp ["Thm", "cterm"] ProofDisplay.pprint_cterm);
295.7 -install_pp (make_pp ["Binding", "binding"] (Pretty.pprint o Pretty.str o Binding.display));
295.8 +install_pp (make_pp ["Binding", "binding"] (Pretty.pprint o Pretty.str o Binding.str_of));
295.9 install_pp (make_pp ["Thm", "ctyp"] ProofDisplay.pprint_ctyp);
295.10 install_pp (make_pp ["Context", "theory"] Context.pprint_thy);
295.11 install_pp (make_pp ["Context", "theory_ref"] Context.pprint_thy_ref);
296.1 --- a/src/Pure/pure_thy.ML Wed Mar 04 10:43:39 2009 +0100
296.2 +++ b/src/Pure/pure_thy.ML Wed Mar 04 10:45:52 2009 +0100
296.3 @@ -31,10 +31,10 @@
296.4 val add_thm: (binding * thm) * attribute list -> theory -> thm * theory
296.5 val add_thmss: ((binding * thm list) * attribute list) list -> theory -> thm list list * theory
296.6 val add_thms_dynamic: binding * (Context.generic -> thm list) -> theory -> theory
296.7 - val note_thmss: string -> ((binding * attribute list) *
296.8 - (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
296.9 - val note_thmss_grouped: string -> string -> ((binding * attribute list) *
296.10 - (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
296.11 + val note_thmss: string -> (Thm.binding *
296.12 + (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
296.13 + val note_thmss_grouped: string -> string -> (Thm.binding *
296.14 + (thm list * attribute list) list) list -> theory -> (string * thm list) list * theory
296.15 val add_axioms: ((binding * term) * attribute list) list -> theory -> thm list * theory
296.16 val add_axioms_cmd: ((bstring * string) * attribute list) list -> theory -> thm list * theory
296.17 val add_defs: bool -> ((binding * term) * attribute list) list ->
296.18 @@ -151,14 +151,15 @@
296.19 fun enter_thms pre_name post_name app_att (b, thms) thy =
296.20 if Binding.is_empty b
296.21 then swap (enter_proofs (app_att (thy, thms)))
296.22 - else let
296.23 - val naming = Sign.naming_of thy;
296.24 - val name = NameSpace.full_name naming b;
296.25 - val (thy', thms') =
296.26 - enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
296.27 - val thms'' = map (Thm.transfer thy') thms';
296.28 - val thy'' = thy' |> (FactsData.map o apfst) (Facts.add_global naming (b, thms'') #> snd);
296.29 - in (thms'', thy'') end;
296.30 + else
296.31 + let
296.32 + val naming = Sign.naming_of thy;
296.33 + val name = NameSpace.full_name naming b;
296.34 + val (thy', thms') =
296.35 + enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
296.36 + val thms'' = map (Thm.transfer thy') thms';
296.37 + val thy'' = thy' |> (FactsData.map o apfst) (Facts.add_global naming (b, thms'') #> snd);
296.38 + in (thms'', thy'') end;
296.39
296.40
296.41 (* store_thm(s) *)
296.42 @@ -177,7 +178,7 @@
296.43
296.44 fun add_thms_atts pre_name ((b, thms), atts) =
296.45 enter_thms pre_name (name_thms false true Position.none)
296.46 - (foldl_map (Thm.theory_attributes atts)) (b, thms);
296.47 + (Library.foldl_map (Thm.theory_attributes atts)) (b, thms);
296.48
296.49 fun gen_add_thmss pre_name =
296.50 fold_map (add_thms_atts pre_name);
296.51 @@ -207,9 +208,9 @@
296.52 val name = Sign.full_name thy b;
296.53 val _ = Position.report (Markup.fact_decl name) pos;
296.54
296.55 - fun app (x, (ths, atts)) = foldl_map (Thm.theory_attributes atts) (x, ths);
296.56 + fun app (x, (ths, atts)) = Library.foldl_map (Thm.theory_attributes atts) (x, ths);
296.57 val (thms, thy') = thy |> enter_thms
296.58 - (name_thmss true pos) (name_thms false true pos) (apsnd flat o foldl_map app)
296.59 + (name_thmss true pos) (name_thms false true pos) (apsnd flat o Library.foldl_map app)
296.60 (b, map (fn (ths, atts) => (ths, surround tag (atts @ more_atts))) ths_atts);
296.61 in ((name, thms), thy') end);
296.62
297.1 --- a/src/Pure/sign.ML Wed Mar 04 10:43:39 2009 +0100
297.2 +++ b/src/Pure/sign.ML Wed Mar 04 10:45:52 2009 +0100
297.3 @@ -338,7 +338,7 @@
297.4 fun typ_of (_, Const (_, T)) = T
297.5 | typ_of (_, Free (_, T)) = T
297.6 | typ_of (_, Var (_, T)) = T
297.7 - | typ_of (bs, Bound i) = snd (List.nth (bs, i) handle Subscript =>
297.8 + | typ_of (bs, Bound i) = snd (nth bs i handle Subscript =>
297.9 raise TYPE ("Loose bound variable: B." ^ string_of_int i, [], [Bound i]))
297.10 | typ_of (bs, Abs (x, T, body)) = T --> typ_of ((x, T) :: bs, body)
297.11 | typ_of (bs, t $ u) =
297.12 @@ -507,12 +507,12 @@
297.13 val prepT = Type.no_tvars o Term.no_dummyT o certify_typ thy o parse_typ ctxt;
297.14 fun prep (raw_b, raw_T, raw_mx) =
297.15 let
297.16 - val (mx_name, mx) = Syntax.const_mixfix (Binding.base_name raw_b) raw_mx;
297.17 - val b = Binding.map_base (K mx_name) raw_b;
297.18 + val (mx_name, mx) = Syntax.const_mixfix (Binding.name_of raw_b) raw_mx;
297.19 + val b = Binding.map_name (K mx_name) raw_b;
297.20 val c = full_name thy b;
297.21 - val c_syn = if authentic then Syntax.constN ^ c else Binding.base_name b;
297.22 + val c_syn = if authentic then Syntax.constN ^ c else Binding.name_of b;
297.23 val T = (prepT raw_T handle TYPE (msg, _, _) => error msg) handle ERROR msg =>
297.24 - cat_error msg ("in declaration of constant " ^ quote (Binding.display b));
297.25 + cat_error msg ("in declaration of constant " ^ quote (Binding.str_of b));
297.26 val T' = Logic.varifyT T;
297.27 in ((b, T'), (c_syn, T', mx), Const (c, T)) end;
297.28 val args = map prep raw_args;
297.29 @@ -549,7 +549,7 @@
297.30 val pp = Syntax.pp_global thy;
297.31 val prep_tm = no_frees pp o Term.no_dummy_patterns o cert_term_abbrev thy;
297.32 val t = (prep_tm raw_t handle TYPE (msg, _, _) => error msg | TERM (msg, _) => error msg)
297.33 - handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.display b));
297.34 + handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b));
297.35 val (res, consts') = consts_of thy
297.36 |> Consts.abbreviate pp (tsig_of thy) (naming_of thy) mode tags (b, t);
297.37 in (res, thy |> map_consts (K consts')) end;
298.1 --- a/src/Pure/sorts.ML Wed Mar 04 10:43:39 2009 +0100
298.2 +++ b/src/Pure/sorts.ML Wed Mar 04 10:45:52 2009 +0100
298.3 @@ -46,9 +46,7 @@
298.4 val add_arities: Pretty.pp -> string * (class * sort list) list -> algebra -> algebra
298.5 val empty_algebra: algebra
298.6 val merge_algebra: Pretty.pp -> algebra * algebra -> algebra
298.7 - val classrels_of: algebra -> (class * class list) list
298.8 - val instances_of: algebra -> (string * class) list
298.9 - val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list)
298.10 + val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list option)
298.11 -> algebra -> (sort -> sort) * algebra
298.12 type class_error
298.13 val class_error: Pretty.pp -> class_error -> string
298.14 @@ -302,19 +300,14 @@
298.15
298.16 (* algebra projections *)
298.17
298.18 -fun classrels_of (Algebra {classes, ...}) =
298.19 - map (fn [c] => (c, Graph.imm_succs classes c)) (rev (Graph.strong_conn classes));
298.20 -
298.21 -fun instances_of (Algebra {arities, ...}) =
298.22 - Symtab.fold (fn (a, cs) => append (map (pair a o fst) cs)) arities [];
298.23 -
298.24 fun subalgebra pp P sargs (algebra as Algebra {classes, arities}) =
298.25 let
298.26 val restrict_sort = minimize_sort algebra o filter P o Graph.all_succs classes;
298.27 fun restrict_arity tyco (c, (_, Ss)) =
298.28 - if P c then
298.29 - SOME (c, (c, Ss |> map2 (curry (inter_sort algebra)) (sargs (c, tyco))
298.30 + if P c then case sargs (c, tyco)
298.31 + of SOME sorts => SOME (c, (c, Ss |> map2 (curry (inter_sort algebra)) sorts
298.32 |> map restrict_sort))
298.33 + | NONE => NONE
298.34 else NONE;
298.35 val classes' = classes |> Graph.subgraph P;
298.36 val arities' = arities |> Symtab.map' (map_filter o restrict_arity);
299.1 --- a/src/Pure/tctical.ML Wed Mar 04 10:43:39 2009 +0100
299.2 +++ b/src/Pure/tctical.ML Wed Mar 04 10:45:52 2009 +0100
299.3 @@ -349,15 +349,13 @@
299.4 (*Returns all states that have changed in subgoal i, counted from the LAST
299.5 subgoal. For stac, for example.*)
299.6 fun CHANGED_GOAL tac i st =
299.7 - let val np = nprems_of st
299.8 + let val np = Thm.nprems_of st
299.9 val d = np-i (*distance from END*)
299.10 - val t = List.nth(prems_of st, i-1)
299.11 + val t = Thm.term_of (Thm.cprem_of st i)
299.12 fun diff st' =
299.13 - nprems_of st' - d <= 0 (*the subgoal no longer exists*)
299.14 + Thm.nprems_of st' - d <= 0 (*the subgoal no longer exists*)
299.15 orelse
299.16 - not (Pattern.aeconv (t,
299.17 - List.nth(prems_of st',
299.18 - nprems_of st' - d - 1)))
299.19 + not (Pattern.aeconv (t, Thm.term_of (Thm.cprem_of st' (Thm.nprems_of st' - d))))
299.20 in Seq.filter diff (tac i st) end
299.21 handle Subscript => Seq.empty (*no subgoal i*);
299.22
300.1 --- a/src/Pure/term.ML Wed Mar 04 10:43:39 2009 +0100
300.2 +++ b/src/Pure/term.ML Wed Mar 04 10:45:52 2009 +0100
300.3 @@ -297,7 +297,7 @@
300.4 Ts = [T0,T1,...] holds types of bound variables 0, 1, ...*)
300.5 fun type_of1 (Ts, Const (_,T)) = T
300.6 | type_of1 (Ts, Free (_,T)) = T
300.7 - | type_of1 (Ts, Bound i) = (List.nth (Ts,i)
300.8 + | type_of1 (Ts, Bound i) = (nth Ts i
300.9 handle Subscript => raise TYPE("type_of: bound variable", [], [Bound i]))
300.10 | type_of1 (Ts, Var (_,T)) = T
300.11 | type_of1 (Ts, Abs (_,T,body)) = T --> type_of1(T::Ts, body)
300.12 @@ -322,7 +322,7 @@
300.13 | _ => raise TERM("fastype_of: expected function type", [f$u]))
300.14 | fastype_of1 (_, Const (_,T)) = T
300.15 | fastype_of1 (_, Free (_,T)) = T
300.16 - | fastype_of1 (Ts, Bound i) = (List.nth(Ts,i)
300.17 + | fastype_of1 (Ts, Bound i) = (nth Ts i
300.18 handle Subscript => raise TERM("fastype_of: Bound", [Bound i]))
300.19 | fastype_of1 (_, Var (_,T)) = T
300.20 | fastype_of1 (Ts, Abs (_,T,u)) = T --> fastype_of1 (T::Ts, u);
300.21 @@ -387,17 +387,17 @@
300.22 (*number of atoms and abstractions in a term*)
300.23 fun size_of_term tm =
300.24 let
300.25 - fun add_size (t $ u, n) = add_size (t, add_size (u, n))
300.26 - | add_size (Abs (_ ,_, t), n) = add_size (t, n + 1)
300.27 - | add_size (_, n) = n + 1;
300.28 - in add_size (tm, 0) end;
300.29 + fun add_size (t $ u) n = add_size t (add_size u n)
300.30 + | add_size (Abs (_ ,_, t)) n = add_size t (n + 1)
300.31 + | add_size _ n = n + 1;
300.32 + in add_size tm 0 end;
300.33
300.34 -(*number of tfrees, tvars, and constructors in a type*)
300.35 +(*number of atoms and constructors in a type*)
300.36 fun size_of_typ ty =
300.37 let
300.38 - fun add_size (Type (_, ars), n) = foldl add_size (n + 1) ars
300.39 - | add_size (_, n) = n + 1;
300.40 - in add_size (ty, 0) end;
300.41 + fun add_size (Type (_, tys)) n = fold add_size tys (n + 1)
300.42 + | add_size _ n = n + 1;
300.43 + in add_size ty 0 end;
300.44
300.45 fun map_atyps f (Type (a, Ts)) = Type (a, map (map_atyps f) Ts)
300.46 | map_atyps f T = f T;
300.47 @@ -638,7 +638,7 @@
300.48 val n = length args;
300.49 fun subst (t as Bound i, lev) =
300.50 (if i < lev then raise SAME (*var is locally bound*)
300.51 - else incr_boundvars lev (List.nth (args, i - lev))
300.52 + else incr_boundvars lev (nth args (i - lev))
300.53 handle Subscript => Bound (i - n)) (*loose: change it*)
300.54 | subst (Abs (a, T, body), lev) = Abs (a, T, subst (body, lev + 1))
300.55 | subst (f $ t, lev) =
301.1 --- a/src/Pure/theory.ML Wed Mar 04 10:43:39 2009 +0100
301.2 +++ b/src/Pure/theory.ML Wed Mar 04 10:45:52 2009 +0100
301.3 @@ -258,7 +258,7 @@
301.4 val _ = check_overloading thy overloaded lhs_const;
301.5 in defs |> dependencies thy unchecked true name lhs_const rhs_consts end
301.6 handle ERROR msg => cat_error msg (Pretty.string_of (Pretty.block
301.7 - [Pretty.str ("The error(s) above occurred in definition " ^ quote (Binding.display b) ^ ":"),
301.8 + [Pretty.str ("The error(s) above occurred in definition " ^ quote (Binding.str_of b) ^ ":"),
301.9 Pretty.fbrk, Pretty.quote (Syntax.pretty_term_global thy tm)]));
301.10
301.11
302.1 --- a/src/Pure/type_infer.ML Wed Mar 04 10:43:39 2009 +0100
302.2 +++ b/src/Pure/type_infer.ML Wed Mar 04 10:45:52 2009 +0100
302.3 @@ -369,7 +369,7 @@
302.4 fun inf _ (PConst (_, T)) = T
302.5 | inf _ (PFree (_, T)) = T
302.6 | inf _ (PVar (_, T)) = T
302.7 - | inf bs (PBound i) = snd (List.nth (bs, i) handle Subscript => err_loose i)
302.8 + | inf bs (PBound i) = snd (nth bs i handle Subscript => err_loose i)
302.9 | inf bs (PAbs (x, T, t)) = PType ("fun", [T, inf ((x, T) :: bs) t])
302.10 | inf bs (PAppl (t, u)) =
302.11 let
303.1 --- a/src/Tools/Compute_Oracle/Compute_Oracle.thy Wed Mar 04 10:43:39 2009 +0100
303.2 +++ b/src/Tools/Compute_Oracle/Compute_Oracle.thy Wed Mar 04 10:45:52 2009 +0100
303.3 @@ -1,5 +1,4 @@
303.4 (* Title: Tools/Compute_Oracle/Compute_Oracle.thy
303.5 - ID: $Id$
303.6 Author: Steven Obua, TU Munich
303.7
303.8 Steven Obua's evaluator.
304.1 --- a/src/Tools/Compute_Oracle/am_compiler.ML Wed Mar 04 10:43:39 2009 +0100
304.2 +++ b/src/Tools/Compute_Oracle/am_compiler.ML Wed Mar 04 10:45:52 2009 +0100
304.3 @@ -1,5 +1,4 @@
304.4 (* Title: Tools/Compute_Oracle/am_compiler.ML
304.5 - ID: $Id$
304.6 Author: Steven Obua
304.7 *)
304.8
305.1 --- a/src/Tools/Compute_Oracle/am_ghc.ML Wed Mar 04 10:43:39 2009 +0100
305.2 +++ b/src/Tools/Compute_Oracle/am_ghc.ML Wed Mar 04 10:45:52 2009 +0100
305.3 @@ -1,5 +1,4 @@
305.4 (* Title: Tools/Compute_Oracle/am_ghc.ML
305.5 - ID: $Id$
305.6 Author: Steven Obua
305.7 *)
305.8
306.1 --- a/src/Tools/Compute_Oracle/am_interpreter.ML Wed Mar 04 10:43:39 2009 +0100
306.2 +++ b/src/Tools/Compute_Oracle/am_interpreter.ML Wed Mar 04 10:45:52 2009 +0100
306.3 @@ -1,5 +1,4 @@
306.4 (* Title: Tools/Compute_Oracle/am_interpreter.ML
306.5 - ID: $Id$
306.6 Author: Steven Obua
306.7 *)
306.8
307.1 --- a/src/Tools/Compute_Oracle/am_sml.ML Wed Mar 04 10:43:39 2009 +0100
307.2 +++ b/src/Tools/Compute_Oracle/am_sml.ML Wed Mar 04 10:45:52 2009 +0100
307.3 @@ -1,5 +1,4 @@
307.4 (* Title: Tools/Compute_Oracle/am_sml.ML
307.5 - ID: $Id$
307.6 Author: Steven Obua
307.7
307.8 ToDO: "parameterless rewrite cannot be used in pattern": In a lot of cases it CAN be used, and these cases should be handled properly;
308.1 --- a/src/Tools/Compute_Oracle/report.ML Wed Mar 04 10:43:39 2009 +0100
308.2 +++ b/src/Tools/Compute_Oracle/report.ML Wed Mar 04 10:45:52 2009 +0100
308.3 @@ -13,7 +13,7 @@
308.4 let
308.5 val t1 = start_timing ()
308.6 val x = f ()
308.7 - val t2 = end_timing t1
308.8 + val t2 = #message (end_timing t1)
308.9 val _ = writeln ((report_space ()) ^ "--> "^t2)
308.10 in
308.11 x
309.1 --- a/src/Tools/IsaPlanner/README Wed Mar 04 10:43:39 2009 +0100
309.2 +++ b/src/Tools/IsaPlanner/README Wed Mar 04 10:45:52 2009 +0100
309.3 @@ -1,4 +1,3 @@
309.4 -ID: $Id$
309.5 Author: Lucas Dixon, University of Edinburgh
309.6
309.7 Support files for IsaPlanner (see http://isaplanner.sourceforge.net).
310.1 --- a/src/Tools/IsaPlanner/isand.ML Wed Mar 04 10:43:39 2009 +0100
310.2 +++ b/src/Tools/IsaPlanner/isand.ML Wed Mar 04 10:45:52 2009 +0100
310.3 @@ -132,7 +132,7 @@
310.4 fun allify_prem_var (vt as (n,ty),t) =
310.5 (Term.all ty) $ (Abs(n,ty,Term.abstract_over (Free vt, t)))
310.6
310.7 - fun allify_prem Ts p = foldr allify_prem_var p Ts
310.8 + fun allify_prem Ts p = List.foldr allify_prem_var p Ts
310.9
310.10 val cTs = map (ctermify o Free) Ts
310.11 val cterm_asms = map (ctermify o allify_prem Ts) premts
310.12 @@ -306,7 +306,7 @@
310.13 in (Term.all ty) $ (Abs(n,ty,Term.abstract_over (vt, t))) end;
310.14
310.15 fun allify_for_sg_term ctermify vs t =
310.16 - let val t_alls = foldr allify_term t vs;
310.17 + let val t_alls = List.foldr allify_term t vs;
310.18 val ct_alls = ctermify t_alls;
310.19 in
310.20 (ct_alls, Drule.forall_elim_list vs (Thm.assume ct_alls))
310.21 @@ -394,7 +394,7 @@
310.22 |> Drule.forall_intr_list cfvs
310.23 in Drule.compose_single (solth', i, gth) end;
310.24
310.25 -fun export_solutions (xs,th) = foldr (uncurry export_solution) th xs;
310.26 +fun export_solutions (xs,th) = List.foldr (uncurry export_solution) th xs;
310.27
310.28
310.29 (* fix parameters of a subgoal "i", as free variables, and create an
311.1 --- a/src/Tools/IsaPlanner/rw_inst.ML Wed Mar 04 10:43:39 2009 +0100
311.2 +++ b/src/Tools/IsaPlanner/rw_inst.ML Wed Mar 04 10:45:52 2009 +0100
311.3 @@ -136,7 +136,7 @@
311.4 fun mk_renamings tgt rule_inst =
311.5 let
311.6 val rule_conds = Thm.prems_of rule_inst
311.7 - val names = foldr OldTerm.add_term_names [] (tgt :: rule_conds);
311.8 + val names = List.foldr OldTerm.add_term_names [] (tgt :: rule_conds);
311.9 val (conds_tyvs,cond_vs) =
311.10 Library.foldl (fn ((tyvs, vs), t) =>
311.11 (Library.union
311.12 @@ -147,7 +147,7 @@
311.13 val termvars = map Term.dest_Var (OldTerm.term_vars tgt);
311.14 val vars_to_fix = Library.union (termvars, cond_vs);
311.15 val (renamings, names2) =
311.16 - foldr (fn (((n,i),ty), (vs, names')) =>
311.17 + List.foldr (fn (((n,i),ty), (vs, names')) =>
311.18 let val n' = Name.variant names' n in
311.19 ((((n,i),ty), Free (n', ty)) :: vs, n'::names')
311.20 end)
311.21 @@ -166,13 +166,13 @@
311.22 let
311.23 val ignore_ixs = map fst ignore_insts;
311.24 val (tvars, tfrees) =
311.25 - foldr (fn (t, (varixs, tfrees)) =>
311.26 + List.foldr (fn (t, (varixs, tfrees)) =>
311.27 (OldTerm.add_term_tvars (t,varixs),
311.28 OldTerm.add_term_tfrees (t,tfrees)))
311.29 ([],[]) ts;
311.30 val unfixed_tvars =
311.31 List.filter (fn (ix,s) => not (member (op =) ignore_ixs ix)) tvars;
311.32 - val (fixtyinsts, _) = foldr new_tfree ([], map fst tfrees) unfixed_tvars
311.33 + val (fixtyinsts, _) = List.foldr new_tfree ([], map fst tfrees) unfixed_tvars
311.34 in (fixtyinsts, tfrees) end;
311.35
311.36
311.37 @@ -248,7 +248,7 @@
311.38 Ts;
311.39
311.40 (* type-instantiate the var instantiations *)
311.41 - val insts_tyinst = foldr (fn ((ix,(ty,t)),insts_tyinst) =>
311.42 + val insts_tyinst = List.foldr (fn ((ix,(ty,t)),insts_tyinst) =>
311.43 (ix, (Term.typ_subst_TVars term_typ_inst ty,
311.44 Term.subst_TVars term_typ_inst t))
311.45 :: insts_tyinst)
312.1 --- a/src/Tools/IsaPlanner/rw_tools.ML Wed Mar 04 10:43:39 2009 +0100
312.2 +++ b/src/Tools/IsaPlanner/rw_tools.ML Wed Mar 04 10:45:52 2009 +0100
312.3 @@ -1,5 +1,4 @@
312.4 (* Title: Tools/IsaPlanner/rw_tools.ML
312.5 - ID: $Id$
312.6 Author: Lucas Dixon, University of Edinburgh
312.7
312.8 Term related tools used for rewriting.
313.1 --- a/src/Tools/IsaPlanner/zipper.ML Wed Mar 04 10:43:39 2009 +0100
313.2 +++ b/src/Tools/IsaPlanner/zipper.ML Wed Mar 04 10:45:52 2009 +0100
313.3 @@ -1,5 +1,4 @@
313.4 (* Title: Tools/IsaPlanner/zipper.ML
313.5 - ID: $Id$
313.6 Author: Lucas Dixon, University of Edinburgh
313.7
313.8 A notion roughly based on Huet's Zippers for Isabelle terms.
314.1 --- a/src/Tools/Metis/make-metis Wed Mar 04 10:43:39 2009 +0100
314.2 +++ b/src/Tools/Metis/make-metis Wed Mar 04 10:45:52 2009 +0100
314.3 @@ -1,7 +1,5 @@
314.4 #!/usr/bin/env bash
314.5 #
314.6 -# $Id$
314.7 -#
314.8 # make-metis - turn original Metis files into Isabelle ML source.
314.9 #
314.10 # Structure declarations etc. are made local by wrapping into a
314.11 @@ -11,8 +9,6 @@
314.12 THIS=$(cd "$(dirname "$0")"; echo $PWD)
314.13
314.14 (
314.15 - echo -n '(* $'
314.16 - echo 'Id$ *)'
314.17 cat <<EOF
314.18 (******************************************************************)
314.19 (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
315.1 --- a/src/Tools/Metis/metis.ML Wed Mar 04 10:43:39 2009 +0100
315.2 +++ b/src/Tools/Metis/metis.ML Wed Mar 04 10:45:52 2009 +0100
315.3 @@ -1,4 +1,3 @@
315.4 -(* $Id$ *)
315.5 (******************************************************************)
315.6 (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
315.7 (* GENERATED FILE -- DO NOT EDIT -- GENERATED FILE -- DO NOT EDIT *)
316.1 --- a/src/Tools/README Wed Mar 04 10:43:39 2009 +0100
316.2 +++ b/src/Tools/README Wed Mar 04 10:45:52 2009 +0100
316.3 @@ -4,5 +4,3 @@
316.4 This directory contains ML sources of generic tools. Typically, they
316.5 can be applied to various logics.
316.6
316.7 -
316.8 -$Id$
317.1 --- a/src/Tools/atomize_elim.ML Wed Mar 04 10:43:39 2009 +0100
317.2 +++ b/src/Tools/atomize_elim.ML Wed Mar 04 10:45:52 2009 +0100
317.3 @@ -1,5 +1,4 @@
317.4 (* Title: Tools/atomize_elim.ML
317.5 - ID: $Id$
317.6 Author: Alexander Krauss, TU Muenchen
317.7
317.8 Turn elimination rules into atomic expressions in the object logic.
318.1 --- a/src/Tools/auto_solve.ML Wed Mar 04 10:43:39 2009 +0100
318.2 +++ b/src/Tools/auto_solve.ML Wed Mar 04 10:45:52 2009 +0100
318.3 @@ -1,89 +1,91 @@
318.4 -(* Title: auto_solve.ML
318.5 +(* Title: Pure/Tools/auto_solve.ML
318.6 Author: Timothy Bourke and Gerwin Klein, NICTA
318.7
318.8 - Check whether a newly stated theorem can be solved directly
318.9 - by an existing theorem. Duplicate lemmas can be detected in
318.10 - this way.
318.11 +Check whether a newly stated theorem can be solved directly by an
318.12 +existing theorem. Duplicate lemmas can be detected in this way.
318.13
318.14 - The implemenation is based in part on Berghofer and
318.15 - Haftmann's Pure/codegen.ML. It relies critically on
318.16 - the FindTheorems solves feature.
318.17 +The implemenation is based in part on Berghofer and Haftmann's
318.18 +Pure/codegen.ML. It relies critically on the FindTheorems solves
318.19 +feature.
318.20 *)
318.21
318.22 signature AUTO_SOLVE =
318.23 sig
318.24 - val auto : bool ref;
318.25 - val auto_time_limit : int ref;
318.26 + val auto : bool ref
318.27 + val auto_time_limit : int ref
318.28
318.29 - val seek_solution : bool -> Proof.state -> Proof.state;
318.30 + val seek_solution : bool -> Proof.state -> Proof.state
318.31 end;
318.32
318.33 structure AutoSolve : AUTO_SOLVE =
318.34 struct
318.35 - structure FT = FindTheorems;
318.36
318.37 - val auto = ref false;
318.38 - val auto_time_limit = ref 5000;
318.39 +val auto = ref false;
318.40 +val auto_time_limit = ref 2500;
318.41
318.42 - fun seek_solution int state = let
318.43 - val ctxt = Proof.context_of state;
318.44 +fun seek_solution int state =
318.45 + let
318.46 + val ctxt = Proof.context_of state;
318.47
318.48 - fun conj_to_list [] = []
318.49 - | conj_to_list (t::ts) =
318.50 - (Conjunction.dest_conjunction t
318.51 - |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
318.52 - handle TERM _ => t::conj_to_list ts;
318.53 + fun conj_to_list [] = []
318.54 + | conj_to_list (t::ts) =
318.55 + (Conjunction.dest_conjunction t
318.56 + |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
318.57 + handle TERM _ => t::conj_to_list ts;
318.58
318.59 - val crits = [(true, FT.Solves)];
318.60 - fun find g = (NONE, FT.find_theorems ctxt g true crits);
318.61 - fun find_cterm g = (SOME g, FT.find_theorems ctxt
318.62 - (SOME (Goal.init g)) true crits);
318.63 + val crits = [(true, FindTheorems.Solves)];
318.64 + fun find g = (NONE, FindTheorems.find_theorems ctxt g true crits);
318.65 + fun find_cterm g = (SOME g, FindTheorems.find_theorems ctxt
318.66 + (SOME (Goal.init g)) true crits);
318.67
318.68 - fun prt_result (goal, results) = let
318.69 - val msg = case goal of
318.70 - NONE => "The current goal"
318.71 - | SOME g => Syntax.string_of_term ctxt (term_of g);
318.72 - in
318.73 - Pretty.big_list (msg ^ " could be solved directly with:")
318.74 - (map Display.pretty_fact results)
318.75 - end;
318.76 + fun prt_result (goal, results) =
318.77 + let
318.78 + val msg = case goal of
318.79 + NONE => "The current goal"
318.80 + | SOME g => Syntax.string_of_term ctxt (term_of g);
318.81 + in
318.82 + Pretty.big_list (msg ^ " could be solved directly with:")
318.83 + (map (FindTheorems.pretty_thm ctxt) results)
318.84 + end;
318.85
318.86 - fun seek_against_goal () = let
318.87 - val goal = try Proof.get_goal state
318.88 - |> Option.map (#2 o #2);
318.89 + fun seek_against_goal () =
318.90 + let
318.91 + val goal = try Proof.get_goal state
318.92 + |> Option.map (#2 o #2);
318.93
318.94 - val goals = goal
318.95 - |> Option.map (fn g => cprem_of g 1)
318.96 - |> the_list
318.97 - |> conj_to_list;
318.98 + val goals = goal
318.99 + |> Option.map (fn g => cprem_of g 1)
318.100 + |> the_list
318.101 + |> conj_to_list;
318.102
318.103 - val rs = if length goals = 1
318.104 - then [find goal]
318.105 - else map find_cterm goals;
318.106 - val frs = filter_out (null o snd) rs;
318.107 + val rs = if length goals = 1
318.108 + then [find goal]
318.109 + else map find_cterm goals;
318.110 + val frs = filter_out (null o snd) rs;
318.111
318.112 - in if null frs then NONE else SOME frs end;
318.113 + in if null frs then NONE else SOME frs end;
318.114
318.115 - fun go () = let
318.116 - val res = TimeLimit.timeLimit
318.117 - (Time.fromMilliseconds (!auto_time_limit))
318.118 - (try seek_against_goal) ();
318.119 - in
318.120 - case Option.join res of
318.121 - NONE => state
318.122 - | SOME results => (Proof.goal_message
318.123 - (fn () => Pretty.chunks [Pretty.str "",
318.124 - Pretty.markup Markup.hilite
318.125 - (Library.separate (Pretty.brk 0)
318.126 - (map prt_result results))])
318.127 - state)
318.128 - end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
318.129 - in
318.130 - if int andalso !auto andalso not (!Toplevel.quiet)
318.131 - then go ()
318.132 - else state
318.133 - end;
318.134 -
318.135 + fun go () =
318.136 + let
318.137 + val res = TimeLimit.timeLimit
318.138 + (Time.fromMilliseconds (! auto_time_limit))
318.139 + (try seek_against_goal) ();
318.140 + in
318.141 + case Option.join res of
318.142 + NONE => state
318.143 + | SOME results => (Proof.goal_message
318.144 + (fn () => Pretty.chunks [Pretty.str "",
318.145 + Pretty.markup Markup.hilite
318.146 + (Library.separate (Pretty.brk 0)
318.147 + (map prt_result results))])
318.148 + state)
318.149 + end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
318.150 + in
318.151 + if int andalso ! auto andalso not (! Toplevel.quiet)
318.152 + then go ()
318.153 + else state
318.154 + end;
318.155 +
318.156 end;
318.157
318.158 val _ = Context.>> (Specification.add_theorem_hook AutoSolve.seek_solution);
319.1 --- a/src/Tools/code/code_funcgr.ML Wed Mar 04 10:43:39 2009 +0100
319.2 +++ b/src/Tools/code/code_funcgr.ML Wed Mar 04 10:45:52 2009 +0100
319.3 @@ -1,12 +1,13 @@
319.4 (* Title: Tools/code/code_funcgr.ML
319.5 - ID: $Id$
319.6 Author: Florian Haftmann, TU Muenchen
319.7
319.8 -Retrieving, normalizing and structuring defining equations in graph
319.9 +Retrieving, normalizing and structuring code equations in graph
319.10 with explicit dependencies.
319.11 +
319.12 +Legacy. To be replaced by Tools/code/code_wellsorted.ML
319.13 *)
319.14
319.15 -signature CODE_FUNCGR =
319.16 +signature CODE_WELLSORTED =
319.17 sig
319.18 type T
319.19 val eqns: T -> string -> (thm * bool) list
319.20 @@ -22,7 +23,7 @@
319.21 val timing: bool ref
319.22 end
319.23
319.24 -structure Code_Funcgr : CODE_FUNCGR =
319.25 +structure Code_Wellsorted : CODE_WELLSORTED =
319.26 struct
319.27
319.28 (** the graph type **)
319.29 @@ -318,13 +319,13 @@
319.30 in
319.31
319.32 val _ =
319.33 - OuterSyntax.improper_command "code_thms" "print system of defining equations for code" OuterKeyword.diag
319.34 + OuterSyntax.improper_command "code_thms" "print system of code equations for code" OuterKeyword.diag
319.35 (Scan.repeat P.term_group
319.36 >> (fn cs => Toplevel.no_timing o Toplevel.unknown_theory
319.37 o Toplevel.keep ((fn thy => code_thms_cmd thy cs) o Toplevel.theory_of)));
319.38
319.39 val _ =
319.40 - OuterSyntax.improper_command "code_deps" "visualize dependencies of defining equations for code" OuterKeyword.diag
319.41 + OuterSyntax.improper_command "code_deps" "visualize dependencies of code equations for code" OuterKeyword.diag
319.42 (Scan.repeat P.term_group
319.43 >> (fn cs => Toplevel.no_timing o Toplevel.unknown_theory
319.44 o Toplevel.keep ((fn thy => code_deps_cmd thy cs) o Toplevel.theory_of)));
320.1 --- a/src/Tools/code/code_haskell.ML Wed Mar 04 10:43:39 2009 +0100
320.2 +++ b/src/Tools/code/code_haskell.ML Wed Mar 04 10:45:52 2009 +0100
320.3 @@ -1,5 +1,4 @@
320.4 (* Title: Tools/code/code_haskell.ML
320.5 - ID: $Id$
320.6 Author: Florian Haftmann, TU Muenchen
320.7
320.8 Serializer for Haskell.
321.1 --- a/src/Tools/code/code_name.ML Wed Mar 04 10:43:39 2009 +0100
321.2 +++ b/src/Tools/code/code_name.ML Wed Mar 04 10:45:52 2009 +0100
321.3 @@ -1,5 +1,4 @@
321.4 (* Title: Tools/code/code_name.ML
321.5 - ID: $Id$
321.6 Author: Florian Haftmann, TU Muenchen
321.7
321.8 Some code generator infrastructure concerning names.
322.1 --- a/src/Tools/code/code_printer.ML Wed Mar 04 10:43:39 2009 +0100
322.2 +++ b/src/Tools/code/code_printer.ML Wed Mar 04 10:45:52 2009 +0100
322.3 @@ -1,5 +1,4 @@
322.4 (* Title: Tools/code/code_printer.ML
322.5 - ID: $Id$
322.6 Author: Florian Haftmann, TU Muenchen
322.7
322.8 Generic operations for pretty printing of target language code.
323.1 --- a/src/Tools/code/code_target.ML Wed Mar 04 10:43:39 2009 +0100
323.2 +++ b/src/Tools/code/code_target.ML Wed Mar 04 10:45:52 2009 +0100
323.3 @@ -1,5 +1,4 @@
323.4 (* Title: Tools/code/code_target.ML
323.5 - ID: $Id$
323.6 Author: Florian Haftmann, TU Muenchen
323.7
323.8 Serializer from intermediate language ("Thin-gol") to target languages.
323.9 @@ -418,7 +417,7 @@
323.10 val program4 = Graph.subgraph (member (op =) names_all) program3;
323.11 val empty_funs = filter_out (member (op =) abortable)
323.12 (Code_Thingol.empty_funs program3);
323.13 - val _ = if null empty_funs then () else error ("No defining equations for "
323.14 + val _ = if null empty_funs then () else error ("No code equations for "
323.15 ^ commas (map (Sign.extern_const thy) empty_funs));
323.16 in
323.17 serializer module args (labelled_name thy program2) reserved includes
324.1 --- a/src/Tools/code/code_thingol.ML Wed Mar 04 10:43:39 2009 +0100
324.2 +++ b/src/Tools/code/code_thingol.ML Wed Mar 04 10:45:52 2009 +0100
324.3 @@ -109,7 +109,7 @@
324.4 let val (xs', x') = unfoldr dest x2 in (x1::xs', x') end;
324.5
324.6
324.7 -(** language core - types, patterns, expressions **)
324.8 +(** language core - types, terms **)
324.9
324.10 type vname = string;
324.11
324.12 @@ -131,31 +131,6 @@
324.13 | ICase of ((iterm * itype) * (iterm * iterm) list) * iterm;
324.14 (*see also signature*)
324.15
324.16 -(*
324.17 - variable naming conventions
324.18 -
324.19 - bare names:
324.20 - variable names v
324.21 - class names class
324.22 - type constructor names tyco
324.23 - datatype names dtco
324.24 - const names (general) c (const)
324.25 - constructor names co
324.26 - class parameter names classparam
324.27 - arbitrary name s
324.28 -
324.29 - v, c, co, classparam also annotated with types etc.
324.30 -
324.31 - constructs:
324.32 - sort sort
324.33 - type parameters vs
324.34 - type ty
324.35 - type schemes tysm
324.36 - term t
324.37 - (term as pattern) p
324.38 - instance (class, tyco) inst
324.39 - *)
324.40 -
324.41 val op `$$ = Library.foldl (op `$);
324.42 val op `|--> = Library.foldr (op `|->);
324.43
324.44 @@ -478,7 +453,7 @@
324.45 let
324.46 val err_class = Sorts.class_error (Syntax.pp_global thy) e;
324.47 val err_thm = case thm
324.48 - of SOME thm => "\n(in defining equation " ^ Display.string_of_thm thm ^ ")" | NONE => "";
324.49 + of SOME thm => "\n(in code equation " ^ Display.string_of_thm thm ^ ")" | NONE => "";
324.50 val err_typ = "Type " ^ Syntax.string_of_typ_global thy ty ^ " not of sort "
324.51 ^ Syntax.string_of_sort_global thy sort;
324.52 in error ("Wellsortedness error" ^ err_thm ^ ":\n" ^ err_typ ^ "\n" ^ err_class) end;
324.53 @@ -486,12 +461,6 @@
324.54
324.55 (* translation *)
324.56
324.57 -(*FIXME move to code(_unit).ML*)
324.58 -fun get_case_scheme thy c = case Code.get_case_data thy c
324.59 - of SOME (proto_case_scheme as (_, case_pats)) =>
324.60 - SOME (1 + (if null case_pats then 1 else length case_pats), proto_case_scheme)
324.61 - | NONE => NONE
324.62 -
324.63 fun ensure_class thy (algbr as (_, algebra)) funcgr class =
324.64 let
324.65 val superclasses = (Sorts.minimize_sort algebra o Sorts.super_classes algebra) class;
324.66 @@ -526,9 +495,8 @@
324.67 and translate_tyvar_sort thy (algbr as (proj_sort, _)) funcgr (v, sort) =
324.68 fold_map (ensure_class thy algbr funcgr) (proj_sort sort)
324.69 #>> (fn sort => (unprefix "'" v, sort))
324.70 -and translate_typ thy algbr funcgr (TFree v_sort) =
324.71 - translate_tyvar_sort thy algbr funcgr v_sort
324.72 - #>> (fn (v, sort) => ITyVar v)
324.73 +and translate_typ thy algbr funcgr (TFree (v, _)) =
324.74 + pair (ITyVar (unprefix "'" v))
324.75 | translate_typ thy algbr funcgr (Type (tyco, tys)) =
324.76 ensure_tyco thy algbr funcgr tyco
324.77 ##>> fold_map (translate_typ thy algbr funcgr) tys
324.78 @@ -543,16 +511,8 @@
324.79 Global ((class, tyco), yss)
324.80 | class_relation (Local (classrels, v), subclass) superclass =
324.81 Local ((subclass, superclass) :: classrels, v);
324.82 - fun norm_typargs ys =
324.83 - let
324.84 - val raw_sort = map snd ys;
324.85 - val sort = Sorts.minimize_sort algebra raw_sort;
324.86 - in
324.87 - map_filter (fn (y, class) =>
324.88 - if member (op =) sort class then SOME y else NONE) ys
324.89 - end;
324.90 fun type_constructor tyco yss class =
324.91 - Global ((class, tyco), map norm_typargs yss);
324.92 + Global ((class, tyco), (map o map) fst yss);
324.93 fun type_variable (TFree (v, sort)) =
324.94 let
324.95 val sort' = proj_sort sort;
324.96 @@ -622,9 +582,8 @@
324.97 fun stmt_classparam class =
324.98 ensure_class thy algbr funcgr class
324.99 #>> (fn class => Classparam (c, class));
324.100 - fun stmt_fun ((vs, raw_ty), raw_thms) =
324.101 + fun stmt_fun ((vs, ty), raw_thms) =
324.102 let
324.103 - val ty = Logic.unvarifyT raw_ty;
324.104 val thms = if null (Term.add_tfreesT ty []) orelse (null o fst o strip_type) ty
324.105 then raw_thms
324.106 else (map o apfst) (Code_Unit.expand_eta thy 1) raw_thms;
324.107 @@ -638,7 +597,7 @@
324.108 of SOME tyco => stmt_datatypecons tyco
324.109 | NONE => (case AxClass.class_of_param thy c
324.110 of SOME class => stmt_classparam class
324.111 - | NONE => stmt_fun (Code_Funcgr.typ funcgr c, Code_Funcgr.eqns funcgr c))
324.112 + | NONE => stmt_fun (Code_Wellsorted.typ funcgr c, Code_Wellsorted.eqns funcgr c))
324.113 in ensure_stmt lookup_const (declare_const thy) stmt_const c end
324.114 and translate_term thy algbr funcgr thm (Const (c, ty)) =
324.115 translate_app thy algbr funcgr thm ((c, ty), [])
324.116 @@ -663,7 +622,7 @@
324.117 and translate_const thy algbr funcgr thm (c, ty) =
324.118 let
324.119 val tys = Sign.const_typargs thy (c, ty);
324.120 - val sorts = (map snd o fst o Code_Funcgr.typ funcgr) c;
324.121 + val sorts = (map snd o fst o Code_Wellsorted.typ funcgr) c;
324.122 val tys_args = (fst o Term.strip_type) ty;
324.123 in
324.124 ensure_const thy algbr funcgr c
324.125 @@ -671,7 +630,7 @@
324.126 ##>> fold_map (translate_typ thy algbr funcgr) tys_args
324.127 #>> (fn ((c, iss), tys) => IConst (c, (iss, tys)))
324.128 end
324.129 -and translate_app_default thy algbr funcgr thm (c_ty, ts) =
324.130 +and translate_app_const thy algbr funcgr thm (c_ty, ts) =
324.131 translate_const thy algbr funcgr thm c_ty
324.132 ##>> fold_map (translate_term thy algbr funcgr thm) ts
324.133 #>> (fn (t, ts) => t `$$ ts)
324.134 @@ -683,11 +642,6 @@
324.135 val ts_clause = nth_drop t_pos ts;
324.136 fun mk_clause (co, num_co_args) t =
324.137 let
324.138 - val _ = if (is_some o Code.get_datatype_of_constr thy) co then ()
324.139 - else error ("Non-constructor " ^ quote co
324.140 - ^ " encountered in case pattern"
324.141 - ^ (case thm of NONE => ""
324.142 - | SOME thm => ", in equation\n" ^ Display.string_of_thm thm))
324.143 val (vs, body) = Term.strip_abs_eta num_co_args t;
324.144 val not_undefined = case body
324.145 of (Const (c, _)) => not (Code.is_undefined thy c)
324.146 @@ -722,26 +676,28 @@
324.147 #>> pair b) clauses
324.148 #>> (fn (((const, t), ty), ds) => mk_icase const t ty ds)
324.149 end
324.150 -and translate_app thy algbr funcgr thm ((c, ty), ts) = case get_case_scheme thy c
324.151 - of SOME (case_scheme as (num_args, _)) =>
324.152 - if length ts < num_args then
324.153 - let
324.154 - val k = length ts;
324.155 - val tys = (curry Library.take (num_args - k) o curry Library.drop k o fst o strip_type) ty;
324.156 - val ctxt = (fold o fold_aterms) Term.declare_term_frees ts Name.context;
324.157 - val vs = Name.names ctxt "a" tys;
324.158 - in
324.159 - fold_map (translate_typ thy algbr funcgr) tys
324.160 - ##>> translate_case thy algbr funcgr thm case_scheme ((c, ty), ts @ map Free vs)
324.161 - #>> (fn (tys, t) => map2 (fn (v, _) => pair v) vs tys `|--> t)
324.162 - end
324.163 - else if length ts > num_args then
324.164 - translate_case thy algbr funcgr thm case_scheme ((c, ty), Library.take (num_args, ts))
324.165 - ##>> fold_map (translate_term thy algbr funcgr thm) (Library.drop (num_args, ts))
324.166 - #>> (fn (t, ts) => t `$$ ts)
324.167 - else
324.168 - translate_case thy algbr funcgr thm case_scheme ((c, ty), ts)
324.169 - | NONE => translate_app_default thy algbr funcgr thm ((c, ty), ts);
324.170 +and translate_app_case thy algbr funcgr thm (case_scheme as (num_args, _)) ((c, ty), ts) =
324.171 + if length ts < num_args then
324.172 + let
324.173 + val k = length ts;
324.174 + val tys = (curry Library.take (num_args - k) o curry Library.drop k o fst o strip_type) ty;
324.175 + val ctxt = (fold o fold_aterms) Term.declare_term_frees ts Name.context;
324.176 + val vs = Name.names ctxt "a" tys;
324.177 + in
324.178 + fold_map (translate_typ thy algbr funcgr) tys
324.179 + ##>> translate_case thy algbr funcgr thm case_scheme ((c, ty), ts @ map Free vs)
324.180 + #>> (fn (tys, t) => map2 (fn (v, _) => pair v) vs tys `|--> t)
324.181 + end
324.182 + else if length ts > num_args then
324.183 + translate_case thy algbr funcgr thm case_scheme ((c, ty), Library.take (num_args, ts))
324.184 + ##>> fold_map (translate_term thy algbr funcgr thm) (Library.drop (num_args, ts))
324.185 + #>> (fn (t, ts) => t `$$ ts)
324.186 + else
324.187 + translate_case thy algbr funcgr thm case_scheme ((c, ty), ts)
324.188 +and translate_app thy algbr funcgr thm (c_ty_ts as ((c, _), _)) =
324.189 + case Code.get_case_scheme thy c
324.190 + of SOME case_scheme => translate_app_case thy algbr funcgr thm case_scheme c_ty_ts
324.191 + | NONE => translate_app_const thy algbr funcgr thm c_ty_ts;
324.192
324.193
324.194 (* store *)
324.195 @@ -779,7 +735,7 @@
324.196 fun generate_consts thy algebra funcgr =
324.197 fold_map (ensure_const thy algebra funcgr);
324.198 in
324.199 - invoke_generation thy (Code_Funcgr.make thy cs) generate_consts cs
324.200 + invoke_generation thy (Code_Wellsorted.make thy cs) generate_consts cs
324.201 |-> project_consts
324.202 end;
324.203
324.204 @@ -822,8 +778,8 @@
324.205 in evaluator'' naming program vs_ty_t deps end;
324.206 in (t', evaluator') end
324.207
324.208 -fun eval_conv thy = Code_Funcgr.eval_conv thy o eval thy;
324.209 -fun eval_term thy = Code_Funcgr.eval_term thy o eval thy;
324.210 +fun eval_conv thy = Code_Wellsorted.eval_conv thy o eval thy;
324.211 +fun eval_term thy = Code_Wellsorted.eval_term thy o eval thy;
324.212
324.213 end; (*struct*)
324.214
325.1 --- a/src/Tools/float.ML Wed Mar 04 10:43:39 2009 +0100
325.2 +++ b/src/Tools/float.ML Wed Mar 04 10:45:52 2009 +0100
325.3 @@ -1,5 +1,4 @@
325.4 (* Title: Tools/float.ML
325.5 - ID: $Id$
325.6 Author: Steven Obua, Florian Haftmann, TU Muenchen
325.7
325.8 Implementation of real numbers as mantisse-exponent pairs.
326.1 --- a/src/Tools/induct.ML Wed Mar 04 10:43:39 2009 +0100
326.2 +++ b/src/Tools/induct.ML Wed Mar 04 10:45:52 2009 +0100
326.3 @@ -552,7 +552,7 @@
326.4 let
326.5 fun add (SOME (SOME x, t)) ctxt =
326.6 let val ([(lhs, (_, th))], ctxt') =
326.7 - LocalDefs.add_defs [((x, NoSyn), ((Binding.empty, []), t))] ctxt
326.8 + LocalDefs.add_defs [((x, NoSyn), (Thm.empty_binding, t))] ctxt
326.9 in ((SOME lhs, [th]), ctxt') end
326.10 | add (SOME (NONE, t)) ctxt = ((SOME t, []), ctxt)
326.11 | add NONE ctxt = ((NONE, []), ctxt);
327.1 --- a/src/Tools/induct_tacs.ML Wed Mar 04 10:43:39 2009 +0100
327.2 +++ b/src/Tools/induct_tacs.ML Wed Mar 04 10:45:52 2009 +0100
327.3 @@ -1,5 +1,4 @@
327.4 (* Title: Tools/induct_tacs.ML
327.5 - ID: $Id$
327.6 Author: Makarius
327.7
327.8 Unstructured induction and cases analysis.
328.1 --- a/src/Tools/nbe.ML Wed Mar 04 10:43:39 2009 +0100
328.2 +++ b/src/Tools/nbe.ML Wed Mar 04 10:45:52 2009 +0100
328.3 @@ -389,8 +389,8 @@
328.4 val ts' = take_until is_dict ts;
328.5 val c = const_of_idx idx;
328.6 val (_, T) = Code.default_typscheme thy c;
328.7 - val T' = map_type_tvar (fn ((v, i), S) => TypeInfer.param (typidx + i) (v, [])) T;
328.8 - val typidx' = typidx + maxidx_of_typ T' + 1;
328.9 + val T' = map_type_tfree (fn (v, _) => TypeInfer.param typidx (v, [])) T;
328.10 + val typidx' = typidx + 1;
328.11 in of_apps bounds (Term.Const (c, T'), ts') typidx' end
328.12 | of_univ bounds (Free (name, ts)) typidx =
328.13 of_apps bounds (Term.Free (name, dummyT), ts) typidx
329.1 --- a/src/Tools/random_word.ML Wed Mar 04 10:43:39 2009 +0100
329.2 +++ b/src/Tools/random_word.ML Wed Mar 04 10:45:52 2009 +0100
329.3 @@ -1,5 +1,4 @@
329.4 (* Title: Tools/random_word.ML
329.5 - ID: $Id$
329.6 Author: Makarius
329.7
329.8 Simple generator for pseudo-random numbers, using unboxed word
330.1 --- a/src/Tools/rat.ML Wed Mar 04 10:43:39 2009 +0100
330.2 +++ b/src/Tools/rat.ML Wed Mar 04 10:45:52 2009 +0100
330.3 @@ -1,5 +1,4 @@
330.4 (* Title: Tools/rat.ML
330.5 - ID: $Id$
330.6 Author: Tobias Nipkow, Florian Haftmann, TU Muenchen
330.7
330.8 Canonical implementation of exact rational numbers.
331.1 --- a/src/ZF/Tools/datatype_package.ML Wed Mar 04 10:43:39 2009 +0100
331.2 +++ b/src/ZF/Tools/datatype_package.ML Wed Mar 04 10:45:52 2009 +0100
331.3 @@ -1,5 +1,4 @@
331.4 (* Title: ZF/Tools/datatype_package.ML
331.5 - ID: $Id$
331.6 Author: Lawrence C Paulson, Cambridge University Computer Laboratory
331.7 Copyright 1994 University of Cambridge
331.8
331.9 @@ -140,11 +139,11 @@
331.10 (*Treatment of a list of constructors, for one part
331.11 Result adds a list of terms, each a function variable with arguments*)
331.12 fun add_case_list (con_ty_list, (opno, case_lists)) =
331.13 - let val (opno', case_list) = foldr add_case (opno, []) con_ty_list
331.14 + let val (opno', case_list) = List.foldr add_case (opno, []) con_ty_list
331.15 in (opno', case_list :: case_lists) end;
331.16
331.17 (*Treatment of all parts*)
331.18 - val (_, case_lists) = foldr add_case_list (1,[]) con_ty_lists;
331.19 + val (_, case_lists) = List.foldr add_case_list (1,[]) con_ty_lists;
331.20
331.21 (*extract the types of all the variables*)
331.22 val case_typ = List.concat (map (map (#2 o #1)) con_ty_lists) ---> @{typ "i => i"};
331.23 @@ -184,7 +183,7 @@
331.24 val rec_args = map (make_rec_call (rev case_args,0))
331.25 (List.drop(recursor_args, ncase_args))
331.26 in
331.27 - foldr add_abs
331.28 + List.foldr add_abs
331.29 (list_comb (recursor_var,
331.30 bound_args @ rec_args)) case_args
331.31 end
331.32 @@ -216,7 +215,7 @@
331.33 val rec_ty_lists = (map (map rec_ty_elem) con_ty_lists);
331.34
331.35 (*Treatment of all parts*)
331.36 - val (_, recursor_lists) = foldr add_case_list (1,[]) rec_ty_lists;
331.37 + val (_, recursor_lists) = List.foldr add_case_list (1,[]) rec_ty_lists;
331.38
331.39 (*extract the types of all the variables*)
331.40 val recursor_typ = List.concat (map (map (#2 o #1)) rec_ty_lists) ---> @{typ "i => i"};
332.1 --- a/src/ZF/Tools/inductive_package.ML Wed Mar 04 10:43:39 2009 +0100
332.2 +++ b/src/ZF/Tools/inductive_package.ML Wed Mar 04 10:45:52 2009 +0100
332.3 @@ -65,7 +65,7 @@
332.4 val _ = Theory.requires thy "Inductive_ZF" "(co)inductive definitions";
332.5 val ctxt = ProofContext.init thy;
332.6
332.7 - val intr_specs = map (apfst (apfst Binding.base_name)) raw_intr_specs;
332.8 + val intr_specs = map (apfst (apfst Binding.name_of)) raw_intr_specs;
332.9 val (intr_names, intr_tms) = split_list (map fst intr_specs);
332.10 val case_names = RuleCases.case_names intr_names;
332.11
332.12 @@ -99,7 +99,7 @@
332.13 Syntax.string_of_term ctxt t);
332.14
332.15 (*** Construct the fixedpoint definition ***)
332.16 - val mk_variant = Name.variant (foldr OldTerm.add_term_names [] intr_tms);
332.17 + val mk_variant = Name.variant (List.foldr OldTerm.add_term_names [] intr_tms);
332.18
332.19 val z' = mk_variant"z" and X' = mk_variant"X" and w' = mk_variant"w";
332.20
332.21 @@ -113,7 +113,7 @@
332.22 val dummy = List.app (fn rec_hd => List.app (chk_prem rec_hd) prems) rec_hds
332.23 val exfrees = OldTerm.term_frees intr \\ rec_params
332.24 val zeq = FOLogic.mk_eq (Free(z',iT), #1 (rule_concl intr))
332.25 - in foldr FOLogic.mk_exists
332.26 + in List.foldr FOLogic.mk_exists
332.27 (BalancedTree.make FOLogic.mk_conj (zeq::prems)) exfrees
332.28 end;
332.29
332.30 @@ -303,7 +303,7 @@
332.31 (*Make a premise of the induction rule.*)
332.32 fun induct_prem ind_alist intr =
332.33 let val quantfrees = map dest_Free (OldTerm.term_frees intr \\ rec_params)
332.34 - val iprems = foldr (add_induct_prem ind_alist) []
332.35 + val iprems = List.foldr (add_induct_prem ind_alist) []
332.36 (Logic.strip_imp_prems intr)
332.37 val (t,X) = Ind_Syntax.rule_concl intr
332.38 val (SOME pred) = AList.lookup (op aconv) ind_alist X
332.39 @@ -380,7 +380,7 @@
332.40 val pfree = Free(pred_name ^ "_" ^ Sign.base_name rec_name,
332.41 elem_factors ---> FOLogic.oT)
332.42 val qconcl =
332.43 - foldr FOLogic.mk_all
332.44 + List.foldr FOLogic.mk_all
332.45 (FOLogic.imp $
332.46 (@{const mem} $ elem_tuple $ rec_tm)
332.47 $ (list_comb (pfree, elem_frees))) elem_frees
333.1 --- a/src/ZF/Tools/primrec_package.ML Wed Mar 04 10:43:39 2009 +0100
333.2 +++ b/src/ZF/Tools/primrec_package.ML Wed Mar 04 10:45:52 2009 +0100
333.3 @@ -120,7 +120,7 @@
333.4 | SOME (rhs, cargs', eq) =>
333.5 (rhs, inst_recursor (recursor_pair, cargs'), eq)
333.6 val allowed_terms = map use_fabs (#2 (strip_comb recursor_rhs))
333.7 - val abs = foldr absterm rhs allowed_terms
333.8 + val abs = List.foldr absterm rhs allowed_terms
333.9 in
333.10 if !Ind_Syntax.trace then
333.11 writeln ("recursor_rhs = " ^
333.12 @@ -145,7 +145,7 @@
333.13 val def_tm = Logic.mk_equals
333.14 (subst_bound (rec_arg, fabs),
333.15 list_comb (recursor,
333.16 - foldr add_case [] (cnames ~~ recursor_pairs))
333.17 + List.foldr add_case [] (cnames ~~ recursor_pairs))
333.18 $ rec_arg)
333.19
333.20 in
333.21 @@ -164,7 +164,7 @@
333.22 let
333.23 val ((eqn_names, eqn_terms), eqn_atts) = apfst split_list (split_list args);
333.24 val SOME (fname, ftype, ls, rs, con_info, eqns) =
333.25 - foldr (process_eqn thy) NONE eqn_terms;
333.26 + List.foldr (process_eqn thy) NONE eqn_terms;
333.27 val def = process_fun thy (fname, ftype, ls, rs, con_info, eqns);
333.28
333.29 val ([def_thm], thy1) = thy