diff options
Diffstat (limited to 'snapshots/isabelle/lib/lem')
32 files changed, 8321 insertions, 0 deletions
diff --git a/snapshots/isabelle/lib/lem/LICENSE b/snapshots/isabelle/lib/lem/LICENSE new file mode 100644 index 00000000..06f7abfe --- /dev/null +++ b/snapshots/isabelle/lib/lem/LICENSE @@ -0,0 +1,524 @@ + Lem + +All files except ocaml-lib/pmap.{ml,mli} and ocaml-libpset.{ml,mli} +are distributed under the following license: + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. +3. The names of the authors may not be used to endorse or promote +products derived from this software without specific prior written +permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN +IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + + + +The following files are modified versions of map and set from the +Objective Caml library and are distributed under the GNU LIBRARY GENERAL +PUBLIC LICENSE Version 2 as below. + +ocaml-lib/pmap.mli +ocaml-lib/pmap.ml +ocaml-lib/pset.mli +ocaml-lib/pset.ml + + + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the library's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + <signature of Ty Coon>, 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/snapshots/isabelle/lib/lem/Lem.thy b/snapshots/isabelle/lib/lem/Lem.thy new file mode 100644 index 00000000..c6a2a883 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem.thy @@ -0,0 +1,108 @@ +(*========================================================================*) +(* Lem *) +(* *) +(* Dominic Mulligan, University of Cambridge *) +(* Francesco Zappa Nardelli, INRIA Paris-Rocquencourt *) +(* Gabriel Kerneis, University of Cambridge *) +(* Kathy Gray, University of Cambridge *) +(* Peter Boehm, University of Cambridge (while working on Lem) *) +(* Peter Sewell, University of Cambridge *) +(* Scott Owens, University of Kent *) +(* Thomas Tuerk, University of Cambridge *) +(* Brian Campbell, University of Edinburgh *) +(* Shaked Flur, University of Cambridge *) +(* Thomas Bauereiss, University of Cambridge *) +(* Stephen Kell, University of Cambridge *) +(* Thomas Williams *) +(* Lars Hupel *) +(* Basile Clement *) +(* *) +(* The Lem sources are copyright 2010-2018 *) +(* by the authors above and Institut National de Recherche en *) +(* Informatique et en Automatique (INRIA). *) +(* *) +(* All files except ocaml-lib/pmap.{ml,mli} and ocaml-libpset.{ml,mli} *) +(* are distributed under the license below. The former are distributed *) +(* under the LGPLv2, as in the LICENSE file. *) +(* *) +(* *) +(* Redistribution and use in source and binary forms, with or without *) +(* modification, are permitted provided that the following conditions *) +(* are met: *) +(* 1. Redistributions of source code must retain the above copyright *) +(* notice, this list of conditions and the following disclaimer. *) +(* 2. Redistributions in binary form must reproduce the above copyright *) +(* notice, this list of conditions and the following disclaimer in the *) +(* documentation and/or other materials provided with the distribution. *) +(* 3. The names of the authors may not be used to endorse or promote *) +(* products derived from this software without specific prior written *) +(* permission. *) +(* *) +(* THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS *) +(* OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *) +(* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE *) +(* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY *) +(* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL *) +(* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE *) +(* GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS *) +(* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER *) +(* IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR *) +(* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN *) +(* IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) +(*========================================================================*) + +chapter\<open>Mappings of Syntax needed by Lem\<close> + +theory "Lem" + +imports + LemExtraDefs + "~~/src/HOL/Word/Word" +begin + +type_synonym numeral = nat + +subsection \<open>Finite Maps\<close> + +abbreviation (input) "map_find k m \<equiv> the (m k)" +abbreviation (input) "map_update k v m \<equiv> m (k \<mapsto> v)" +abbreviation (input) "map_remove k m \<equiv> m |` (- {k})" +abbreviation (input) "map_any P m \<equiv> \<exists> (k, v) \<in> map_to_set m. P k v" +abbreviation (input) "map_all P m \<equiv> \<forall> (k, v) \<in> map_to_set m. P k v" + +subsection \<open>Lists\<close> + +abbreviation (input) "list_mem e l \<equiv> (e \<in> set l)" +abbreviation (input) "list_forall P l \<equiv> (\<forall>e\<in>set l. P e)" +abbreviation (input) "list_exists P l \<equiv> (\<exists>e\<in>set l. P e)" +abbreviation (input) "list_unzip l \<equiv> (map fst l, map snd l)" + +subsection \<open>Sets\<close> + +abbreviation (input) "set_filter P (s::'a set) \<equiv> {x \<in> s. P x}" +abbreviation (input) "set_bigunion S \<equiv> \<Union> S" +abbreviation (input) "set_biginter S \<equiv> \<Inter> S" + +subsection \<open>Natural numbers\<close> + +subsection \<open>Integers\<close> + + +subsection \<open>Dummy\<close> + +consts + bitwise_xor :: "nat \<Rightarrow> nat \<Rightarrow> nat" + num_asr :: "nat \<Rightarrow> nat \<Rightarrow> nat" + num_lsl :: "nat \<Rightarrow> nat \<Rightarrow> nat" + bitwise_or :: "nat \<Rightarrow> nat \<Rightarrow> nat" + bitwise_not :: "nat \<Rightarrow> nat" + bitwise_and :: "nat \<Rightarrow> nat \<Rightarrow> nat" + +subsection \<open>Machine words\<close> + +definition word_update :: "'a::len word \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'b::len word \<Rightarrow> 'a word" where + "word_update v lo hi w = + (let sz = size v in + of_bl (take (sz-hi-1) (to_bl v) @ to_bl w @ drop (sz-lo) (to_bl v)))" + +end diff --git a/snapshots/isabelle/lib/lem/LemExtraDefs.thy b/snapshots/isabelle/lib/lem/LemExtraDefs.thy new file mode 100644 index 00000000..c14a669f --- /dev/null +++ b/snapshots/isabelle/lib/lem/LemExtraDefs.thy @@ -0,0 +1,1259 @@ +(*========================================================================*) +(* Lem *) +(* *) +(* Dominic Mulligan, University of Cambridge *) +(* Francesco Zappa Nardelli, INRIA Paris-Rocquencourt *) +(* Gabriel Kerneis, University of Cambridge *) +(* Kathy Gray, University of Cambridge *) +(* Peter Boehm, University of Cambridge (while working on Lem) *) +(* Peter Sewell, University of Cambridge *) +(* Scott Owens, University of Kent *) +(* Thomas Tuerk, University of Cambridge *) +(* Brian Campbell, University of Edinburgh *) +(* Shaked Flur, University of Cambridge *) +(* Thomas Bauereiss, University of Cambridge *) +(* Stephen Kell, University of Cambridge *) +(* Thomas Williams *) +(* Lars Hupel *) +(* Basile Clement *) +(* *) +(* The Lem sources are copyright 2010-2018 *) +(* by the authors above and Institut National de Recherche en *) +(* Informatique et en Automatique (INRIA). *) +(* *) +(* All files except ocaml-lib/pmap.{ml,mli} and ocaml-libpset.{ml,mli} *) +(* are distributed under the license below. The former are distributed *) +(* under the LGPLv2, as in the LICENSE file. *) +(* *) +(* *) +(* Redistribution and use in source and binary forms, with or without *) +(* modification, are permitted provided that the following conditions *) +(* are met: *) +(* 1. Redistributions of source code must retain the above copyright *) +(* notice, this list of conditions and the following disclaimer. *) +(* 2. Redistributions in binary form must reproduce the above copyright *) +(* notice, this list of conditions and the following disclaimer in the *) +(* documentation and/or other materials provided with the distribution. *) +(* 3. The names of the authors may not be used to endorse or promote *) +(* products derived from this software without specific prior written *) +(* permission. *) +(* *) +(* THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS *) +(* OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *) +(* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE *) +(* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY *) +(* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL *) +(* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE *) +(* GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS *) +(* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER *) +(* IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR *) +(* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN *) +(* IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) +(*========================================================================*) + +chapter \<open>Auxiliary Definitions needed by Lem\<close> + +theory "LemExtraDefs" + +imports + Main + "~~/src/HOL/Library/Permutation" + "~~/src/HOL/Library/While_Combinator" +begin + +subsection \<open>General\<close> + +consts failwith :: " 'a \<Rightarrow> 'b" + +subsection \<open>Lists\<close> + +fun index :: " 'a list \<Rightarrow> nat \<Rightarrow> 'a option " where + "index [] n = None" + | "index (x # xs) 0 = Some x" + | "index (x # xs) (Suc n) = index xs n" + +lemma index_eq_some [simp]: + "index l n = Some x \<longleftrightarrow> (n < length l \<and> (x = l ! n))" +proof (induct l arbitrary: n x) + case Nil thus ?case by simp +next + case (Cons e es n x) + note ind_hyp = this + + show ?case + proof (cases n) + case 0 thus ?thesis by auto + next + case (Suc n') + with ind_hyp show ?thesis by simp + qed +qed + +lemma index_eq_none [simp]: + "index l n = None \<longleftrightarrow> length l \<le> n" +by (rule iffD1[OF Not_eq_iff]) auto + + +lemma index_simps [simp]: + "length l \<le> n \<Longrightarrow> index l n = None" + "n < length l \<Longrightarrow> index l n = Some (l ! n)" +by (simp_all) + +fun find_indices :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> nat list" where + "find_indices P [] = []" + | "find_indices P (x # xs) = (if P x then 0 # (map Suc (find_indices P xs)) else (map Suc (find_indices P xs)))" + +lemma length_find_indices : + "length (find_indices P l) \<le> length l" +by (induct l) auto + +lemma sorted_map_suc : + "sorted l \<Longrightarrow> sorted (map Suc l)" +by (induct l) (simp_all add: sorted_Cons) + +lemma sorted_find_indices : + "sorted (find_indices P xs)" +proof (induct xs) + case Nil thus ?case by simp +next + case (Cons x xs) + from sorted_map_suc[OF this] + show ?case + by (simp add: sorted_Cons) +qed + +lemma find_indices_set [simp] : + "set (find_indices P l) = {i. i < length l \<and> P (l ! i)}" +proof (intro set_eqI) + fix i + show "i \<in> set (find_indices P l) \<longleftrightarrow> (i \<in> {i. i < length l \<and> P (l ! i)})" + proof (induct l arbitrary: i) + case Nil thus ?case by simp + next + case (Cons x l' i) + note ind_hyp = this + show ?case + proof (cases i) + case 0 thus ?thesis by auto + next + case (Suc i') with ind_hyp[of i'] show ?thesis by auto + qed + qed +qed + +definition find_index where + "find_index P xs = (case find_indices P xs of + [] \<Rightarrow> None + | i # _ \<Rightarrow> Some i)" + +lemma find_index_eq_some [simp] : + "(find_index P xs = Some ii) \<longleftrightarrow> (ii < length xs \<and> P (xs ! ii) \<and> (\<forall>i' < ii. \<not>(P (xs ! i'))))" + (is "?lhs = ?rhs") +proof (cases "find_indices P xs") + case Nil + with find_indices_set[of P xs] + show ?thesis + unfolding find_index_def by auto +next + case (Cons i il) note find_indices_eq = this + + from sorted_find_indices[of P xs] find_indices_eq + have "sorted (i # il)" by simp + hence i_leq: "\<And>i'. i' \<in> set (i # il) \<Longrightarrow> i \<le> i'" unfolding sorted_Cons by auto + + from find_indices_set[of P xs, unfolded find_indices_eq] + have set_i_il_eq:"\<And>i'. i' \<in> set (i # il) = (i' < length xs \<and> P (xs ! i'))" + by simp + + have lhs_eq: "find_index P xs = Some i" + unfolding find_index_def find_indices_eq by simp + + show ?thesis + proof (intro iffI) + assume ?lhs + with lhs_eq have ii_eq[simp]: "ii = i" by simp + + from set_i_il_eq[of i] i_leq[unfolded set_i_il_eq] + show ?rhs by auto (metis leD less_trans) + next + assume ?rhs + with set_i_il_eq[of ii] + have "ii \<in> set (i # il) \<and> (ii \<le> i)" + by (metis leI length_pos_if_in_set nth_Cons_0 nth_mem set_i_il_eq) + + with i_leq [of ii] have "i = ii" by simp + thus ?lhs unfolding lhs_eq by simp + qed +qed + +lemma find_index_eq_none [simp] : + "(find_index P xs = None) \<longleftrightarrow> (\<forall>x \<in> set xs. \<not>(P x))" (is "?lhs = ?rhs") +proof (rule iffD1[OF Not_eq_iff], intro iffI) + assume "\<not> ?lhs" + then obtain i where "find_index P xs = Some i" by auto + hence "i < length xs \<and> P (xs ! i)" by simp + thus "\<not> ?rhs" by auto +next + let ?p = "(\<lambda>i. i < length xs \<and> P(xs ! i))" + + assume "\<not> ?rhs" + then obtain i where "?p i" + by (metis in_set_conv_nth) + + from LeastI [of ?p, OF \<open>?p i\<close>] + have "?p (Least ?p)" . + + hence "find_index P xs = Some (Least ?p)" + by (subst find_index_eq_some) (metis (mono_tags) less_trans not_less_Least) + + thus "\<not> ?lhs" by blast +qed + +definition genlist where + "genlist f n = map f (upt 0 n)" + +lemma genlist_length [simp] : + "length (genlist f n) = n" +unfolding genlist_def by simp + +lemma genlist_simps [simp]: + "genlist f 0 = []" + "genlist f (Suc n) = genlist f n @ [f n]" +unfolding genlist_def by auto + +definition split_at where + "split_at n l = (take n l, drop n l)" + +fun delete_first :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> ('a list) option " where + "delete_first P [] = None" + | "delete_first P (x # xs) = + (if (P x) then Some xs else + map_option (\<lambda>xs'. x # xs') (delete_first P xs))" +declare delete_first.simps [simp del] + +lemma delete_first_simps [simp] : + "delete_first P [] = None" + "P x \<Longrightarrow> delete_first P (x # xs) = Some xs" + "\<not>(P x) \<Longrightarrow> delete_first P (x # xs) = map_option (\<lambda>xs'. x # xs') (delete_first P xs)" +unfolding delete_first.simps by auto + +lemmas delete_first_unroll = delete_first.simps(2) + + +lemma delete_first_eq_none [simp] : + "delete_first P l = None \<longleftrightarrow> (\<forall>x \<in> set l. \<not> (P x))" +by (induct l) (auto simp add: delete_first_unroll) + +lemma delete_first_eq_some : + "delete_first P l = (Some l') \<longleftrightarrow> (\<exists>l1 x l2. P x \<and> (\<forall>x \<in> set l1. \<not>(P x)) \<and> (l = l1 @ (x # l2)) \<and> (l' = l1 @ l2))" + (is "?lhs l l' = (\<exists>l1 x l2. ?rhs_body l1 x l2 l l')") +proof (induct l arbitrary: l') + case Nil thus ?case by simp +next + case (Cons e l l') + note ind_hyp = this + + show ?case + proof (cases "P e") + case True + show ?thesis + proof (rule iffI) + assume "?lhs (e # l) l'" + with \<open>P e\<close> have "l = l'" by simp + with \<open>P e\<close> have "?rhs_body [] e l' (e # l) l'" by simp + thus "\<exists>l1 x l2. ?rhs_body l1 x l2 (e # l) l'" by blast + next + assume "\<exists>l1 x l2. ?rhs_body l1 x l2 (e # l) l'" + then obtain l1 x l2 where body_ok: "?rhs_body l1 x l2 (e # l) l'" by blast + + from body_ok \<open>P e\<close> have l1_eq[simp]: "l = l'" + by (cases l1) (simp_all) + with \<open>P e\<close> show "?lhs (e # l) l'" by simp + qed + next + case False + define rhs_pred where "rhs_pred \<equiv> \<lambda>l1 x l2 l l'. ?rhs_body l1 x l2 l l'" + have rhs_fold: "\<And>l1 x l2 l l'. ?rhs_body l1 x l2 l l' = rhs_pred l1 x l2 l l'" + unfolding rhs_pred_def by simp + + have "(\<exists>z l1 x l2. rhs_pred l1 x l2 l z \<and> e # z = l') = (\<exists>l1 x l2. rhs_pred l1 x l2 (e # l) l')" + proof (intro iffI) + assume "\<exists>z l1 x l2. rhs_pred l1 x l2 l z \<and> e # z = l'" + then obtain z l1 x l2 where "rhs_pred l1 x l2 l z" and l'_eq: "l' = e # z" by auto + with \<open>\<not>(P e)\<close> have "rhs_pred (e # l1) x l2 (e # l) l'" + unfolding rhs_pred_def by simp + thus "\<exists>l1 x l2. rhs_pred l1 x l2 (e # l) l'" by blast + next + assume "\<exists>l1 x l2. rhs_pred l1 x l2 (e # l) l'" + then obtain l1 x l2 where "rhs_pred l1 x l2 (e # l) l'" by blast + with \<open>\<not> (P e)\<close> obtain l1' where l1_eq[simp]: "l1 = e # l1'" + unfolding rhs_pred_def by (cases l1) (auto) + + with \<open>rhs_pred l1 x l2 (e # l) l'\<close> + have "rhs_pred l1' x l2 l (l1' @ l2) \<and> e # (l1' @ l2) = l'" + unfolding rhs_pred_def by (simp) + thus "\<exists>z l1 x l2. rhs_pred l1 x l2 l z \<and> e # z = l'" by blast + qed + with \<open>\<not> P e\<close> show ?thesis + unfolding rhs_fold + by (simp add: ind_hyp[unfolded rhs_fold]) + qed +qed + + +lemma perm_eval [code] : + "perm [] l \<longleftrightarrow> l = []" (is ?g1) + "perm (x # xs) l \<longleftrightarrow> (case delete_first (\<lambda>e. e = x) l of + None => False + | Some l' => perm xs l')" (is ?g2) +proof - + show ?g1 by auto +next + show ?g2 + proof (cases "delete_first (\<lambda>e. e = x) l") + case None note del_eq = this + hence "x \<notin> set l" by auto + with perm_set_eq [of "x # xs" l] + have "\<not> perm (x # xs) l" by auto + thus ?thesis unfolding del_eq by simp + next + case (Some l') note del_eq = this + + from del_eq[unfolded delete_first_eq_some] + obtain l1 l2 where l_eq: "l = l1 @ [x] @ l2" and l'_eq: "l' = l1 @ l2" by auto + + have "(x # xs <~~> l1 @ x # l2) = (xs <~~> l1 @ l2)" + proof - + from perm_append_swap [of l1 "[x]"] + perm_append2 [of "l1 @ [x]" "x # l1" l2] + have "l1 @ x # l2 <~~> x # (l1 @ l2)" by simp + hence "x # xs <~~> l1 @ x # l2 \<longleftrightarrow> x # xs <~~> x # (l1 @ l2)" + by (metis perm.trans perm_sym) + thus ?thesis by simp + qed + with del_eq l_eq l'_eq show ?thesis by simp + qed +qed + + +fun sorted_by :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> bool " where + "sorted_by cmp [] = True" + | "sorted_by cmp [_] = True" + | "sorted_by cmp (x1 # x2 # xs) = ((cmp x1 x2) \<and> sorted_by cmp (x2 # xs))" + +lemma sorted_by_lesseq [simp] : + "sorted_by ((op \<le>) :: ('a::{linorder}) => 'a => bool) = sorted" +proof (rule ext) + fix l :: "'a list" + show "sorted_by (op \<le>) l = sorted l" + proof (induct l) + case Nil thus ?case by simp + next + case (Cons x xs) + thus ?case by (cases xs) (simp_all) + qed +qed + +lemma sorted_by_cons_imp : + "sorted_by cmp (x # xs) \<Longrightarrow> sorted_by cmp xs" +by (cases xs) simp_all + +lemma sorted_by_cons_trans : + assumes trans_cmp: "transp cmp" + shows "sorted_by cmp (x # xs) = ((\<forall>x' \<in> set xs . cmp x x') \<and> sorted_by cmp xs)" +proof (induct xs arbitrary: x) + case Nil thus ?case by simp +next + case (Cons x2 xs x1) + note ind_hyp = this + + from trans_cmp + show ?case + by (auto simp add: ind_hyp transp_def) +qed + + +fun insert_sort_insert_by :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list " where + "insert_sort_insert_by cmp e ([]) = ( [e])" +| "insert_sort_insert_by cmp e (x # xs) = ( if cmp e x then (e # (x # xs)) else x # (insert_sort_insert_by cmp e xs))" + + +lemma insert_sort_insert_by_length [simp] : + "length (insert_sort_insert_by cmp e l) = Suc (length l)" +by (induct l) auto + +lemma insert_sort_insert_by_set [simp] : + "set (insert_sort_insert_by cmp e l) = insert e (set l)" +by (induct l) auto + +lemma insert_sort_insert_by_perm : + "(insert_sort_insert_by cmp e l) <~~> (e # l)" +proof (induct l) + case Nil thus ?case by simp +next + case (Cons e2 l') + note ind_hyp = this + + have "e2 # e # l' <~~> e # e2 # l'" by (rule perm.swap) + hence "e2 # insert_sort_insert_by cmp e l' <~~> e # e2 # l'" + using ind_hyp by (metis cons_perm_eq perm.trans) + thus ?case by simp +qed + + +lemma insert_sort_insert_by_sorted_by : +assumes cmp_cases: "\<And>y. y \<in> set l \<Longrightarrow> \<not> (cmp e y) \<Longrightarrow> cmp y e" +assumes cmp_trans: "transp cmp" +shows "sorted_by cmp l \<Longrightarrow> sorted_by cmp (insert_sort_insert_by cmp e l)" +using cmp_cases +proof (induct l) + case Nil thus ?case by simp +next + case (Cons x1 l') + note ind_hyp = Cons(1) + note sorted_x1_l' = Cons(2) + note cmp_cases = Cons(3) + + show ?case + proof (cases l') + case Nil with cmp_cases show ?thesis by simp + next + case (Cons x2 l'') note l'_eq = this + + from l'_eq sorted_x1_l' have "cmp x1 x2" "sorted_by cmp l'" by simp_all + + show ?thesis + proof (cases "cmp e x1") + case True + with \<open>cmp x1 x2\<close> \<open>sorted_by cmp l'\<close> + have "sorted_by cmp (x1 # l')" + unfolding l'_eq by (simp) + with \<open>cmp e x1\<close> + show ?thesis by simp + next + case False + + with cmp_cases have "cmp x1 e" by simp + have "\<And>x'. x' \<in> set l' \<Longrightarrow> cmp x1 x'" + proof - + fix x' + assume "x' \<in> set l'" + hence "x' = x2 \<or> cmp x2 x'" + using \<open>sorted_by cmp l'\<close> l'_eq sorted_by_cons_trans [OF cmp_trans, of x2 l''] + by auto + with transpD[OF cmp_trans, of x1 x2 x'] \<open>cmp x1 x2\<close> + show "cmp x1 x'" by blast + qed + hence "sorted_by cmp (x1 # insert_sort_insert_by cmp e l')" + using ind_hyp [OF \<open>sorted_by cmp l'\<close>] \<open>cmp x1 e\<close> cmp_cases + unfolding sorted_by_cons_trans[OF cmp_trans] + by simp + with \<open>\<not>(cmp e x1)\<close> + show ?thesis by simp + qed + qed +qed + + + +fun insert_sort_by :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list " where + "insert_sort_by cmp [] = []" + | "insert_sort_by cmp (x # xs) = insert_sort_insert_by cmp x (insert_sort_by cmp xs)" + + +lemma insert_sort_by_perm : + "(insert_sort_by cmp l) <~~> l" +proof (induct l) + case Nil thus ?case by simp +next + case (Cons x l) + thus ?case + by simp (metis cons_perm_eq insert_sort_insert_by_perm perm.trans) +qed + +lemma insert_sort_by_length [simp]: + "length (insert_sort_by cmp l) = length l" +by (induct l) auto + +lemma insert_sort_by_set [simp]: + "set (insert_sort_by cmp l) = set l" +by (induct l) auto + +definition sort_by where + "sort_by = insert_sort_by" + +lemma sort_by_simps [simp]: + "length (sort_by cmp l) = length l" + "set (sort_by cmp l) = set l" +unfolding sort_by_def by simp_all + +lemma sort_by_perm : + "sort_by cmp l <~~> l" +unfolding sort_by_def +by (simp add: insert_sort_by_perm) + +subsection \<open>Maps\<close> + +definition map_image :: "('v \<Rightarrow> 'w) \<Rightarrow> ('k, 'v) map \<Rightarrow> ('k, 'w) map" where + "map_image f m = (\<lambda>k. map_option f (m k))" + +definition map_domain_image :: "('k \<Rightarrow> 'v \<Rightarrow> 'w) \<Rightarrow> ('k, 'v) map \<Rightarrow> ('k, 'w) map" where + "map_domain_image f m = (\<lambda>k. map_option (f k) (m k))" + + +lemma map_image_simps [simp]: + "(map_image f m) k = None \<longleftrightarrow> m k = None" + "(map_image f m) k = Some x \<longleftrightarrow> (\<exists>x'. (m k = Some x') \<and> (x = f x'))" + "(map_image f Map.empty) = Map.empty" + "(map_image f (m (k \<mapsto> v)) = (map_image f m) (k \<mapsto> f v))" +unfolding map_image_def by auto + +lemma map_image_dom_ran [simp]: + "dom (map_image f m) = dom m" + "ran (map_image f m) = f ` (ran m)" +unfolding dom_def ran_def by auto + +definition map_to_set :: "('k, 'v) map \<Rightarrow> ('k * 'v) set" where + "map_to_set m = { (k, v) . m k = Some v }" + +lemma map_to_set_simps [simp] : + "map_to_set Map.empty = {}" (is ?g1) + "map_to_set (m ((k::'k) \<mapsto> (v::'v))) = (insert (k, v) (map_to_set (m |` (- {k}))))" (is ?g2) +proof - + show ?g1 unfolding map_to_set_def by simp +next + show ?g2 + proof (rule set_eqI) + fix kv :: "('k * 'v)" + obtain k' v' where kv_eq[simp]: "kv = (k', v')" by (rule prod.exhaust) + + show "(kv \<in> map_to_set (m(k \<mapsto> v))) = (kv \<in> insert (k, v) (map_to_set (m |` (- {k}))))" + by (auto simp add: map_to_set_def) + qed +qed + + +subsection \<open>Sets\<close> + +definition "set_choose s \<equiv> (SOME x. (x \<in> s))" + +definition without_trans_edges :: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set" where + "without_trans_edges S \<equiv> + let ts = trancl S in + { (x, y) \<in> S. \<forall>z \<in> snd ` S. x \<noteq> z \<and> y \<noteq> z \<longrightarrow> \<not> ((x, z) \<in> ts \<and> (z, y) \<in> ts)}" + +definition unbounded_lfp :: "'a set \<Rightarrow> ('a set \<Rightarrow> 'a set) \<Rightarrow> 'a set" where + "unbounded_lfp S f \<equiv> + while (\<lambda>x. x \<subset> S) f S" + +definition unbounded_gfp :: "'a set \<Rightarrow> ('a set \<Rightarrow> 'a set) \<Rightarrow> 'a set" where + "unbounded_gfp S f \<equiv> + while (\<lambda>x. S \<subset> x) f S" + +lemma set_choose_thm[simp]: + "s \<noteq> {} \<Longrightarrow> (set_choose s) \<in> s" +unfolding set_choose_def +by (rule someI_ex) auto + +lemma set_choose_sing [simp]: + "set_choose {x} = x" + unfolding set_choose_def + by auto + +lemma set_choose_code [code]: + "set_choose (set [x]) = x" +by auto + +lemma set_choose_in [intro] : + assumes "s \<noteq> {}" + shows "set_choose s \<in> s" +proof - + from \<open>s \<noteq> {}\<close> + obtain x where "x \<in> s" by auto + thus ?thesis + unfolding set_choose_def + by (rule someI) +qed + + +definition set_case where + "set_case s c_empty c_sing c_else = + (if (s = {}) then c_empty else + (if (card s = 1) then c_sing (set_choose s) else + c_else))" + +lemma set_case_simps [simp] : + "set_case {} c_empty c_sing c_else = c_empty" + "set_case {x} c_empty c_sing c_else = c_sing x" + "card s > 1 \<Longrightarrow> set_case s c_empty c_sing c_else = c_else" + "\<not>(finite s) \<Longrightarrow> set_case s c_empty c_sing c_else = c_else" +unfolding set_case_def by auto + +lemma set_case_simp_insert2 [simp] : +assumes x12_neq: "x1 \<noteq> x2" +shows "set_case (insert x1 (insert x2 xs)) c_empty c_sing c_else = c_else" +proof (cases "finite xs") + case False thus ?thesis by (simp) +next + case True note fin_xs = this + + have "card {x1,x2} \<le> card (insert x1 (insert x2 xs))" + by (rule card_mono) (auto simp add: fin_xs) + with x12_neq have "1 < card (insert x1 (insert x2 xs))" by simp + thus ?thesis by auto +qed + +lemma set_case_code [code] : + "set_case (set []) c_empty c_sing c_else = c_empty" + "set_case (set [x]) c_empty c_sing c_else = c_sing x" + "set_case (set (x1 # x2 # xs)) c_empty c_sing c_else = + (if (x1 = x2) then + set_case (set (x2 # xs)) c_empty c_sing c_else + else + c_else)" +by auto + +definition set_lfp:: "'a set \<Rightarrow> ('a set \<Rightarrow> 'a set) \<Rightarrow> 'a set" where + "set_lfp s f = lfp (\<lambda>s'. f s' \<union> s)" + +lemma set_lfp_tail_rec_def : +assumes mono_f: "mono f" +shows "set_lfp s f = (if (f s) \<subseteq> s then s else (set_lfp (s \<union> f s) f))" (is "?ls = ?rs") +proof (cases "f s \<subseteq> s") + case True note fs_sub_s = this + + from fs_sub_s have "\<Inter>{u. f u \<union> s \<subseteq> u} = s" by auto + hence "?ls = s" unfolding set_lfp_def lfp_def . + with fs_sub_s show "?ls = ?rs" by simp +next + case False note not_fs_sub_s = this + + from mono_f have mono_f': "mono (\<lambda>s'. f s' \<union> s)" + unfolding mono_def by auto + + have "\<Inter>{u. f u \<union> s \<subseteq> u} = \<Inter>{u. f u \<union> (s \<union> f s) \<subseteq> u}" (is "\<Inter>?S1 = \<Inter>?S2") + proof + have "?S2 \<subseteq> ?S1" by auto + thus "\<Inter>?S1 \<subseteq> \<Inter>?S2" by (rule Inf_superset_mono) + next + { fix e + assume "e \<in> \<Inter>?S2" + hence S2_prop: "\<And>s'. f s' \<subseteq> s' \<Longrightarrow> s \<subseteq> s' \<Longrightarrow> f s \<subseteq> s' \<Longrightarrow> e \<in> s'" by simp + + { fix s' + assume "f s' \<subseteq> s'" "s \<subseteq> s'" + + from mono_f \<open>s \<subseteq> s'\<close> + have "f s \<subseteq> f s'" unfolding mono_def by simp + with \<open>f s' \<subseteq> s'\<close> have "f s \<subseteq> s'" by simp + with \<open>f s' \<subseteq> s'\<close> \<open>s \<subseteq> s'\<close> S2_prop + have "e \<in> s'" by simp + } + hence "e \<in> \<Inter>?S1" by simp + } + thus "\<Inter>?S2 \<subseteq> \<Inter>?S1" by auto + qed + hence "?ls = (set_lfp (s \<union> f s) f)" + unfolding set_lfp_def lfp_def . + with not_fs_sub_s show "?ls = ?rs" by simp +qed + +lemma set_lfp_simps [simp] : +"mono f \<Longrightarrow> f s \<subseteq> s \<Longrightarrow> set_lfp s f = s" +"mono f \<Longrightarrow> \<not>(f s \<subseteq> s) \<Longrightarrow> set_lfp s f = (set_lfp (s \<union> f s) f)" +by (metis set_lfp_tail_rec_def)+ + + +fun insert_in_list_at_arbitrary_pos where + "insert_in_list_at_arbitrary_pos x [] = {[x]}" + | "insert_in_list_at_arbitrary_pos x (y # ys) = + insert (x # y # ys) ((\<lambda>l. y # l) ` (insert_in_list_at_arbitrary_pos x ys))" + +lemma insert_in_list_at_arbitrary_pos_thm : + "xl \<in> insert_in_list_at_arbitrary_pos x l \<longleftrightarrow> + (\<exists>l1 l2. l = l1 @ l2 \<and> xl = l1 @ [x] @ l2)" +proof (induct l arbitrary: xl) + case Nil thus ?case by simp +next + case (Cons y l xyl) + note ind_hyp = this + + show ?case + proof (rule iffI) + assume xyl_in: "xyl \<in> insert_in_list_at_arbitrary_pos x (y # l)" + show "\<exists>l1 l2. y # l = l1 @ l2 \<and> xyl = l1 @ [x] @ l2" + proof (cases "xyl = x # y # l") + case True + hence "y # l = [] @ (y # l) \<and> xyl = [] @ [x] @ (y # l)" by simp + thus ?thesis by blast + next + case False + with xyl_in have "xyl \<in> op # y ` insert_in_list_at_arbitrary_pos x l" by simp + with ind_hyp obtain l1 l2 where "l = l1 @ l2 \<and> xyl = y # l1 @ x # l2" + by (auto simp add: image_def Bex_def) + hence "y # l = (y # l1) @ l2 \<and> xyl = (y # l1) @ [x] @ l2" by simp + thus ?thesis by blast + qed + next + assume "\<exists>l1 l2. y # l = l1 @ l2 \<and> xyl = l1 @ [x] @ l2" + then obtain l1 l2 where yl_eq: "y # l = l1 @ l2" and xyl_eq: "xyl = l1 @ [x] @ l2" by blast + show "xyl \<in> insert_in_list_at_arbitrary_pos x (y # l)" + proof (cases l1) + case Nil + with yl_eq xyl_eq + have "xyl = x # y # l" by simp + thus ?thesis by simp + next + case (Cons y' l1') + with yl_eq have l1_eq: "l1 = y # l1'" and l_eq: "l = l1' @ l2" by simp_all + + have "\<exists>l1'' l2''. l = l1'' @ l2'' \<and> l1' @ [x] @ l2 = l1'' @ [x] @ l2''" + apply (rule_tac exI[where x = l1']) + apply (rule_tac exI [where x = l2]) + apply (simp add: l_eq) + done + hence "(l1' @ [x] @ l2) \<in> insert_in_list_at_arbitrary_pos x l" + unfolding ind_hyp by blast + hence "\<exists>l'. l' \<in> insert_in_list_at_arbitrary_pos x l \<and> l1 @ x # l2 = y # l'" + by (rule_tac exI [where x = "l1' @ [x] @ l2"]) (simp add: l1_eq) + thus ?thesis + by (simp add: image_def Bex_def xyl_eq) + qed + qed +qed + +definition list_of_set_set :: "'a set \<Rightarrow> ('a list) set" where +"list_of_set_set s = { l . (set l = s) \<and> distinct l }" + +lemma list_of_set_set_empty [simp]: + "list_of_set_set {} = {[]}" +unfolding list_of_set_set_def by auto + +lemma list_of_set_set_insert [simp] : + "list_of_set_set (insert x s) = + \<Union> ((insert_in_list_at_arbitrary_pos x) ` (list_of_set_set (s - {x})))" + (is "?lhs = ?rhs") +proof (intro set_eqI) + fix l + + have "(set l = insert x s \<and> distinct l) \<longleftrightarrow> (\<exists>l1 l2. set (l1 @ l2) = s - {x} \<and> distinct (l1 @ l2) \<and> l = l1 @ x # l2)" + proof (intro iffI) + assume "set l = insert x s \<and> distinct l" + hence set_l_eq: "set l = insert x s" and "distinct l" by simp_all + + from \<open>set l = insert x s\<close> + have "x \<in> set l" by simp + then obtain l1 l2 where l_eq: "l = l1 @ x # l2" + unfolding in_set_conv_decomp by blast + + from \<open>distinct l\<close> l_eq + have "distinct (l1 @ l2)" and x_nin: "x \<notin> set (l1 @ l2)" + by auto + + from x_nin set_l_eq[unfolded l_eq] + have set_l12_eq: "set (l1 @ l2) = s - {x}" + by auto + + from \<open>distinct (l1 @ l2)\<close> l_eq set_l12_eq + show "\<exists>l1 l2. set (l1 @ l2) = s - {x} \<and> distinct (l1 @ l2) \<and> l = l1 @ x # l2" + by blast + next + assume "\<exists>l1 l2. set (l1 @ l2) = s - {x} \<and> distinct (l1 @ l2) \<and> l = l1 @ x # l2" + then obtain l1 l2 where "set (l1 @ l2) = s - {x}" "distinct (l1 @ l2)" "l = l1 @ x # l2" + by blast + thus "set l = insert x s \<and> distinct l" + by auto + qed + + thus "l \<in> list_of_set_set (insert x s) \<longleftrightarrow> l \<in> (\<Union> ((insert_in_list_at_arbitrary_pos x) ` (list_of_set_set (s - {x}))))" + unfolding list_of_set_set_def + by (simp add: insert_in_list_at_arbitrary_pos_thm ex_simps[symmetric] del: ex_simps) +qed + +lemma list_of_set_set_code [code]: + "list_of_set_set (set []) = {[]}" + "list_of_set_set (set (x # xs)) = + \<Union> ((insert_in_list_at_arbitrary_pos x) ` (list_of_set_set ((set xs) - {x})))" +by simp_all + +lemma list_of_set_set_is_empty : + "list_of_set_set s = {} \<longleftrightarrow> \<not> (finite s)" +proof - + have "finite s \<longleftrightarrow> (\<exists>l. set l = s \<and> distinct l)" + proof (rule iffI) + assume "\<exists>l. set l = s \<and> distinct l" then + obtain l where "s = set l" by blast + thus "finite s" by simp + next + assume "finite s" + thus "\<exists>l. set l = s \<and> distinct l" + proof (induct s) + case empty + show ?case by auto + next + case (insert e s) + note e_nin_s = insert(2) + from insert(3) obtain l where set_l: "set l = s" and dist_l: "distinct l" by blast + + from set_l have set_el: "set (e # l) = insert e s" by auto + from dist_l set_l e_nin_s have dist_el: "distinct (e # l)" by simp + + from set_el dist_el show ?case by blast + qed + qed + thus ?thesis + unfolding list_of_set_set_def by simp +qed + +definition list_of_set :: "'a set \<Rightarrow> 'a list" where + "list_of_set s = set_choose (list_of_set_set s)" + +lemma list_of_set [simp] : + assumes fin_s: "finite s" + shows "set (list_of_set s) = s" + "distinct (list_of_set s)" +proof - + from fin_s list_of_set_set_is_empty[of s] + have "\<not> (list_of_set_set s = {})" by simp + hence "list_of_set s \<in> list_of_set_set s" + unfolding list_of_set_def + by (rule set_choose_thm) + thus "set (list_of_set s) = s" + "distinct (list_of_set s)" unfolding list_of_set_set_def + by simp_all +qed + +lemma list_of_set_in: + "finite s \<Longrightarrow> list_of_set s \<in> list_of_set_set s" +unfolding list_of_set_def +by (metis list_of_set_set_is_empty set_choose_thm) + +definition ordered_list_of_set where + "ordered_list_of_set cmp s = set_choose (sort_by cmp ` list_of_set_set s)" + +subsection \<open>sum\<close> + +find_consts "'a list => ('a list * _)" + +fun sum_partition :: "('a + 'b) list \<Rightarrow> 'a list * 'b list" where + "sum_partition [] = ([], [])" +| "sum_partition ((Inl l) # lrs) = + (let (ll, rl) = sum_partition lrs in + (l # ll, rl))" +| "sum_partition ((Inr r) # lrs) = + (let (ll, rl) = sum_partition lrs in + (ll, r # rl))" + +lemma sum_partition_length : + "List.length lrs = List.length (fst (sum_partition lrs)) + List.length (snd (sum_partition lrs))" +proof (induct lrs) + case Nil thus ?case by simp +next + case (Cons lr lrs) thus ?case + by (cases lr) (auto split: prod.split) +qed + +subsection \<open>sorting\<close> + +subsection \<open>Strings\<close> + +lemma explode_str_simp [simp] : + "String.explode (STR l) = l" +by (metis STR_inverse UNIV_I) + +declare String.literal.explode_inverse [simp] + +subsection \<open>num to string conversions\<close> + +definition nat_list_to_string :: "nat list \<Rightarrow> string" where + "nat_list_to_string nl = map char_of_nat nl" + +definition is_digit where + "is_digit (n::nat) = (n < 10)" + +lemma is_digit_simps[simp] : + "n < 10 \<Longrightarrow> is_digit n" + "\<not>(n < 10) \<Longrightarrow> \<not>(is_digit n)" +unfolding is_digit_def by simp_all + +lemma is_digit_expand : + "is_digit n \<longleftrightarrow> + (n = 0) \<or> (n = 1) \<or> (n = 2) \<or> (n = 3) \<or> (n = 4) \<or> + (n = 5) \<or> (n = 6) \<or> (n = 7) \<or> (n = 8) \<or> (n = 9)" +unfolding is_digit_def by auto + +lemmas is_digitE = is_digit_expand[THEN iffD1,elim_format] +lemmas is_digitI = is_digit_expand[THEN iffD2,rule_format] + +definition is_digit_char where + "is_digit_char c \<longleftrightarrow> + (c = CHR ''0'') \<or> (c = CHR ''5'') \<or> + (c = CHR ''1'') \<or> (c = CHR ''6'') \<or> + (c = CHR ''2'') \<or> (c = CHR ''7'') \<or> + (c = CHR ''3'') \<or> (c = CHR ''8'') \<or> + (c = CHR ''4'') \<or> (c = CHR ''9'')" + +lemma is_digit_char_simps[simp] : + "is_digit_char (CHR ''0'')" + "is_digit_char (CHR ''1'')" + "is_digit_char (CHR ''2'')" + "is_digit_char (CHR ''3'')" + "is_digit_char (CHR ''4'')" + "is_digit_char (CHR ''5'')" + "is_digit_char (CHR ''6'')" + "is_digit_char (CHR ''7'')" + "is_digit_char (CHR ''8'')" + "is_digit_char (CHR ''9'')" +unfolding is_digit_char_def by simp_all + +lemmas is_digit_charE = is_digit_char_def[THEN iffD1,elim_format] +lemmas is_digit_charI = is_digit_char_def[THEN iffD2,rule_format] + +definition digit_to_char :: "nat \<Rightarrow> char" where + "digit_to_char n = ( + if n = 0 then CHR ''0'' + else if n = 1 then CHR ''1'' + else if n = 2 then CHR ''2'' + else if n = 3 then CHR ''3'' + else if n = 4 then CHR ''4'' + else if n = 5 then CHR ''5'' + else if n = 6 then CHR ''6'' + else if n = 7 then CHR ''7'' + else if n = 8 then CHR ''8'' + else if n = 9 then CHR ''9'' + else CHR ''X'')" + +lemma digit_to_char_simps [simp]: + "digit_to_char 0 = CHR ''0''" + "digit_to_char (Suc 0) = CHR ''1''" + "digit_to_char 2 = CHR ''2''" + "digit_to_char 3 = CHR ''3''" + "digit_to_char 4 = CHR ''4''" + "digit_to_char 5 = CHR ''5''" + "digit_to_char 6 = CHR ''6''" + "digit_to_char 7 = CHR ''7''" + "digit_to_char 8 = CHR ''8''" + "digit_to_char 9 = CHR ''9''" + "n > 9 \<Longrightarrow> digit_to_char n = CHR ''X''" +unfolding digit_to_char_def +by simp_all + +definition char_to_digit :: "char \<Rightarrow> nat" where + "char_to_digit c = ( + if c = CHR ''0'' then 0 + else if c = CHR ''1'' then 1 + else if c = CHR ''2'' then 2 + else if c = CHR ''3'' then 3 + else if c = CHR ''4'' then 4 + else if c = CHR ''5'' then 5 + else if c = CHR ''6'' then 6 + else if c = CHR ''7'' then 7 + else if c = CHR ''8'' then 8 + else if c = CHR ''9'' then 9 + else 10)" + +lemma char_to_digit_simps [simp]: + "char_to_digit (CHR ''0'') = 0" + "char_to_digit (CHR ''1'') = 1" + "char_to_digit (CHR ''2'') = 2" + "char_to_digit (CHR ''3'') = 3" + "char_to_digit (CHR ''4'') = 4" + "char_to_digit (CHR ''5'') = 5" + "char_to_digit (CHR ''6'') = 6" + "char_to_digit (CHR ''7'') = 7" + "char_to_digit (CHR ''8'') = 8" + "char_to_digit (CHR ''9'') = 9" +unfolding char_to_digit_def by simp_all + + +lemma diget_to_char_inv[simp]: +assumes is_digit: "is_digit n" +shows "char_to_digit (digit_to_char n) = n" +using is_digit unfolding is_digit_expand by auto + +lemma char_to_diget_inv[simp]: +assumes is_digit: "is_digit_char c" +shows "digit_to_char (char_to_digit c) = c" +using is_digit +unfolding char_to_digit_def is_digit_char_def +by auto + +lemma char_to_digit_div_mod [simp]: +assumes is_digit: "is_digit_char c" +shows "char_to_digit c < 10" +using is_digit +unfolding char_to_digit_def is_digit_char_def +by auto + + +lemma is_digit_char_intro[simp]: + "is_digit (char_to_digit c) = is_digit_char c" +unfolding char_to_digit_def is_digit_char_def is_digit_expand +by auto + +lemma is_digit_intro[simp]: + "is_digit_char (digit_to_char n) = is_digit n" +unfolding digit_to_char_def is_digit_char_def is_digit_expand +by auto + +lemma digit_to_char_11: +"digit_to_char n1 = digit_to_char n2 \<Longrightarrow> + (is_digit n1 = is_digit n2) \<and> (is_digit n1 \<longrightarrow> (n1 = n2))" +by (metis diget_to_char_inv is_digit_intro) + +lemma char_to_digit_11: +"char_to_digit c1 = char_to_digit c2 \<Longrightarrow> + (is_digit_char c1 = is_digit_char c2) \<and> (is_digit_char c1 \<longrightarrow> (c1 = c2))" +by (metis char_to_diget_inv is_digit_char_intro) + +function nat_to_string :: "nat \<Rightarrow> string" where + "nat_to_string n = + (if (is_digit n) then [digit_to_char n] else + nat_to_string (n div 10) @ [digit_to_char (n mod 10)])" +by auto +termination + by (relation "measure id") (auto simp add: is_digit_def) + +definition int_to_string :: "int \<Rightarrow> string" where + "int_to_string i \<equiv> + if i < 0 then + ''-'' @ nat_to_string (nat (abs i)) + else + nat_to_string (nat i)" + +lemma nat_to_string_simps[simp]: + "is_digit n \<Longrightarrow> nat_to_string n = [digit_to_char n]" + "\<not>(is_digit n) \<Longrightarrow> nat_to_string n = nat_to_string (n div 10) @ [digit_to_char (n mod 10)]" +by simp_all +declare nat_to_string.simps[simp del] + +lemma nat_to_string_neq_nil[simp]: + "nat_to_string n \<noteq> []" + by (cases "is_digit n") simp_all + +lemmas nat_to_string_neq_nil2[simp] = nat_to_string_neq_nil[symmetric] + +lemma nat_to_string_char_to_digit [simp]: + "is_digit_char c \<Longrightarrow> nat_to_string (char_to_digit c) = [c]" +by auto + +lemma nat_to_string_11[simp] : + "(nat_to_string n1 = nat_to_string n2) \<longleftrightarrow> n1 = n2" +proof (rule iffI) + assume "n1 = n2" + thus "nat_to_string n1 = nat_to_string n2" by simp +next + assume "nat_to_string n1 = nat_to_string n2" + thus "n1 = n2" + proof (induct n2 arbitrary: n1 rule: less_induct) + case (less n2') + note ind_hyp = this(1) + note n2s_eq = less(2) + + have is_dig_eq: "is_digit n2' = is_digit n1" using n2s_eq + apply (cases "is_digit n2'") + apply (case_tac [!] "is_digit n1") + apply (simp_all) + done + + show ?case + proof (cases "is_digit n2'") + case True with n2s_eq is_dig_eq show ?thesis by simp (metis digit_to_char_11) + next + case False + with is_dig_eq have not_digs : "\<not> (is_digit n1)" "\<not> (is_digit n2')" by simp_all + + from not_digs(2) have "n2' div 10 < n2'" unfolding is_digit_def by auto + note ind_hyp' = ind_hyp [OF this, of "n1 div 10"] + + from not_digs n2s_eq ind_hyp' digit_to_char_11[of "n1 mod 10" "n2' mod 10"] + have "(n1 mod 10) = (n2' mod 10)" "n1 div 10 = n2' div 10" by simp_all + thus "n1 = n2'" by (metis div_mult_mod_eq) + qed + qed +qed + +definition "is_nat_string s \<equiv> (\<forall>c\<in>set s. is_digit_char c)" +definition "is_strong_nat_string s \<equiv> is_nat_string s \<and> (s \<noteq> []) \<and> (hd s = CHR ''0'' \<longrightarrow> length s = 1)" + +lemma is_nat_string_simps[simp]: + "is_nat_string []" + "is_nat_string (c # s) \<longleftrightarrow> is_digit_char c \<and> is_nat_string s" +unfolding is_nat_string_def by simp_all + +lemma is_strong_nat_string_simps[simp]: + "\<not>(is_strong_nat_string [])" + "is_strong_nat_string (c # s) \<longleftrightarrow> is_digit_char c \<and> is_nat_string s \<and> + (c = CHR ''0'' \<longrightarrow> s = [])" +unfolding is_strong_nat_string_def by simp_all + +fun string_to_nat_aux :: "nat \<Rightarrow> string \<Rightarrow> nat" where + "string_to_nat_aux n [] = n" + | "string_to_nat_aux n (d#ds) = + string_to_nat_aux (n*10 + char_to_digit d) ds" + +definition string_to_nat :: "string \<Rightarrow> nat option" where + "string_to_nat s \<equiv> + (if is_nat_string s then Some (string_to_nat_aux 0 s) else None)" + +definition string_to_nat' :: "string \<Rightarrow> nat" where + "string_to_nat' s \<equiv> the (string_to_nat s)" + +lemma string_to_nat_aux_inv : +assumes "is_nat_string s" +assumes "n > 0 \<or> is_strong_nat_string s" +shows "nat_to_string (string_to_nat_aux n s) = +(if n = 0 then '''' else nat_to_string n) @ s" +using assms +proof (induct s arbitrary: n) + case Nil + thus ?case + by (simp add: is_strong_nat_string_def) +next + case (Cons c s n) + from Cons(2) have "is_digit_char c" "is_nat_string s" by simp_all + note cs_ok = Cons(3) + let ?m = "n*10 + char_to_digit c" + note ind_hyp = Cons(1)[OF \<open>is_nat_string s\<close>, of ?m] + + from \<open>is_digit_char c\<close> have m_div: "?m div 10 = n" and + m_mod: "?m mod 10 = char_to_digit c" + unfolding is_digit_char_def + by auto + + show ?case + proof (cases "?m = 0") + case True + with \<open>is_digit_char c\<close> + have "n = 0" "c = CHR ''0''" unfolding is_digit_char_def by auto + moreover with cs_ok have "s = []" by simp + ultimately show ?thesis by simp + next + case False note m_neq_0 = this + with ind_hyp have ind_hyp': + "nat_to_string (string_to_nat_aux ?m s) = (nat_to_string ?m) @ s" by auto + + hence "nat_to_string (string_to_nat_aux n (c # s)) = (nat_to_string ?m) @ s" + by simp + + with \<open>is_digit_char c\<close> m_div show ?thesis by simp + qed +qed + +lemma string_to_nat_inv : +assumes strong_nat_s: "is_strong_nat_string s" +assumes s2n_s: "string_to_nat s = Some n" +shows "nat_to_string n = s" +proof - + from strong_nat_s have nat_s: "is_nat_string s" unfolding is_strong_nat_string_def by simp + with s2n_s have n_eq: "n = string_to_nat_aux 0 s" unfolding string_to_nat_def by simp + + from string_to_nat_aux_inv[of s 0, folded n_eq] nat_s strong_nat_s + show ?thesis by simp +qed + +lemma nat_to_string_induct [case_names "digit" "non_digit"]: +assumes digit: "\<And>d. is_digit d \<Longrightarrow> P d" +assumes not_digit: "\<And>n. \<not>(is_digit n) \<Longrightarrow> P (n div 10) \<Longrightarrow> P (n mod 10) \<Longrightarrow> P n" +shows "P n" +proof (induct n rule: less_induct) + case (less n) + note ind_hyp = this + + show ?case + proof (cases "is_digit n") + case True with digit show ?thesis by simp + next + case False note not_dig = this + hence "n div 10 < n" "n mod 10 < n" unfolding is_digit_def by auto + with not_dig ind_hyp not_digit show ?thesis by simp + qed +qed + +lemma nat_to_string___is_nat_string [simp]: + "is_nat_string (nat_to_string n)" +unfolding is_nat_string_def +proof (induct n rule: nat_to_string_induct) + case (digit d) + thus ?case by simp +next + case (non_digit n) + thus ?case by simp +qed + +lemma nat_to_string___eq_0 [simp]: + "(nat_to_string n = (CHR ''0'')#s) \<longleftrightarrow> (n = 0 \<and> s = [])" +unfolding is_nat_string_def +proof (induct n arbitrary: s rule: nat_to_string_induct) + case (digit d) thus ?case unfolding is_digit_expand by auto +next + case (non_digit n) + + obtain c s' where ns_eq: "nat_to_string (n div 10) = c # s'" + by (cases "nat_to_string (n div 10)") auto + + from non_digit(1) have "n div 10 \<noteq> 0" unfolding is_digit_def by auto + with non_digit(2) ns_eq have c_neq: "c \<noteq> CHR ''0''" by auto + + from \<open>\<not> (is_digit n)\<close> c_neq ns_eq + show ?case by auto +qed + +lemma nat_to_string___is_strong_nat_string: + "is_strong_nat_string (nat_to_string n)" +proof (cases "is_digit n") + case True thus ?thesis by simp +next + case False note not_digit = this + + obtain c s' where ns_eq: "nat_to_string n = c # s'" + by (cases "nat_to_string n") auto + + from not_digit have "0 < n" unfolding is_digit_def by simp + with ns_eq have c_neq: "c \<noteq> CHR ''0''" by auto + hence "hd (nat_to_string n) \<noteq> CHR ''0''" unfolding ns_eq by simp + + thus ?thesis unfolding is_strong_nat_string_def + by simp +qed + +lemma nat_to_string_inv : + "string_to_nat (nat_to_string n) = Some n" +by (metis nat_to_string_11 + nat_to_string___is_nat_string + nat_to_string___is_strong_nat_string + string_to_nat_def + string_to_nat_inv) + +definition The_opt where + "The_opt p = (if (\<exists>!x. p x) then Some (The p) else None)" + +lemma The_opt_eq_some [simp] : +"((The_opt p) = (Some x)) \<longleftrightarrow> ((p x) \<and> ((\<forall> y. p y \<longrightarrow> (x = y))))" + (is "?lhs = ?rhs") +proof (cases "\<exists>!x. p x") + case True + note exists_unique = this + then obtain x where p_x: "p x" by auto + + from the1_equality[of p x] exists_unique p_x + have the_opt_eq: "The_opt p = Some x" + unfolding The_opt_def by simp + + from exists_unique the_opt_eq p_x show ?thesis + by auto +next + case False + note not_unique = this + + hence "The_opt p = None" + unfolding The_opt_def by simp + with not_unique show ?thesis by auto +qed + +lemma The_opt_eq_none [simp] : +"((The_opt p) = None) \<longleftrightarrow> \<not>(\<exists>!x. p x)" +unfolding The_opt_def by auto + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_assert_extra.thy b/snapshots/isabelle/lib/lem/Lem_assert_extra.thy new file mode 100644 index 00000000..b56e5a19 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_assert_extra.thy @@ -0,0 +1,45 @@ +chapter \<open>Generated by Lem from assert_extra.lem.\<close> + +theory "Lem_assert_extra" + +imports + Main + "Lem" + +begin + + +(*open import {ocaml} `Xstring`*) +(*open import {hol} `stringTheory` `lemTheory`*) +(*open import {coq} `Coq.Strings.Ascii` `Coq.Strings.String`*) +(*open import {isabelle} `$LIB_DIR/Lem`*) + +(* ------------------------------------ *) +(* failing with a proper error message *) +(* ------------------------------------ *) + +(*val failwith: forall 'a. string -> 'a*) + +(* ------------------------------------ *) +(* failing without an error message *) +(* ------------------------------------ *) + +(*val fail : forall 'a. 'a*) +definition fail :: " 'a " where + " fail = ( failwith (''fail''))" + + +(* ------------------------------------- *) +(* assertions *) +(* ------------------------------------- *) + +(*val ensure : bool -> string -> unit*) +definition ensure :: " bool \<Rightarrow> string \<Rightarrow> unit " where + " ensure test msg = ( + if test then + () + else + failwith msg )" + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_basic_classes.thy b/snapshots/isabelle/lib/lem/Lem_basic_classes.thy new file mode 100644 index 00000000..c2032dc1 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_basic_classes.thy @@ -0,0 +1,500 @@ +chapter \<open>Generated by Lem from basic_classes.lem.\<close> + +theory "Lem_basic_classes" + +imports + Main + "Lem_bool" + +begin + +(******************************************************************************) +(* Basic Type Classes *) +(******************************************************************************) + +(*open import Bool*) + +(*open import {coq} `Coq.Strings.Ascii`*) + +(* ========================================================================== *) +(* Equality *) +(* ========================================================================== *) + +(* Lem`s default equality (=) is defined by the following type-class Eq. + This typeclass should define equality on an abstract datatype 'a. It should + always coincide with the default equality of Coq, HOL and Isabelle. + For OCaml, it might be different, since abstract datatypes like sets + might have fancy equalities. *) + +(*class ( Eq 'a ) + val = [isEqual] : 'a -> 'a -> bool + val <> [isInequal] : 'a -> 'a -> bool +end*) + + +(* (=) should for all instances be an equivalence relation + The isEquivalence predicate of relations could be used here. + However, this would lead to a cyclic dependency. *) + +(* TODO: add later, once lemmata can be assigned to classes +lemma eq_equiv: ((forall x. (x = x)) && + (forall x y. (x = y) <-> (y = x)) && + (forall x y z. ((x = y) && (y = z)) --> (x = z))) +*) + +(* Structural equality *) + +(* Sometimes, it is also handy to be able to use structural equality. + This equality is mapped to the build-in equality of backends. This equality + differs significantly for each backend. For example, OCaml can`t check equality + of function types, whereas HOL can. When using structural equality, one should + know what one is doing. The only guarentee is that is behaves like + the native backend equality. + + A lengthy name for structural equality is used to discourage its direct use. + It also ensures that users realise it is unsafe (e.g. OCaml can`t check two functions + for equality *) +(*val unsafe_structural_equality : forall 'a. 'a -> 'a -> bool*) + +(*val unsafe_structural_inequality : forall 'a. 'a -> 'a -> bool*) +(*let unsafe_structural_inequality x y= not (unsafe_structural_equality x y)*) + + +(* ========================================================================== *) +(* Orderings *) +(* ========================================================================== *) + +(* The type-class Ord represents total orders (also called linear orders) *) +datatype ordering = LT | EQ | GT + +fun orderingIsLess :: " ordering \<Rightarrow> bool " where + " orderingIsLess LT = ( True )" +|" orderingIsLess _ = ( False )" + +fun orderingIsGreater :: " ordering \<Rightarrow> bool " where + " orderingIsGreater GT = ( True )" +|" orderingIsGreater _ = ( False )" + +fun orderingIsEqual :: " ordering \<Rightarrow> bool " where + " orderingIsEqual EQ = ( True )" +|" orderingIsEqual _ = ( False )" + + +definition ordering_cases :: " ordering \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a " where + " ordering_cases r lt eq gt = ( + if orderingIsLess r then lt else + if orderingIsEqual r then eq else gt )" + + + +(*val orderingEqual : ordering -> ordering -> bool*) + +record 'a Ord_class= + + compare_method ::" 'a \<Rightarrow> 'a \<Rightarrow> ordering " + + isLess_method ::" 'a \<Rightarrow> 'a \<Rightarrow> bool " + + isLessEqual_method ::" 'a \<Rightarrow> 'a \<Rightarrow> bool " + + isGreater_method ::" 'a \<Rightarrow> 'a \<Rightarrow> bool " + + isGreaterEqual_method ::" 'a \<Rightarrow> 'a \<Rightarrow> bool " + + + + +(* Ocaml provides default, polymorphic compare functions. Let's use them + as the default. However, because used perhaps in a typeclass they must be + defined for all targets. So, explicitly declare them as undefined for + all other targets. If explictly declare undefined, the type-checker won't complain and + an error will only be raised when trying to actually output the function for a certain + target. *) +(*val defaultCompare : forall 'a. 'a -> 'a -> ordering*) +(*val defaultLess : forall 'a. 'a -> 'a -> bool*) +(*val defaultLessEq : forall 'a. 'a -> 'a -> bool*) +(*val defaultGreater : forall 'a. 'a -> 'a -> bool*) +(*val defaultGreaterEq : forall 'a. 'a -> 'a -> bool*) + + +definition genericCompare :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ordering " where + " genericCompare (less1:: 'a \<Rightarrow> 'a \<Rightarrow> bool) (equal:: 'a \<Rightarrow> 'a \<Rightarrow> bool) (x :: 'a) (y :: 'a) = ( + if less1 x y then + LT + else if equal x y then + EQ + else + GT )" + + + +(* +(* compare should really be a total order *) +lemma ord_OK_1: ( + (forall x y. (compare x y = EQ) <-> (compare y x = EQ)) && + (forall x y. (compare x y = LT) <-> (compare y x = GT))) + +lemma ord_OK_2: ( + (forall x y z. (x <= y) && (y <= z) --> (x <= z)) && + (forall x y. (x <= y) || (y <= x)) +) +*) + +(* let's derive a compare function from the Ord type-class *) +(*val ordCompare : forall 'a. Eq 'a, Ord 'a => 'a -> 'a -> ordering*) +definition ordCompare :: " 'a Ord_class \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ordering " where + " ordCompare dict_Basic_classes_Ord_a x y = ( + if ((isLess_method dict_Basic_classes_Ord_a) x y) then LT else + if (x = y) then EQ else GT )" + + +record 'a OrdMaxMin_class= + + max_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + min_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +(*val minByLessEqual : forall 'a. ('a -> 'a -> bool) -> 'a -> 'a -> 'a*) + +(*val maxByLessEqual : forall 'a. ('a -> 'a -> bool) -> 'a -> 'a -> 'a*) + +(*val defaultMax : forall 'a. Ord 'a => 'a -> 'a -> 'a*) + +(*val defaultMin : forall 'a. Ord 'a => 'a -> 'a -> 'a*) + +definition instance_Basic_classes_OrdMaxMin_var_dict :: " 'a Ord_class \<Rightarrow> 'a OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_var_dict dict_Basic_classes_Ord_a = ((| + + max_method = ((\<lambda> x y. if ( + (isLessEqual_method dict_Basic_classes_Ord_a) y x) then x else y)), + + min_method = ((\<lambda> x y. if ( + (isLessEqual_method dict_Basic_classes_Ord_a) x y) then x else y))|) )" + + + +(* ========================================================================== *) +(* SetTypes *) +(* ========================================================================== *) + +(* Set implementations use often an order on the elements. This allows the OCaml implementation + to use trees for implementing them. At least, one needs to be able to check equality on sets. + One could use the Ord type-class for sets. However, defining a special typeclass is cleaner + and allows more flexibility. One can make e.g. sure, that this type-class is ignored for + backends like HOL or Isabelle, which don't need it. Moreover, one is not forced to also instantiate + the functions <, <= ... *) + +(*class ( SetType 'a ) + val {ocaml;coq} setElemCompare : 'a -> 'a -> ordering +end*) + +fun boolCompare :: " bool \<Rightarrow> bool \<Rightarrow> ordering " where + " boolCompare True True = ( EQ )" +|" boolCompare True False = ( GT )" +|" boolCompare False True = ( LT )" +|" boolCompare False False = ( EQ )" + + +(* strings *) + +(*val charEqual : char -> char -> bool*) + +(*val stringEquality : string -> string -> bool*) + +(* pairs *) + +(*val pairEqual : forall 'a 'b. Eq 'a, Eq 'b => ('a * 'b) -> ('a * 'b) -> bool*) +(*let pairEqual (a1, b1) (a2, b2)= (a1 = a2) && (b1 = b2)*) + +(*val pairEqualBy : forall 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a * 'b) -> ('a * 'b) -> bool*) + +(*val pairCompare : forall 'a 'b. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('a * 'b) -> ('a * 'b) -> ordering*) +fun pairCompare :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> ordering " where + " pairCompare cmpa cmpb (a1, b1) (a2, b2) = ( + (case cmpa a1 a2 of + LT => LT + | GT => GT + | EQ => cmpb b1 b2 + ))" + + +fun pairLess :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'b*'a \<Rightarrow> 'b*'a \<Rightarrow> bool " where + " pairLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b (x1, x2) (y1, y2) = ( ( + (isLess_method dict_Basic_classes_Ord_b) x1 y1) \<or> (((isLessEqual_method dict_Basic_classes_Ord_b) x1 y1) \<and> ((isLess_method dict_Basic_classes_Ord_a) x2 y2)))" + +fun pairLessEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'b*'a \<Rightarrow> 'b*'a \<Rightarrow> bool " where + " pairLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b (x1, x2) (y1, y2) = ( ( + (isLess_method dict_Basic_classes_Ord_b) x1 y1) \<or> (((isLessEqual_method dict_Basic_classes_Ord_b) x1 y1) \<and> ((isLessEqual_method dict_Basic_classes_Ord_a) x2 y2)))" + + +definition pairGreater :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> bool " where + " pairGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b x12 y12 = ( pairLess + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12 x12 )" + +definition pairGreaterEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> bool " where + " pairGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b x12 y12 = ( pairLessEq + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12 x12 )" + + +definition instance_Basic_classes_Ord_tup2_dict :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow>('a*'b)Ord_class " where + " instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b = ((| + + compare_method = (pairCompare + (compare_method dict_Basic_classes_Ord_a) (compare_method dict_Basic_classes_Ord_b)), + + isLess_method = + (pairLess dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a), + + isLessEqual_method = + (pairLessEq dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a), + + isGreater_method = + (pairGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b), + + isGreaterEqual_method = + (pairGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b) |) )" + + + +(* triples *) + +(*val tripleEqual : forall 'a 'b 'c. Eq 'a, Eq 'b, Eq 'c => ('a * 'b * 'c) -> ('a * 'b * 'c) -> bool*) +(*let tripleEqual (x1, x2, x3) (y1, y2, y3)= ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, x3)) (y1, (y2, y3)))*) + +(*val tripleCompare : forall 'a 'b 'c. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) -> ('a * 'b * 'c) -> ('a * 'b * 'c) -> ordering*) +fun tripleCompare :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> ordering " where + " tripleCompare cmpa cmpb cmpc (a1, b1, c1) (a2, b2, c2) = ( + pairCompare cmpa (pairCompare cmpb cmpc) (a1, (b1, c1)) (a2, (b2, c2)))" + + +fun tripleLess :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> bool " where + " tripleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c (x1, x2, x3) (y1, y2, y3) = ( pairLess + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c) dict_Basic_classes_Ord_a (x1, (x2, x3)) (y1, (y2, y3)))" + +fun tripleLessEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> bool " where + " tripleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c (x1, x2, x3) (y1, y2, y3) = ( pairLessEq + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c) dict_Basic_classes_Ord_a (x1, (x2, x3)) (y1, (y2, y3)))" + + +definition tripleGreater :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'c*'b*'a \<Rightarrow> 'c*'b*'a \<Rightarrow> bool " where + " tripleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c x123 y123 = ( tripleLess + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123 x123 )" + +definition tripleGreaterEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'c*'b*'a \<Rightarrow> 'c*'b*'a \<Rightarrow> bool " where + " tripleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c x123 y123 = ( tripleLessEq + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123 x123 )" + + +definition instance_Basic_classes_Ord_tup3_dict :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow>('a*'b*'c)Ord_class " where + " instance_Basic_classes_Ord_tup3_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c = ((| + + compare_method = (tripleCompare + (compare_method dict_Basic_classes_Ord_a) (compare_method dict_Basic_classes_Ord_b) (compare_method dict_Basic_classes_Ord_c)), + + isLess_method = + (tripleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c), + + isLessEqual_method = + (tripleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c), + + isGreater_method = + (tripleGreater dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_a), + + isGreaterEqual_method = + (tripleGreaterEq dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_a) |) )" + + +(* quadruples *) + +(*val quadrupleEqual : forall 'a 'b 'c 'd. Eq 'a, Eq 'b, Eq 'c, Eq 'd => ('a * 'b * 'c * 'd) -> ('a * 'b * 'c * 'd) -> bool*) +(*let quadrupleEqual (x1, x2, x3, x4) (y1, y2, y3, y4)= ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))*) + +(*val quadrupleCompare : forall 'a 'b 'c 'd. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) -> + ('d -> 'd -> ordering) -> ('a * 'b * 'c * 'd) -> ('a * 'b * 'c * 'd) -> ordering*) +fun quadrupleCompare :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> ordering " where + " quadrupleCompare cmpa cmpb cmpc cmpd (a1, b1, c1, d1) (a2, b2, c2, d2) = ( + pairCompare cmpa (pairCompare cmpb (pairCompare cmpc cmpd)) (a1, (b1, (c1, d1))) (a2, (b2, (c2, d2))))" + + +fun quadrupleLess :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> bool " where + " quadrupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d (x1, x2, x3, x4) (y1, y2, y3, y4) = ( pairLess + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_d)) dict_Basic_classes_Ord_a (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))" + +fun quadrupleLessEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> bool " where + " quadrupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d (x1, x2, x3, x4) (y1, y2, y3, y4) = ( pairLessEq + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_d)) dict_Basic_classes_Ord_a (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))" + + +definition quadrupleGreater :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> bool " where + " quadrupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d x1234 y1234 = ( quadrupleLess + dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y1234 x1234 )" + +definition quadrupleGreaterEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> bool " where + " quadrupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d x1234 y1234 = ( quadrupleLessEq + dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y1234 x1234 )" + + +definition instance_Basic_classes_Ord_tup4_dict :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow>('a*'b*'c*'d)Ord_class " where + " instance_Basic_classes_Ord_tup4_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d = ((| + + compare_method = (quadrupleCompare + (compare_method dict_Basic_classes_Ord_a) (compare_method dict_Basic_classes_Ord_b) (compare_method dict_Basic_classes_Ord_c) (compare_method dict_Basic_classes_Ord_d)), + + isLess_method = + (quadrupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d), + + isLessEqual_method = + (quadrupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d), + + isGreater_method = + (quadrupleGreater dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a), + + isGreaterEqual_method = + (quadrupleGreaterEq dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a) |) )" + + +(* quintuples *) + +(*val quintupleEqual : forall 'a 'b 'c 'd 'e. Eq 'a, Eq 'b, Eq 'c, Eq 'd, Eq 'e => ('a * 'b * 'c * 'd * 'e) -> ('a * 'b * 'c * 'd * 'e) -> bool*) +(*let quintupleEqual (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5)= ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))*) + +(*val quintupleCompare : forall 'a 'b 'c 'd 'e. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) -> + ('d -> 'd -> ordering) -> ('e -> 'e -> ordering) -> ('a * 'b * 'c * 'd * 'e) -> ('a * 'b * 'c * 'd * 'e) -> ordering*) +fun quintupleCompare :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow>('e \<Rightarrow> 'e \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> ordering " where + " quintupleCompare cmpa cmpb cmpc cmpd cmpe (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) = ( + pairCompare cmpa (pairCompare cmpb (pairCompare cmpc (pairCompare cmpd cmpe))) (a1, (b1, (c1, (d1, e1)))) (a2, (b2, (c2, (d2, e2)))))" + + +fun quintupleLess :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> bool " where + " quintupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) = ( pairLess + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))" + +fun quintupleLessEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> bool " where + " quintupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) = ( pairLessEq + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))" + + +definition quintupleGreater :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> bool " where + " quintupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e x12345 y12345 = ( quintupleLess + dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12345 x12345 )" + +definition quintupleGreaterEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> bool " where + " quintupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e x12345 y12345 = ( quintupleLessEq + dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12345 x12345 )" + + +definition instance_Basic_classes_Ord_tup5_dict :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow>('a*'b*'c*'d*'e)Ord_class " where + " instance_Basic_classes_Ord_tup5_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e = ((| + + compare_method = (quintupleCompare + (compare_method dict_Basic_classes_Ord_a) (compare_method dict_Basic_classes_Ord_b) (compare_method dict_Basic_classes_Ord_c) (compare_method dict_Basic_classes_Ord_d) (compare_method dict_Basic_classes_Ord_e)), + + isLess_method = + (quintupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e), + + isLessEqual_method = + (quintupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e), + + isGreater_method = + (quintupleGreater dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_a), + + isGreaterEqual_method = + (quintupleGreaterEq dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_a) |) )" + + +(* sextuples *) + +(*val sextupleEqual : forall 'a 'b 'c 'd 'e 'f. Eq 'a, Eq 'b, Eq 'c, Eq 'd, Eq 'e, Eq 'f => ('a * 'b * 'c * 'd * 'e * 'f) -> ('a * 'b * 'c * 'd * 'e * 'f) -> bool*) +(*let sextupleEqual (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6)= ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))*) + +(*val sextupleCompare : forall 'a 'b 'c 'd 'e 'f. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) -> + ('d -> 'd -> ordering) -> ('e -> 'e -> ordering) -> ('f -> 'f -> ordering) -> + ('a * 'b * 'c * 'd * 'e * 'f) -> ('a * 'b * 'c * 'd * 'e * 'f) -> ordering*) +fun sextupleCompare :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow>('e \<Rightarrow> 'e \<Rightarrow> ordering)\<Rightarrow>('f \<Rightarrow> 'f \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> ordering " where + " sextupleCompare cmpa cmpb cmpc cmpd cmpe cmpf (a1, b1, c1, d1, e1, f1) (a2, b2, c2, d2, e2, f2) = ( + pairCompare cmpa (pairCompare cmpb (pairCompare cmpc (pairCompare cmpd (pairCompare cmpe cmpf)))) (a1, (b1, (c1, (d1, (e1, f1))))) (a2, (b2, (c2, (d2, (e2, f2))))))" + + +fun sextupleLess :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> bool " where + " sextupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) = ( pairLess + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_e + dict_Basic_classes_Ord_f)))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))" + +fun sextupleLessEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> bool " where + " sextupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) = ( pairLessEq + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d + (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_e + dict_Basic_classes_Ord_f)))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))" + + +definition sextupleGreater :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> bool " where + " sextupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f x123456 y123456 = ( sextupleLess + dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123456 x123456 )" + +definition sextupleGreaterEq :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> bool " where + " sextupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f x123456 y123456 = ( sextupleLessEq + dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123456 x123456 )" + + +definition instance_Basic_classes_Ord_tup6_dict :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow>('a*'b*'c*'d*'e*'f)Ord_class " where + " instance_Basic_classes_Ord_tup6_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f = ((| + + compare_method = (sextupleCompare + (compare_method dict_Basic_classes_Ord_a) (compare_method dict_Basic_classes_Ord_b) (compare_method dict_Basic_classes_Ord_c) (compare_method dict_Basic_classes_Ord_d) (compare_method dict_Basic_classes_Ord_e) (compare_method dict_Basic_classes_Ord_f)), + + isLess_method = + (sextupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f), + + isLessEqual_method = + (sextupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b + dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d + dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f), + + isGreater_method = + (sextupleGreater dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e + dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a), + + isGreaterEqual_method = + (sextupleGreaterEq dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e + dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c + dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a) |) )" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_bool.thy b/snapshots/isabelle/lib/lem/Lem_bool.thy new file mode 100644 index 00000000..75142160 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_bool.thy @@ -0,0 +1,75 @@ +chapter \<open>Generated by Lem from bool.lem.\<close> + +theory "Lem_bool" + +imports + Main + +begin + + + +(* The type bool is hard-coded, so are true and false *) + +(* ----------------------- *) +(* not *) +(* ----------------------- *) + +(*val not : bool -> bool*) +(*let not b= match b with + | true -> false + | false -> true +end*) + +(* ----------------------- *) +(* and *) +(* ----------------------- *) + +(*val && [and] : bool -> bool -> bool*) +(*let && b1 b2= match (b1, b2) with + | (true, true) -> true + | _ -> false +end*) + + +(* ----------------------- *) +(* or *) +(* ----------------------- *) + +(*val || [or] : bool -> bool -> bool*) +(*let || b1 b2= match (b1, b2) with + | (false, false) -> false + | _ -> true +end*) + + +(* ----------------------- *) +(* implication *) +(* ----------------------- *) + +(*val --> [imp] : bool -> bool -> bool*) +(*let --> b1 b2= match (b1, b2) with + | (true, false) -> false + | _ -> true +end*) + + +(* ----------------------- *) +(* equivalence *) +(* ----------------------- *) + +(*val <-> [equiv] : bool -> bool -> bool*) +(*let <-> b1 b2= match (b1, b2) with + | (true, true) -> true + | (false, false) -> true + | _ -> false +end*) + + +(* ----------------------- *) +(* xor *) +(* ----------------------- *) + +(*val xor : bool -> bool -> bool*) + +end diff --git a/snapshots/isabelle/lib/lem/Lem_either.thy b/snapshots/isabelle/lib/lem/Lem_either.thy new file mode 100644 index 00000000..e181f823 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_either.thy @@ -0,0 +1,85 @@ +chapter \<open>Generated by Lem from either.lem.\<close> + +theory "Lem_either" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_list" + "Lem_tuple" + +begin + + + +(*open import Bool Basic_classes List Tuple*) +(*open import {hol} `sumTheory`*) +(*open import {ocaml} `Either`*) + +(*type either 'a 'b + = Left of 'a + | Right of 'b*) + + +(* -------------------------------------------------------------------------- *) +(* Equality. *) +(* -------------------------------------------------------------------------- *) + +(*val eitherEqual : forall 'a 'b. Eq 'a, Eq 'b => (either 'a 'b) -> (either 'a 'b) -> bool*) +(*val eitherEqualBy : forall 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> (either 'a 'b) -> (either 'a 'b) -> bool*) + +definition eitherEqualBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> bool)\<Rightarrow>('a,'b)sum \<Rightarrow>('a,'b)sum \<Rightarrow> bool " where + " eitherEqualBy eql eqr (left:: ('a, 'b) sum) (right:: ('a, 'b) sum) = ( + (case (left, right) of + (Inl l, Inl l') => eql l l' + | (Inr r, Inr r') => eqr r r' + | _ => False + ))" + +(*let eitherEqual= eitherEqualBy (=) (=)*) + +fun either_setElemCompare :: "('d \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('d,'c)sum \<Rightarrow>('b,'a)sum \<Rightarrow> ordering " where + " either_setElemCompare cmpa cmpb (Inl x') (Inl y') = ( cmpa x' y' )" +|" either_setElemCompare cmpa cmpb (Inr x') (Inr y') = ( cmpb x' y' )" +|" either_setElemCompare cmpa cmpb (Inl _) (Inr _) = ( LT )" +|" either_setElemCompare cmpa cmpb (Inr _) (Inl _) = ( GT )" + + + +(* -------------------------------------------------------------------------- *) +(* Utility functions. *) +(* -------------------------------------------------------------------------- *) + +(*val isLeft : forall 'a 'b. either 'a 'b -> bool*) + +(*val isRight : forall 'a 'b. either 'a 'b -> bool*) + + +(*val either : forall 'a 'b 'c. ('a -> 'c) -> ('b -> 'c) -> either 'a 'b -> 'c*) +(*let either fa fb x= match x with + | Left a -> fa a + | Right b -> fb b +end*) + + +(*val partitionEither : forall 'a 'b. list (either 'a 'b) -> (list 'a * list 'b)*) +(*let rec partitionEither l= match l with + | [] -> ([], []) + | x :: xs -> begin + let (ll, rl) = partitionEither xs in + match x with + | Left l -> (l::ll, rl) + | Right r -> (ll, r::rl) + end + end +end*) + + +(*val lefts : forall 'a 'b. list (either 'a 'b) -> list 'a*) + + +(*val rights : forall 'a 'b. list (either 'a 'b) -> list 'b*) + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_function.thy b/snapshots/isabelle/lib/lem/Lem_function.thy new file mode 100644 index 00000000..29c1fb04 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_function.thy @@ -0,0 +1,72 @@ +chapter \<open>Generated by Lem from function.lem.\<close> + +theory "Lem_function" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + +begin + +(******************************************************************************) +(* A library for common operations on functions *) +(******************************************************************************) + +(*open import Bool Basic_classes*) + +(*open import {coq} `Program.Basics`*) + +(* ----------------------- *) +(* identity function *) +(* ----------------------- *) + +(*val id : forall 'a. 'a -> 'a*) +(*let id x= x*) + + +(* ----------------------- *) +(* constant function *) +(* ----------------------- *) + +(*val const : forall 'a 'b. 'a -> 'b -> 'a*) + + +(* ----------------------- *) +(* function composition *) +(* ----------------------- *) + +(*val comb : forall 'a 'b 'c. ('b -> 'c) -> ('a -> 'b) -> ('a -> 'c)*) +(*let comb f g= (fun x -> f (g x))*) + + +(* ----------------------- *) +(* function application *) +(* ----------------------- *) + +(*val $ [apply] : forall 'a 'b. ('a -> 'b) -> ('a -> 'b)*) +(*let $ f= (fun x -> f x)*) + +(*val $> [rev_apply] : forall 'a 'b. 'a -> ('a -> 'b) -> 'b*) +(*let $> x f= f x*) + +(* ----------------------- *) +(* flipping argument order *) +(* ----------------------- *) + +(*val flip : forall 'a 'b 'c. ('a -> 'b -> 'c) -> ('b -> 'a -> 'c)*) +(*let flip f= (fun x y -> f y x)*) + + +(* currying / uncurrying *) + +(*val curry : forall 'a 'b 'c. (('a * 'b) -> 'c) -> 'a -> 'b -> 'c*) +definition curry :: "('a*'b \<Rightarrow> 'c)\<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'c " where + " curry f = ( (\<lambda> a b . f (a, b)))" + + +(*val uncurry : forall 'a 'b 'c. ('a -> 'b -> 'c) -> ('a * 'b -> 'c)*) +fun uncurry :: "('a \<Rightarrow> 'b \<Rightarrow> 'c)\<Rightarrow> 'a*'b \<Rightarrow> 'c " where + " uncurry f (a,b) = ( f a b )" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_function_extra.thy b/snapshots/isabelle/lib/lem/Lem_function_extra.thy new file mode 100644 index 00000000..f742e1e6 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_function_extra.thy @@ -0,0 +1,29 @@ +chapter \<open>Generated by Lem from function_extra.lem.\<close> + +theory "Lem_function_extra" + +imports + Main + "Lem_maybe" + "Lem_bool" + "Lem_basic_classes" + "Lem_num" + "Lem_function" + "Lem" + +begin + + + +(*open import Maybe Bool Basic_classes Num Function*) + +(*open import {hol} `lemTheory`*) +(*open import {isabelle} `$LIB_DIR/Lem`*) + +(* ----------------------- *) +(* getting a unique value *) +(* ----------------------- *) + +(*val THE : forall 'a. ('a -> bool) -> maybe 'a*) + +end diff --git a/snapshots/isabelle/lib/lem/Lem_list.thy b/snapshots/isabelle/lib/lem/Lem_list.thy new file mode 100644 index 00000000..3bdef057 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_list.thy @@ -0,0 +1,776 @@ +chapter \<open>Generated by Lem from list.lem.\<close> + +theory "Lem_list" + +imports + Main + "Lem_bool" + "Lem_maybe" + "Lem_basic_classes" + "Lem_function" + "Lem_tuple" + "Lem_num" + "Lem" + +begin + + + +(*open import Bool Maybe Basic_classes Function Tuple Num*) + +(*open import {coq} `Coq.Lists.List`*) +(*open import {isabelle} `$LIB_DIR/Lem`*) +(*open import {hol} `lemTheory` `listTheory` `rich_listTheory` `sortingTheory`*) + +(* ========================================================================== *) +(* Basic list functions *) +(* ========================================================================== *) + +(* The type of lists as well as list literals like [], [1;2], ... are hardcoded. + Thus, we can directly dive into derived definitions. *) + + +(* ----------------------- *) +(* cons *) +(* ----------------------- *) + +(*val :: : forall 'a. 'a -> list 'a -> list 'a*) + + +(* ----------------------- *) +(* Emptyness check *) +(* ----------------------- *) + +(*val null : forall 'a. list 'a -> bool*) +(*let null l= match l with [] -> true | _ -> false end*) + +(* ----------------------- *) +(* Length *) +(* ----------------------- *) + +(*val length : forall 'a. list 'a -> nat*) +(*let rec length l= + match l with + | [] -> 0 + | x :: xs -> (Instance_Num_NumAdd_nat.+) (length xs) 1 + end*) + +(* ----------------------- *) +(* Equality *) +(* ----------------------- *) + +(*val listEqual : forall 'a. Eq 'a => list 'a -> list 'a -> bool*) +(*val listEqualBy : forall 'a. ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*) + +fun listEqualBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool " where + " listEqualBy eq ([]) ([]) = ( True )" +|" listEqualBy eq ([]) (_ # _) = ( False )" +|" listEqualBy eq (_ # _) ([]) = ( False )" +|" listEqualBy eq (x # xs) (y # ys) = ( (eq x y \<and> listEqualBy eq xs ys))" + + + +(* ----------------------- *) +(* compare *) +(* ----------------------- *) + +(*val lexicographicCompare : forall 'a. Ord 'a => list 'a -> list 'a -> ordering*) +(*val lexicographicCompareBy : forall 'a. ('a -> 'a -> ordering) -> list 'a -> list 'a -> ordering*) + +fun lexicographicCompareBy :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> ordering " where + " lexicographicCompareBy cmp ([]) ([]) = ( EQ )" +|" lexicographicCompareBy cmp ([]) (_ # _) = ( LT )" +|" lexicographicCompareBy cmp (_ # _) ([]) = ( GT )" +|" lexicographicCompareBy cmp (x # xs) (y # ys) = ( ( + (case cmp x y of + LT => LT + | GT => GT + | EQ => lexicographicCompareBy cmp xs ys + ) + ))" + + +(*val lexicographicLess : forall 'a. Ord 'a => list 'a -> list 'a -> bool*) +(*val lexicographicLessBy : forall 'a. ('a -> 'a -> bool) -> ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*) +fun lexicographicLessBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool " where + " lexicographicLessBy less1 less_eq1 ([]) ([]) = ( False )" +|" lexicographicLessBy less1 less_eq1 ([]) (_ # _) = ( True )" +|" lexicographicLessBy less1 less_eq1 (_ # _) ([]) = ( False )" +|" lexicographicLessBy less1 less_eq1 (x # xs) (y # ys) = ( ((less1 x y) \<or> ((less_eq1 x y) \<and> (lexicographicLessBy less1 less_eq1 xs ys))))" + + +(*val lexicographicLessEq : forall 'a. Ord 'a => list 'a -> list 'a -> bool*) +(*val lexicographicLessEqBy : forall 'a. ('a -> 'a -> bool) -> ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*) +fun lexicographicLessEqBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool " where + " lexicographicLessEqBy less1 less_eq1 ([]) ([]) = ( True )" +|" lexicographicLessEqBy less1 less_eq1 ([]) (_ # _) = ( True )" +|" lexicographicLessEqBy less1 less_eq1 (_ # _) ([]) = ( False )" +|" lexicographicLessEqBy less1 less_eq1 (x # xs) (y # ys) = ( (less1 x y \<or> (less_eq1 x y \<and> lexicographicLessEqBy less1 less_eq1 xs ys)))" + + + +definition instance_Basic_classes_Ord_list_dict :: " 'a Ord_class \<Rightarrow>('a list)Ord_class " where + " instance_Basic_classes_Ord_list_dict dict_Basic_classes_Ord_a = ((| + + compare_method = (lexicographicCompareBy + (compare_method dict_Basic_classes_Ord_a)), + + isLess_method = (lexicographicLessBy + (isLess_method dict_Basic_classes_Ord_a) (isLessEqual_method dict_Basic_classes_Ord_a)), + + isLessEqual_method = (lexicographicLessEqBy + (isLess_method dict_Basic_classes_Ord_a) (isLessEqual_method dict_Basic_classes_Ord_a)), + + isGreater_method = (\<lambda> x y. (lexicographicLessBy + (isLess_method dict_Basic_classes_Ord_a) (isLessEqual_method dict_Basic_classes_Ord_a) y x)), + + isGreaterEqual_method = (\<lambda> x y. (lexicographicLessEqBy + (isLess_method dict_Basic_classes_Ord_a) (isLessEqual_method dict_Basic_classes_Ord_a) y x))|) )" + + + +(* ----------------------- *) +(* Append *) +(* ----------------------- *) + +(*val ++ : forall 'a. list 'a -> list 'a -> list 'a*) (* originally append *) +(*let rec ++ xs ys= match xs with + | [] -> ys + | x :: xs' -> x :: (xs' ++ ys) + end*) + +(* ----------------------- *) +(* snoc *) +(* ----------------------- *) + +(*val snoc : forall 'a. 'a -> list 'a -> list 'a*) +(*let snoc e l= l ++ [e]*) + + +(* ----------------------- *) +(* Reverse *) +(* ----------------------- *) + +(* First lets define the function [reverse_append], which is + closely related to reverse. [reverse_append l1 l2] appends the list [l2] to the reverse of [l1]. + This can be implemented more efficienctly than appending and is + used to implement reverse. *) + +(*val reverseAppend : forall 'a. list 'a -> list 'a -> list 'a*) (* originally named rev_append *) +(*let rec reverseAppend l1 l2= match l1 with + | [] -> l2 + | x :: xs -> reverseAppend xs (x :: l2) + end*) + +(* Reversing a list *) +(*val reverse : forall 'a. list 'a -> list 'a*) (* originally named rev *) +(*let reverse l= reverseAppend l []*) + +(* ----------------------- *) +(* Map *) +(* ----------------------- *) + +(*val map_tr : forall 'a 'b. list 'b -> ('a -> 'b) -> list 'a -> list 'b*) +function (sequential,domintros) map_tr :: " 'b list \<Rightarrow>('a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> 'b list " where + " map_tr rev_acc f ([]) = ( List.rev rev_acc )" +|" map_tr rev_acc f (x # xs) = ( map_tr ((f x) # rev_acc) f xs )" +by pat_completeness auto + + +(* taken from: https://blogs.janestreet.com/optimizing-list-map/ *) +(*val count_map : forall 'a 'b. ('a -> 'b) -> list 'a -> nat -> list 'b*) +function (sequential,domintros) count_map :: "('a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'b list " where + " count_map f ([]) ctr = ( [])" +|" count_map f (hd1 # tl1) ctr = ( f hd1 # + (if ctr <( 5000 :: nat) then count_map f tl1 (ctr +( 1 :: nat)) + else map_tr [] f tl1))" +by pat_completeness auto + + +(*val map : forall 'a 'b. ('a -> 'b) -> list 'a -> list 'b*) +(*let map f l= count_map f l 0*) + +(* ----------------------- *) +(* Reverse Map *) +(* ----------------------- *) + +(*val reverseMap : forall 'a 'b. ('a -> 'b) -> list 'a -> list 'b*) + + +(* ========================================================================== *) +(* Folding *) +(* ========================================================================== *) + +(* ----------------------- *) +(* fold left *) +(* ----------------------- *) + +(*val foldl : forall 'a 'b. ('a -> 'b -> 'a) -> 'a -> list 'b -> 'a*) (* originally foldl *) + +(*let rec foldl f b l= match l with + | [] -> b + | x :: xs -> foldl f (f b x) xs +end*) + + +(* ----------------------- *) +(* fold right *) +(* ----------------------- *) + +(*val foldr : forall 'a 'b. ('a -> 'b -> 'b) -> 'b -> list 'a -> 'b*) (* originally foldr with different argument order *) +(*let rec foldr f b l= match l with + | [] -> b + | x :: xs -> f x (foldr f b xs) +end*) + + +(* ----------------------- *) +(* concatenating lists *) +(* ----------------------- *) + +(*val concat : forall 'a. list (list 'a) -> list 'a*) (* before also called flatten *) +(*let concat= foldr (++) []*) + + +(* -------------------------- *) +(* concatenating with mapping *) +(* -------------------------- *) + +(*val concatMap : forall 'a 'b. ('a -> list 'b) -> list 'a -> list 'b*) + + +(* ------------------------- *) +(* universal qualification *) +(* ------------------------- *) + +(*val all : forall 'a. ('a -> bool) -> list 'a -> bool*) (* originally for_all *) +(*let all P l= foldl (fun r e -> P e && r) true l*) + + + +(* ------------------------- *) +(* existential qualification *) +(* ------------------------- *) + +(*val any : forall 'a. ('a -> bool) -> list 'a -> bool*) (* originally exist *) +(*let any P l= foldl (fun r e -> P e || r) false l*) + + +(* ------------------------- *) +(* dest_init *) +(* ------------------------- *) + +(* get the initial part and the last element of the list in a safe way *) + +(*val dest_init : forall 'a. list 'a -> maybe (list 'a * 'a)*) + +fun dest_init_aux :: " 'a list \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list*'a " where + " dest_init_aux rev_init last_elem_seen ([]) = ( (List.rev rev_init, last_elem_seen))" +|" dest_init_aux rev_init last_elem_seen (x # xs) = ( dest_init_aux (last_elem_seen # rev_init) x xs )" + + +fun dest_init :: " 'a list \<Rightarrow>('a list*'a)option " where + " dest_init ([]) = ( None )" +|" dest_init (x # xs) = ( Some (dest_init_aux [] x xs))" + + + +(* ========================================================================== *) +(* Indexing lists *) +(* ========================================================================== *) + +(* ------------------------- *) +(* index / nth with maybe *) +(* ------------------------- *) + +(*val index : forall 'a. list 'a -> nat -> maybe 'a*) + +(*let rec index l n= match l with + | [] -> Nothing + | x :: xs -> if (Instance_Basic_classes_Eq_nat.=) n 0 then Just x else index xs ((Instance_Num_NumMinus_nat.-)n 1) +end*) + +(* ------------------------- *) +(* findIndices *) +(* ------------------------- *) + +(* [findIndices P l] returns the indices of all elements of list [l] that satisfy predicate [P]. + Counting starts with 0, the result list is sorted ascendingly *) +(*val findIndices : forall 'a. ('a -> bool) -> list 'a -> list nat*) + +fun findIndices_aux :: " nat \<Rightarrow>('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow>(nat)list " where + " findIndices_aux (i::nat) P ([]) = ( [])" +|" findIndices_aux (i::nat) P (x # xs) = ( if P x then i # findIndices_aux (i +( 1 :: nat)) P xs else findIndices_aux (i +( 1 :: nat)) P xs )" + +(*let findIndices P l= findIndices_aux 0 P l*) + + + +(* ------------------------- *) +(* findIndex *) +(* ------------------------- *) + +(* findIndex returns the first index of a list that satisfies a given predicate. *) +(*val findIndex : forall 'a. ('a -> bool) -> list 'a -> maybe nat*) +(*let findIndex P l= match findIndices P l with + | [] -> Nothing + | x :: _ -> Just x +end*) + +(* ------------------------- *) +(* elemIndices *) +(* ------------------------- *) + +(*val elemIndices : forall 'a. Eq 'a => 'a -> list 'a -> list nat*) + +(* ------------------------- *) +(* elemIndex *) +(* ------------------------- *) + +(*val elemIndex : forall 'a. Eq 'a => 'a -> list 'a -> maybe nat*) + + +(* ========================================================================== *) +(* Creating lists *) +(* ========================================================================== *) + +(* ------------------------- *) +(* genlist *) +(* ------------------------- *) + +(* [genlist f n] generates the list [f 0; f 1; ... (f (n-1))] *) +(*val genlist : forall 'a. (nat -> 'a) -> nat -> list 'a*) + + +(*let rec genlist f n= + match n with + | 0 -> [] + | n' + 1 -> snoc (f n') (genlist f n') + end*) + + +(* ------------------------- *) +(* replicate *) +(* ------------------------- *) + +(*val replicate : forall 'a. nat -> 'a -> list 'a*) +(*let rec replicate n x= + match n with + | 0 -> [] + | n' + 1 -> x :: replicate n' x + end*) + + +(* ========================================================================== *) +(* Sublists *) +(* ========================================================================== *) + +(* ------------------------- *) +(* splitAt *) +(* ------------------------- *) + +(* [splitAt n xs] returns a tuple (xs1, xs2), with append xs1 xs2 = xs and + length xs1 = n. If there are not enough elements + in [xs], the original list and the empty one are returned. *) +(*val splitAtAcc : forall 'a. list 'a -> nat -> list 'a -> (list 'a * list 'a)*) +function (sequential,domintros) splitAtAcc :: " 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list*'a list " where + " splitAtAcc revAcc n l = ( + (case l of + [] => (List.rev revAcc, []) + | x # xs => if n \<le>( 0 :: nat) then (List.rev revAcc, l) else splitAtAcc (x # revAcc) (n-( 1 :: nat)) xs + ))" +by pat_completeness auto + + +(*val splitAt : forall 'a. nat -> list 'a -> (list 'a * list 'a)*) +(*let rec splitAt n l= + splitAtAcc [] n l*) + + +(* ------------------------- *) +(* take *) +(* ------------------------- *) + +(* take n xs returns the prefix of xs of length n, or xs itself if n > length xs *) +(*val take : forall 'a. nat -> list 'a -> list 'a*) +(*let take n l= fst (splitAt n l)*) + +(* ------------------------- *) +(* drop *) +(* ------------------------- *) + +(* [drop n xs] drops the first [n] elements of [xs]. It returns the empty list, if [n] > [length xs]. *) +(*val drop : forall 'a. nat -> list 'a -> list 'a*) +(*let drop n l= snd (splitAt n l)*) + +(* ------------------------------------ *) +(* splitWhile, takeWhile, and dropWhile *) +(* ------------------------------------ *) + +(*val splitWhile_tr : forall 'a. ('a -> bool) -> list 'a -> list 'a -> (list 'a * list 'a)*) +fun splitWhile_tr :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list*'a list " where + " splitWhile_tr p ([]) acc1 = ( + (List.rev acc1, []))" +|" splitWhile_tr p (x # xs) acc1 = ( + if p x then + splitWhile_tr p xs (x # acc1) + else + (List.rev acc1, (x # xs)))" + + +(*val splitWhile : forall 'a. ('a -> bool) -> list 'a -> (list 'a * list 'a)*) +definition splitWhile :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list*'a list " where + " splitWhile p xs = ( splitWhile_tr p xs [])" + + +(* [takeWhile p xs] takes the first elements of [xs] that satisfy [p]. *) +(*val takeWhile : forall 'a. ('a -> bool) -> list 'a -> list 'a*) +definition takeWhile :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list " where + " takeWhile p l = ( fst (splitWhile p l))" + + +(* [dropWhile p xs] drops the first elements of [xs] that satisfy [p]. *) +(*val dropWhile : forall 'a. ('a -> bool) -> list 'a -> list 'a*) +definition dropWhile :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list " where + " dropWhile p l = ( snd (splitWhile p l))" + + +(* ------------------------- *) +(* isPrefixOf *) +(* ------------------------- *) + +(*val isPrefixOf : forall 'a. Eq 'a => list 'a -> list 'a -> bool*) +fun isPrefixOf :: " 'a list \<Rightarrow> 'a list \<Rightarrow> bool " where + " isPrefixOf ([]) _ = ( True )" +|" isPrefixOf (_ # _) ([]) = ( False )" +|" isPrefixOf (x # xs) (y # ys) = ( (x = y) \<and> isPrefixOf xs ys )" + + +(* ------------------------- *) +(* update *) +(* ------------------------- *) +(*val update : forall 'a. list 'a -> nat -> 'a -> list 'a*) +(*let rec update l n e= + match l with + | [] -> [] + | x :: xs -> if (Instance_Basic_classes_Eq_nat.=) n 0 then e :: xs else x :: (update xs ((Instance_Num_NumMinus_nat.-) n 1) e) +end*) + + + +(* ========================================================================== *) +(* Searching lists *) +(* ========================================================================== *) + +(* ------------------------- *) +(* Membership test *) +(* ------------------------- *) + +(* The membership test, one of the basic list functions, is actually tricky for + Lem, because it is tricky, which equality to use. From Lem`s point of + perspective, we want to use the equality provided by the equality type - class. + This allows for example to check whether a set is in a list of sets. + + However, in order to use the equality type class, elem essentially becomes + existential quantification over lists. For types, which implement semantic + equality (=) with syntactic equality, this is overly complicated. In + our theorem prover backend, we would end up with overly complicated, harder + to read definitions and some of the automation would be harder to apply. + Moreover, nearly all the old Lem generated code would change and require + (hopefully minor) adaptions of proofs. + + For now, we ignore this problem and just demand, that all instances of + the equality type class do the right thing for the theorem prover backends. +*) + +(*val elem : forall 'a. Eq 'a => 'a -> list 'a -> bool*) +(*val elemBy : forall 'a. ('a -> 'a -> bool) -> 'a -> list 'a -> bool*) + +definition elemBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> bool " where + " elemBy eq e l = ( ((\<exists> x \<in> (set l). (eq e) x)))" + +(*let elem= elemBy (=)*) + +(* ------------------------- *) +(* Find *) +(* ------------------------- *) +(*val find : forall 'a. ('a -> bool) -> list 'a -> maybe 'a*) (* previously not of maybe type *) +(*let rec find P l= match l with + | [] -> Nothing + | x :: xs -> if P x then Just x else find P xs +end*) + + +(* ----------------------------- *) +(* Lookup in an associative list *) +(* ----------------------------- *) +(*val lookup : forall 'a 'b. Eq 'a => 'a -> list ('a * 'b) -> maybe 'b*) +(*val lookupBy : forall 'a 'b. ('a -> 'a -> bool) -> 'a -> list ('a * 'b) -> maybe 'b*) + +(* DPM: eta-expansion for Coq backend type-inference. *) +definition lookupBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow>('a*'b)list \<Rightarrow> 'b option " where + " lookupBy eq k m = ( map_option (\<lambda> x . snd x) (List.find ( \<lambda>x . + (case x of (k', _) => eq k k' )) m))" + + +(* ------------------------- *) +(* filter *) +(* ------------------------- *) +(*val filter : forall 'a. ('a -> bool) -> list 'a -> list 'a*) +(*let rec filter P l= match l with + | [] -> [] + | x :: xs -> if (P x) then x :: (filter P xs) else filter P xs + end*) + + +(* ------------------------- *) +(* partition *) +(* ------------------------- *) +(*val partition : forall 'a. ('a -> bool) -> list 'a -> list 'a * list 'a*) +(*let partition P l= (filter P l, filter (fun x -> not (P x)) l)*) + +(*val reversePartition : forall 'a. ('a -> bool) -> list 'a -> list 'a * list 'a*) +definition reversePartition :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list*'a list " where + " reversePartition P l = ( List.partition P (List.rev l))" + + + +(* ------------------------- *) +(* delete first element *) +(* with certain property *) +(* ------------------------- *) + +(*val deleteFirst : forall 'a. ('a -> bool) -> list 'a -> maybe (list 'a)*) +(*let rec deleteFirst P l= match l with + | [] -> Nothing + | x :: xs -> if (P x) then Just xs else Maybe.map (fun xs' -> x :: xs') (deleteFirst P xs) + end*) + + +(*val delete : forall 'a. Eq 'a => 'a -> list 'a -> list 'a*) +(*val deleteBy : forall 'a. ('a -> 'a -> bool) -> 'a -> list 'a -> list 'a*) + +definition deleteBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list " where + " deleteBy eq x l = ( case_option l id (delete_first (eq x) l))" + + + +(* ========================================================================== *) +(* Zipping and unzipping lists *) +(* ========================================================================== *) + +(* ------------------------- *) +(* zip *) +(* ------------------------- *) + +(* zip takes two lists and returns a list of corresponding pairs. If one input list is short, excess elements of the longer list are discarded. *) +(*val zip : forall 'a 'b. list 'a -> list 'b -> list ('a * 'b)*) (* before combine *) +(*let rec zip l1 l2= match (l1, l2) with + | (x :: xs, y :: ys) -> (x, y) :: zip xs ys + | _ -> [] +end*) + +(* ------------------------- *) +(* unzip *) +(* ------------------------- *) + +(*val unzip: forall 'a 'b. list ('a * 'b) -> (list 'a * list 'b)*) +(*let rec unzip l= match l with + | [] -> ([], []) + | (x, y) :: xys -> let (xs, ys) = unzip xys in (x :: xs, y :: ys) +end*) + +(* ------------------------- *) +(* distinct elements *) +(* ------------------------- *) + +(*val allDistinct : forall 'a. Eq 'a => list 'a -> bool*) +fun allDistinct :: " 'a list \<Rightarrow> bool " where + " allDistinct ([]) = ( True )" +|" allDistinct (x # l') = ( \<not> (Set.member x (set l')) \<and> allDistinct l' )" + + +(* some more useful functions *) +(*val mapMaybe : forall 'a 'b. ('a -> maybe 'b) -> list 'a -> list 'b*) +function (sequential,domintros) mapMaybe :: "('a \<Rightarrow> 'b option)\<Rightarrow> 'a list \<Rightarrow> 'b list " where + " mapMaybe f ([]) = ( [])" +|" mapMaybe f (x # xs) = ( + (case f x of + None => mapMaybe f xs + | Some y => y # (mapMaybe f xs) + ))" +by pat_completeness auto + + +(*val mapi : forall 'a 'b. (nat -> 'a -> 'b) -> list 'a -> list 'b*) +function (sequential,domintros) mapiAux :: "(nat \<Rightarrow> 'b \<Rightarrow> 'a)\<Rightarrow> nat \<Rightarrow> 'b list \<Rightarrow> 'a list " where + " mapiAux f (n :: nat) ([]) = ( [])" +|" mapiAux f (n :: nat) (x # xs) = ( (f n x) # mapiAux f (n +( 1 :: nat)) xs )" +by pat_completeness auto + +definition mapi :: "(nat \<Rightarrow> 'a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> 'b list " where + " mapi f l = ( mapiAux f(( 0 :: nat)) l )" + + +(*val deletes: forall 'a. Eq 'a => list 'a -> list 'a -> list 'a*) +definition deletes :: " 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list " where + " deletes xs ys = ( + List.foldl ((\<lambda> x y. remove1 y x)) xs ys )" + + +(* ========================================================================== *) +(* Comments (not clean yet, please ignore the rest of the file) *) +(* ========================================================================== *) + +(* ----------------------- *) +(* skipped from Haskell Lib*) +(* ----------------------- + +intersperse :: a -> [a] -> [a] +intercalate :: [a] -> [[a]] -> [a] +transpose :: [[a]] -> [[a]] +subsequences :: [a] -> [[a]] +permutations :: [a] -> [[a]] +foldl` :: (a -> b -> a) -> a -> [b] -> aSource +foldl1` :: (a -> a -> a) -> [a] -> aSource + +and +or +sum +product +maximum +minimum +scanl +scanr +scanl1 +scanr1 +Accumulating maps + +mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])Source +mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])Source + +iterate :: (a -> a) -> a -> [a] +repeat :: a -> [a] +cycle :: [a] -> [a] +unfoldr + + +takeWhile :: (a -> Bool) -> [a] -> [a]Source +dropWhile :: (a -> Bool) -> [a] -> [a]Source +dropWhileEnd :: (a -> Bool) -> [a] -> [a]Source +span :: (a -> Bool) -> [a] -> ([a], [a])Source +break :: (a -> Bool) -> [a] -> ([a], [a])Source +break p is equivalent to span (not . p). +stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]Source +group :: Eq a => [a] -> [[a]]Source +inits :: [a] -> [[a]]Source +tails :: [a] -> [[a]]Source + + +isPrefixOf :: Eq a => [a] -> [a] -> BoolSource +isSuffixOf :: Eq a => [a] -> [a] -> BoolSource +isInfixOf :: Eq a => [a] -> [a] -> BoolSource + + + +notElem :: Eq a => a -> [a] -> BoolSource + +zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]Source +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]Source +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]Source +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]Source +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]Source + +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]Source +zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]Source +zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]Source +zipWith5 :: (a -> b -> c -> d -> e -> f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]Source +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]Source +zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]Source + + +unzip3 :: [(a, b, c)] -> ([a], [b], [c])Source +unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])Source +unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])Source +unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])Source +unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])Source + + +lines :: String -> [String]Source +words :: String -> [String]Source +unlines :: [String] -> StringSource +unwords :: [String] -> StringSource +nub :: Eq a => [a] -> [a]Source +delete :: Eq a => a -> [a] -> [a]Source + +() :: Eq a => [a] -> [a] -> [a]Source +union :: Eq a => [a] -> [a] -> [a]Source +intersect :: Eq a => [a] -> [a] -> [a]Source +sort :: Ord a => [a] -> [a]Source +insert :: Ord a => a -> [a] -> [a]Source + + +nubBy :: (a -> a -> Bool) -> [a] -> [a]Source +deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]Source +deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source +unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source +intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source +groupBy :: (a -> a -> Bool) -> [a] -> [[a]]Source +sortBy :: (a -> a -> Ordering) -> [a] -> [a]Source +insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]Source +maximumBy :: (a -> a -> Ordering) -> [a] -> aSource +minimumBy :: (a -> a -> Ordering) -> [a] -> aSource +genericLength :: Num i => [b] -> iSource +genericTake :: Integral i => i -> [a] -> [a]Source +genericDrop :: Integral i => i -> [a] -> [a]Source +genericSplitAt :: Integral i => i -> [b] -> ([b], [b])Source +genericIndex :: Integral a => [b] -> a -> bSource +genericReplicate :: Integral i => i -> a -> [a]Source + + +*) + + +(* ----------------------- *) +(* skipped from Lem Lib *) +(* ----------------------- + + +val for_all2 : forall 'a 'b. ('a -> 'b -> bool) -> list 'a -> list 'b -> bool +val exists2 : forall 'a 'b. ('a -> 'b -> bool) -> list 'a -> list 'b -> bool +val map2 : forall 'a 'b 'c. ('a -> 'b -> 'c) -> list 'a -> list 'b -> list 'c +val rev_map2 : forall 'a 'b 'c. ('a -> 'b -> 'c) -> list 'a -> list 'b -> list 'c +val fold_left2 : forall 'a 'b 'c. ('a -> 'b -> 'c -> 'a) -> 'a -> list 'b -> list 'c -> 'a +val fold_right2 : forall 'a 'b 'c. ('a -> 'b -> 'c -> 'c) -> list 'a -> list 'b -> 'c -> 'c + + +(* now maybe result and called lookup *) +val assoc : forall 'a 'b. 'a -> list ('a * 'b) -> 'b +let inline {ocaml} assoc = Ocaml.List.assoc + + +val mem_assoc : forall 'a 'b. 'a -> list ('a * 'b) -> bool +val remove_assoc : forall 'a 'b. 'a -> list ('a * 'b) -> list ('a * 'b) + + + +val stable_sort : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a +val fast_sort : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a + +val merge : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a -> list 'a +val intersect : forall 'a. list 'a -> list 'a -> list 'a + + +*) + +(*val catMaybes : forall 'a. list (maybe 'a) -> list 'a*) +function (sequential,domintros) catMaybes :: "('a option)list \<Rightarrow> 'a list " where + " catMaybes ([]) = ( + [])" +|" catMaybes (None # xs') = ( + catMaybes xs' )" +|" catMaybes (Some x # xs') = ( + x # catMaybes xs' )" +by pat_completeness auto + +end diff --git a/snapshots/isabelle/lib/lem/Lem_list_extra.thy b/snapshots/isabelle/lib/lem/Lem_list_extra.thy new file mode 100644 index 00000000..9caf32fc --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_list_extra.thy @@ -0,0 +1,117 @@ +chapter \<open>Generated by Lem from list_extra.lem.\<close> + +theory "Lem_list_extra" + +imports + Main + "Lem_bool" + "Lem_maybe" + "Lem_basic_classes" + "Lem_tuple" + "Lem_num" + "Lem_list" + "Lem_assert_extra" + +begin + + + +(*open import Bool Maybe Basic_classes Tuple Num List Assert_extra*) + +(* ------------------------- *) +(* head of non-empty list *) +(* ------------------------- *) +(*val head : forall 'a. list 'a -> 'a*) +(*let head l= match l with | x::xs -> x | [] -> failwith List_extra.head of empty list end*) + + +(* ------------------------- *) +(* tail of non-empty list *) +(* ------------------------- *) +(*val tail : forall 'a. list 'a -> list 'a*) +(*let tail l= match l with | x::xs -> xs | [] -> failwith List_extra.tail of empty list end*) + + +(* ------------------------- *) +(* last *) +(* ------------------------- *) +(*val last : forall 'a. list 'a -> 'a*) +(*let rec last l= match l with | [x] -> x | x1::x2::xs -> last (x2 :: xs) | [] -> failwith List_extra.last of empty list end*) + + +(* ------------------------- *) +(* init *) +(* ------------------------- *) + +(* All elements of a non-empty list except the last one. *) +(*val init : forall 'a. list 'a -> list 'a*) +(*let rec init l= match l with | [x] -> [] | x1::x2::xs -> x1::(init (x2::xs)) | [] -> failwith List_extra.init of empty list end*) + + +(* ------------------------- *) +(* foldl1 / foldr1 *) +(* ------------------------- *) + +(* folding functions for non-empty lists, + which don`t take the base case *) +(*val foldl1 : forall 'a. ('a -> 'a -> 'a) -> list 'a -> 'a*) +fun foldl1 :: "('a \<Rightarrow> 'a \<Rightarrow> 'a)\<Rightarrow> 'a list \<Rightarrow> 'a " where + " foldl1 f (x # xs) = ( List.foldl f x xs )" +|" foldl1 f ([]) = ( failwith (''List_extra.foldl1 of empty list''))" + + +(*val foldr1 : forall 'a. ('a -> 'a -> 'a) -> list 'a -> 'a*) +fun foldr1 :: "('a \<Rightarrow> 'a \<Rightarrow> 'a)\<Rightarrow> 'a list \<Rightarrow> 'a " where + " foldr1 f (x # xs) = ( List.foldr f xs x )" +|" foldr1 f ([]) = ( failwith (''List_extra.foldr1 of empty list''))" + + + +(* ------------------------- *) +(* nth element *) +(* ------------------------- *) + +(* get the nth element of a list *) +(*val nth : forall 'a. list 'a -> nat -> 'a*) +(*let nth l n= match index l n with Just e -> e | Nothing -> failwith List_extra.nth end*) + + +(* ------------------------- *) +(* Find_non_pure *) +(* ------------------------- *) +(*val findNonPure : forall 'a. ('a -> bool) -> list 'a -> 'a*) +definition findNonPure :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a " where + " findNonPure P l = ( (case (List.find P l) of + Some e => e + | None => failwith (''List_extra.findNonPure'') +))" + + + +(* ------------------------- *) +(* zip same length *) +(* ------------------------- *) + +(*val zipSameLength : forall 'a 'b. list 'a -> list 'b -> list ('a * 'b)*) +fun zipSameLength :: " 'a list \<Rightarrow> 'b list \<Rightarrow>('a*'b)list " where + " zipSameLength l1 l2 = ( (case (l1, l2) of + (x # xs, y # ys) => (x, y) # zipSameLength xs ys + | ([], []) => [] + | _ => failwith (''List_extra.zipSameLength of different length lists'') + +))" + + +(*val unfoldr: forall 'a 'b. ('a -> maybe ('b * 'a)) -> 'a -> list 'b*) +function (sequential,domintros) unfoldr :: "('a \<Rightarrow>('b*'a)option)\<Rightarrow> 'a \<Rightarrow> 'b list " where + " unfoldr f x = ( + (case f x of + Some (y, x') => + y # unfoldr f x' + | None => + [] + ))" +by pat_completeness auto + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_machine_word.thy b/snapshots/isabelle/lib/lem/Lem_machine_word.thy new file mode 100644 index 00000000..3f83789c --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_machine_word.thy @@ -0,0 +1,450 @@ +chapter \<open>Generated by Lem from machine_word.lem.\<close> + +theory "Lem_machine_word" + +imports + Main + "Lem_bool" + "Lem_num" + "Lem_basic_classes" + "Lem_show" + "~~/src/HOL/Word/Word" + +begin + + + +(*open import Bool Num Basic_classes Show*) + +(*open import {isabelle} `~~/src/HOL/Word/Word`*) +(*open import {hol} `wordsTheory` `wordsLib` `bitstringTheory` `integer_wordTheory`*) + +(*type mword 'a*) + +(*class (Size 'a) + val size : nat +end*) + +(*val native_size : forall 'a. nat*) + +(*val ocaml_inject : forall 'a. nat * natural -> mword 'a*) + +(* A singleton type family that can be used to carry a size as the type parameter *) + +(*type itself 'a*) + +(*val the_value : forall 'a. itself 'a*) + +(*val size_itself : forall 'a. Size 'a => itself 'a -> nat*) +definition size_itself :: "('a::len)itself \<Rightarrow> nat " where + " size_itself x = ( (len_of (TYPE(_) :: 'a itself)))" + + +(*******************************************************************) +(* Fixed bitwidths extracted from Anthony's models. *) +(* *) +(* If you need a size N that is not included here, put the lines *) +(* *) +(* type tyN *) +(* instance (Size tyN) let size = N end *) +(* declare isabelle target_rep type tyN = `N` *) +(* declare hol target_rep type tyN = `N` *) +(* *) +(* in your project, replacing N in each line. *) +(*******************************************************************) + +(*type ty1*) +(*type ty2*) +(*type ty3*) +(*type ty4*) +(*type ty5*) +(*type ty6*) +(*type ty7*) +(*type ty8*) +(*type ty9*) +(*type ty10*) +(*type ty11*) +(*type ty12*) +(*type ty13*) +(*type ty14*) +(*type ty15*) +(*type ty16*) +(*type ty17*) +(*type ty18*) +(*type ty19*) +(*type ty20*) +(*type ty21*) +(*type ty22*) +(*type ty23*) +(*type ty24*) +(*type ty25*) +(*type ty26*) +(*type ty27*) +(*type ty28*) +(*type ty29*) +(*type ty30*) +(*type ty31*) +(*type ty32*) +(*type ty33*) +(*type ty34*) +(*type ty35*) +(*type ty36*) +(*type ty37*) +(*type ty38*) +(*type ty39*) +(*type ty40*) +(*type ty41*) +(*type ty42*) +(*type ty43*) +(*type ty44*) +(*type ty45*) +(*type ty46*) +(*type ty47*) +(*type ty48*) +(*type ty49*) +(*type ty50*) +(*type ty51*) +(*type ty52*) +(*type ty53*) +(*type ty54*) +(*type ty55*) +(*type ty56*) +(*type ty57*) +(*type ty58*) +(*type ty59*) +(*type ty60*) +(*type ty61*) +(*type ty62*) +(*type ty63*) +(*type ty64*) +(*type ty65*) +(*type ty66*) +(*type ty67*) +(*type ty68*) +(*type ty69*) +(*type ty70*) +(*type ty71*) +(*type ty72*) +(*type ty73*) +(*type ty74*) +(*type ty75*) +(*type ty76*) +(*type ty77*) +(*type ty78*) +(*type ty79*) +(*type ty80*) +(*type ty81*) +(*type ty82*) +(*type ty83*) +(*type ty84*) +(*type ty85*) +(*type ty86*) +(*type ty87*) +(*type ty88*) +(*type ty89*) +(*type ty90*) +(*type ty91*) +(*type ty92*) +(*type ty93*) +(*type ty94*) +(*type ty95*) +(*type ty96*) +(*type ty97*) +(*type ty98*) +(*type ty99*) +(*type ty100*) +(*type ty101*) +(*type ty102*) +(*type ty103*) +(*type ty104*) +(*type ty105*) +(*type ty106*) +(*type ty107*) +(*type ty108*) +(*type ty109*) +(*type ty110*) +(*type ty111*) +(*type ty112*) +(*type ty113*) +(*type ty114*) +(*type ty115*) +(*type ty116*) +(*type ty117*) +(*type ty118*) +(*type ty119*) +(*type ty120*) +(*type ty121*) +(*type ty122*) +(*type ty123*) +(*type ty124*) +(*type ty125*) +(*type ty126*) +(*type ty127*) +(*type ty128*) +(*type ty129*) +(*type ty130*) +(*type ty131*) +(*type ty132*) +(*type ty133*) +(*type ty134*) +(*type ty135*) +(*type ty136*) +(*type ty137*) +(*type ty138*) +(*type ty139*) +(*type ty140*) +(*type ty141*) +(*type ty142*) +(*type ty143*) +(*type ty144*) +(*type ty145*) +(*type ty146*) +(*type ty147*) +(*type ty148*) +(*type ty149*) +(*type ty150*) +(*type ty151*) +(*type ty152*) +(*type ty153*) +(*type ty154*) +(*type ty155*) +(*type ty156*) +(*type ty157*) +(*type ty158*) +(*type ty159*) +(*type ty160*) +(*type ty161*) +(*type ty162*) +(*type ty163*) +(*type ty164*) +(*type ty165*) +(*type ty166*) +(*type ty167*) +(*type ty168*) +(*type ty169*) +(*type ty170*) +(*type ty171*) +(*type ty172*) +(*type ty173*) +(*type ty174*) +(*type ty175*) +(*type ty176*) +(*type ty177*) +(*type ty178*) +(*type ty179*) +(*type ty180*) +(*type ty181*) +(*type ty182*) +(*type ty183*) +(*type ty184*) +(*type ty185*) +(*type ty186*) +(*type ty187*) +(*type ty188*) +(*type ty189*) +(*type ty190*) +(*type ty191*) +(*type ty192*) +(*type ty193*) +(*type ty194*) +(*type ty195*) +(*type ty196*) +(*type ty197*) +(*type ty198*) +(*type ty199*) +(*type ty200*) +(*type ty201*) +(*type ty202*) +(*type ty203*) +(*type ty204*) +(*type ty205*) +(*type ty206*) +(*type ty207*) +(*type ty208*) +(*type ty209*) +(*type ty210*) +(*type ty211*) +(*type ty212*) +(*type ty213*) +(*type ty214*) +(*type ty215*) +(*type ty216*) +(*type ty217*) +(*type ty218*) +(*type ty219*) +(*type ty220*) +(*type ty221*) +(*type ty222*) +(*type ty223*) +(*type ty224*) +(*type ty225*) +(*type ty226*) +(*type ty227*) +(*type ty228*) +(*type ty229*) +(*type ty230*) +(*type ty231*) +(*type ty232*) +(*type ty233*) +(*type ty234*) +(*type ty235*) +(*type ty236*) +(*type ty237*) +(*type ty238*) +(*type ty239*) +(*type ty240*) +(*type ty241*) +(*type ty242*) +(*type ty243*) +(*type ty244*) +(*type ty245*) +(*type ty246*) +(*type ty247*) +(*type ty248*) +(*type ty249*) +(*type ty250*) +(*type ty251*) +(*type ty252*) +(*type ty253*) +(*type ty254*) +(*type ty255*) +(*type ty256*) +(*type ty257*) + +(*val word_length : forall 'a. mword 'a -> nat*) + +(******************************************************************) +(* Conversions *) +(******************************************************************) + +(*val signedIntegerFromWord : forall 'a. mword 'a -> integer*) + +(*val unsignedIntegerFromWord : forall 'a. mword 'a -> integer*) + +(* Version without typeclass constraint so that we can derive operations + in Lem for one of the theorem provers without requiring it. *) +(*val proverWordFromInteger : forall 'a. integer -> mword 'a*) + +(*val wordFromInteger : forall 'a. Size 'a => integer -> mword 'a*) +(* The OCaml version is defined after the arithmetic operations, below. *) + +(*val naturalFromWord : forall 'a. mword 'a -> natural*) + +(*val wordFromNatural : forall 'a. Size 'a => natural -> mword 'a*) + +(*val wordToHex : forall 'a. mword 'a -> string*) +(* Building libraries fails if we don't provide implementations for the + type class. *) +definition wordToHex :: "('a::len)Word.word \<Rightarrow> string " where + " wordToHex w = ( (''wordToHex not yet implemented''))" + + +definition instance_Show_Show_Machine_word_mword_dict :: "(('a::len)Word.word)Show_class " where + " instance_Show_Show_Machine_word_mword_dict = ((| + + show_method = wordToHex |) )" + + +(*val wordFromBitlist : forall 'a. Size 'a => list bool -> mword 'a*) + +(*val bitlistFromWord : forall 'a. mword 'a -> list bool*) + + +(*val size_test_fn : forall 'a. Size 'a => mword 'a -> nat*) +definition size_test_fn :: "('a::len)Word.word \<Rightarrow> nat " where + " size_test_fn _ = ( (len_of (TYPE(_) :: 'a itself)))" + + +(******************************************************************) +(* Comparisons *) +(******************************************************************) + +(*val mwordEq : forall 'a. mword 'a -> mword 'a -> bool*) + +(*val signedLess : forall 'a. mword 'a -> mword 'a -> bool*) + +(*val signedLessEq : forall 'a. mword 'a -> mword 'a -> bool*) + +(*val unsignedLess : forall 'a. mword 'a -> mword 'a -> bool*) + +(*val unsignedLessEq : forall 'a. mword 'a -> mword 'a -> bool*) + +(* Comparison tests are below, after the definition of wordFromInteger *) + +(******************************************************************) +(* Appending, splitting and probing words *) +(******************************************************************) + +(*val word_concat : forall 'a 'b 'c. mword 'a -> mword 'b -> mword 'c*) + +(* Note that we assume the result type has the correct size, especially + for Isabelle. *) +(*val word_extract : forall 'a 'b. nat -> nat -> mword 'a -> mword 'b*) + +(* Needs to be in the prover because we'd end up with unknown sizes in the + types in Lem. +*) +(*val word_update : forall 'a 'b. mword 'a -> nat -> nat -> mword 'b -> mword 'a*) + +(*val setBit : forall 'a. mword 'a -> nat -> bool -> mword 'a*) + +(*val getBit : forall 'a. mword 'a -> nat -> bool*) + +(*val msb : forall 'a. mword 'a -> bool*) + +(*val lsb : forall 'a. mword 'a -> bool*) + +(******************************************************************) +(* Bitwise operations, shifts, etc. *) +(******************************************************************) + +(*val shiftLeft : forall 'a. mword 'a -> nat -> mword 'a*) + +(*val shiftRight : forall 'a. mword 'a -> nat -> mword 'a*) + +(*val arithShiftRight : forall 'a. mword 'a -> nat -> mword 'a*) + +(*val lAnd : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val lOr : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val lXor : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val lNot : forall 'a. mword 'a -> mword 'a*) + +(*val rotateRight : forall 'a. nat -> mword 'a -> mword 'a*) + +(*val rotateLeft : forall 'a. nat -> mword 'a -> mword 'a*) + +(*val zeroExtend : forall 'a 'b. Size 'b => mword 'a -> mword 'b*) + +(*val signExtend : forall 'a 'b. Size 'b => mword 'a -> mword 'b*) + +(* Sign extension tests are below, after the definition of wordFromInteger *) + +(*****************************************************************) +(* Arithmetic *) +(*****************************************************************) + +(*val plus : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val minus : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val uminus : forall 'a. mword 'a -> mword 'a*) + +(*val times : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +(*val unsignedDivide : forall 'a. mword 'a -> mword 'a -> mword 'a*) +(*val signedDivide : forall 'a. mword 'a -> mword 'a -> mword 'a*) + +definition signedDivide :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word " where + " signedDivide x y = ( + if Bits.msb x then + if Bits.msb y then (- x) div (- y) + else - ((- x) div y) + else if Bits.msb y then - (x div (- y)) + else x div y )" + + +(*val modulo : forall 'a. mword 'a -> mword 'a -> mword 'a*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_map.thy b/snapshots/isabelle/lib/lem/Lem_map.thy new file mode 100644 index 00000000..fbaed71a --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_map.thy @@ -0,0 +1,159 @@ +chapter \<open>Generated by Lem from map.lem.\<close> + +theory "Lem_map" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_function" + "Lem_maybe" + "Lem_list" + "Lem_tuple" + "Lem_set" + "Lem_num" + +begin + + + +(*open import Bool Basic_classes Function Maybe List Tuple Set Num*) +(*open import {hol} `finite_mapTheory` `finite_mapLib`*) + +(*type map 'k 'v*) + + + +(* -------------------------------------------------------------------------- *) +(* Map equality. *) +(* -------------------------------------------------------------------------- *) + +(*val mapEqual : forall 'k 'v. Eq 'k, Eq 'v => map 'k 'v -> map 'k 'v -> bool*) +(*val mapEqualBy : forall 'k 'v. ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> map 'k 'v -> map 'k 'v -> bool*) + + +(* -------------------------------------------------------------------------- *) +(* Map type class *) +(* -------------------------------------------------------------------------- *) + +(*class ( MapKeyType 'a ) + val {ocaml;coq} mapKeyCompare : 'a -> 'a -> ordering +end*) + +(* -------------------------------------------------------------------------- *) +(* Empty maps *) +(* -------------------------------------------------------------------------- *) + +(*val empty : forall 'k 'v. MapKeyType 'k => map 'k 'v*) +(*val emptyBy : forall 'k 'v. ('k -> 'k -> ordering) -> map 'k 'v*) + + +(* -------------------------------------------------------------------------- *) +(* Insertion *) +(* -------------------------------------------------------------------------- *) + +(*val insert : forall 'k 'v. MapKeyType 'k => 'k -> 'v -> map 'k 'v -> map 'k 'v*) + + +(* -------------------------------------------------------------------------- *) +(* Singleton *) +(* -------------------------------------------------------------------------- *) + +(*val singleton : forall 'k 'v. MapKeyType 'k => 'k -> 'v -> map 'k 'v*) + + + +(* -------------------------------------------------------------------------- *) +(* Emptyness check *) +(* -------------------------------------------------------------------------- *) + +(*val null : forall 'k 'v. MapKeyType 'k, Eq 'k, Eq 'v => map 'k 'v -> bool*) + + +(* -------------------------------------------------------------------------- *) +(* lookup *) +(* -------------------------------------------------------------------------- *) + +(*val lookupBy : forall 'k 'v. ('k -> 'k -> ordering) -> 'k -> map 'k 'v -> maybe 'v*) + +(*val lookup : forall 'k 'v. MapKeyType 'k => 'k -> map 'k 'v -> maybe 'v*) + +(* -------------------------------------------------------------------------- *) +(* findWithDefault *) +(* -------------------------------------------------------------------------- *) + +(*val findWithDefault : forall 'k 'v. MapKeyType 'k => 'k -> 'v -> map 'k 'v -> 'v*) + +(* -------------------------------------------------------------------------- *) +(* from lists *) +(* -------------------------------------------------------------------------- *) + +(*val fromList : forall 'k 'v. MapKeyType 'k => list ('k * 'v) -> map 'k 'v*) +(*let fromList l= foldl (fun m (k,v) -> insert k v m) empty l*) + + +(* -------------------------------------------------------------------------- *) +(* to sets / domain / range *) +(* -------------------------------------------------------------------------- *) + +(*val toSet : forall 'k 'v. MapKeyType 'k, SetType 'k, SetType 'v => map 'k 'v -> set ('k * 'v)*) +(*val toSetBy : forall 'k 'v. (('k * 'v) -> ('k * 'v) -> ordering) -> map 'k 'v -> set ('k * 'v)*) + + +(*val domainBy : forall 'k 'v. ('k -> 'k -> ordering) -> map 'k 'v -> set 'k*) +(*val domain : forall 'k 'v. MapKeyType 'k, SetType 'k => map 'k 'v -> set 'k*) + + +(*val range : forall 'k 'v. MapKeyType 'k, SetType 'v => map 'k 'v -> set 'v*) +(*val rangeBy : forall 'k 'v. ('v -> 'v -> ordering) -> map 'k 'v -> set 'v*) + + +(* -------------------------------------------------------------------------- *) +(* member *) +(* -------------------------------------------------------------------------- *) + +(*val member : forall 'k 'v. MapKeyType 'k, SetType 'k, Eq 'k => 'k -> map 'k 'v -> bool*) + +(*val notMember : forall 'k 'v. MapKeyType 'k, SetType 'k, Eq 'k => 'k -> map 'k 'v -> bool*) + +(* -------------------------------------------------------------------------- *) +(* Quantification *) +(* -------------------------------------------------------------------------- *) + +(*val any : forall 'k 'v. MapKeyType 'k, Eq 'v => ('k -> 'v -> bool) -> map 'k 'v -> bool*) +(*val all : forall 'k 'v. MapKeyType 'k, Eq 'v => ('k -> 'v -> bool) -> map 'k 'v -> bool*) + +(*let all P m= (forall k v. (P k v && ((Instance_Basic_classes_Eq_Maybe_maybe.=) (lookup k m) (Just v))))*) + + +(* -------------------------------------------------------------------------- *) +(* Set-like operations. *) +(* -------------------------------------------------------------------------- *) +(*val deleteBy : forall 'k 'v. ('k -> 'k -> ordering) -> 'k -> map 'k 'v -> map 'k 'v*) +(*val delete : forall 'k 'v. MapKeyType 'k => 'k -> map 'k 'v -> map 'k 'v*) +(*val deleteSwap : forall 'k 'v. MapKeyType 'k => map 'k 'v -> 'k -> map 'k 'v*) + +(*val union : forall 'k 'v. MapKeyType 'k => map 'k 'v -> map 'k 'v -> map 'k 'v*) + +(*val unions : forall 'k 'v. MapKeyType 'k => list (map 'k 'v) -> map 'k 'v*) + + +(* -------------------------------------------------------------------------- *) +(* Maps (in the functor sense). *) +(* -------------------------------------------------------------------------- *) + +(*val map : forall 'k 'v 'w. MapKeyType 'k => ('v -> 'w) -> map 'k 'v -> map 'k 'w*) + +(*val mapi : forall 'k 'v 'w. MapKeyType 'k => ('k -> 'v -> 'w) -> map 'k 'v -> map 'k 'w*) + +(* -------------------------------------------------------------------------- *) +(* Cardinality *) +(* -------------------------------------------------------------------------- *) +(*val size : forall 'k 'v. MapKeyType 'k, SetType 'k => map 'k 'v -> nat*) + +(* instance of SetType *) +definition map_setElemCompare :: "(('d*'c)set \<Rightarrow>('b*'a)set \<Rightarrow> 'e)\<Rightarrow>('d,'c)Map.map \<Rightarrow>('b,'a)Map.map \<Rightarrow> 'e " where + " map_setElemCompare cmp x y = ( + cmp (map_to_set x) (map_to_set y))" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_map_extra.thy b/snapshots/isabelle/lib/lem/Lem_map_extra.thy new file mode 100644 index 00000000..4117fe81 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_map_extra.thy @@ -0,0 +1,82 @@ +chapter \<open>Generated by Lem from map_extra.lem.\<close> + +theory "Lem_map_extra" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_function" + "Lem_assert_extra" + "Lem_maybe" + "Lem_list" + "Lem_num" + "Lem_set" + "Lem_map" + +begin + + + +(*open import Bool Basic_classes Function Assert_extra Maybe List Num Set Map*) + +(* -------------------------------------------------------------------------- *) +(* find *) +(* -------------------------------------------------------------------------- *) + +(*val find : forall 'k 'v. MapKeyType 'k => 'k -> map 'k 'v -> 'v*) +(*let find k m= match (lookup k m) with Just x -> x | Nothing -> failwith Map_extra.find end*) + + + +(* -------------------------------------------------------------------------- *) +(* from sets / domain / range *) +(* -------------------------------------------------------------------------- *) + + +(*val fromSet : forall 'k 'v. MapKeyType 'k => ('k -> 'v) -> set 'k -> map 'k 'v*) +definition fromSet :: "('k \<Rightarrow> 'v)\<Rightarrow> 'k set \<Rightarrow>('k,'v)Map.map " where + " fromSet f s = ( Finite_Set.fold (\<lambda> k m . map_update k (f k) m) Map.empty s )" + + +(* +assert fromSet_0: (fromSet succ (Set.empty : set nat) = Map.empty) +assert fromSet_1: (fromSet succ {(2:nat); 3; 4}) = Map.fromList [(2,3); (3, 4); (4, 5)] +*) + +(* -------------------------------------------------------------------------- *) +(* fold *) +(* -------------------------------------------------------------------------- *) + +(*val fold : forall 'k 'v 'r. MapKeyType 'k, SetType 'k, SetType 'v => ('k -> 'v -> 'r -> 'r) -> map 'k 'v -> 'r -> 'r*) +definition fold :: "('k \<Rightarrow> 'v \<Rightarrow> 'r \<Rightarrow> 'r)\<Rightarrow>('k,'v)Map.map \<Rightarrow> 'r \<Rightarrow> 'r " where + " fold f m v = ( Finite_Set.fold ( \<lambda>x . + (case x of (k, v) => \<lambda> r . f k v r )) v (map_to_set m))" + + +(* +assert fold_1: (fold (fun k v a -> (a+k)) (Map.fromList [((2:nat),(3:nat)); (3, 4); (4, 5)]) 0 = 9) +assert fold_2: (fold (fun k v a -> (a+v)) (Map.fromList [((2:nat),(3:nat)); (3, 4); (4, 5)]) 0 = 12) +*) + +(*val toList: forall 'k 'v. MapKeyType 'k => map 'k 'v -> list ('k * 'v)*) +(* declare compile_message toList = Map_extra.toList is only defined for the ocaml, isabelle and coq backend *) + +(* more 'map' functions *) + +(* TODO: this function is in map_extra rather than map just for implementation reasons *) +(*val mapMaybe : forall 'a 'b 'c. MapKeyType 'a => ('a -> 'b -> maybe 'c) -> map 'a 'b -> map 'a 'c*) +(* OLD: TODO: mapMaybe depends on toList that is not defined for hol and isabelle *) +definition option_map :: "('a \<Rightarrow> 'b \<Rightarrow> 'c option)\<Rightarrow>('a,'b)Map.map \<Rightarrow>('a,'c)Map.map " where + " option_map f m = ( + List.foldl + (\<lambda> m' . \<lambda>x . + (case x of + (k, v) => + (case f k v of None => m' | Some v' => map_update k v' m' ) + )) + Map.empty + (list_of_set (LemExtraDefs.map_to_set m)))" + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_maybe.thy b/snapshots/isabelle/lib/lem/Lem_maybe.thy new file mode 100644 index 00000000..da0bde92 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_maybe.thy @@ -0,0 +1,113 @@ +chapter \<open>Generated by Lem from maybe.lem.\<close> + +theory "Lem_maybe" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_function" + +begin + + + +(*open import Bool Basic_classes Function*) + +(* ========================================================================== *) +(* Basic stuff *) +(* ========================================================================== *) + +(*type maybe 'a = + | Nothing + | Just of 'a*) + + +(*val maybeEqual : forall 'a. Eq 'a => maybe 'a -> maybe 'a -> bool*) +(*val maybeEqualBy : forall 'a. ('a -> 'a -> bool) -> maybe 'a -> maybe 'a -> bool*) + +fun maybeEqualBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a option \<Rightarrow> 'a option \<Rightarrow> bool " where + " maybeEqualBy eq None None = ( True )" +|" maybeEqualBy eq None (Some _) = ( False )" +|" maybeEqualBy eq (Some _) None = ( False )" +|" maybeEqualBy eq (Some x') (Some y') = ( (eq x' y'))" + + + +fun maybeCompare :: "('b \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow> 'b option \<Rightarrow> 'a option \<Rightarrow> ordering " where + " maybeCompare cmp None None = ( EQ )" +|" maybeCompare cmp None (Some _) = ( LT )" +|" maybeCompare cmp (Some _) None = ( GT )" +|" maybeCompare cmp (Some x') (Some y') = ( cmp x' y' )" + + +definition instance_Basic_classes_Ord_Maybe_maybe_dict :: " 'a Ord_class \<Rightarrow>('a option)Ord_class " where + " instance_Basic_classes_Ord_Maybe_maybe_dict dict_Basic_classes_Ord_a = ((| + + compare_method = (maybeCompare + (compare_method dict_Basic_classes_Ord_a)), + + isLess_method = (\<lambda> m1 . (\<lambda> m2 . maybeCompare + (compare_method dict_Basic_classes_Ord_a) m1 m2 = LT)), + + isLessEqual_method = (\<lambda> m1 . (\<lambda> m2 . ((let r = (maybeCompare + (compare_method dict_Basic_classes_Ord_a) m1 m2) in (r = LT) \<or> (r = EQ))))), + + isGreater_method = (\<lambda> m1 . (\<lambda> m2 . maybeCompare + (compare_method dict_Basic_classes_Ord_a) m1 m2 = GT)), + + isGreaterEqual_method = (\<lambda> m1 . (\<lambda> m2 . ((let r = (maybeCompare + (compare_method dict_Basic_classes_Ord_a) m1 m2) in (r = GT) \<or> (r = EQ)))))|) )" + + +(* ----------------------- *) +(* maybe *) +(* ----------------------- *) + +(*val maybe : forall 'a 'b. 'b -> ('a -> 'b) -> maybe 'a -> 'b*) +(*let maybe d f mb= match mb with + | Just a -> f a + | Nothing -> d +end*) + +(* ----------------------- *) +(* isJust / isNothing *) +(* ----------------------- *) + +(*val isJust : forall 'a. maybe 'a -> bool*) +(*let isJust mb= match mb with + | Just _ -> true + | Nothing -> false +end*) + +(*val isNothing : forall 'a. maybe 'a -> bool*) +(*let isNothing mb= match mb with + | Just _ -> false + | Nothing -> true +end*) + +(* ----------------------- *) +(* fromMaybe *) +(* ----------------------- *) + +(*val fromMaybe : forall 'a. 'a -> maybe 'a -> 'a*) +(*let fromMaybe d mb= match mb with + | Just v -> v + | Nothing -> d +end*) + +(* ----------------------- *) +(* map *) +(* ----------------------- *) + +(*val map : forall 'a 'b. ('a -> 'b) -> maybe 'a -> maybe 'b*) +(*let map f= maybe Nothing (fun v -> Just (f v))*) + + +(* ----------------------- *) +(* bind *) +(* ----------------------- *) + +(*val bind : forall 'a 'b. maybe 'a -> ('a -> maybe 'b) -> maybe 'b*) +(*let bind mb f= maybe Nothing f mb*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_maybe_extra.thy b/snapshots/isabelle/lib/lem/Lem_maybe_extra.thy new file mode 100644 index 00000000..0a57814c --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_maybe_extra.thy @@ -0,0 +1,24 @@ +chapter \<open>Generated by Lem from maybe_extra.lem.\<close> + +theory "Lem_maybe_extra" + +imports + Main + "Lem_basic_classes" + "Lem_maybe" + "Lem_assert_extra" + +begin + + + +(*open import Basic_classes Maybe Assert_extra*) + +(* ----------------------- *) +(* fromJust *) +(* ----------------------- *) + +(*val fromJust : forall 'a. maybe 'a -> 'a*) +(*let fromJust op= match op with | Just v -> v | Nothing -> failwith fromJust of Nothing end*) + +end diff --git a/snapshots/isabelle/lib/lem/Lem_num.thy b/snapshots/isabelle/lib/lem/Lem_num.thy new file mode 100644 index 00000000..0d7a72ea --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_num.thy @@ -0,0 +1,1302 @@ +chapter \<open>Generated by Lem from num.lem.\<close> + +theory "Lem_num" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "~~/src/HOL/Word/Word" + "Real" + "~~/src/HOL/NthRoot" + +begin + + + +(*open import Bool Basic_classes*) +(*open import {isabelle} `~~/src/HOL/Word/Word` `Real` `~~/src/HOL/NthRoot`*) +(*open import {hol} `integerTheory` `intReduce` `wordsTheory` `wordsLib` `ratTheory` `realTheory` `intrealTheory`*) +(*open import {coq} `Coq.Numbers.BinNums` `Coq.ZArith.BinInt` `Coq.ZArith.Zpower` `Coq.ZArith.Zdiv` `Coq.ZArith.Zmax` `Coq.Numbers.Natural.Peano.NPeano` `Coq.QArith.Qabs` `Coq.QArith.Qminmax` `Coq.Reals.ROrderedType` `Coq.Reals.Rbase` `Coq.Reals.Rfunctions`*) + +(*class inline ( Numeral 'a ) + val fromNumeral : numeral -> 'a +end*) + +(* ========================================================================== *) +(* Syntactic type-classes for common operations *) +(* ========================================================================== *) + +(* Typeclasses can be used as a mean to overload constants like +, -, etc *) + +record 'a NumNegate_class= + + numNegate_method ::" 'a \<Rightarrow> 'a " + + + +record 'a NumAbs_class= + + abs_method ::" 'a \<Rightarrow> 'a " + + + +record 'a NumAdd_class= + + numAdd_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a NumMinus_class= + + numMinus_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a NumMult_class= + + numMult_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a NumPow_class= + + numPow_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a " + + + +record 'a NumDivision_class= + + numDivision_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a NumIntegerDivision_class= + + div_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + + +record 'a NumRemainder_class= + + mod_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a NumSucc_class= + + succ_method ::" 'a \<Rightarrow> 'a " + + + +record 'a NumPred_class= + + pred_method ::" 'a \<Rightarrow> 'a " + + + + +(* ----------------------- *) +(* natural *) +(* ----------------------- *) + +(* unbounded size natural numbers *) +(*type natural*) + + +(* ----------------------- *) +(* int *) +(* ----------------------- *) + +(* bounded size integers with uncertain length *) + +(*type int*) + + +(* ----------------------- *) +(* integer *) +(* ----------------------- *) + +(* unbounded size integers *) + +(*type integer*) + +(* ----------------------- *) +(* bint *) +(* ----------------------- *) + +(* TODO the bounded ints are only partially implemented, use with care. *) + +(* 32 bit integers *) +(*type int32*) + +(* 64 bit integers *) +(*type int64*) + + +(* ----------------------- *) +(* rational *) +(* ----------------------- *) + +(* unbounded size and precision rational numbers *) + +(*type rational*) (* ???: better type for this in HOL? *) + + +(* ----------------------- *) +(* real *) +(* ----------------------- *) + +(* real numbers *) +(* Note that for OCaml, this is mapped to floats with 64 bits. *) + +(*type real*) (* ???: better type for this in HOL? *) + + +(* ----------------------- *) +(* double *) +(* ----------------------- *) + +(* double precision floating point (64 bits) *) + +(*type float64*) (* ???: better type for this in HOL? *) + +(*type float32*) (* ???: better type for this in HOL? *) + + +(* ========================================================================== *) +(* Binding the standard operations for the number types *) +(* ========================================================================== *) + + +(* ----------------------- *) +(* nat *) +(* ----------------------- *) + +(*val natFromNumeral : numeral -> nat*) + +(*val natEq : nat -> nat -> bool*) + +(*val natLess : nat -> nat -> bool*) +(*val natLessEqual : nat -> nat -> bool*) +(*val natGreater : nat -> nat -> bool*) +(*val natGreaterEqual : nat -> nat -> bool*) + +(*val natCompare : nat -> nat -> ordering*) + +definition instance_Basic_classes_Ord_nat_dict :: "(nat)Ord_class " where + " instance_Basic_classes_Ord_nat_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val natAdd : nat -> nat -> nat*) + +definition instance_Num_NumAdd_nat_dict :: "(nat)NumAdd_class " where + " instance_Num_NumAdd_nat_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val natMinus : nat -> nat -> nat*) + +definition instance_Num_NumMinus_nat_dict :: "(nat)NumMinus_class " where + " instance_Num_NumMinus_nat_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val natSucc : nat -> nat*) +(*let natSucc n= (Instance_Num_NumAdd_nat.+) n 1*) +definition instance_Num_NumSucc_nat_dict :: "(nat)NumSucc_class " where + " instance_Num_NumSucc_nat_dict = ((| + + succ_method = Suc |) )" + + +(*val natPred : nat -> nat*) +definition instance_Num_NumPred_nat_dict :: "(nat)NumPred_class " where + " instance_Num_NumPred_nat_dict = ((| + + pred_method = (\<lambda> n. n -( 1 :: nat))|) )" + + +(*val natMult : nat -> nat -> nat*) + +definition instance_Num_NumMult_nat_dict :: "(nat)NumMult_class " where + " instance_Num_NumMult_nat_dict = ((| + + numMult_method = (op*)|) )" + + +(*val natDiv : nat -> nat -> nat*) + +definition instance_Num_NumIntegerDivision_nat_dict :: "(nat)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_nat_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_nat_dict :: "(nat)NumDivision_class " where + " instance_Num_NumDivision_nat_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val natMod : nat -> nat -> nat*) + +definition instance_Num_NumRemainder_nat_dict :: "(nat)NumRemainder_class " where + " instance_Num_NumRemainder_nat_dict = ((| + + mod_method = (op mod)|) )" + + + +(*val gen_pow_aux : forall 'a. ('a -> 'a -> 'a) -> 'a -> 'a -> nat -> 'a*) +fun gen_pow_aux :: "('a \<Rightarrow> 'a \<Rightarrow> 'a)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a " where + " gen_pow_aux (mul :: 'a \<Rightarrow> 'a \<Rightarrow> 'a) (a :: 'a) (b :: 'a) (e :: nat) = ( + (case e of + 0 => a (* cannot happen, call discipline guarentees e >= 1 *) + | (Suc 0) => mul a b + | ( (Suc(Suc e'))) => (let e'' = (e div( 2 :: nat)) in + (let a' = (if (e mod( 2 :: nat)) =( 0 :: nat) then a else mul a b) in + gen_pow_aux mul a' (mul b b) e'')) + ))" + + +definition gen_pow :: " 'a \<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> 'a)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a " where + " gen_pow (one :: 'a) (mul :: 'a \<Rightarrow> 'a \<Rightarrow> 'a) (b :: 'a) (e :: nat) = ( + if e <( 0 :: nat) then one else + if (e =( 0 :: nat)) then one else gen_pow_aux mul one b e )" + + +(*val natPow : nat -> nat -> nat*) + +definition instance_Num_NumPow_nat_dict :: "(nat)NumPow_class " where + " instance_Num_NumPow_nat_dict = ((| + + numPow_method = (op^)|) )" + + +(*val natMin : nat -> nat -> nat*) + +(*val natMax : nat -> nat -> nat*) + +definition instance_Basic_classes_OrdMaxMin_nat_dict :: "(nat)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_nat_dict = ((| + + max_method = max, + + min_method = min |) )" + + + +(* ----------------------- *) +(* natural *) +(* ----------------------- *) + +(*val naturalFromNumeral : numeral -> natural*) + +(*val naturalEq : natural -> natural -> bool*) + +(*val naturalLess : natural -> natural -> bool*) +(*val naturalLessEqual : natural -> natural -> bool*) +(*val naturalGreater : natural -> natural -> bool*) +(*val naturalGreaterEqual : natural -> natural -> bool*) + +(*val naturalCompare : natural -> natural -> ordering*) + +definition instance_Basic_classes_Ord_Num_natural_dict :: "(nat)Ord_class " where + " instance_Basic_classes_Ord_Num_natural_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val naturalAdd : natural -> natural -> natural*) + +definition instance_Num_NumAdd_Num_natural_dict :: "(nat)NumAdd_class " where + " instance_Num_NumAdd_Num_natural_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val naturalMinus : natural -> natural -> natural*) + +definition instance_Num_NumMinus_Num_natural_dict :: "(nat)NumMinus_class " where + " instance_Num_NumMinus_Num_natural_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val naturalSucc : natural -> natural*) +(*let naturalSucc n= (Instance_Num_NumAdd_Num_natural.+) n 1*) +definition instance_Num_NumSucc_Num_natural_dict :: "(nat)NumSucc_class " where + " instance_Num_NumSucc_Num_natural_dict = ((| + + succ_method = Suc |) )" + + +(*val naturalPred : natural -> natural*) +definition instance_Num_NumPred_Num_natural_dict :: "(nat)NumPred_class " where + " instance_Num_NumPred_Num_natural_dict = ((| + + pred_method = (\<lambda> n. n -( 1 :: nat))|) )" + + +(*val naturalMult : natural -> natural -> natural*) + +definition instance_Num_NumMult_Num_natural_dict :: "(nat)NumMult_class " where + " instance_Num_NumMult_Num_natural_dict = ((| + + numMult_method = (op*)|) )" + + + +(*val naturalPow : natural -> nat -> natural*) + +definition instance_Num_NumPow_Num_natural_dict :: "(nat)NumPow_class " where + " instance_Num_NumPow_Num_natural_dict = ((| + + numPow_method = (op^)|) )" + + +(*val naturalDiv : natural -> natural -> natural*) + +definition instance_Num_NumIntegerDivision_Num_natural_dict :: "(nat)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Num_natural_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_Num_natural_dict :: "(nat)NumDivision_class " where + " instance_Num_NumDivision_Num_natural_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val naturalMod : natural -> natural -> natural*) + +definition instance_Num_NumRemainder_Num_natural_dict :: "(nat)NumRemainder_class " where + " instance_Num_NumRemainder_Num_natural_dict = ((| + + mod_method = (op mod)|) )" + + +(*val naturalMin : natural -> natural -> natural*) + +(*val naturalMax : natural -> natural -> natural*) + +definition instance_Basic_classes_OrdMaxMin_Num_natural_dict :: "(nat)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_natural_dict = ((| + + max_method = max, + + min_method = min |) )" + + + +(* ----------------------- *) +(* int *) +(* ----------------------- *) + +(*val intFromNumeral : numeral -> int*) + +(*val intEq : int -> int -> bool*) + +(*val intLess : int -> int -> bool*) +(*val intLessEqual : int -> int -> bool*) +(*val intGreater : int -> int -> bool*) +(*val intGreaterEqual : int -> int -> bool*) + +(*val intCompare : int -> int -> ordering*) + +definition instance_Basic_classes_Ord_Num_int_dict :: "(int)Ord_class " where + " instance_Basic_classes_Ord_Num_int_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val intNegate : int -> int*) + +definition instance_Num_NumNegate_Num_int_dict :: "(int)NumNegate_class " where + " instance_Num_NumNegate_Num_int_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val intAbs : int -> int*) (* TODO: check *) + +definition instance_Num_NumAbs_Num_int_dict :: "(int)NumAbs_class " where + " instance_Num_NumAbs_Num_int_dict = ((| + + abs_method = abs |) )" + + +(*val intAdd : int -> int -> int*) + +definition instance_Num_NumAdd_Num_int_dict :: "(int)NumAdd_class " where + " instance_Num_NumAdd_Num_int_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val intMinus : int -> int -> int*) + +definition instance_Num_NumMinus_Num_int_dict :: "(int)NumMinus_class " where + " instance_Num_NumMinus_Num_int_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val intSucc : int -> int*) +definition instance_Num_NumSucc_Num_int_dict :: "(int)NumSucc_class " where + " instance_Num_NumSucc_Num_int_dict = ((| + + succ_method = (\<lambda> n. n +( 1 :: int))|) )" + + +(*val intPred : int -> int*) +definition instance_Num_NumPred_Num_int_dict :: "(int)NumPred_class " where + " instance_Num_NumPred_Num_int_dict = ((| + + pred_method = (\<lambda> n. n -( 1 :: int))|) )" + + +(*val intMult : int -> int -> int*) + +definition instance_Num_NumMult_Num_int_dict :: "(int)NumMult_class " where + " instance_Num_NumMult_Num_int_dict = ((| + + numMult_method = (op*)|) )" + + + +(*val intPow : int -> nat -> int*) + +definition instance_Num_NumPow_Num_int_dict :: "(int)NumPow_class " where + " instance_Num_NumPow_Num_int_dict = ((| + + numPow_method = (op^)|) )" + + +(*val intDiv : int -> int -> int*) + +definition instance_Num_NumIntegerDivision_Num_int_dict :: "(int)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Num_int_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_Num_int_dict :: "(int)NumDivision_class " where + " instance_Num_NumDivision_Num_int_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val intMod : int -> int -> int*) + +definition instance_Num_NumRemainder_Num_int_dict :: "(int)NumRemainder_class " where + " instance_Num_NumRemainder_Num_int_dict = ((| + + mod_method = (op mod)|) )" + + +(*val intMin : int -> int -> int*) + +(*val intMax : int -> int -> int*) + +definition instance_Basic_classes_OrdMaxMin_Num_int_dict :: "(int)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_int_dict = ((| + + max_method = max, + + min_method = min |) )" + + +(* ----------------------- *) +(* int32 *) +(* ----------------------- *) +(*val int32FromNumeral : numeral -> int32*) + +(*val int32Eq : int32 -> int32 -> bool*) + +(*val int32Less : int32 -> int32 -> bool*) +(*val int32LessEqual : int32 -> int32 -> bool*) +(*val int32Greater : int32 -> int32 -> bool*) +(*val int32GreaterEqual : int32 -> int32 -> bool*) + +(*val int32Compare : int32 -> int32 -> ordering*) + +definition instance_Basic_classes_Ord_Num_int32_dict :: "( 32 word)Ord_class " where + " instance_Basic_classes_Ord_Num_int32_dict = ((| + + compare_method = (genericCompare word_sless (op=)), + + isLess_method = word_sless, + + isLessEqual_method = word_sle, + + isGreater_method = (\<lambda> x y. word_sless y x), + + isGreaterEqual_method = (\<lambda> x y. word_sle y x)|) )" + + +(*val int32Negate : int32 -> int32*) + +definition instance_Num_NumNegate_Num_int32_dict :: "( 32 word)NumNegate_class " where + " instance_Num_NumNegate_Num_int32_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val int32Abs : int32 -> int32*) +definition int32Abs :: " 32 word \<Rightarrow> 32 word " where + " int32Abs i = ( (if word_sle(((word_of_int 0) :: 32 word)) i then i else - i))" + + +definition instance_Num_NumAbs_Num_int32_dict :: "( 32 word)NumAbs_class " where + " instance_Num_NumAbs_Num_int32_dict = ((| + + abs_method = int32Abs |) )" + + + +(*val int32Add : int32 -> int32 -> int32*) + +definition instance_Num_NumAdd_Num_int32_dict :: "( 32 word)NumAdd_class " where + " instance_Num_NumAdd_Num_int32_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val int32Minus : int32 -> int32 -> int32*) + +definition instance_Num_NumMinus_Num_int32_dict :: "( 32 word)NumMinus_class " where + " instance_Num_NumMinus_Num_int32_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val int32Succ : int32 -> int32*) + +definition instance_Num_NumSucc_Num_int32_dict :: "( 32 word)NumSucc_class " where + " instance_Num_NumSucc_Num_int32_dict = ((| + + succ_method = (\<lambda> n. n +((word_of_int 1) :: 32 word))|) )" + + +(*val int32Pred : int32 -> int32*) +definition instance_Num_NumPred_Num_int32_dict :: "( 32 word)NumPred_class " where + " instance_Num_NumPred_Num_int32_dict = ((| + + pred_method = (\<lambda> n. n -((word_of_int 1) :: 32 word))|) )" + + +(*val int32Mult : int32 -> int32 -> int32*) + +definition instance_Num_NumMult_Num_int32_dict :: "( 32 word)NumMult_class " where + " instance_Num_NumMult_Num_int32_dict = ((| + + numMult_method = (op*)|) )" + + + +(*val int32Pow : int32 -> nat -> int32*) + +definition instance_Num_NumPow_Num_int32_dict :: "( 32 word)NumPow_class " where + " instance_Num_NumPow_Num_int32_dict = ((| + + numPow_method = (op^)|) )" + + +(*val int32Div : int32 -> int32 -> int32*) + +definition instance_Num_NumIntegerDivision_Num_int32_dict :: "( 32 word)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Num_int32_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_Num_int32_dict :: "( 32 word)NumDivision_class " where + " instance_Num_NumDivision_Num_int32_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val int32Mod : int32 -> int32 -> int32*) + +definition instance_Num_NumRemainder_Num_int32_dict :: "( 32 word)NumRemainder_class " where + " instance_Num_NumRemainder_Num_int32_dict = ((| + + mod_method = (op mod)|) )" + + +(*val int32Min : int32 -> int32 -> int32*) + +(*val int32Max : int32 -> int32 -> int32*) + +definition instance_Basic_classes_OrdMaxMin_Num_int32_dict :: "( 32 word)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_int32_dict = ((| + + max_method = ((\<lambda> x y. if (word_sle y x) then x else y)), + + min_method = ((\<lambda> x y. if (word_sle x y) then x else y))|) )" + + + + +(* ----------------------- *) +(* int64 *) +(* ----------------------- *) +(*val int64FromNumeral : numeral -> int64*) + +(*val int64Eq : int64 -> int64 -> bool*) + +(*val int64Less : int64 -> int64 -> bool*) +(*val int64LessEqual : int64 -> int64 -> bool*) +(*val int64Greater : int64 -> int64 -> bool*) +(*val int64GreaterEqual : int64 -> int64 -> bool*) + +(*val int64Compare : int64 -> int64 -> ordering*) + +definition instance_Basic_classes_Ord_Num_int64_dict :: "( 64 word)Ord_class " where + " instance_Basic_classes_Ord_Num_int64_dict = ((| + + compare_method = (genericCompare word_sless (op=)), + + isLess_method = word_sless, + + isLessEqual_method = word_sle, + + isGreater_method = (\<lambda> x y. word_sless y x), + + isGreaterEqual_method = (\<lambda> x y. word_sle y x)|) )" + + +(*val int64Negate : int64 -> int64*) + +definition instance_Num_NumNegate_Num_int64_dict :: "( 64 word)NumNegate_class " where + " instance_Num_NumNegate_Num_int64_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val int64Abs : int64 -> int64*) +definition int64Abs :: " 64 word \<Rightarrow> 64 word " where + " int64Abs i = ( (if word_sle(((word_of_int 0) :: 64 word)) i then i else - i))" + + +definition instance_Num_NumAbs_Num_int64_dict :: "( 64 word)NumAbs_class " where + " instance_Num_NumAbs_Num_int64_dict = ((| + + abs_method = int64Abs |) )" + + + +(*val int64Add : int64 -> int64 -> int64*) + +definition instance_Num_NumAdd_Num_int64_dict :: "( 64 word)NumAdd_class " where + " instance_Num_NumAdd_Num_int64_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val int64Minus : int64 -> int64 -> int64*) + +definition instance_Num_NumMinus_Num_int64_dict :: "( 64 word)NumMinus_class " where + " instance_Num_NumMinus_Num_int64_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val int64Succ : int64 -> int64*) + +definition instance_Num_NumSucc_Num_int64_dict :: "( 64 word)NumSucc_class " where + " instance_Num_NumSucc_Num_int64_dict = ((| + + succ_method = (\<lambda> n. n +((word_of_int 1) :: 64 word))|) )" + + +(*val int64Pred : int64 -> int64*) +definition instance_Num_NumPred_Num_int64_dict :: "( 64 word)NumPred_class " where + " instance_Num_NumPred_Num_int64_dict = ((| + + pred_method = (\<lambda> n. n -((word_of_int 1) :: 64 word))|) )" + + +(*val int64Mult : int64 -> int64 -> int64*) + +definition instance_Num_NumMult_Num_int64_dict :: "( 64 word)NumMult_class " where + " instance_Num_NumMult_Num_int64_dict = ((| + + numMult_method = (op*)|) )" + + + +(*val int64Pow : int64 -> nat -> int64*) + +definition instance_Num_NumPow_Num_int64_dict :: "( 64 word)NumPow_class " where + " instance_Num_NumPow_Num_int64_dict = ((| + + numPow_method = (op^)|) )" + + +(*val int64Div : int64 -> int64 -> int64*) + +definition instance_Num_NumIntegerDivision_Num_int64_dict :: "( 64 word)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Num_int64_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_Num_int64_dict :: "( 64 word)NumDivision_class " where + " instance_Num_NumDivision_Num_int64_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val int64Mod : int64 -> int64 -> int64*) + +definition instance_Num_NumRemainder_Num_int64_dict :: "( 64 word)NumRemainder_class " where + " instance_Num_NumRemainder_Num_int64_dict = ((| + + mod_method = (op mod)|) )" + + +(*val int64Min : int64 -> int64 -> int64*) + +(*val int64Max : int64 -> int64 -> int64*) + +definition instance_Basic_classes_OrdMaxMin_Num_int64_dict :: "( 64 word)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_int64_dict = ((| + + max_method = ((\<lambda> x y. if (word_sle y x) then x else y)), + + min_method = ((\<lambda> x y. if (word_sle x y) then x else y))|) )" + + + +(* ----------------------- *) +(* integer *) +(* ----------------------- *) + +(*val integerFromNumeral : numeral -> integer*) + +(*val integerFromNat : nat -> integer*) (* TODO: check *) + +(*val integerEq : integer -> integer -> bool*) + +(*val integerLess : integer -> integer -> bool*) +(*val integerLessEqual : integer -> integer -> bool*) +(*val integerGreater : integer -> integer -> bool*) +(*val integerGreaterEqual : integer -> integer -> bool*) + +(*val integerCompare : integer -> integer -> ordering*) + +definition instance_Basic_classes_Ord_Num_integer_dict :: "(int)Ord_class " where + " instance_Basic_classes_Ord_Num_integer_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val integerNegate : integer -> integer*) + +definition instance_Num_NumNegate_Num_integer_dict :: "(int)NumNegate_class " where + " instance_Num_NumNegate_Num_integer_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val integerAbs : integer -> integer*) (* TODO: check *) + +definition instance_Num_NumAbs_Num_integer_dict :: "(int)NumAbs_class " where + " instance_Num_NumAbs_Num_integer_dict = ((| + + abs_method = abs |) )" + + +(*val integerAdd : integer -> integer -> integer*) + +definition instance_Num_NumAdd_Num_integer_dict :: "(int)NumAdd_class " where + " instance_Num_NumAdd_Num_integer_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val integerMinus : integer -> integer -> integer*) + +definition instance_Num_NumMinus_Num_integer_dict :: "(int)NumMinus_class " where + " instance_Num_NumMinus_Num_integer_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val integerSucc : integer -> integer*) +definition instance_Num_NumSucc_Num_integer_dict :: "(int)NumSucc_class " where + " instance_Num_NumSucc_Num_integer_dict = ((| + + succ_method = (\<lambda> n. n +( 1 :: int))|) )" + + +(*val integerPred : integer -> integer*) +definition instance_Num_NumPred_Num_integer_dict :: "(int)NumPred_class " where + " instance_Num_NumPred_Num_integer_dict = ((| + + pred_method = (\<lambda> n. n -( 1 :: int))|) )" + + +(*val integerMult : integer -> integer -> integer*) + +definition instance_Num_NumMult_Num_integer_dict :: "(int)NumMult_class " where + " instance_Num_NumMult_Num_integer_dict = ((| + + numMult_method = (op*)|) )" + + + +(*val integerPow : integer -> nat -> integer*) + +definition instance_Num_NumPow_Num_integer_dict :: "(int)NumPow_class " where + " instance_Num_NumPow_Num_integer_dict = ((| + + numPow_method = (op^)|) )" + + +(*val integerDiv : integer -> integer -> integer*) + +definition instance_Num_NumIntegerDivision_Num_integer_dict :: "(int)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Num_integer_dict = ((| + + div_method = (op div)|) )" + + +definition instance_Num_NumDivision_Num_integer_dict :: "(int)NumDivision_class " where + " instance_Num_NumDivision_Num_integer_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val integerMod : integer -> integer -> integer*) + +definition instance_Num_NumRemainder_Num_integer_dict :: "(int)NumRemainder_class " where + " instance_Num_NumRemainder_Num_integer_dict = ((| + + mod_method = (op mod)|) )" + + +(*val integerMin : integer -> integer -> integer*) + +(*val integerMax : integer -> integer -> integer*) + +definition instance_Basic_classes_OrdMaxMin_Num_integer_dict :: "(int)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_integer_dict = ((| + + max_method = max, + + min_method = min |) )" + + + + +(* ----------------------- *) +(* rational *) +(* ----------------------- *) + +(*val rationalFromNumeral : numeral -> rational*) + +(*val rationalFromInt : int -> rational*) + +(*val rationalEq : rational -> rational -> bool*) + +(*val rationalLess : rational -> rational -> bool*) +(*val rationalLessEqual : rational -> rational -> bool*) +(*val rationalGreater : rational -> rational -> bool*) +(*val rationalGreaterEqual : rational -> rational -> bool*) + +(*val rationalCompare : rational -> rational -> ordering*) + +definition instance_Basic_classes_Ord_Num_rational_dict :: "(rat)Ord_class " where + " instance_Basic_classes_Ord_Num_rational_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val rationalAdd : rational -> rational -> rational*) + +definition instance_Num_NumAdd_Num_rational_dict :: "(rat)NumAdd_class " where + " instance_Num_NumAdd_Num_rational_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val rationalMinus : rational -> rational -> rational*) + +definition instance_Num_NumMinus_Num_rational_dict :: "(rat)NumMinus_class " where + " instance_Num_NumMinus_Num_rational_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val rationalNegate : rational -> rational*) + +definition instance_Num_NumNegate_Num_rational_dict :: "(rat)NumNegate_class " where + " instance_Num_NumNegate_Num_rational_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val rationalAbs : rational -> rational*) + +definition instance_Num_NumAbs_Num_rational_dict :: "(rat)NumAbs_class " where + " instance_Num_NumAbs_Num_rational_dict = ((| + + abs_method = abs |) )" + + +(*val rationalSucc : rational -> rational*) +definition instance_Num_NumSucc_Num_rational_dict :: "(rat)NumSucc_class " where + " instance_Num_NumSucc_Num_rational_dict = ((| + + succ_method = (\<lambda> n. n +(Fract ( 1 :: int) (1 :: int)))|) )" + + +(*val rationalPred : rational -> rational*) +definition instance_Num_NumPred_Num_rational_dict :: "(rat)NumPred_class " where + " instance_Num_NumPred_Num_rational_dict = ((| + + pred_method = (\<lambda> n. n -(Fract ( 1 :: int) (1 :: int)))|) )" + + +(*val rationalMult : rational -> rational -> rational*) + +definition instance_Num_NumMult_Num_rational_dict :: "(rat)NumMult_class " where + " instance_Num_NumMult_Num_rational_dict = ((| + + numMult_method = (op*)|) )" + + +(*val rationalDiv : rational -> rational -> rational*) + +definition instance_Num_NumDivision_Num_rational_dict :: "(rat)NumDivision_class " where + " instance_Num_NumDivision_Num_rational_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val rationalFromFrac : int -> int -> rational*) +(*let rationalFromFrac n d= (Instance_Num_NumDivision_Num_rational./) (rationalFromInt n) (rationalFromInt d)*) + +(*val rationalPowInteger : rational -> integer -> rational*) +fun rationalPowInteger :: " rat \<Rightarrow> int \<Rightarrow> rat " where + " rationalPowInteger b e = ( + if e =( 0 :: int) then(Fract ( 1 :: int) (1 :: int)) else + if e >( 0 :: int) then rationalPowInteger b (e -( 1 :: int)) * b else + rationalPowInteger b (e +( 1 :: int)) div b )" + + +(*val rationalPowNat : rational -> nat -> rational*) +(*let rationalPowNat r e= rationalPowInteger r (integerFromNat e)*) + +definition instance_Num_NumPow_Num_rational_dict :: "(rat)NumPow_class " where + " instance_Num_NumPow_Num_rational_dict = ((| + + numPow_method = power |) )" + + +(*val rationalMin : rational -> rational -> rational*) + +(*val rationalMax : rational -> rational -> rational*) + +definition instance_Basic_classes_OrdMaxMin_Num_rational_dict :: "(rat)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_rational_dict = ((| + + max_method = max, + + min_method = min |) )" + + + + +(* ----------------------- *) +(* real *) +(* ----------------------- *) + +(*val realFromNumeral : numeral -> real*) + +(*val realFromInteger : integer -> real*) + +(*val realEq : real -> real -> bool*) + +(*val realLess : real -> real -> bool*) +(*val realLessEqual : real -> real -> bool*) +(*val realGreater : real -> real -> bool*) +(*val realGreaterEqual : real -> real -> bool*) + +(*val realCompare : real -> real -> ordering*) + +definition instance_Basic_classes_Ord_Num_real_dict :: "(real)Ord_class " where + " instance_Basic_classes_Ord_Num_real_dict = ((| + + compare_method = (genericCompare (op<) (op=)), + + isLess_method = (op<), + + isLessEqual_method = (op \<le>), + + isGreater_method = (op>), + + isGreaterEqual_method = (op \<ge>)|) )" + + +(*val realAdd : real -> real -> real*) + +definition instance_Num_NumAdd_Num_real_dict :: "(real)NumAdd_class " where + " instance_Num_NumAdd_Num_real_dict = ((| + + numAdd_method = (op+)|) )" + + +(*val realMinus : real -> real -> real*) + +definition instance_Num_NumMinus_Num_real_dict :: "(real)NumMinus_class " where + " instance_Num_NumMinus_Num_real_dict = ((| + + numMinus_method = (op-)|) )" + + +(*val realNegate : real -> real*) + +definition instance_Num_NumNegate_Num_real_dict :: "(real)NumNegate_class " where + " instance_Num_NumNegate_Num_real_dict = ((| + + numNegate_method = (\<lambda> i. - i)|) )" + + +(*val realAbs : real -> real*) + +definition instance_Num_NumAbs_Num_real_dict :: "(real)NumAbs_class " where + " instance_Num_NumAbs_Num_real_dict = ((| + + abs_method = abs |) )" + + +(*val realSucc : real -> real*) +definition instance_Num_NumSucc_Num_real_dict :: "(real)NumSucc_class " where + " instance_Num_NumSucc_Num_real_dict = ((| + + succ_method = (\<lambda> n. n +( 1 :: real))|) )" + + +(*val realPred : real -> real*) +definition instance_Num_NumPred_Num_real_dict :: "(real)NumPred_class " where + " instance_Num_NumPred_Num_real_dict = ((| + + pred_method = (\<lambda> n. n -( 1 :: real))|) )" + + +(*val realMult : real -> real -> real*) + +definition instance_Num_NumMult_Num_real_dict :: "(real)NumMult_class " where + " instance_Num_NumMult_Num_real_dict = ((| + + numMult_method = (op*)|) )" + + +(*val realDiv : real -> real -> real*) + +definition instance_Num_NumDivision_Num_real_dict :: "(real)NumDivision_class " where + " instance_Num_NumDivision_Num_real_dict = ((| + + numDivision_method = (op div)|) )" + + +(*val realFromFrac : integer -> integer -> real*) +definition realFromFrac :: " int \<Rightarrow> int \<Rightarrow> real " where + " realFromFrac n d = ( ((real_of_int n)) div ((real_of_int d)))" + + +(*val realPowInteger : real -> integer -> real*) +fun realPowInteger :: " real \<Rightarrow> int \<Rightarrow> real " where + " realPowInteger b e = ( + if e =( 0 :: int) then( 1 :: real) else + if e >( 0 :: int) then realPowInteger b (e -( 1 :: int)) * b else + realPowInteger b (e +( 1 :: int)) div b )" + + +(*val realPowNat : real -> nat -> real*) +(*let realPowNat r e= realPowInteger r (integerFromNat e)*) + +definition instance_Num_NumPow_Num_real_dict :: "(real)NumPow_class " where + " instance_Num_NumPow_Num_real_dict = ((| + + numPow_method = power |) )" + + +(*val realSqrt : real -> real*) + +(*val realMin : real -> real -> real*) + +(*val realMax : real -> real -> real*) + +definition instance_Basic_classes_OrdMaxMin_Num_real_dict :: "(real)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Num_real_dict = ((| + + max_method = max, + + min_method = min |) )" + + +(*val realCeiling : real -> integer*) + +(*val realFloor : real -> integer*) + +(* ========================================================================== *) +(* Translation between number types *) +(* ========================================================================== *) + +(******************) +(* integerFrom... *) +(******************) + +(*val integerFromInt : int -> integer*) + +(*val integerFromNatural : natural -> integer*) + + +(*val integerFromInt32 : int32 -> integer*) + + +(*val integerFromInt64 : int64 -> integer*) + + +(******************) +(* naturalFrom... *) +(******************) + +(*val naturalFromNat : nat -> natural*) + +(*val naturalFromInteger : integer -> natural*) + + +(******************) +(* intFrom ... *) +(******************) + +(*val intFromInteger : integer -> int*) + +(*val intFromNat : nat -> int*) + + +(******************) +(* natFrom ... *) +(******************) + +(*val natFromNatural : natural -> nat*) + +(*val natFromInt : int -> nat*) + + +(******************) +(* int32From ... *) +(******************) + +(*val int32FromNat : nat -> int32*) + +(*val int32FromNatural : natural -> int32*) + +(*val int32FromInteger : integer -> int32*) +(*let int32FromInteger i= ( + let abs_int32 = int32FromNatural (naturalFromInteger i) in + if ((Instance_Basic_classes_Ord_Num_integer.<) i 0) then (Instance_Num_NumNegate_Num_int32.~ abs_int32) else abs_int32 +)*) + +(*val int32FromInt : int -> int32*) +(*let int32FromInt i= int32FromInteger (integerFromInt i)*) + + +(*val int32FromInt64 : int64 -> int32*) +(*let int32FromInt64 i= int32FromInteger (integerFromInt64 i)*) + + + + +(******************) +(* int64From ... *) +(******************) + +(*val int64FromNat : nat -> int64*) + +(*val int64FromNatural : natural -> int64*) + +(*val int64FromInteger : integer -> int64*) +(*let int64FromInteger i= ( + let abs_int64 = int64FromNatural (naturalFromInteger i) in + if ((Instance_Basic_classes_Ord_Num_integer.<) i 0) then (Instance_Num_NumNegate_Num_int64.~ abs_int64) else abs_int64 +)*) + +(*val int64FromInt : int -> int64*) +(*let int64FromInt i= int64FromInteger (integerFromInt i)*) + + +(*val int64FromInt32 : int32 -> int64*) +(*let int64FromInt32 i= int64FromInteger (integerFromInt32 i)*) + + +(******************) +(* what's missing *) +(******************) + +(*val naturalFromInt : int -> natural*) +(*val naturalFromInt32 : int32 -> natural*) +(*val naturalFromInt64 : int64 -> natural*) + + +(*val intFromNatural : natural -> int*) +(*val intFromInt32 : int32 -> int*) +(*val intFromInt64 : int64 -> int*) + +(*val natFromInteger : integer -> nat*) +(*val natFromInt32 : int32 -> nat*) +(*val natFromInt64 : int64 -> nat*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_num_extra.thy b/snapshots/isabelle/lib/lem/Lem_num_extra.thy new file mode 100644 index 00000000..0611862e --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_num_extra.thy @@ -0,0 +1,34 @@ +chapter \<open>Generated by Lem from num_extra.lem.\<close> + +theory "Lem_num_extra" + +imports + Main + "Lem_num" + "Lem_string" + +begin + +(* **************************************************** *) +(* *) +(* A library of additional functions on numbers *) +(* *) +(* **************************************************** *) + +(*open import Num*) +(*open import String*) + +(*val naturalOfString : string -> natural*) + +(*val integerOfString : string -> integer*) + + +(* Truncation integer division (round toward zero) *) +(*val integerDiv_t: integer -> integer -> integer*) + +(* Truncation modulo *) +(*val integerRem_t: integer -> integer -> integer*) + +(* Flooring modulo *) +(*val integerRem_f: integer -> integer -> integer*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_pervasives.thy b/snapshots/isabelle/lib/lem/Lem_pervasives.thy new file mode 100644 index 00000000..37da1224 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_pervasives.thy @@ -0,0 +1,31 @@ +chapter \<open>Generated by Lem from pervasives.lem.\<close> + +theory "Lem_pervasives" + +imports + Main + "Lem_basic_classes" + "Lem_bool" + "Lem_tuple" + "Lem_maybe" + "Lem_either" + "Lem_function" + "Lem_num" + "Lem_map" + "Lem_set" + "Lem_list" + "Lem_string" + "Lem_word" + "Lem_show" + "Lem_sorting" + "Lem_relation" + +begin + + + +(*include import Basic_classes Bool Tuple Maybe Either Function Num Map Set List String Word Show*) + +(*import Sorting Relation*) + +end diff --git a/snapshots/isabelle/lib/lem/Lem_pervasives_extra.thy b/snapshots/isabelle/lib/lem/Lem_pervasives_extra.thy new file mode 100644 index 00000000..0e3e5a88 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_pervasives_extra.thy @@ -0,0 +1,26 @@ +chapter \<open>Generated by Lem from pervasives_extra.lem.\<close> + +theory "Lem_pervasives_extra" + +imports + Main + "Lem_pervasives" + "Lem_function_extra" + "Lem_maybe_extra" + "Lem_map_extra" + "Lem_num_extra" + "Lem_set_extra" + "Lem_set_helpers" + "Lem_list_extra" + "Lem_string_extra" + "Lem_assert_extra" + "Lem_show_extra" + "Lem_machine_word" + +begin + + + +(*include import Pervasives*) +(*include import Function_extra Maybe_extra Map_extra Num_extra Set_extra Set_helpers List_extra String_extra Assert_extra Show_extra Machine_word*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_relation.thy b/snapshots/isabelle/lib/lem/Lem_relation.thy new file mode 100644 index 00000000..23e7d707 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_relation.thy @@ -0,0 +1,449 @@ +chapter \<open>Generated by Lem from relation.lem.\<close> + +theory "Lem_relation" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_tuple" + "Lem_set" + "Lem_num" + +begin + + + +(*open import Bool Basic_classes Tuple Set Num*) +(*open import {hol} `set_relationTheory`*) + +(* ========================================================================== *) +(* The type of relations *) +(* ========================================================================== *) + +type_synonym( 'a, 'b) rel_pred =" 'a \<Rightarrow> 'b \<Rightarrow> bool " +type_synonym( 'a, 'b) rel_set =" ('a * 'b) set " + +(* Binary relations are usually represented as either + sets of pairs (rel_set) or as curried functions (rel_pred). + + The choice depends on taste and the backend. Lem should not take a + decision, but supports both representations. There is an abstract type + pred, which can be converted to both representations. The representation + of pred itself then depends on the backend. However, for the time beeing, + let's implement relations as sets to get them working more quickly. *) + +type_synonym( 'a, 'b) rel =" ('a, 'b) rel_set " + +(*val relToSet : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> rel_set 'a 'b*) +(*val relFromSet : forall 'a 'b. SetType 'a, SetType 'b => rel_set 'a 'b -> rel 'a 'b*) + +(*val relEq : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> rel 'a 'b -> bool*) +definition relEq :: "('a*'b)set \<Rightarrow>('a*'b)set \<Rightarrow> bool " where + " relEq r1 r2 = ( (r1 = r2))" + + +(*val relToPred : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => rel 'a 'b -> rel_pred 'a 'b*) +(*val relFromPred : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => set 'a -> set 'b -> rel_pred 'a 'b -> rel 'a 'b*) + +definition relToPred :: "('a*'b)set \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool " where + " relToPred r = ( (\<lambda> x y . (x, y) \<in> r))" + +definition relFromPred :: " 'a set \<Rightarrow> 'b set \<Rightarrow>('a \<Rightarrow> 'b \<Rightarrow> bool)\<Rightarrow>('a*'b)set " where + " relFromPred xs ys p = ( set_filter ( \<lambda>x . + (case x of (x,y) => p x y )) (xs \<times> ys))" + + + +(* ========================================================================== *) +(* Basic Operations *) +(* ========================================================================== *) + +(* ----------------------- *) +(* membership test *) +(* ----------------------- *) + +(*val inRel : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => 'a -> 'b -> rel 'a 'b -> bool*) + + +(* ----------------------- *) +(* empty relation *) +(* ----------------------- *) + +(*val relEmpty : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b*) + +(* ----------------------- *) +(* Insertion *) +(* ----------------------- *) + +(*val relAdd : forall 'a 'b. SetType 'a, SetType 'b => 'a -> 'b -> rel 'a 'b -> rel 'a 'b*) + + +(* ----------------------- *) +(* Identity relation *) +(* ----------------------- *) + +(*val relIdOn : forall 'a. SetType 'a, Eq 'a => set 'a -> rel 'a 'a*) +definition relIdOn :: " 'a set \<Rightarrow>('a*'a)set " where + " relIdOn s = ( relFromPred s s (op=))" + + +(*val relId : forall 'a. SetType 'a, Eq 'a => rel 'a 'a*) + +(* ----------------------- *) +(* relation union *) +(* ----------------------- *) + +(*val relUnion : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> rel 'a 'b -> rel 'a 'b*) + +(* ----------------------- *) +(* relation intersection *) +(* ----------------------- *) + +(*val relIntersection : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => rel 'a 'b -> rel 'a 'b -> rel 'a 'b*) + +(* ----------------------- *) +(* Relation Composition *) +(* ----------------------- *) + +(*val relComp : forall 'a 'b 'c. SetType 'a, SetType 'b, SetType 'c, Eq 'a, Eq 'b => rel 'a 'b -> rel 'b 'c -> rel 'a 'c*) +(*let relComp r1 r2= relFromSet {(e1, e3) | forall ((e1,e2) IN (relToSet r1)) ((e2',e3) IN (relToSet r2)) | e2 = e2'}*) + +(* ----------------------- *) +(* restrict *) +(* ----------------------- *) + +(*val relRestrict : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> rel 'a 'a*) +definition relRestrict :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow>('a*'a)set " where + " relRestrict r s = ( ((let x2 = + ({}) in Finite_Set.fold + (\<lambda>a x2 . Finite_Set.fold + (\<lambda>b x2 . + if (a, b) \<in> r then Set.insert (a, b) x2 else x2) + x2 s) x2 s)))" + + + +(* ----------------------- *) +(* Converse *) +(* ----------------------- *) + +(*val relConverse : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> rel 'b 'a*) +(*let relConverse r= relFromSet (Set.map swap (relToSet r))*) + + +(* ----------------------- *) +(* domain *) +(* ----------------------- *) + +(*val relDomain : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> set 'a*) +(*let relDomain r= Set.map (fun x -> fst x) (relToSet r)*) + +(* ----------------------- *) +(* range *) +(* ----------------------- *) + +(*val relRange : forall 'a 'b. SetType 'a, SetType 'b => rel 'a 'b -> set 'b*) +(*let relRange r= Set.map (fun x -> snd x) (relToSet r)*) + + +(* ----------------------- *) +(* field / definedOn *) +(* *) +(* avoid the keyword field *) +(* ----------------------- *) + +(*val relDefinedOn : forall 'a. SetType 'a => rel 'a 'a -> set 'a*) + +(* ----------------------- *) +(* relOver *) +(* *) +(* avoid the keyword field *) +(* ----------------------- *) + +(*val relOver : forall 'a. SetType 'a => rel 'a 'a -> set 'a -> bool*) +definition relOver :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " relOver r s = ( ((((Domain r) \<union> (Range r))) \<subseteq> s))" + + + +(* ----------------------- *) +(* apply a relation *) +(* ----------------------- *) + +(* Given a relation r and a set s, relApply r s applies s to r, i.e. + it returns the set of all value reachable via r from a value in s. + This operation can be seen as a generalisation of function application. *) + +(*val relApply : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a => rel 'a 'b -> set 'a -> set 'b*) +(*let relApply r s= { y | forall ((x, y) IN (relToSet r)) | x IN s }*) + + +(* ========================================================================== *) +(* Properties *) +(* ========================================================================== *) + +(* ----------------------- *) +(* subrel *) +(* ----------------------- *) + +(*val isSubrel : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => rel 'a 'b -> rel 'a 'b -> bool*) + +(* ----------------------- *) +(* reflexivity *) +(* ----------------------- *) + +(*val isReflexiveOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isReflexiveOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isReflexiveOn r s = ( ((\<forall> e \<in> s. (e, e) \<in> r)))" + + +(*val isReflexive : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let ~{ocaml;coq} isReflexive r= (forall e. inRel e e r)*) + + +(* ----------------------- *) +(* irreflexivity *) +(* ----------------------- *) + +(*val isIrreflexiveOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isIrreflexiveOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isIrreflexiveOn r s = ( ((\<forall> e \<in> s. \<not> ((e, e) \<in> r))))" + + +(*val isIrreflexive : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let isIrreflexive r= (forall ((e1, e2) IN (relToSet r)). not (e1 = e2))*) + + +(* ----------------------- *) +(* symmetry *) +(* ----------------------- *) + +(*val isSymmetricOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isSymmetricOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isSymmetricOn r s = ( ((\<forall> e1 \<in> s. \<forall> e2 \<in> s. ((e1, e2) \<in> r) \<longrightarrow> ((e2, e1) \<in> r))))" + + +(*val isSymmetric : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let isSymmetric r= (forall ((e1, e2) IN relToSet r). inRel e2 e1 r)*) + + +(* ----------------------- *) +(* antisymmetry *) +(* ----------------------- *) + +(*val isAntisymmetricOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isAntisymmetricOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isAntisymmetricOn r s = ( ((\<forall> e1 \<in> s. \<forall> e2 \<in> s. ((e1, e2) \<in> r) \<longrightarrow> (((e2, e1) \<in> r) \<longrightarrow> (e1 = e2)))))" + + +(*val isAntisymmetric : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let isAntisymmetric r= (forall ((e1, e2) IN relToSet r). (inRel e2 e1 r) --> (e1 = e2))*) + + +(* ----------------------- *) +(* transitivity *) +(* ----------------------- *) + +(*val isTransitiveOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isTransitiveOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isTransitiveOn r s = ( ((\<forall> e1 \<in> s. \<forall> e2 \<in> s. \<forall> e3 \<in> s. ((e1, e2) \<in> r) \<longrightarrow> (((e2, e3) \<in> r) \<longrightarrow> ((e1, e3) \<in> r)))))" + + +(*val isTransitive : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let isTransitive r= (forall ((e1, e2) IN relToSet r) (e3 IN relApply r {e2}). inRel e1 e3 r)*) + +(* ----------------------- *) +(* total *) +(* ----------------------- *) + +(*val isTotalOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isTotalOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isTotalOn r s = ( ((\<forall> e1 \<in> s. \<forall> e2 \<in> s. ((e1, e2) \<in> r) \<or> ((e2, e1) \<in> r))))" + + + +(*val isTotal : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +(*let ~{ocaml;coq} isTotal r= (forall e1 e2. (inRel e1 e2 r) || (inRel e2 e1 r))*) + +(*val isTrichotomousOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isTrichotomousOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isTrichotomousOn r s = ( ((\<forall> e1 \<in> s. \<forall> e2 \<in> s. ((e1, e2) \<in> r) \<or> ((e1 = e2) \<or> ((e2, e1) \<in> r)))))" + + +(*val isTrichotomous : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isTrichotomous :: "('a*'a)set \<Rightarrow> bool " where + " isTrichotomous r = ( ((\<forall> e1. \<forall> e2. ((e1, e2) \<in> r) \<or> ((e1 = e2) \<or> ((e2, e1) \<in> r)))))" + + + +(* ----------------------- *) +(* is_single_valued *) +(* ----------------------- *) + +(*val isSingleValued : forall 'a 'b. SetType 'a, SetType 'b, Eq 'a, Eq 'b => rel 'a 'b -> bool*) +definition isSingleValued :: "('a*'b)set \<Rightarrow> bool " where + " isSingleValued r = ( ((\<forall> (e1, e2a) \<in> r. \<forall> e2b \<in> Image r {e1}. e2a = e2b)))" + + + +(* ----------------------- *) +(* equivalence relation *) +(* ----------------------- *) + +(*val isEquivalenceOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isEquivalenceOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isEquivalenceOn r s = ( isReflexiveOn r s \<and> (isSymmetricOn r s \<and> isTransitiveOn r s))" + + + +(*val isEquivalence : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isEquivalence :: "('a*'a)set \<Rightarrow> bool " where + " isEquivalence r = ( refl r \<and> (sym r \<and> trans r))" + + + +(* ----------------------- *) +(* well founded *) +(* ----------------------- *) + +(*val isWellFounded : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isWellFounded :: "('a*'a)set \<Rightarrow> bool " where + " isWellFounded r = ( ((\<forall> P. ((\<forall> x. ((\<forall> y. ((y, x) \<in> r) \<longrightarrow> P x)) \<longrightarrow> P x)) \<longrightarrow> ((\<forall> x. P x)))))" + + + +(* ========================================================================== *) +(* Orders *) +(* ========================================================================== *) + + +(* ----------------------- *) +(* pre- or quasiorders *) +(* ----------------------- *) + +(*val isPreorderOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isPreorderOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isPreorderOn r s = ( isReflexiveOn r s \<and> isTransitiveOn r s )" + + +(*val isPreorder : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isPreorder :: "('a*'a)set \<Rightarrow> bool " where + " isPreorder r = ( refl r \<and> trans r )" + + + +(* ----------------------- *) +(* partial orders *) +(* ----------------------- *) + +(*val isPartialOrderOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isPartialOrderOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isPartialOrderOn r s = ( isReflexiveOn r s \<and> (isTransitiveOn r s \<and> isAntisymmetricOn r s))" + + + +(*val isStrictPartialOrderOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isStrictPartialOrderOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isStrictPartialOrderOn r s = ( isIrreflexiveOn r s \<and> isTransitiveOn r s )" + + + +(*val isStrictPartialOrder : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isStrictPartialOrder :: "('a*'a)set \<Rightarrow> bool " where + " isStrictPartialOrder r = ( irrefl r \<and> trans r )" + + +(*val isPartialOrder : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isPartialOrder :: "('a*'a)set \<Rightarrow> bool " where + " isPartialOrder r = ( refl r \<and> (trans r \<and> antisym r))" + + +(* ----------------------- *) +(* total / linear orders *) +(* ----------------------- *) + +(*val isTotalOrderOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isTotalOrderOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isTotalOrderOn r s = ( isPartialOrderOn r s \<and> isTotalOn r s )" + + +(*val isStrictTotalOrderOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> bool*) +definition isStrictTotalOrderOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow> bool " where + " isStrictTotalOrderOn r s = ( isStrictPartialOrderOn r s \<and> isTrichotomousOn r s )" + + +(*val isTotalOrder : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isTotalOrder :: "('a*'a)set \<Rightarrow> bool " where + " isTotalOrder r = ( isPartialOrder r \<and> total r )" + + +(*val isStrictTotalOrder : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> bool*) +definition isStrictTotalOrder :: "('a*'a)set \<Rightarrow> bool " where + " isStrictTotalOrder r = ( isStrictPartialOrder r \<and> isTrichotomous r )" + + + + +(* ========================================================================== *) +(* closures *) +(* ========================================================================== *) + +(* ----------------------- *) +(* transitive closure *) +(* ----------------------- *) + +(*val transitiveClosure : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> rel 'a 'a*) +(*val transitiveClosureByEq : forall 'a. ('a -> 'a -> bool) -> rel 'a 'a -> rel 'a 'a*) +(*val transitiveClosureByCmp : forall 'a. ('a * 'a -> 'a * 'a -> ordering) -> rel 'a 'a -> rel 'a 'a*) + + +(* ----------------------- *) +(* transitive closure step *) +(* ----------------------- *) + +(*val transitiveClosureAdd : forall 'a. SetType 'a, Eq 'a => 'a -> 'a -> rel 'a 'a -> rel 'a 'a*) + +definition transitiveClosureAdd :: " 'a \<Rightarrow> 'a \<Rightarrow>('a*'a)set \<Rightarrow>('a*'a)set " where + " transitiveClosureAdd x y r = ( + (((((Set.insert (x,y) (r)))) \<union> ((((((let x2 = + ({}) in Finite_Set.fold + (\<lambda>z x2 . if (y, z) \<in> r then Set.insert (x, z) x2 else x2) + x2 (Range r)))) \<union> (((let x2 = + ({}) in Finite_Set.fold + (\<lambda>z x2 . if (z, x) \<in> r then Set.insert (z, y) x2 else x2) + x2 (Domain r))))))))))" + + + +(* ========================================================================== *) +(* reflexive closure *) +(* ========================================================================== *) + +(*val reflexiveTransitiveClosureOn : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> set 'a -> rel 'a 'a*) +definition reflexiveTransitiveClosureOn :: "('a*'a)set \<Rightarrow> 'a set \<Rightarrow>('a*'a)set " where + " reflexiveTransitiveClosureOn r s = ( trancl (((r) \<union> ((relIdOn s)))))" + + + +(*val reflexiveTransitiveClosure : forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> rel 'a 'a*) +definition reflexiveTransitiveClosure :: "('a*'a)set \<Rightarrow>('a*'a)set " where + " reflexiveTransitiveClosure r = ( trancl (((r) \<union> (Id))))" + + + + +(* ========================================================================== *) +(* inverse of closures *) +(* ========================================================================== *) + +(* ----------------------- *) +(* without transitve edges *) +(* ----------------------- *) + +(*val withoutTransitiveEdges: forall 'a. SetType 'a, Eq 'a => rel 'a 'a -> rel 'a 'a*) +(*let withoutTransitiveEdges r= + let tc = transitiveClosure r in + {(a, c) | forall ((a, c) IN r) + | forall (b IN relRange r). a <> b && b <> c --> not ((a, b) IN tc && (b, c) IN tc)}*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_set.thy b/snapshots/isabelle/lib/lem/Lem_set.thy new file mode 100644 index 00000000..f77d4d98 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_set.thy @@ -0,0 +1,325 @@ +chapter \<open>Generated by Lem from set.lem.\<close> + +theory "Lem_set" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_maybe" + "Lem_function" + "Lem_num" + "Lem_list" + "Lem_set_helpers" + "Lem" + +begin + +(******************************************************************************) +(* A library for sets *) +(* *) +(* It mainly follows the Haskell Set-library *) +(******************************************************************************) + +(* Sets in Lem are a bit tricky. On the one hand, we want efficiently executable sets. + OCaml and Haskell both represent sets by some kind of balancing trees. This means + that sets are finite and an order on the element type is required. + Such sets are constructed by simple, executable operations like inserting or + deleting elements, union, intersection, filtering etc. + + On the other hand, we want to use sets for specifications. This leads often + infinite sets, which are specificied in complicated, perhaps even undecidable + ways. + + The set library in this file, chooses the first approach. It describes + *finite* sets with an underlying order. Infinite sets should in the medium + run be represented by a separate type. Since this would require some significant + changes to Lem, for the moment also infinite sets are represented using this + class. However, a run-time exception might occour when using these sets. + This problem needs adressing in the future. *) + + +(* ========================================================================== *) +(* Header *) +(* ========================================================================== *) + +(*open import Bool Basic_classes Maybe Function Num List Set_helpers*) + +(* DPM: sets currently implemented as lists due to mismatch between Coq type + * class hierarchy and the hierarchy implemented in Lem. + *) +(*open import {coq} `Coq.Lists.List`*) +(*open import {hol} `lemTheory`*) +(*open import {isabelle} `$LIB_DIR/Lem`*) + +(* ----------------------- *) +(* Equality check *) +(* ----------------------- *) + +(*val setEqualBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> bool*) + +(*val setEqual : forall 'a. SetType 'a => set 'a -> set 'a -> bool*) + +(* ----------------------- *) +(* Empty set *) +(* ----------------------- *) + +(*val empty : forall 'a. SetType 'a => set 'a*) +(*val emptyBy : forall 'a. ('a -> 'a -> ordering) -> set 'a*) + +(* ----------------------- *) +(* any / all *) +(* ----------------------- *) + +(*val any : forall 'a. SetType 'a => ('a -> bool) -> set 'a -> bool*) + +(*val all : forall 'a. SetType 'a => ('a -> bool) -> set 'a -> bool*) + + +(* ----------------------- *) +(* (IN) *) +(* ----------------------- *) + +(*val IN [member] : forall 'a. SetType 'a => 'a -> set 'a -> bool*) +(*val memberBy : forall 'a. ('a -> 'a -> ordering) -> 'a -> set 'a -> bool*) + +(* ----------------------- *) +(* not (IN) *) +(* ----------------------- *) + +(*val NIN [notMember] : forall 'a. SetType 'a => 'a -> set 'a -> bool*) + + + +(* ----------------------- *) +(* Emptyness check *) +(* ----------------------- *) + +(*val null : forall 'a. SetType 'a => set 'a -> bool*) + + +(* ------------------------ *) +(* singleton *) +(* ------------------------ *) + +(*val singletonBy : forall 'a. ('a -> 'a -> ordering) -> 'a -> set 'a*) +(*val singleton : forall 'a. SetType 'a => 'a -> set 'a*) + + +(* ----------------------- *) +(* size *) +(* ----------------------- *) + +(*val size : forall 'a. SetType 'a => set 'a -> nat*) + + +(* ----------------------------*) +(* setting up pattern matching *) +(* --------------------------- *) + +(*val set_case : forall 'a 'b. SetType 'a => set 'a -> 'b -> ('a -> 'b) -> 'b -> 'b*) + + +(* ------------------------ *) +(* union *) +(* ------------------------ *) + +(*val unionBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> set 'a*) +(*val union : forall 'a. SetType 'a => set 'a -> set 'a -> set 'a*) + +(* ----------------------- *) +(* insert *) +(* ----------------------- *) + +(*val insert : forall 'a. SetType 'a => 'a -> set 'a -> set 'a*) + +(* ----------------------- *) +(* filter *) +(* ----------------------- *) + +(*val filter : forall 'a. SetType 'a => ('a -> bool) -> set 'a -> set 'a*) +(*let filter P s= {e | forall (e IN s) | P e}*) + + +(* ----------------------- *) +(* partition *) +(* ----------------------- *) + +(*val partition : forall 'a. SetType 'a => ('a -> bool) -> set 'a -> set 'a * set 'a*) +definition partition :: "('a \<Rightarrow> bool)\<Rightarrow> 'a set \<Rightarrow> 'a set*'a set " where + " partition P s = ( (set_filter P s, set_filter (\<lambda> e . \<not> (P e)) s))" + + + +(* ----------------------- *) +(* split *) +(* ----------------------- *) + +(*val split : forall 'a. SetType 'a, Ord 'a => 'a -> set 'a -> set 'a * set 'a*) +definition split :: " 'a Ord_class \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> 'a set*'a set " where + " split dict_Basic_classes_Ord_a p s = ( (set_filter ( + (isGreater_method dict_Basic_classes_Ord_a) p) s, set_filter ((isLess_method dict_Basic_classes_Ord_a) p) s))" + + +(*val splitMember : forall 'a. SetType 'a, Ord 'a => 'a -> set 'a -> set 'a * bool * set 'a*) +definition splitMember :: " 'a Ord_class \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> 'a set*bool*'a set " where + " splitMember dict_Basic_classes_Ord_a p s = ( (set_filter ( + (isLess_method dict_Basic_classes_Ord_a) p) s, (p \<in> s), set_filter ( + (isGreater_method dict_Basic_classes_Ord_a) p) s))" + + +(* ------------------------ *) +(* subset and proper subset *) +(* ------------------------ *) + +(*val isSubsetOfBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> bool*) +(*val isProperSubsetOfBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> bool*) + +(*val isSubsetOf : forall 'a. SetType 'a => set 'a -> set 'a -> bool*) +(*val isProperSubsetOf : forall 'a. SetType 'a => set 'a -> set 'a -> bool*) + + +(* ------------------------ *) +(* delete *) +(* ------------------------ *) + +(*val delete : forall 'a. SetType 'a, Eq 'a => 'a -> set 'a -> set 'a*) +(*val deleteBy : forall 'a. SetType 'a => ('a -> 'a -> bool) -> 'a -> set 'a -> set 'a*) + + +(* ------------------------ *) +(* bigunion *) +(* ------------------------ *) + +(*val bigunion : forall 'a. SetType 'a => set (set 'a) -> set 'a*) +(*val bigunionBy : forall 'a. ('a -> 'a -> ordering) -> set (set 'a) -> set 'a*) + +(*let bigunion bs= {x | forall (s IN bs) (x IN s) | true}*) + +(* ------------------------ *) +(* big intersection *) +(* ------------------------ *) + +(* Shaked's addition, for which he is now forever responsible as a de facto + * Lem maintainer... + *) +(*val bigintersection : forall 'a. SetType 'a => set (set 'a) -> set 'a*) +definition bigintersection :: "('a set)set \<Rightarrow> 'a set " where + " bigintersection bs = ( (let x2 = + ({}) in Finite_Set.fold + (\<lambda>x x2 . + if( \<forall> s \<in> bs. x \<in> s) then Set.insert x x2 else x2) + x2 (\<Union> bs)))" + + +(* ------------------------ *) +(* difference *) +(* ------------------------ *) + +(*val differenceBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> set 'a*) +(*val difference : forall 'a. SetType 'a => set 'a -> set 'a -> set 'a*) + +(* ------------------------ *) +(* intersection *) +(* ------------------------ *) + +(*val intersection : forall 'a. SetType 'a => set 'a -> set 'a -> set 'a*) +(*val intersectionBy : forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> set 'a*) + + +(* ------------------------ *) +(* map *) +(* ------------------------ *) + +(*val map : forall 'a 'b. SetType 'a, SetType 'b => ('a -> 'b) -> set 'a -> set 'b*) (* before image *) +(*let map f s= { f e | forall (e IN s) | true }*) + +(*val mapBy : forall 'a 'b. ('b -> 'b -> ordering) -> ('a -> 'b) -> set 'a -> set 'b*) + + +(* ------------------------ *) +(* bigunionMap *) +(* ------------------------ *) + +(* In order to avoid providing an comparison function for sets of sets, + it might be better to combine bigunion and map sometimes into a single operation. *) + +(*val bigunionMap : forall 'a 'b. SetType 'a, SetType 'b => ('a -> set 'b) -> set 'a -> set 'b*) +(*val bigunionMapBy : forall 'a 'b. ('b -> 'b -> ordering) -> ('a -> set 'b) -> set 'a -> set 'b*) + +(* ------------------------ *) +(* mapMaybe and fromMaybe *) +(* ------------------------ *) + +(* If the mapping function returns Just x, x is added to the result + set. If it returns Nothing, no element is added. *) + +(*val mapMaybe : forall 'a 'b. SetType 'a, SetType 'b => ('a -> maybe 'b) -> set 'a -> set 'b*) +definition setMapMaybe :: "('a \<Rightarrow> 'b option)\<Rightarrow> 'a set \<Rightarrow> 'b set " where + " setMapMaybe f s = ( + \<Union> (Set.image (\<lambda> x . (case f x of + Some y => {y} + | None => {} + )) s))" + + +(*val removeMaybe : forall 'a. SetType 'a => set (maybe 'a) -> set 'a*) +definition removeMaybe :: "('a option)set \<Rightarrow> 'a set " where + " removeMaybe s = ( setMapMaybe (\<lambda> x . x) s )" + + +(* ------------------------ *) +(* min and max *) +(* ------------------------ *) + +(*val findMin : forall 'a. SetType 'a, Eq 'a => set 'a -> maybe 'a*) +(*val findMax : forall 'a. SetType 'a, Eq 'a => set 'a -> maybe 'a*) + +(* ------------------------ *) +(* fromList *) +(* ------------------------ *) + +(*val fromList : forall 'a. SetType 'a => list 'a -> set 'a*) (* before from_list *) +(*val fromListBy : forall 'a. ('a -> 'a -> ordering) -> list 'a -> set 'a*) + + +(* ------------------------ *) +(* Sigma *) +(* ------------------------ *) + +(*val sigma : forall 'a 'b. SetType 'a, SetType 'b => set 'a -> ('a -> set 'b) -> set ('a * 'b)*) +(*val sigmaBy : forall 'a 'b. (('a * 'b) -> ('a * 'b) -> ordering) -> set 'a -> ('a -> set 'b) -> set ('a * 'b)*) + +(*let sigma sa sb= { (a, b) | forall (a IN sa) (b IN sb a) | true }*) + + +(* ------------------------ *) +(* cross product *) +(* ------------------------ *) + +(*val cross : forall 'a 'b. SetType 'a, SetType 'b => set 'a -> set 'b -> set ('a * 'b)*) +(*val crossBy : forall 'a 'b. (('a * 'b) -> ('a * 'b) -> ordering) -> set 'a -> set 'b -> set ('a * 'b)*) + +(*let cross s1 s2= { (e1, e2) | forall (e1 IN s1) (e2 IN s2) | true }*) + + +(* ------------------------ *) +(* finite *) +(* ------------------------ *) + +(*val finite : forall 'a. SetType 'a => set 'a -> bool*) + + +(* ----------------------------*) +(* fixed point *) +(* --------------------------- *) + +(*val leastFixedPoint : forall 'a. SetType 'a + => nat -> (set 'a -> set 'a) -> set 'a -> set 'a*) +fun leastFixedPoint :: " nat \<Rightarrow>('a set \<Rightarrow> 'a set)\<Rightarrow> 'a set \<Rightarrow> 'a set " where + " leastFixedPoint 0 f x = ( x )" +|" leastFixedPoint ((Suc bound')) f x = ( (let fx = (f x) in + if fx \<subseteq> x then x + else leastFixedPoint bound' f (fx \<union> x)))" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_set_extra.thy b/snapshots/isabelle/lib/lem/Lem_set_extra.thy new file mode 100644 index 00000000..33516be7 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_set_extra.thy @@ -0,0 +1,121 @@ +chapter \<open>Generated by Lem from set_extra.lem.\<close> + +theory "Lem_set_extra" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_maybe" + "Lem_function" + "Lem_num" + "Lem_list" + "Lem_sorting" + "Lem_set" + +begin + +(******************************************************************************) +(* A library for sets *) +(* *) +(* It mainly follows the Haskell Set-library *) +(******************************************************************************) + +(* ========================================================================== *) +(* Header *) +(* ========================================================================== *) + +(*open import Bool Basic_classes Maybe Function Num List Sorting Set*) + + +(* ----------------------------*) +(* set choose (be careful !) *) +(* --------------------------- *) + +(*val choose : forall 'a. SetType 'a => set 'a -> 'a*) + +(* ------------------------ *) +(* chooseAndSplit *) +(* ------------------------ *) +(* The idea here is to provide a simple primitive that Lem code can use + * to perform its own custom searches within the set -- likely using a + * search criterion related to the element ordering, but not necessarily). + * For example, sometimes we don't necessarily want to search for a specific + * element, but want to search for elements greater than or less than some other. + * Someties we'd like to use split but don't know a good value to split at. + * This function lets the set implementation decide that value. + * + * The contract of chooseAndSplit is simply to select an element nondeterministically + * and return that element, together with the subsets of elements less than and + * greater than it. In this way, we can recursively traverse the set with any + * search criterion, and we avoid baking in the tree representation (although that + * is the obvious choice). + *) +(*val chooseAndSplit : forall 'a. SetType 'a, Ord 'a => set 'a -> maybe (set 'a * 'a * set 'a)*) +definition chooseAndSplit :: " 'a Ord_class \<Rightarrow> 'a set \<Rightarrow>('a set*'a*'a set)option " where + " chooseAndSplit dict_Basic_classes_Ord_a s = ( + if s = {} then + None + else + (let element = (set_choose s) in + (let (lt, gt) = (Lem_set.split + dict_Basic_classes_Ord_a element s) in + Some (lt, element, gt))))" + + +(* ----------------------------*) +(* universal set *) +(* --------------------------- *) + +(*val universal : forall 'a. SetType 'a => set 'a*) + + +(* ----------------------------*) +(* toList *) +(* --------------------------- *) + +(*val toList : forall 'a. SetType 'a => set 'a -> list 'a*) + + +(* ----------------------------*) +(* toOrderedList *) +(* --------------------------- *) + +(* toOrderedList returns a sorted list. Therefore the result is (given a suitable order) deterministic. + Therefore, it is much preferred to toList. However, it still is only defined for finite sets. So, please + use carefully and consider using set-operations instead of translating sets to lists, performing list manipulations + and then transforming back to sets. *) + +(*val toOrderedListBy : forall 'a. ('a -> 'a -> bool) -> set 'a -> list 'a*) + +(*val toOrderedList : forall 'a. SetType 'a, Ord 'a => set 'a -> list 'a*) + +(* ----------------------- *) +(* compare *) +(* ----------------------- *) + +(*val setCompareBy: forall 'a. ('a -> 'a -> ordering) -> set 'a -> set 'a -> ordering*) +definition setCompareBy :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> ordering " where + " setCompareBy cmp ss ts = ( + (let ss' = (ordered_list_of_set (\<lambda> x y . cmp x y = LT) ss) in + (let ts' = (ordered_list_of_set (\<lambda> x y . cmp x y = LT) ts) in + lexicographicCompareBy cmp ss' ts')))" + + +(*val setCompare : forall 'a. SetType 'a, Ord 'a => set 'a -> set 'a -> ordering*) +definition setCompare :: " 'a Ord_class \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> ordering " where + " setCompare dict_Basic_classes_Ord_a = ( setCompareBy + (compare_method dict_Basic_classes_Ord_a) )" + + +(* ----------------------------*) +(* unbounded fixed point *) +(* --------------------------- *) + +(* Is NOT supported by the coq backend! *) +(*val leastFixedPointUnbounded : forall 'a. SetType 'a => (set 'a -> set 'a) -> set 'a -> set 'a*) +(*let rec leastFixedPointUnbounded f x= + let fx = f x in + if fx subset x then x + else leastFixedPointUnbounded f (fx union x)*) +end diff --git a/snapshots/isabelle/lib/lem/Lem_set_helpers.thy b/snapshots/isabelle/lib/lem/Lem_set_helpers.thy new file mode 100644 index 00000000..1a2f5f50 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_set_helpers.thy @@ -0,0 +1,50 @@ +chapter \<open>Generated by Lem from set_helpers.lem.\<close> + +theory "Lem_set_helpers" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_maybe" + "Lem_function" + "Lem_num" + +begin + +(******************************************************************************) +(* Helper functions for sets *) +(******************************************************************************) + +(* Usually there is a something.lem file containing the main definitions and a + something_extra.lem one containing functions that might cause problems for + some backends or are just seldomly used. + + For sets the situation is different. folding is not well defined, since it + is only sensibly defined for finite sets and the traversal + order is underspecified. *) + +(* ========================================================================== *) +(* Header *) +(* ========================================================================== *) + +(*open import Bool Basic_classes Maybe Function Num*) + +(*open import {coq} `Coq.Lists.List`*) + +(* ------------------------ *) +(* fold *) +(* ------------------------ *) + +(* fold is suspicious, because if given a function, for which + the order, in which the arguments are given, matters, its + results are undefined. On the other hand, it is very handy to + define other - non suspicious functions. + + Moreover, fold is central for OCaml, since it is used to + compile set comprehensions *) + +(*val fold : forall 'a 'b. ('a -> 'b -> 'b) -> set 'a -> 'b -> 'b*) + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_show.thy b/snapshots/isabelle/lib/lem/Lem_show.thy new file mode 100644 index 00000000..fced534d --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_show.thy @@ -0,0 +1,87 @@ +chapter \<open>Generated by Lem from show.lem.\<close> + +theory "Lem_show" + +imports + Main + "Lem_string" + "Lem_maybe" + "Lem_num" + "Lem_basic_classes" + +begin + + + +(*open import String Maybe Num Basic_classes*) + +(*open import {hol} `lemTheory`*) + +record 'a Show_class= + + show_method::" 'a \<Rightarrow> string " + + + +definition instance_Show_Show_string_dict :: "(string)Show_class " where + " instance_Show_Show_string_dict = ((| + + show_method = (\<lambda> s. ([(char_of_nat 34)]) @ (s @ ([(char_of_nat 34)])))|) )" + + +(*val stringFromMaybe : forall 'a. ('a -> string) -> maybe 'a -> string*) +fun stringFromMaybe :: "('a \<Rightarrow> string)\<Rightarrow> 'a option \<Rightarrow> string " where + " stringFromMaybe showX (Some x) = ( (''Just ('') @ (showX x @ ('')'')))" +|" stringFromMaybe showX None = ( (''Nothing''))" + + +definition instance_Show_Show_Maybe_maybe_dict :: " 'a Show_class \<Rightarrow>('a option)Show_class " where + " instance_Show_Show_Maybe_maybe_dict dict_Show_Show_a = ((| + + show_method = (\<lambda> x_opt. stringFromMaybe + (show_method dict_Show_Show_a) x_opt)|) )" + + +(*val stringFromListAux : forall 'a. ('a -> string) -> list 'a -> string*) +function (sequential,domintros) stringFromListAux :: "('a \<Rightarrow> string)\<Rightarrow> 'a list \<Rightarrow> string " where + " stringFromListAux showX ([]) = ( (''''))" +|" stringFromListAux showX (x # xs') = ( + (case xs' of + [] => showX x + | _ => showX x @ ((''; '') @ stringFromListAux showX xs') + ))" +by pat_completeness auto + + +(*val stringFromList : forall 'a. ('a -> string) -> list 'a -> string*) +definition stringFromList :: "('a \<Rightarrow> string)\<Rightarrow> 'a list \<Rightarrow> string " where + " stringFromList showX xs = ( + (''['') @ (stringFromListAux showX xs @ ('']'')))" + + +definition instance_Show_Show_list_dict :: " 'a Show_class \<Rightarrow>('a list)Show_class " where + " instance_Show_Show_list_dict dict_Show_Show_a = ((| + + show_method = (\<lambda> xs. stringFromList + (show_method dict_Show_Show_a) xs)|) )" + + +(*val stringFromPair : forall 'a 'b. ('a -> string) -> ('b -> string) -> ('a * 'b) -> string*) +fun stringFromPair :: "('a \<Rightarrow> string)\<Rightarrow>('b \<Rightarrow> string)\<Rightarrow> 'a*'b \<Rightarrow> string " where + " stringFromPair showX showY (x,y) = ( + (''('') @ (showX x @ (('', '') @ (showY y @ ('')'')))))" + + +definition instance_Show_Show_tup2_dict :: " 'a Show_class \<Rightarrow> 'b Show_class \<Rightarrow>('a*'b)Show_class " where + " instance_Show_Show_tup2_dict dict_Show_Show_a dict_Show_Show_b = ((| + + show_method = (stringFromPair + (show_method dict_Show_Show_a) (show_method dict_Show_Show_b))|) )" + + +definition instance_Show_Show_bool_dict :: "(bool)Show_class " where + " instance_Show_Show_bool_dict = ((| + + show_method = (\<lambda> b. if b then (''true'') else (''false''))|) )" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_show_extra.thy b/snapshots/isabelle/lib/lem/Lem_show_extra.thy new file mode 100644 index 00000000..25ab2570 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_show_extra.thy @@ -0,0 +1,74 @@ +chapter \<open>Generated by Lem from show_extra.lem.\<close> + +theory "Lem_show_extra" + +imports + Main + "Lem_string" + "Lem_maybe" + "Lem_num" + "Lem_basic_classes" + "Lem_set" + "Lem_relation" + "Lem_show" + "Lem_set_extra" + "Lem_string_extra" + +begin + + + +(*open import String Maybe Num Basic_classes Set Relation Show*) +(*import Set_extra String_extra*) + +definition instance_Show_Show_nat_dict :: "(nat)Show_class " where + " instance_Show_Show_nat_dict = ((| + + show_method = Lem_string_extra.stringFromNat |) )" + + +definition instance_Show_Show_Num_natural_dict :: "(nat)Show_class " where + " instance_Show_Show_Num_natural_dict = ((| + + show_method = Lem_string_extra.stringFromNatural |) )" + + +definition instance_Show_Show_Num_int_dict :: "(int)Show_class " where + " instance_Show_Show_Num_int_dict = ((| + + show_method = Lem_string_extra.stringFromInt |) )" + + +definition instance_Show_Show_Num_integer_dict :: "(int)Show_class " where + " instance_Show_Show_Num_integer_dict = ((| + + show_method = Lem_string_extra.stringFromInteger |) )" + + +definition stringFromSet :: "('a \<Rightarrow> string)\<Rightarrow> 'a set \<Rightarrow> string " where + " stringFromSet showX xs = ( + (''{'') @ (Lem_show.stringFromListAux showX (list_of_set xs) @ (''}'')))" + + +(* Abbreviates the representation if the relation is transitive. *) +definition stringFromRelation :: "('a*'a \<Rightarrow> string)\<Rightarrow>('a*'a)set \<Rightarrow> string " where + " stringFromRelation showX rel = ( + if trans rel then + (let pruned_rel = (LemExtraDefs.without_trans_edges rel) in + if ((\<forall> e \<in> rel. (e \<in> pruned_rel))) then + (* The relations are the same (there are no transitive edges), + so we can just as well print the original one. *) + stringFromSet showX rel + else + (''trancl of '') @ stringFromSet showX pruned_rel) + else + stringFromSet showX rel )" + + +definition instance_Show_Show_set_dict :: " 'a Show_class \<Rightarrow>('a set)Show_class " where + " instance_Show_Show_set_dict dict_Show_Show_a = ((| + + show_method = (\<lambda> xs. stringFromSet + (show_method dict_Show_Show_a) xs)|) )" + +end diff --git a/snapshots/isabelle/lib/lem/Lem_sorting.thy b/snapshots/isabelle/lib/lem/Lem_sorting.thy new file mode 100644 index 00000000..d42425a2 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_sorting.thy @@ -0,0 +1,110 @@ +chapter \<open>Generated by Lem from sorting.lem.\<close> + +theory "Lem_sorting" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_maybe" + "Lem_list" + "Lem_num" + "Lem" + "~~/src/HOL/Library/Permutation" + +begin + + + +(*open import Bool Basic_classes Maybe List Num*) + +(*open import {isabelle} `~~/src/HOL/Library/Permutation`*) +(*open import {coq} `Coq.Lists.List`*) +(*open import {hol} `sortingTheory` `permLib`*) +(*open import {isabelle} `$LIB_DIR/Lem`*) + +(* ------------------------- *) +(* permutations *) +(* ------------------------- *) + +(*val isPermutation : forall 'a. Eq 'a => list 'a -> list 'a -> bool*) +(*val isPermutationBy : forall 'a. ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*) + +fun isPermutationBy :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool " where + " isPermutationBy eq ([]) l2 = ( (l2 = []))" +|" isPermutationBy eq (x # xs) l2 = ( ( + (case delete_first (eq x) l2 of + None => False + | Some ys => isPermutationBy eq xs ys + ) + ))" + + + + +(* ------------------------- *) +(* isSorted *) +(* ------------------------- *) + +(* isSortedBy R l + checks, whether the list l is sorted by ordering R. + R should represent an order, i.e. it should be transitive. + Different backends defined isSorted slightly differently. However, + the definitions coincide for transitive R. Therefore there is the + following restriction: + + WARNING: Use isSorted and isSortedBy only with transitive relations! +*) + +(*val isSorted : forall 'a. Ord 'a => list 'a -> bool*) +(*val isSortedBy : forall 'a. ('a -> 'a -> bool) -> list 'a -> bool*) + +(* DPM: rejigged the definition with a nested match to get past Coq's termination checker. *) +(*let rec isSortedBy cmp l= match l with + | [] -> true + | x1 :: xs -> + match xs with + | [] -> true + | x2 :: _ -> (cmp x1 x2 && isSortedBy cmp xs) + end +end*) + + +(* ----------------------- *) +(* insertion sort *) +(* ----------------------- *) + +(*val insert : forall 'a. Ord 'a => 'a -> list 'a -> list 'a*) +(*val insertBy : forall 'a. ('a -> 'a -> bool) -> 'a -> list 'a -> list 'a*) + +(*val insertSort: forall 'a. Ord 'a => list 'a -> list 'a*) +(*val insertSortBy: forall 'a. ('a -> 'a -> bool) -> list 'a -> list 'a*) + +(*let rec insertBy cmp e l= match l with + | [] -> [e] + | x :: xs -> if cmp x e then x :: (insertBy cmp e xs) else (e :: x :: xs) +end*) + +(*let insertSortBy cmp l= List.foldl (fun l e -> insertBy cmp e l) [] l*) + + +(* ----------------------- *) +(* general sorting *) +(* ----------------------- *) + +(*val sort: forall 'a. Ord 'a => list 'a -> list 'a*) +(*val sortBy: forall 'a. ('a -> 'a -> bool) -> list 'a -> list 'a*) +(*val sortByOrd: forall 'a. ('a -> 'a -> ordering) -> list 'a -> list 'a*) + +(*val predicate_of_ord : forall 'a. ('a -> 'a -> ordering) -> 'a -> 'a -> bool*) +definition predicate_of_ord :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool " where + " predicate_of_ord f x y = ( + (case f x y of + LT => True + | EQ => True + | GT => False + ))" + + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_string.thy b/snapshots/isabelle/lib/lem/Lem_string.thy new file mode 100644 index 00000000..9df246c4 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_string.thy @@ -0,0 +1,75 @@ +chapter \<open>Generated by Lem from string.lem.\<close> + +theory "Lem_string" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + "Lem_list" + +begin + + + +(*open import Bool Basic_classes List*) +(*open import {ocaml} `Xstring`*) +(*open import {hol} `lemTheory` `stringTheory`*) +(*open import {coq} `Coq.Strings.Ascii` `Coq.Strings.String`*) + +(* ------------------------------------------- *) +(* translations between strings and char lists *) +(* ------------------------------------------- *) + +(*val toCharList : string -> list char*) + +(*val toString : list char -> string*) + + +(* ----------------------- *) +(* generating strings *) +(* ----------------------- *) + +(*val makeString : nat -> char -> string*) +(*let makeString len c= toString (replicate len c)*) + +(* ----------------------- *) +(* length *) +(* ----------------------- *) + +(*val stringLength : string -> nat*) + +(* ----------------------- *) +(* string concatenation *) +(* ----------------------- *) + +(*val ^ [stringAppend] : string -> string -> string*) + + +(* ----------------------------*) +(* setting up pattern matching *) +(* --------------------------- *) + +(*val string_case : forall 'a. string -> 'a -> (char -> string -> 'a) -> 'a*) + +(*let string_case s c_empty c_cons= + match (toCharList s) with + | [] -> c_empty + | c :: cs -> c_cons c (toString cs) + end*) + +(*val empty_string : string*) + +(*val cons_string : char -> string -> string*) + +(*val concat : string -> list string -> string*) +function (sequential,domintros) concat :: " string \<Rightarrow>(string)list \<Rightarrow> string " where + " concat sep ([]) = ( (''''))" +|" concat sep (s # ss') = ( + (case ss' of + [] => s + | _ => s @ (sep @ concat sep ss') + ))" +by pat_completeness auto + +end diff --git a/snapshots/isabelle/lib/lem/Lem_string_extra.thy b/snapshots/isabelle/lib/lem/Lem_string_extra.thy new file mode 100644 index 00000000..bd8317ba --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_string_extra.thy @@ -0,0 +1,137 @@ +chapter \<open>Generated by Lem from string_extra.lem.\<close> + +theory "Lem_string_extra" + +imports + Main + "Lem_num" + "Lem_list" + "Lem_basic_classes" + "Lem_string" + "Lem_list_extra" + +begin + +(******************************************************************************) +(* String functions *) +(******************************************************************************) + +(*open import Basic_classes*) +(*open import Num*) +(*open import List*) +(*open import String*) +(*open import List_extra*) +(*open import {hol} `stringLib`*) +(*open import {hol} `ASCIInumbersTheory`*) + + +(******************************************************************************) +(* Character's to numbers *) +(******************************************************************************) + +(*val ord : char -> nat*) + +(*val chr : nat -> char*) + +(******************************************************************************) +(* Converting to strings *) +(******************************************************************************) + +(*val stringFromNatHelper : nat -> list char -> list char*) +fun stringFromNatHelper :: " nat \<Rightarrow>(char)list \<Rightarrow>(char)list " where + " stringFromNatHelper n acc1 = ( + if n =( 0 :: nat) then + acc1 + else + stringFromNatHelper (n div( 10 :: nat)) (char_of_nat ((n mod( 10 :: nat)) +( 48 :: nat)) # acc1))" + + +(*val stringFromNat : nat -> string*) +definition stringFromNat :: " nat \<Rightarrow> string " where + " stringFromNat n = ( + if n =( 0 :: nat) then (''0'') else (stringFromNatHelper n []))" + + +(*val stringFromNaturalHelper : natural -> list char -> list char*) +fun stringFromNaturalHelper :: " nat \<Rightarrow>(char)list \<Rightarrow>(char)list " where + " stringFromNaturalHelper n acc1 = ( + if n =( 0 :: nat) then + acc1 + else + stringFromNaturalHelper (n div( 10 :: nat)) (char_of_nat ( ((n mod( 10 :: nat)) +( 48 :: nat))) # acc1))" + + +(*val stringFromNatural : natural -> string*) +definition stringFromNatural :: " nat \<Rightarrow> string " where + " stringFromNatural n = ( + if n =( 0 :: nat) then (''0'') else (stringFromNaturalHelper n []))" + + +(*val stringFromInt : int -> string*) +definition stringFromInt :: " int \<Rightarrow> string " where + " stringFromInt i = ( + if i <( 0 :: int) then + (''-'') @ stringFromNat (nat (abs i)) + else + stringFromNat (nat (abs i)))" + + +(*val stringFromInteger : integer -> string*) +definition stringFromInteger :: " int \<Rightarrow> string " where + " stringFromInteger i = ( + if i <( 0 :: int) then + (''-'') @ stringFromNatural (nat (abs i)) + else + stringFromNatural (nat (abs i)))" + + + +(******************************************************************************) +(* List-like operations *) +(******************************************************************************) + +(*val nth : string -> nat -> char*) +definition nth :: " string \<Rightarrow> nat \<Rightarrow> char " where + " nth s n = ( List.nth ( s) n )" + + +(*val stringConcat : list string -> string*) +definition stringConcat :: "(string)list \<Rightarrow> string " where + " stringConcat s = ( + List.foldr (op@) s (''''))" + + +(******************************************************************************) +(* String comparison *) +(******************************************************************************) + +(*val stringCompare : string -> string -> ordering*) + +definition stringLess :: " string \<Rightarrow> string \<Rightarrow> bool " where + " stringLess x y = ( orderingIsLess (EQ))" + +definition stringLessEq :: " string \<Rightarrow> string \<Rightarrow> bool " where + " stringLessEq x y = ( \<not> (orderingIsGreater (EQ)))" + +definition stringGreater :: " string \<Rightarrow> string \<Rightarrow> bool " where + " stringGreater x y = ( stringLess y x )" + +definition stringGreaterEq :: " string \<Rightarrow> string \<Rightarrow> bool " where + " stringGreaterEq x y = ( stringLessEq y x )" + + +definition instance_Basic_classes_Ord_string_dict :: "(string)Ord_class " where + " instance_Basic_classes_Ord_string_dict = ((| + + compare_method = (\<lambda> x y. EQ), + + isLess_method = stringLess, + + isLessEqual_method = stringLessEq, + + isGreater_method = stringGreater, + + isGreaterEqual_method = stringGreaterEq |) )" + + +end diff --git a/snapshots/isabelle/lib/lem/Lem_tuple.thy b/snapshots/isabelle/lib/lem/Lem_tuple.thy new file mode 100644 index 00000000..66f1a209 --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_tuple.thy @@ -0,0 +1,51 @@ +chapter \<open>Generated by Lem from tuple.lem.\<close> + +theory "Lem_tuple" + +imports + Main + "Lem_bool" + "Lem_basic_classes" + +begin + + + +(*open import Bool Basic_classes*) + +(* ----------------------- *) +(* fst *) +(* ----------------------- *) + +(*val fst : forall 'a 'b. 'a * 'b -> 'a*) +(*let fst (v1, v2)= v1*) + +(* ----------------------- *) +(* snd *) +(* ----------------------- *) + +(*val snd : forall 'a 'b. 'a * 'b -> 'b*) +(*let snd (v1, v2)= v2*) + + +(* ----------------------- *) +(* curry *) +(* ----------------------- *) + +(*val curry : forall 'a 'b 'c. ('a * 'b -> 'c) -> ('a -> 'b -> 'c)*) + +(* ----------------------- *) +(* uncurry *) +(* ----------------------- *) + +(*val uncurry : forall 'a 'b 'c. ('a -> 'b -> 'c) -> ('a * 'b -> 'c)*) + + +(* ----------------------- *) +(* swap *) +(* ----------------------- *) + +(*val swap : forall 'a 'b. ('a * 'b) -> ('b * 'a)*) +(*let swap (v1, v2)= (v2, v1)*) + +end diff --git a/snapshots/isabelle/lib/lem/Lem_word.thy b/snapshots/isabelle/lib/lem/Lem_word.thy new file mode 100644 index 00000000..bc56da3c --- /dev/null +++ b/snapshots/isabelle/lib/lem/Lem_word.thy @@ -0,0 +1,1024 @@ +chapter \<open>Generated by Lem from word.lem.\<close> + +theory "Lem_word" + +imports + Main + "Lem_bool" + "Lem_maybe" + "Lem_num" + "Lem_basic_classes" + "Lem_list" + "~~/src/HOL/Word/Word" + +begin + + + +(*open import Bool Maybe Num Basic_classes List*) + +(*open import {isabelle} `~~/src/HOL/Word/Word`*) +(*open import {hol} `wordsTheory` `wordsLib`*) + + +(* ========================================================================== *) +(* Define general purpose word, i.e. sequences of bits of arbitrary length *) +(* ========================================================================== *) + +datatype bitSequence = BitSeq " + nat option " " (* length of the sequence, Nothing means infinite length *) + bool " " bool (* sign of the word, used to fill up after concrete value is exhausted *) + list " (* the initial part of the sequence, least significant bit first *) + +(*val bitSeqEq : bitSequence -> bitSequence -> bool*) + +(*val boolListFrombitSeq : nat -> bitSequence -> list bool*) + +fun boolListFrombitSeqAux :: " nat \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list " where + " boolListFrombitSeqAux n s bl = ( + if n =( 0 :: nat) then [] else + (case bl of + [] => List.replicate n s + | b # bl' => b # (boolListFrombitSeqAux (n-( 1 :: nat)) s bl') + ))" + + +fun boolListFrombitSeq :: " nat \<Rightarrow> bitSequence \<Rightarrow>(bool)list " where + " boolListFrombitSeq n (BitSeq _ s bl) = ( boolListFrombitSeqAux n s bl )" + + + +(*val bitSeqFromBoolList : list bool -> maybe bitSequence*) +definition bitSeqFromBoolList :: "(bool)list \<Rightarrow>(bitSequence)option " where + " bitSeqFromBoolList bl = ( + (case dest_init bl of + None => None + | Some (bl', s) => Some (BitSeq (Some (List.length bl)) s bl') + ))" + + + +(* cleans up the representation of a bitSequence without changing its semantics *) +(*val cleanBitSeq : bitSequence -> bitSequence*) +fun cleanBitSeq :: " bitSequence \<Rightarrow> bitSequence " where + " cleanBitSeq (BitSeq len s bl) = ( (case len of + None => (BitSeq len s (List.rev (dropWhile ((op \<longleftrightarrow>) s) (List.rev bl)))) + | Some n => (BitSeq len s (List.rev (dropWhile ((op \<longleftrightarrow>) s) (List.rev (List.take (n-( 1 :: nat)) bl))))) +))" + + + +(*val bitSeqTestBit : bitSequence -> nat -> maybe bool*) +fun bitSeqTestBit :: " bitSequence \<Rightarrow> nat \<Rightarrow>(bool)option " where + " bitSeqTestBit (BitSeq None s bl) pos = ( if pos < List.length bl then index bl pos else Some s )" +|" bitSeqTestBit (BitSeq(Some l) s bl) pos = ( if (pos \<ge> l) then None else + if ((pos = (l -( 1 :: nat))) \<or> (pos \<ge> List.length bl)) then Some s else + index bl pos )" + + +(*val bitSeqSetBit : bitSequence -> nat -> bool -> bitSequence*) +fun bitSeqSetBit :: " bitSequence \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> bitSequence " where + " bitSeqSetBit (BitSeq len s bl) pos v = ( + (let bl' = (if (pos < List.length bl) then bl else bl @ List.replicate pos s) in + (let bl'' = (List.list_update bl' pos v) in + (let bs' = (BitSeq len s bl'') in + cleanBitSeq bs'))))" + + + +(*val resizeBitSeq : maybe nat -> bitSequence -> bitSequence*) +definition resizeBitSeq :: "(nat)option \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " resizeBitSeq new_len bs = ( + (case cleanBitSeq bs of + (BitSeq len s bl) => + (let shorten_opt = ((case (new_len, len) of + (None, _) => None + | (Some l1, None) => Some l1 + | (Some l1, Some l2) => + if (l1 < l2) then Some l1 else None + )) in + (case shorten_opt of + None => BitSeq new_len s bl + | Some l1 => ( + (let bl' = (List.take l1 (bl @ [s])) in + (case dest_init bl' of + None => (BitSeq len s bl) (* do nothing if size 0 is requested *) + | Some (bl'', s') => cleanBitSeq (BitSeq new_len s' bl'') + ))) + )) + ) )" + + +(*val bitSeqNot : bitSequence -> bitSequence*) +fun bitSeqNot :: " bitSequence \<Rightarrow> bitSequence " where + " bitSeqNot (BitSeq len s bl) = ( BitSeq len (\<not> s) (List.map (\<lambda> x. \<not> x) bl))" + + +(*val bitSeqBinop : (bool -> bool -> bool) -> bitSequence -> bitSequence -> bitSequence*) + +(*val bitSeqBinopAux : (bool -> bool -> bool) -> bool -> list bool -> bool -> list bool -> list bool*) +fun bitSeqBinopAux :: "(bool \<Rightarrow> bool \<Rightarrow> bool)\<Rightarrow> bool \<Rightarrow>(bool)list \<Rightarrow> bool \<Rightarrow>(bool)list \<Rightarrow>(bool)list " where + " bitSeqBinopAux binop s1 ([]) s2 ([]) = ( [])" +|" bitSeqBinopAux binop s1 (b1 # bl1') s2 ([]) = ( (binop b1 s2) # bitSeqBinopAux binop s1 bl1' s2 [])" +|" bitSeqBinopAux binop s1 ([]) s2 (b2 # bl2') = ( (binop s1 b2) # bitSeqBinopAux binop s1 [] s2 bl2' )" +|" bitSeqBinopAux binop s1 (b1 # bl1') s2 (b2 # bl2') = ( (binop b1 b2) # bitSeqBinopAux binop s1 bl1' s2 bl2' )" + + +definition bitSeqBinop :: "(bool \<Rightarrow> bool \<Rightarrow> bool)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqBinop binop bs1 bs2 = ( ( + (case cleanBitSeq bs1 of + (BitSeq len1 s1 bl1) => + (case cleanBitSeq bs2 of + (BitSeq len2 s2 bl2) => + (let len = ((case (len1, len2) of + (Some l1, Some l2) => Some (max l1 l2) + | _ => None + )) in + (let s = (binop s1 s2) in + (let bl = (bitSeqBinopAux binop s1 bl1 s2 bl2) in + cleanBitSeq (BitSeq len s bl)))) + ) + ) +))" + + +definition bitSeqAnd :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqAnd = ( bitSeqBinop (op \<and>))" + +definition bitSeqOr :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqOr = ( bitSeqBinop (op \<or>))" + +definition bitSeqXor :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqXor = ( bitSeqBinop (\<lambda> b1 b2. \<not> (b1 \<longleftrightarrow> b2)))" + + +(*val bitSeqShiftLeft : bitSequence -> nat -> bitSequence*) +fun bitSeqShiftLeft :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence " where + " bitSeqShiftLeft (BitSeq len s bl) n = ( cleanBitSeq (BitSeq len s (List.replicate n False @ bl)))" + + +(*val bitSeqArithmeticShiftRight : bitSequence -> nat -> bitSequence*) +definition bitSeqArithmeticShiftRight :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence " where + " bitSeqArithmeticShiftRight bs n = ( + (case cleanBitSeq bs of + (BitSeq len s bl) => + cleanBitSeq (BitSeq len s (List.drop n bl)) + ) )" + + +(*val bitSeqLogicalShiftRight : bitSequence -> nat -> bitSequence*) +definition bitSeqLogicalShiftRight :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence " where + " bitSeqLogicalShiftRight bs n = ( + if (n =( 0 :: nat)) then cleanBitSeq bs else + (case cleanBitSeq bs of + (BitSeq len s bl) => + (case len of + None => cleanBitSeq (BitSeq len s (List.drop n bl)) + | Some l => cleanBitSeq + (BitSeq len False ((List.drop n bl) @ List.replicate l s)) + ) + ) )" + + + +(* integerFromBoolList sign bl creates an integer from a list of bits + (least significant bit first) and an explicitly given sign bit. + It uses two's complement encoding. *) +(*val integerFromBoolList : (bool * list bool) -> integer*) + +fun integerFromBoolListAux :: " int \<Rightarrow>(bool)list \<Rightarrow> int " where + " integerFromBoolListAux (acc1 :: int) (([]) :: bool list) = ( acc1 )" +|" integerFromBoolListAux (acc1 :: int) ((True # bl') :: bool list) = ( integerFromBoolListAux ((acc1 *( 2 :: int)) +( 1 :: int)) bl' )" +|" integerFromBoolListAux (acc1 :: int) ((False # bl') :: bool list) = ( integerFromBoolListAux (acc1 *( 2 :: int)) bl' )" + + +fun integerFromBoolList :: " bool*(bool)list \<Rightarrow> int " where + " integerFromBoolList (sign, bl) = ( + if sign then + - (integerFromBoolListAux(( 0 :: int)) (List.rev (List.map (\<lambda> x. \<not> x) bl)) +( 1 :: int)) + else integerFromBoolListAux(( 0 :: int)) (List.rev bl))" + + +(* [boolListFromInteger i] creates a sign bit and a list of booleans from an integer. The len_opt tells it when to stop.*) +(*val boolListFromInteger : integer -> bool * list bool*) + +fun boolListFromNatural :: "(bool)list \<Rightarrow> nat \<Rightarrow>(bool)list " where + " boolListFromNatural acc1 (remainder :: nat) = ( + if (remainder >( 0 :: nat)) then + (boolListFromNatural (((remainder mod( 2 :: nat)) =( 1 :: nat)) # acc1) + (remainder div( 2 :: nat))) + else + List.rev acc1 )" + + +definition boolListFromInteger :: " int \<Rightarrow> bool*(bool)list " where + " boolListFromInteger (i :: int) = ( + if (i <( 0 :: int)) then + (True, List.map (\<lambda> x. \<not> x) (boolListFromNatural [] (nat (abs (- (i +( 1 :: int))))))) + else + (False, boolListFromNatural [] (nat (abs i))))" + + + +(* [bitSeqFromInteger len_opt i] encodes [i] as a bitsequence with [len_opt] bits. If there are not enough + bits, truncation happens *) +(*val bitSeqFromInteger : maybe nat -> integer -> bitSequence*) +definition bitSeqFromInteger :: "(nat)option \<Rightarrow> int \<Rightarrow> bitSequence " where + " bitSeqFromInteger len_opt i = ( + (let (s, bl) = (boolListFromInteger i) in + resizeBitSeq len_opt (BitSeq None s bl)))" + + + +(*val integerFromBitSeq : bitSequence -> integer*) +definition integerFromBitSeq :: " bitSequence \<Rightarrow> int " where + " integerFromBitSeq bs = ( + (case cleanBitSeq bs of (BitSeq len s bl) => integerFromBoolList (s, bl) ) )" + + + +(* Now we can via translation to integers map arithmetic operations to bitSequences *) + +(*val bitSeqArithUnaryOp : (integer -> integer) -> bitSequence -> bitSequence*) +definition bitSeqArithUnaryOp :: "(int \<Rightarrow> int)\<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqArithUnaryOp uop bs = ( + (case bs of + (BitSeq len _ _) => + bitSeqFromInteger len (uop (integerFromBitSeq bs)) + ) )" + + +(*val bitSeqArithBinOp : (integer -> integer -> integer) -> bitSequence -> bitSequence -> bitSequence*) +definition bitSeqArithBinOp :: "(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqArithBinOp binop bs1 bs2 = ( + (case bs1 of + (BitSeq len1 _ _) => + (case bs2 of + (BitSeq len2 _ _) => + (let len = ((case (len1, len2) of + (Some l1, Some l2) => Some (max l1 l2) + | _ => None + )) in + bitSeqFromInteger len + (binop (integerFromBitSeq bs1) (integerFromBitSeq bs2))) + ) + ) )" + + +(*val bitSeqArithBinTest : forall 'a. (integer -> integer -> 'a) -> bitSequence -> bitSequence -> 'a*) +definition bitSeqArithBinTest :: "(int \<Rightarrow> int \<Rightarrow> 'a)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> 'a " where + " bitSeqArithBinTest binop bs1 bs2 = ( binop (integerFromBitSeq bs1) (integerFromBitSeq bs2))" + + + +(* now instantiate the number interface for bit-sequences *) + +(*val bitSeqFromNumeral : numeral -> bitSequence*) + +(*val bitSeqLess : bitSequence -> bitSequence -> bool*) +definition bitSeqLess :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool " where + " bitSeqLess bs1 bs2 = ( bitSeqArithBinTest (op<) bs1 bs2 )" + + +(*val bitSeqLessEqual : bitSequence -> bitSequence -> bool*) +definition bitSeqLessEqual :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool " where + " bitSeqLessEqual bs1 bs2 = ( bitSeqArithBinTest (op \<le>) bs1 bs2 )" + + +(*val bitSeqGreater : bitSequence -> bitSequence -> bool*) +definition bitSeqGreater :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool " where + " bitSeqGreater bs1 bs2 = ( bitSeqArithBinTest (op>) bs1 bs2 )" + + +(*val bitSeqGreaterEqual : bitSequence -> bitSequence -> bool*) +definition bitSeqGreaterEqual :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool " where + " bitSeqGreaterEqual bs1 bs2 = ( bitSeqArithBinTest (op \<ge>) bs1 bs2 )" + + +(*val bitSeqCompare : bitSequence -> bitSequence -> ordering*) +definition bitSeqCompare :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> ordering " where + " bitSeqCompare bs1 bs2 = ( bitSeqArithBinTest (genericCompare (op<) (op=)) bs1 bs2 )" + + +definition instance_Basic_classes_Ord_Word_bitSequence_dict :: "(bitSequence)Ord_class " where + " instance_Basic_classes_Ord_Word_bitSequence_dict = ((| + + compare_method = bitSeqCompare, + + isLess_method = bitSeqLess, + + isLessEqual_method = bitSeqLessEqual, + + isGreater_method = bitSeqGreater, + + isGreaterEqual_method = bitSeqGreaterEqual |) )" + + +(* arithmetic negation, don't mix up with bitwise negation *) +(*val bitSeqNegate : bitSequence -> bitSequence*) +definition bitSeqNegate :: " bitSequence \<Rightarrow> bitSequence " where + " bitSeqNegate bs = ( bitSeqArithUnaryOp (\<lambda> i. - i) bs )" + + +definition instance_Num_NumNegate_Word_bitSequence_dict :: "(bitSequence)NumNegate_class " where + " instance_Num_NumNegate_Word_bitSequence_dict = ((| + + numNegate_method = bitSeqNegate |) )" + + + +(*val bitSeqAdd : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqAdd :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqAdd bs1 bs2 = ( bitSeqArithBinOp (op+) bs1 bs2 )" + + +definition instance_Num_NumAdd_Word_bitSequence_dict :: "(bitSequence)NumAdd_class " where + " instance_Num_NumAdd_Word_bitSequence_dict = ((| + + numAdd_method = bitSeqAdd |) )" + + +(*val bitSeqMinus : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqMinus :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqMinus bs1 bs2 = ( bitSeqArithBinOp (op-) bs1 bs2 )" + + +definition instance_Num_NumMinus_Word_bitSequence_dict :: "(bitSequence)NumMinus_class " where + " instance_Num_NumMinus_Word_bitSequence_dict = ((| + + numMinus_method = bitSeqMinus |) )" + + +(*val bitSeqSucc : bitSequence -> bitSequence*) +definition bitSeqSucc :: " bitSequence \<Rightarrow> bitSequence " where + " bitSeqSucc bs = ( bitSeqArithUnaryOp (\<lambda> n. n +( 1 :: int)) bs )" + + +definition instance_Num_NumSucc_Word_bitSequence_dict :: "(bitSequence)NumSucc_class " where + " instance_Num_NumSucc_Word_bitSequence_dict = ((| + + succ_method = bitSeqSucc |) )" + + +(*val bitSeqPred : bitSequence -> bitSequence*) +definition bitSeqPred :: " bitSequence \<Rightarrow> bitSequence " where + " bitSeqPred bs = ( bitSeqArithUnaryOp (\<lambda> n. n -( 1 :: int)) bs )" + + +definition instance_Num_NumPred_Word_bitSequence_dict :: "(bitSequence)NumPred_class " where + " instance_Num_NumPred_Word_bitSequence_dict = ((| + + pred_method = bitSeqPred |) )" + + +(*val bitSeqMult : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqMult :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqMult bs1 bs2 = ( bitSeqArithBinOp (op*) bs1 bs2 )" + + +definition instance_Num_NumMult_Word_bitSequence_dict :: "(bitSequence)NumMult_class " where + " instance_Num_NumMult_Word_bitSequence_dict = ((| + + numMult_method = bitSeqMult |) )" + + + +(*val bitSeqPow : bitSequence -> nat -> bitSequence*) +definition bitSeqPow :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence " where + " bitSeqPow bs n = ( bitSeqArithUnaryOp (\<lambda> i . i ^ n) bs )" + + +definition instance_Num_NumPow_Word_bitSequence_dict :: "(bitSequence)NumPow_class " where + " instance_Num_NumPow_Word_bitSequence_dict = ((| + + numPow_method = bitSeqPow |) )" + + +(*val bitSeqDiv : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqDiv :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqDiv bs1 bs2 = ( bitSeqArithBinOp (op div) bs1 bs2 )" + + +definition instance_Num_NumIntegerDivision_Word_bitSequence_dict :: "(bitSequence)NumIntegerDivision_class " where + " instance_Num_NumIntegerDivision_Word_bitSequence_dict = ((| + + div_method = bitSeqDiv |) )" + + +definition instance_Num_NumDivision_Word_bitSequence_dict :: "(bitSequence)NumDivision_class " where + " instance_Num_NumDivision_Word_bitSequence_dict = ((| + + numDivision_method = bitSeqDiv |) )" + + +(*val bitSeqMod : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqMod :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqMod bs1 bs2 = ( bitSeqArithBinOp (op mod) bs1 bs2 )" + + +definition instance_Num_NumRemainder_Word_bitSequence_dict :: "(bitSequence)NumRemainder_class " where + " instance_Num_NumRemainder_Word_bitSequence_dict = ((| + + mod_method = bitSeqMod |) )" + + +(*val bitSeqMin : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqMin :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqMin bs1 bs2 = ( bitSeqArithBinOp min bs1 bs2 )" + + +(*val bitSeqMax : bitSequence -> bitSequence -> bitSequence*) +definition bitSeqMax :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence " where + " bitSeqMax bs1 bs2 = ( bitSeqArithBinOp max bs1 bs2 )" + + +definition instance_Basic_classes_OrdMaxMin_Word_bitSequence_dict :: "(bitSequence)OrdMaxMin_class " where + " instance_Basic_classes_OrdMaxMin_Word_bitSequence_dict = ((| + + max_method = bitSeqMax, + + min_method = bitSeqMin |) )" + + + + + +(* ========================================================================== *) +(* Interface for bitoperations *) +(* ========================================================================== *) + +record 'a WordNot_class= + + lnot_method ::" 'a \<Rightarrow> 'a " + + + +record 'a WordAnd_class= + + land_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a WordOr_class= + + lor_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + + +record 'a WordXor_class= + + lxor_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a " + + + +record 'a WordLsl_class= + + lsl_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a " + + + +record 'a WordLsr_class= + + lsr_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a " + + + +record 'a WordAsr_class= + + asr_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a " + + + +(* ----------------------- *) +(* bitSequence *) +(* ----------------------- *) + +definition instance_Word_WordNot_Word_bitSequence_dict :: "(bitSequence)WordNot_class " where + " instance_Word_WordNot_Word_bitSequence_dict = ((| + + lnot_method = bitSeqNot |) )" + + +definition instance_Word_WordAnd_Word_bitSequence_dict :: "(bitSequence)WordAnd_class " where + " instance_Word_WordAnd_Word_bitSequence_dict = ((| + + land_method = bitSeqAnd |) )" + + +definition instance_Word_WordOr_Word_bitSequence_dict :: "(bitSequence)WordOr_class " where + " instance_Word_WordOr_Word_bitSequence_dict = ((| + + lor_method = bitSeqOr |) )" + + +definition instance_Word_WordXor_Word_bitSequence_dict :: "(bitSequence)WordXor_class " where + " instance_Word_WordXor_Word_bitSequence_dict = ((| + + lxor_method = bitSeqXor |) )" + + +definition instance_Word_WordLsl_Word_bitSequence_dict :: "(bitSequence)WordLsl_class " where + " instance_Word_WordLsl_Word_bitSequence_dict = ((| + + lsl_method = bitSeqShiftLeft |) )" + + +definition instance_Word_WordLsr_Word_bitSequence_dict :: "(bitSequence)WordLsr_class " where + " instance_Word_WordLsr_Word_bitSequence_dict = ((| + + lsr_method = bitSeqLogicalShiftRight |) )" + + +definition instance_Word_WordAsr_Word_bitSequence_dict :: "(bitSequence)WordAsr_class " where + " instance_Word_WordAsr_Word_bitSequence_dict = ((| + + asr_method = bitSeqArithmeticShiftRight |) )" + + + +(* ----------------------- *) +(* int32 *) +(* ----------------------- *) + +(*val int32Lnot : int32 -> int32*) (* XXX: fix *) + +definition instance_Word_WordNot_Num_int32_dict :: "( 32 word)WordNot_class " where + " instance_Word_WordNot_Num_int32_dict = ((| + + lnot_method = (\<lambda> w. (NOT w))|) )" + + + +(*val int32Lor : int32 -> int32 -> int32*) (* XXX: fix *) + +definition instance_Word_WordOr_Num_int32_dict :: "( 32 word)WordOr_class " where + " instance_Word_WordOr_Num_int32_dict = ((| + + lor_method = (op OR)|) )" + + +(*val int32Lxor : int32 -> int32 -> int32*) (* XXX: fix *) + +definition instance_Word_WordXor_Num_int32_dict :: "( 32 word)WordXor_class " where + " instance_Word_WordXor_Num_int32_dict = ((| + + lxor_method = (op XOR)|) )" + + +(*val int32Land : int32 -> int32 -> int32*) (* XXX: fix *) + +definition instance_Word_WordAnd_Num_int32_dict :: "( 32 word)WordAnd_class " where + " instance_Word_WordAnd_Num_int32_dict = ((| + + land_method = (op AND)|) )" + + +(*val int32Lsl : int32 -> nat -> int32*) (* XXX: fix *) + +definition instance_Word_WordLsl_Num_int32_dict :: "( 32 word)WordLsl_class " where + " instance_Word_WordLsl_Num_int32_dict = ((| + + lsl_method = (op<<)|) )" + + +(*val int32Lsr : int32 -> nat -> int32*) (* XXX: fix *) + +definition instance_Word_WordLsr_Num_int32_dict :: "( 32 word)WordLsr_class " where + " instance_Word_WordLsr_Num_int32_dict = ((| + + lsr_method = (op>>)|) )" + + + +(*val int32Asr : int32 -> nat -> int32*) (* XXX: fix *) + +definition instance_Word_WordAsr_Num_int32_dict :: "( 32 word)WordAsr_class " where + " instance_Word_WordAsr_Num_int32_dict = ((| + + asr_method = (op>>>)|) )" + + + +(* ----------------------- *) +(* int64 *) +(* ----------------------- *) + +(*val int64Lnot : int64 -> int64*) (* XXX: fix *) + +definition instance_Word_WordNot_Num_int64_dict :: "( 64 word)WordNot_class " where + " instance_Word_WordNot_Num_int64_dict = ((| + + lnot_method = (\<lambda> w. (NOT w))|) )" + + +(*val int64Lor : int64 -> int64 -> int64*) (* XXX: fix *) + +definition instance_Word_WordOr_Num_int64_dict :: "( 64 word)WordOr_class " where + " instance_Word_WordOr_Num_int64_dict = ((| + + lor_method = (op OR)|) )" + + +(*val int64Lxor : int64 -> int64 -> int64*) (* XXX: fix *) + +definition instance_Word_WordXor_Num_int64_dict :: "( 64 word)WordXor_class " where + " instance_Word_WordXor_Num_int64_dict = ((| + + lxor_method = (op XOR)|) )" + + +(*val int64Land : int64 -> int64 -> int64*) (* XXX: fix *) + +definition instance_Word_WordAnd_Num_int64_dict :: "( 64 word)WordAnd_class " where + " instance_Word_WordAnd_Num_int64_dict = ((| + + land_method = (op AND)|) )" + + +(*val int64Lsl : int64 -> nat -> int64*) (* XXX: fix *) + +definition instance_Word_WordLsl_Num_int64_dict :: "( 64 word)WordLsl_class " where + " instance_Word_WordLsl_Num_int64_dict = ((| + + lsl_method = (op<<)|) )" + + +(*val int64Lsr : int64 -> nat -> int64*) (* XXX: fix *) + +definition instance_Word_WordLsr_Num_int64_dict :: "( 64 word)WordLsr_class " where + " instance_Word_WordLsr_Num_int64_dict = ((| + + lsr_method = (op>>)|) )" + + +(*val int64Asr : int64 -> nat -> int64*) (* XXX: fix *) + +definition instance_Word_WordAsr_Num_int64_dict :: "( 64 word)WordAsr_class " where + " instance_Word_WordAsr_Num_int64_dict = ((| + + asr_method = (op>>>)|) )" + + + +(* ----------------------- *) +(* Words via bit sequences *) +(* ----------------------- *) + +(*val defaultLnot : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a*) +definition defaultLnot :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a " where + " defaultLnot fromBitSeq toBitSeq x = ( fromBitSeq (bitSeqNegate (toBitSeq x)))" + + +(*val defaultLand : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a*) +definition defaultLand :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a " where + " defaultLand fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqAnd (toBitSeq x1) (toBitSeq x2)))" + + +(*val defaultLor : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a*) +definition defaultLor :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a " where + " defaultLor fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqOr (toBitSeq x1) (toBitSeq x2)))" + + +(*val defaultLxor : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a*) +definition defaultLxor :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a " where + " defaultLxor fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqXor (toBitSeq x1) (toBitSeq x2)))" + + +(*val defaultLsl : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a*) +definition defaultLsl :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a " where + " defaultLsl fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqShiftLeft (toBitSeq x) n))" + + +(*val defaultLsr : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a*) +definition defaultLsr :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a " where + " defaultLsr fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqLogicalShiftRight (toBitSeq x) n))" + + +(*val defaultAsr : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a*) +definition defaultAsr :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a " where + " defaultAsr fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqArithmeticShiftRight (toBitSeq x) n))" + + +(* ----------------------- *) +(* integer *) +(* ----------------------- *) + +(*val integerLnot : integer -> integer*) +definition integerLnot :: " int \<Rightarrow> int " where + " integerLnot i = ( - (i +( 1 :: int)))" + + +definition instance_Word_WordNot_Num_integer_dict :: "(int)WordNot_class " where + " instance_Word_WordNot_Num_integer_dict = ((| + + lnot_method = integerLnot |) )" + + + +(*val integerLor : integer -> integer -> integer*) +definition integerLor :: " int \<Rightarrow> int \<Rightarrow> int " where + " integerLor i1 i2 = ( defaultLor integerFromBitSeq (bitSeqFromInteger None) i1 i2 )" + + +definition instance_Word_WordOr_Num_integer_dict :: "(int)WordOr_class " where + " instance_Word_WordOr_Num_integer_dict = ((| + + lor_method = integerLor |) )" + + +(*val integerLxor : integer -> integer -> integer*) +definition integerLxor :: " int \<Rightarrow> int \<Rightarrow> int " where + " integerLxor i1 i2 = ( defaultLxor integerFromBitSeq (bitSeqFromInteger None) i1 i2 )" + + +definition instance_Word_WordXor_Num_integer_dict :: "(int)WordXor_class " where + " instance_Word_WordXor_Num_integer_dict = ((| + + lxor_method = integerLxor |) )" + + +(*val integerLand : integer -> integer -> integer*) +definition integerLand :: " int \<Rightarrow> int \<Rightarrow> int " where + " integerLand i1 i2 = ( defaultLand integerFromBitSeq (bitSeqFromInteger None) i1 i2 )" + + +definition instance_Word_WordAnd_Num_integer_dict :: "(int)WordAnd_class " where + " instance_Word_WordAnd_Num_integer_dict = ((| + + land_method = integerLand |) )" + + +(*val integerLsl : integer -> nat -> integer*) +definition integerLsl :: " int \<Rightarrow> nat \<Rightarrow> int " where + " integerLsl i n = ( defaultLsl integerFromBitSeq (bitSeqFromInteger None) i n )" + + +definition instance_Word_WordLsl_Num_integer_dict :: "(int)WordLsl_class " where + " instance_Word_WordLsl_Num_integer_dict = ((| + + lsl_method = integerLsl |) )" + + +(*val integerAsr : integer -> nat -> integer*) +definition integerAsr :: " int \<Rightarrow> nat \<Rightarrow> int " where + " integerAsr i n = ( defaultAsr integerFromBitSeq (bitSeqFromInteger None) i n )" + + +definition instance_Word_WordLsr_Num_integer_dict :: "(int)WordLsr_class " where + " instance_Word_WordLsr_Num_integer_dict = ((| + + lsr_method = integerAsr |) )" + + +definition instance_Word_WordAsr_Num_integer_dict :: "(int)WordAsr_class " where + " instance_Word_WordAsr_Num_integer_dict = ((| + + asr_method = integerAsr |) )" + + + +(* ----------------------- *) +(* int *) +(* ----------------------- *) + +(* sometimes it is convenient to be able to perform bit-operations on ints. + However, since int is not well-defined (it has different size on different systems), + it should be used very carefully and only for operations that don't depend on the + bitwidth of int *) + +(*val intFromBitSeq : bitSequence -> int*) +definition intFromBitSeq :: " bitSequence \<Rightarrow> int " where + " intFromBitSeq bs = ( (integerFromBitSeq (resizeBitSeq (Some(( 31 :: nat))) bs)))" + + + +(*val bitSeqFromInt : int -> bitSequence*) +definition bitSeqFromInt :: " int \<Rightarrow> bitSequence " where + " bitSeqFromInt i = ( bitSeqFromInteger (Some(( 31 :: nat))) ( i))" + + + +(*val intLnot : int -> int*) +definition intLnot :: " int \<Rightarrow> int " where + " intLnot i = ( - (i +( 1 :: int)))" + + +definition instance_Word_WordNot_Num_int_dict :: "(int)WordNot_class " where + " instance_Word_WordNot_Num_int_dict = ((| + + lnot_method = intLnot |) )" + + +(*val intLor : int -> int -> int*) +definition intLor :: " int \<Rightarrow> int \<Rightarrow> int " where + " intLor i1 i2 = ( defaultLor intFromBitSeq bitSeqFromInt i1 i2 )" + + +definition instance_Word_WordOr_Num_int_dict :: "(int)WordOr_class " where + " instance_Word_WordOr_Num_int_dict = ((| + + lor_method = intLor |) )" + + +(*val intLxor : int -> int -> int*) +definition intLxor :: " int \<Rightarrow> int \<Rightarrow> int " where + " intLxor i1 i2 = ( defaultLxor intFromBitSeq bitSeqFromInt i1 i2 )" + + +definition instance_Word_WordXor_Num_int_dict :: "(int)WordXor_class " where + " instance_Word_WordXor_Num_int_dict = ((| + + lxor_method = intLxor |) )" + + +(*val intLand : int -> int -> int*) +definition intLand :: " int \<Rightarrow> int \<Rightarrow> int " where + " intLand i1 i2 = ( defaultLand intFromBitSeq bitSeqFromInt i1 i2 )" + + +definition instance_Word_WordAnd_Num_int_dict :: "(int)WordAnd_class " where + " instance_Word_WordAnd_Num_int_dict = ((| + + land_method = intLand |) )" + + +(*val intLsl : int -> nat -> int*) +definition intLsl :: " int \<Rightarrow> nat \<Rightarrow> int " where + " intLsl i n = ( defaultLsl intFromBitSeq bitSeqFromInt i n )" + + +definition instance_Word_WordLsl_Num_int_dict :: "(int)WordLsl_class " where + " instance_Word_WordLsl_Num_int_dict = ((| + + lsl_method = intLsl |) )" + + +(*val intAsr : int -> nat -> int*) +definition intAsr :: " int \<Rightarrow> nat \<Rightarrow> int " where + " intAsr i n = ( defaultAsr intFromBitSeq bitSeqFromInt i n )" + + +definition instance_Word_WordAsr_Num_int_dict :: "(int)WordAsr_class " where + " instance_Word_WordAsr_Num_int_dict = ((| + + asr_method = intAsr |) )" + + + + +(* ----------------------- *) +(* natural *) +(* ----------------------- *) + +(* some operations work also on positive numbers *) + +(*val naturalFromBitSeq : bitSequence -> natural*) +definition naturalFromBitSeq :: " bitSequence \<Rightarrow> nat " where + " naturalFromBitSeq bs = ( nat (abs (integerFromBitSeq bs)))" + + +(*val bitSeqFromNatural : maybe nat -> natural -> bitSequence*) +definition bitSeqFromNatural :: "(nat)option \<Rightarrow> nat \<Rightarrow> bitSequence " where + " bitSeqFromNatural len n = ( bitSeqFromInteger len (int n))" + + +(*val naturalLor : natural -> natural -> natural*) +definition naturalLor :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " naturalLor i1 i2 = ( defaultLor naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )" + + +definition instance_Word_WordOr_Num_natural_dict :: "(nat)WordOr_class " where + " instance_Word_WordOr_Num_natural_dict = ((| + + lor_method = naturalLor |) )" + + +(*val naturalLxor : natural -> natural -> natural*) +definition naturalLxor :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " naturalLxor i1 i2 = ( defaultLxor naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )" + + +definition instance_Word_WordXor_Num_natural_dict :: "(nat)WordXor_class " where + " instance_Word_WordXor_Num_natural_dict = ((| + + lxor_method = naturalLxor |) )" + + +(*val naturalLand : natural -> natural -> natural*) +definition naturalLand :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " naturalLand i1 i2 = ( defaultLand naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )" + + +definition instance_Word_WordAnd_Num_natural_dict :: "(nat)WordAnd_class " where + " instance_Word_WordAnd_Num_natural_dict = ((| + + land_method = naturalLand |) )" + + +(*val naturalLsl : natural -> nat -> natural*) +definition naturalLsl :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " naturalLsl i n = ( defaultLsl naturalFromBitSeq (bitSeqFromNatural None) i n )" + + +definition instance_Word_WordLsl_Num_natural_dict :: "(nat)WordLsl_class " where + " instance_Word_WordLsl_Num_natural_dict = ((| + + lsl_method = naturalLsl |) )" + + +(*val naturalAsr : natural -> nat -> natural*) +definition naturalAsr :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " naturalAsr i n = ( defaultAsr naturalFromBitSeq (bitSeqFromNatural None) i n )" + + +definition instance_Word_WordLsr_Num_natural_dict :: "(nat)WordLsr_class " where + " instance_Word_WordLsr_Num_natural_dict = ((| + + lsr_method = naturalAsr |) )" + + +definition instance_Word_WordAsr_Num_natural_dict :: "(nat)WordAsr_class " where + " instance_Word_WordAsr_Num_natural_dict = ((| + + asr_method = naturalAsr |) )" + + + +(* ----------------------- *) +(* nat *) +(* ----------------------- *) + +(* sometimes it is convenient to be able to perform bit-operations on nats. + However, since nat is not well-defined (it has different size on different systems), + it should be used very carefully and only for operations that don't depend on the + bitwidth of nat *) + +(*val natFromBitSeq : bitSequence -> nat*) +definition natFromBitSeq :: " bitSequence \<Rightarrow> nat " where + " natFromBitSeq bs = ( (naturalFromBitSeq (resizeBitSeq (Some(( 31 :: nat))) bs)))" + + + +(*val bitSeqFromNat : nat -> bitSequence*) +definition bitSeqFromNat :: " nat \<Rightarrow> bitSequence " where + " bitSeqFromNat i = ( bitSeqFromNatural (Some(( 31 :: nat))) ( i))" + + + +(*val natLor : nat -> nat -> nat*) +definition natLor :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " natLor i1 i2 = ( defaultLor natFromBitSeq bitSeqFromNat i1 i2 )" + + +definition instance_Word_WordOr_nat_dict :: "(nat)WordOr_class " where + " instance_Word_WordOr_nat_dict = ((| + + lor_method = natLor |) )" + + +(*val natLxor : nat -> nat -> nat*) +definition natLxor :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " natLxor i1 i2 = ( defaultLxor natFromBitSeq bitSeqFromNat i1 i2 )" + + +definition instance_Word_WordXor_nat_dict :: "(nat)WordXor_class " where + " instance_Word_WordXor_nat_dict = ((| + + lxor_method = natLxor |) )" + + +(*val natLand : nat -> nat -> nat*) +definition natLand :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " natLand i1 i2 = ( defaultLand natFromBitSeq bitSeqFromNat i1 i2 )" + + +definition instance_Word_WordAnd_nat_dict :: "(nat)WordAnd_class " where + " instance_Word_WordAnd_nat_dict = ((| + + land_method = natLand |) )" + + +(*val natLsl : nat -> nat -> nat*) +definition natLsl :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " natLsl i n = ( defaultLsl natFromBitSeq bitSeqFromNat i n )" + + +definition instance_Word_WordLsl_nat_dict :: "(nat)WordLsl_class " where + " instance_Word_WordLsl_nat_dict = ((| + + lsl_method = natLsl |) )" + + +(*val natAsr : nat -> nat -> nat*) +definition natAsr :: " nat \<Rightarrow> nat \<Rightarrow> nat " where + " natAsr i n = ( defaultAsr natFromBitSeq bitSeqFromNat i n )" + + +definition instance_Word_WordAsr_nat_dict :: "(nat)WordAsr_class " where + " instance_Word_WordAsr_nat_dict = ((| + + asr_method = natAsr |) )" + + +end diff --git a/snapshots/isabelle/lib/lem/ROOT b/snapshots/isabelle/lib/lem/ROOT new file mode 100644 index 00000000..443687f9 --- /dev/null +++ b/snapshots/isabelle/lib/lem/ROOT @@ -0,0 +1,7 @@ +session LEM = "HOL-Word" + + description {* + HOL + LEM specific theories + *} + theories Lem_pervasives Lem_pervasives_extra + + |