Merge branch 'sail2' into mappings

48 files changed, 13914 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
+
+
diff --git a/snapshots/isabelle/lib/sail/Hoare.thy b/snapshots/isabelle/lib/sail/Hoare.thy
new file mode 100644
index 00000000..ee7a5fa6
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Hoare.thy
@@ -0,0 +1,320 @@
+theory Hoare
+  imports
+    State_lemmas
+    "HOL-Eisbach.Eisbach_Tools"
+begin
+
+(*adhoc_overloading
+  Monad_Syntax.bind State_monad.bindS*)
+
+section \<open>Hoare logic for the state, exception and nondeterminism monad\<close>
+
+subsection \<open>Hoare triples\<close>
+
+type_synonym 'regs predS = "'regs sequential_state \<Rightarrow> bool"
+
+definition PrePost :: "'regs predS \<Rightarrow> ('regs, 'a, 'e) monadS \<Rightarrow> (('a, 'e) result \<Rightarrow> 'regs predS) \<Rightarrow> bool"
+  where "PrePost P f Q \<equiv> (\<forall>s. P s \<longrightarrow> (\<forall>(r, s') \<in> f s. Q r s'))"
+
+lemma PrePostI:
+  assumes "\<And>s r s'. P s \<Longrightarrow> (r, s') \<in> f s \<Longrightarrow> Q r s'"
+  shows "PrePost P f Q"
+  using assms unfolding PrePost_def by auto
+
+lemma PrePost_elim:
+  assumes "PrePost P f Q" and "P s" and "(r, s') \<in> f s"
+  obtains "Q r s'"
+  using assms by (fastforce simp: PrePost_def)
+
+lemma PrePost_consequence:
+  assumes "PrePost A f B"
+    and "\<And>s. P s \<Longrightarrow> A s" and "\<And>v s. B v s \<Longrightarrow> Q v s"
+  shows "PrePost P f Q"
+  using assms unfolding PrePost_def by (blast intro: list.pred_mono_strong)
+
+lemma PrePost_strengthen_pre:
+  assumes "PrePost A f C" and  "\<And>s. B s \<Longrightarrow> A s"
+  shows "PrePost B f C"
+  using assms by (rule PrePost_consequence)
+
+lemma PrePost_weaken_post:
+  assumes "PrePost A f B" and  "\<And>v s. B v s \<Longrightarrow> C v s"
+  shows "PrePost A f C"
+  using assms by (blast intro: PrePost_consequence)
+
+named_theorems PrePost_intro
+
+lemma PrePost_True_post[PrePost_intro, intro, simp]:
+  "PrePost P m (\<lambda>_ _. True)"
+  unfolding PrePost_def by auto
+
+lemma PrePost_any: "PrePost (\<lambda>s. \<forall>(r, s') \<in> m s. Q r s') m Q"
+  unfolding PrePost_def by auto
+
+lemma PrePost_returnS[intro, PrePost_intro]: "PrePost (P (Value x)) (returnS x) P"
+  unfolding PrePost_def returnS_def by auto
+
+lemma PrePost_bindS[intro, PrePost_intro]:
+  assumes f: "\<And>s a s'. (Value a, s') \<in> m s \<Longrightarrow> PrePost (R a) (f a) Q"
+    and m: "PrePost P m (\<lambda>r. case r of Value a \<Rightarrow> R a | Ex e \<Rightarrow> Q (Ex e))"
+  shows "PrePost P (bindS m f) Q"
+proof (intro PrePostI)
+  fix s r s'
+  assume P: "P s" and bind: "(r, s') \<in> bindS m f s"
+  from bind show "Q r s'"
+  proof (cases r s' m f s rule: bindS_cases)
+    case (Value a a' s'')
+    then have "R a' s''" using P m by (auto elim: PrePost_elim)
+    then show ?thesis using Value f by (auto elim: PrePost_elim)
+  next
+    case (Ex_Left e)
+    then show ?thesis using P m by (auto elim: PrePost_elim)
+  next
+    case (Ex_Right e a s'')
+    then have "R a s''" using P m by (auto elim: PrePost_elim)
+    then show ?thesis using Ex_Right f by (auto elim: PrePost_elim)
+  qed
+qed
+
+lemma PrePost_bindS_ignore:
+  assumes f: "PrePost R f Q"
+    and m : "PrePost P m (\<lambda>r. case r of Value a \<Rightarrow> R | Ex e \<Rightarrow> Q (Ex e))"
+  shows "PrePost P (bindS m (\<lambda>_. f)) Q"
+  using assms by auto
+
+lemma PrePost_bindS_unit:
+  fixes m :: "('regs, unit, 'e) monadS"
+  assumes f: "PrePost R (f ()) Q"
+    and m: "PrePost P m (\<lambda>r. case r of Value a \<Rightarrow> R | Ex e \<Rightarrow> Q (Ex e))"
+  shows "PrePost P (bindS m f) Q"
+  using assms by auto
+
+lemma PrePost_readS[intro, PrePost_intro]: "PrePost (\<lambda>s. P (Value (f s)) s) (readS f) P"
+  unfolding PrePost_def readS_def returnS_def by auto
+
+lemma PrePost_updateS[intro, PrePost_intro]: "PrePost (\<lambda>s. P (Value ()) (f s)) (updateS f) P"
+  unfolding PrePost_def updateS_def returnS_def by auto
+
+lemma PrePost_if:
+  assumes "b \<Longrightarrow> PrePost P f Q" and "\<not>b \<Longrightarrow> PrePost P g Q"
+  shows "PrePost P (if b then f else g) Q"
+  using assms by auto
+
+lemma PrePost_if_branch[PrePost_intro]:
+  assumes "b \<Longrightarrow> PrePost Pf f Q" and "\<not>b \<Longrightarrow> PrePost Pg g Q"
+  shows "PrePost (if b then Pf else Pg) (if b then f else g) Q"
+  using assms by auto
+
+lemma PrePost_if_then:
+  assumes "b" and "PrePost P f Q"
+  shows "PrePost P (if b then f else g) Q"
+  using assms by auto
+
+lemma PrePost_if_else:
+  assumes "\<not>b" and "PrePost P g Q"
+  shows "PrePost P (if b then f else g) Q"
+  using assms by auto
+
+lemma PrePost_prod_cases[PrePost_intro]:
+  assumes "PrePost P (f (fst x) (snd x)) Q"
+  shows "PrePost P (case x of (a, b) \<Rightarrow> f a b) Q"
+  using assms by (auto split: prod.splits)
+
+lemma PrePost_option_cases[PrePost_intro]:
+  assumes "\<And>a. PrePost (PS a) (s a) Q" and "PrePost PN n Q"
+  shows "PrePost (case x of Some a \<Rightarrow> PS a | None \<Rightarrow> PN) (case x of Some a \<Rightarrow> s a | None \<Rightarrow> n) Q"
+  using assms by (auto split: option.splits)
+
+lemma PrePost_let[intro, PrePost_intro]:
+  assumes "PrePost P (m y) Q"
+  shows "PrePost P (let x = y in m x) Q"
+  using assms by auto
+
+lemma PrePost_assert_expS[intro, PrePost_intro]: "PrePost (if c then P (Value ()) else P (Ex (Failure m))) (assert_expS c m) P"
+  unfolding PrePost_def assert_expS_def by (auto simp: returnS_def failS_def)
+
+lemma PrePost_chooseS[intro, PrePost_intro]: "PrePost (\<lambda>s. \<forall>x \<in> xs. Q (Value x) s) (chooseS xs) Q"
+  by (auto simp: PrePost_def chooseS_def)
+
+lemma PrePost_failS[intro, PrePost_intro]: "PrePost (Q (Ex (Failure msg))) (failS msg) Q"
+  by (auto simp: PrePost_def failS_def)
+
+lemma case_result_combine[simp]:
+  "(case r of Value a \<Rightarrow> Q (Value a) | Ex e \<Rightarrow> Q (Ex e)) = Q r"
+  by (auto split: result.splits)
+
+lemma PrePost_foreachS_Nil[intro, simp, PrePost_intro]:
+  "PrePost (Q (Value vars)) (foreachS [] vars body) Q"
+  by auto
+
+lemma PrePost_foreachS_Cons:
+  assumes "\<And>s vars' s'. (Value vars', s') \<in> body x vars s \<Longrightarrow> PrePost (Q (Value vars')) (foreachS xs vars' body) Q"
+    and "PrePost (Q (Value vars)) (body x vars) Q"
+  shows "PrePost (Q (Value vars)) (foreachS (x # xs) vars body) Q"
+  using assms by fastforce
+
+lemma PrePost_foreachS_invariant:
+  assumes "\<And>x vars. x \<in> set xs \<Longrightarrow> PrePost (Q (Value vars)) (body x vars) Q"
+  shows "PrePost (Q (Value vars)) (foreachS xs vars body) Q"
+proof (use assms in \<open>induction xs arbitrary: vars\<close>)
+  case (Cons x xs)
+  have "PrePost (Q (Value vars)) (bindS (body x vars) (\<lambda>vars. foreachS xs vars body)) Q"
+  proof (rule PrePost_bindS)
+    fix vars'
+    show "PrePost (Q (Value vars')) (foreachS xs vars' body) Q"
+      using Cons by auto
+    show "PrePost (Q (Value vars)) (body x vars) (\<lambda>r. case r of Value a \<Rightarrow> Q (Value a) | result.Ex e \<Rightarrow> Q (result.Ex e))"
+      unfolding case_result_combine
+      using Cons by auto
+  qed
+  then show ?case by auto
+qed auto
+
+subsection \<open>Hoare quadruples\<close>
+
+text \<open>It is often convenient to treat the exception case separately.  For this purpose, we use
+a Hoare logic similar to the one used in [1]. It features not only Hoare triples, but also quadruples
+with two postconditions: one for the case where the computation succeeds, and one for the case where
+there is an exception.
+
+[1] D. Cock, G. Klein, and T. Sewell, ‘Secure Microkernels, State Monads and Scalable Refinement’,
+in Theorem Proving in Higher Order Logics, 2008, pp. 167–182.\<close>
+
+definition PrePostE :: "'regs predS \<Rightarrow> ('regs, 'a, 'e) monadS \<Rightarrow> ('a \<Rightarrow> 'regs predS) \<Rightarrow> ('e ex \<Rightarrow> 'regs predS) \<Rightarrow> bool"
+  where "PrePostE P f Q E \<equiv> PrePost P f (\<lambda>v. case v of Value a \<Rightarrow> Q a | Ex e \<Rightarrow> E e)"
+
+lemmas PrePost_defs = PrePost_def PrePostE_def
+
+lemma PrePostE_I[case_names Val Err]:
+  assumes "\<And>s a s'. P s \<Longrightarrow> (Value a, s') \<in> f s \<Longrightarrow> Q a s'"
+    and "\<And>s e s'. P s \<Longrightarrow> (Ex e, s') \<in> f s \<Longrightarrow> E e s'"
+  shows "PrePostE P f Q E"
+  using assms unfolding PrePostE_def by (intro PrePostI) (auto split: result.splits)
+
+lemma PrePostE_PrePost:
+  assumes "PrePost P m (\<lambda>v. case v of Value a \<Rightarrow> Q a | Ex e \<Rightarrow> E e)"
+  shows "PrePostE P m Q E"
+  using assms unfolding PrePostE_def by auto
+
+lemma PrePostE_elim:
+  assumes "PrePostE P f Q E" and "P s" and "(r, s') \<in> f s"
+  obtains
+    (Val) v where "r = Value v" "Q v s'"
+  | (Ex) e where "r = Ex e" "E e s'"
+  using assms by (cases r; fastforce simp: PrePost_defs)
+
+lemma PrePostE_consequence:
+  assumes "PrePostE A f B C"
+    and "\<And>s. P s \<Longrightarrow> A s" and "\<And>v s. B v s \<Longrightarrow> Q v s" and "\<And>e s. C e s \<Longrightarrow> E e s"
+  shows "PrePostE P f Q E"
+  using assms unfolding PrePostE_def by (auto elim: PrePost_consequence split: result.splits)
+
+lemma PrePostE_strengthen_pre:
+  assumes "PrePostE R f Q E" and "\<And>s. P s \<Longrightarrow> R s"
+  shows "PrePostE P f Q E"
+  using assms PrePostE_consequence by blast
+
+lemma PrePostE_weaken_post:
+  assumes "PrePostE A f B E" and  "\<And>v s. B v s \<Longrightarrow> C v s"
+  shows "PrePostE A f C E"
+  using assms by (blast intro: PrePostE_consequence)
+
+named_theorems PrePostE_intro
+
+lemma PrePostE_True_post[PrePost_intro, intro, simp]:
+  "PrePostE P m (\<lambda>_ _. True) (\<lambda>_ _. True)"
+  unfolding PrePost_defs by (auto split: result.splits)
+
+lemma PrePostE_any: "PrePostE (\<lambda>s. \<forall>(r, s') \<in> m s. case r of Value a \<Rightarrow> Q a s' | Ex e \<Rightarrow> E e s') m Q E"
+  by (intro PrePostE_I) auto
+
+lemma PrePostE_returnS[PrePostE_intro, intro, simp]:
+  "PrePostE (P x) (returnS x) P Q"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_bindS[intro, PrePostE_intro]:
+  assumes f: "\<And>s a s'. (Value a, s') \<in> m s \<Longrightarrow> PrePostE (R a) (f a) Q E"
+    and m: "PrePostE P m R E"
+  shows "PrePostE P (bindS m f) Q E"
+  using assms
+  by (fastforce simp: PrePostE_def cong: result.case_cong)
+
+lemma PrePostE_bindS_ignore:
+  assumes f: "PrePostE R f Q E"
+    and m : "PrePostE  P m (\<lambda>_. R) E"
+  shows "PrePostE P (bindS m (\<lambda>_. f)) Q E"
+  using assms by auto
+
+lemma PrePostE_bindS_unit:
+  fixes m :: "('regs, unit, 'e) monadS"
+  assumes f: "PrePostE R (f ()) Q E"
+    and m: "PrePostE P m (\<lambda>_. R) E"
+  shows "PrePostE P (bindS m f) Q E"
+  using assms by auto
+
+lemma PrePostE_readS[PrePostE_intro, intro]: "PrePostE (\<lambda>s. Q (f s) s) (readS f) Q E"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_updateS[PrePostE_intro, intro]: "PrePostE (\<lambda>s. Q () (f s)) (updateS f) Q E"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_if_branch[PrePostE_intro]:
+  assumes "b \<Longrightarrow> PrePostE Pf f Q E" and "\<not>b \<Longrightarrow> PrePostE Pg g Q E"
+  shows "PrePostE (if b then Pf else Pg) (if b then f else g) Q E"
+  using assms by (auto)
+
+lemma PrePostE_if:
+  assumes "b \<Longrightarrow> PrePostE P f Q E" and "\<not>b \<Longrightarrow> PrePostE P g Q E"
+  shows "PrePostE P (if b then f else g) Q E"
+  using assms by auto
+
+lemma PrePostE_if_then:
+  assumes "b" and "PrePostE P f Q E"
+  shows "PrePostE P (if b then f else g) Q E"
+  using assms by auto
+
+lemma PrePostE_if_else:
+  assumes "\<not> b" and "PrePostE P g Q E"
+  shows "PrePostE P (if b then f else g) Q E"
+  using assms by auto
+
+lemma PrePostE_prod_cases[PrePostE_intro]:
+  assumes "PrePostE P (f (fst x) (snd x)) Q E"
+  shows "PrePostE P (case x of (a, b) \<Rightarrow> f a b) Q E"
+  using assms by (auto split: prod.splits)
+
+lemma PrePostE_option_cases[PrePostE_intro]:
+  assumes "\<And>a. PrePostE (PS a) (s a) Q E" and "PrePostE PN n Q E"
+  shows "PrePostE (case x of Some a \<Rightarrow> PS a | None \<Rightarrow> PN) (case x of Some a \<Rightarrow> s a | None \<Rightarrow> n) Q E"
+  using assms by (auto split: option.splits)
+
+lemma PrePostE_let[PrePostE_intro]:
+  assumes "PrePostE P (m y) Q E"
+  shows "PrePostE P (let x = y in m x) Q E"
+  using assms by auto
+
+lemma PrePostE_assert_expS[PrePostE_intro, intro]:
+  "PrePostE (if c then P () else Q (Failure m)) (assert_expS c m) P Q"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_failS[PrePost_intro, intro]:
+  "PrePostE (E (Failure msg)) (failS msg) Q E"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_chooseS[intro, PrePostE_intro]:
+  "PrePostE (\<lambda>s. \<forall>x \<in> xs. Q x s) (chooseS xs) Q E"
+  unfolding PrePostE_def by (auto intro: PrePost_strengthen_pre)
+
+lemma PrePostE_foreachS_Cons:
+  assumes "\<And>s vars' s'. (Value vars', s') \<in> body x vars s \<Longrightarrow> PrePostE (Q vars') (foreachS xs vars' body) Q E"
+    and "PrePostE (Q vars) (body x vars) Q E"
+  shows "PrePostE (Q vars) (foreachS (x # xs) vars body) Q E"
+  using assms by fastforce
+
+lemma PrePostE_foreachS_invariant:
+  assumes "\<And>x vars. x \<in> set xs \<Longrightarrow> PrePostE (Q vars) (body x vars) Q E"
+  shows "PrePostE (Q vars) (foreachS xs vars body) Q E"
+  using assms unfolding PrePostE_def
+  by (intro PrePost_foreachS_invariant[THEN PrePost_strengthen_pre]) auto
+
+end
diff --git a/snapshots/isabelle/lib/sail/Prompt.thy b/snapshots/isabelle/lib/sail/Prompt.thy
new file mode 100644
index 00000000..5792e575
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Prompt.thy
@@ -0,0 +1,150 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/prompt.lem.\<close>
+
+theory "Prompt" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Sail_values" 
+	 "Prompt_monad" 
+	 "Prompt_monad_lemmas" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Sail_impl_base*)
+(*open import Sail_values*)
+(*open import Prompt_monad*)
+(*open import {isabelle} `Prompt_monad_lemmas`*)
+
+(*val >>= : forall 'rv 'a 'b 'e. monad 'rv 'a 'e -> ('a -> monad 'rv 'b 'e) -> monad 'rv 'b 'e*)
+
+(*val >> : forall 'rv 'b 'e. monad 'rv unit 'e -> monad 'rv 'b 'e -> monad 'rv 'b 'e*)
+
+(*val iter_aux : forall 'rv 'a 'e. integer -> (integer -> 'a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e*)
+fun  iter_aux  :: " int \<Rightarrow>(int \<Rightarrow> 'a \<Rightarrow>('rv,(unit),'e)monad)\<Rightarrow> 'a list \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " iter_aux i f (x # xs) = ( f i x \<then> iter_aux (i +( 1 :: int)) f xs )"
+|" iter_aux i f ([]) = ( return ()  )"
+
+
+(*val iteri : forall 'rv 'a 'e. (integer -> 'a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e*)
+definition iteri  :: "(int \<Rightarrow> 'a \<Rightarrow>('rv,(unit),'e)monad)\<Rightarrow> 'a list \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " iteri f xs = ( iter_aux(( 0 :: int)) f xs )"
+
+
+(*val iter : forall 'rv 'a 'e. ('a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e*)
+definition iter  :: "('a \<Rightarrow>('rv,(unit),'e)monad)\<Rightarrow> 'a list \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " iter f xs = ( iteri ( \<lambda>x .  
+  (case  x of _ => \<lambda> x .  f x )) xs )"
+
+
+(*val foreachM : forall 'a 'rv 'vars 'e.
+  list 'a -> 'vars -> ('a -> 'vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e*)
+fun  foreachM  :: " 'a list \<Rightarrow> 'vars \<Rightarrow>('a \<Rightarrow> 'vars \<Rightarrow>('rv,'vars,'e)monad)\<Rightarrow>('rv,'vars,'e)monad "  where 
+     " foreachM ([]) vars body = ( return vars )"
+|" foreachM (x # xs) vars body = (
+  body x vars \<bind> (\<lambda> vars . 
+  foreachM xs vars body))"
+
+
+(*val and_boolM : forall 'rv 'e. monad 'rv bool 'e -> monad 'rv bool 'e -> monad 'rv bool 'e*)
+definition and_boolM  :: "('rv,(bool),'e)monad \<Rightarrow>('rv,(bool),'e)monad \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " and_boolM l r = ( l \<bind> (\<lambda> l .  if l then r else return False))"
+
+
+(*val or_boolM : forall 'rv 'e. monad 'rv bool 'e -> monad 'rv bool 'e -> monad 'rv bool 'e*)
+definition or_boolM  :: "('rv,(bool),'e)monad \<Rightarrow>('rv,(bool),'e)monad \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " or_boolM l r = ( l \<bind> (\<lambda> l .  if l then return True else r))"
+
+
+(*val bool_of_bitU_fail : forall 'rv 'e. bitU -> monad 'rv bool 'e*)
+definition bool_of_bitU_fail  :: " bitU \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " bool_of_bitU_fail = ( \<lambda>x .  
+  (case  x of
+        B0 => return False
+    | B1 => return True
+    | BU => Fail (''bool_of_bitU'')
+  ) )"
+
+
+(*val bool_of_bitU_oracle : forall 'rv 'e. bitU -> monad 'rv bool 'e*)
+definition bool_of_bitU_oracle  :: " bitU \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " bool_of_bitU_oracle = ( \<lambda>x .  
+  (case  x of
+        B0 => return False
+    | B1 => return True
+    | BU => undefined_bool () 
+  ) )"
+
+
+(*val bools_of_bits_oracle : forall 'rv 'e. list bitU -> monad 'rv (list bool) 'e*)
+definition bools_of_bits_oracle  :: "(bitU)list \<Rightarrow>('rv,((bool)list),'e)monad "  where 
+     " bools_of_bits_oracle bits = (
+  foreachM bits []
+    (\<lambda> b bools . 
+      bool_of_bitU_oracle b \<bind> (\<lambda> b . 
+      return (bools @ [b]))))"
+
+
+(*val of_bits_oracle : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monad 'rv 'a 'e*)
+definition of_bits_oracle  :: " 'a Bitvector_class \<Rightarrow>(bitU)list \<Rightarrow>('rv,'a,'e)monad "  where 
+     " of_bits_oracle dict_Sail_values_Bitvector_a bits = (
+  bools_of_bits_oracle bits \<bind> (\<lambda> bs . 
+  return ((of_bools_method   dict_Sail_values_Bitvector_a) bs)))"
+
+
+(*val of_bits_fail : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monad 'rv 'a 'e*)
+definition of_bits_fail  :: " 'a Bitvector_class \<Rightarrow>(bitU)list \<Rightarrow>('rv,'a,'e)monad "  where 
+     " of_bits_fail dict_Sail_values_Bitvector_a bits = ( maybe_fail (''of_bits'') (
+  (of_bits_method   dict_Sail_values_Bitvector_a) bits))"
+
+
+(*val mword_oracle : forall 'rv 'a 'e. Size 'a => unit -> monad 'rv (mword 'a) 'e*)
+definition mword_oracle  :: " unit \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " mword_oracle _ = (
+  bools_of_bits_oracle (repeat [BU] (int (len_of (TYPE(_) :: 'a itself)))) \<bind> (\<lambda> bs . 
+  return (Word.of_bl bs)))"
+
+
+(*val whileM : forall 'rv 'vars 'e. 'vars -> ('vars -> monad 'rv bool 'e) ->
+                ('vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e*)
+function (sequential,domintros)  whileM  :: " 'vars \<Rightarrow>('vars \<Rightarrow>('rv,(bool),'e)monad)\<Rightarrow>('vars \<Rightarrow>('rv,'vars,'e)monad)\<Rightarrow>('rv,'vars,'e)monad "  where 
+     " whileM vars cond body = (
+  cond vars \<bind> (\<lambda> cond_val . 
+  if cond_val then
+    body vars \<bind> (\<lambda> vars .  whileM vars cond body)
+  else return vars))" 
+by pat_completeness auto
+
+
+(*val untilM : forall 'rv 'vars 'e. 'vars -> ('vars -> monad 'rv bool 'e) ->
+                ('vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e*)
+function (sequential,domintros)  untilM  :: " 'vars \<Rightarrow>('vars \<Rightarrow>('rv,(bool),'e)monad)\<Rightarrow>('vars \<Rightarrow>('rv,'vars,'e)monad)\<Rightarrow>('rv,'vars,'e)monad "  where 
+     " untilM vars cond body = (
+  body vars \<bind> (\<lambda> vars . 
+  cond vars \<bind> (\<lambda> cond_val . 
+  if cond_val then return vars else untilM vars cond body)))" 
+by pat_completeness auto
+
+
+(*let write_two_regs r1 r2 vec =
+  let is_inc =
+    let is_inc_r1 = is_inc_of_reg r1 in
+    let is_inc_r2 = is_inc_of_reg r2 in
+    let () = ensure (is_inc_r1 = is_inc_r2)
+                    write_two_regs called with vectors of different direction in
+    is_inc_r1 in
+
+  let (size_r1 : integer) = size_of_reg r1 in
+  let (start_vec : integer) = get_start vec in
+  let size_vec = length vec in
+  let r1_v =
+    if is_inc
+    then slice vec start_vec (size_r1 - start_vec - 1)
+    else slice vec start_vec (start_vec - size_r1 - 1) in
+  let r2_v =
+    if is_inc
+    then slice vec (size_r1 - start_vec) (size_vec - start_vec)
+    else slice vec (start_vec - size_r1) (start_vec - size_vec) in
+  write_reg r1 r1_v >> write_reg r2 r2_v*)
+end
diff --git a/snapshots/isabelle/lib/sail/Prompt_monad.thy b/snapshots/isabelle/lib/sail/Prompt_monad.thy
new file mode 100644
index 00000000..e4aecfba
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Prompt_monad.thy
@@ -0,0 +1,267 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/prompt_monad.lem.\<close>
+
+theory "Prompt_monad" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Sail_instr_kinds" 
+	 "Sail_values" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Sail_impl_base*)
+(*open import Sail_instr_kinds*)
+(*open import Sail_values*)
+
+type_synonym register_name =" string "
+type_synonym address =" bitU list "
+
+datatype( 'regval, 'a, 'e) monad =
+    Done " 'a "
+  (* Read a number of bytes from memory, returned in little endian order *)
+  | Read_mem " read_kind " " address " " nat " " ( memory_byte list \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Read the tag of a memory address *)
+  | Read_tag " address " " (bitU \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Tell the system a write is imminent, at address lifted, of size nat *)
+  | Write_ea " write_kind " " address " " nat " " ('regval, 'a, 'e) monad "
+  (* Request the result of store-exclusive *)
+  | Excl_res " (bool \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Request to write memory at last signalled address. Memory value should be 8
+     times the size given in ea signal, given in little endian order *)
+  | Write_memv " memory_byte list " " (bool \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Request to write the tag at given address. *)
+  | Write_tag " address " " bitU " " (bool \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Tell the system to dynamically recalculate dependency footprint *)
+  | Footprint " ('regval, 'a, 'e) monad "
+  (* Request a memory barrier *)
+  | Barrier " barrier_kind " " ('regval, 'a, 'e) monad "
+  (* Request to read register, will track dependency when mode.track_values *)
+  | Read_reg " register_name " " ('regval \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Request to write register *)
+  | Write_reg " register_name " " 'regval " " ('regval, 'a, 'e) monad "
+  | Undefined " (bool \<Rightarrow> ('regval, 'a, 'e) monad)"
+  (* Print debugging or tracing information *)
+  | Print " string " " ('regval, 'a, 'e) monad "
+  (*Result of a failed assert with possible error message to report*)
+  | Fail " string "
+  (* Exception of type 'e *)
+  | Exception " 'e "
+
+(*val return : forall 'rv 'a 'e. 'a -> monad 'rv 'a 'e*)
+definition return  :: " 'a \<Rightarrow>('rv,'a,'e)monad "  where 
+     " return a = ( Done a )"
+
+
+(*val bind : forall 'rv 'a 'b 'e. monad 'rv 'a 'e -> ('a -> monad 'rv 'b 'e) -> monad 'rv 'b 'e*)
+function (sequential,domintros)  bind  :: "('rv,'a,'e)monad \<Rightarrow>('a \<Rightarrow>('rv,'b,'e)monad)\<Rightarrow>('rv,'b,'e)monad "  where 
+     " bind (Done a) f = ( f a )"
+|" bind (Read_mem rk a sz k) f = ( Read_mem rk a sz (\<lambda> v .  bind (k v) f))"
+|" bind (Read_tag a k) f = (       Read_tag a       (\<lambda> v .  bind (k v) f))"
+|" bind (Write_memv descr k) f = ( Write_memv descr (\<lambda> v .  bind (k v) f))"
+|" bind (Write_tag a t k) f = (    Write_tag a t    (\<lambda> v .  bind (k v) f))"
+|" bind (Read_reg descr k) f = (   Read_reg descr   (\<lambda> v .  bind (k v) f))"
+|" bind (Excl_res k) f = (         Excl_res         (\<lambda> v .  bind (k v) f))"
+|" bind (Undefined k) f = (        Undefined        (\<lambda> v .  bind (k v) f))"
+|" bind (Write_ea wk a sz k) f = ( Write_ea wk a sz (bind k f))"
+|" bind (Footprint k) f = (        Footprint        (bind k f))"
+|" bind (Barrier bk k) f = (       Barrier bk       (bind k f))"
+|" bind (Write_reg r v k) f = (    Write_reg r v    (bind k f))"
+|" bind (Print msg k) f = (        Print msg        (bind k f))"
+|" bind (Fail descr) f = (         Fail descr )"
+|" bind (Exception e) f = (        Exception e )" 
+by pat_completeness auto
+
+
+(*val exit : forall 'rv 'a 'e. unit -> monad 'rv 'a 'e*)
+definition exit0  :: " unit \<Rightarrow>('rv,'a,'e)monad "  where 
+     " exit0 _ = ( Fail (''exit''))"
+
+
+(*val undefined_bool : forall 'rv 'e. unit -> monad 'rv bool 'e*)
+definition undefined_bool  :: " unit \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " undefined_bool _ = ( Undefined return )"
+
+
+(*val assert_exp : forall 'rv 'e. bool -> string -> monad 'rv unit 'e*)
+definition assert_exp  :: " bool \<Rightarrow> string \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " assert_exp exp msg = ( if exp then Done ()  else Fail msg )"
+
+
+(*val throw : forall 'rv 'a 'e. 'e -> monad 'rv 'a 'e*)
+definition throw  :: " 'e \<Rightarrow>('rv,'a,'e)monad "  where 
+     " throw e = ( Exception e )"
+
+
+(*val try_catch : forall 'rv 'a 'e1 'e2. monad 'rv 'a 'e1 -> ('e1 -> monad 'rv 'a 'e2) -> monad 'rv 'a 'e2*)
+function (sequential,domintros)  try_catch  :: "('rv,'a,'e1)monad \<Rightarrow>('e1 \<Rightarrow>('rv,'a,'e2)monad)\<Rightarrow>('rv,'a,'e2)monad "  where 
+     " try_catch (Done a) h = (             Done a )"
+|" try_catch (Read_mem rk a sz k) h = ( Read_mem rk a sz (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Read_tag a k) h = (       Read_tag a       (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Write_memv descr k) h = ( Write_memv descr (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Write_tag a t k) h = (    Write_tag a t    (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Read_reg descr k) h = (   Read_reg descr   (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Excl_res k) h = (         Excl_res         (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Undefined k) h = (        Undefined        (\<lambda> v .  try_catch (k v) h))"
+|" try_catch (Write_ea wk a sz k) h = ( Write_ea wk a sz (try_catch k h))"
+|" try_catch (Footprint k) h = (        Footprint        (try_catch k h))"
+|" try_catch (Barrier bk k) h = (       Barrier bk       (try_catch k h))"
+|" try_catch (Write_reg r v k) h = (    Write_reg r v    (try_catch k h))"
+|" try_catch (Print msg k) h = (        Print msg        (try_catch k h))"
+|" try_catch (Fail descr) h = (         Fail descr )"
+|" try_catch (Exception e) h = (        h e )" 
+by pat_completeness auto
+
+
+(* For early return, we abuse exceptions by throwing and catching
+   the return value. The exception type is either 'r 'e, where Right e
+   represents a proper exception and Left r an early return of value r. *)
+type_synonym( 'rv, 'a, 'r, 'e) monadR =" ('rv, 'a, ( ('r, 'e)sum)) monad "
+
+(*val early_return : forall 'rv 'a 'r 'e. 'r -> monadR 'rv 'a 'r 'e*)
+definition early_return  :: " 'r \<Rightarrow>('rv,'a,(('r,'e)sum))monad "  where 
+     " early_return r = ( throw (Inl r))"
+
+
+(*val catch_early_return : forall 'rv 'a 'e. monadR 'rv 'a 'a 'e -> monad 'rv 'a 'e*)
+definition catch_early_return  :: "('rv,'a,(('a,'e)sum))monad \<Rightarrow>('rv,'a,'e)monad "  where 
+     " catch_early_return m = (
+  try_catch m
+    (\<lambda>x .  (case  x of   Inl a => return a | Inr e => throw e )))"
+
+
+(* Lift to monad with early return by wrapping exceptions *)
+(*val liftR : forall 'rv 'a 'r 'e. monad 'rv 'a 'e -> monadR 'rv 'a 'r 'e*)
+definition liftR  :: "('rv,'a,'e)monad \<Rightarrow>('rv,'a,(('r,'e)sum))monad "  where 
+     " liftR m = ( try_catch m (\<lambda> e .  throw (Inr e)))"
+
+
+(* Catch exceptions in the presence of early returns *)
+(*val try_catchR : forall 'rv 'a 'r 'e1 'e2. monadR 'rv 'a 'r 'e1 -> ('e1 -> monadR 'rv 'a 'r 'e2) ->  monadR 'rv 'a 'r 'e2*)
+definition try_catchR  :: "('rv,'a,(('r,'e1)sum))monad \<Rightarrow>('e1 \<Rightarrow>('rv,'a,(('r,'e2)sum))monad)\<Rightarrow>('rv,'a,(('r,'e2)sum))monad "  where 
+     " try_catchR m h = (
+  try_catch m
+    (\<lambda>x .  (case  x of   Inl r => throw (Inl r) | Inr e => h e )))"
+
+
+(*val maybe_fail : forall 'rv 'a 'e. string -> maybe 'a -> monad 'rv 'a 'e*)
+definition maybe_fail  :: " string \<Rightarrow> 'a option \<Rightarrow>('rv,'a,'e)monad "  where 
+     " maybe_fail msg = ( \<lambda>x .  
+  (case  x of   Some a => return a | None => Fail msg ) )"
+
+
+(*val read_mem_bytes : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv (list memory_byte) 'e*)
+definition read_mem_bytes  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> read_kind \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>('rv,((memory_byte)list),'e)monad "  where 
+     " read_mem_bytes dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b rk addr sz = (
+  Read_mem rk ((bits_of_method   dict_Sail_values_Bitvector_a) addr) (nat_of_int sz) return )"
+
+
+(*val read_mem : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv 'b 'e*)
+definition read_mem  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> read_kind \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>('rv,'b,'e)monad "  where 
+     " read_mem dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b rk addr sz = (
+  bind
+    (read_mem_bytes dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_a rk addr sz)
+    (\<lambda> bytes . 
+       maybe_fail (''bits_of_mem_bytes'') (
+  (of_bits_method   dict_Sail_values_Bitvector_b) (bits_of_mem_bytes bytes))))"
+
+
+(*val read_tag : forall 'rv 'a 'e. Bitvector 'a => 'a -> monad 'rv bitU 'e*)
+definition read_tag  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>('rv,(bitU),'e)monad "  where 
+     " read_tag dict_Sail_values_Bitvector_a addr = ( Read_tag (
+  (bits_of_method   dict_Sail_values_Bitvector_a) addr) return )"
+
+
+(*val excl_result : forall 'rv 'e. unit -> monad 'rv bool 'e*)
+definition excl_result  :: " unit \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " excl_result _ = ( 
+  (let k = (\<lambda> successful .  (return successful)) in Excl_res k) )"
+
+
+(*val write_mem_ea : forall 'rv 'a 'e. Bitvector 'a => write_kind -> 'a -> integer -> monad 'rv unit 'e*)
+definition write_mem_ea  :: " 'a Bitvector_class \<Rightarrow> write_kind \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " write_mem_ea dict_Sail_values_Bitvector_a wk addr sz = ( Write_ea wk (
+  (bits_of_method   dict_Sail_values_Bitvector_a) addr) (nat_of_int sz) (Done () ))"
+
+
+(*val write_mem_val : forall 'rv 'a 'e. Bitvector 'a => 'a -> monad 'rv bool 'e*)
+definition write_mem_val  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " write_mem_val dict_Sail_values_Bitvector_a v = ( (case  mem_bytes_of_bits 
+  dict_Sail_values_Bitvector_a v of
+    Some v => Write_memv v return
+  | None => Fail (''write_mem_val'')
+))"
+
+
+(*val write_tag : forall 'rv 'a 'e. Bitvector 'a => 'a -> bitU -> monad 'rv bool 'e*)
+definition write_tag  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('rv,(bool),'e)monad "  where 
+     " write_tag dict_Sail_values_Bitvector_a addr b = ( Write_tag (
+  (bits_of_method   dict_Sail_values_Bitvector_a) addr) b return )"
+
+
+(*val read_reg : forall 's 'rv 'a 'e. register_ref 's 'rv 'a -> monad 'rv 'a 'e*)
+definition read_reg  :: "('s,'rv,'a)register_ref \<Rightarrow>('rv,'a,'e)monad "  where 
+     " read_reg reg = ( 
+  (let k = (\<lambda> v . 
+            (case (of_regval   reg) v of
+                  Some v => Done v
+              | None => Fail (''read_reg: unrecognised value'')
+            )) in Read_reg (name   reg) k) )"
+
+
+(* TODO
+val read_reg_range : forall 's 'r 'rv 'a 'e. Bitvector 'a => register_ref 's 'rv 'r -> integer -> integer -> monad 'rv 'a 'e
+let read_reg_range reg i j =
+  read_reg_aux of_bits (external_reg_slice reg (nat_of_int i,nat_of_int j))
+
+let read_reg_bit reg i =
+  read_reg_aux (fun v -> v) (external_reg_slice reg (nat_of_int i,nat_of_int i)) >>= fun v ->
+  return (extract_only_element v)
+
+let read_reg_field reg regfield =
+  read_reg_aux (external_reg_field_whole reg regfield)
+
+let read_reg_bitfield reg regfield =
+  read_reg_aux (external_reg_field_whole reg regfield) >>= fun v ->
+  return (extract_only_element v)*)
+
+definition reg_deref  :: "('d,'c,'b)register_ref \<Rightarrow>('c,'b,'a)monad "  where 
+     " reg_deref = ( read_reg )"
+
+
+(*val write_reg : forall 's 'rv 'a 'e. register_ref 's 'rv 'a -> 'a -> monad 'rv unit 'e*)
+definition write_reg  :: "('s,'rv,'a)register_ref \<Rightarrow> 'a \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " write_reg reg v = ( Write_reg(name   reg) ((regval_of   reg) v) (Done () ))"
+
+
+(* TODO
+let write_reg reg v =
+  write_reg_aux (external_reg_whole reg) v
+let write_reg_range reg i j v =
+  write_reg_aux (external_reg_slice reg (nat_of_int i,nat_of_int j)) v
+let write_reg_pos reg i v =
+  let iN = nat_of_int i in
+  write_reg_aux (external_reg_slice reg (iN,iN)) [v]
+let write_reg_bit = write_reg_pos
+let write_reg_field reg regfield v =
+  write_reg_aux (external_reg_field_whole reg regfield.field_name) v
+let write_reg_field_bit reg regfield bit =
+  write_reg_aux (external_reg_field_whole reg regfield.field_name)
+                (Vector [bit] 0 (is_inc_of_reg reg))
+let write_reg_field_range reg regfield i j v =
+  write_reg_aux (external_reg_field_slice reg regfield.field_name (nat_of_int i,nat_of_int j)) v
+let write_reg_field_pos reg regfield i v =
+  write_reg_field_range reg regfield i i [v]
+let write_reg_field_bit = write_reg_field_pos*)
+
+(*val barrier : forall 'rv 'e. barrier_kind -> monad 'rv unit 'e*)
+definition barrier  :: " barrier_kind \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " barrier bk = ( Barrier bk (Done () ))"
+
+
+(*val footprint : forall 'rv 'e. unit -> monad 'rv unit 'e*)
+definition footprint  :: " unit \<Rightarrow>('rv,(unit),'e)monad "  where 
+     " footprint _ = ( Footprint (Done () ))"
+
+end
diff --git a/snapshots/isabelle/lib/sail/Prompt_monad_lemmas.thy b/snapshots/isabelle/lib/sail/Prompt_monad_lemmas.thy
new file mode 100644
index 00000000..e883c2a0
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Prompt_monad_lemmas.thy
@@ -0,0 +1,170 @@
+theory Prompt_monad_lemmas
+  imports
+    Prompt_monad
+    Sail_values_lemmas
+begin
+
+notation bind (infixr "\<bind>" 54)
+
+abbreviation seq :: "('rv,unit,'e)monad \<Rightarrow> ('rv,'b,'e)monad \<Rightarrow>('rv,'b,'e)monad" (infixr "\<then>" 54) where
+  "m \<then> n \<equiv> m \<bind> (\<lambda>_. n)"
+
+lemma All_bind_dom: "bind_dom (m, f)"
+  by (induction m) (auto intro: bind.domintros)
+
+termination bind using All_bind_dom by auto
+lemmas bind_induct[case_names Done Read_mem Write_memv Read_reg Excl_res Write_ea Barrier Write_reg Fail Exception] = bind.induct
+
+lemma bind_return[simp]: "bind (return a) f = f a"
+  by (auto simp: return_def)
+
+lemma bind_assoc[simp]: "bind (bind m f) g = bind m (\<lambda>x. bind (f x) g)"
+  by (induction m f arbitrary: g rule: bind.induct) auto
+
+lemma bind_assert_True[simp]: "bind (assert_exp True msg) f = f ()"
+  by (auto simp: assert_exp_def)
+
+lemma All_try_catch_dom: "try_catch_dom (m, h)"
+  by (induction m) (auto intro: try_catch.domintros)
+termination try_catch using All_try_catch_dom by auto
+lemmas try_catch_induct[case_names Done Read_mem Write_memv Read_reg Excl_res Write_ea Barrier Write_reg Fail Exception] = try_catch.induct
+
+datatype 'regval event =
+  (* Request to read memory *)
+    e_read_mem read_kind "bitU list" nat "memory_byte list"
+  | e_read_tag "bitU list" bitU
+  (* Write is imminent, at address lifted, of size nat *)
+  | e_write_ea write_kind "bitU list" nat
+  (* Request the result of store-exclusive *)
+  | e_excl_res bool
+  (* Request to write memory at last signalled address. Memory value should be 8
+     times the size given in ea signal *)
+  | e_write_memv "memory_byte list" bool
+  | e_write_tag "bitU list" bitU bool
+  (* Tell the system to dynamically recalculate dependency footprint *)
+  | e_footprint
+  (* Request a memory barrier *)
+  | e_barrier " barrier_kind "
+  (* Request to read register *)
+  | e_read_reg string 'regval
+  (* Request to write register *)
+  | e_write_reg string 'regval
+  | e_undefined bool
+  | e_print string
+
+inductive_set T :: "(('rv, 'a, 'e) monad \<times> 'rv event \<times> ('rv, 'a, 'e) monad) set" where
+  Read_mem: "((Read_mem rk addr sz k), e_read_mem rk addr sz v, k v) \<in> T"
+| Read_tag: "((Read_tag addr k), e_read_tag addr v, k v) \<in> T"
+| Write_ea: "((Write_ea wk addr sz k), e_write_ea wk addr sz, k) \<in> T"
+| Excl_res: "((Excl_res k), e_excl_res r, k r) \<in> T"
+| Write_memv: "((Write_memv v k), e_write_memv v r, k r) \<in> T"
+| Write_tag: "((Write_tag a v k), e_write_tag a v r, k r) \<in> T"
+| Footprint: "((Footprint k), e_footprint, k) \<in> T"
+| Barrier: "((Barrier bk k), e_barrier bk, k) \<in> T"
+| Read_reg: "((Read_reg r k), e_read_reg r v, k v) \<in> T"
+| Write_reg: "((Write_reg r v k), e_write_reg r v, k) \<in> T"
+| Undefined : "((Undefined k), e_undefined v, k v) \<in> T"
+| Print: "((Print msg k), e_print msg, k) \<in> T"
+
+inductive_set Traces :: "(('rv, 'a, 'e) monad \<times> 'rv event list \<times> ('rv, 'a, 'e) monad) set" where
+  Nil: "(s, [], s) \<in> Traces"
+| Step: "\<lbrakk>(s, e, s'') \<in> T; (s'', t, s') \<in> Traces\<rbrakk> \<Longrightarrow> (s, e # t, s') \<in> Traces"
+
+declare Traces.intros[intro]
+declare T.intros[intro]
+
+declare prod.splits[split]
+
+lemmas Traces_ConsI = T.intros[THEN Step, rotated]
+
+inductive_cases Traces_NilE[elim]: "(s, [], s') \<in> Traces"
+inductive_cases Traces_ConsE[elim]: "(s, e # t, s') \<in> Traces"
+
+lemma Traces_cases:
+  fixes m :: "('rv, 'a, 'e) monad"
+  assumes Run: "(m, t, m') \<in> Traces"
+  obtains (Nil) a where "m = m'" and "t = []"
+  | (Read_mem) rk addr s k t' v where "m = Read_mem rk addr s k" and "t = e_read_mem rk addr s v # t'" and "(k v, t', m') \<in> Traces"
+  | (Read_tag) addr k t' v where "m = Read_tag addr k" and "t = e_read_tag addr v # t'" and "(k v, t', m') \<in> Traces"
+  | (Write_memv) val k t' v where "m = Write_memv val k" and "t = e_write_memv val v # t'" and "(k v, t', m') \<in> Traces"
+  | (Write_tag) a val k t' v where "m = Write_tag a val k" and "t = e_write_tag a val v # t'" and "(k v, t', m') \<in> Traces"
+  | (Barrier) bk k t' v where "m = Barrier bk k" and "t = e_barrier bk # t'" and "(k, t', m') \<in> Traces"
+  | (Read_reg) reg k t' v where "m = Read_reg reg k" and "t = e_read_reg reg v # t'" and "(k v, t', m') \<in> Traces"
+  | (Excl_res) k t' v where "m = Excl_res k" and "t = e_excl_res v # t'" and "(k v, t', m') \<in> Traces"
+  | (Write_ea) wk addr s k t' where "m = Write_ea wk addr s k" and "t = e_write_ea wk addr s # t'" and "(k, t', m') \<in> Traces"
+  | (Footprint) k t' where "m = Footprint k" and "t = e_footprint # t'" and "(k, t', m') \<in> Traces"
+  | (Write_reg) reg v k t' where "m = Write_reg reg v k" and "t = e_write_reg reg v # t'" and "(k, t', m') \<in> Traces"
+  | (Undefined) v k t' where "m = Undefined k" and "t = e_undefined v # t'" and "(k v, t', m') \<in> Traces"
+  | (Print) msg k t' where "m = Print msg k" and "t = e_print msg # t'" and "(k, t', m') \<in> Traces"
+proof (use Run in \<open>cases m t m' set: Traces\<close>)
+  case Nil
+  then show ?thesis by (auto intro: that(1))
+next
+  case (Step e m'' t')
+  from \<open>(m, e, m'') \<in> T\<close> and \<open>t = e # t'\<close> and \<open>(m'', t', m') \<in> Traces\<close>
+  show ?thesis by (cases m e m'' rule: T.cases; elim that; blast)
+qed
+
+abbreviation Run :: "('rv, 'a, 'e) monad \<Rightarrow> 'rv event list \<Rightarrow> 'a \<Rightarrow> bool"
+  where "Run s t a \<equiv> (s, t, Done a) \<in> Traces"
+
+lemma Run_appendI:
+  assumes "(s, t1, s') \<in> Traces"
+    and "Run s' t2 a"
+  shows "Run s (t1 @ t2) a"
+proof (use assms in \<open>induction t1 arbitrary: s\<close>)
+  case (Cons e t1)
+  then show ?case by (elim Traces_ConsE) auto
+qed auto
+
+lemma bind_DoneE:
+  assumes "bind m f = Done a"
+  obtains a' where "m = Done a'" and "f a' = Done a"
+  using assms by (auto elim: bind.elims)
+
+lemma bind_T_cases:
+  assumes "(bind m f, e, s') \<in> T"
+  obtains (Done) a where "m = Done a"
+  | (Bind) m' where "s' = bind m' f" and "(m, e, m') \<in> T"
+  using assms by (cases; blast elim: bind.elims)
+
+lemma Run_bindE:
+  fixes m :: "('rv, 'b, 'e) monad" and a :: 'a
+  assumes "Run (bind m f) t a"
+  obtains tm am tf where "t = tm @ tf" and "Run m tm am" and "Run (f am) tf a"
+proof (use assms in \<open>induction "bind m f" t "Done a :: ('rv, 'a, 'e) monad" arbitrary: m rule: Traces.induct\<close>)
+  case Nil
+  obtain am where "m = Done am" and "f am = Done a" using Nil(1) by (elim bind_DoneE)
+  then show ?case by (intro Nil(2)) auto
+next
+  case (Step e s'' t m)
+  show thesis using Step(1)
+  proof (cases rule: bind_T_cases)
+    case (Done am)
+    then show ?thesis using Step(1,2) by (intro Step(4)[of "[]" "e # t" am]) auto
+  next
+    case (Bind m')
+    show ?thesis proof (rule Step(3)[OF Bind(1)])
+      fix tm tf am
+      assume "t = tm @ tf" and "Run m' tm am" and "Run (f am) tf a"
+      then show thesis using Bind by (intro Step(4)[of "e # tm" tf am]) auto
+    qed
+  qed
+qed
+
+lemma Run_DoneE:
+  assumes "Run (Done a) t a'"
+  obtains "t = []" and "a' = a"
+  using assms by (auto elim: Traces.cases T.cases)
+
+lemma Run_Done_iff_Nil[simp]: "Run (Done a) t a' \<longleftrightarrow> t = [] \<and> a' = a"
+  by (auto elim: Run_DoneE)
+
+lemma bind_cong[fundef_cong]:
+  assumes m: "m1 = m2"
+    and f: "\<And>t a. Run m2 t a \<Longrightarrow> f1 a = f2 a"
+  shows "bind m1 f1 = bind m2 f2"
+  unfolding m using f
+  by (induction m2 f1 arbitrary: f2 rule: bind.induct; unfold bind.simps; blast)
+
+end
diff --git a/snapshots/isabelle/lib/sail/ROOT b/snapshots/isabelle/lib/sail/ROOT
new file mode 100644
index 00000000..3189f216
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/ROOT
@@ -0,0 +1,11 @@
+session "Sail" = "LEM" +
+  options [document = false]
+  sessions
+    "HOL-Eisbach"
+  theories
+    Sail_values_lemmas
+    Prompt
+    State_lemmas
+    Sail_operators_mwords_lemmas
+    Sail_operators_bitlists
+    Hoare
diff --git a/snapshots/isabelle/lib/sail/Sail_instr_kinds.thy b/snapshots/isabelle/lib/sail/Sail_instr_kinds.thy
new file mode 100644
index 00000000..088ff4a8
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_instr_kinds.thy
@@ -0,0 +1,494 @@
+chapter \<open>Generated by Lem from ../../src/lem_interp/sail_instr_kinds.lem.\<close>
+
+theory "Sail_instr_kinds" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+
+begin 
+
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  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.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 AUTHOR OR   *)
+(*  CONTRIBUTORS 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.                                                          *)
+(*========================================================================*)
+
+(*open import Pervasives_extra*)
+
+
+record 'a EnumerationType_class= 
+
+  toNat_method ::" 'a \<Rightarrow> nat "
+
+
+
+
+(*val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering*)
+definition enumeration_typeCompare  :: " 'a EnumerationType_class \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ordering "  where 
+     " enumeration_typeCompare dict_Sail_instr_kinds_EnumerationType_a e1 e2 = (
+  (genericCompare (op<) (op=) (
+  (toNat_method   dict_Sail_instr_kinds_EnumerationType_a) e1) ((toNat_method   dict_Sail_instr_kinds_EnumerationType_a) e2)))"
+
+
+
+definition instance_Basic_classes_Ord_var_dict  :: " 'a EnumerationType_class \<Rightarrow> 'a Ord_class "  where 
+     " instance_Basic_classes_Ord_var_dict dict_Sail_instr_kinds_EnumerationType_a = ((|
+
+  compare_method = 
+  (enumeration_typeCompare dict_Sail_instr_kinds_EnumerationType_a),
+
+  isLess_method = (\<lambda>  r1 r2. (enumeration_typeCompare 
+  dict_Sail_instr_kinds_EnumerationType_a r1 r2) = LT),
+
+  isLessEqual_method = (\<lambda> r1 r2. (enumeration_typeCompare 
+  dict_Sail_instr_kinds_EnumerationType_a r1 r2) \<noteq> GT),
+
+  isGreater_method = (\<lambda>  r1 r2. (enumeration_typeCompare 
+  dict_Sail_instr_kinds_EnumerationType_a r1 r2) = GT),
+
+  isGreaterEqual_method = (\<lambda> r1 r2. (enumeration_typeCompare 
+  dict_Sail_instr_kinds_EnumerationType_a r1 r2) \<noteq> LT)|) )"
+
+
+
+(* Data structures for building up instructions *)
+
+(* careful: changes in the read/write/barrier kinds have to be
+   reflected in deep_shallow_convert *)
+datatype read_kind =
+  (* common reads *)
+    Read_plain
+  (* Power reads *)
+  | Read_reserve
+  (* AArch64 reads *)
+  | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream
+  (* RISC-V reads *)
+  | Read_RISCV_acquire  | Read_RISCV_strong_acquire
+  | Read_RISCV_reserved | Read_RISCV_reserved_acquire
+  | Read_RISCV_reserved_strong_acquire
+  (* x86 reads *)
+  | Read_X86_locked (* the read part of a lock'd instruction (rmw) *)
+
+definition instance_Show_Show_Sail_instr_kinds_read_kind_dict  :: "(read_kind)Show_class "  where 
+     " instance_Show_Show_Sail_instr_kinds_read_kind_dict = ((|
+
+  show_method = (\<lambda>x .  
+  (case  x of
+        Read_plain => (''Read_plain'')
+    | Read_reserve => (''Read_reserve'')
+    | Read_acquire => (''Read_acquire'')
+    | Read_exclusive => (''Read_exclusive'')
+    | Read_exclusive_acquire => (''Read_exclusive_acquire'')
+    | Read_stream => (''Read_stream'')
+    | Read_RISCV_acquire => (''Read_RISCV_acquire'')
+    | Read_RISCV_strong_acquire => (''Read_RISCV_strong_acquire'')
+    | Read_RISCV_reserved => (''Read_RISCV_reserved'')
+    | Read_RISCV_reserved_acquire => (''Read_RISCV_reserved_acquire'')
+    | Read_RISCV_reserved_strong_acquire => (''Read_RISCV_reserved_strong_acquire'')
+    | Read_X86_locked => (''Read_X86_locked'')
+  ))|) )"
+
+
+datatype write_kind =
+  (* common writes *)
+    Write_plain
+  (* Power writes *)
+  | Write_conditional
+  (* AArch64 writes *)
+  | Write_release | Write_exclusive | Write_exclusive_release
+  (* RISC-V *)
+  | Write_RISCV_release     | Write_RISCV_strong_release
+  | Write_RISCV_conditional | Write_RISCV_conditional_release
+  | Write_RISCV_conditional_strong_release
+  (* x86 writes *)
+  | Write_X86_locked (* the write part of a lock'd instruction (rmw) *)
+
+definition instance_Show_Show_Sail_instr_kinds_write_kind_dict  :: "(write_kind)Show_class "  where 
+     " instance_Show_Show_Sail_instr_kinds_write_kind_dict = ((|
+
+  show_method = (\<lambda>x .  
+  (case  x of
+        Write_plain => (''Write_plain'')
+    | Write_conditional => (''Write_conditional'')
+    | Write_release => (''Write_release'')
+    | Write_exclusive => (''Write_exclusive'')
+    | Write_exclusive_release => (''Write_exclusive_release'')
+    | Write_RISCV_release => (''Write_RISCV_release'')
+    | Write_RISCV_strong_release => (''Write_RISCV_strong_release'')
+    | Write_RISCV_conditional => (''Write_RISCV_conditional'')
+    | Write_RISCV_conditional_release => (''Write_RISCV_conditional_release'')
+    | Write_RISCV_conditional_strong_release => (''Write_RISCV_conditional_strong_release'')
+    | Write_X86_locked => (''Write_X86_locked'')
+  ))|) )"
+
+
+datatype barrier_kind =
+  (* Power barriers *)
+  Barrier_Sync | Barrier_LwSync | Barrier_Eieio | Barrier_Isync
+  (* AArch64 barriers *)
+  | Barrier_DMB | Barrier_DMB_ST | Barrier_DMB_LD | Barrier_DSB
+  | Barrier_DSB_ST | Barrier_DSB_LD | Barrier_ISB
+  | Barrier_TM_COMMIT
+  (* MIPS barriers *)
+  | Barrier_MIPS_SYNC
+  (* RISC-V barriers *)
+  | Barrier_RISCV_rw_rw
+  | Barrier_RISCV_r_rw
+  | Barrier_RISCV_r_r
+  | Barrier_RISCV_rw_w
+  | Barrier_RISCV_w_w
+  | Barrier_RISCV_i
+  (* X86 *)
+  | Barrier_x86_MFENCE
+
+
+definition instance_Show_Show_Sail_instr_kinds_barrier_kind_dict  :: "(barrier_kind)Show_class "  where 
+     " instance_Show_Show_Sail_instr_kinds_barrier_kind_dict = ((|
+
+  show_method = (\<lambda>x .  
+  (case  x of
+        Barrier_Sync => (''Barrier_Sync'')
+    | Barrier_LwSync => (''Barrier_LwSync'')
+    | Barrier_Eieio => (''Barrier_Eieio'')
+    | Barrier_Isync => (''Barrier_Isync'')
+    | Barrier_DMB => (''Barrier_DMB'')
+    | Barrier_DMB_ST => (''Barrier_DMB_ST'')
+    | Barrier_DMB_LD => (''Barrier_DMB_LD'')
+    | Barrier_DSB => (''Barrier_DSB'')
+    | Barrier_DSB_ST => (''Barrier_DSB_ST'')
+    | Barrier_DSB_LD => (''Barrier_DSB_LD'')
+    | Barrier_ISB => (''Barrier_ISB'')
+    | Barrier_TM_COMMIT => (''Barrier_TM_COMMIT'')
+    | Barrier_MIPS_SYNC => (''Barrier_MIPS_SYNC'')
+    | Barrier_RISCV_rw_rw => (''Barrier_RISCV_rw_rw'')
+    | Barrier_RISCV_r_rw => (''Barrier_RISCV_r_rw'')
+    | Barrier_RISCV_r_r => (''Barrier_RISCV_r_r'')
+    | Barrier_RISCV_rw_w => (''Barrier_RISCV_rw_w'')
+    | Barrier_RISCV_w_w => (''Barrier_RISCV_w_w'')
+    | Barrier_RISCV_i => (''Barrier_RISCV_i'')
+    | Barrier_x86_MFENCE => (''Barrier_x86_MFENCE'')
+  ))|) )"
+
+
+datatype trans_kind =
+  (* AArch64 *)
+    Transaction_start | Transaction_commit | Transaction_abort
+
+definition instance_Show_Show_Sail_instr_kinds_trans_kind_dict  :: "(trans_kind)Show_class "  where 
+     " instance_Show_Show_Sail_instr_kinds_trans_kind_dict = ((|
+
+  show_method = (\<lambda>x .  
+  (case  x of
+        Transaction_start => (''Transaction_start'')
+    | Transaction_commit => (''Transaction_commit'')
+    | Transaction_abort => (''Transaction_abort'')
+  ))|) )"
+
+
+datatype instruction_kind =
+    IK_barrier   " barrier_kind "
+  | IK_mem_read  " read_kind "
+  | IK_mem_write " write_kind "
+  | IK_mem_rmw   " (read_kind * write_kind)"
+  | IK_branch (* this includes conditional-branch (multiple nias, none of which is NIA_indirect_address),
+  indirect/computed-branch (single nia of kind NIA_indirect_address)
+  and branch/jump (single nia of kind NIA_concrete_address) *)
+  | IK_trans     " trans_kind "
+  | IK_simple
+
+
+definition instance_Show_Show_Sail_instr_kinds_instruction_kind_dict  :: "(instruction_kind)Show_class "  where 
+     " instance_Show_Show_Sail_instr_kinds_instruction_kind_dict = ((|
+
+  show_method = (\<lambda>x .  
+  (case  x of
+        IK_barrier barrier_kind => (''IK_barrier '') @
+                                     (((\<lambda>x .  (case  x of
+                                                            Barrier_Sync => 
+                                                      (''Barrier_Sync'')
+                                                        | Barrier_LwSync => 
+                                                      (''Barrier_LwSync'')
+                                                        | Barrier_Eieio => 
+                                                      (''Barrier_Eieio'')
+                                                        | Barrier_Isync => 
+                                                      (''Barrier_Isync'')
+                                                        | Barrier_DMB => 
+                                                      (''Barrier_DMB'')
+                                                        | Barrier_DMB_ST => 
+                                                      (''Barrier_DMB_ST'')
+                                                        | Barrier_DMB_LD => 
+                                                      (''Barrier_DMB_LD'')
+                                                        | Barrier_DSB => 
+                                                      (''Barrier_DSB'')
+                                                        | Barrier_DSB_ST => 
+                                                      (''Barrier_DSB_ST'')
+                                                        | Barrier_DSB_LD => 
+                                                      (''Barrier_DSB_LD'')
+                                                        | Barrier_ISB => 
+                                                      (''Barrier_ISB'')
+                                                        | Barrier_TM_COMMIT => 
+                                                      (''Barrier_TM_COMMIT'')
+                                                        | Barrier_MIPS_SYNC => 
+                                                      (''Barrier_MIPS_SYNC'')
+                                                        | Barrier_RISCV_rw_rw => 
+                                                      (''Barrier_RISCV_rw_rw'')
+                                                        | Barrier_RISCV_r_rw => 
+                                                      (''Barrier_RISCV_r_rw'')
+                                                        | Barrier_RISCV_r_r => 
+                                                      (''Barrier_RISCV_r_r'')
+                                                        | Barrier_RISCV_rw_w => 
+                                                      (''Barrier_RISCV_rw_w'')
+                                                        | Barrier_RISCV_w_w => 
+                                                      (''Barrier_RISCV_w_w'')
+                                                        | Barrier_RISCV_i => 
+                                                      (''Barrier_RISCV_i'')
+                                                        | Barrier_x86_MFENCE => 
+                                                      (''Barrier_x86_MFENCE'')
+                                                      )) barrier_kind))
+    | IK_mem_read read_kind => (''IK_mem_read '') @
+                                 (((\<lambda>x .  (case  x of
+                                                        Read_plain => 
+                                                  (''Read_plain'')
+                                                    | Read_reserve => 
+                                                  (''Read_reserve'')
+                                                    | Read_acquire => 
+                                                  (''Read_acquire'')
+                                                    | Read_exclusive => 
+                                                  (''Read_exclusive'')
+                                                    | Read_exclusive_acquire => 
+                                                  (''Read_exclusive_acquire'')
+                                                    | Read_stream => 
+                                                  (''Read_stream'')
+                                                    | Read_RISCV_acquire => 
+                                                  (''Read_RISCV_acquire'')
+                                                    | Read_RISCV_strong_acquire => 
+                                                  (''Read_RISCV_strong_acquire'')
+                                                    | Read_RISCV_reserved => 
+                                                  (''Read_RISCV_reserved'')
+                                                    | Read_RISCV_reserved_acquire => 
+                                                  (''Read_RISCV_reserved_acquire'')
+                                                    | Read_RISCV_reserved_strong_acquire => 
+                                                  (''Read_RISCV_reserved_strong_acquire'')
+                                                    | Read_X86_locked => 
+                                                  (''Read_X86_locked'')
+                                                  )) read_kind))
+    | IK_mem_write write_kind => (''IK_mem_write '') @
+                                   (((\<lambda>x .  (case  x of
+                                                          Write_plain => 
+                                                    (''Write_plain'')
+                                                      | Write_conditional => 
+                                                    (''Write_conditional'')
+                                                      | Write_release => 
+                                                    (''Write_release'')
+                                                      | Write_exclusive => 
+                                                    (''Write_exclusive'')
+                                                      | Write_exclusive_release => 
+                                                    (''Write_exclusive_release'')
+                                                      | Write_RISCV_release => 
+                                                    (''Write_RISCV_release'')
+                                                      | Write_RISCV_strong_release => 
+                                                    (''Write_RISCV_strong_release'')
+                                                      | Write_RISCV_conditional => 
+                                                    (''Write_RISCV_conditional'')
+                                                      | Write_RISCV_conditional_release => 
+                                                    (''Write_RISCV_conditional_release'')
+                                                      | Write_RISCV_conditional_strong_release => 
+                                                    (''Write_RISCV_conditional_strong_release'')
+                                                      | Write_X86_locked => 
+                                                    (''Write_X86_locked'')
+                                                    )) write_kind))
+    | IK_mem_rmw (r, w) => (''IK_mem_rmw '') @
+                             ((((\<lambda>x .  (case  x of
+                                                     Read_plain => (''Read_plain'')
+                                                 | Read_reserve => (''Read_reserve'')
+                                                 | Read_acquire => (''Read_acquire'')
+                                                 | Read_exclusive => 
+                                               (''Read_exclusive'')
+                                                 | Read_exclusive_acquire => 
+                                               (''Read_exclusive_acquire'')
+                                                 | Read_stream => (''Read_stream'')
+                                                 | Read_RISCV_acquire => 
+                                               (''Read_RISCV_acquire'')
+                                                 | Read_RISCV_strong_acquire => 
+                                               (''Read_RISCV_strong_acquire'')
+                                                 | Read_RISCV_reserved => 
+                                               (''Read_RISCV_reserved'')
+                                                 | Read_RISCV_reserved_acquire => 
+                                               (''Read_RISCV_reserved_acquire'')
+                                                 | Read_RISCV_reserved_strong_acquire => 
+                                               (''Read_RISCV_reserved_strong_acquire'')
+                                                 | Read_X86_locked => 
+                                               (''Read_X86_locked'')
+                                               )) r)) @
+                                (('' '') @
+                                   (((\<lambda>x .  (case  x of
+                                                          Write_plain => 
+                                                    (''Write_plain'')
+                                                      | Write_conditional => 
+                                                    (''Write_conditional'')
+                                                      | Write_release => 
+                                                    (''Write_release'')
+                                                      | Write_exclusive => 
+                                                    (''Write_exclusive'')
+                                                      | Write_exclusive_release => 
+                                                    (''Write_exclusive_release'')
+                                                      | Write_RISCV_release => 
+                                                    (''Write_RISCV_release'')
+                                                      | Write_RISCV_strong_release => 
+                                                    (''Write_RISCV_strong_release'')
+                                                      | Write_RISCV_conditional => 
+                                                    (''Write_RISCV_conditional'')
+                                                      | Write_RISCV_conditional_release => 
+                                                    (''Write_RISCV_conditional_release'')
+                                                      | Write_RISCV_conditional_strong_release => 
+                                                    (''Write_RISCV_conditional_strong_release'')
+                                                      | Write_X86_locked => 
+                                                    (''Write_X86_locked'')
+                                                    )) w))))
+    | IK_branch => (''IK_branch'')
+    | IK_trans trans_kind => (''IK_trans '') @
+                               (((\<lambda>x .  (case  x of
+                                                      Transaction_start => 
+                                                (''Transaction_start'')
+                                                  | Transaction_commit => 
+                                                (''Transaction_commit'')
+                                                  | Transaction_abort => 
+                                                (''Transaction_abort'')
+                                                )) trans_kind))
+    | IK_simple => (''IK_simple'')
+  ))|) )"
+
+
+
+definition read_is_exclusive  :: " read_kind \<Rightarrow> bool "  where 
+     " read_is_exclusive = ( \<lambda>x .  
+  (case  x of
+        Read_plain => False
+    | Read_reserve => True
+    | Read_acquire => False
+    | Read_exclusive => True
+    | Read_exclusive_acquire => True
+    | Read_stream => False
+    | Read_RISCV_acquire => False
+    | Read_RISCV_strong_acquire => False
+    | Read_RISCV_reserved => True
+    | Read_RISCV_reserved_acquire => True
+    | Read_RISCV_reserved_strong_acquire => True
+    | Read_X86_locked => True
+  ) )"
+
+
+
+
+definition instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_read_kind_dict  :: "(read_kind)EnumerationType_class "  where 
+     " instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_read_kind_dict = ((|
+
+  toNat_method = (\<lambda>x .  
+  (case  x of
+        Read_plain =>( 0 :: nat)
+    | Read_reserve =>( 1 :: nat)
+    | Read_acquire =>( 2 :: nat)
+    | Read_exclusive =>( 3 :: nat)
+    | Read_exclusive_acquire =>( 4 :: nat)
+    | Read_stream =>( 5 :: nat)
+    | Read_RISCV_acquire =>( 6 :: nat)
+    | Read_RISCV_strong_acquire =>( 7 :: nat)
+    | Read_RISCV_reserved =>( 8 :: nat)
+    | Read_RISCV_reserved_acquire =>( 9 :: nat)
+    | Read_RISCV_reserved_strong_acquire =>( 10 :: nat)
+    | Read_X86_locked =>( 11 :: nat)
+  ))|) )"
+
+
+definition instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_write_kind_dict  :: "(write_kind)EnumerationType_class "  where 
+     " instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_write_kind_dict = ((|
+
+  toNat_method = (\<lambda>x .  
+  (case  x of
+        Write_plain =>( 0 :: nat)
+    | Write_conditional =>( 1 :: nat)
+    | Write_release =>( 2 :: nat)
+    | Write_exclusive =>( 3 :: nat)
+    | Write_exclusive_release =>( 4 :: nat)
+    | Write_RISCV_release =>( 5 :: nat)
+    | Write_RISCV_strong_release =>( 6 :: nat)
+    | Write_RISCV_conditional =>( 7 :: nat)
+    | Write_RISCV_conditional_release =>( 8 :: nat)
+    | Write_RISCV_conditional_strong_release =>( 9 :: nat)
+    | Write_X86_locked =>( 10 :: nat)
+  ))|) )"
+
+
+definition instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_barrier_kind_dict  :: "(barrier_kind)EnumerationType_class "  where 
+     " instance_Sail_instr_kinds_EnumerationType_Sail_instr_kinds_barrier_kind_dict = ((|
+
+  toNat_method = (\<lambda>x .  
+  (case  x of
+        Barrier_Sync =>( 0 :: nat)
+    | Barrier_LwSync =>( 1 :: nat)
+    | Barrier_Eieio =>( 2 :: nat)
+    | Barrier_Isync =>( 3 :: nat)
+    | Barrier_DMB =>( 4 :: nat)
+    | Barrier_DMB_ST =>( 5 :: nat)
+    | Barrier_DMB_LD =>( 6 :: nat)
+    | Barrier_DSB =>( 7 :: nat)
+    | Barrier_DSB_ST =>( 8 :: nat)
+    | Barrier_DSB_LD =>( 9 :: nat)
+    | Barrier_ISB =>( 10 :: nat)
+    | Barrier_TM_COMMIT =>( 11 :: nat)
+    | Barrier_MIPS_SYNC =>( 12 :: nat)
+    | Barrier_RISCV_rw_rw =>( 13 :: nat)
+    | Barrier_RISCV_r_rw =>( 14 :: nat)
+    | Barrier_RISCV_r_r =>( 15 :: nat)
+    | Barrier_RISCV_rw_w =>( 16 :: nat)
+    | Barrier_RISCV_w_w =>( 17 :: nat)
+    | Barrier_RISCV_i =>( 18 :: nat)
+    | Barrier_x86_MFENCE =>( 19 :: nat)
+  ))|) )"
+
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_operators.thy b/snapshots/isabelle/lib/sail/Sail_operators.thy
new file mode 100644
index 00000000..00b32a85
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_operators.thy
@@ -0,0 +1,326 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/sail_operators.lem.\<close>
+
+theory "Sail_operators" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Lem_machine_word" 
+	 "Sail_values" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Machine_word*)
+(*open import Sail_values*)
+
+(*** Bit vector operations *)
+
+(*val concat_bv : forall 'a 'b. Bitvector 'a, Bitvector 'b => 'a -> 'b -> list bitU*)
+definition concat_bv  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow>(bitU)list "  where 
+     " concat_bv dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b l r = ( (
+  (bits_of_method   dict_Sail_values_Bitvector_a) l @(bits_of_method   dict_Sail_values_Bitvector_b) r))"
+
+
+(*val cons_bv : forall 'a. Bitvector 'a => bitU -> 'a -> list bitU*)
+definition cons_bv  :: " 'a Bitvector_class \<Rightarrow> bitU \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " cons_bv dict_Sail_values_Bitvector_a b v = ( b # 
+  (bits_of_method   dict_Sail_values_Bitvector_a) v )"
+
+
+(*val cast_unit_bv : bitU -> list bitU*)
+definition cast_unit_bv  :: " bitU \<Rightarrow>(bitU)list "  where 
+     " cast_unit_bv b = ( [b])"
+
+
+(*val bv_of_bit : integer -> bitU -> list bitU*)
+definition bv_of_bit  :: " int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " bv_of_bit len b = ( extz_bits len [b])"
+
+
+definition most_significant  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU "  where 
+     " most_significant dict_Sail_values_Bitvector_a v = ( (case  
+  (bits_of_method   dict_Sail_values_Bitvector_a) v of
+    b # _ => b
+  | _ => B0 (* Treat empty bitvector as all zeros *)
+  ))"
+
+
+definition get_max_representable_in  :: " bool \<Rightarrow> int \<Rightarrow> int "  where 
+     " get_max_representable_in sign (n :: int) = (
+  if (n =( 64 :: int)) then (case  sign of   True => max_64 | False => max_64u )
+  else if (n=( 32 :: int)) then (case  sign of   True => max_32 | False => max_32u )
+  else if (n=( 8 :: int)) then max_8
+  else if (n=( 5 :: int)) then max_5
+  else (case  sign of   True => (( 2 :: int))^ ((nat (abs ( n))) -( 1 :: nat))
+                       | False => (( 2 :: int))^ (nat (abs ( n)))
+       ))"
+
+
+definition get_min_representable_in  :: " 'a \<Rightarrow> int \<Rightarrow> int "  where 
+     " get_min_representable_in _ (n :: int) = (
+  if n =( 64 :: int) then min_64
+  else if n =( 32 :: int) then min_32
+  else if n =( 8 :: int) then min_8
+  else if n =( 5 :: int) then min_5
+  else( 0 :: int) - ((( 2 :: int))^ (nat (abs ( n)))))"
+
+
+(*val arith_op_bv_int : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> 'a -> integer -> 'a*)
+definition arith_op_bv_int  :: " 'a Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> 'a "  where 
+     " arith_op_bv_int dict_Sail_values_Bitvector_a op1 sign l r = (
+  (let r' = ((of_int_method   dict_Sail_values_Bitvector_a) ((length_method   dict_Sail_values_Bitvector_a) l) r) in (arith_op_bv_method   dict_Sail_values_Bitvector_a) op1 sign l r'))"
+
+
+(*val arith_op_int_bv : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a*)
+definition arith_op_int_bv  :: " 'a Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a "  where 
+     " arith_op_int_bv dict_Sail_values_Bitvector_a op1 sign l r = (
+  (let l' = ((of_int_method   dict_Sail_values_Bitvector_a) ((length_method   dict_Sail_values_Bitvector_a) r) l) in (arith_op_bv_method   dict_Sail_values_Bitvector_a) op1 sign l' r))"
+
+
+definition arith_op_bv_bool  :: " 'a Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a "  where 
+     " arith_op_bv_bool dict_Sail_values_Bitvector_a op1 sign l r = ( arith_op_bv_int 
+  dict_Sail_values_Bitvector_a op1 sign l (if r then( 1 :: int) else( 0 :: int)))"
+
+definition arith_op_bv_bit  :: " 'a Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow> 'a option "  where 
+     " arith_op_bv_bit dict_Sail_values_Bitvector_a op1 sign l r = ( map_option (arith_op_bv_bool 
+  dict_Sail_values_Bitvector_a op1 sign l) (bool_of_bitU r))"
+
+
+(* TODO (or just omit and define it per spec if needed)
+val arith_op_overflow_bv : forall 'a. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a -> (list bitU * bitU * bitU)
+let arith_op_overflow_bv op sign size l r =
+  let len = length l in
+  let act_size = len * size in
+  match (int_of_bv sign l, int_of_bv sign r, int_of_bv false l, int_of_bv false r) with
+    | (Just l_sign, Just r_sign, Just l_unsign, Just r_unsign) ->
+       let n = op l_sign r_sign in
+       let n_unsign = op l_unsign r_unsign in
+       let correct_size = of_int act_size n in
+       let one_more_size_u = bits_of_int (act_size + 1) n_unsign in
+       let overflow =
+         if n <= get_max_representable_in sign len &&
+              n >= get_min_representable_in sign len
+         then B0 else B1 in
+       let c_out = most_significant one_more_size_u in
+       (correct_size,overflow,c_out)
+    | (_, _, _, _) ->
+       (repeat [BU] act_size, BU, BU)
+  end
+
+let add_overflow_bv = arith_op_overflow_bv integerAdd false 1
+let adds_overflow_bv = arith_op_overflow_bv integerAdd true 1
+let sub_overflow_bv = arith_op_overflow_bv integerMinus false 1
+let subs_overflow_bv = arith_op_overflow_bv integerMinus true 1
+let mult_overflow_bv = arith_op_overflow_bv integerMult false 2
+let mults_overflow_bv = arith_op_overflow_bv integerMult true 2
+
+val arith_op_overflow_bv_bit : forall 'a. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> bitU -> (list bitU * bitU * bitU)
+let arith_op_overflow_bv_bit op sign size l r_bit =
+  let act_size = length l * size in
+  match (int_of_bv sign l, int_of_bv false l, r_bit = BU) with
+    | (Just l', Just l_u, false) ->
+       let (n, nu, changed) = match r_bit with
+         | B1 -> (op l' 1, op l_u 1, true)
+         | B0 -> (l', l_u, false)
+         | BU -> (* unreachable due to check above *)
+            failwith arith_op_overflow_bv_bit applied to undefined bit
+         end in
+       let correct_size = of_int act_size n in
+       let one_larger = bits_of_int (act_size + 1) nu in
+       let overflow =
+         if changed
+         then
+           if n <= get_max_representable_in sign act_size && n >= get_min_representable_in sign act_size
+           then B0 else B1
+         else B0 in
+       (correct_size, overflow, most_significant one_larger)
+    | (_, _, _) ->
+       (repeat [BU] act_size, BU, BU)
+  end
+
+let add_overflow_bv_bit = arith_op_overflow_bv_bit integerAdd false 1
+let adds_overflow_bv_bit = arith_op_overflow_bv_bit integerAdd true 1
+let sub_overflow_bv_bit = arith_op_overflow_bv_bit integerMinus false 1
+let subs_overflow_bv_bit = arith_op_overflow_bv_bit integerMinus true 1*)
+
+datatype shift = LL_shift | RR_shift | RR_shift_arith | LL_rot | RR_rot
+
+definition invert_shift  :: " shift \<Rightarrow> shift "  where 
+     " invert_shift = ( \<lambda>x .  
+  (case  x of
+        LL_shift => RR_shift
+    | RR_shift => LL_shift
+    | RR_shift_arith => LL_shift
+    | LL_rot => RR_rot
+    | RR_rot => LL_rot
+  ) )"
+
+
+(*val shift_op_bv : forall 'a. Bitvector 'a => shift -> 'a -> integer -> list bitU*)
+definition shift_op_bv  :: " 'a Bitvector_class \<Rightarrow> shift \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " shift_op_bv dict_Sail_values_Bitvector_a op1 v n = (
+  (let v = ((bits_of_method   dict_Sail_values_Bitvector_a) v) in
+  if n =( 0 :: int) then v else
+  (let (op1, n) = (if n >( 0 :: int) then (op1, n) else (invert_shift op1, - n)) in
+  (case  op1 of
+    LL_shift =>
+     subrange_list True v n (int (List.length v) -( 1 :: int)) @ repeat [B0] n
+  | RR_shift =>
+     repeat [B0] n @ subrange_list True v(( 0 :: int)) ((int (List.length v) - n) -( 1 :: int))
+  | RR_shift_arith =>
+     repeat [most_significant 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) v] n @ subrange_list True v(( 0 :: int)) ((int (List.length v) - n) -( 1 :: int))
+  | LL_rot =>
+     subrange_list True v n (int (List.length v) -( 1 :: int)) @ subrange_list True v(( 0 :: int)) (n -( 1 :: int))
+  | RR_rot =>
+     subrange_list False v(( 0 :: int)) (n -( 1 :: int)) @ subrange_list False v n (int (List.length v) -( 1 :: int))
+  ))))"
+
+
+definition shiftl_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " shiftl_bv dict_Sail_values_Bitvector_a = ( shift_op_bv 
+  dict_Sail_values_Bitvector_a LL_shift )"
+ (*<<*)
+definition shiftr_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " shiftr_bv dict_Sail_values_Bitvector_a = ( shift_op_bv 
+  dict_Sail_values_Bitvector_a RR_shift )"
+ (*>>*)
+definition arith_shiftr_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " arith_shiftr_bv dict_Sail_values_Bitvector_a = ( shift_op_bv 
+  dict_Sail_values_Bitvector_a RR_shift_arith )"
+
+definition rotl_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " rotl_bv dict_Sail_values_Bitvector_a = ( shift_op_bv 
+  dict_Sail_values_Bitvector_a LL_rot )"
+ (*<<<*)
+definition rotr_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " rotr_bv dict_Sail_values_Bitvector_a = ( shift_op_bv 
+  dict_Sail_values_Bitvector_a LL_rot )"
+ (*>>>*)
+
+definition shiftl_mword  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " shiftl_mword w n = ( w << (nat_of_int n))"
+
+definition shiftr_mword  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " shiftr_mword w n = ( w >> (nat_of_int n))"
+
+definition arith_shiftr_mword  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " arith_shiftr_mword w n = ( w >>> (nat_of_int n))"
+
+definition rotl_mword  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " rotl_mword w n = ( Word.word_rotl (nat_of_int n) w )"
+
+definition rotr_mword  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " rotr_mword w n = ( Word.word_rotr (nat_of_int n) w )"
+
+
+fun  arith_op_no0  :: "(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> int \<Rightarrow> int \<Rightarrow>(int)option "  where 
+     " arith_op_no0 (op1 :: int \<Rightarrow> int \<Rightarrow> int) l r = (
+  if r =( 0 :: int)
+  then None
+  else Some (op1 l r))"
+
+
+(*val arith_op_bv_no0 : forall 'a 'b. Bitvector 'a, Bitvector 'b =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a -> maybe 'b*)
+definition arith_op_bv_no0  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b option "  where 
+     " arith_op_bv_no0 dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b op1 sign size1 l r = (
+  Option.bind (int_of_bv 
+  dict_Sail_values_Bitvector_a sign l) (\<lambda> l' . 
+  Option.bind (int_of_bv 
+  dict_Sail_values_Bitvector_a sign r) (\<lambda> r' . 
+  if r' =( 0 :: int) then None else Some (
+  (of_int_method   dict_Sail_values_Bitvector_b) ((length_method   dict_Sail_values_Bitvector_a) l * size1) (op1 l' r')))))"
+
+
+definition mod_bv  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'a option "  where 
+     " mod_bv dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b = ( arith_op_bv_no0 
+  dict_Sail_values_Bitvector_b dict_Sail_values_Bitvector_a hardware_mod False(( 1 :: int)))"
+
+definition quot_bv  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'a option "  where 
+     " quot_bv dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b = ( arith_op_bv_no0 
+  dict_Sail_values_Bitvector_b dict_Sail_values_Bitvector_a hardware_quot False(( 1 :: int)))"
+
+definition quots_bv  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'a option "  where 
+     " quots_bv dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b = ( arith_op_bv_no0 
+  dict_Sail_values_Bitvector_b dict_Sail_values_Bitvector_a hardware_quot True(( 1 :: int)))"
+
+
+definition mod_mword  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " mod_mword = ( (op mod))"
+
+definition quot_mword  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " quot_mword = ( (op div))"
+
+definition quots_mword  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " quots_mword = ( Lem_machine_word.signedDivide )"
+
+
+definition arith_op_bv_int_no0  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> 'b option "  where 
+     " arith_op_bv_int_no0 dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b op1 sign size1 l r = (
+  arith_op_bv_no0 dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b op1 sign size1 l ((of_int_method   dict_Sail_values_Bitvector_a) ((length_method   dict_Sail_values_Bitvector_a) l) r))"
+
+
+definition quot_bv_int  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> int \<Rightarrow> 'a option "  where 
+     " quot_bv_int dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b = ( arith_op_bv_int_no0 
+  dict_Sail_values_Bitvector_b dict_Sail_values_Bitvector_a hardware_quot False(( 1 :: int)))"
+
+definition mod_bv_int  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> int \<Rightarrow> 'a option "  where 
+     " mod_bv_int dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b = ( arith_op_bv_int_no0 
+  dict_Sail_values_Bitvector_b dict_Sail_values_Bitvector_a hardware_mod False(( 1 :: int)))"
+
+
+definition mod_mword_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " mod_mword_int l r = ( l mod (Word.word_of_int r))"
+
+definition quot_mword_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " quot_mword_int l r = ( l div (Word.word_of_int r))"
+
+definition quots_mword_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " quots_mword_int l r = ( Lem_machine_word.signedDivide l (Word.word_of_int r))"
+
+
+definition replicate_bits_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " replicate_bits_bv dict_Sail_values_Bitvector_a v count1 = ( repeat (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) count1 )"
+
+definition duplicate_bit_bv  :: " 'a BitU_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " duplicate_bit_bv dict_Sail_values_BitU_a bit len = ( replicate_bits_bv 
+  (instance_Sail_values_Bitvector_list_dict dict_Sail_values_BitU_a) [bit] len )"
+
+
+(*val eq_bv : forall 'a. Bitvector 'a => 'a -> 'a -> bool*)
+definition eq_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool "  where 
+     " eq_bv dict_Sail_values_Bitvector_a l r = ( (
+  (bits_of_method   dict_Sail_values_Bitvector_a) l =(bits_of_method   dict_Sail_values_Bitvector_a) r))"
+
+
+(*val neq_bv : forall 'a. Bitvector 'a => 'a -> 'a -> bool*)
+definition neq_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool "  where 
+     " neq_bv dict_Sail_values_Bitvector_a l r = ( \<not> (eq_bv 
+  dict_Sail_values_Bitvector_a l r))"
+
+
+(*val get_slice_int_bv : forall 'a. Bitvector 'a => integer -> integer -> integer -> 'a*)
+definition get_slice_int_bv  :: " 'a Bitvector_class \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a "  where 
+     " get_slice_int_bv dict_Sail_values_Bitvector_a len n lo = (
+  (let hi = ((lo + len) -( 1 :: int)) in
+  (let bs = (bools_of_int (hi +( 1 :: int)) n) in 
+  (of_bools_method   dict_Sail_values_Bitvector_a) (subrange_list False bs hi lo))))"
+
+
+(*val set_slice_int_bv : forall 'a. Bitvector 'a => integer -> integer -> integer -> 'a -> integer*)
+definition set_slice_int_bv  :: " 'a Bitvector_class \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> int "  where 
+     " set_slice_int_bv dict_Sail_values_Bitvector_a len n lo v = (
+  (let hi = ((lo + len) -( 1 :: int)) in
+  (let bs = (bits_of_int (hi +( 1 :: int)) n) in
+  maybe_failwith (signed_of_bits (update_subrange_list False bs hi lo (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v))))))"
+
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_operators_bitlists.thy b/snapshots/isabelle/lib/sail/Sail_operators_bitlists.thy
new file mode 100644
index 00000000..d3d886ed
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_operators_bitlists.thy
@@ -0,0 +1,773 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/sail_operators_bitlists.lem.\<close>
+
+theory "Sail_operators_bitlists" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Lem_machine_word" 
+	 "Sail_values" 
+	 "Sail_operators" 
+	 "Prompt_monad" 
+	 "Prompt" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Machine_word*)
+(*open import Sail_values*)
+(*open import Sail_operators*)
+(*open import Prompt_monad*)
+(*open import Prompt*)
+
+(* Specialisation of operators to bit lists *)
+
+(*val uint_maybe : list bitU -> maybe integer*)
+definition uint_maybe  :: "(bitU)list \<Rightarrow>(int)option "  where 
+     " uint_maybe v = ( unsigned_of_bits (List.map (\<lambda> b. b) v))"
+
+definition uint_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>('c,(int),'b)monad "  where 
+     " uint_fail dict_Sail_values_Bitvector_a v = ( maybe_fail (''uint'') (
+  (unsigned_method   dict_Sail_values_Bitvector_a) v))"
+
+definition uint_oracle  :: "(bitU)list \<Rightarrow>('b,(int),'a)monad "  where 
+     " uint_oracle v = (
+  bools_of_bits_oracle v \<bind> (\<lambda> bs . 
+  return (int_of_bools False bs)))"
+
+definition uint  :: "(bitU)list \<Rightarrow> int "  where 
+     " uint v = ( maybe_failwith (uint_maybe v))"
+
+
+(*val sint_maybe : list bitU -> maybe integer*)
+definition sint_maybe  :: "(bitU)list \<Rightarrow>(int)option "  where 
+     " sint_maybe v = ( signed_of_bits (List.map (\<lambda> b. b) v))"
+
+definition sint_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>('c,(int),'b)monad "  where 
+     " sint_fail dict_Sail_values_Bitvector_a v = ( maybe_fail (''sint'') (
+  (signed_method   dict_Sail_values_Bitvector_a) v))"
+
+definition sint_oracle  :: "(bitU)list \<Rightarrow>('b,(int),'a)monad "  where 
+     " sint_oracle v = (
+  bools_of_bits_oracle v \<bind> (\<lambda> bs . 
+  return (int_of_bools True bs)))"
+
+definition sint  :: "(bitU)list \<Rightarrow> int "  where 
+     " sint v = ( maybe_failwith (sint_maybe v))"
+
+
+(*val extz_vec : integer -> list bitU -> list bitU*)
+definition extz_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " extz_vec = ( 
+  extz_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val exts_vec : integer -> list bitU -> list bitU*)
+definition exts_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " exts_vec = ( 
+  exts_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val zero_extend : list bitU -> integer -> list bitU*)
+definition zero_extend  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " zero_extend bits len = ( extz_bits len bits )"
+
+
+(*val sign_extend : list bitU -> integer -> list bitU*)
+definition sign_extend  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " sign_extend bits len = ( exts_bits len bits )"
+
+
+(*val zeros : integer -> list bitU*)
+definition zeros  :: " int \<Rightarrow>(bitU)list "  where 
+     " zeros len = ( repeat [B0] len )"
+
+
+(*val vector_truncate : list bitU -> integer -> list bitU*)
+definition vector_truncate  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " vector_truncate bs len = ( extz_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) len bs )"
+
+
+(*val vec_of_bits_maybe    : list bitU -> maybe (list bitU)*)
+(*val vec_of_bits_fail     : forall 'rv 'e. list bitU -> monad 'rv (list bitU) 'e*)
+(*val vec_of_bits_oracle   : forall 'rv 'e. list bitU -> monad 'rv (list bitU) 'e*)
+(*val vec_of_bits_failwith : list bitU -> list bitU*)
+(*val vec_of_bits          : list bitU -> list bitU*)
+
+(*val access_vec_inc : list bitU -> integer -> bitU*)
+definition access_vec_inc  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_vec_inc = ( 
+  access_bv_inc
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val access_vec_dec : list bitU -> integer -> bitU*)
+definition access_vec_dec  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_vec_dec = ( 
+  access_bv_dec
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val update_vec_inc : list bitU -> integer -> bitU -> list bitU*)
+definition update_vec_inc  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " update_vec_inc = ( 
+  update_bv_inc
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition update_vec_inc_maybe  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>((bitU)list)option "  where 
+     " update_vec_inc_maybe v i b = ( Some (update_vec_inc v i b))"
+
+definition update_vec_inc_fail  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " update_vec_inc_fail v i b = ( return (update_vec_inc v i b))"
+
+definition update_vec_inc_oracle  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " update_vec_inc_oracle v i b = ( return (update_vec_inc v i b))"
+
+
+(*val update_vec_dec : list bitU -> integer -> bitU -> list bitU*)
+definition update_vec_dec  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " update_vec_dec = ( 
+  update_bv_dec
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition update_vec_dec_maybe  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>((bitU)list)option "  where 
+     " update_vec_dec_maybe v i b = ( Some (update_vec_dec v i b))"
+
+definition update_vec_dec_fail  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " update_vec_dec_fail v i b = ( return (update_vec_dec v i b))"
+
+definition update_vec_dec_oracle  :: "(bitU)list \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " update_vec_dec_oracle v i b = ( return (update_vec_dec v i b))"
+
+
+(*val subrange_vec_inc : list bitU -> integer -> integer -> list bitU*)
+definition subrange_vec_inc  :: "(bitU)list \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " subrange_vec_inc = ( 
+  subrange_bv_inc
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val subrange_vec_dec : list bitU -> integer -> integer -> list bitU*)
+definition subrange_vec_dec  :: "(bitU)list \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " subrange_vec_dec = ( 
+  subrange_bv_dec
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val update_subrange_vec_inc : list bitU -> integer -> integer -> list bitU -> list bitU*)
+definition update_subrange_vec_inc  :: "(bitU)list \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " update_subrange_vec_inc = ( 
+  update_subrange_bv_inc
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict)
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val update_subrange_vec_dec : list bitU -> integer -> integer -> list bitU -> list bitU*)
+definition update_subrange_vec_dec  :: "(bitU)list \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " update_subrange_vec_dec = ( 
+  update_subrange_bv_dec
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict)
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val concat_vec : list bitU -> list bitU -> list bitU*)
+definition concat_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " concat_vec = ( 
+  concat_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict)
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val cons_vec : bitU -> list bitU -> list bitU*)
+definition cons_vec  :: " bitU \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " cons_vec = ( 
+  cons_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition cons_vec_maybe  :: " bitU \<Rightarrow>(bitU)list \<Rightarrow>((bitU)list)option "  where 
+     " cons_vec_maybe b v = ( Some (cons_vec b v))"
+
+definition cons_vec_fail  :: " bitU \<Rightarrow>(bitU)list \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " cons_vec_fail b v = ( return (cons_vec b v))"
+
+definition cons_vec_oracle  :: " bitU \<Rightarrow>(bitU)list \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " cons_vec_oracle b v = ( return (cons_vec b v))"
+
+
+(*val cast_unit_vec : bitU -> list bitU*)
+definition cast_unit_vec  :: " bitU \<Rightarrow>(bitU)list "  where 
+     " cast_unit_vec = ( cast_unit_bv )"
+
+definition cast_unit_vec_maybe  :: " bitU \<Rightarrow>((bitU)list)option "  where 
+     " cast_unit_vec_maybe b = ( Some (cast_unit_vec b))"
+
+definition cast_unit_vec_fail  :: " bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " cast_unit_vec_fail b = ( return (cast_unit_vec b))"
+
+definition cast_unit_vec_oracle  :: " bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " cast_unit_vec_oracle b = ( return (cast_unit_vec b))"
+
+
+(*val vec_of_bit : integer -> bitU -> list bitU*)
+definition vec_of_bit  :: " int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " vec_of_bit = ( bv_of_bit )"
+
+definition vec_of_bit_maybe  :: " int \<Rightarrow> bitU \<Rightarrow>((bitU)list)option "  where 
+     " vec_of_bit_maybe len b = ( Some (vec_of_bit len b))"
+
+definition vec_of_bit_fail  :: " int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " vec_of_bit_fail len b = ( return (vec_of_bit len b))"
+
+definition vec_of_bit_oracle  :: " int \<Rightarrow> bitU \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " vec_of_bit_oracle len b = ( return (vec_of_bit len b))"
+
+
+(*val msb : list bitU -> bitU*)
+definition msb  :: "(bitU)list \<Rightarrow> bitU "  where 
+     " msb = ( 
+  most_significant
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val int_of_vec_maybe : bool -> list bitU -> maybe integer*)
+definition int_of_vec_maybe  :: " bool \<Rightarrow>(bitU)list \<Rightarrow>(int)option "  where 
+     " int_of_vec_maybe = ( 
+  int_of_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition int_of_vec_fail  :: " bool \<Rightarrow>(bitU)list \<Rightarrow>('b,(int),'a)monad "  where 
+     " int_of_vec_fail sign v = ( maybe_fail (''int_of_vec'') (int_of_vec_maybe sign v))"
+
+definition int_of_vec_oracle  :: " bool \<Rightarrow>(bitU)list \<Rightarrow>('b,(int),'a)monad "  where 
+     " int_of_vec_oracle sign v = ( bools_of_bits_oracle v \<bind> (\<lambda> v .  return (int_of_bools sign v)))"
+
+definition int_of_vec  :: " bool \<Rightarrow>(bitU)list \<Rightarrow> int "  where 
+     " int_of_vec sign v = ( maybe_failwith (int_of_vec_maybe sign v))"
+
+
+(*val string_of_vec : list bitU -> string*)
+definition string_of_vec  :: "(bitU)list \<Rightarrow> string "  where 
+     " string_of_vec = ( 
+  string_of_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val and_vec : list bitU -> list bitU -> list bitU*)
+(*val or_vec  : list bitU -> list bitU -> list bitU*)
+(*val xor_vec : list bitU -> list bitU -> list bitU*)
+(*val not_vec : list bitU -> list bitU*)
+definition and_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " and_vec = ( binop_list and_bit )"
+
+definition or_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "   where 
+     " or_vec  = ( binop_list or_bit )"
+
+definition xor_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " xor_vec = ( binop_list xor_bit )"
+
+definition not_vec  :: "(bitU)list \<Rightarrow>(bitU)list "  where 
+     " not_vec = ( List.map not_bit )"
+
+
+(*val arith_op_double_bl : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> 'a -> 'a -> list bitU*)
+definition arith_op_double_bl  :: " 'a Bitvector_class \<Rightarrow>(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " arith_op_double_bl dict_Sail_values_Bitvector_a op1 sign l r = (
+  (let len =(( 2 :: int) *
+  (length_method   dict_Sail_values_Bitvector_a) l) in
+  (let l' = (if sign then exts_bv 
+  dict_Sail_values_Bitvector_a len l else extz_bv dict_Sail_values_Bitvector_a len l) in
+  (let r' = (if sign then exts_bv 
+  dict_Sail_values_Bitvector_a len r else extz_bv dict_Sail_values_Bitvector_a len r) in
+  List.map (\<lambda> b. b) (arith_op_bits op1 sign (List.map (\<lambda> b. b) l') (List.map (\<lambda> b. b) r'))))))"
+
+
+(*val add_vec   : list bitU -> list bitU -> list bitU*)
+(*val adds_vec  : list bitU -> list bitU -> list bitU*)
+(*val sub_vec   : list bitU -> list bitU -> list bitU*)
+(*val subs_vec  : list bitU -> list bitU -> list bitU*)
+(*val mult_vec  : list bitU -> list bitU -> list bitU*)
+(*val mults_vec : list bitU -> list bitU -> list bitU*)
+definition add_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "    where 
+     " add_vec   = ( (\<lambda> l r. List.map (\<lambda> b. b) (arith_op_bits (op+) False (List.map (\<lambda> b. b) l) (List.map (\<lambda> b. b) r))))"
+
+definition adds_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "   where 
+     " adds_vec  = ( (\<lambda> l r. List.map (\<lambda> b. b) (arith_op_bits (op+) True (List.map (\<lambda> b. b) l) (List.map (\<lambda> b. b) r))))"
+
+definition sub_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "    where 
+     " sub_vec   = ( (\<lambda> l r. List.map (\<lambda> b. b) (arith_op_bits (op-) False (List.map (\<lambda> b. b) l) (List.map (\<lambda> b. b) r))))"
+
+definition subs_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "   where 
+     " subs_vec  = ( (\<lambda> l r. List.map (\<lambda> b. b) (arith_op_bits (op-) True (List.map (\<lambda> b. b) l) (List.map (\<lambda> b. b) r))))"
+
+definition mult_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "   where 
+     " mult_vec  = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) False )"
+
+definition mults_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " mults_vec = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) True )"
+
+
+(*val add_vec_int       : list bitU -> integer -> list bitU*)
+(*val adds_vec_int      : list bitU -> integer -> list bitU*)
+(*val sub_vec_int       : list bitU -> integer -> list bitU*)
+(*val subs_vec_int      : list bitU -> integer -> list bitU*)
+(*val mult_vec_int      : list bitU -> integer -> list bitU*)
+(*val mults_vec_int     : list bitU -> integer -> list bitU*)
+definition add_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " add_vec_int   l r = ( arith_op_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op+) False l r )"
+
+definition adds_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " adds_vec_int  l r = ( arith_op_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op+) True l r )"
+
+definition sub_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " sub_vec_int   l r = ( arith_op_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op-) False l r )"
+
+definition subs_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " subs_vec_int  l r = ( arith_op_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op-) True l r )"
+
+definition mult_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " mult_vec_int  l r = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) False l (List.map (\<lambda> b. b) (bits_of_int (int (List.length l)) r)))"
+
+definition mults_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " mults_vec_int l r = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) True l (List.map (\<lambda> b. b) (bits_of_int (int (List.length l)) r)))"
+
+
+(*val add_int_vec       : integer -> list bitU -> list bitU*)
+(*val adds_int_vec      : integer -> list bitU -> list bitU*)
+(*val sub_int_vec       : integer -> list bitU -> list bitU*)
+(*val subs_int_vec      : integer -> list bitU -> list bitU*)
+(*val mult_int_vec      : integer -> list bitU -> list bitU*)
+(*val mults_int_vec     : integer -> list bitU -> list bitU*)
+definition add_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " add_int_vec   l r = ( arith_op_int_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op+) False l r )"
+
+definition adds_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " adds_int_vec  l r = ( arith_op_int_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op+) True l r )"
+
+definition sub_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " sub_int_vec   l r = ( arith_op_int_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op-) False l r )"
+
+definition subs_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " subs_int_vec  l r = ( arith_op_int_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op-) True l r )"
+
+definition mult_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " mult_int_vec  l r = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) False (List.map (\<lambda> b. b) (bits_of_int (int (List.length r)) l)) r )"
+
+definition mults_int_vec  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " mults_int_vec l r = ( arith_op_double_bl 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (op*) True (List.map (\<lambda> b. b) (bits_of_int (int (List.length r)) l)) r )"
+
+
+(*val add_vec_bit      : list bitU -> bitU -> list bitU*)
+(*val adds_vec_bit     : list bitU -> bitU -> list bitU*)
+(*val sub_vec_bit      : list bitU -> bitU -> list bitU*)
+(*val subs_vec_bit     : list bitU -> bitU -> list bitU*)
+
+definition add_vec_bool  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a "  where 
+     " add_vec_bool dict_Sail_values_Bitvector_a       l r = ( arith_op_bv_bool 
+  dict_Sail_values_Bitvector_a (op+) False l r )"
+
+definition add_vec_bit_maybe  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow> 'a option "  where 
+     " add_vec_bit_maybe dict_Sail_values_Bitvector_a  l r = ( arith_op_bv_bit 
+  dict_Sail_values_Bitvector_a (op+) False l r )"
+
+definition add_vec_bit_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " add_vec_bit_fail dict_Sail_values_Bitvector_a   l r = ( maybe_fail (''add_vec_bit'') (add_vec_bit_maybe 
+  dict_Sail_values_Bitvector_a l r))"
+
+definition add_vec_bit_oracle  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " add_vec_bit_oracle dict_Sail_values_Bitvector_a l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (add_vec_bool 
+  dict_Sail_values_Bitvector_a l r)))"
+
+definition add_vec_bit  :: "(bitU)list \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " add_vec_bit        l r = ( case_option (repeat [BU] (int (List.length l))) id (add_vec_bit_maybe 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+
+definition adds_vec_bool  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a "  where 
+     " adds_vec_bool dict_Sail_values_Bitvector_a       l r = ( arith_op_bv_bool 
+  dict_Sail_values_Bitvector_a (op+) True l r )"
+
+definition adds_vec_bit_maybe  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow> 'a option "  where 
+     " adds_vec_bit_maybe dict_Sail_values_Bitvector_a  l r = ( arith_op_bv_bit 
+  dict_Sail_values_Bitvector_a (op+) True l r )"
+
+definition adds_vec_bit_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " adds_vec_bit_fail dict_Sail_values_Bitvector_a   l r = ( maybe_fail (''adds_vec_bit'') (adds_vec_bit_maybe 
+  dict_Sail_values_Bitvector_a l r))"
+
+definition adds_vec_bit_oracle  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " adds_vec_bit_oracle dict_Sail_values_Bitvector_a l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (adds_vec_bool 
+  dict_Sail_values_Bitvector_a l r)))"
+
+definition adds_vec_bit  :: "(bitU)list \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " adds_vec_bit        l r = ( case_option (repeat [BU] (int (List.length l))) id (adds_vec_bit_maybe 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+
+definition sub_vec_bool  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a "  where 
+     " sub_vec_bool dict_Sail_values_Bitvector_a        l r = ( arith_op_bv_bool 
+  dict_Sail_values_Bitvector_a (op-) False l r )"
+
+definition sub_vec_bit_maybe  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow> 'a option "  where 
+     " sub_vec_bit_maybe dict_Sail_values_Bitvector_a   l r = ( arith_op_bv_bit 
+  dict_Sail_values_Bitvector_a (op-) False l r )"
+
+definition sub_vec_bit_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " sub_vec_bit_fail dict_Sail_values_Bitvector_a    l r = ( maybe_fail (''sub_vec_bit'') (sub_vec_bit_maybe 
+  dict_Sail_values_Bitvector_a l r))"
+
+definition sub_vec_bit_oracle  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " sub_vec_bit_oracle dict_Sail_values_Bitvector_a  l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (sub_vec_bool 
+  dict_Sail_values_Bitvector_a l r)))"
+
+definition sub_vec_bit  :: "(bitU)list \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " sub_vec_bit         l r = ( case_option (repeat [BU] (int (List.length l))) id (sub_vec_bit_maybe 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+
+definition subs_vec_bool  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a "  where 
+     " subs_vec_bool dict_Sail_values_Bitvector_a       l r = ( arith_op_bv_bool 
+  dict_Sail_values_Bitvector_a (op-) True l r )"
+
+definition subs_vec_bit_maybe  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow> 'a option "  where 
+     " subs_vec_bit_maybe dict_Sail_values_Bitvector_a  l r = ( arith_op_bv_bit 
+  dict_Sail_values_Bitvector_a (op-) True l r )"
+
+definition subs_vec_bit_fail  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " subs_vec_bit_fail dict_Sail_values_Bitvector_a   l r = ( maybe_fail (''sub_vec_bit'') (subs_vec_bit_maybe 
+  dict_Sail_values_Bitvector_a l r))"
+
+definition subs_vec_bit_oracle  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('d,'a,'c)monad "  where 
+     " subs_vec_bit_oracle dict_Sail_values_Bitvector_a l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (subs_vec_bool 
+  dict_Sail_values_Bitvector_a l r)))"
+
+definition subs_vec_bit  :: "(bitU)list \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " subs_vec_bit        l r = ( case_option (repeat [BU] (int (List.length l))) id (subs_vec_bit_maybe 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+
+(*val add_overflow_vec         : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val add_overflow_vec_signed  : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec         : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_signed  : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val mult_overflow_vec        : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val mult_overflow_vec_signed : list bitU -> list bitU -> (list bitU * bitU * bitU)
+let add_overflow_vec         = add_overflow_bv
+let add_overflow_vec_signed  = add_overflow_bv_signed
+let sub_overflow_vec         = sub_overflow_bv
+let sub_overflow_vec_signed  = sub_overflow_bv_signed
+let mult_overflow_vec        = mult_overflow_bv
+let mult_overflow_vec_signed = mult_overflow_bv_signed
+
+val add_overflow_vec_bit         : list bitU -> bitU -> (list bitU * bitU * bitU)
+val add_overflow_vec_bit_signed  : list bitU -> bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_bit         : list bitU -> bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_bit_signed  : list bitU -> bitU -> (list bitU * bitU * bitU)
+let add_overflow_vec_bit         = add_overflow_bv_bit
+let add_overflow_vec_bit_signed  = add_overflow_bv_bit_signed
+let sub_overflow_vec_bit         = sub_overflow_bv_bit
+let sub_overflow_vec_bit_signed  = sub_overflow_bv_bit_signed*)
+
+(*val shiftl       : list bitU -> integer -> list bitU*)
+(*val shiftr       : list bitU -> integer -> list bitU*)
+(*val arith_shiftr : list bitU -> integer -> list bitU*)
+(*val rotl         : list bitU -> integer -> list bitU*)
+(*val rotr         : list bitU -> integer -> list bitU*)
+definition shiftl  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "        where 
+     " shiftl       = ( 
+  shiftl_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition shiftr  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "        where 
+     " shiftr       = ( 
+  shiftr_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition arith_shiftr  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " arith_shiftr = ( 
+  arith_shiftr_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition rotl  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "          where 
+     " rotl         = ( 
+  rotl_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition rotr  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "          where 
+     " rotr         = ( 
+  rotr_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val mod_vec        : list bitU -> list bitU -> list bitU*)
+(*val mod_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)*)
+(*val mod_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+(*val mod_vec_oracle : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+definition mod_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " mod_vec        l r = ( case_option (repeat [BU] (int (List.length l))) id (mod_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition mod_vec_maybe  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>((bitU)list)option "  where 
+     " mod_vec_maybe  l r = ( mod_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r )"
+
+definition mod_vec_fail  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " mod_vec_fail   l r = ( maybe_fail (''mod_vec'') (mod_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition mod_vec_oracle  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " mod_vec_oracle l r = ( of_bits_oracle 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (mod_vec l r))"
+
+
+(*val quot_vec        : list bitU -> list bitU -> list bitU*)
+(*val quot_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)*)
+(*val quot_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+(*val quot_vec_oracle : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+definition quot_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " quot_vec        l r = ( case_option (repeat [BU] (int (List.length l))) id (quot_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quot_vec_maybe  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>((bitU)list)option "  where 
+     " quot_vec_maybe  l r = ( quot_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r )"
+
+definition quot_vec_fail  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quot_vec_fail   l r = ( maybe_fail (''quot_vec'') (quot_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quot_vec_oracle  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quot_vec_oracle l r = ( of_bits_oracle 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (quot_vec l r))"
+
+
+(*val quots_vec        : list bitU -> list bitU -> list bitU*)
+(*val quots_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)*)
+(*val quots_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+(*val quots_vec_oracle : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e*)
+definition quots_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " quots_vec        l r = ( case_option (repeat [BU] (int (List.length l))) id (quots_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quots_vec_maybe  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>((bitU)list)option "  where 
+     " quots_vec_maybe  l r = ( quots_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r )"
+
+definition quots_vec_fail  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quots_vec_fail   l r = ( maybe_fail (''quots_vec'') (quots_bv 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quots_vec_oracle  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quots_vec_oracle l r = ( of_bits_oracle 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (quots_vec l r))"
+
+
+(*val mod_vec_int        : list bitU -> integer -> list bitU*)
+(*val mod_vec_int_maybe  : list bitU -> integer -> maybe (list bitU)*)
+(*val mod_vec_int_fail   : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e*)
+(*val mod_vec_int_oracle : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e*)
+definition mod_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " mod_vec_int        l r = ( case_option (repeat [BU] (int (List.length l))) id (mod_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition mod_vec_int_maybe  :: "(bitU)list \<Rightarrow> int \<Rightarrow>((bitU)list)option "  where 
+     " mod_vec_int_maybe  l r = ( mod_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r )"
+
+definition mod_vec_int_fail  :: "(bitU)list \<Rightarrow> int \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " mod_vec_int_fail   l r = ( maybe_fail (''mod_vec_int'') (mod_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition mod_vec_int_oracle  :: "(bitU)list \<Rightarrow> int \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " mod_vec_int_oracle l r = ( of_bits_oracle 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (mod_vec_int l r))"
+
+
+(*val quot_vec_int        : list bitU -> integer -> list bitU*)
+(*val quot_vec_int_maybe  : list bitU -> integer -> maybe (list bitU)*)
+(*val quot_vec_int_fail   : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e*)
+(*val quot_vec_int_oracle : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e*)
+definition quot_vec_int  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " quot_vec_int        l r = ( case_option (repeat [BU] (int (List.length l))) id (quot_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quot_vec_int_maybe  :: "(bitU)list \<Rightarrow> int \<Rightarrow>((bitU)list)option "  where 
+     " quot_vec_int_maybe  l r = ( quot_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r )"
+
+definition quot_vec_int_fail  :: "(bitU)list \<Rightarrow> int \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quot_vec_int_fail   l r = ( maybe_fail (''quot_vec_int'') (quot_bv_int 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (instance_Sail_values_Bitvector_list_dict
+   instance_Sail_values_BitU_Sail_values_bitU_dict) l r))"
+
+definition quot_vec_int_oracle  :: "(bitU)list \<Rightarrow> int \<Rightarrow>('rv,((bitU)list),'e)monad "  where 
+     " quot_vec_int_oracle l r = ( of_bits_oracle 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) (quot_vec_int l r))"
+
+
+(*val replicate_bits : list bitU -> integer -> list bitU*)
+definition replicate_bits  :: "(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " replicate_bits = ( 
+  replicate_bits_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val duplicate : bitU -> integer -> list bitU*)
+definition duplicate  :: " bitU \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " duplicate = ( 
+  duplicate_bit_bv instance_Sail_values_BitU_Sail_values_bitU_dict )"
+
+definition duplicate_maybe  :: " bitU \<Rightarrow> int \<Rightarrow>((bitU)list)option "  where 
+     " duplicate_maybe b n = ( Some (duplicate b n))"
+
+definition duplicate_fail  :: " bitU \<Rightarrow> int \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " duplicate_fail b n = ( return (duplicate b n))"
+
+definition duplicate_oracle  :: " bitU \<Rightarrow> int \<Rightarrow>('b,((bitU)list),'a)monad "  where 
+     " duplicate_oracle b n = (
+  bool_of_bitU_oracle b \<bind> (\<lambda> b . 
+  return (duplicate (bitU_of_bool b) n)))"
+
+
+(*val reverse_endianness : list bitU -> list bitU*)
+definition reverse_endianness  :: "(bitU)list \<Rightarrow>(bitU)list "  where 
+     " reverse_endianness v = ( reverse_endianness_list v )"
+
+
+(*val get_slice_int : integer -> integer -> integer -> list bitU*)
+definition get_slice_int  :: " int \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " get_slice_int = ( 
+  get_slice_int_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val set_slice_int : integer -> integer -> integer -> list bitU -> integer*)
+definition set_slice_int  :: " int \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list \<Rightarrow> int "  where 
+     " set_slice_int = ( 
+  set_slice_int_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+
+(*val slice : list bitU -> integer -> integer -> list bitU*)
+definition slice  :: "(bitU)list \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " slice v lo len = (
+  subrange_vec_dec v ((lo + len) -( 1 :: int)) lo )"
+
+
+(*val set_slice : integer -> integer -> list bitU -> integer -> list bitU -> list bitU*)
+definition set_slice  :: " int \<Rightarrow> int \<Rightarrow>(bitU)list \<Rightarrow> int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " set_slice (out_len::ii) (slice_len::ii) out (n::ii) v = (
+  update_subrange_vec_dec out ((n + slice_len) -( 1 :: int)) n v )"
+
+
+(*val eq_vec    : list bitU -> list bitU -> bool*)
+(*val neq_vec   : list bitU -> list bitU -> bool*)
+definition eq_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow> bool "     where 
+     " eq_vec    = ( 
+  eq_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+definition neq_vec  :: "(bitU)list \<Rightarrow>(bitU)list \<Rightarrow> bool "    where 
+     " neq_vec   = ( 
+  neq_bv
+    (instance_Sail_values_Bitvector_list_dict
+       instance_Sail_values_BitU_Sail_values_bitU_dict) )"
+
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_operators_mwords.thy b/snapshots/isabelle/lib/sail/Sail_operators_mwords.thy
new file mode 100644
index 00000000..edaec4e3
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_operators_mwords.thy
@@ -0,0 +1,638 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/sail_operators_mwords.lem.\<close>
+
+theory "Sail_operators_mwords" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Lem_machine_word" 
+	 "Sail_values" 
+	 "Sail_operators" 
+	 "Prompt_monad" 
+	 "Prompt" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Machine_word*)
+(*open import Sail_values*)
+(*open import Sail_operators*)
+(*open import Prompt_monad*)
+(*open import Prompt*)
+definition uint_maybe  :: "('a::len)Word.word \<Rightarrow>(int)option "  where 
+     " uint_maybe v = ( Some (Word.uint v))"
+
+definition uint_fail  :: "('a::len)Word.word \<Rightarrow>('c,(int),'b)monad "  where 
+     " uint_fail v = ( return (Word.uint v))"
+
+definition uint_oracle  :: "('a::len)Word.word \<Rightarrow>('c,(int),'b)monad "  where 
+     " uint_oracle v = ( return (Word.uint v))"
+
+definition sint_maybe  :: "('a::len)Word.word \<Rightarrow>(int)option "  where 
+     " sint_maybe v = ( Some (Word.sint v))"
+
+definition sint_fail  :: "('a::len)Word.word \<Rightarrow>('c,(int),'b)monad "  where 
+     " sint_fail v = ( return (Word.sint v))"
+
+definition sint_oracle  :: "('a::len)Word.word \<Rightarrow>('c,(int),'b)monad "  where 
+     " sint_oracle v = ( return (Word.sint v))"
+
+
+(*val vec_of_bits_maybe    : forall 'a. Size 'a => list bitU -> maybe (mword 'a)*)
+(*val vec_of_bits_fail     : forall 'rv 'a 'e. Size 'a => list bitU -> monad 'rv (mword 'a) 'e*)
+(*val vec_of_bits_oracle   : forall 'rv 'a 'e. Size 'a => list bitU -> monad 'rv (mword 'a) 'e*)
+(*val vec_of_bits_failwith : forall 'a. Size 'a => list bitU -> mword 'a*)
+(*val vec_of_bits          : forall 'a. Size 'a => list bitU -> mword 'a*)
+definition vec_of_bits_maybe  :: "(bitU)list \<Rightarrow>(('a::len)Word.word)option "  where 
+     " vec_of_bits_maybe bits = ( map_option Word.of_bl (just_list (List.map bool_of_bitU bits)))"
+
+definition vec_of_bits_fail  :: "(bitU)list \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " vec_of_bits_fail bits = ( of_bits_fail 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict bits )"
+
+definition vec_of_bits_oracle  :: "(bitU)list \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " vec_of_bits_oracle bits = ( of_bits_oracle 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict bits )"
+
+definition vec_of_bits_failwith  :: "(bitU)list \<Rightarrow>('a::len)Word.word "  where 
+     " vec_of_bits_failwith bits = ( of_bits_failwith 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict bits )"
+
+definition vec_of_bits  :: "(bitU)list \<Rightarrow>('a::len)Word.word "  where 
+     " vec_of_bits bits = ( of_bits_failwith 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict bits )"
+
+
+(*val access_vec_inc : forall 'a. Size 'a => mword 'a -> integer -> bitU*)
+definition access_vec_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_vec_inc = ( 
+  access_bv_inc instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+(*val access_vec_dec : forall 'a. Size 'a => mword 'a -> integer -> bitU*)
+definition access_vec_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_vec_dec = ( 
+  access_bv_dec instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+definition update_vec_dec_maybe  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " update_vec_dec_maybe w i b = ( update_mword_dec w i b )"
+
+definition update_vec_dec_fail  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " update_vec_dec_fail w i b = (
+  bool_of_bitU_fail b \<bind> (\<lambda> b . 
+  return (update_mword_bool_dec w i b)))"
+
+definition update_vec_dec_oracle  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " update_vec_dec_oracle w i b = (
+  bool_of_bitU_oracle b \<bind> (\<lambda> b . 
+  return (update_mword_bool_dec w i b)))"
+
+definition update_vec_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " update_vec_dec w i b = ( maybe_failwith (update_vec_dec_maybe w i b))"
+
+
+definition update_vec_inc_maybe  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " update_vec_inc_maybe w i b = ( update_mword_inc w i b )"
+
+definition update_vec_inc_fail  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " update_vec_inc_fail w i b = (
+  bool_of_bitU_fail b \<bind> (\<lambda> b . 
+  return (update_mword_bool_inc w i b)))"
+
+definition update_vec_inc_oracle  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " update_vec_inc_oracle w i b = (
+  bool_of_bitU_oracle b \<bind> (\<lambda> b . 
+  return (update_mword_bool_inc w i b)))"
+
+definition update_vec_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " update_vec_inc w i b = ( maybe_failwith (update_vec_inc_maybe w i b))"
+
+
+(*val subrange_vec_dec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b*)
+definition subrange_vec_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " subrange_vec_dec w i j = ( Word.slice (nat_of_int j) w )"
+
+
+(*val subrange_vec_inc : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b*)
+definition subrange_vec_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " subrange_vec_inc w i j = ( subrange_vec_dec w ((int (size w) -( 1 :: int)) - i) ((int (size w) -( 1 :: int)) - j))"
+
+
+(*val update_subrange_vec_dec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b -> mword 'a*)
+definition update_subrange_vec_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " update_subrange_vec_dec w i j w' = ( Lem.word_update w (nat_of_int j) (nat_of_int i) w' )"
+
+
+(*val update_subrange_vec_inc : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b -> mword 'a*)
+definition update_subrange_vec_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " update_subrange_vec_inc w i j w' = ( update_subrange_vec_dec w ((int (size w) -( 1 :: int)) - i) ((int (size w) -( 1 :: int)) - j) w' )"
+
+
+(*val extz_vec : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b*)
+definition extz_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " extz_vec _ w = ( Word.ucast w )"
+
+
+(*val exts_vec : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b*)
+definition exts_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " exts_vec _ w = ( Word.scast w )"
+
+
+(*val zero_extend : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+definition zero_extend  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " zero_extend w _ = ( Word.ucast w )"
+
+
+(*val sign_extend : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+definition sign_extend  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " sign_extend w _ = ( Word.scast w )"
+
+
+(*val zeros : forall 'a. Size 'a => integer -> mword 'a*)
+definition zeros  :: " int \<Rightarrow>('a::len)Word.word "  where 
+     " zeros _ = ( Word.word_of_int (int(( 0 :: nat))))"
+
+
+(*val vector_truncate : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+definition vector_truncate  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " vector_truncate w _ = ( Word.ucast w )"
+
+
+(*val concat_vec : forall 'a 'b 'c. Size 'a, Size 'b, Size 'c => mword 'a -> mword 'b -> mword 'c*)
+definition concat_vec  :: "('a::len)Word.word \<Rightarrow>('b::len)Word.word \<Rightarrow>('c::len)Word.word "  where 
+     " concat_vec = ( Word.word_cat )"
+
+
+(*val cons_vec_bool : forall 'a 'b 'c. Size 'a, Size 'b => bool -> mword 'a -> mword 'b*)
+definition cons_vec_bool  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " cons_vec_bool b w = ( Word.of_bl (b # Word.to_bl w))"
+
+definition cons_vec_maybe  :: " bitU \<Rightarrow>('c::len)Word.word \<Rightarrow>(('b::len)Word.word)option "  where 
+     " cons_vec_maybe b w = ( map_option (\<lambda> b .  cons_vec_bool b w) (bool_of_bitU b))"
+
+definition cons_vec_fail  :: " bitU \<Rightarrow>('c::len)Word.word \<Rightarrow>('e,(('b::len)Word.word),'d)monad "  where 
+     " cons_vec_fail b w = ( bool_of_bitU_fail b \<bind> (\<lambda> b .  return (cons_vec_bool b w)))"
+
+definition cons_vec_oracle  :: " bitU \<Rightarrow>('c::len)Word.word \<Rightarrow>('e,(('b::len)Word.word),'d)monad "  where 
+     " cons_vec_oracle b w = ( bool_of_bitU_oracle b \<bind> (\<lambda> b .  return (cons_vec_bool b w)))"
+
+definition cons_vec  :: " bitU \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " cons_vec b w = ( maybe_failwith (cons_vec_maybe b w))"
+
+
+(*val vec_of_bool : forall 'a. Size 'a => integer -> bool -> mword 'a*)
+definition vec_of_bool  :: " int \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " vec_of_bool _ b = ( Word.of_bl [b])"
+
+definition vec_of_bit_maybe  :: " int \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " vec_of_bit_maybe len b = ( map_option (vec_of_bool len) (bool_of_bitU b))"
+
+definition vec_of_bit_fail  :: " int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " vec_of_bit_fail len b = ( bool_of_bitU_fail b \<bind> (\<lambda> b .  return (vec_of_bool len b)))"
+
+definition vec_of_bit_oracle  :: " int \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " vec_of_bit_oracle len b = ( bool_of_bitU_oracle b \<bind> (\<lambda> b .  return (vec_of_bool len b)))"
+
+definition vec_of_bit  :: " int \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " vec_of_bit len b = ( maybe_failwith (vec_of_bit_maybe len b))"
+
+
+(*val cast_bool_vec : bool -> mword ty1*)
+definition cast_bool_vec  :: " bool \<Rightarrow>(1)Word.word "  where 
+     " cast_bool_vec b = ( vec_of_bool(( 1 :: int)) b )"
+
+definition cast_unit_vec_maybe  :: " bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " cast_unit_vec_maybe b = ( vec_of_bit_maybe(( 1 :: int)) b )"
+
+definition cast_unit_vec_fail  :: " bitU \<Rightarrow>('b,((1)Word.word),'a)monad "  where 
+     " cast_unit_vec_fail b = ( bool_of_bitU_fail b \<bind> (\<lambda> b .  return (cast_bool_vec b)))"
+
+definition cast_unit_vec_oracle  :: " bitU \<Rightarrow>('b,((1)Word.word),'a)monad "  where 
+     " cast_unit_vec_oracle b = ( bool_of_bitU_oracle b \<bind> (\<lambda> b .  return (cast_bool_vec b)))"
+
+definition cast_unit_vec  :: " bitU \<Rightarrow>('a::len)Word.word "  where 
+     " cast_unit_vec b = ( maybe_failwith (cast_unit_vec_maybe b))"
+
+
+(*val msb : forall 'a. Size 'a => mword 'a -> bitU*)
+definition msb  :: "('a::len)Word.word \<Rightarrow> bitU "  where 
+     " msb = ( 
+  most_significant instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+(*val int_of_vec : forall 'a. Size 'a => bool -> mword 'a -> integer*)
+definition int_of_vec  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow> int "  where 
+     " int_of_vec sign w = (
+  if sign
+  then Word.sint w
+  else Word.uint w )"
+
+definition int_of_vec_maybe  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow>(int)option "  where 
+     " int_of_vec_maybe sign w = ( Some (int_of_vec sign w))"
+
+definition int_of_vec_fail  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow>('c,(int),'b)monad "  where 
+     " int_of_vec_fail sign w = ( return (int_of_vec sign w))"
+
+
+(*val string_of_vec : forall 'a. Size 'a => mword 'a -> string*)
+definition string_of_vec  :: "('a::len)Word.word \<Rightarrow> string "  where 
+     " string_of_vec = ( 
+  string_of_bv instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+(*val and_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val or_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val xor_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val not_vec : forall 'a. Size 'a => mword 'a -> mword 'a*)
+definition and_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " and_vec = ( Bits.bitAND )"
+
+definition or_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "   where 
+     " or_vec  = ( Bits.bitOR )"
+
+definition xor_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " xor_vec = ( Bits.bitXOR )"
+
+definition not_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " not_vec = ( Bits.bitNOT )"
+
+
+(*val add_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val adds_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val sub_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val subs_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val mult_vec  : forall 'a 'b. Size 'a, Size 'b => mword 'a -> mword 'a -> mword 'b*)
+(*val mults_vec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> mword 'a -> mword 'b*)
+definition add_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " add_vec   l r = ( Word.word_of_int ((int_of_mword False l) + (int_of_mword False r)))"
+
+definition adds_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " adds_vec  l r = ( Word.word_of_int ((int_of_mword True l) + (int_of_mword True r)))"
+
+definition sub_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " sub_vec   l r = ( Word.word_of_int ((int_of_mword False l) - (int_of_mword False r)))"
+
+definition subs_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " subs_vec  l r = ( Word.word_of_int ((int_of_mword True l) - (int_of_mword True r)))"
+
+definition mult_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " mult_vec  l r = ( Word.word_of_int ((int_of_mword False (Word.ucast l :: ( 'b::len)Word.word)) * (int_of_mword False (Word.ucast r :: ( 'b::len)Word.word))))"
+
+definition mults_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " mults_vec l r = ( Word.word_of_int ((int_of_mword True (Word.scast l :: ( 'b::len)Word.word)) * (int_of_mword True (Word.scast r :: ( 'b::len)Word.word))))"
+
+
+(*val add_vec_int   : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val adds_vec_int  : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val sub_vec_int   : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val subs_vec_int  : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val mult_vec_int  : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+(*val mults_vec_int : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+definition add_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " add_vec_int   l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+)   False l r )"
+
+definition adds_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " adds_vec_int  l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+)   True  l r )"
+
+definition sub_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " sub_vec_int   l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) False l r )"
+
+definition subs_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " subs_vec_int  l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) True  l r )"
+
+definition mult_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " mult_vec_int  l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op*)  False (Word.ucast l :: ( 'b::len)Word.word) r )"
+
+definition mults_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " mults_vec_int l r = ( arith_op_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op*)  True  (Word.scast l :: ( 'b::len)Word.word) r )"
+
+
+(*val add_int_vec   : forall 'a. Size 'a => integer -> mword 'a -> mword 'a*)
+(*val adds_int_vec  : forall 'a. Size 'a => integer -> mword 'a -> mword 'a*)
+(*val sub_int_vec   : forall 'a. Size 'a => integer -> mword 'a -> mword 'a*)
+(*val subs_int_vec  : forall 'a. Size 'a => integer -> mword 'a -> mword 'a*)
+(*val mult_int_vec  : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b*)
+(*val mults_int_vec : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b*)
+definition add_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " add_int_vec   l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+)   False l r )"
+
+definition adds_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " adds_int_vec  l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+)   True  l r )"
+
+definition sub_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " sub_int_vec   l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) False l r )"
+
+definition subs_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " subs_int_vec  l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) True  l r )"
+
+definition mult_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " mult_int_vec  l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op*)  False l (Word.ucast r :: ( 'b::len)Word.word))"
+
+definition mults_int_vec  :: " int \<Rightarrow>('a::len)Word.word \<Rightarrow>('b::len)Word.word "  where 
+     " mults_int_vec l r = ( arith_op_int_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op*)  True  l (Word.scast r :: ( 'b::len)Word.word))"
+
+
+(*val add_vec_bool  : forall 'a. Size 'a => mword 'a -> bool -> mword 'a*)
+(*val adds_vec_bool : forall 'a. Size 'a => mword 'a -> bool -> mword 'a*)
+(*val sub_vec_bool  : forall 'a. Size 'a => mword 'a -> bool -> mword 'a*)
+(*val subs_vec_bool : forall 'a. Size 'a => mword 'a -> bool -> mword 'a*)
+
+definition add_vec_bool  :: "('a::len)Word.word \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " add_vec_bool        l r = ( arith_op_bv_bool 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+) False l r )"
+
+definition add_vec_bit_maybe  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " add_vec_bit_maybe   l r = ( map_option (add_vec_bool l) (bool_of_bitU r))"
+
+definition add_vec_bit_fail  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " add_vec_bit_fail    l r = ( bool_of_bitU_fail r \<bind> (\<lambda> r .  return (add_vec_bool l r)))"
+
+definition add_vec_bit_oracle  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " add_vec_bit_oracle  l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (add_vec_bool l r)))"
+
+definition add_vec_bit  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " add_vec_bit         l r = ( maybe_failwith (add_vec_bit_maybe  l r))"
+
+
+definition adds_vec_bool  :: "('a::len)Word.word \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " adds_vec_bool       l r = ( arith_op_bv_bool 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op+) True  l r )"
+
+definition adds_vec_bit_maybe  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " adds_vec_bit_maybe  l r = ( map_option (adds_vec_bool l) (bool_of_bitU r))"
+
+definition adds_vec_bit_fail  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " adds_vec_bit_fail   l r = ( bool_of_bitU_fail r \<bind> (\<lambda> r .  return (adds_vec_bool l r)))"
+
+definition adds_vec_bit_oracle  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " adds_vec_bit_oracle l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (adds_vec_bool l r)))"
+
+definition adds_vec_bit  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " adds_vec_bit        l r = ( maybe_failwith (adds_vec_bit_maybe l r))"
+
+
+definition sub_vec_bool  :: "('a::len)Word.word \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " sub_vec_bool        l r = ( arith_op_bv_bool 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) False l r )"
+
+definition sub_vec_bit_maybe  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " sub_vec_bit_maybe   l r = ( map_option (sub_vec_bool l) (bool_of_bitU r))"
+
+definition sub_vec_bit_fail  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " sub_vec_bit_fail    l r = ( bool_of_bitU_fail r \<bind> (\<lambda> r .  return (sub_vec_bool l r)))"
+
+definition sub_vec_bit_oracle  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " sub_vec_bit_oracle  l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (sub_vec_bool l r)))"
+
+definition sub_vec_bit  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " sub_vec_bit         l r = ( maybe_failwith (sub_vec_bit_maybe  l r))"
+
+
+definition subs_vec_bool  :: "('a::len)Word.word \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " subs_vec_bool       l r = ( arith_op_bv_bool 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict (op-) True  l r )"
+
+definition subs_vec_bit_maybe  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " subs_vec_bit_maybe  l r = ( map_option (subs_vec_bool l) (bool_of_bitU r))"
+
+definition subs_vec_bit_fail  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " subs_vec_bit_fail   l r = ( bool_of_bitU_fail r \<bind> (\<lambda> r .  return (subs_vec_bool l r)))"
+
+definition subs_vec_bit_oracle  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " subs_vec_bit_oracle l r = ( bool_of_bitU_oracle r \<bind> (\<lambda> r .  return (subs_vec_bool l r)))"
+
+definition subs_vec_bit  :: "('a::len)Word.word \<Rightarrow> bitU \<Rightarrow>('a::len)Word.word "  where 
+     " subs_vec_bit        l r = ( maybe_failwith (subs_vec_bit_maybe  l r))"
+
+
+(* TODO
+val maybe_mword_of_bits_overflow : forall 'a. Size 'a => (list bitU * bitU * bitU) -> maybe (mword 'a * bitU * bitU)
+let maybe_mword_of_bits_overflow (bits, overflow, carry) =
+  Maybe.map (fun w -> (w, overflow, carry)) (of_bits bits)
+
+val add_overflow_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val adds_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val sub_overflow_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val subs_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val mult_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val mults_overflow_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+let add_overflow_vec   l r = maybe_mword_of_bits_overflow (add_overflow_bv l r)
+let adds_overflow_vec  l r = maybe_mword_of_bits_overflow (adds_overflow_bv l r)
+let sub_overflow_vec   l r = maybe_mword_of_bits_overflow (sub_overflow_bv l r)
+let subs_overflow_vec  l r = maybe_mword_of_bits_overflow (subs_overflow_bv l r)
+let mult_overflow_vec  l r = maybe_mword_of_bits_overflow (mult_overflow_bv l r)
+let mults_overflow_vec l r = maybe_mword_of_bits_overflow (mults_overflow_bv l r)
+
+val add_overflow_vec_bit         : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val add_overflow_vec_bit_signed  : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val sub_overflow_vec_bit         : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val sub_overflow_vec_bit_signed  : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+let add_overflow_vec_bit         = add_overflow_bv_bit
+let add_overflow_vec_bit_signed  = add_overflow_bv_bit_signed
+let sub_overflow_vec_bit         = sub_overflow_bv_bit
+let sub_overflow_vec_bit_signed  = sub_overflow_bv_bit_signed*)
+
+(*val shiftl       : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val shiftr       : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val arith_shiftr : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val rotl         : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val rotr         : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+definition shiftl  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "        where 
+     " shiftl       = ( shiftl_mword )"
+
+definition shiftr  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "        where 
+     " shiftr       = ( shiftr_mword )"
+
+definition arith_shiftr  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " arith_shiftr = ( arith_shiftr_mword )"
+
+definition rotl  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "          where 
+     " rotl         = ( rotl_mword )"
+
+definition rotr  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "          where 
+     " rotr         = ( rotr_mword )"
+
+
+(*val mod_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val mod_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)*)
+(*val mod_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+(*val mod_vec_oracle : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+definition mod_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " mod_vec        l r = ( mod_mword l r )"
+
+definition mod_vec_maybe  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>(('a::len)Word.word)option "  where 
+     " mod_vec_maybe  l r = ( mod_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r )"
+
+definition mod_vec_fail  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " mod_vec_fail   l r = ( maybe_fail (''mod_vec'') (mod_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r))"
+
+definition mod_vec_oracle  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " mod_vec_oracle l r = (
+  (case  (mod_bv instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r) of
+      Some w => return w
+    | None => mword_oracle () 
+  ))"
+
+
+(*val quot_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val quot_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)*)
+(*val quot_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+(*val quot_vec_oracle : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+definition quot_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " quot_vec        l r = ( quot_mword l r )"
+
+definition quot_vec_maybe  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>(('a::len)Word.word)option "  where 
+     " quot_vec_maybe  l r = ( quot_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r )"
+
+definition quot_vec_fail  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quot_vec_fail   l r = ( maybe_fail (''quot_vec'') (quot_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r))"
+
+definition quot_vec_oracle  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quot_vec_oracle l r = (
+  (case  (quot_bv instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r) of
+      Some w => return w
+    | None => mword_oracle () 
+  ))"
+
+
+(*val quots_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a*)
+(*val quots_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)*)
+(*val quots_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+(*val quots_vec_oracle : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e*)
+definition quots_vec  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " quots_vec        l r = ( quots_mword l r )"
+
+definition quots_vec_maybe  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>(('a::len)Word.word)option "  where 
+     " quots_vec_maybe  l r = ( quots_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r )"
+
+definition quots_vec_fail  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quots_vec_fail   l r = ( maybe_fail (''quots_vec'') (quots_bv 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r))"
+
+definition quots_vec_oracle  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quots_vec_oracle l r = (
+  (case  (quots_bv instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r) of
+      Some w => return w
+    | None => mword_oracle () 
+  ))"
+
+
+(*val mod_vec_int        : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val mod_vec_int_maybe  : forall 'a. Size 'a => mword 'a -> integer -> maybe (mword 'a)*)
+(*val mod_vec_int_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e*)
+(*val mod_vec_int_oracle : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e*)
+definition mod_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " mod_vec_int        l r = ( mod_mword_int l r )"
+
+definition mod_vec_int_maybe  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>(('a::len)Word.word)option "  where 
+     " mod_vec_int_maybe  l r = ( mod_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r )"
+
+definition mod_vec_int_fail  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " mod_vec_int_fail   l r = ( maybe_fail (''mod_vec_int'') (mod_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r))"
+
+definition mod_vec_int_oracle  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " mod_vec_int_oracle l r = (
+  (case  (mod_bv_int instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r) of
+      Some w => return w
+    | None => mword_oracle () 
+  ))"
+
+
+(*val quot_vec_int        : forall 'a. Size 'a => mword 'a -> integer -> mword 'a*)
+(*val quot_vec_int_maybe  : forall 'a. Size 'a => mword 'a -> integer -> maybe (mword 'a)*)
+(*val quot_vec_int_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e*)
+(*val quot_vec_int_oracle : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e*)
+definition quot_vec_int  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " quot_vec_int        l r = ( quot_mword_int l r )"
+
+definition quot_vec_int_maybe  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>(('a::len)Word.word)option "  where 
+     " quot_vec_int_maybe  l r = ( quot_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r )"
+
+definition quot_vec_int_fail  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quot_vec_int_fail   l r = ( maybe_fail (''quot_vec_int'') (quot_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r))"
+
+definition quot_vec_int_oracle  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('rv,(('a::len)Word.word),'e)monad "  where 
+     " quot_vec_int_oracle l r = (
+  (case  (quot_bv_int 
+  instance_Sail_values_Bitvector_Machine_word_mword_dict instance_Sail_values_Bitvector_Machine_word_mword_dict l r) of
+      Some w => return w
+    | None => mword_oracle () 
+  ))"
+
+
+(*val replicate_bits : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b*)
+definition replicate_bits  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " replicate_bits v count1 = ( Word.of_bl (repeat (Word.to_bl v) count1))"
+
+
+(*val duplicate_bool : forall 'a. Size 'a => bool -> integer -> mword 'a*)
+definition duplicate_bool  :: " bool \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " duplicate_bool   b n = ( Word.of_bl (repeat [b] n))"
+
+definition duplicate_maybe  :: " bitU \<Rightarrow> int \<Rightarrow>(('a::len)Word.word)option "  where 
+     " duplicate_maybe  b n = ( map_option (\<lambda> b .  duplicate_bool b n) (bool_of_bitU b))"
+
+definition duplicate_fail  :: " bitU \<Rightarrow> int \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " duplicate_fail   b n = ( bool_of_bitU_fail b \<bind> (\<lambda> b .  return (duplicate_bool b n)))"
+
+definition duplicate_oracle  :: " bitU \<Rightarrow> int \<Rightarrow>('c,(('a::len)Word.word),'b)monad "  where 
+     " duplicate_oracle b n = ( bool_of_bitU_oracle b \<bind> (\<lambda> b .  return (duplicate_bool b n)))"
+
+definition duplicate  :: " bitU \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " duplicate        b n = ( maybe_failwith (duplicate_maybe b n))"
+
+
+(*val reverse_endianness : forall 'a. Size 'a => mword 'a -> mword 'a*)
+definition reverse_endianness  :: "('a::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " reverse_endianness v = ( Word.of_bl (reverse_endianness_list (Word.to_bl v)))"
+
+
+(*val get_slice_int : forall 'a. Size 'a => integer -> integer -> integer -> mword 'a*)
+definition get_slice_int  :: " int \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('a::len)Word.word "  where 
+     " get_slice_int = ( 
+  get_slice_int_bv instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+(*val set_slice_int : forall 'a. Size 'a => integer -> integer -> integer -> mword 'a -> integer*)
+definition set_slice_int  :: " int \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('a::len)Word.word \<Rightarrow> int "  where 
+     " set_slice_int = ( 
+  set_slice_int_bv instance_Sail_values_Bitvector_Machine_word_mword_dict )"
+
+
+(*val slice : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b*)
+definition slice  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " slice v lo len = (
+  subrange_vec_dec v ((lo + len) -( 1 :: int)) lo )"
+
+
+(*val set_slice : forall 'a 'b. Size 'a, Size 'b => integer -> integer -> mword 'a -> integer -> mword 'b -> mword 'a*)
+definition set_slice  :: " int \<Rightarrow> int \<Rightarrow>('a::len)Word.word \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " set_slice (out_len::ii) (slice_len::ii) out (n::ii) v = (
+  update_subrange_vec_dec out ((n + slice_len) -( 1 :: int)) n v )"
+
+
+(*val eq_vec    : forall 'a. Size 'a => mword 'a -> mword 'a -> bool*)
+(*val neq_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> bool*)
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_operators_mwords_lemmas.thy b/snapshots/isabelle/lib/sail/Sail_operators_mwords_lemmas.thy
new file mode 100644
index 00000000..22c35e1f
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_operators_mwords_lemmas.thy
@@ -0,0 +1,112 @@
+theory "Sail_operators_mwords_lemmas"
+  imports Sail_operators_mwords
+begin
+
+lemmas uint_simps[simp] = uint_maybe_def uint_fail_def uint_oracle_def
+lemmas sint_simps[simp] = sint_maybe_def sint_fail_def sint_oracle_def
+
+lemma bools_of_bits_oracle_just_list[simp]:
+  assumes "just_list (map bool_of_bitU bus) = Some bs"
+  shows "bools_of_bits_oracle bus = return bs"
+proof -
+  have f: "foreachM bus bools (\<lambda>b bools. bool_of_bitU_oracle b \<bind> (\<lambda>b. return (bools @ [b]))) = return (bools @ bs)"
+    if "just_list (map bool_of_bitU bus) = Some bs" for bus bs bools
+  proof (use that in \<open>induction bus arbitrary: bs bools\<close>)
+    case (Cons bu bus bs)
+    obtain b bs' where bs: "bs = b # bs'" and bu: "bool_of_bitU bu = Some b"
+      using Cons.prems by (cases bu) (auto split: option.splits)
+    then show ?case
+      using Cons.prems Cons.IH[where bs = bs' and bools = "bools @ [b]"]
+      by (cases bu) (auto simp: bool_of_bitU_oracle_def split: option.splits)
+  qed auto
+  then show ?thesis using f[OF assms, of "[]"] unfolding bools_of_bits_oracle_def
+    by auto
+qed
+
+lemma of_bits_mword_return_of_bl[simp]:
+  assumes "just_list (map bool_of_bitU bus) = Some bs"
+  shows "of_bits_oracle BC_mword bus = return (of_bl bs)"
+    and "of_bits_fail BC_mword bus = return (of_bl bs)"
+  by (auto simp: of_bits_oracle_def of_bits_fail_def maybe_fail_def assms BC_mword_defs)
+
+lemma vec_of_bits_of_bl[simp]:
+  assumes "just_list (map bool_of_bitU bus) = Some bs"
+  shows "vec_of_bits_maybe bus = Some (of_bl bs)"
+    and "vec_of_bits_fail bus = return (of_bl bs)"
+    and "vec_of_bits_oracle bus = return (of_bl bs)"
+    and "vec_of_bits_failwith bus = of_bl bs"
+    and "vec_of_bits bus = of_bl bs"
+  unfolding vec_of_bits_maybe_def vec_of_bits_fail_def vec_of_bits_oracle_def
+            vec_of_bits_failwith_def vec_of_bits_def
+  by (auto simp: assms)
+
+lemmas access_vec_dec_test_bit[simp] = access_bv_dec_mword[folded access_vec_dec_def]
+
+lemma access_vec_inc_test_bit[simp]:
+  fixes w :: "('a::len) word"
+  assumes "n \<ge> 0" and "nat n < LENGTH('a)"
+  shows "access_vec_inc w n = bitU_of_bool (w !! (LENGTH('a) - 1 - nat n))"
+  using assms
+  by (auto simp: access_vec_inc_def access_bv_inc_def access_list_def BC_mword_defs rev_nth test_bit_bl)
+
+lemma bool_of_bitU_monadic_simps[simp]:
+  "bool_of_bitU_fail B0 = return False"
+  "bool_of_bitU_fail B1 = return True"
+  "bool_of_bitU_fail BU = Fail ''bool_of_bitU''"
+  "bool_of_bitU_oracle B0 = return False"
+  "bool_of_bitU_oracle B1 = return True"
+  "bool_of_bitU_oracle BU = undefined_bool ()"
+  unfolding bool_of_bitU_fail_def bool_of_bitU_oracle_def
+  by auto
+
+lemma update_vec_dec_simps[simp]:
+  "update_vec_dec_maybe w i B0 = Some (set_bit w (nat i) False)"
+  "update_vec_dec_maybe w i B1 = Some (set_bit w (nat i) True)"
+  "update_vec_dec_maybe w i BU = None"
+  "update_vec_dec_fail w i B0 = return (set_bit w (nat i) False)"
+  "update_vec_dec_fail w i B1 = return (set_bit w (nat i) True)"
+  "update_vec_dec_fail w i BU = Fail ''bool_of_bitU''"
+  "update_vec_dec_oracle w i B0 = return (set_bit w (nat i) False)"
+  "update_vec_dec_oracle w i B1 = return (set_bit w (nat i) True)"
+  "update_vec_dec_oracle w i BU = undefined_bool () \<bind> (\<lambda>b. return (set_bit w (nat i) b))"
+  "update_vec_dec w i B0 = set_bit w (nat i) False"
+  "update_vec_dec w i B1 = set_bit w (nat i) True"
+  unfolding update_vec_dec_maybe_def update_vec_dec_fail_def update_vec_dec_oracle_def update_vec_dec_def
+  by (auto simp: update_mword_dec_def update_mword_bool_dec_def maybe_failwith_def)
+
+lemma len_of_minus_One_minus_nonneg_lt_len_of[simp]:
+  "n \<ge> 0 \<Longrightarrow> nat (int LENGTH('a::len) - 1 - n) < LENGTH('a)"
+  by (metis diff_mono diff_zero len_gt_0 nat_eq_iff2 nat_less_iff order_refl zle_diff1_eq)
+
+declare extz_vec_def[simp]
+declare exts_vec_def[simp]
+declare concat_vec_def[simp]
+
+lemma msb_Bits_msb[simp]:
+  "msb w = bitU_of_bool (Bits.msb w)"
+  by (auto simp: msb_def most_significant_def BC_mword_defs word_msb_alt split: list.splits)
+
+declare and_vec_def[simp]
+declare or_vec_def[simp]
+declare xor_vec_def[simp]
+declare not_vec_def[simp]
+
+lemma arith_vec_simps[simp]:
+  "add_vec l r = l + r"
+  "sub_vec l r = l - r"
+  "mult_vec l r = (ucast l) * (ucast r)"
+  unfolding add_vec_def sub_vec_def mult_vec_def
+  by (auto simp: int_of_mword_def word_add_def word_sub_wi word_mult_def)
+
+declare adds_vec_def[simp]
+declare subs_vec_def[simp]
+declare mults_vec_def[simp]
+
+lemma arith_vec_int_simps[simp]:
+  "add_vec_int l r = l + (word_of_int r)"
+  "sub_vec_int l r = l - (word_of_int r)"
+  "mult_vec_int l r = (ucast l) * (word_of_int r)"
+  unfolding add_vec_int_def sub_vec_int_def mult_vec_int_def
+  by (auto simp: arith_op_bv_int_def BC_mword_defs word_add_def word_sub_wi word_mult_def)
+
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_values.thy b/snapshots/isabelle/lib/sail/Sail_values.thy
new file mode 100644
index 00000000..7338ac40
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_values.thy
@@ -0,0 +1,1215 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/sail_values.lem.\<close>
+
+theory "Sail_values" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Lem_machine_word" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Machine_word*)
+(*open import Sail_impl_base*)
+
+
+type_synonym ii =" int "
+type_synonym nn =" nat "
+
+(*val nat_of_int : integer -> nat*)
+definition nat_of_int  :: " int \<Rightarrow> nat "  where 
+     " nat_of_int i = ( if i <( 0 :: int) then( 0 :: nat) else nat (abs ( i)))"
+
+
+(*val pow : integer -> integer -> integer*)
+definition pow  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
+     " pow m n = ( m ^ (nat_of_int n))"
+
+
+definition pow2  :: " int \<Rightarrow> int "  where 
+     " pow2 n = ( pow(( 2 :: int)) n )"
+
+
+(*val eq : forall 'a. Eq 'a => 'a -> 'a -> bool*)
+
+(*val neq : forall 'a. Eq 'a => 'a -> 'a -> bool*)
+
+(*let add_int l r = integerAdd l r
+let add_signed l r = integerAdd l r
+let sub_int l r = integerMinus l r
+let mult_int l r = integerMult l r
+let div_int l r = integerDiv l r
+let div_nat l r = natDiv l r
+let power_int_nat l r = integerPow l r
+let power_int_int l r = integerPow l (nat_of_int r)
+let negate_int i = integerNegate i
+let min_int l r = integerMin l r
+let max_int l r = integerMax l r
+
+let add_real l r = realAdd l r
+let sub_real l r = realMinus l r
+let mult_real l r = realMult l r
+let div_real l r = realDiv l r
+let negate_real r = realNegate r
+let abs_real r = realAbs r
+let power_real b e = realPowInteger b e*)
+
+(*val prerr_endline : string -> unit*)
+definition prerr_endline  :: " string \<Rightarrow> unit "  where 
+     " prerr_endline _ = ( ()  )"
+
+
+(*val print_int : string -> integer -> unit*)
+definition print_int  :: " string \<Rightarrow> int \<Rightarrow> unit "  where 
+     " print_int msg i = ( prerr_endline (msg @ (stringFromInteger i)))"
+
+
+(*val putchar : integer -> unit*)
+definition putchar  :: " int \<Rightarrow> unit "  where 
+     " putchar _ = ( ()  )"
+
+
+(*val shr_int : ii -> ii -> ii*)
+function (sequential,domintros)  shr_int  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
+     " shr_int x s = ( if s >( 0 :: int) then shr_int (x div( 2 :: int)) (s -( 1 :: int)) else x )" 
+by pat_completeness auto
+
+
+(*val shl_int : integer -> integer -> integer*)
+function (sequential,domintros)  shl_int  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
+     " shl_int i shift = ( if shift >( 0 :: int) then( 2 :: int) * shl_int i (shift -( 1 :: int)) else i )" 
+by pat_completeness auto
+
+definition take_list  :: " int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " take_list n xs = ( List.take (nat_of_int n) xs )"
+
+definition drop_list  :: " int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " drop_list n xs = ( List.drop (nat_of_int n) xs )"
+
+
+(*val repeat : forall 'a. list 'a -> integer -> list 'a*)
+fun  repeat  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " repeat xs n = (
+  if n \<le>( 0 :: int) then []
+  else xs @ repeat xs (n-( 1 :: int)))"
+
+
+definition duplicate_to_list  :: " 'a \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " duplicate_to_list bit length1 = ( repeat [bit] length1 )"
+
+
+fun  replace  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a list "  where 
+     " replace ([]) (n :: int) b' = ( [])"
+|" replace (b # bs) (n :: int) b' = (
+     if n =( 0 :: int) then b' # bs
+              else b # replace bs (n -( 1 :: int)) b' )"
+
+
+definition upper  :: " 'a \<Rightarrow> 'a "  where 
+     " upper n = ( n )"
+
+
+(* Modulus operation corresponding to quot below -- result
+   has sign of dividend. *)
+definition hardware_mod  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
+     " hardware_mod (a:: int) (b::int) = (
+  (let m = ((abs a) mod (abs b)) in
+  if a <( 0 :: int) then - m else m))"
+
+
+(* There are different possible answers for integer divide regarding
+rounding behaviour on negative operands. Positive operands always
+round down so derive the one we want (trucation towards zero) from
+that *)
+definition hardware_quot  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
+     " hardware_quot (a::int) (b::int) = (
+  (let q = ((abs a) div (abs b)) in
+  if ((a<( 0 :: int)) \<longleftrightarrow> (b<( 0 :: int))) then
+    q  (* same sign -- result positive *)
+  else
+    - q))"
+ (* different sign -- result negative *)
+
+definition max_64u  :: " int "  where 
+     " max_64u = ( ((( 2 :: int))^(( 64 :: nat))) -( 1 :: int))"
+
+definition max_64  :: " int "   where 
+     " max_64  = ( ((( 2 :: int))^(( 63 :: nat))) -( 1 :: int))"
+
+definition min_64  :: " int "   where 
+     " min_64  = (( 0 :: int) - ((( 2 :: int))^(( 63 :: nat))))"
+
+definition max_32u  :: " int "  where 
+     " max_32u = ( (( 4294967295 :: int) :: int))"
+
+definition max_32  :: " int "   where 
+     " max_32  = ( (( 2147483647 :: int) :: int))"
+
+definition min_32  :: " int "   where 
+     " min_32  = ( (( 0 :: int) -( 2147483648 :: int) :: int))"
+
+definition max_8  :: " int "    where 
+     " max_8   = ( (( 127 :: int) :: int))"
+
+definition min_8  :: " int "    where 
+     " min_8   = ( (( 0 :: int) -( 128 :: int) :: int))"
+
+definition max_5  :: " int "    where 
+     " max_5   = ( (( 31 :: int) :: int))"
+
+definition min_5  :: " int "    where 
+     " min_5   = ( (( 0 :: int) -( 32 :: int) :: int))"
+
+
+(* just_list takes a list of maybes and returns Just xs if all elements have
+   a value, and Nothing if one of the elements is Nothing. *)
+(*val just_list : forall 'a. list (maybe 'a) -> maybe (list 'a)*)
+fun  just_list  :: "('a option)list \<Rightarrow>('a list)option "  where 
+     " just_list ([]) = ( Some [])"
+|" just_list (x # xs) = (
+    (case  (x, just_list xs) of
+        (Some x, Some xs) => Some (x # xs)
+      | (_, _) => None
+    ))"
+
+
+(*val maybe_failwith : forall 'a. maybe 'a -> 'a*)
+definition maybe_failwith  :: " 'a option \<Rightarrow> 'a "  where 
+     " maybe_failwith = ( \<lambda>x .  
+  (case  x of   Some a => a | None => failwith (''maybe_failwith'') ) )"
+
+
+(*** Bits *)
+datatype bitU = B0 | B1 | BU
+
+definition showBitU  :: " bitU \<Rightarrow> string "  where 
+     " showBitU = ( \<lambda>x .  
+  (case  x of   B0 => (''O'') | B1 => (''I'') | BU => (''U'') ) )"
+
+
+definition bitU_char  :: " bitU \<Rightarrow> char "  where 
+     " bitU_char = ( \<lambda>x .  
+  (case  x of   B0 => (CHR ''0'') | B1 => (CHR ''1'') | BU => (CHR ''?'') ) )"
+
+
+definition instance_Show_Show_Sail_values_bitU_dict  :: "(bitU)Show_class "  where 
+     " instance_Show_Show_Sail_values_bitU_dict = ((|
+
+  show_method = showBitU |) )"
+
+
+(*val compare_bitU : bitU -> bitU -> ordering*)
+fun compare_bitU  :: " bitU \<Rightarrow> bitU \<Rightarrow> ordering "  where 
+     " compare_bitU BU BU = ( EQ )"
+|" compare_bitU B0 B0 = ( EQ )"
+|" compare_bitU B1 B1 = ( EQ )"
+|" compare_bitU BU _ = ( LT )"
+|" compare_bitU _ BU = ( GT )"
+|" compare_bitU B0 _ = ( LT )"
+|" compare_bitU _ _ = ( GT )"
+
+
+definition instance_Basic_classes_Ord_Sail_values_bitU_dict  :: "(bitU)Ord_class "  where 
+     " instance_Basic_classes_Ord_Sail_values_bitU_dict = ((|
+
+  compare_method = compare_bitU,
+
+  isLess_method = (\<lambda>  l r. (compare_bitU l r) = LT),
+
+  isLessEqual_method = (\<lambda> l r. (compare_bitU l r) \<noteq> GT),
+
+  isGreater_method = (\<lambda>  l r. (compare_bitU l r) = GT),
+
+  isGreaterEqual_method = (\<lambda> l r. (compare_bitU l r) \<noteq> LT)|) )"
+
+
+record 'a BitU_class=
+
+  to_bitU_method ::" 'a \<Rightarrow> bitU " 
+
+  of_bitU_method ::" bitU \<Rightarrow> 'a "
+
+
+
+definition instance_Sail_values_BitU_Sail_values_bitU_dict  :: "(bitU)BitU_class "  where 
+     " instance_Sail_values_BitU_Sail_values_bitU_dict = ((|
+
+  to_bitU_method = (\<lambda> b. b),
+
+  of_bitU_method = (\<lambda> b. b)|) )"
+
+
+definition bool_of_bitU  :: " bitU \<Rightarrow>(bool)option "  where 
+     " bool_of_bitU = ( \<lambda>x .  
+  (case  x of   B0 => Some False | B1 => Some True | BU => None ) )"
+
+
+definition bitU_of_bool  :: " bool \<Rightarrow> bitU "  where 
+     " bitU_of_bool b = ( if b then B1 else B0 )"
+
+
+(*instance (BitU bool)
+  let to_bitU = bitU_of_bool
+  let of_bitU = bool_of_bitU
+end*)
+
+definition cast_bit_bool  :: " bitU \<Rightarrow>(bool)option "  where 
+     " cast_bit_bool = ( bool_of_bitU )"
+
+
+definition not_bit  :: " bitU \<Rightarrow> bitU "  where 
+     " not_bit = ( \<lambda>x .  
+  (case  x of   B1 => B0 | B0 => B1 | BU => BU ) )"
+
+
+(*val is_one : integer -> bitU*)
+definition is_one  :: " int \<Rightarrow> bitU "  where 
+     " is_one i = (
+  if i =( 1 :: int) then B1 else B0 )"
+
+
+(*val and_bit : bitU -> bitU -> bitU*)
+fun and_bit  :: " bitU \<Rightarrow> bitU \<Rightarrow> bitU "  where 
+     " and_bit B0 _ = ( B0 )"
+|" and_bit _ B0 = ( B0 )"
+|" and_bit B1 B1 = ( B1 )"
+|" and_bit _ _ = ( BU )"
+
+
+(*val or_bit : bitU -> bitU -> bitU*)
+fun or_bit  :: " bitU \<Rightarrow> bitU \<Rightarrow> bitU "  where 
+     " or_bit B1 _ = ( B1 )"
+|" or_bit _ B1 = ( B1 )"
+|" or_bit B0 B0 = ( B0 )"
+|" or_bit _ _ = ( BU )"
+
+
+(*val xor_bit : bitU -> bitU -> bitU*)
+fun xor_bit  :: " bitU \<Rightarrow> bitU \<Rightarrow> bitU "  where 
+     " xor_bit B0 B0 = ( B0 )"
+|" xor_bit B0 B1 = ( B1 )"
+|" xor_bit B1 B0 = ( B1 )"
+|" xor_bit B1 B1 = ( B0 )"
+|" xor_bit _ _ = ( BU )"
+
+
+(*val &. : bitU -> bitU -> bitU*)
+
+(*val |. : bitU -> bitU -> bitU*)
+
+(*val +. : bitU -> bitU -> bitU*)
+
+
+(*** Bool lists ***)
+
+(*val bools_of_nat_aux : integer -> natural -> list bool -> list bool*)
+fun  bools_of_nat_aux  :: " int \<Rightarrow> nat \<Rightarrow>(bool)list \<Rightarrow>(bool)list "  where 
+     " bools_of_nat_aux len x acc1 = (
+  if len \<le>( 0 :: int) then acc1
+  else bools_of_nat_aux (len -( 1 :: int)) (x div( 2 :: nat)) ((if (x mod( 2 :: nat)) =( 1 :: nat) then True else False) # acc1))"
+
+definition bools_of_nat  :: " int \<Rightarrow> nat \<Rightarrow>(bool)list "  where 
+     " bools_of_nat len n = ( bools_of_nat_aux len n [])"
+ (*List.reverse (bools_of_nat_aux n)*)
+
+(*val nat_of_bools_aux : natural -> list bool -> natural*)
+fun  nat_of_bools_aux  :: " nat \<Rightarrow>(bool)list \<Rightarrow> nat "  where 
+     " nat_of_bools_aux acc1 ([]) = ( acc1 )"
+|" nat_of_bools_aux acc1 (True # bs) = ( nat_of_bools_aux ((( 2 :: nat) * acc1) +( 1 :: nat)) bs )"
+|" nat_of_bools_aux acc1 (False # bs) = ( nat_of_bools_aux (( 2 :: nat) * acc1) bs )"
+
+definition nat_of_bools  :: "(bool)list \<Rightarrow> nat "  where 
+     " nat_of_bools bs = ( nat_of_bools_aux(( 0 :: nat)) bs )"
+
+
+(*val unsigned_of_bools : list bool -> integer*)
+definition unsigned_of_bools  :: "(bool)list \<Rightarrow> int "  where 
+     " unsigned_of_bools bs = ( int (nat_of_bools bs))"
+
+
+(*val signed_of_bools : list bool -> integer*)
+definition signed_of_bools  :: "(bool)list \<Rightarrow> int "  where 
+     " signed_of_bools bs = (
+  (case  bs of
+      True # _  =>( 0 :: int) - (( 1 :: int) + (unsigned_of_bools (List.map (\<lambda> x. \<not> x) bs)))
+    | False # _ => unsigned_of_bools bs
+    | [] =>( 0 :: int) (* Treat empty list as all zeros *)
+  ))"
+
+
+(*val int_of_bools : bool -> list bool -> integer*)
+definition int_of_bools  :: " bool \<Rightarrow>(bool)list \<Rightarrow> int "  where 
+     " int_of_bools sign bs = ( if sign then signed_of_bools bs else unsigned_of_bools bs )"
+
+
+(*val pad_list : forall 'a. 'a -> list 'a -> integer -> list 'a*)
+fun  pad_list  :: " 'a \<Rightarrow> 'a list \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " pad_list x xs n = (
+  if n \<le>( 0 :: int) then xs else pad_list x (x # xs) (n -( 1 :: int)))"
+
+
+definition ext_list  :: " 'a \<Rightarrow> int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " ext_list pad len xs = (
+  (let longer = (len - (int (List.length xs))) in
+  if longer <( 0 :: int) then List.drop (nat_of_int (abs (longer))) xs
+  else pad_list pad xs longer))"
+
+
+definition extz_bools  :: " int \<Rightarrow>(bool)list \<Rightarrow>(bool)list "  where 
+     " extz_bools len bs = ( ext_list False len bs )"
+
+definition exts_bools  :: " int \<Rightarrow>(bool)list \<Rightarrow>(bool)list "  where 
+     " exts_bools len bs = (
+  (case  bs of
+      True # _ => ext_list True len bs
+    | _ => ext_list False len bs
+  ))"
+
+
+fun  add_one_bool_ignore_overflow_aux  :: "(bool)list \<Rightarrow>(bool)list "  where 
+     " add_one_bool_ignore_overflow_aux ([]) = ( [])"
+|" add_one_bool_ignore_overflow_aux (False # bits) = ( True # bits )"
+|" add_one_bool_ignore_overflow_aux (True # bits) = ( False # add_one_bool_ignore_overflow_aux bits )"
+
+
+definition add_one_bool_ignore_overflow  :: "(bool)list \<Rightarrow>(bool)list "  where 
+     " add_one_bool_ignore_overflow bits = (
+  List.rev (add_one_bool_ignore_overflow_aux (List.rev bits)))"
+
+
+(*let bool_list_of_int n =
+  let bs_abs = false :: bools_of_nat (naturalFromInteger (abs n)) in
+  if n >= (0 : integer) then bs_abs
+  else add_one_bool_ignore_overflow (List.map not bs_abs)
+let bools_of_int len n = exts_bools len (bool_list_of_int n)*)
+definition bools_of_int  :: " int \<Rightarrow> int \<Rightarrow>(bool)list "  where 
+     " bools_of_int len n = (
+  (let bs_abs = (bools_of_nat len (nat (abs (abs n)))) in
+  if n \<ge> (( 0 :: int) :: int) then bs_abs
+  else add_one_bool_ignore_overflow (List.map (\<lambda> x. \<not> x) bs_abs)))"
+
+
+(*** Bit lists ***)
+
+(*val has_undefined_bits : list bitU -> bool*)
+definition has_undefined_bits  :: "(bitU)list \<Rightarrow> bool "  where 
+     " has_undefined_bits bs = ( ((\<exists> x \<in> (set bs).  (\<lambda>x .  
+  (case  x of BU => True | _ => False )) x)))"
+
+
+definition bits_of_nat  :: " int \<Rightarrow> nat \<Rightarrow>(bitU)list "  where 
+     " bits_of_nat len n = ( List.map bitU_of_bool (bools_of_nat len n))"
+
+
+definition nat_of_bits  :: "(bitU)list \<Rightarrow>(nat)option "  where 
+     " nat_of_bits bits = (
+  (case  (just_list (List.map bool_of_bitU bits)) of
+      Some bs => Some (nat_of_bools bs)
+    | None => None
+  ))"
+
+
+definition not_bits  :: "(bitU)list \<Rightarrow>(bitU)list "  where 
+     " not_bits = ( List.map not_bit )"
+
+
+(*val binop_list : forall 'a. ('a -> 'a -> 'a) -> list 'a -> list 'a -> list 'a*)
+definition binop_list  :: "('a \<Rightarrow> 'a \<Rightarrow> 'a)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " binop_list op1 xs ys = (
+  List.foldr ( \<lambda>x .  
+  (case  x of (x, y) => \<lambda> acc1 .  op1 x y # acc1 )) (List.zip xs ys) [])"
+
+
+definition unsigned_of_bits  :: "(bitU)list \<Rightarrow>(int)option "  where 
+     " unsigned_of_bits bits = (
+  (case  (just_list (List.map bool_of_bitU bits)) of
+      Some bs => Some (unsigned_of_bools bs)
+    | None => None
+  ))"
+
+
+definition signed_of_bits  :: "(bitU)list \<Rightarrow>(int)option "  where 
+     " signed_of_bits bits = (
+  (case  (just_list (List.map bool_of_bitU bits)) of
+      Some bs => Some (signed_of_bools bs)
+    | None => None
+  ))"
+
+
+(*val int_of_bits : bool -> list bitU -> maybe integer*)
+definition int_of_bits  :: " bool \<Rightarrow>(bitU)list \<Rightarrow>(int)option "  where 
+     " int_of_bits sign bs = ( if sign then signed_of_bits bs else unsigned_of_bits bs )"
+
+
+definition extz_bits  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " extz_bits len bits = ( ext_list B0 len bits )"
+
+definition exts_bits  :: " int \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " exts_bits len bits = (
+  (case  bits of
+    BU # _ => ext_list BU len bits
+  | B1 # _ => ext_list B1 len bits
+  | _ => ext_list B0 len bits
+  ))"
+
+
+fun  add_one_bit_ignore_overflow_aux  :: "(bitU)list \<Rightarrow>(bitU)list "  where 
+     " add_one_bit_ignore_overflow_aux ([]) = ( [])"
+|" add_one_bit_ignore_overflow_aux (B0 # bits) = ( B1 # bits )"
+|" add_one_bit_ignore_overflow_aux (B1 # bits) = ( B0 # add_one_bit_ignore_overflow_aux bits )"
+|" add_one_bit_ignore_overflow_aux (BU # bits) = ( BU # List.map ( \<lambda>x .  
+  (case  x of _ => BU )) bits )"
+
+
+definition add_one_bit_ignore_overflow  :: "(bitU)list \<Rightarrow>(bitU)list "  where 
+     " add_one_bit_ignore_overflow bits = (
+  List.rev (add_one_bit_ignore_overflow_aux (List.rev bits)))"
+
+
+(*let bit_list_of_int n = List.map bitU_of_bool (bool_list_of_int n)
+let bits_of_int len n = exts_bits len (bit_list_of_int n)*)
+definition bits_of_int  :: " int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " bits_of_int len n = ( List.map bitU_of_bool (bools_of_int len n))"
+
+
+(*val arith_op_bits :
+  (integer -> integer -> integer) -> bool -> list bitU -> list bitU -> list bitU*)
+definition arith_op_bits  :: "(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bool \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list \<Rightarrow>(bitU)list "  where 
+     " arith_op_bits op1 sign l r = (
+  (case  (int_of_bits sign l, int_of_bits sign r) of
+      (Some li, Some ri) => bits_of_int (int (List.length l)) (op1 li ri)
+    | (_, _) => repeat [BU] (int (List.length l))
+  ))"
+
+
+definition char_of_nibble  :: " bitU*bitU*bitU*bitU \<Rightarrow>(char)option "  where 
+     " char_of_nibble = ( \<lambda>x .  
+  (case  x of
+        (B0, B0, B0, B0) => Some (CHR ''0'')
+    | (B0, B0, B0, B1) => Some (CHR ''1'')
+    | (B0, B0, B1, B0) => Some (CHR ''2'')
+    | (B0, B0, B1, B1) => Some (CHR ''3'')
+    | (B0, B1, B0, B0) => Some (CHR ''4'')
+    | (B0, B1, B0, B1) => Some (CHR ''5'')
+    | (B0, B1, B1, B0) => Some (CHR ''6'')
+    | (B0, B1, B1, B1) => Some (CHR ''7'')
+    | (B1, B0, B0, B0) => Some (CHR ''8'')
+    | (B1, B0, B0, B1) => Some (CHR ''9'')
+    | (B1, B0, B1, B0) => Some (CHR ''A'')
+    | (B1, B0, B1, B1) => Some (CHR ''B'')
+    | (B1, B1, B0, B0) => Some (CHR ''C'')
+    | (B1, B1, B0, B1) => Some (CHR ''D'')
+    | (B1, B1, B1, B0) => Some (CHR ''E'')
+    | (B1, B1, B1, B1) => Some (CHR ''F'')
+    | _ => None
+  ) )"
+
+
+fun  hexstring_of_bits  :: "(bitU)list \<Rightarrow>((char)list)option "  where 
+     " hexstring_of_bits (b1 # b2 # b3 # b4 # bs) = (
+     (let n = (char_of_nibble (b1, b2, b3, b4)) in
+     (let s = (hexstring_of_bits bs) in
+     (case  (n, s) of
+       (Some n, Some s) => Some (n # s)
+     | _ => None
+     ))))"
+|" hexstring_of_bits ([]) = ( Some [])"
+|" hexstring_of_bits _ = ( None )"
+
+
+definition show_bitlist  :: "(bitU)list \<Rightarrow> string "  where 
+     " show_bitlist bs = (
+  (case  hexstring_of_bits bs of
+    Some s => ((CHR ''0'') # ((CHR ''x'') # s))
+  | None => ((CHR ''0'') # ((CHR ''b'') # List.map bitU_char bs))
+  ))"
+
+
+(*val subrange_list_inc : forall 'a. list 'a -> integer -> integer -> list 'a*)
+definition subrange_list_inc  :: " 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " subrange_list_inc xs i j = (
+  (let (toJ,suffix0) = (split_at (nat_of_int (j +( 1 :: int))) xs) in
+  (let (prefix0,fromItoJ) = (split_at (nat_of_int i) toJ) in
+  fromItoJ)))"
+
+
+(*val subrange_list_dec : forall 'a. list 'a -> integer -> integer -> list 'a*)
+definition subrange_list_dec  :: " 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " subrange_list_dec xs i j = (
+  (let top1 = ((int (List.length xs)) -( 1 :: int)) in
+  subrange_list_inc xs (top1 - i) (top1 - j)))"
+
+
+(*val subrange_list : forall 'a. bool -> list 'a -> integer -> integer -> list 'a*)
+definition subrange_list  :: " bool \<Rightarrow> 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list "  where 
+     " subrange_list is_inc xs i j = ( if is_inc then subrange_list_inc xs i j else subrange_list_dec xs i j )"
+
+
+(*val update_subrange_list_inc : forall 'a. list 'a -> integer -> integer -> list 'a -> list 'a*)
+definition update_subrange_list_inc  :: " 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " update_subrange_list_inc xs i j xs' = (
+  (let (toJ,suffix) = (split_at (nat_of_int (j +( 1 :: int))) xs) in
+  (let (prefix,fromItoJ0) = (split_at (nat_of_int i) toJ) in
+  (prefix @ xs') @ suffix)))"
+
+
+(*val update_subrange_list_dec : forall 'a. list 'a -> integer -> integer -> list 'a -> list 'a*)
+definition update_subrange_list_dec  :: " 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " update_subrange_list_dec xs i j xs' = (
+  (let top1 = ((int (List.length xs)) -( 1 :: int)) in
+  update_subrange_list_inc xs (top1 - i) (top1 - j) xs'))"
+
+
+(*val update_subrange_list : forall 'a. bool -> list 'a -> integer -> integer -> list 'a -> list 'a*)
+definition update_subrange_list  :: " bool \<Rightarrow> 'a list \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
+     " update_subrange_list is_inc xs i j xs' = (
+  if is_inc then update_subrange_list_inc xs i j xs' else update_subrange_list_dec xs i j xs' )"
+
+
+(*val access_list_inc : forall 'a. list 'a -> integer -> 'a*)
+definition access_list_inc  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a "  where 
+     " access_list_inc xs n = ( List.nth xs (nat_of_int n))"
+
+
+(*val access_list_dec : forall 'a. list 'a -> integer -> 'a*)
+definition access_list_dec  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a "  where 
+     " access_list_dec xs n = (
+  (let top1 = ((int (List.length xs)) -( 1 :: int)) in
+  access_list_inc xs (top1 - n)))"
+
+
+(*val access_list : forall 'a. bool -> list 'a -> integer -> 'a*)
+definition access_list  :: " bool \<Rightarrow> 'a list \<Rightarrow> int \<Rightarrow> 'a "  where 
+     " access_list is_inc xs n = (
+  if is_inc then access_list_inc xs n else access_list_dec xs n )"
+
+
+(*val update_list_inc : forall 'a. list 'a -> integer -> 'a -> list 'a*)
+definition update_list_inc  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a list "  where 
+     " update_list_inc xs n x = ( List.list_update xs (nat_of_int n) x )"
+
+
+(*val update_list_dec : forall 'a. list 'a -> integer -> 'a -> list 'a*)
+definition update_list_dec  :: " 'a list \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a list "  where 
+     " update_list_dec xs n x = (
+  (let top1 = ((int (List.length xs)) -( 1 :: int)) in
+  update_list_inc xs (top1 - n) x))"
+
+
+(*val update_list : forall 'a. bool -> list 'a -> integer -> 'a -> list 'a*)
+definition update_list  :: " bool \<Rightarrow> 'a list \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow> 'a list "  where 
+     " update_list is_inc xs n x = (
+  if is_inc then update_list_inc xs n x else update_list_dec xs n x )"
+
+
+definition extract_only_bit  :: "(bitU)list \<Rightarrow> bitU "  where 
+     " extract_only_bit = ( \<lambda>x .  
+  (case  x of   [] => BU | [e] => e | _ => BU ) )"
+
+
+(*** Machine words *)
+
+(*val length_mword : forall 'a. mword 'a -> integer*)
+
+(*val slice_mword_dec : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b*)
+definition slice_mword_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " slice_mword_dec w i j = ( Word.slice (nat_of_int i) w )"
+
+
+(*val slice_mword_inc : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b*)
+definition slice_mword_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " slice_mword_inc w i j = (
+  (let top1 = ((int (size w)) -( 1 :: int)) in
+  slice_mword_dec w (top1 - i) (top1 - j)))"
+
+
+(*val slice_mword : forall 'a 'b. bool -> mword 'a -> integer -> integer -> mword 'b*)
+definition slice_mword  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word "  where 
+     " slice_mword is_inc w i j = ( if is_inc then slice_mword_inc w i j else slice_mword_dec w i j )"
+
+
+(*val update_slice_mword_dec : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b -> mword 'a*)
+definition update_slice_mword_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " update_slice_mword_dec w i j w' = ( Lem.word_update w (nat_of_int i) (nat_of_int j) w' )"
+
+
+(*val update_slice_mword_inc : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b -> mword 'a*)
+definition update_slice_mword_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " update_slice_mword_inc w i j w' = (
+  (let top1 = ((int (size w)) -( 1 :: int)) in
+  update_slice_mword_dec w (top1 - i) (top1 - j) w'))"
+
+
+(*val update_slice_mword : forall 'a 'b. bool -> mword 'a -> integer -> integer -> mword 'b -> mword 'a*)
+definition update_slice_mword  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow> int \<Rightarrow> int \<Rightarrow>('b::len)Word.word \<Rightarrow>('a::len)Word.word "  where 
+     " update_slice_mword is_inc w i j w' = (
+  if is_inc then update_slice_mword_inc w i j w' else update_slice_mword_dec w i j w' )"
+
+
+(*val access_mword_dec : forall 'a. mword 'a -> integer -> bitU*)
+definition access_mword_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_mword_dec w n = ( bitU_of_bool (Bits.test_bit w (nat_of_int n)))"
+
+
+(*val access_mword_inc : forall 'a. mword 'a -> integer -> bitU*)
+definition access_mword_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_mword_inc w n = (
+  (let top1 = ((int (size w)) -( 1 :: int)) in
+  access_mword_dec w (top1 - n)))"
+
+
+(*val access_mword : forall 'a. bool -> mword 'a -> integer -> bitU*)
+definition access_mword  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_mword is_inc w n = (
+  if is_inc then access_mword_inc w n else access_mword_dec w n )"
+
+
+(*val update_mword_bool_dec : forall 'a. mword 'a -> integer -> bool -> mword 'a*)
+definition update_mword_bool_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " update_mword_bool_dec w n b = ( Bits.set_bit w (nat_of_int n) b )"
+
+definition update_mword_dec  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " update_mword_dec w n b = ( map_option (update_mword_bool_dec w n) (bool_of_bitU b))"
+
+
+(*val update_mword_bool_inc : forall 'a. mword 'a -> integer -> bool -> mword 'a*)
+definition update_mword_bool_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bool \<Rightarrow>('a::len)Word.word "  where 
+     " update_mword_bool_inc w n b = (
+  (let top1 = ((int (size w)) -( 1 :: int)) in
+  update_mword_bool_dec w (top1 - n) b))"
+
+definition update_mword_inc  :: "('a::len)Word.word \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(('a::len)Word.word)option "  where 
+     " update_mword_inc w n b = ( map_option (update_mword_bool_inc w n) (bool_of_bitU b))"
+
+
+(*val int_of_mword : forall 'a. bool -> mword 'a -> integer*)
+definition int_of_mword  :: " bool \<Rightarrow>('a::len)Word.word \<Rightarrow> int "  where 
+     " int_of_mword sign w = (
+  if sign then Word.sint w else Word.uint w )"
+
+
+(* Translating between a type level number (itself 'n) and an integer *)
+
+definition size_itself_int  :: "('a::len)itself \<Rightarrow> int "  where 
+     " size_itself_int x = ( int (size_itself x))"
+
+
+(* NB: the corresponding sail type is forall 'n. atom('n) -> itself('n),
+   the actual integer is ignored. *)
+
+(*val make_the_value : forall 'n. integer -> itself 'n*)
+definition make_the_value  :: " int \<Rightarrow>('n::len)itself "  where 
+     " make_the_value _ = ( TYPE(_) )"
+
+
+(*** Bitvectors *)
+
+record 'a Bitvector_class=
+
+  bits_of_method ::" 'a \<Rightarrow> bitU list " 
+
+  (* We allow of_bits to be partial, as not all bitvector representations
+     support undefined bits *)
+  of_bits_method ::" bitU list \<Rightarrow>  'a option " 
+
+  of_bools_method ::" bool list \<Rightarrow> 'a " 
+
+  length_method ::" 'a \<Rightarrow> int " 
+
+  (* of_int: the first parameter specifies the desired length of the bitvector *)
+  of_int_method ::" int \<Rightarrow> int \<Rightarrow> 'a " 
+
+  (* Conversion to integers is undefined if any bit is undefined *)
+  unsigned_method ::" 'a \<Rightarrow>  int option " 
+
+  signed_method ::" 'a \<Rightarrow>  int option " 
+
+  (* Lifting of integer operations to bitvectors:  The boolean flag indicates
+     whether to treat the bitvectors as signed (true) or not (false). *)
+  arith_op_bv_method ::" (int \<Rightarrow> int \<Rightarrow> int) \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a "
+
+
+
+(*val of_bits_failwith : forall 'a. Bitvector 'a => list bitU -> 'a*)
+definition of_bits_failwith  :: " 'a Bitvector_class \<Rightarrow>(bitU)list \<Rightarrow> 'a "  where 
+     " of_bits_failwith dict_Sail_values_Bitvector_a bits = ( maybe_failwith (
+  (of_bits_method   dict_Sail_values_Bitvector_a) bits))"
+
+
+definition int_of_bv  :: " 'a Bitvector_class \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow>(int)option "  where 
+     " int_of_bv dict_Sail_values_Bitvector_a sign = ( if sign then 
+  (signed_method   dict_Sail_values_Bitvector_a) else (unsigned_method   dict_Sail_values_Bitvector_a) )"
+
+
+definition instance_Sail_values_Bitvector_list_dict  :: " 'a BitU_class \<Rightarrow>('a list)Bitvector_class "  where 
+     " instance_Sail_values_Bitvector_list_dict dict_Sail_values_BitU_a = ((|
+
+  bits_of_method = (\<lambda> v. List.map 
+  (to_bitU_method   dict_Sail_values_BitU_a) v),
+
+  of_bits_method = (\<lambda> v. Some (List.map 
+  (of_bitU_method   dict_Sail_values_BitU_a) v)),
+
+  of_bools_method = (\<lambda> v. List.map 
+  (of_bitU_method   dict_Sail_values_BitU_a) (List.map bitU_of_bool v)),
+
+  length_method = (\<lambda> xs. int (List.length xs)),
+
+  of_int_method = (\<lambda> len n. List.map 
+  (of_bitU_method   dict_Sail_values_BitU_a) (bits_of_int len n)),
+
+  unsigned_method = (\<lambda> v. unsigned_of_bits (List.map 
+  (to_bitU_method   dict_Sail_values_BitU_a) v)),
+
+  signed_method = (\<lambda> v. signed_of_bits (List.map 
+  (to_bitU_method   dict_Sail_values_BitU_a) v)),
+
+  arith_op_bv_method = (\<lambda> op1 sign l r. List.map 
+  (of_bitU_method   dict_Sail_values_BitU_a) (arith_op_bits op1 sign (List.map 
+  (to_bitU_method   dict_Sail_values_BitU_a) l) (List.map (to_bitU_method   dict_Sail_values_BitU_a) r)))|) )"
+
+
+definition instance_Sail_values_Bitvector_Machine_word_mword_dict  :: "(('a::len)Word.word)Bitvector_class "  where 
+     " instance_Sail_values_Bitvector_Machine_word_mword_dict = ((|
+
+  bits_of_method = (\<lambda> v. List.map bitU_of_bool (Word.to_bl v)),
+
+  of_bits_method = (\<lambda> v. map_option Word.of_bl (just_list (List.map bool_of_bitU v))),
+
+  of_bools_method = (\<lambda> v. Word.of_bl v),
+
+  length_method = (\<lambda> v. int (size v)),
+
+  of_int_method = ( \<lambda>x .  
+  (case  x of _ => \<lambda> n .  Word.word_of_int n )),
+
+  unsigned_method = (\<lambda> v. Some (Word.uint v)),
+
+  signed_method = (\<lambda> v. Some (Word.sint v)),
+
+  arith_op_bv_method = (\<lambda> op1 sign l r. Word.word_of_int (op1 (int_of_mword sign l) (int_of_mword sign r)))|) )"
+
+
+definition access_bv_inc  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_bv_inc dict_Sail_values_Bitvector_a v n = ( access_list True  (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) n )"
+
+definition access_bv_dec  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> bitU "  where 
+     " access_bv_dec dict_Sail_values_Bitvector_a v n = ( access_list False (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) n )"
+
+
+definition update_bv_inc  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " update_bv_inc dict_Sail_values_Bitvector_a v n b = ( update_list True  (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) n b )"
+
+definition update_bv_dec  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> bitU \<Rightarrow>(bitU)list "  where 
+     " update_bv_dec dict_Sail_values_Bitvector_a v n b = ( update_list False (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) n b )"
+
+
+definition subrange_bv_inc  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " subrange_bv_inc dict_Sail_values_Bitvector_a v i j = ( subrange_list True  (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) i j )"
+
+definition subrange_bv_dec  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(bitU)list "  where 
+     " subrange_bv_dec dict_Sail_values_Bitvector_a v i j = ( subrange_list False (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v) i j )"
+
+
+definition update_subrange_bv_inc  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " update_subrange_bv_inc dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b v i j v' = ( update_subrange_list True  (
+  (bits_of_method   dict_Sail_values_Bitvector_b) v) i j ((bits_of_method   dict_Sail_values_Bitvector_a) v'))"
+
+definition update_subrange_bv_dec  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> 'b \<Rightarrow> int \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " update_subrange_bv_dec dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b v i j v' = ( update_subrange_list False (
+  (bits_of_method   dict_Sail_values_Bitvector_b) v) i j ((bits_of_method   dict_Sail_values_Bitvector_a) v'))"
+
+
+(*val extz_bv : forall 'a. Bitvector 'a => integer -> 'a -> list bitU*)
+definition extz_bv  :: " 'a Bitvector_class \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " extz_bv dict_Sail_values_Bitvector_a n v = ( extz_bits n (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v))"
+
+
+(*val exts_bv : forall 'a. Bitvector 'a => integer -> 'a -> list bitU*)
+definition exts_bv  :: " 'a Bitvector_class \<Rightarrow> int \<Rightarrow> 'a \<Rightarrow>(bitU)list "  where 
+     " exts_bv dict_Sail_values_Bitvector_a n v = ( exts_bits n (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v))"
+
+
+(*val string_of_bv : forall 'a. Bitvector 'a => 'a -> string*)
+definition string_of_bv  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> string "  where 
+     " string_of_bv dict_Sail_values_Bitvector_a v = ( show_bitlist (
+  (bits_of_method   dict_Sail_values_Bitvector_a) v))"
+
+
+(*** Bytes and addresses *)
+
+type_synonym memory_byte =" bitU list "
+
+(*val byte_chunks : forall 'a. list 'a -> maybe (list (list 'a))*)
+fun  byte_chunks  :: " 'a list \<Rightarrow>(('a list)list)option "  where 
+     " byte_chunks ([]) = ( Some [])"
+|" byte_chunks (a # b # c # d # e # f # g # h # rest) = (
+     Option.bind (byte_chunks rest) (\<lambda> rest .  Some ([a,b,c,d,e,f,g,h] # rest)))"
+|" byte_chunks _ = ( None )"
+
+
+(*val bytes_of_bits : forall 'a. Bitvector 'a => 'a -> maybe (list memory_byte)*)
+definition bytes_of_bits  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>(((bitU)list)list)option "  where 
+     " bytes_of_bits dict_Sail_values_Bitvector_a bs = ( byte_chunks (
+  (bits_of_method   dict_Sail_values_Bitvector_a) bs))"
+
+
+(*val bits_of_bytes : list memory_byte -> list bitU*)
+definition bits_of_bytes  :: "((bitU)list)list \<Rightarrow>(bitU)list "  where 
+     " bits_of_bytes bs = ( List.concat (List.map (\<lambda> v. List.map (\<lambda> b. b) v) bs))"
+
+
+definition mem_bytes_of_bits  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>(((bitU)list)list)option "  where 
+     " mem_bytes_of_bits dict_Sail_values_Bitvector_a bs = ( map_option List.rev (bytes_of_bits 
+  dict_Sail_values_Bitvector_a bs))"
+
+definition bits_of_mem_bytes  :: "((bitU)list)list \<Rightarrow>(bitU)list "  where 
+     " bits_of_mem_bytes bs = ( bits_of_bytes (List.rev bs))"
+
+
+(*val bitv_of_byte_lifteds : list Sail_impl_base.byte_lifted -> list bitU
+let bitv_of_byte_lifteds v =
+  foldl (fun x (Byte_lifted y) -> x ++ (List.map bitU_of_bit_lifted y)) [] v
+
+val bitv_of_bytes : list Sail_impl_base.byte -> list bitU
+let bitv_of_bytes v =
+  foldl (fun x (Byte y) -> x ++ (List.map bitU_of_bit y)) [] v
+
+val byte_lifteds_of_bitv : list bitU -> list byte_lifted
+let byte_lifteds_of_bitv bits =
+  let bits = List.map bit_lifted_of_bitU bits in
+  byte_lifteds_of_bit_lifteds bits
+
+val bytes_of_bitv : list bitU -> list byte
+let bytes_of_bitv bits =
+  let bits = List.map bit_of_bitU bits in
+  bytes_of_bits bits
+
+val bit_lifteds_of_bitUs : list bitU -> list bit_lifted
+let bit_lifteds_of_bitUs bits = List.map bit_lifted_of_bitU bits
+
+val bit_lifteds_of_bitv : list bitU -> list bit_lifted
+let bit_lifteds_of_bitv v = bit_lifteds_of_bitUs v
+
+
+val address_lifted_of_bitv : list bitU -> address_lifted
+let address_lifted_of_bitv v =
+  let byte_lifteds = byte_lifteds_of_bitv v in
+  let maybe_address_integer =
+    match (maybe_all (List.map byte_of_byte_lifted byte_lifteds)) with
+    | Just bs -> Just (integer_of_byte_list bs)
+    | _ -> Nothing
+    end in
+  Address_lifted byte_lifteds maybe_address_integer
+
+val bitv_of_address_lifted : address_lifted -> list bitU
+let bitv_of_address_lifted (Address_lifted bs _) = bitv_of_byte_lifteds bs
+
+val address_of_bitv : list bitU -> address
+let address_of_bitv v =
+  let bytes = bytes_of_bitv v in
+  address_of_byte_list bytes*)
+
+function (sequential,domintros)  reverse_endianness_list  :: " 'a list \<Rightarrow> 'a list "  where 
+     " reverse_endianness_list bits = (
+  if List.length bits \<le>( 8 :: nat) then bits else
+    reverse_endianness_list (drop_list(( 8 :: int)) bits) @ take_list(( 8 :: int)) bits )" 
+by pat_completeness auto
+
+
+
+(*** Registers *)
+
+(*type register_field = string
+type register_field_index = string * (integer * integer) (* name, start and end *)
+
+type register =
+  | Register of string * (* name *)
+                integer * (* length *)
+                integer * (* start index *)
+                bool * (* is increasing *)
+                  list register_field_index
+  | UndefinedRegister of integer (* length *)
+  | RegisterPair of register * register*)
+
+record( 'regstate, 'regval, 'a) register_ref =
+  
+ name ::" string " 
+
+     (*is_inc : bool;*)
+     read_from ::" 'regstate \<Rightarrow> 'a " 
+
+     write_to ::" 'a \<Rightarrow> 'regstate \<Rightarrow> 'regstate " 
+
+     of_regval ::" 'regval \<Rightarrow>  'a option " 
+
+     regval_of ::" 'a \<Rightarrow> 'regval " 
+
+
+(* Register accessors: pair of functions for reading and writing register values *)
+type_synonym( 'regstate, 'regval) register_accessors ="
+  ((string \<Rightarrow> 'regstate \<Rightarrow>  'regval option) *
+   (string \<Rightarrow> 'regval \<Rightarrow> 'regstate \<Rightarrow>  'regstate option))"
+
+record( 'regtype, 'a) field_ref =
+  
+ field_name ::" string " 
+
+     field_start ::" int " 
+
+     field_is_inc ::" bool " 
+
+     get_field ::" 'regtype \<Rightarrow> 'a " 
+
+     set_field ::" 'regtype \<Rightarrow> 'a \<Rightarrow> 'regtype " 
+
+
+(*let name_of_reg = function
+  | Register name _ _ _ _ -> name
+  | UndefinedRegister _ -> failwith name_of_reg UndefinedRegister
+  | RegisterPair _ _ -> failwith name_of_reg RegisterPair
+end
+
+let size_of_reg = function
+  | Register _ size _ _ _ -> size
+  | UndefinedRegister size -> size
+  | RegisterPair _ _ -> failwith size_of_reg RegisterPair
+end
+
+let start_of_reg = function
+  | Register _ _ start _ _ -> start
+  | UndefinedRegister _ -> failwith start_of_reg UndefinedRegister
+  | RegisterPair _ _ -> failwith start_of_reg RegisterPair
+end
+
+let is_inc_of_reg = function
+  | Register _ _ _ is_inc _ -> is_inc
+  | UndefinedRegister _ -> failwith is_inc_of_reg UndefinedRegister
+  | RegisterPair _ _ -> failwith in_inc_of_reg RegisterPair
+end
+
+let dir_of_reg = function
+  | Register _ _ _ is_inc _ -> dir_of_bool is_inc
+  | UndefinedRegister _ -> failwith dir_of_reg UndefinedRegister
+  | RegisterPair _ _ -> failwith dir_of_reg RegisterPair
+end
+
+let size_of_reg_nat reg = natFromInteger (size_of_reg reg)
+let start_of_reg_nat reg = natFromInteger (start_of_reg reg)
+
+val register_field_indices_aux : register -> register_field -> maybe (integer * integer)
+let rec register_field_indices_aux register rfield =
+  match register with
+  | Register _ _ _ _ rfields -> List.lookup rfield rfields
+  | RegisterPair r1 r2 ->
+      let m_indices = register_field_indices_aux r1 rfield in
+      if isJust m_indices then m_indices else register_field_indices_aux r2 rfield
+  | UndefinedRegister _ -> Nothing
+  end
+
+val register_field_indices : register -> register_field -> integer * integer
+let register_field_indices register rfield =
+  match register_field_indices_aux register rfield with
+  | Just indices -> indices
+  | Nothing -> failwith Invalid register/register-field combination
+  end
+
+let register_field_indices_nat reg regfield=
+  let (i,j) = register_field_indices reg regfield in
+  (natFromInteger i,natFromInteger j)*)
+
+(*let rec external_reg_value reg_name v =
+  let (internal_start, external_start, direction) =
+    match reg_name with
+     | Reg _ start size dir ->
+        (start, (if dir = D_increasing then start else (start - (size +1))), dir)
+     | Reg_slice _ reg_start dir (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     | Reg_field _ reg_start dir _ (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     | Reg_f_slice _ reg_start dir _ _ (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     end in
+  let bits = bit_lifteds_of_bitv v in
+  <| rv_bits           = bits;
+     rv_dir            = direction;
+     rv_start          = external_start;
+     rv_start_internal = internal_start |>
+
+val internal_reg_value : register_value -> list bitU
+let internal_reg_value v =
+  List.map bitU_of_bit_lifted v.rv_bits
+         (*(integerFromNat v.rv_start_internal)
+         (v.rv_dir = D_increasing)*)
+
+
+let external_slice (d:direction) (start:nat) ((i,j):(nat*nat)) =
+  match d with
+  (*This is the case the thread/concurrecny model expects, so no change needed*)
+  | D_increasing -> (i,j)
+  | D_decreasing -> let slice_i = start - i in
+                    let slice_j = (i - j) + slice_i in
+                    (slice_i,slice_j)
+  end *)
+
+(* TODO
+let external_reg_whole r =
+  Reg (r.name) (natFromInteger r.start) (natFromInteger r.size) (dir_of_bool r.is_inc)
+
+let external_reg_slice r (i,j) =
+  let start = natFromInteger r.start in
+  let dir = dir_of_bool r.is_inc in
+  Reg_slice (r.name) start dir (external_slice dir start (i,j))
+
+let external_reg_field_whole reg rfield =
+  let (m,n) = register_field_indices_nat reg rfield in
+  let start = start_of_reg_nat reg in
+  let dir = dir_of_reg reg in
+  Reg_field (name_of_reg reg) start dir rfield (external_slice dir start (m,n))
+
+let external_reg_field_slice reg rfield (i,j) =
+  let (m,n) = register_field_indices_nat reg rfield in
+  let start = start_of_reg_nat reg in
+  let dir = dir_of_reg reg in
+  Reg_f_slice (name_of_reg reg) start dir rfield
+              (external_slice dir start (m,n))
+              (external_slice dir start (i,j))*)
+
+(*val external_mem_value : list bitU -> memory_value
+let external_mem_value v =
+  byte_lifteds_of_bitv v $> List.reverse
+
+val internal_mem_value : memory_value -> list bitU
+let internal_mem_value bytes =
+  List.reverse bytes $> bitv_of_byte_lifteds*)
+
+
+(*val foreach : forall 'a 'vars.
+  (list 'a) -> 'vars -> ('a -> 'vars -> 'vars) -> 'vars*)
+fun  foreach  :: " 'a list \<Rightarrow> 'vars \<Rightarrow>('a \<Rightarrow> 'vars \<Rightarrow> 'vars)\<Rightarrow> 'vars "  where 
+     " foreach ([]) vars body = ( vars )"
+|" foreach (x # xs) vars body = ( foreach xs (body x vars) body )"
+
+
+(*val index_list : integer -> integer -> integer -> list integer*)
+function (sequential,domintros)  index_list  :: " int \<Rightarrow> int \<Rightarrow> int \<Rightarrow>(int)list "  where 
+     " index_list from1 to1 step = (
+  if ((step >( 0 :: int)) \<and> (from1 \<le> to1)) \<or> ((step <( 0 :: int)) \<and> (to1 \<le> from1)) then
+    from1 # index_list (from1 + step) to1 step
+  else [])" 
+by pat_completeness auto
+
+
+(*val while : forall 'vars. 'vars -> ('vars -> bool) -> ('vars -> 'vars) -> 'vars*)
+function (sequential,domintros)  while  :: " 'vars \<Rightarrow>('vars \<Rightarrow> bool)\<Rightarrow>('vars \<Rightarrow> 'vars)\<Rightarrow> 'vars "  where 
+     " while vars cond body = (
+  if cond vars then while (body vars) cond body else vars )" 
+by pat_completeness auto
+
+
+(*val until : forall 'vars. 'vars -> ('vars -> bool) -> ('vars -> 'vars) -> 'vars*)
+function (sequential,domintros)  until  :: " 'vars \<Rightarrow>('vars \<Rightarrow> bool)\<Rightarrow>('vars \<Rightarrow> 'vars)\<Rightarrow> 'vars "  where 
+     " until vars cond body = (
+  (let vars = (body vars) in
+  if cond vars then vars else until (body vars) cond body))" 
+by pat_completeness auto
+
+
+
+(* convert numbers unsafely to naturals *)
+
+record 'a ToNatural_class=
+ toNatural_method ::" 'a \<Rightarrow> nat " 
+
+(* eta-expanded for Isabelle output, otherwise it breaks *)
+definition instance_Sail_values_ToNatural_Num_integer_dict  :: "(int)ToNatural_class "  where 
+     " instance_Sail_values_ToNatural_Num_integer_dict = ((|
+
+  toNatural_method = (\<lambda> n .  nat (abs n))|) )"
+
+definition instance_Sail_values_ToNatural_Num_int_dict  :: "(int)ToNatural_class "  where 
+     " instance_Sail_values_ToNatural_Num_int_dict = ((|
+
+  toNatural_method = (\<lambda> n .   (nat (abs n)))|) )"
+
+definition instance_Sail_values_ToNatural_nat_dict  :: "(nat)ToNatural_class "  where 
+     " instance_Sail_values_ToNatural_nat_dict = ((|
+
+  toNatural_method = (\<lambda> n .   n)|) )"
+
+definition instance_Sail_values_ToNatural_Num_natural_dict  :: "(nat)ToNatural_class "  where 
+     " instance_Sail_values_ToNatural_Num_natural_dict = ((|
+
+  toNatural_method = (\<lambda> n .  n)|) )"
+
+
+fun toNaturalFiveTup  :: " 'a ToNatural_class \<Rightarrow> 'b ToNatural_class \<Rightarrow> 'c ToNatural_class \<Rightarrow> 'd ToNatural_class \<Rightarrow> 'e ToNatural_class \<Rightarrow> 'd*'c*'b*'a*'e \<Rightarrow> nat*nat*nat*nat*nat "  where 
+     " toNaturalFiveTup dict_Sail_values_ToNatural_a dict_Sail_values_ToNatural_b dict_Sail_values_ToNatural_c dict_Sail_values_ToNatural_d dict_Sail_values_ToNatural_e (n1,n2,n3,n4,n5) = (
+  ((toNatural_method   dict_Sail_values_ToNatural_d) n1,(toNatural_method   dict_Sail_values_ToNatural_c) n2,(toNatural_method   dict_Sail_values_ToNatural_b) n3,(toNatural_method   dict_Sail_values_ToNatural_a) n4,(toNatural_method   dict_Sail_values_ToNatural_e) n5))"
+
+
+(* Let the following types be generated by Sail per spec, using either bitlists
+   or machine words as bitvector representation *)
+(*type regfp =
+  | RFull of (string)
+  | RSlice of (string * integer * integer)
+  | RSliceBit of (string * integer)
+  | RField of (string * string)
+
+type niafp =
+  | NIAFP_successor
+  | NIAFP_concrete_address of vector bitU
+  | NIAFP_indirect_address
+
+(* only for MIPS *)
+type diafp =
+  | DIAFP_none
+  | DIAFP_concrete of vector bitU
+  | DIAFP_reg of regfp
+
+let regfp_to_reg (reg_info : string -> maybe string -> (nat * nat * direction * (nat * nat))) = function
+  | RFull name ->
+     let (start,length,direction,_) = reg_info name Nothing in
+     Reg name start length direction
+  | RSlice (name,i,j) ->
+     let i = natFromInteger i in
+     let j = natFromInteger j in
+     let (start,length,direction,_) = reg_info name Nothing in
+     let slice = external_slice direction start (i,j) in
+     Reg_slice name start direction slice
+  | RSliceBit (name,i) ->
+     let i = natFromInteger i in
+     let (start,length,direction,_) = reg_info name Nothing in
+     let slice = external_slice direction start (i,i) in
+     Reg_slice name start direction slice
+  | RField (name,field_name) ->
+     let (start,length,direction,span) = reg_info name (Just field_name) in
+     let slice = external_slice direction start span in
+     Reg_field name start direction field_name slice
+end
+
+let niafp_to_nia reginfo = function
+  | NIAFP_successor -> NIA_successor
+  | NIAFP_concrete_address v -> NIA_concrete_address (address_of_bitv v)
+  | NIAFP_indirect_address -> NIA_indirect_address
+end
+
+let diafp_to_dia reginfo = function
+  | DIAFP_none -> DIA_none
+  | DIAFP_concrete v -> DIA_concrete_address (address_of_bitv v)
+  | DIAFP_reg r -> DIA_register (regfp_to_reg reginfo r)
+end
+*)
+end
diff --git a/snapshots/isabelle/lib/sail/Sail_values_lemmas.thy b/snapshots/isabelle/lib/sail/Sail_values_lemmas.thy
new file mode 100644
index 00000000..dd008695
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/Sail_values_lemmas.thy
@@ -0,0 +1,206 @@
+theory Sail_values_lemmas
+  imports Sail_values
+begin
+
+lemma nat_of_int_nat_simps[simp]: "nat_of_int = nat" by (auto simp: nat_of_int_def)
+
+termination reverse_endianness_list by (lexicographic_order simp add: drop_list_def)
+
+termination index_list
+  by (relation "measure (\<lambda>(i, j, step). nat ((j - i + step) * sgn step))") auto
+
+lemma just_list_map_Some[simp]: "just_list (map Some v) = Some v" by (induction v) auto
+
+lemma just_list_None_iff[simp]: "just_list xs = None \<longleftrightarrow> None \<in> set xs"
+  by (induction xs) (auto split: option.splits)
+
+lemma just_list_Some_iff[simp]: "just_list xs = Some ys \<longleftrightarrow> xs = map Some ys"
+  by (induction xs arbitrary: ys) (auto split: option.splits)
+
+lemma just_list_cases:
+  assumes "just_list xs = y"
+  obtains (None) "None \<in> set xs" and "y = None"
+        | (Some) ys where "xs = map Some ys" and "y = Some ys"
+  using assms by (cases y) auto
+
+lemma repeat_singleton_replicate[simp]:
+  "repeat [x] n = replicate (nat n) x"
+proof (induction n)
+  case (nonneg n)
+  have "nat (1 + int m) = Suc m" for m by auto
+  then show ?case by (induction n) auto
+next
+  case (neg n)
+  then show ?case by auto
+qed
+
+lemma bool_of_bitU_simps[simp]:
+  "bool_of_bitU B0 = Some False"
+  "bool_of_bitU B1 = Some True"
+  "bool_of_bitU BU = None"
+  by (auto simp: bool_of_bitU_def)
+
+lemma bitops_bitU_of_bool[simp]:
+  "and_bit (bitU_of_bool x) (bitU_of_bool y) = bitU_of_bool (x \<and> y)"
+  "or_bit (bitU_of_bool x) (bitU_of_bool y) = bitU_of_bool (x \<or> y)"
+  "xor_bit (bitU_of_bool x) (bitU_of_bool y) = bitU_of_bool ((x \<or> y) \<and> \<not>(x \<and> y))"
+  "not_bit (bitU_of_bool x) = bitU_of_bool (\<not>x)"
+  "not_bit \<circ> bitU_of_bool = bitU_of_bool \<circ> Not"
+  by (auto simp: bitU_of_bool_def not_bit_def)
+
+lemma image_bitU_of_bool_B0_B1: "bitU_of_bool ` bs \<subseteq> {B0, B1}"
+  by (auto simp: bitU_of_bool_def split: if_splits)
+
+lemma bool_of_bitU_bitU_of_bool[simp]:
+  "bool_of_bitU \<circ> bitU_of_bool = Some"
+  "bool_of_bitU \<circ> (bitU_of_bool \<circ> f) = Some \<circ> f"
+  "bool_of_bitU (bitU_of_bool x) = Some x"
+  by (intro ext, auto simp: bool_of_bitU_def bitU_of_bool_def)+
+
+abbreviation "BC_bitU_list \<equiv> instance_Sail_values_Bitvector_list_dict instance_Sail_values_BitU_Sail_values_bitU_dict"
+lemmas BC_bitU_list_def = instance_Sail_values_Bitvector_list_dict_def instance_Sail_values_BitU_Sail_values_bitU_dict_def
+abbreviation "BC_mword \<equiv> instance_Sail_values_Bitvector_Machine_word_mword_dict"
+lemmas BC_mword_defs = instance_Sail_values_Bitvector_Machine_word_mword_dict_def
+  access_mword_def access_mword_inc_def access_mword_dec_def
+  (*update_mword_def update_mword_inc_def update_mword_dec_def*)
+  subrange_list_def subrange_list_inc_def subrange_list_dec_def
+  update_subrange_list_def update_subrange_list_inc_def update_subrange_list_dec_def
+
+declare size_itself_int_def[simp]
+declare size_itself_def[simp]
+declare word_size[simp]
+
+lemma int_of_mword_simps[simp]:
+  "int_of_mword False w = uint w"
+  "int_of_mword True w = sint w"
+  "int_of_bv BC_mword False w = Some (uint w)"
+  "int_of_bv BC_mword True w = Some (sint w)"
+  by (auto simp: int_of_mword_def int_of_bv_def BC_mword_defs)
+
+lemma BC_mword_simps[simp]:
+  "unsigned_method BC_mword a = Some (uint a)"
+  "signed_method BC_mword a = Some (sint a)"
+  "length_method BC_mword (a :: ('a :: len) word) = int (LENGTH('a))"
+  by (auto simp: BC_mword_defs)
+
+lemma of_bits_mword_of_bl[simp]:
+  assumes "just_list (map bool_of_bitU bus) = Some bs"
+  shows "of_bits_method BC_mword bus = Some (of_bl bs)"
+    and "of_bits_failwith BC_mword bus = of_bl bs"
+  using assms by (auto simp: BC_mword_defs of_bits_failwith_def maybe_failwith_def)
+
+lemma nat_of_bits_aux_bl_to_bin_aux:
+  "nat_of_bools_aux acc bs = nat (bl_to_bin_aux bs (int acc))"
+  by (induction acc bs rule: nat_of_bools_aux.induct)
+     (auto simp: Bit_def intro!: arg_cong[where f = nat] arg_cong2[where f = bl_to_bin_aux] split: if_splits)
+
+lemma nat_of_bits_bl_to_bin[simp]:
+  "nat_of_bools bs = nat (bl_to_bin bs)"
+  by (auto simp: nat_of_bools_def bl_to_bin_def nat_of_bits_aux_bl_to_bin_aux)
+
+lemma unsigned_bits_of_mword[simp]:
+  "unsigned_method BC_bitU_list (bits_of_method BC_mword a) = Some (uint a)"
+  by (auto simp: BC_bitU_list_def BC_mword_defs unsigned_of_bits_def unsigned_of_bools_def)
+
+lemma bits_of_bitU_list[simp]:
+  "bits_of_method BC_bitU_list v = v"
+  "of_bits_method BC_bitU_list v = Some v"
+  by (auto simp: BC_bitU_list_def)
+
+lemma subrange_list_inc_drop_take:
+  "subrange_list_inc xs i j = drop (nat i) (take (nat (j + 1)) xs)"
+  by (auto simp: subrange_list_inc_def split_at_def)
+
+lemma subrange_list_dec_drop_take:
+  assumes "i \<ge> 0" and "j \<ge> 0"
+  shows "subrange_list_dec xs i j = drop (length xs - nat (i + 1)) (take (length xs - nat j) xs)"
+  using assms unfolding subrange_list_dec_def
+  by (auto simp: subrange_list_inc_drop_take add.commute diff_diff_add nat_minus_as_int)
+
+lemma update_subrange_list_inc_drop_take:
+  assumes "i \<ge> 0" and "j \<ge> i"
+  shows "update_subrange_list_inc xs i j xs' = take (nat i) xs @ xs' @ drop (nat (j + 1)) xs"
+  using assms unfolding update_subrange_list_inc_def
+  by (auto simp: split_at_def min_def)
+
+lemma update_subrange_list_dec_drop_take:
+  assumes "j \<ge> 0" and "i \<ge> j"
+  shows "update_subrange_list_dec xs i j xs' = take (length xs - nat (i + 1)) xs @ xs' @ drop (length xs - nat j) xs"
+  using assms unfolding update_subrange_list_dec_def update_subrange_list_inc_def
+  by (auto simp: split_at_def min_def Let_def add.commute diff_diff_add nat_minus_as_int)
+
+declare access_list_inc_def[simp]
+
+lemma access_list_dec_rev_nth:
+  assumes "0 \<le> i" and "nat i < length xs"
+  shows "access_list_dec xs i = rev xs ! (nat i)"
+  using assms
+  by (auto simp: access_list_dec_def rev_nth intro!: arg_cong2[where f = List.nth])
+
+lemma access_bv_dec_mword[simp]:
+  fixes w :: "('a::len) word"
+  assumes "0 \<le> n" and "nat n < LENGTH('a)"
+  shows "access_bv_dec BC_mword w n = bitU_of_bool (w !! (nat n))"
+  using assms unfolding access_bv_dec_def access_list_def
+  by (auto simp: access_list_dec_rev_nth BC_mword_defs rev_map test_bit_bl)
+
+lemma access_list_dec_nth[simp]:
+  assumes "0 \<le> i"
+  shows "access_list_dec xs i = xs ! (length xs - nat (i + 1))"
+  using assms
+  by (auto simp: access_list_dec_def add.commute diff_diff_add nat_minus_as_int)
+
+lemma update_list_inc_update[simp]:
+  "update_list_inc xs n x = xs[nat n := x]"
+  by (auto simp: update_list_inc_def)
+
+lemma update_list_dec_update[simp]:
+  "update_list_dec xs n x = xs[length xs - nat (n + 1) := x]"
+  by (auto simp: update_list_dec_def add.commute diff_diff_add nat_minus_as_int)
+
+lemma bools_of_nat_aux_simps[simp]:
+  "\<And>len. len \<le> 0 \<Longrightarrow> bools_of_nat_aux len x acc = acc"
+  "\<And>len. bools_of_nat_aux (int (Suc len)) x acc =
+     bools_of_nat_aux (int len) (x div 2) ((if x mod 2 = 1 then True else False) # acc)"
+  by auto
+declare bools_of_nat_aux.simps[simp del]
+
+lemma bools_of_nat_aux_bin_to_bl_aux:
+  "bools_of_nat_aux len n acc = bin_to_bl_aux (nat len) (int n) acc"
+proof (cases len)
+  case (nonneg len')
+  show ?thesis unfolding nonneg
+  proof (induction len' arbitrary: n acc)
+    case (Suc len'' n acc)
+    then show ?case
+      using zmod_int[of n 2]
+      by (auto simp del: of_nat_simps simp add: bin_rest_def bin_last_def zdiv_int)
+  qed auto
+qed auto
+
+lemma bools_of_nat_bin_to_bl[simp]:
+  "bools_of_nat len n = bin_to_bl (nat len) (int n)"
+  by (auto simp: bools_of_nat_def bools_of_nat_aux_bin_to_bl_aux)
+
+lemma add_one_bool_ignore_overflow_aux_rbl_succ[simp]:
+  "add_one_bool_ignore_overflow_aux xs = rbl_succ xs"
+  by (induction xs) auto
+
+lemma add_one_bool_ignore_overflow_rbl_succ[simp]:
+  "add_one_bool_ignore_overflow xs = rev (rbl_succ (rev xs))"
+  unfolding add_one_bool_ignore_overflow_def by auto
+
+lemma map_Not_bin_to_bl:
+  "map Not (bin_to_bl_aux len n acc) = bin_to_bl_aux len (-n - 1) (map Not acc)"
+proof (induction len arbitrary: n acc)
+  case (Suc len n acc)
+  moreover have "(- (n div 2) - 1) = ((-n - 1) div 2)" by auto
+  moreover have "(n mod 2 = 0) = ((- n - 1) mod 2 = 1)" by presburger
+  ultimately show ?case by (auto simp: bin_rest_def bin_last_def)
+qed auto
+
+lemma bools_of_int_bin_to_bl[simp]:
+  "bools_of_int (int len) n = bin_to_bl len n"
+  by (auto simp: bools_of_int_def Let_def map_Not_bin_to_bl rbl_succ[unfolded bin_to_bl_def])
+
+end
diff --git a/snapshots/isabelle/lib/sail/State.thy b/snapshots/isabelle/lib/sail/State.thy
new file mode 100644
index 00000000..9d460e8e
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/State.thy
@@ -0,0 +1,102 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/state.lem.\<close>
+
+theory "State" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Sail_values" 
+	 "Prompt_monad" 
+	 "Prompt" 
+	 "State_monad" 
+	 "State_monad_lemmas" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Sail_impl_base*)
+(*open import Sail_values*)
+(*open import Prompt_monad*)
+(*open import Prompt*)
+(*open import State_monad*)
+(*open import {isabelle} `State_monad_lemmas`*)
+
+(* State monad wrapper around prompt monad *)
+
+(*val liftState : forall 'regval 'regs 'a 'e. register_accessors 'regs 'regval -> monad 'regval 'a 'e -> monadS 'regs 'a 'e*)
+function (sequential,domintros)  liftState  :: "(string \<Rightarrow> 'regs \<Rightarrow> 'regval option)*(string \<Rightarrow> 'regval \<Rightarrow> 'regs \<Rightarrow> 'regs option)\<Rightarrow>('regval,'a,'e)monad \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " liftState ra (Done a) = ( returnS a )"
+|" liftState ra (Read_mem rk a sz k) = ( bindS (read_mem_bytesS 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) rk a sz) (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Read_tag t k) = ( bindS (read_tagS 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) t)             (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Write_memv a k) = ( bindS (write_mem_bytesS a)      (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Write_tag a t k) = ( bindS (write_tagS 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) a t)          (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Read_reg r k) = ( bindS (read_regvalS ra r)       (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Excl_res k) = ( bindS (excl_resultS () )         (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Undefined k) = ( bindS (undefined_boolS () )      (\<lambda> v .  liftState ra (k v)))"
+|" liftState ra (Write_ea wk a sz k) = ( seqS (write_mem_eaS 
+  (instance_Sail_values_Bitvector_list_dict
+     instance_Sail_values_BitU_Sail_values_bitU_dict) wk a sz)    (liftState ra k))"
+|" liftState ra (Write_reg r v k) = ( seqS (write_regvalS ra r v)     (liftState ra k))"
+|" liftState ra (Footprint k) = ( liftState ra k )"
+|" liftState ra (Barrier _ k) = ( liftState ra k )"
+|" liftState ra (Print _ k) = ( liftState ra k )"
+|" liftState ra (Fail descr) = ( failS descr )"
+|" liftState ra (Exception e) = ( throwS e )" 
+by pat_completeness auto
+
+
+
+(*val iterS_aux : forall 'rv 'a 'e. integer -> (integer -> 'a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e*)
+fun  iterS_aux  :: " int \<Rightarrow>(int \<Rightarrow> 'a \<Rightarrow> 'rv sequential_state \<Rightarrow>(((unit),'e)result*'rv sequential_state)set)\<Rightarrow> 'a list \<Rightarrow>('rv,(unit),'e)monadS "  where 
+     " iterS_aux i f (x # xs) = ( seqS (f i x) (iterS_aux (i +( 1 :: int)) f xs))"
+|" iterS_aux i f ([]) = ( returnS ()  )"
+
+
+(*val iteriS : forall 'rv 'a 'e. (integer -> 'a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e*)
+definition iteriS  :: "(int \<Rightarrow> 'a \<Rightarrow>('rv,(unit),'e)monadS)\<Rightarrow> 'a list \<Rightarrow> 'rv sequential_state \<Rightarrow>(((unit),'e)result*'rv sequential_state)set "  where 
+     " iteriS f xs = ( iterS_aux(( 0 :: int)) f xs )"
+
+
+(*val iterS : forall 'rv 'a 'e. ('a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e*)
+definition iterS  :: "('a \<Rightarrow> 'rv sequential_state \<Rightarrow>(((unit),'e)result*'rv sequential_state)set)\<Rightarrow> 'a list \<Rightarrow> 'rv sequential_state \<Rightarrow>(((unit),'e)result*'rv sequential_state)set "  where 
+     " iterS f xs = ( iteriS ( \<lambda>x .  
+  (case  x of _ => \<lambda> x .  f x )) xs )"
+
+
+(*val foreachS : forall 'a 'rv 'vars 'e.
+  list 'a -> 'vars -> ('a -> 'vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e*)
+fun  foreachS  :: " 'a list \<Rightarrow> 'vars \<Rightarrow>('a \<Rightarrow> 'vars \<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set)\<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set "  where 
+     " foreachS ([]) vars body = ( returnS vars )"
+|" foreachS (x # xs) vars body = ( bindS
+     (body x vars) (\<lambda> vars . 
+     foreachS xs vars body))"
+
+
+
+(*val whileS : forall 'rv 'vars 'e. 'vars -> ('vars -> monadS 'rv bool 'e) ->
+                ('vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e*)
+function (sequential,domintros)  whileS  :: " 'vars \<Rightarrow>('vars \<Rightarrow> 'rv sequential_state \<Rightarrow>(((bool),'e)result*'rv sequential_state)set)\<Rightarrow>('vars \<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set)\<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set "  where 
+     " whileS vars cond body s = (
+  ( bindS(cond vars) (\<lambda> cond_val s' . 
+  if cond_val then
+    ( bindS(body vars) (\<lambda> vars s'' .  whileS vars cond body s'')) s'
+  else returnS vars s')) s )" 
+by pat_completeness auto
+
+
+(*val untilS : forall 'rv 'vars 'e. 'vars -> ('vars -> monadS 'rv bool 'e) ->
+                ('vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e*)
+function (sequential,domintros)  untilS  :: " 'vars \<Rightarrow>('vars \<Rightarrow> 'rv sequential_state \<Rightarrow>(((bool),'e)result*'rv sequential_state)set)\<Rightarrow>('vars \<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set)\<Rightarrow> 'rv sequential_state \<Rightarrow>(('vars,'e)result*'rv sequential_state)set "  where 
+     " untilS vars cond body s = (
+  ( bindS(body vars) (\<lambda> vars s' . 
+  ( bindS(cond vars) (\<lambda> cond_val s'' . 
+  if cond_val then returnS vars s'' else untilS vars cond body s'')) s')) s )" 
+by pat_completeness auto
+
+end
diff --git a/snapshots/isabelle/lib/sail/State_lemmas.thy b/snapshots/isabelle/lib/sail/State_lemmas.thy
new file mode 100644
index 00000000..84b08e6c
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/State_lemmas.thy
@@ -0,0 +1,202 @@
+theory State_lemmas
+  imports State
+begin
+
+lemma All_liftState_dom: "liftState_dom (r, m)"
+  by (induction m) (auto intro: liftState.domintros)
+termination liftState using All_liftState_dom by auto
+
+lemma liftState_bind[simp]:
+  "liftState r (bind m f) = bindS (liftState r m) (liftState r \<circ> f)"
+  by (induction m f rule: bind.induct) auto
+
+lemma liftState_return[simp]: "liftState r (return a) = returnS a" by (auto simp: return_def)
+
+lemma Value_liftState_Run:
+  assumes "(Value a, s') \<in> liftState r m s"
+  obtains t where "Run m t a"
+  by (use assms in \<open>induction r m arbitrary: s s' rule: liftState.induct\<close>;
+      auto simp add: failS_def throwS_def returnS_def simp del: read_regvalS.simps;
+      blast elim: Value_bindS_elim)
+
+lemmas liftState_if_distrib[simp] = if_distrib[where f = "liftState ra" for ra]
+
+lemma liftState_throw[simp]: "liftState r (throw e) = throwS e" by (auto simp: throw_def)
+lemma liftState_assert[simp]: "liftState r (assert_exp c msg) = assert_expS c msg" by (auto simp: assert_exp_def assert_expS_def)
+lemma liftState_exit[simp]: "liftState r (exit0 ()) = exitS ()" by (auto simp: exit0_def exitS_def)
+lemma liftState_exclResult[simp]: "liftState r (excl_result ()) = excl_resultS ()" by (auto simp: excl_result_def)
+lemma liftState_barrier[simp]: "liftState r (barrier bk) = returnS ()" by (auto simp: barrier_def)
+lemma liftState_footprint[simp]: "liftState r (footprint ()) = returnS ()" by (auto simp: footprint_def)
+lemma liftState_undefined[simp]: "liftState r (undefined_bool ()) = undefined_boolS ()" by (auto simp: undefined_bool_def)
+lemma liftState_maybe_fail[simp]: "liftState r (maybe_fail msg x) = maybe_failS msg x"
+  by (auto simp: maybe_fail_def maybe_failS_def split: option.splits)
+
+lemma liftState_try_catch[simp]:
+  "liftState r (try_catch m h) = try_catchS (liftState r m) (liftState r \<circ> h)"
+  by (induction m h rule: try_catch_induct) (auto simp: try_catchS_bindS_no_throw)
+
+lemma liftState_early_return[simp]:
+  "liftState r (early_return r) = early_returnS r"
+  by (auto simp: early_return_def early_returnS_def)
+
+lemma liftState_catch_early_return[simp]:
+  "liftState r (catch_early_return m) = catch_early_returnS (liftState r m)"
+  by (auto simp: catch_early_return_def catch_early_returnS_def sum.case_distrib cong: sum.case_cong)
+
+lemma liftState_liftR[simp]:
+  "liftState r (liftR m) = liftSR (liftState r m)"
+  by (auto simp: liftR_def liftSR_def)
+
+lemma liftState_try_catchR[simp]:
+  "liftState r (try_catchR m h) = try_catchSR (liftState r m) (liftState r \<circ> h)"
+  by (auto simp: try_catchR_def try_catchSR_def sum.case_distrib cong: sum.case_cong)
+
+lemma liftState_read_mem_BC:
+  assumes "unsigned_method BC_bitU_list (bits_of_method BCa a) = unsigned_method BCa a"
+  shows "liftState r (read_mem BCa BCb rk a sz) = read_memS BCa BCb rk a sz"
+  using assms
+  by (auto simp: read_mem_def read_mem_bytes_def read_memS_def read_mem_bytesS_def maybe_failS_def split: option.splits)
+
+lemma liftState_read_mem[simp]:
+  "\<And>a. liftState r (read_mem BC_mword BC_mword rk a sz) = read_memS BC_mword BC_mword rk a sz"
+  "\<And>a. liftState r (read_mem BC_bitU_list BC_bitU_list rk a sz) = read_memS BC_bitU_list BC_bitU_list rk a sz"
+  by (auto simp: liftState_read_mem_BC)
+
+lemma liftState_write_mem_ea_BC:
+  assumes "unsigned_method BC_bitU_list (bits_of_method BCa a) = unsigned_method BCa a"
+  shows "liftState r (write_mem_ea BCa rk a sz) = write_mem_eaS BCa rk a (nat sz)"
+  using assms by (auto simp: write_mem_ea_def write_mem_eaS_def)
+
+lemma liftState_write_mem_ea[simp]:
+  "\<And>a. liftState r (write_mem_ea BC_mword rk a sz) = write_mem_eaS BC_mword rk a (nat sz)"
+  "\<And>a. liftState r (write_mem_ea BC_bitU_list rk a sz) = write_mem_eaS BC_bitU_list rk a (nat sz)"
+  by (auto simp: liftState_write_mem_ea_BC)
+
+lemma liftState_write_mem_val:
+  "liftState r (write_mem_val BC v) = write_mem_valS BC v"
+  by (auto simp: write_mem_val_def write_mem_valS_def split: option.splits)
+
+lemma liftState_read_reg_readS:
+  assumes "\<And>s. Option.bind (get_regval' (name reg) s) (of_regval reg) = Some (read_from reg s)"
+  shows "liftState (get_regval', set_regval') (read_reg reg) = readS (read_from reg \<circ> regstate)"
+proof
+  fix s :: "'a sequential_state"
+  obtain rv v where "get_regval' (name reg) (regstate s) = Some rv"
+    and "of_regval reg rv \<equiv> Some v" and "read_from reg (regstate s) = v"
+    using assms unfolding bind_eq_Some_conv by blast
+  then show "liftState (get_regval', set_regval') (read_reg reg) s = readS (read_from reg \<circ> regstate) s"
+    by (auto simp: read_reg_def bindS_def returnS_def read_regS_def readS_def)
+qed
+
+lemma liftState_write_reg_updateS:
+  assumes "\<And>s. set_regval' (name reg) (regval_of reg v) s = Some (write_to reg v s)"
+  shows "liftState (get_regval', set_regval') (write_reg reg v) = updateS (regstate_update (write_to reg v))"
+  using assms by (auto simp: write_reg_def updateS_def returnS_def bindS_readS)
+
+lemma liftState_iter_aux[simp]:
+  shows "liftState r (iter_aux i f xs) = iterS_aux i (\<lambda>i x. liftState r (f i x)) xs"
+  by (induction i "\<lambda>i x. liftState r (f i x)" xs rule: iterS_aux.induct) (auto cong: bindS_cong)
+
+lemma liftState_iteri[simp]:
+  "liftState r (iteri f xs) = iteriS (\<lambda>i x. liftState r (f i x)) xs"
+  by (auto simp: iteri_def iteriS_def)
+
+lemma liftState_iter[simp]:
+  "liftState r (iter f xs) = iterS (liftState r \<circ> f) xs"
+  by (auto simp: iter_def iterS_def)
+
+lemma liftState_foreachM[simp]:
+  "liftState r (foreachM xs vars body) = foreachS xs vars (\<lambda>x vars. liftState r (body x vars))"
+  by (induction xs vars "\<lambda>x vars. liftState r (body x vars)" rule: foreachS.induct)
+     (auto cong: bindS_cong)
+
+lemma whileS_dom_step:
+  assumes "whileS_dom (vars, cond, body, s)"
+    and "(Value True, s') \<in> cond vars s"
+    and "(Value vars', s'') \<in> body vars s'"
+  shows "whileS_dom (vars', cond, body, s'')"
+  by (use assms in \<open>induction vars cond body s arbitrary: vars' s' s'' rule: whileS.pinduct\<close>)
+     (auto intro: whileS.domintros)
+
+lemma whileM_dom_step:
+  assumes "whileM_dom (vars, cond, body)"
+    and "Run (cond vars) t True"
+    and "Run (body vars) t' vars'"
+  shows "whileM_dom (vars', cond, body)"
+  by (use assms in \<open>induction vars cond body arbitrary: vars' t t' rule: whileM.pinduct\<close>)
+     (auto intro: whileM.domintros)
+
+lemma whileM_dom_ex_step:
+  assumes "whileM_dom (vars, cond, body)"
+    and "\<exists>t. Run (cond vars) t True"
+    and "\<exists>t'. Run (body vars) t' vars'"
+  shows "whileM_dom (vars', cond, body)"
+  using assms by (blast intro: whileM_dom_step)
+
+lemmas whileS_pinduct = whileS.pinduct[case_names Step]
+
+lemma liftState_whileM:
+  assumes "whileS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)"
+    and "whileM_dom (vars, cond, body)"
+  shows "liftState r (whileM vars cond body) s = whileS vars (liftState r \<circ> cond) (liftState r \<circ> body) s"
+proof (use assms in \<open>induction vars "liftState r \<circ> cond" "liftState r \<circ> body" s rule: whileS.pinduct\<close>)
+  case Step: (1 vars s)
+  note domS = Step(1) and IH = Step(2) and domM = Step(3)
+  show ?case unfolding whileS.psimps[OF domS] whileM.psimps[OF domM] liftState_bind
+  proof (intro bindS_ext_cong, goal_cases cond while)
+    case (while a s')
+    have "bindS (liftState r (body vars)) (liftState r \<circ> (\<lambda>vars. whileM vars cond body)) s' =
+          bindS (liftState r (body vars)) (\<lambda>vars. whileS vars (liftState r \<circ> cond) (liftState r \<circ> body)) s'"
+      if "a"
+    proof (intro bindS_ext_cong, goal_cases body while')
+      case (while' vars' s'')
+      have "whileM_dom (vars', cond, body)" proof (rule whileM_dom_ex_step[OF domM])
+        show "\<exists>t. Run (cond vars) t True" using while that by (auto elim: Value_liftState_Run)
+        show "\<exists>t'. Run (body vars) t' vars'" using while' that by (auto elim: Value_liftState_Run)
+      qed
+      then show ?case using while while' that IH by auto
+    qed auto
+    then show ?case by auto
+  qed auto
+qed
+
+
+lemma untilM_dom_step:
+  assumes "untilM_dom (vars, cond, body)"
+    and "Run (body vars) t vars'"
+    and "Run (cond vars') t' False"
+  shows "untilM_dom (vars', cond, body)"
+  by (use assms in \<open>induction vars cond body arbitrary: vars' t t' rule: untilM.pinduct\<close>)
+     (auto intro: untilM.domintros)
+
+lemma untilM_dom_ex_step:
+  assumes "untilM_dom (vars, cond, body)"
+    and "\<exists>t. Run (body vars) t vars'"
+    and "\<exists>t'. Run (cond vars') t' False"
+  shows "untilM_dom (vars', cond, body)"
+  using assms by (blast intro: untilM_dom_step)
+
+lemma liftState_untilM:
+  assumes "untilS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)"
+    and "untilM_dom (vars, cond, body)"
+  shows "liftState r (untilM vars cond body) s = untilS vars (liftState r \<circ> cond) (liftState r \<circ> body) s"
+proof (use assms in \<open>induction vars "liftState r \<circ> cond" "liftState r \<circ> body" s rule: untilS.pinduct\<close>)
+  case Step: (1 vars s)
+  note domS = Step(1) and IH = Step(2) and domM = Step(3)
+  show ?case unfolding untilS.psimps[OF domS] untilM.psimps[OF domM] liftState_bind
+  proof (intro bindS_ext_cong, goal_cases body k)
+    case (k vars' s')
+    show ?case unfolding comp_def liftState_bind
+    proof (intro bindS_ext_cong, goal_cases cond until)
+      case (until a s'')
+      have "untilM_dom (vars', cond, body)" if "\<not>a"
+      proof (rule untilM_dom_ex_step[OF domM])
+        show "\<exists>t. Run (body vars) t vars'" using k by (auto elim: Value_liftState_Run)
+        show "\<exists>t'. Run (cond vars') t' False" using until that by (auto elim: Value_liftState_Run)
+      qed
+      then show ?case using k until IH by (auto simp: comp_def)
+    qed auto
+  qed auto
+qed
+
+end
diff --git a/snapshots/isabelle/lib/sail/State_monad.thy b/snapshots/isabelle/lib/sail/State_monad.thy
new file mode 100644
index 00000000..8e19f0b6
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/State_monad.thy
@@ -0,0 +1,375 @@
+chapter \<open>Generated by Lem from ../../src/gen_lib/state_monad.lem.\<close>
+
+theory "State_monad" 
+
+imports 
+ 	 Main
+	 "Lem_pervasives_extra" 
+	 "Sail_instr_kinds" 
+	 "Sail_values" 
+
+begin 
+
+(*open import Pervasives_extra*)
+(*open import Sail_instr_kinds*)
+(*open import Sail_values*)
+
+(* 'a is result type *)
+
+type_synonym memstate =" (int, memory_byte) Map.map "
+type_synonym tagstate =" (int, bitU) Map.map "
+(* type regstate = map string (vector bitU) *)
+
+record 'regs sequential_state =
+  
+ regstate ::" 'regs " 
+
+     memstate ::" memstate " 
+
+     tagstate ::" tagstate " 
+
+     write_ea ::"  (write_kind * int * int)option " 
+
+     last_exclusive_operation_was_load ::" bool " 
+
+     (* Random bool generator for use as an undefined bit oracle *)
+     next_bool ::" nat \<Rightarrow> (bool * nat)" 
+
+     seed ::" nat " 
+
+
+(*val init_state : forall 'regs. 'regs -> (nat -> (bool* nat)) -> nat -> sequential_state 'regs*)
+definition init_state  :: " 'regs \<Rightarrow>(nat \<Rightarrow> bool*nat)\<Rightarrow> nat \<Rightarrow> 'regs sequential_state "  where 
+     " init_state regs o1 s = (
+  (| regstate = regs,
+     memstate = Map.empty,
+     tagstate = Map.empty,
+     write_ea = None,
+     last_exclusive_operation_was_load = False,
+     next_bool = o1,
+     seed = s |) )"
+
+
+datatype 'e ex =
+    Failure " string "
+  | Throw " 'e "
+
+datatype( 'a, 'e) result =
+    Value " 'a "
+  | Ex " ( 'e ex)"
+
+(* State, nondeterminism and exception monad with result value type 'a
+   and exception type 'e. *)
+type_synonym( 'regs, 'a, 'e) monadS =" 'regs sequential_state \<Rightarrow> ( ('a, 'e)result * 'regs sequential_state) set "
+
+(*val returnS : forall 'regs 'a 'e. 'a -> monadS 'regs 'a 'e*)
+definition returnS  :: " 'a \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " returnS a s = ( {(Value a,s)})"
+
+
+(*val bindS : forall 'regs 'a 'b 'e. monadS 'regs 'a 'e -> ('a -> monadS 'regs 'b 'e) -> monadS 'regs 'b 'e*)
+definition bindS  :: "('regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set)\<Rightarrow>('a \<Rightarrow> 'regs sequential_state \<Rightarrow>(('b,'e)result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('b,'e)result*'regs sequential_state)set "  where 
+     " bindS m f (s :: 'regs sequential_state) = (
+  \<Union> (Set.image (\<lambda>x .  
+  (case  x of   (Value a, s') => f a s' | (Ex e, s') => {(Ex e, s')} )) (m s)))"
+
+
+(*val seqS: forall 'regs 'b 'e. monadS 'regs unit 'e -> monadS 'regs 'b 'e -> monadS 'regs 'b 'e*)
+definition seqS  :: "('regs sequential_state \<Rightarrow>(((unit),'e)result*'regs sequential_state)set)\<Rightarrow>('regs sequential_state \<Rightarrow>(('b,'e)result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('b,'e)result*'regs sequential_state)set "  where 
+     " seqS m n = ( bindS m ( \<lambda>x .  
+  (case  x of (_ :: unit) => n )))"
+
+
+(*val chooseS : forall 'regs 'a 'e. SetType 'a => set 'a -> monadS 'regs 'a 'e*)
+definition chooseS  :: " 'a set \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " chooseS xs s = ( Set.image (\<lambda> x .  (Value x, s)) xs )"
+
+
+(*val readS : forall 'regs 'a 'e. (sequential_state 'regs -> 'a) -> monadS 'regs 'a 'e*)
+definition readS  :: "('regs sequential_state \<Rightarrow> 'a)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " readS f = ( (\<lambda> s .  returnS (f s) s))"
+
+
+(*val updateS : forall 'regs 'e. (sequential_state 'regs -> sequential_state 'regs) -> monadS 'regs unit 'e*)
+definition updateS  :: "('regs sequential_state \<Rightarrow> 'regs sequential_state)\<Rightarrow> 'regs sequential_state \<Rightarrow>(((unit),'e)result*'regs sequential_state)set "  where 
+     " updateS f = ( (\<lambda> s .  returnS ()  (f s)))"
+
+
+(*val failS : forall 'regs 'a 'e. string -> monadS 'regs 'a 'e*)
+definition failS  :: " string \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " failS msg s = ( {(Ex (Failure msg), s)})"
+
+
+(*val undefined_boolS : forall 'regval 'regs 'a 'e. unit -> monadS 'regs bool 'e*)
+definition undefined_boolS  :: " unit \<Rightarrow>('regs,(bool),'e)monadS "  where 
+     " undefined_boolS _ = ( bindS
+  (readS (\<lambda> s . (next_bool   s) ((seed   s)))) ( \<lambda>x .  
+  (case  x of
+      (b, seed1) => seqS (updateS (\<lambda> s .  ( s (| seed := seed1 |))))
+                      (returnS b)
+  )))"
+
+
+(*val exitS : forall 'regs 'e 'a. unit -> monadS 'regs 'a 'e*)
+definition exitS  :: " unit \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " exitS _ = ( failS (''exit''))"
+
+
+(*val throwS : forall 'regs 'a 'e. 'e -> monadS 'regs 'a 'e*)
+definition throwS  :: " 'e \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " throwS e s = ( {(Ex (Throw e), s)})"
+
+
+(*val try_catchS : forall 'regs 'a 'e1 'e2. monadS 'regs 'a 'e1 -> ('e1 -> monadS 'regs 'a 'e2) ->  monadS 'regs 'a 'e2*)
+definition try_catchS  :: "('regs sequential_state \<Rightarrow>(('a,'e1)result*'regs sequential_state)set)\<Rightarrow>('e1 \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e2)result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e2)result*'regs sequential_state)set "  where 
+     " try_catchS m h s = (
+  \<Union> (Set.image (\<lambda>x .  
+  (case  x of
+        (Value a, s') => returnS a s'
+    | (Ex (Throw e), s') => h e s'
+    | (Ex (Failure msg), s') => {(Ex (Failure msg), s')}
+  )) (m s)))"
+
+
+(*val assert_expS : forall 'regs 'e. bool -> string -> monadS 'regs unit 'e*)
+definition assert_expS  :: " bool \<Rightarrow> string \<Rightarrow> 'regs sequential_state \<Rightarrow>(((unit),'e)result*'regs sequential_state)set "  where 
+     " assert_expS exp msg = ( if exp then returnS ()  else failS msg )"
+
+
+(* For early return, we abuse exceptions by throwing and catching
+   the return value. The exception type is either 'r 'e, where Right e
+   represents a proper exception and Left r an early return of value r. *)
+type_synonym( 'regs, 'a, 'r, 'e) monadSR =" ('regs, 'a, ( ('r, 'e)sum)) monadS "
+
+(*val early_returnS : forall 'regs 'a 'r 'e. 'r -> monadSR 'regs 'a 'r 'e*)
+definition early_returnS  :: " 'r \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,(('r,'e)sum))result*'regs sequential_state)set "  where 
+     " early_returnS r = ( throwS (Inl r))"
+
+
+(*val catch_early_returnS : forall 'regs 'a 'e. monadSR 'regs 'a 'a 'e -> monadS 'regs 'a 'e*)
+definition catch_early_returnS  :: "('regs sequential_state \<Rightarrow>(('a,(('a,'e)sum))result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " catch_early_returnS m = (
+  try_catchS m
+    (\<lambda>x .  (case  x of   Inl a => returnS a | Inr e => throwS e )))"
+
+
+(* Lift to monad with early return by wrapping exceptions *)
+(*val liftSR : forall 'a 'r 'regs 'e. monadS 'regs 'a 'e -> monadSR 'regs 'a 'r 'e*)
+definition liftSR  :: "('regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,(('r,'e)sum))result*'regs sequential_state)set "  where 
+     " liftSR m = ( try_catchS m (\<lambda> e .  throwS (Inr e)))"
+
+
+(* Catch exceptions in the presence of early returns *)
+(*val try_catchSR : forall 'regs 'a 'r 'e1 'e2. monadSR 'regs 'a 'r 'e1 -> ('e1 -> monadSR 'regs 'a 'r 'e2) ->  monadSR 'regs 'a 'r 'e2*)
+definition try_catchSR  :: "('regs sequential_state \<Rightarrow>(('a,(('r,'e1)sum))result*'regs sequential_state)set)\<Rightarrow>('e1 \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,(('r,'e2)sum))result*'regs sequential_state)set)\<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,(('r,'e2)sum))result*'regs sequential_state)set "  where 
+     " try_catchSR m h = (
+  try_catchS m
+    (\<lambda>x .  (case  x of   Inl r => throwS (Inl r) | Inr e => h e )))"
+
+
+(*val maybe_failS : forall 'regs 'a 'e. string -> maybe 'a -> monadS 'regs 'a 'e*)
+definition maybe_failS  :: " string \<Rightarrow> 'a option \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " maybe_failS msg = ( \<lambda>x .  
+  (case  x of   Some a => returnS a | None => failS msg ) )"
+
+
+(*val read_tagS : forall 'regs 'a 'e. Bitvector 'a => 'a -> monadS 'regs bitU 'e*)
+definition read_tagS  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow>('regs,(bitU),'e)monadS "  where 
+     " read_tagS dict_Sail_values_Bitvector_a addr = ( bindS
+  (maybe_failS (''unsigned'') (
+  (unsigned_method   dict_Sail_values_Bitvector_a) addr)) (\<lambda> addr . 
+  readS (\<lambda> s .  case_option B0 id ((tagstate   s) addr))))"
+
+
+(* Read bytes from memory and return in little endian order *)
+(*val read_mem_bytesS : forall 'regs 'e 'a. Bitvector 'a => read_kind -> 'a -> nat -> monadS 'regs (list memory_byte) 'e*)
+definition read_mem_bytesS  :: " 'a Bitvector_class \<Rightarrow> read_kind \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow>('regs,(((bitU)list)list),'e)monadS "  where 
+     " read_mem_bytesS dict_Sail_values_Bitvector_a read_kind addr sz = ( bindS
+  (maybe_failS (''unsigned'') (
+  (unsigned_method   dict_Sail_values_Bitvector_a) addr)) (\<lambda> addr . 
+  (let sz = (int sz) in
+  (let addrs = (index_list addr ((addr+sz)-( 1 :: int))(( 1 :: int))) in  
+  (let read_byte = (\<lambda> s addr .  (memstate   s) addr) in
+  bindS (readS (\<lambda> s .  just_list (List.map (read_byte s) addrs)))
+    (\<lambda>x .  (case  x of
+                         Some mem_val => seqS
+                                           (updateS
+                                              (\<lambda> s . 
+                                               if read_is_exclusive read_kind
+                                               then
+                                                 ( s (| last_exclusive_operation_was_load := True |))
+                                               else s)) (returnS mem_val)
+                     | None => failS (''read_memS'')
+                   )))))))"
+
+
+(*val read_memS : forall 'regs 'e 'a 'b. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monadS 'regs 'b 'e*)
+definition read_memS  :: " 'a Bitvector_class \<Rightarrow> 'b Bitvector_class \<Rightarrow> read_kind \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow>('regs,'b,'e)monadS "  where 
+     " read_memS dict_Sail_values_Bitvector_a dict_Sail_values_Bitvector_b rk a sz = ( bindS
+  (read_mem_bytesS dict_Sail_values_Bitvector_a rk a (nat_of_int sz)) (\<lambda> bytes . 
+  maybe_failS (''bits_of_mem_bytes'') (
+  (of_bits_method   dict_Sail_values_Bitvector_b) (bits_of_mem_bytes bytes))))"
+
+
+(*val excl_resultS : forall 'regs 'e. unit -> monadS 'regs bool 'e*)
+definition excl_resultS  :: " unit \<Rightarrow>('regs,(bool),'e)monadS "  where 
+     " excl_resultS _ = ( bindS
+  (readS (\<lambda> s . (last_exclusive_operation_was_load   s))) (\<lambda> excl_load .  seqS
+  (updateS (\<lambda> s .  ( s (| last_exclusive_operation_was_load := False |))))
+  (chooseS (if excl_load then {False, True} else {False}))))"
+
+
+(*val write_mem_eaS : forall 'regs 'e 'a. Bitvector 'a => write_kind -> 'a -> nat -> monadS 'regs unit 'e*)
+definition write_mem_eaS  :: " 'a Bitvector_class \<Rightarrow> write_kind \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow>('regs,(unit),'e)monadS "  where 
+     " write_mem_eaS dict_Sail_values_Bitvector_a write_kind addr sz = ( bindS
+  (maybe_failS (''unsigned'') (
+  (unsigned_method   dict_Sail_values_Bitvector_a) addr)) (\<lambda> addr . 
+  (let sz = (int sz) in
+  updateS (\<lambda> s .  ( s (| write_ea := (Some (write_kind, addr, sz)) |))))))"
+
+
+(* Write little-endian list of bytes to previously announced address *)
+(*val write_mem_bytesS : forall 'regs 'e. list memory_byte -> monadS 'regs bool 'e*)
+definition write_mem_bytesS  :: "((bitU)list)list \<Rightarrow>('regs,(bool),'e)monadS "  where 
+     " write_mem_bytesS v = ( bindS
+  (readS (\<lambda> s . (write_ea   s))) (\<lambda>x .  
+  (case  x of
+        None => failS (''write ea has not been announced yet'')
+    | Some (_, addr, sz) =>
+  (let addrs = (index_list addr ((addr + sz) - ( 1 :: int)) (( 1 :: int))) in
+  (*let v = external_mem_value (bits_of v) in*)
+  (let a_v = (List.zip addrs v) in
+  (let write_byte = (\<lambda>mem p .  (case  (mem ,p ) of
+                                           ( mem , (addr, v) ) => map_update
+                                                                    addr 
+                                                                  v mem
+                                       )) in
+  seqS
+    (updateS
+       (\<lambda> s . 
+        ( s (| memstate := (List.foldl write_byte (memstate   s) a_v) |))))
+    (returnS True))))
+  )))"
+
+
+(*val write_mem_valS : forall 'regs 'e 'a. Bitvector 'a => 'a -> monadS 'regs bool 'e*)
+definition write_mem_valS  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> 'regs sequential_state \<Rightarrow>(((bool),'e)result*'regs sequential_state)set "  where 
+     " write_mem_valS dict_Sail_values_Bitvector_a v = ( (case  mem_bytes_of_bits 
+  dict_Sail_values_Bitvector_a v of
+    Some v => write_mem_bytesS v
+  | None => failS (''write_mem_val'')
+))"
+
+
+(*val write_tagS : forall 'regs 'a 'e. Bitvector 'a => 'a -> bitU -> monadS 'regs bool 'e*)
+definition write_tagS  :: " 'a Bitvector_class \<Rightarrow> 'a \<Rightarrow> bitU \<Rightarrow>('regs,(bool),'e)monadS "  where 
+     " write_tagS dict_Sail_values_Bitvector_a addr t = ( bindS
+   (maybe_failS (''unsigned'') (
+  (unsigned_method   dict_Sail_values_Bitvector_a) addr)) (\<lambda> addr .  seqS
+   (updateS (\<lambda> s .  ( s (| tagstate := (map_update addr t(tagstate   s)) |))))
+   (returnS True)))"
+
+
+(*val read_regS : forall 'regs 'rv 'a 'e. register_ref 'regs 'rv 'a -> monadS 'regs 'a 'e*)
+definition read_regS  :: "('regs,'rv,'a)register_ref \<Rightarrow> 'regs sequential_state \<Rightarrow>(('a,'e)result*'regs sequential_state)set "  where 
+     " read_regS reg = ( readS (\<lambda> s . (read_from   reg)(regstate   s)))"
+
+
+(* TODO
+let read_reg_range reg i j state =
+  let v = slice (get_reg state (name_of_reg reg)) i j in
+  [(Value (vec_to_bvec v),state)]
+let read_reg_bit reg i state =
+  let v = access (get_reg state (name_of_reg reg)) i in
+  [(Value v,state)]
+let read_reg_field reg regfield =
+  let (i,j) = register_field_indices reg regfield in
+  read_reg_range reg i j
+let read_reg_bitfield reg regfield =
+  let (i,_) = register_field_indices reg regfield in
+  read_reg_bit reg i *)
+
+(*val read_regvalS : forall 'regs 'rv 'e.
+  register_accessors 'regs 'rv -> string -> monadS 'regs 'rv 'e*)
+fun read_regvalS  :: "(string \<Rightarrow> 'regs \<Rightarrow> 'rv option)*(string \<Rightarrow> 'rv \<Rightarrow> 'regs \<Rightarrow> 'regs option)\<Rightarrow> string \<Rightarrow>('regs,'rv,'e)monadS "  where 
+     " read_regvalS (read, _) reg = ( bindS
+  (readS (\<lambda> s .  read reg(regstate   s))) (\<lambda>x .  
+  (case  x of
+        Some v => returnS v
+    | None => failS ((''read_regvalS '') @ reg)
+  )))"
+
+
+(*val write_regvalS : forall 'regs 'rv 'e.
+  register_accessors 'regs 'rv -> string -> 'rv -> monadS 'regs unit 'e*)
+fun write_regvalS  :: "(string \<Rightarrow> 'regs \<Rightarrow> 'rv option)*(string \<Rightarrow> 'rv \<Rightarrow> 'regs \<Rightarrow> 'regs option)\<Rightarrow> string \<Rightarrow> 'rv \<Rightarrow>('regs,(unit),'e)monadS "  where 
+     " write_regvalS (_, write1) reg v = ( bindS
+  (readS (\<lambda> s .  write1 reg v(regstate   s))) (\<lambda>x .  
+  (case  x of
+        Some rs' => updateS (\<lambda> s .  ( s (| regstate := rs' |)))
+    | None => failS ((''write_regvalS '') @ reg)
+  )))"
+
+
+(*val write_regS : forall 'regs 'rv 'a 'e. register_ref 'regs 'rv 'a -> 'a -> monadS 'regs unit 'e*)
+definition write_regS  :: "('regs,'rv,'a)register_ref \<Rightarrow> 'a \<Rightarrow> 'regs sequential_state \<Rightarrow>(((unit),'e)result*'regs sequential_state)set "  where 
+     " write_regS reg v = (
+  updateS (\<lambda> s .  ( s (| regstate := ((write_to   reg) v(regstate   s)) |))))"
+
+
+(* TODO
+val update_reg : forall 'regs 'rv 'a 'b 'e. register_ref 'regs 'rv 'a -> ('a -> 'b -> 'a) -> 'b -> monadS 'regs unit 'e
+let update_reg reg f v state =
+  let current_value = get_reg state reg in
+  let new_value = f current_value v in
+  [(Value (), set_reg state reg new_value)]
+
+let write_reg_field reg regfield = update_reg reg regfield.set_field
+
+val update_reg_range : forall 'regs 'rv 'a 'b. Bitvector 'a, Bitvector 'b => register_ref 'regs 'rv 'a -> integer -> integer -> 'a -> 'b -> 'a
+let update_reg_range reg i j reg_val new_val = set_bits (reg.is_inc) reg_val i j (bits_of new_val)
+let write_reg_range reg i j = update_reg reg (update_reg_range reg i j)
+
+let update_reg_pos reg i reg_val x = update_list reg.is_inc reg_val i x
+let write_reg_pos reg i = update_reg reg (update_reg_pos reg i)
+
+let update_reg_bit reg i reg_val bit = set_bit (reg.is_inc) reg_val i (to_bitU bit)
+let write_reg_bit reg i = update_reg reg (update_reg_bit reg i)
+
+let update_reg_field_range regfield i j reg_val new_val =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = set_bits (regfield.field_is_inc) current_field_value i j (bits_of new_val) in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_range reg regfield i j = update_reg reg (update_reg_field_range regfield i j)
+
+let update_reg_field_pos regfield i reg_val x =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = update_list regfield.field_is_inc current_field_value i x in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_pos reg regfield i = update_reg reg (update_reg_field_pos regfield i)
+
+let update_reg_field_bit regfield i reg_val bit =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = set_bit (regfield.field_is_inc) current_field_value i (to_bitU bit) in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_bit reg regfield i = update_reg reg (update_reg_field_bit regfield i)*)
+
+(* TODO Add Show typeclass for value and exception type *)
+(*val show_result : forall 'a 'e. result 'a 'e -> string*)
+definition show_result  :: "('a,'e)result \<Rightarrow> string "  where 
+     " show_result = ( \<lambda>x .  
+  (case  x of
+        Value _ => (''Value ()'')
+    | Ex (Failure msg) => (''Failure '') @ msg
+    | Ex (Throw _) => (''Throw'')
+  ) )"
+
+
+(*val prerr_results : forall 'a 'e 's. SetType 's => set (result 'a 'e * 's) -> unit*)
+definition prerr_results  :: "(('a,'e)result*'s)set \<Rightarrow> unit "  where 
+     " prerr_results rs = (
+  (let _ = (Set.image ( \<lambda>x .  
+  (case  x of (r, _) => (let _ = (prerr_endline (show_result r)) in () ) )) rs) in
+  () ))"
+
+end
diff --git a/snapshots/isabelle/lib/sail/State_monad_lemmas.thy b/snapshots/isabelle/lib/sail/State_monad_lemmas.thy
new file mode 100644
index 00000000..e0d684ba
--- /dev/null
+++ b/snapshots/isabelle/lib/sail/State_monad_lemmas.thy
@@ -0,0 +1,232 @@
+theory State_monad_lemmas
+  imports
+    State_monad
+    Sail_values_lemmas
+begin
+
+(*context
+  notes returnS_def[simp] and failS_def[simp] and throwS_def[simp] and readS_def[simp] and updateS_def[simp]
+begin*)
+
+lemma bindS_ext_cong[fundef_cong]:
+  assumes m: "m1 s = m2 s"
+    and f: "\<And>a s'. (Value a, s') \<in> (m2 s) \<Longrightarrow> f1 a s' = f2 a s'"
+  shows "bindS m1 f1 s = bindS m2 f2 s"
+  using assms unfolding bindS_def by (auto split: result.splits)
+
+lemma bindS_cong[fundef_cong]:
+  assumes m: "m1 = m2"
+    and f: "\<And>s a s'. (Value a, s') \<in> (m2 s) \<Longrightarrow> f1 a s' = f2 a s'"
+  shows "bindS m1 f1 = bindS m2 f2"
+  using assms by (intro ext bindS_ext_cong; blast)
+
+lemma bindS_returnS_left[simp]: "bindS (returnS x) f = f x"
+  by (auto simp add: bindS_def returnS_def)
+
+lemma bindS_returnS_right[simp]: "bindS m returnS = (m :: ('regs, 'a, 'e) monadS)"
+  by (intro ext) (auto simp: bindS_def returnS_def split: result.splits)
+
+lemma bindS_readS: "bindS (readS f) m = (\<lambda>s. m (f s) s)"
+  by (auto simp: bindS_def readS_def returnS_def)
+
+lemma bindS_updateS: "bindS (updateS f) m = (\<lambda>s. m () (f s))"
+  by (auto simp: bindS_def updateS_def returnS_def)
+
+lemma bindS_assertS_True[simp]: "bindS (assert_expS True msg) f = f ()"
+  by (auto simp: assert_expS_def)
+
+
+lemma result_cases:
+  fixes r :: "('a, 'e) result"
+  obtains (Value) a where "r = Value a"
+  | (Throw) e where "r = Ex (Throw e)"
+  | (Failure) msg where "r = Ex (Failure msg)"
+proof (cases r)
+  case (Ex ex) then show ?thesis by (cases ex; auto intro: that)
+qed
+
+lemma result_state_cases:
+  fixes rs :: "('a, 'e) result \<times> 's"
+  obtains (Value) a s where "rs = (Value a, s)"
+  | (Throw) e s where "rs = (Ex (Throw e), s)"
+  | (Failure) msg s where "rs = (Ex (Failure msg), s)"
+proof -
+  obtain r s where rs: "rs = (r, s)" by (cases rs)
+  then show thesis by (cases r rule: result_cases) (auto intro: that)
+qed
+
+lemma monadS_ext_eqI:
+  fixes m m' :: "('regs, 'a, 'e) monadS"
+  assumes "\<And>a s'. (Value a, s') \<in> m s \<longleftrightarrow> (Value a, s') \<in> m' s"
+    and "\<And>e s'. (Ex (Throw e), s') \<in> m s \<longleftrightarrow> (Ex (Throw e), s') \<in> m' s"
+    and "\<And>msg s'. (Ex (Failure msg), s') \<in> m s \<longleftrightarrow> (Ex (Failure msg), s') \<in> m' s"
+  shows "m s = m' s"
+proof (intro set_eqI)
+  fix x
+  show "x \<in> m s \<longleftrightarrow> x \<in> m' s" using assms by (cases x rule: result_state_cases) auto
+qed
+
+lemma monadS_eqI:
+  fixes m m' :: "('regs, 'a, 'e) monadS"
+  assumes "\<And>s a s'. (Value a, s') \<in> m s \<longleftrightarrow> (Value a, s') \<in> m' s"
+    and "\<And>s e s'. (Ex (Throw e), s') \<in> m s \<longleftrightarrow> (Ex (Throw e), s') \<in> m' s"
+    and "\<And>s msg s'. (Ex (Failure msg), s') \<in> m s \<longleftrightarrow> (Ex (Failure msg), s') \<in> m' s"
+  shows "m = m'"
+  using assms by (intro ext monadS_ext_eqI)
+
+lemma bindS_cases:
+  assumes "(r, s') \<in> bindS m f s"
+  obtains (Value) a a' s'' where "r = Value a" and "(Value a', s'') \<in> m s" and "(Value a, s') \<in> f a' s''"
+  | (Ex_Left) e where "r = Ex e" and "(Ex e, s') \<in> m s"
+  | (Ex_Right) e a s'' where "r = Ex e" and "(Value a, s'') \<in> m s" and "(Ex e, s') \<in> f a s''"
+  using assms by (cases r; auto simp: bindS_def split: result.splits)
+
+lemma bindS_intros:
+  "\<And>m f s a s' a' s''. (Value a', s'') \<in> m s \<Longrightarrow> (Value a, s') \<in> f a' s'' \<Longrightarrow> (Value a, s') \<in> bindS m f s"
+  "\<And>m f s e s'. (Ex e, s') \<in> m s \<Longrightarrow> (Ex e, s') \<in> bindS m f s"
+  "\<And>m f s e s' a s''. (Ex e, s') \<in> f a s'' \<Longrightarrow> (Value a, s'') \<in> m s \<Longrightarrow> (Ex e, s') \<in> bindS m f s"
+  by (auto simp: bindS_def intro: bexI[rotated])
+
+lemma bindS_assoc[simp]: "bindS (bindS m f) g = bindS m (\<lambda>x. bindS (f x) g)"
+  by (auto elim!: bindS_cases intro: bindS_intros monadS_eqI)
+
+lemma bindS_failS[simp]: "bindS (failS msg) f = failS msg" by (auto simp: bindS_def failS_def)
+lemma bindS_throwS[simp]: "bindS (throwS e) f = throwS e" by (auto simp: bindS_def throwS_def)
+declare seqS_def[simp]
+
+lemma Value_bindS_elim:
+  assumes "(Value a, s') \<in> bindS m f s"
+  obtains s'' a' where "(Value a', s'') \<in> m s" and "(Value a, s') \<in> f a' s''"
+  using assms by (auto elim: bindS_cases)
+
+lemma Ex_bindS_elim:
+  assumes "(Ex e, s') \<in> bindS m f s"
+  obtains (Left) "(Ex e, s') \<in> m s"
+  | (Right) s'' a' where "(Value a', s'') \<in> m s" and "(Ex e, s') \<in> f a' s''"
+  using assms by (auto elim: bindS_cases)
+
+lemma try_catchS_returnS[simp]: "try_catchS (returnS a) h = returnS a"
+  and try_catchS_failS[simp]: "try_catchS (failS msg) h = failS msg"
+  and try_catchS_throwS[simp]: "try_catchS (throwS e) h = h e"
+  by (auto simp: try_catchS_def returnS_def failS_def throwS_def)
+
+lemma try_catchS_cong[cong]:
+  assumes "\<And>s. m1 s = m2 s" and "\<And>e s. h1 e s = h2 e s"
+  shows "try_catchS m1 h1 = try_catchS m2 h2"
+  using assms by (intro arg_cong2[where f = try_catchS] ext) auto
+
+lemma try_catchS_cases:
+  assumes "(r, s') \<in> try_catchS m h s"
+  obtains (Value) a where "r = Value a" and "(Value a, s') \<in> m s"
+  | (Fail) msg where "r = Ex (Failure msg)" and "(Ex (Failure msg), s') \<in> m s"
+  | (h) e s'' where "(Ex (Throw e), s'') \<in> m s" and "(r, s') \<in> h e s''"
+  using assms
+  by (cases r rule: result_cases) (auto simp: try_catchS_def returnS_def split: result.splits ex.splits)
+
+lemma try_catchS_intros:
+  "\<And>m h s a s'. (Value a, s') \<in> m s \<Longrightarrow> (Value a, s') \<in> try_catchS m h s"
+  "\<And>m h s msg s'. (Ex (Failure msg), s') \<in> m s \<Longrightarrow> (Ex (Failure msg), s') \<in> try_catchS m h s"
+  "\<And>m h s e s'' r s'. (Ex (Throw e), s'') \<in> m s \<Longrightarrow> (r, s') \<in> h e s'' \<Longrightarrow> (r, s') \<in> try_catchS m h s"
+  by (auto simp: try_catchS_def returnS_def intro: bexI[rotated])
+
+lemma no_Ex_basic_builtins[simp]:
+  "\<And>s e s' a. (Ex e, s') \<in> returnS a s \<longleftrightarrow> False"
+  "\<And>s e s' f. (Ex e, s') \<in> readS f s \<longleftrightarrow> False"
+  "\<And>s e s' f. (Ex e, s') \<in> updateS f s \<longleftrightarrow> False"
+  "\<And>s e s' xs. (Ex e, s') \<in> chooseS xs s \<longleftrightarrow> False"
+  by (auto simp: readS_def updateS_def returnS_def chooseS_def)
+
+fun ignore_throw_aux :: "(('a, 'e1) result \<times> 's) \<Rightarrow> (('a, 'e2) result \<times> 's) set" where
+  "ignore_throw_aux (Value a, s') = {(Value a, s')}"
+| "ignore_throw_aux (Ex (Throw e), s') = {}"
+| "ignore_throw_aux (Ex (Failure msg), s') = {(Ex (Failure msg), s')}"
+definition "ignore_throw m s \<equiv> \<Union>(ignore_throw_aux ` m s)"
+
+lemma ignore_throw_cong:
+  assumes "\<And>s. m1 s = m2 s"
+  shows "ignore_throw m1 = ignore_throw m2"
+  using assms by (auto simp: ignore_throw_def)
+
+lemma ignore_throw_aux_member_simps[simp]:
+  "(Value a, s') \<in> ignore_throw_aux ms \<longleftrightarrow> ms = (Value a, s')"
+  "(Ex (Throw e), s') \<in> ignore_throw_aux ms \<longleftrightarrow> False"
+  "(Ex (Failure msg), s') \<in> ignore_throw_aux ms \<longleftrightarrow> ms = (Ex (Failure msg), s')"
+  by (cases ms rule: result_state_cases; auto)+
+
+lemma ignore_throw_member_simps[simp]:
+  "(Value a, s') \<in> ignore_throw m s \<longleftrightarrow> (Value a, s') \<in> m s"
+  "(Value a, s') \<in> ignore_throw m s \<longleftrightarrow> (Value a, s') \<in> m s"
+  "(Ex (Throw e), s') \<in> ignore_throw m s \<longleftrightarrow> False"
+  "(Ex (Failure msg), s') \<in> ignore_throw m s \<longleftrightarrow> (Ex (Failure msg), s') \<in> m s"
+  by (auto simp: ignore_throw_def)
+
+lemma ignore_throw_cases:
+  assumes no_throw: "ignore_throw m s = m s"
+    and r: "(r, s') \<in> m s"
+  obtains (Value) a where "r = Value a"
+  | (Failure) msg where "r = Ex (Failure msg)"
+  using r unfolding no_throw[symmetric]
+  by (cases r rule: result_cases) (auto simp: ignore_throw_def)
+
+lemma ignore_throw_bindS[simp]:
+  "ignore_throw (bindS m f) = bindS (ignore_throw m) (ignore_throw \<circ> f)"
+  by (intro monadS_eqI) (auto simp: ignore_throw_def elim!: bindS_cases intro: bindS_intros)
+
+lemma try_catchS_bindS_no_throw:
+  fixes m1 :: "('r, 'a, 'e1) monadS" and m2 :: "('r, 'a, 'e2) monadS"
+  assumes m1: "\<And>s. ignore_throw m1 s = m1 s"
+    and m2: "\<And>s. ignore_throw m1 s = m2 s"
+  shows "try_catchS (bindS m1 f) h = bindS m2 (\<lambda>a. try_catchS (f a) h)"
+proof
+  fix s
+  have "try_catchS (bindS m1 f) h s = bindS (ignore_throw m1) (\<lambda>a. try_catchS (f a) h) s"
+    by (intro monadS_ext_eqI;
+        auto elim!: bindS_cases try_catchS_cases elim: ignore_throw_cases[OF m1];
+        auto simp: ignore_throw_def intro: bindS_intros try_catchS_intros)
+  also have "\<dots> = bindS m2 (\<lambda>a. try_catchS (f a) h) s" using m2 by (intro bindS_ext_cong) auto
+  finally show "try_catchS (bindS m1 f) h s = bindS m2 (\<lambda>a. try_catchS (f a) h) s" .
+qed
+
+lemma no_throw_basic_builtins[simp]:
+  "ignore_throw (returnS a) = returnS a"
+  "\<And>f. ignore_throw (readS f) = readS f"
+  "\<And>f. ignore_throw (updateS f) = updateS f"
+  "ignore_throw (chooseS xs) = chooseS xs"
+  "ignore_throw (failS msg) = failS msg"
+  "ignore_throw (maybe_failS msg x) = maybe_failS msg x"
+  unfolding ignore_throw_def returnS_def chooseS_def maybe_failS_def failS_def readS_def updateS_def
+  by (intro ext; auto split: option.splits)+
+
+lemmas ignore_throw_option_case_distrib =
+  option.case_distrib[where h = "\<lambda>c. ignore_throw c s" and option = "c s" for c s]
+
+lemma no_throw_mem_builtins:
+  "\<And>BC rk a sz s. ignore_throw (read_mem_bytesS BC rk a sz) s = read_mem_bytesS BC rk a sz s"
+  "\<And>BC a s. ignore_throw (read_tagS BC a) s = read_tagS BC a s"
+  "\<And>BC wk a sz s. ignore_throw (write_mem_eaS BC wk a sz) s = write_mem_eaS BC wk a sz s"
+  "\<And>v s. ignore_throw (write_mem_bytesS v) s = write_mem_bytesS v s"
+  "\<And>BC v s. ignore_throw (write_mem_valS BC v) s = write_mem_valS BC v s"
+  "\<And>BC a t s. ignore_throw (write_tagS BC a t) s = write_tagS BC a t s"
+  "\<And>s. ignore_throw (excl_resultS ()) s = excl_resultS () s"
+  "\<And>s. ignore_throw (undefined_boolS ()) s = undefined_boolS () s"
+  unfolding read_mem_bytesS_def read_memS_def read_tagS_def write_mem_eaS_def
+  unfolding write_mem_valS_def write_mem_bytesS_def write_tagS_def
+  unfolding excl_resultS_def undefined_boolS_def
+  by (auto cong: bindS_cong bindS_ext_cong ignore_throw_cong option.case_cong
+           simp: option.case_distrib prod.case_distrib ignore_throw_option_case_distrib comp_def)
+
+lemma no_throw_read_memS: "ignore_throw (read_memS BCa BCb rk a sz) s = read_memS BCa BCb rk a sz s"
+  by (auto simp: read_memS_def no_throw_mem_builtins cong: bindS_ext_cong)
+
+lemma no_throw_read_regvalS: "ignore_throw (read_regvalS r reg_name) s = read_regvalS r reg_name s"
+  by (cases r) (auto simp: option.case_distrib cong: bindS_cong option.case_cong)
+
+lemma no_throw_write_regvalS: "ignore_throw (write_regvalS r reg_name v) s = write_regvalS r reg_name v s"
+  by (cases r) (auto simp: option.case_distrib cong: bindS_cong option.case_cong)
+
+lemmas no_throw_builtins[simp] =
+  no_throw_mem_builtins no_throw_read_regvalS no_throw_write_regvalS no_throw_read_memS
+
+(* end *)
+
+end