Merge from LFSC (#26)

* Showing models as coq counter examples in tactic without constructing coq terms * also read models when calling cvc4 with a file (deactivated because cvc4 crashes) * Show counter examples with variables in the order they are quantified in the Coq goal * Circumvent issue with ocamldep * fix issue with dependencies * fix issue with dependencies * Translation and OCaml support for extract, zero_extend, sign_extend * Show run times of components * print time on stdout instead * Tests now work with new version (master) of CVC4 * fix small printing issue * look for date on mac os x * proof of valid_check_bbShl: some cases to prove. * full proof of "left shift checker". * full proof of "rigth shift checker". * Support translation of terms bvlshr, bvshl but LFSC rules do not exists at the moment Bug fix for bitvector extract (inverted arguments) * Typo * More modularity on the format of traces depending on the version of coq * More straightforward definitions in Int63Native_standard * Use the Int31 library with coq-8.5 * Use the most efficient operations of Int31 * Improved performance with coq-8.5 * Uniform treatment of sat and smt tactics * Hopefully solved the problem with universes for the tactic * Updated the installation instructions * Holes for unsupported bit blasting rules * Cherry-picking from smtcoq/smtcoq * bug fix hole for bitblast * Predefined arrays are not required anymore * fix issue with coq bbT and bitof construction from ocaml * bug fix in smtAtom for uninterpreted functions fix verit test file * fix issue with smtlib2 extract parsing * It looks like we still need the PArray function instances for some examples (see vmcai_bytes.smt2) * Solver specific reification: Each solver has a list of supported theories which is passed to Atom.of_coq, this function creates uninterpreted functions / sorts for unsupported features. * show counter-examples with const_farray instead of const for constant array definitions * Vernacular commands to debug checkers. Verit/Lfsc_Checker_Debug will always fail, reporting the first proof step of the certificate that failed be checked * Update INSTALL.md * show smtcoq proof when converting * (Hopefully) repared the universes problems * Corrected a bug with holes in proofs * scripts for tests: create a folder "work" under "lfsc/tests/", locate the benchmarks there. create a folder "results" under "lfsc/tests/work/" in which you'll find the results of ./cvc4tocoq. * make sure to give correct path for your benchs... * Checker for array extensionality modulo symmetry of equality * fix oversight with bitvectors larger than 63 bits * some printing functions for smt2 ast * handle smtlib2 files with more complicated equivalence with (= ... ) * revert: ./cvc4tocoq does not output lfsc proofs... * bug fix one input was ignored * Don't show verit translation of LFSC proof if environment variable DONTSHOWVERIT is set (e.g. put export DONTSHOWVERIT="" in your .bashrc or .bashprofile) * Also sort names of introduced variables when showing counter-example * input files for which SMTCoq retuns false. * input files for which SMTCoq retuns false. * use debug checker for debug file * More efficient debug checker * better approximate number of failing step of certificate in debug checker * fix mistake in ml4 * very first attempt to support goals in Prop * bvs: comparison predicates in Prop and their <-> proofs with the ones in bool farrays: equality predicate in Prop and its <-> proof with the one in bool. * unit, Bool, Z, Pos: comparison and equality predicates in Prop. * a typo fixed. * an example of array equality in Prop (converted into Bool by hand)... TODO: enhance the search space of cvc4 tactic. * first version of cvc4' tactic: "solves" the goals in Prop. WARNING: supports only bv and array goals and might not be complete TODO: add support for lia goals * cvc4' support for lia WARNING: might not be complete! * small fix in cvc4' and some variations of examples * small fix + support for goals in Bool and Bool = true + use of solve tactical WARNING: does not support UF and INT63 goals in Prop * cvc4': better arrangement * cvc4': Prop2Bool by context search... * cvc4': solve tactial added -> do not modify unsolved goals. * developer documentation for the smtcoq repo * cvc4': rudimentary support for uninterpreted function goals in Prop. * cvc4': support for goals with Leibniz equality... WARNING: necessary use of "Grab Existential Variables." to instantiate variable types for farrays! * cvc4': Z.lt adapted + better support from verit... * cvc4': support for Z.le, Z.ge, Z.gt. * Try arrays with default value (with a constructor for constant arrays), but extensionality is not provable * cvc4': support for equality over uninterpreted types * lfsc demo: goals in Coq's Prop. * lfsc demo: goals in Bool. * Fix issue with existential variables generated by prop2bool. - prop2bool tactic exported by SMTCoq - remove useless stuff * update usage and installation instructions * Update INSTALL.md * highlighting * the tactic: bool2prop. * clean up * the tactic smt: very first version. * smt: return unsolved goals in Prop. * Show when a certificate cannot be checked when running the tactic instead of at Qed * Tactic improvements - Handle negation/True/False in prop/bool conversions tactic. - Remove alias for farray (this caused problem for matching on this type in tactics). - Tactic `smt` that combines cvc4 and veriT. - return subgoals in prop * test change header * smt: support for negated goals + some reorganization. * conflicts resolved + some reorganization. * a way to solve the issue with ambiguous coercions. * reorganization. * small change. * another small change. * developer documentation of the tactics. * developer guide: some improvements. * developer guide: some more improvements. * developer guide: some more improvements. * developer guide: some more improvements. * pass correct environment for conversion + better error messages * cleaning * ReflectFacts added. * re-organizing developers' guide. * re-organizing developers' guide. * re-organizing developers' guide. * removing unused maps. * headers. * artifact readme getting started... * first attempt * second... * third... * 4th... * 5th... * 6th... * 7th... * 8th... * 9th... * 10th... * 11th... * 12th... * 13th... * 14th... * 15th... * 16th... * 17th... * Update artifact.md Use links to lfsc repository like in the paper * 18th... * 19th... * 20th... * 21st... * 22nd... * 23rd... * 24th... * 25th... * 26th... * 27th... * 28th... * Update artifact.md Small reorganization * minor edits * More minor edits * revised description of tactics * Final pass * typo * name changed: artifact-readme.md * file added... * passwd chaged... * links... * removal * performance statement... * typos... * the link to the artifact image updated... * suggestions by Guy... * aux files removed... * clean-up... * clean-up... * some small changes... * small fix... * additional information on newly created files after running cvc4tocoq script... * some small fix... * another small fix... * typo... * small fix... * another small fix... * fix... * link to the artifact image... * We do not want to force vm_cast for the Theorem commands * no_check variants of the tactics * TODO: a veriT test does not work anymore * Compiles with both versions of Coq * Test of the tactics in real conditions * Comment on this case study * an example for the FroCoS paper. * Fix smt tactic that doesn't return cvc4's subgoals * readme modifications * readme modifications 2 * small typo in readme. * small changes in readme. * small changes in readme. * typo in readme. * Sync with https://github.com/LFSC/smtcoq * Port to Coq 8.6 * README * README * INSTALL * Missing file * Yves' proposition for installation instructions * Updated link to CVC4 * Compiles again with native-coq * Compiles with both versions of Coq * Command to bypass typechecking when generating a zchaff theorem * Solved bug on cuts from Hole * Counter-models for uninterpreted sorts (improves issue #13) * OCaml version note (#15) * update .gitignore * needs OCaml 4.04.0 * Solving merge issues (under progress) * Make SmtBtype compile * Compilation of SmtForm under progress * Make SmtForm compile * Make SmtCertif compile * Make SmtTrace compile * Make SatAtom compile * Make smtAtom compile * Make CnfParser compile * Make Zchaff compile * Make VeritSyntax compile * Make VeritParser compile * Make lfsc/tosmtcoq compile * Make smtlib2_genconstr compile * smtCommand under progress * smtCommands and verit compile again * lfsc compiles * ml4 compiles * Everything compiles * All ZChaff unit tests and most verit unit tests (but taut5 and un_menteur) go through * Most LFSC tests ok; some fail due to the problem of verit; a few fail due to an error "Not_found" to investigate * Authors and headings * Compiles with native-coq * Typo
author: ckeller <ckeller@users.noreply.github.com> 2019-01-28 23:19:12 +0100
committer: GitHub <noreply@github.com> 2019-01-28 23:19:12 +0100
commit: 7021c53d4ecf97c82ccebb6bb45f5305d8b482ea (patch)
tree: ba7537e1e813cabf9ee0d910f845c71fa5f446e7
parent: 36548d6634864a131cc83ce21491c797163de305 (diff)
download: smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.tar.gz
smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.zip
213 files changed, 39604 insertions, 2190 deletions
diff --git a/.gitignore b/.gitignore
index 75736be..3199ccb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,42 +1,81 @@
 *.annot
+
+# ocamlbuild working directory
+_build/
+
+# ocamlbuild targets
+*.byte
+*.native
+
+# oasis generated files
+setup.data
+setup.log
+
+# generated by coq
+*.glob
+*.v.d
+*.aux
+*.vo
+*.d
+.lia.cache
+.nia.cache
+
+# cp targets of src/configure.sh:
+src/Makefile
+src/smtcoq_plugin.ml4
+src/versions/native/Structures.v
+src/g_smtcoq.ml4
+src/smtcoq_plugin.mlpack
+src/versions/standard/Int63/Int63.v
+src/versions/standard/Int63/Int63Native.v
+src/versions/standard/Int63/Int63Op.v
+src/versions/standard/Int63/Int63Axioms.v
+src/versions/standard/Int63/Int63Properties.v
+src/versions/standard/Array/PArray.v
+src/versions/standard/Structures.v
+
+# generated by the Makefile
+src/uninstall_me.sh
+
+# .ml files generated by ocamllex from a .mll, regenerate list using
+# find . -name '*.mll' | sed -e 's/^.\(.*\).$/\1/g'
+/src/smtlib2/smtlib2_lex.ml
+/src/smtlib2/sExprLexer.ml
+/src/lfsc/lfscLexer.ml
+/src/verit/veritLexer.ml
+
+# .ml files generated by ocamlyacc from a .mly, regenerate list using
+# find . -name '*.mly' | sed -e 's/^.\(.*\).$/\1/g'
+/src/smtlib2/sExprParser.ml
+/src/smtlib2/smtlib2_parse.ml
+/src/lfsc/lfscParser.ml
+/src/verit/veritParser.ml
+
+# .mli files generated by ocamlyacc from a .mly, regenerate list using
+find . -name '*.mly' | sed -e 's/^.\(.*\).$/\1i/g'
+/src/smtlib2/sExprParser.mli
+/src/smtlib2/smtlib2_parse.mli
+/src/lfsc/lfscParser.mli
+/src/verit/veritParser.mli
+
+# compiled OCaml files
 *.cmt
 *.cmti
-*.vtlog
-*.zlog
-*.cache
 *.cmi
 *.cmo
+*.cma
 *.cmx
 *.cmxs
 *.cmxa
 *.ml.d
 *.mli.d
 *.ml4.d
-*.native
 *.o
 *.a
-*.glob
-*.vo
-*.v.d
-*.aux
 *.mlpack.d
-src/Makefile
 src/extraction/.Makefile.swp
 src/extraction/smtcoq
-src/smtcoq_plugin.ml4
-src/smtlib2/smtlib2_parse.ml
-src/verit/veritParser.ml
-src/versions/native/Structures.v
-src/g_smtcoq.ml4
-src/smtcoq_plugin.mlpack
-src/smtlib2/smtlib2_lex.ml
-src/smtlib2/smtlib2_parse.mli
-src/verit/veritLexer.ml
-src/verit/veritParser.mli
-src/versions/standard/Array/PArray.v
-src/versions/standard/Int63/Int63.v
-src/versions/standard/Int63/Int63Axioms.v
-src/versions/standard/Int63/Int63Native.v
-src/versions/standard/Int63/Int63Op.v
-src/versions/standard/Int63/Int63Properties.v
-src/versions/standard/Structures.v
+
+# proof certificates
+*.vtlog
+*.zlog
diff --git a/AUTHORS b/AUTHORS
new file mode 100644
index 0000000..48c4e63
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1,15 @@
+Authors:
+  Michaël Armand
+  Valentin Blot
+  Amina Bousalem
+  Quentin Garchery
+  Benjamin Grégoire
+  Chantal Keller
+  Burak Ekici
+  Alain Mebsout
+
+Institutes:
+  École Polytechnique
+  Inria
+  The University of Iowa
+  Université Paris-Sud
diff --git a/INSTALL.md b/INSTALL.md
index c578b83..0eac582 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -4,42 +4,109 @@
 
 SMTCoq is designed to work on computers equipped with a POSIX (Unix or a
 clone) operating system. It is known to work under GNU/Linux (i386 and
-amd64).
+amd64) and Mac OS X.
 
-You can install it from the sources, using two different versions
-  of Coq (depending on the efficiency you want).
-In either case, you will also need to install the provers you want to
-use (see below).
+For now you have to install it from the sources. (We plan on releasing
+an updated opam package soon with the latest additions.)
 
+You will also need to [install the provers](#installation-of-the-provers)
+you want to use and make some [small configuration
+changes](#setting-up-environment-for-smtcoq).
 
-## Installation from the sources (uses Coq-8.6 or native-coq)
+## Requirements
 
-You can also build SMTCoq from the sources, using either Coq 8.6 or the
-[version of Coq with native data-structures](https://github.com/smtcoq/native-coq).
-We recommend Coq 8.6 for standard use, and native-coq for uses that
-require very efficient computation (such as checking big certificates).
+You need to have OCaml version >= 4.04.0 and Coq version 8.6 or 8.6.1.
+The easiest way to install these two pieces of software is through opam.
 
+> **Warning**: The version of Coq that you plan to use must have been compiled
+> with the same version of OCaml that you are going to use to compile
+> SMTCoq. In particular this means you want a version of Coq that was compiled
+> with OCaml version >= 4.04.0.
 
-### Installation with Coq 8.6
+If you want to use SMTCoq with high performance, you need to use the
+[version of Coq with native
+data-structures](https://github.com/smtcoq/native-coq) instead of
+Coq-8.6.
 
-It requires OCaml between versions 4.02 and 4.05 (included). OCaml
-4.04.0 is reported to work with Coq 8.6.1 and SMTCoq df1a51d.
 
-1. Download the last stable version of Coq 8.6:
+### Installation with Coq and OCaml opam packages
+
+#### Install opam
+
+We recommended to install the required packages from
+[opam](https://opam.ocaml.org). Once you have installed opam on your system you
+should issue the following command:
+
+```bash
+opam init
+```
+
+which will initialize the opam installation and prompt for modifying the shell
+init file.
+
+Once opam is installed you should still issue
+
+```bash
+eval `opam config env`
 ```
+
+(this is not necessary if you start another session in your shell).
+
+#### Install OCaml
+
+Now you can install an OCaml compiler (we recommend 4.04.0 or the latest
+release):
+
+```bash
+opam switch 4.04.0
+```
+
+#### Install Coq
+
+After OCaml is installed, you can install Coq through opam (we recommend 8.6.1).
+
+```bash
+opam install coq.8.6.1
+```
+
+If you also want to install CoqIDE at the same time you can do
+
+```bash
+opam install coq.8.6.1 coqide.8.6.1
+```
+
+but you might need to install some extra packages and libraries for your system
+(such as GTK2, gtksourceview2, etc.).
+
+
+#### Install SMTCoq
+
+Compile and install SMTCoq by using the following commands in the src directory.
+
+```bash
+./configure.sh
+make
+make install
+```
+
+
+### Installation with official Coq 8.6 release
+
+1. Download the last stable version of Coq 8.6:
+```bash
 wget https://coq.inria.fr/distrib/8.6.1/files/coq-8.6.1.tar.gz
 ```
    and compile it by following the instructions available in the
-   repository. We recommand that you do not install it, but only compile
-   it in local:
-```
+   repository (make sure you use OCaml 4.04.0 for that). We recommand
+   that you do not install it, but only compile it in local:
+```bash
 ./configure -local
 make
 ```
 
 2. Set an environment variable COQBIN to the directory where Coq's
    binaries are; for instance:
-```
+```bash
 export COQBIN=/home/jdoe/coq-8.6.1/bin/
 ```
    (the final slash is mandatory).
@@ -50,25 +117,26 @@ export COQBIN=/home/jdoe/coq-8.6.1/bin/
 make
 make install
 ```
+```
 
 
 ### Installation with native-coq
 
 1. Download the git version of Coq with native compilation:
-```
+```bash
 git clone https://github.com/smtcoq/native-coq.git
 ```
    and compile it by following the instructions available in the
    repository. We recommand that you do not install it, but only compile
    it in local:
-```
+```bash
 ./configure -local
 make
 ```
 
 2. Set an environment variable COQBIN to the directory where Coq's
    binaries are; for instance:
-```
+```bash
 export COQBIN=/home/jdoe/native-coq/bin/
 ```
    (the final slash is mandatory).
@@ -81,16 +149,15 @@ make install
 ```
 
 
-## Deprecated: installation via opam (uses Coq-8.5)
+### Deprecated: installation via opam (uses Coq-8.5)
 
 Simply add the coq-extra-dev repo to opam:
-```
+```bash
 opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev
 ```
 and install smtcoq:
-```
+```bash
 opam install coq-smtcoq
-```
 
 
 ## Installation of the provers
@@ -102,12 +169,24 @@ Currently, these solvers are:
 
 - [zChaff](http://www.princeton.edu/~chaff/zchaff.html)
 
+- [CVC4](http://cvc4.cs.nyu.edu)
+
 Please download the solvers you would like to use via the above links
 (since SMTCoq might not support other versions), and follow the
 instructions available for each solver in order to compile them **in a
 proof production mode**, as detailed below.
 
 
+### CVC4
+
+Use the version of CVC4 that is available in the master branch of its
+[git repository](https://github.com/CVC4/CVC4) or one of the **development**
+versions available at [http://cvc4.cs.stanford.edu/downloads] (we recommend using
+the latest version available).
+
+The `cvc4` binary must be present in your PATH to use it through SMTCoq.
+
+
 ### veriT
 
 The
@@ -135,3 +214,61 @@ please report an issue.
 
 To turn proof production on, you need to uncomment the line
 `// #define VERIFY_ON ` in `zchaff_solver.cpp`.
+
+The `zchaff` binary must be present in your PATH to use it through SMTCoq.
+
+
+## Setting up environment for SMTCoq
+
+To use the latest features of SMTCoq, you need to make these configuration
+changes:
+
+In your `.bashrc` (or `.bash_profile`, or any other initialization file read by
+your shell), export the following environment variable to make it point at the
+`signatures` directory distributed with SMTCoq.
+
+> Don't use `~` in the path but rather `$HOME`.
+
+```bash
+export LFSCSIGS="$HOME/path/to/smtcoq/src/lfsc/tests/signatures/"
+```
+
+If you don't want SMTCoq to spit the translated proof in your proof environment
+window, add the following optional definition (in the same file).
+
+```bash
+export DONTSHOWVERIT="yes"
+```
+
+### Using SMTCoq without installing
+
+If you want to use SMTCoq without installing it your Coq installation, you can
+tell Coq where to find SMTCoq by adding the following line in the file
+`~/.config/coqrc`:
+
+```coq
+Add Rec LoadPath "~/path/to/smtcoq/src" as SMTCoq.
+```
+
+
+### Emacs and ProofGeneral
+
+If you use Emacs and ProofGeneral for Coq development, we recommend to use the
+package [exec-path-from-shell](https://github.com/purcell/exec-path-from-shell)
+(which can be installed with `M-x package-install exec-path-from-shell`) and to
+add the following in your `.emacs`:
+
+```elisp
+(exec-path-from-shell-initialize)
+```
+
+This will make emacs use the same environment as your shell. This is also
+particularly useful if you have installed Coq and OCaml from opam.
+
+
+### Warning about CoqIDE
+
+The latest versions of CoqIDE can now check Coq scripts in parallel. This
+feature is very useful but it seems SMTCoq doesn't work with it. This means
+that if you use any of the SMTCoq tactics or vernacular commands, we suggest to
+instruct CoqIDE to go through the script step-by-step.
diff --git a/README.md b/README.md
index 4e960d6..0f275b6 100644
--- a/README.md
+++ b/README.md
@@ -5,11 +5,13 @@ SAT and SMT solvers.
 
 It relies on a certified checker for such witnesses. On top of it,
 vernacular commands and tactics to interface with the SAT solver zChaff
-and the SMT solver veriT are provided. It is designed in a modular way
+and the SMT solvers veriT and CVC4 are provided. It is designed in a modular way
 allowing to extend it easily to other solvers.
 
+<!--- Extraction is probably broken
 SMTCoq also provides an extracted version of the checker, that can be
 run outside Coq.
+--->
 
 The current stable version is version 1.3.
 
@@ -33,34 +35,41 @@ easily re-usable for your own usage.
 
 #### Overview
 
-The SMTCoq module can be used in Coq files via the `Require Import
-SMTCoq.` command. For each supported solver, it provides:
+After installation, the SMTCoq module can be used in Coq files via the
+`Require Import SMTCoq.` command. For each supported solver, it
+provides:
 
-- a vernacular command to check answers:
-  `XXX_Checker "problem_file" "witness_file"` returns `true` only if
-  `witness_file` contains a zChaff proof of the unsatisfiability of the
-  problem stated in `problem_file`;
+- a vernacular command to check answers: `XXX_Checker "problem_file"
+  "witness_file"` returns `true` only if `witness_file` contains a proof
+  of the unsatisfiability of the problem stated in `problem_file`;
 
 - a vernacular command to safely import theorems:
   `XXX_Theorem theo "problem_file" "witness_file"` produces a Coq term
-  `teo` whose type is the theorem stated in `problem_file` if
+  `theo` whose type is the theorem stated in `problem_file` if
   `witness_file` is a proof of the unsatisfiability of it, and fails
   otherwise.
 
-- a safe tactic to try to solve a Coq goal using the chosen solver.
+- safe tactics to try to solve a Coq goal using the chosen solver (or a
+  combination of solvers).
 
+<!--- Extraction is probably broken
 The SMTCoq checker can also be extracted to OCaml and then used
 independently from Coq.
+--->
 
+We now give more details for each solver.
+
+<!--- Extraction is probably broken
 We now give more details for each solver, and explanations on
 extraction.
+--->
 
 
 #### zChaff
 
 Compile and install zChaff as explained in the installation
 instructions. In the following, we consider that the command `zchaff` is
-in your `PATH` variable environment.
+in your `PATH` environment variable.
 
 
 ##### Checking zChaff answers of unsatisfiability and importing theorems
@@ -72,7 +81,7 @@ To check the result given by zChaff on an unsatisfiable dimacs file
   produces a proof witness file named `resolve_trace`.
 
 - In a Coq file `file.v`, put:
-```
+```coq
 Require Import SMTCoq.
 Zchaff_Checker "file.cnf" "resolve_trace".
 ```
@@ -82,7 +91,7 @@ Zchaff_Checker "file.cnf" "resolve_trace".
 
 - You can also produce Coq theorems from zChaff proof witnesses: the
   commands
-```
+```coq
 Require Import SMTCoq.
 Zchaff_Theorem theo "file.cnf" "resolve_trace".
 ```
@@ -93,17 +102,18 @@ will produce a Coq term `theo` whose type is the theorem stated in
 ##### zChaff as a Coq decision procedure
 
 The `zchaff` tactic can be used to solve any goal of the form:
-```
+```coq
 forall l, b1 = b2
 ```
-where `l` is a list of Booleans (that can be concrete terms).
+where `l` is a quantifier-free list of variables and `b1` and `b2` are
+expressions of type `bool`.
 
 
 #### veriT
 
 Compile and install veriT as explained in the installation instructions.
 In the following, we consider that the command `veriT` is in your `PATH`
-variable environment.
+environment variable.
 
 
 ##### Checking veriT answers of unsatisfiability and importing theorems
@@ -112,13 +122,13 @@ To check the result given by veriT on an unsatisfiable SMT-LIB2 file
 `file.smt2`:
 
 - Produce a veriT proof witness:
-```
+```coq
 veriT --proof-prune --proof-merge --proof-with-sharing --cnf-definitional --disable-e --disable-ackermann --input=smtlib2 --proof=file.log file.smt2
 ```
 This command produces a proof witness file named `file.log`.
 
 - In a Coq file `file.v`, put:
-```
+```coq
 Require Import SMTCoq.
 Section File.
   Verit_Checker "file.smt2" "file.log".
@@ -128,9 +138,9 @@ End File.
 - Compile `file.v`: `coqc file.v`. If it returns `true` then veriT
   indeed proved that the problem was unsatisfiable.
 
-- You can also produce Coq theorems from zChaff proof witnesses: the
+- You can also produce Coq theorems from veriT proof witnesses: the
   commands
-```
+```coq
 Require Import SMTCoq.
 Section File.
   Verit_Theorem theo "file.smt2" "file.log".
@@ -139,16 +149,105 @@ End File.
 will produce a Coq term `theo` whose type is the theorem stated in
 `file.smt2`.
 
-The theories that are currently supported are `QF_UF`, `QF_LIA`,
-`QF_IDL` and their combinations.
+The theories that are currently supported by these commands are `QF_UF`
+(theory of equality), `QF_LIA` (linear integer arithmetic), `QF_IDL`
+(integer difference logic), and their combinations.
 
 
 ##### veriT as a Coq decision procedure
 
-The `verit` tactic can be used to solve any goal of the form:
+The `verit_bool` tactic can be used to solve any goal of the form:
+```coq
+forall l, b1 = b2
+```
+where `l` is a quantifier-free list of variables and `b1` and `b2` are
+expressions of type `bool`.
+
+In addition, the `verit` tactic applies to Coq goals of sort `Prop`: it
+first converts the goal into a term of type `bool` (thanks to the
+`reflect` predicate of `SSReflect`), and then calls the previous tactic
+`verit_bool`.
+
+The theories that are currently supported by these tactics are `QF_UF`
+(theory of equality), `QF_LIA` (linear integer arithmetic), `QF_IDL`
+(integer difference logic), and their combinations.
+
+
+#### CVC4
+
+Compile and install `CVC4` as explained in the installation
+instructions. In the following, we consider that the command `cvc4` is
+in your `PATH` environment variable.
+
+
+##### Checking CVC4 answers of unsatisfiability and importing theorems
+
+To check the result given by CVC4 on an unsatisfiable SMT-LIB2 file
+`name.smt2`:
+
+- Produce a CVC4 proof witness:
+
+```bash
+cvc4 --dump-proof --no-simplification --fewer-preprocessing-holes --no-bv-eq --no-bv-ineq --no-bv-algebraic name.smt2 > name.lfsc
 ```
+
+This set of commands produces a proof witness file named `name.lfsc`.
+
+- In a Coq file `name.v`, put:
+```coq
+Require Import SMTCoq Bool List.
+Import ListNotations BVList.BITVECTOR_LIST FArray.
+Local Open Scope list_scope.
+Local Open Scope farray_scope.
+Local Open Scope bv_scope.
+
+Section File.
+  Lfsc_Checker "name.smt2" "name.lfsc".
+End File.
+```
+
+- Compile `name.v`: `coqc name.v`. If it returns `true` then the problem
+  is indeed unsatisfiable.
+
+NB: Use `cvc4tocoq` script in `src/lfsc/tests` to automatize the above steps.
+
+- Ex: `./cvc4tocoq name.smt2` returns `true` only if the problem
+  `name.smt2` has been proved unsatisfiable by CVC4.
+
+The theories that are currently supported by these commands are `QF_UF`
+(theory of equality), `QF_LIA` (linear integer arithmetic), `QF_IDL`
+(integer difference logic), `QF_BV` (theory of fixed-size bit vectors),
+`QF_A` (theory of arrays), and their combinations.
+
+
+##### CVC4 as a Coq decision procedure
+
+The `cvc4_bool` tactic can be used to solve any goal of the form:
+```coq
 forall l, b1 = b2
 ```
-where `l` is a list of Booleans. Those Booleans can be any concrete
-terms. The theories that are currently supported are `QF_UF`, `QF_LIA`,
-`QF_IDL` and their combinations.
+
+where `l` is a quantifier-free list of variables and `b1` and `b2` are
+expressions of type `bool`.
+
+In addition, the `cvc4` tactic applies to Coq goals of sort `Prop`: it
+ first converts the goal into a term of type `bool` (thanks to the
+ `reflect` predicate of `SSReflect`), it then calls the previous tactic
+ `cvc4_bool`, and it finally converts any unsolved subgoals returned by
+ CVC4 back to `Prop`, thus offering to the user the possibility to solve
+ these (usually simpler) subgoals.
+
+The theories that are currently supported by these tactics are `QF_UF`
+(theory of equality), `QF_LIA` (linear integer arithmetic), `QF_IDL`
+(integer difference logic), `QF_BV` (theory of fixed-size bit vectors),
+`QF_A` (theory of arrays), and their combinations.
+
+
+### The smt tactic
+
+The more powerful tactic `smt` combines all the previous tactics: it
+first converts the goal to a term of type `bool` (thanks to the
+`reflect` predicate of `SSReflect`), it then calls a combination of the
+`cvc4_bool` and `verit_bool` tactics, and it finally converts any
+unsolved subgoals back to `Prop`, thus offering to the user the
+possibility to solve these (usually simpler) subgoals.
diff --git a/doc/artifact-readme.md b/doc/artifact-readme.md
new file mode 100644
index 0000000..47c6332
--- /dev/null
+++ b/doc/artifact-readme.md
@@ -0,0 +1,257 @@
+# SMTCoq artifact
+
+SMTCoq is a Coq tool that can be used to dispatch goals to external SAT and SMT solvers
+or simply to check proof witnesses produced by them.
+It currenly supports the quantifier free fragments of the SMT-LIB theories of fixed-sized bit-vectors (`QF_BV`),
+functional arrays (`QF_A`), linear integer arithmetic (`QF_LIA`), equality over uninterpreted functions
+(`QF_EUF`), and their combinations.
+
+This document describes the organization of the SMTCoq artifact submission for CAV 2017.
+
+## How to download the artifact
+
+To get the artifact, please browse [here](https://drive.google.com/file/d/0BzDtBR99eKp9WVNNLTlBQy1Lc28/view)
+and download the `SMTCoq.ova` which is an image of an 
+Ubuntu 16.04 LTS running virtual machine with approximately 3.6GB size 
+(using 8GB memory, single processor which runs at the same frequency with the host processor,
+and approximately 63GB virtual disk space once imported).
+Then, please run [VirtualBox](https://www.virtualbox.org/wiki/VirtualBox);
+from the `File` top-down menu click on `Import Appliance...` and locate the `SMTCoq.ova`
+image. This will create you a virtual machine named `SMTCoq`. To run it, simply click on `Start`.
+The login (and super user) password is `123`.
+
+
+## How to install the artifact
+
+Once logged into the virtual machine, you will find SMTCoq installed. 
+If you want to install it on a separate machine, please check the SMTCoq
+[installation guide](https://github.com/lfsc/smtcoq/blob/master/INSTALL.md).
+
+
+## How to run the artifact
+
+There are two use-cases of SMTCoq:
+ - `within a Coq tactic`: we can give a Coq goal to an external solver and get a
+proof certificate for it. If the checker can validate the certificate, 
+the soundness of the checker allow us to establish a proof of the initial goal
+(by `computational reflection`).
+In this use case, the trusted base consists only of Coq: if something else goes wrong
+(e.g., the checker cannot validate the certificate), the tactic will fail, but
+nothing unsound will be added to the system.
+ - `correct-by-construction checker`: the idea is to check the
+validity of a proof witness, or proof certificate, produced by an external SMT solver
+for some input problem. In this use case, the
+trusted base is both Coq and the parser of the input problem.
+
+### Within a Coq tactic
+
+Once logged into the virtual machine, open a terminal and go to `unit-tests` directory
+by typing `cd Desktop/smtcoq/unit-tests` from home. It contains a test file (`Tests_lfsc.v`) which makes
+use of the new SMTCoq tactics inside Coq, to discharge goals with the aid of various SMT
+solvers.
+
+#### Running everything with a single command
+
+You can run Coq in batch mode on our test file (once you are in the correct
+directory) by simply running the following command:
+
+```
+coqc Tests_lfsc.v
+```
+
+The return code should be 0 to indicate that Coq typed-checked everything correctly. The batch
+compiler `coqc` tries to compile `Tests_lfsc.v` file into `Test_lfsc.vo`. Please refer to
+[Coq reference manual](https://coq.inria.fr/refman/Reference-Manual008.html#compiled) for details.
+
+#### Interactive session through CoqIDE
+
+In the `unit-test` directory, open the test file by running
+
+```
+coqide Tests_lfsc.v
+```
+
+in the terminal. This will load in `CoqIDE` (the Coq interactive development environment)
+the file where we use SMTCoq within a Coq tactic called `smt`.
+Within the CoqIDE, use `Forward one command` button (downarrow on the top-left corner) to
+navigate through the source since `Go to end` button uses a parallelization strategy
+which is not yet supported by SMTCoq.
+
+If the background becomes green after going one command forward, this means
+that Coq has accepted the statement. At the end of the session the whole file should be green.
+If Coq fails to accept any statement, you will see a brief reason of the failure in the
+bottom-right rectangle within the `Errors` tab.
+
+
+
+#### Understanding the test file
+
+```coq
+Require Import SMTCoq.
+```
+
+loads the SMTCoq module. It might be interesting to check out the implementation
+details (with pointers to source codes) of the module
+[here](https://github.com/lfsc/smtcoq/blob/master/doc/sources.md). 
+
+Similarly,
+
+```coq
+Require Import Bool PArray Int63 List ZArith Logic.
+```
+
+loads above-mentioned modules from the Coq standard library.
+
+```coq
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+```
+
+introduces a new notation `-->` for the boolean implication.
+
+Using 
+
+```coq
+Section BV.
+```
+we open a new section to prove theorems from the theory of fixed-size bitvectors. 
+
+```coq
+Import BVList.BITVECTOR_LIST.
+Local Open Scope bv_scope.
+```
+
+are to load our own [bitvector module](https://github.com/lfsc/smtcoq/blob/master/src/bva/BVList.v)
+(called BITVECTOR_LIST in BVList.v file)
+to be able to use theorems proven and notations introduced there. Note that to end a
+section `XX` you need to type
+
+```coq
+End XX.
+```
+
+Now, we can state goals and prove them automatically. For instance, the goal
+
+```coq
+  Goal forall (a b c: bitvector 4),
+                                 (c = (bv_and a b)) ->
+                                 ((bv_and (bv_and c a) b) = c).
+```
+
+is proven by the `smt` tactic which subsumes the powers of the tactics `cvc4` and `verit`:
+```coq
+  Proof.
+    smt.
+  Qed.
+```
+
+Here are some more detailed explanation of the tactics: 
+
+ - `verit` -> applies to Coq goals of type `Prop`: 
+ it first calls `prop2bool` on the goal, converting the goal to a term of type `bool`, 
+ it then calls the reification tactic `verit_bool` (which applies only to Boolean goals),
+ and it finally converts the goals back to `Prop`, by calling `bool2prop`, if it is not
+ solved.
+ 
+- `cvc4` -> applies to Coq goals of type `Prop`: 
+ it first calls `prop2bool` on the goal, converting the goal to a term of type `bool`, 
+ it then calls the reification tactic `cvc4_bool` (which applies only to Boolean goals),
+ and it finally converts any unsolved subgoals returned by CVC4 back to `Prop`, 
+ by calling `bool2prop`.
+ 
+- `smt` -> has the combined effect of the `cvc4` and `verit` tactics: 
+ it first calls `prop2bool` on the goal, it then calls either of the `cvc4_bool` and 
+ `verit_bool` tactics, and it finally converts any unsolved subgoals back to `Prop`, 
+ by calling `bool2prop`.
+
+The reification tactics `cvc4_bool` and `verit_bool`, implemented in OCaml, do most of the work:
+calling the external solvers (`CVC4` and `veriT` respectively), getting a
+proof certificate, and if SMTCoq's checker can validate the certificate, establishing the proof
+of the initial goal. The translation tactics `prop2bool` and `bool2prop` are implemented in Coq using
+the Ltac language. 
+
+NB: all of the above tactics perform better on a "standard" machine compared to the VM.
+
+Another example of a goal in the theory of bit-vectors is the following:
+
+```coq
+  Goal forall (bv1 bv2 bv3: bitvector 4),
+      bv1 = #b|0|0|0|0|  /\
+      bv2 = #b|1|0|0|0|  /\
+      bv3 = #b|1|1|0|0|  ->
+      bv_ultP bv1 bv2 /\ bv_ultP bv2 bv3.
+  Proof. 
+     smt.
+  Qed.
+```
+
+This goal uses three bit-vectors of size four: `bv1`, `bv2` and `bv3` then sets them to
+`0000`, `1000` and `1100` in the given order (`#b|1|0|...|` is the notation for bit-vector
+constants, where `0` stands for `false` and `1` is for `true`). Finally, it states
+that `bv1` is less than (unsigned less than over bit-vectors) `bv2` and (propositional)
+`bv2` is less than `bv3`. The tactic `smt` suffices to solve the goal. 
+
+
+The following sections `Arrays`, `LIA`, `EUF`, `PR`and `A_BV_EUF_LIA_PR` in the Coq file include goals that
+can be proven by the `smt` tactic from the theories of functional arrays; linear integer
+arithmetic; uninterpreted functions; propositional reasoning and the combination of functional
+arrays, fixed-size bit-vectors, uninterpreted functions, linear integer arithmetic and
+propositional reasoning; respectively.
+
+
+The example that appears in the paper can be found in the section `A_BV_EUF_LIA_PR`:
+
+```coq
+Goal forall (a b: farray Z Z) (v w x y: Z)
+            (r s: bitvector 4)
+            (f: Z -> Z)
+            (g: farray Z Z -> Z)
+            (h: bitvector 4 -> Z),
+            a[x <- v] = b /\ a[y <- w] = b ->
+            r = s /\ h r = v /\ h s = y ->
+            v < x + 1 /\ v > x - 1 ->
+            f (h r) = f (h s) \/ g a = g b.
+  Proof.
+    smt. (** "cvc4. verit." also solves the goal *)
+  Qed.
+```
+
+It introduces two arrays `a` and `b` of type `farray Z Z` (the type of integer arrays
+with integer indices); four integers `v`, `w`, `x` and `y`; three uninterpreted fuctions
+`f`, `g` and `h`. 
+Notice that `a[i]` is used to select the value stored in the `i^th^` index of the array `a`
+while `a[x <- v]` is used to store the value `v` in `a[x]`, `x^th^` index of array `a`. 
+
+
+
+### Correct-by-construction checker
+
+Using SMTCoq as a `correct-by-construction checker` means that it is possible to start with
+a problem in SMT-LIB standard, call an external solver (CVC4 or veriT) on it, get the
+unsatisfiability proof and certify it using the certified "small checkers" of SMTCoq.
+
+To test that, in a terminal go to `tests` directory (from home) by typing 
+`cd Desktop/smtcoq/src/lfsc/tests`. Run the shell script `cvc4tocoq` providing
+an input file (i.e., `uf1.smt2`) by typing `./cvc4tocoq uf1.smt2`. 
+This will call `CVC4`, get the proof in `LFSC` format, type check and convert it (using a converter
+written in OCaml) into SMTCoq format (which is very close to the proof format of `veriT`) and call
+the SMTCoq checker. If the checker returns `true` that means that SMTCoq indeed agreed that the proof of
+the input problem is correct. If it returns `false`, that means either that the proof is incorrect
+or that the OCaml converter is mistaken/incomplete. Note that you can replace `uf1.smt2`
+with any `.smt2` extended file under
+`tests` directory (`/home/Desktop/smtcoq/src/lfsc/tests`).
+
+Feel free to generate your own problem files but please recall that the input problems should be from the
+supported theories: `QF_A`, `QF_BV`, `QF_LIA`, `QF_EUF`, and their combinations.
+
+NB: The successful execution of the `./cvc4tocoq XX.smt2` script outputs some new
+files:
+- `XX.lfsc` -> the file includes the `LFSC` style unsatisfiability proof of the input problem `XX.smt2`.
+- `XX_lfsc.v`    -> Coq source file that calls the Coq checkers to validate the proof`XX.lfsc`.
+- `XX_lfsc.glob` -> the file includes the globals of the source `XX_lfsc.v`.
+- `XX_lfsc.vo`   -> compliled module file of the source `XX_lfsc.v`, it is used when to load the modules from the source `XX_lfsc.v`.
+
+ 
+
+
+
+
diff --git a/doc/sources.md b/doc/sources.md
new file mode 100644
index 0000000..55d2cec
--- /dev/null
+++ b/doc/sources.md
@@ -0,0 +1,661 @@
+# SMTCoq sources
+
+This document describes the organization of the SMTCoq repository and locations
+of source code and modules.
+
+Sources are contained in the directory [src](../src) which can be found at
+top-level. The directories [examples](../examples) and
+[unit-tests](../unit-tests) contain respectively example files of usage for
+SMTCoq and regression tests for the different tactics and vernacular commands
+that the plugin provides.
+
+The rest of the document describes the organization of `src`.
+
+
+## Top-level architecture of SMTCoq
+
+SMTCoq sources are contained in this directory. A few Coq files can be found at
+top-level.
+
+### [configure.sh](../src/configure.sh)
+
+This script is meant to be run when compiling SMTCoq for the first time. It
+should also be run every time the Makefile is modified. It takes as argument an
+optional flag `-native` which, when present, will set up the sources to use the
+*native Coq* libraries. Otherwise the standard version 8.5 of Coq is used. See
+section [versions](#versions).
+
+### [SMTCoq.v](../src/SMTCoq.v)
+
+This is the main SMTCoq entry point, it is meant to be imported by users that
+want to use SMTCoq in their Coq developments. It provides (exports) the other
+SMTCoq modules as well as declares the OCaml plugin for adding the new
+vernacular commands and tactics.
+
+### [Trace.v](../src/Trace.v)
+
+This file defines the types of certificates and steps (atomic certificate
+pieces) as well as the *main checkers*.
+
+The first section `trace` gives a generic definition of a main checker
+parameterized by the type of individual steps and a function to check
+individual steps `check_step` (small checkers). Correctness of the main checker
+is proved under the assumption that the small checker is correct.
+
+These generic definitions are applied to construct main checkers for resolution
+(module `Sat_Checker`), CNF conversion (module `Cnf_Checker`) and
+satisfiability modulo theories (module `Euf_Checker`). They each define an
+inductive type `step` to represent certificate steps. For instance, in the case
+of the resolution checker, the only possible step is to apply the resolution
+rule so steps are defined as:
+
+```coq
+Inductive step :=
+   | Res (_:int) (_:resolution).
+```
+
+The main theorems for these modules are named `checker_*correct`. For instance
+the main result for the SMT checker (`Euf_Checker`) is formulated as follows:
+
+```coq
+Lemma checker_correct : forall d used_roots c,
+    checker d used_roots c = true ->
+    ~ valid t_func t_atom t_form d.
+```
+
+which means that if the checker returns true on the formula `d` and the
+certificate `c` then `d` is not valid (*i.e.* `c` is a refutation proof
+certificate for `d`).
+
+
+
+### [State.v](../src/State.v)
+
+This module is used to define representations for the global state of the
+checker. 
+
+A state is an array of clauses:
+
+```coq
+Module S.
+  Definition t := array C.t.
+...
+End S.
+```
+
+on which we define resolution chain operations `set_resolve` that modify the
+state.
+
+Variables, literals and clauses are defined respectively in modules `Var`,
+`Lit` and `C`. Binary resolution is defined between two clauses in `C.resolve`.
+
+
+
+### [SMT_terms.v](../src/SMT_terms.v)
+
+This Coq module defines reification types for formulas (`Form.form`), types
+(`Typ.type`) and atoms/terms (`Atom.atom`). Formulas are given an
+interpretation in Coq's Booleans, types are interpreted in Coq types (for
+instance, type `TZ` is interpreted as Coq's mathematical integers `Z`) and
+atoms are interpreted as Coq terms of type the interpretation of their type
+(for instance an atom whose type is `TZ` is interpreted as an integer of `Z`).
+
+
+**Some important lemmas:**
+
+A function `cast` allows to change the encoded type of a term of type
+`Typ.type` when we know two types are equal (the inductive `cast_result`
+provides the conversion function).
+
+```coq
+Fixpoint cast_refl A:
+      cast A A = Cast (fun P (H : P A) => H).
+```
+
+This is the lemma to use to remove cast constructions during the proofs.
+
+
+
+```coq
+Lemma i_eqb_spec : forall t x y, i_eqb t x y <-> x = y.
+```
+
+This other lemma says that Boolean equality over interpretation of types is the
+equivalent to Leibniz equality. This is useful to allow rewriting.
+
+
+Atom (as well as formulas) are encoded by integers, and mapping is preserved by
+an array `t_atom`. Another array maintains interpretations of encodings. The
+following lemma states that these two relates:
+
+```coq
+Lemma t_interp_wf : forall i,
+   t_interp.[i] = interp_aux (PArray.get t_interp) (t_atom.[i]).
+```
+
+
+
+
+### [Misc.v](../src/Misc.v)
+
+This module contains miscellaneous general lemmas that are used in several
+places throughout the development of SMTCoq.
+
+
+### [versions](../src/versions)
+
+This directory contains everything that is dependent on the version of Coq that
+one wants to use. `standard` contains libraries for the standard version of Coq
+and `native` contains everything related to native Coq. Note that some
+libraries are already present in the default libraries of native Coq, in this
+case they have a counterpart in `standard` that replicates the functionality
+(without using native integers or native arrays).
+
+A particular point of interest is the files
+[smtcoq_plugin_standard.ml4](../src/versions/standard/smtcoq_plugin_standard.ml4)
+and
+[smtcoq_plugin_native.ml4](../src/versions/native/smtcoq_plugin_native.ml4). They
+provide extension points for Coq by defining new vernacular commands and new
+tactics. For instance the tactic `verit` tells Coq to call the OCaml function
+`verit.tactic` (which in turns uses the Coq API to manipulate the goals and
+call the certified checkers).
+
+```ocaml
+TACTIC EXTEND Tactic_verit
+| [ "verit" ] -> [ Verit.tactic () ]
+END
+```
+
+
+
+### [spl](../src/spl)
+
+This directory contains everything related to simplifications of input
+formulas as well as the Coq machinery to handle step checkers that use
+assumptions (and generate sub-goals).
+
+- [Arithmetic.v](../src/spl/Arithmetic.v): Arithmetic simplifications
+- [Operators.v](../src/spl/Operators.v): Simplifications of SMT-LIB 2 operators
+  (atomic disequalities and distinct operators)
+- [Syntactic.v](../src/spl/Syntactic.v): Flattening and normalization of
+  propositional structures
+- [Assumptions.v](../src/spl/Assumptions.v): Small checker for assumptions
+
+
+
+### [extraction](../src/extraction)
+
+This is the extracted version of the SMTCoq checker, that can be run outside
+Coq. It still needs to be fixed for the new additions and extensions.
+
+
+
+### [classes](../src/classes)
+
+
+The definitions of interpretations of terms and types of SMTCoq requires some
+additional constraints that are encoded as Coq type-classes. This directory
+contains definitions and properties of these classes
+[SMT_classes.v](../src/classes/SMT_classes.v) as well as predefined useful
+instances of these classes
+[SMT_classes_instances.v](../src/classes/SMT_classes_instances.v).
+
+These classes are:
+
+- `EqbType`: types with a Boolean equality that reflects in Leibniz equality
+- `DecType`: types with a decidable equality
+- `OrdType`: class of types with a partial order 
+- `Comparable`: augmentation of class of partial order with a compare function
+  to obtain a total order
+- `Inhabited`: class of inhabited types (used to obtain default values for
+  types)
+- `CompDec`: a class that merges all previous classes
+
+
+
+## Small checkers
+
+Small Coq checkers are organized in sub-directories that reflect the theories
+they handle. Small checkers for propositional logic, equality over
+uninterpreted functions and linear integer arithmetic all use preexisting
+standard Coq libraries (Bool, Arith, Z, BinPos, ...) to formalize the
+underlying interpretation of these theories. The theories of fixed-width
+bit-vectors and functional unbounded arrays are formalized in new custom Coq
+libraries (that are distributed with SMTCoq).
+
+
+Computational small checkers have the following signature:
+
+```coq
+Definition checker (s : S.t) (p1 ... pn : int) (l1 ... lm : lit) : C.t := ...
+```
+
+where `s` is the state of the main checker, `p1`, ..., `pn` are positions
+(there can be none) of deduced clauses that appear in the state `s` and `l1`,
+..., `lm` are literals. The function `checker` returns a clause that is
+`deducible` from the already deduced clauses in the state `s`.
+
+Correctness of checkers are specified (and proven) through lemmas of the form:
+
+```coq
+Lemma valid_checker : forall s rho p1 ... pm l1 ... lm,
+                      C.valid rho (checker s p1 ... pm l1 ... lm).
+```
+
+It states that the clause returned by `checker` is valid. In most cases for the
+small checkers, when they fail they return a trivially true clause (`C._true`).
+
+
+### [cnf](../src/cnf)
+
+Small checkers for CNF (conjunctive normal form) are defined in the module
+[Cnf.v](../src/cnf/Cnf.v). In essence they implement a Tseitin conversion.
+
+For instance, the checker `check_BuildDef` returns a tautology in clausal form
+(the validity of the clause is not dependent on the validity of the state) and
+the checker `check_ImmBuildDef` is a generic encoding of conversion rules that
+have a premise (which appears in the state).
+
+
+
+### [euf](../src/euf)
+
+The checkers for EUF (equality over uninterpreted functions) are defined in the
+module [Euf.v](../src/euf/Euf.v).
+
+The first one checks application of the rule of transitivity. `check_trans`
+takes as argument the result of the rule application as well as list of
+equalities of the form `a = b`, `b = c`, ..., `x = y`, `y = z`.
+
+The other checker takes care of applications of the congruence rule. Functions
+in SMT-LIB have a given arity and they are interpreted as Coq functions. The
+checker for congruence can check rule applications with a number of equalities
+corresponding to the arity of the function.
+
+
+### [lia](../src/lia)
+
+Checking linear arithmetic lemmas that come from the SMT solver is performed
+using the already existing `Micromega` solver of Coq. The corresponding
+checker is implemented in module [Lia.v](../src/lia/Lia.v).
+
+
+
+
+
+### [bva](../src/bva)
+
+The small checkers for bit-vector operations can be found in module
+[Bva_checker.v](../src/bva/Bva_checker.v). They implement the rules for
+bit-blasting operators of the theory of fixed width bit-vector.
+
+There are small checkers for:
+
+- bit-wise operators (`bvand`, `bvor`, `bvxor`, `bvnot`)
+- equality
+- variables
+- constants
+- extraction
+- concatenation
+- arithmetic operations (addition, negation, multiplication)
+- comparison predicates (signed/unsigned)
+- extensions (zero/signed)
+
+
+The theory of fixed width is realized by an implementation provided in
+[BVList.v](../src/bva/BVList.v). There, bit-vectors are interpreted by lists of
+Booleans. The type of bit-vectors is a dependent type:
+
+```coq
+Parameter bitvector : N -> Type.
+```
+
+In the implementation, a bit-vector is a record that contains a list of
+Booleans `bv`, *i.e.* the lists of its bits, as well as a proof of well
+formedness `wf`, *i.e.* a proof that the size of the list `bv` is the parameter
+`n` of the type.
+
+```coq
+Record bitvector_ (n:N) : Type :=
+    MkBitvector
+      { bv :> M.bitvector;
+        wf : M.size bv = n
+      }.
+```
+
+
+
+### [array](../src/array)
+
+The theory of unbounded functional arrays with extensionality is realized in
+Coq by a custom type that can be found in [FArray.v](../src/array/FArray.v).
+
+```coq
+Definition farray (key elt : Type) _ _  :=
+```
+
+The type `farray` is parameterized by the type of keys (or indexes) of the
+array and the type of the elements. `key` must be a type equipped with a
+partial order and `elt` must be inhabited. 
+
+
+```coq
+Record slist :=
+  {this :> Raw.farray key elt;
+   sorted : sort (Raw.ltk key_ord) this;
+   nodefault : NoDefault this
+   }.
+   
+Definition farray := slist.
+```
+
+An array is represented internally by an association list for its mappings with
+additional constraints that encode the fact that the list is sorted and that
+there are no mapping to the default value.
+
+Computable equality and comparison functions require additional constraints on
+the types `key` and `elt` (for instance they need to have a total order,
+*etc.*).
+
+This library also provides useful properties on these arrays. Notably
+extensionality which is required by the theory of arrays in SMT solvers:
+
+```coq
+Lemma extensionnality : forall a b, (forall i, select a i = select b i) -> a = b.
+```
+
+The extensionality rule that is used by the checker is a bit different and
+requires classical axioms to be proven. This is done in section
+```Classical_extensionnality``` which provides an alternative version without
+contaminating uses of the library.
+
+There are three small checkers for arrays. They check application of the axioms
+(in the theory sense) of the theory of arrays, two for *read over write* and
+one for *extensionality*
+
+
+## OCaml implementation of the plugin
+
+Part of SMTCoq is implemented in OCaml. These concern functionality which are
+not certified such as the reification mechanism, the parsers, pre-processors
+and the definitions of tactics.
+
+This part communicates directly with Coq by using the OCaml Coq API.
+
+
+### [trace](../src/trace)
+
+This directory contain the implementation of certificates and the
+representation of SMT-LIB formulas in SMTCoq.
+
+[coqTerms.ml](../src/trace/coqTerms.ml) contains imports from Coq of terms to
+be used directly in OCaml. These include usual Coq terms but also ones specific
+to SMTCoq.
+
+[smtAtom.mli](../src/trace/smtAtom.mli) contains the definitions for the types
+of atoms in SMTCoq but also provides smart constructors for them. The modules
+defined in this file have functions to reify Coq terms in OCaml and to
+translate back OCaml atoms and types to their Coq counterpart interpretation.
+
+[smtForm.mli](../src/trace/smtForm.mli) plays the same role as `smtAtom` but on
+the level of formulas.
+
+[smtCertif.ml](../src/trace/smtCertif.ml) contains definitions for an OCaml
+version of the steps of the certificate. These are the objects that are
+constructed when importing a certificate from an SMT solver for instance.
+
+[smtTrace.ml](../src/trace/smtTrace.ml) contains functions to build the Coq
+version of the certificate from the OCaml one.
+
+[smtCommands.ml](../src/trace/smtCommands.ml) constitute the bulk of the
+implementation of the plugin. It contains the OCaml functions that are used to
+build the Coq vernacular commands (`Verit_checker`, `Lfsc_checker`, ...) and
+the tactics. It also contains functions to reconstruct Coq counter-examples
+from models returned by the SMT solver.
+
+[smtCnf.ml](../src/trace/smtCnf.ml) implements a CNF conversion on the type of
+SMTCoq formulas.
+
+[smtMisc.ml](../src/trace/smtMisc.ml) contains miscellaneous functions used in
+the previous modules.
+
+
+
+### [smtlib2](../src/smtlib2)
+
+This directory contains utilities to communicate directly with SMT
+solvers. This includes a lexer/parser for the SMT-LIB 2 format
+([smtlib2_parse.mly](../src/smtlib2/smtlib2_parse.mly)) a conversion module
+from SMT-LIB 2 to formulas and atoms of SMTCoq
+([smtlib2_genConstr.ml](../src/smtlib2/smtlib2_genConstr.ml)) and a way to call
+and communicate with SMT solvers through pipes
+([smtlib2_solver.mli](../src/smtlib2/smtlib2_solver.mli)).
+
+
+
+### [zchaff](../src/zchaff)
+
+Files in this directory allow to call the SAT solver ZChaff. It contains a
+parser for the sat solver input files and ZChaff certificates. The
+implementation for the Coq tactic `zchaff` can be found in
+[zchaff.ml](../src/zchaff/zchaff.ml).
+
+
+
+### [verit](../src/verit)
+
+This directory contains the necessary modules to support the SMT solver veriT.
+In particular it contains a parser for the format of certificates of veriT
+([veritParser.mly](../src/verit/veritParser.mly)) and an intermediate
+representation of those certificates
+([veritSyntax.mli](../src/verit/veritSyntax.mli)). This module also implements
+a conversion function from veriT certificates to SMTCoq format of
+certificates. This pre-processor is a simple one-to-one conversion.
+
+The file ([verit.ml](../src/verit/verit.ml)) contains the functions to invoke
+veritT and create SMT-LIB 2 scripts. This is used by the definition of the
+tactic `verit` of the same file.
+
+
+
+### [lfsc](../src/lfsc)
+
+This directory contains the pre-processor for LFSC proofs to SMTCoq
+certificates (as well as veriT certificates). The files
+[ast.ml](../src/lfsc/ast.ml) and [builtin.ml](../src/lfsc/builtin.ml) contain
+an OCaml implementation of a type checker for LFSC proofs. This directory also
+contains a parser and lexer for LFSC (*c.f.*,
+[lfscParser.mly](../src/lfsc/lfscParser.mly)).
+
+The pre-processor is implemented in the module
+[converter.ml](../src/lfsc/converter.ml)) as a *functor*. Depending on the
+module (for terms and clauses conversions) that is passed in the functor
+application, we obtain either a pre-processor from LFSC proofs to SMTCoq
+certificates directly or a converter from LFSC proofs to veriT certificates.
+
+> **Note:** You can obtain a standalone version of the converter by issuing
+> `make` in this directory. This produces a binary `lfsctosmtcoq.native` that
+> can be run with an LFSC proof as argument and produces a veriT certificate
+> on the standard output.
+
+Finally, the tactic `cvc4_bool` is implemented in the file
+[lfsc.ml](../src/lfsc/lfsc.ml)). It contains functions to call the SMT solver
+CVC4, convert its proof and call the base tactic of `smtCommands`.
+
+
+## Tactics: proof search
+
+### [BoolToProp.v](../src/BoolToProp.v)
+This module includes the tactic `bool2prop` that converts a goal, if Boolean, into
+a goal in Coq's `Prop`, after introducing universally quantified variables into the
+context. 
+
+It simply performs a search in the goal and does the mentioned conversion step by step
+benefitting the `reflect` predicate popularized by the `SSReflect` library:
+
+```coq
+Inductive reflect (P : Prop) : bool -> Set :=
+   | ReflectT :   P -> reflect P true 
+   | ReflectF : ~ P -> reflect P false.
+```
+
+In fact, the predicate `reflect` returns the Boolean counterpart of a proposition.
+Besides, it makes below lemma easily provable:
+
+```coq
+Lemma reflect_iff : forall P b, (P<->b=true) -> reflect P b.
+```
+
+This simply says that if a Coq proposition `P` is equivalent to some Boolean 
+`b` being `true` then `b` is indeed the Boolean counterpart of `P`.
+
+Now, let's exemplify how the tactic `bool2prop` benefits above steps:
+
+Imagine a very simple goal that embodies the `or` connective
+
+```coq
+G0 || G1
+```
+
+for some Booleans `G0` and `G1`. Then, the tactic performes the following 
+rewrite step on the goal 
+
+```coq
+rewrite <- (@reflect_iff (G0 = true \/ G1 = true) (G0 || G1)).
+```
+
+which turns it into:
+
+```coq
+G0 = true \/ G1 = true
+```
+
+together with introducing an additional goal:
+
+```coq
+reflect (G0 = true \/ G1 = true) (G0 || G1)
+```
+
+The first goal is indeed the intended one. However, the tactic can still go a step further 
+putting the goal into the following shape:
+
+```coq
+H0 \/ H1
+```
+
+for some propositions `H0` and `H1`. This is indeed the case for Boolean equality and comparison over bit-vectors,
+Boolean equality and  comparison over Coq intergers `Z`, and Boolean equality over fuctional arrays;
+since the corresponding propositional predicates are proven to be equivalent. E.g., 
+
+```coq
+Lemma bv_ult_B2P: forall n (a b: bitvector n), bv_ult a b = true <-> bv_ultP a b.
+```
+where `bv_ult: bitvector n -> bitvector n -> bool` and `bv_ultP: bitvector n -> bitvector n -> Prop`. 
+
+However, the second one must somehow be solved. This is indeed not so hard:
+it suffices to apply the below lemma which has already been proven again by benefitting the `reflect` predicate:
+
+
+```coq
+Lemma orP : forall (a b: bool), reflect (a = true \/ b = true) (a || b).
+```
+
+Notice that the same sort of conversion steps for the other Boolean connectives are also handled
+by the tactic `bool2prop`.
+
+### [PropToBool.v](../src/PropToBool.v)
+This module includes the tactic `prop2bool` that converts a goal, if in Coq's `Prop`, into
+a Boolean goal, after introducing universally quantified variables into the context.
+It is, in fact, the inverse of the above explained `bool2prop` tactic.
+
+It simply performs a search in the goal and does the mentioned conversion step by step
+benefitting the `reflect` predicate (see above `BoolToProp.v`). The predicate `reflect`
+makes the following goal easily proveable:
+
+```coq
+Lemma reflect_iff : forall P b, reflect P b -> (P<->b=true).
+```
+
+This basically tells us that if `b` is the Boolean counterpart of some proposition `P`,
+then `P` is indeed equivalent to `b` being `true`.
+
+Now, let's exemplify how the tactic `prop2bool` benefits above steps:
+
+Imagine a very simple goal that embodies the `or` connective as
+
+```coq
+H0 \/ H1
+```
+
+for some propositions `H0` and `H1`. At this point, the tactic needs to go a step further and
+puts the goal into the following shape to be able to make use of the `reflect_iff` fact:
+
+```coq
+G0 = true \/ G1 = true
+```
+
+for some Booleans `G0` and `G1`. This step is indeed doable for propositional equality and comparison over
+bit-vectors, propsitional equality and comparison over Coq intergers `Z`, and propositional equality over
+fuctional arrays, since the corresponding Boolean predicates are proven to be equivalent. E.g.,
+
+```coq
+Lemma bv_ult_B2P: forall n (a b: bitvector n), bv_ult a b = true <-> bv_ultP a b.
+```
+where `bv_ult: bitvector n -> bitvector n -> bool` and `bv_ultP: bitvector n -> bitvector n -> Prop`.
+
+
+Then, the tactic performes the following rewrite step on the goal 
+
+```coq
+rewrite (@reflect_iff (G0 = true \/ G1 = true) (G0 || G1))
+```
+
+which turns it into:
+
+```coq
+G0 || G1 = true
+```
+
+together with introducing an additional goal:
+
+```coq
+reflect (G0 = true \/ G1 = true) (G0 || G1)
+```
+
+The first goal is indeed the intended one. So that the tactic leaves the goal as it is. But the second
+one must somehow be solved. In fact, this not so hard: it suffices to apply the below lemma which
+has already been proven again by benefitting the `reflect` predicate:
+
+```coq
+Lemma orP : forall (a b: bool), reflect (a = true \/ b = true) (a || b).
+```
+
+Notice that the same sort of conversion steps for the other propositional connectives are also handled
+by the tactic `prop2bool`.
+
+### [Tactics.v](../src/Tactics.v)
+This file includes four tactics that are written in `Ltac` language:
+
+ - `zchaff` -> can function on the goals in Coq's `Prop`: 
+ first calls `prop2bool` on the goal, getting the goal in `bool`, 
+ then calls the reificiation tactic `zchaff_bool` (which can only function on Boolean goals),
+ and finally puts the goal back in Coq's `Prop`, by calling `bool2prop`, if not solved.
+ 
+ - `verit` -> can function on the goals in Coq's `Prop`: 
+ first calls `prop2bool` on the goal, getting the goal in `bool`, 
+ then calls the reificiation tactic `verit_bool` (can only function on Boolean goals),
+ and finally puts the goal back in Coq's `Prop`, by calling `bool2prop`, if not solved.
+ 
+ - `cvc4` -> can function on the goals in Coq's `Prop`: 
+ first calls `prop2bool` on the goal, getting the goal in `bool`, 
+ then calls the reificiation tactic `cvc4_bool` (can only function on Boolean goals),
+ and finally puts the goal(s) back in Coq's `Prop`, by calling `bool2prop`, in case it is not solved or additional goals returned.
+ 
+ - `smt` -> subsumes the powers of `cvc4` and `verit` tactics: 
+ first calls `prop2bool` on the goal, getting the goal in `bool`, 
+ then calls either of the reificiation tactics `cvc4_bool`, `verit_bool` (can only function on Boolean goals),
+ and finally puts the goal(s) back in Coq's `Prop`, by calling `bool2prop`, in case it is not solved or additional goals returned.
+
+
+
+
diff --git a/examples/Example.v b/examples/Example.v
index 0dba915..c07fb40 100644
--- a/examples/Example.v
+++ b/examples/Example.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 (* [Require Import SMTCoq.SMTCoq.] loads the SMTCoq library.
    If you are using native-coq instead of Coq 8.6, replace it with:
      Require Import SMTCoq.
@@ -5,7 +17,15 @@
 
 Require Import SMTCoq.SMTCoq.
 Require Import Bool.
-Local Open Scope int63_scope.
+
+Local Open Scope Z_scope.
+
+Import BVList.BITVECTOR_LIST.
+Local Open Scope bv_scope.
+
+Import FArray.
+Local Open Scope farray_scope.
+
 
 (* Examples that check ZChaff certificates *)
 
@@ -15,12 +35,21 @@ Check sat.
 
 Zchaff_Checker "hole4.cnf" "hole4.log".
 
-(* Example that checks a VeriT certificate, for logic QF_UF *)
+
+(* Example that checks a VeriT certificate, for logic QF_UFLIA *)
 
 Section Verit.
-  Verit_Checker "euf.smt2" "euf.log".
+  Verit_Checker "lia.smt2" "lia.vtlog".
 End Verit.
 
+
+(* Example that checks a LFSC certificate, for logic QF_UFLIA *)
+
+Section Lfsc.
+  Lfsc_Checker "lia.smt2" "lia.lfsc".
+End Lfsc.
+
+
 (* Examples of the zchaff tactic (requires zchaff in your PATH
    environment variable):
    - with booleans
@@ -33,41 +62,119 @@ Proof.
 Qed.
 
 Goal forall i j k,
-  let a := i == j in
-  let b := j == k in
-  let c := k == i in
+  let a := (i == j)%int in
+  let b := (j == k)%int in
+  let c := (k == i)%int in
   (a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a) = false.
 Proof.
   zchaff.
 Qed.
 
-(* Examples of the verit tactic (requires verit in your PATH environment
-   variable):
-   - with booleans
-   - in logics QF_UF and QF_LIA *)
+
+(* Examples of the verit tactics (requires verit in your PATH environment
+   variable), which handle
+   - propositional logic
+   - theory of equality
+   - linear integer arithmetic *)
 
 Goal forall a b c, ((a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a)) = false.
 Proof.
-  verit.
+  verit_bool.
 Qed.
 
-
 Goal forall (a b : Z) (P : Z -> bool) (f : Z -> Z),
-  negb (f a =? b) || negb (P (f a)) || (P b).
+  (negb (Z.eqb (f a) b)) || (negb (P (f a))) || (P b).
 Proof.
-  verit.
+  verit_bool.
 Qed.
 
 Goal forall b1 b2 x1 x2,
-  implb
-  (ifb b1
-    (ifb b2 (2*x1+1 =? 2*x2+1) (2*x1+1 =? 2*x2))
-    (ifb b2 (2*x1 =? 2*x2+1) (2*x1 =? 2*x2)))
-  ((implb b1 b2) && (implb b2 b1) && (x1 =? x2)).
+    implb
+      (ifb b1
+           (ifb b2 (Z.eqb (2*x1+1) (2*x2+1)) (Z.eqb (2*x1+1) (2*x2)))
+           (ifb b2 (Z.eqb (2*x1) (2*x2+1)) (Z.eqb (2*x1) (2*x2))))
+      ((implb b1 b2) && (implb b2 b1) && (Z.eqb x1 x2)).
+Proof.
+  verit_bool.
+Qed.
+
+Goal forall
+    (x y: Z)
+    (f: Z -> Z),
+    x = y + 1 -> f y = f (x - 1).
 Proof.
   verit.
 Qed.
 
+
+(* Examples of the smt tactic (requires verit and cvc4 in your PATH environment
+   variable):
+   - propositional logic
+   - theory of equality
+   - linear integer arithmetic
+   - theory of fixed-sized bit-vectors
+   - theory of arrays *)
+
+Goal forall a b c, ((a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a)) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall (a b : Z) (P : Z -> bool) (f : Z -> Z),
+  (negb (Z.eqb (f a) b)) || (negb (P (f a))) || (P b).
+Proof.
+  smt.
+Qed.
+Goal forall b1 b2 x1 x2,
+    implb
+      (ifb b1
+           (ifb b2 (Z.eqb (2*x1+1) (2*x2+1)) (Z.eqb (2*x1+1) (2*x2)))
+           (ifb b2 (Z.eqb (2*x1) (2*x2+1)) (Z.eqb (2*x1) (2*x2))))
+      ((implb b1 b2) && (implb b2 b1) && (Z.eqb x1 x2)).
+Proof.
+  smt.
+Qed.
+
+Goal forall
+    (x y: Z)
+    (f: Z -> Z),
+    x = y + 1 -> f y = f (x - 1).
+Proof.
+  smt.
+Qed.
+
+Goal forall (bv1 bv2 bv3: bitvector 4),
+    bv1 = #b|0|0|0|0|  /\
+    bv2 = #b|1|0|0|0|  /\
+    bv3 = #b|1|1|0|0|  ->
+    bv_ultP bv1 bv2 /\ bv_ultP bv2 bv3.
+Proof.
+  smt.
+Qed.
+
+Goal forall (a b c d: farray Z Z),
+    b[0 <- 4] = c  ->
+    d = b[0 <- 4][1 <- 4]  ->
+    a = d[1 <- b[1]]  ->
+    a = c.
+Proof.
+  smt.
+Qed.
+
+Goal forall (a b: farray Z Z) (v w x y z t: Z)
+            (r s: bitvector 4)
+            (f: Z -> Z)
+            (g: farray Z Z -> Z)
+            (h: bitvector 4 -> Z),
+    a[x <- v] = b /\ a[y <- w] = b ->
+    a[z <- w] = b /\ a[t <- v] = b ->
+    r = s -> v < x + 10 /\ v > x - 5 ->
+    ~ (g a = g b) \/ f (h r) = f (h s).
+Proof.
+  smt.
+Qed.
+
+
 (* Examples of using the conversion tactics *)
 
 Local Open Scope positive_scope.
@@ -231,7 +338,6 @@ Section group.
   Lemma unique_identity e':
     (forall z, op e' z =? z) -> e' =? e.
   Proof. intros pe'. verit_base pe'; vauto. Qed.
-
   Lemma simplification_right x1 x2 y:
       op x1 y =? op x2 y -> x1 =? x2.
   Proof. intro H. verit_base H; vauto. Qed.
diff --git a/examples/InsertionSort.v b/examples/InsertionSort.v
new file mode 100644
index 0000000..fcd5dfc
--- /dev/null
+++ b/examples/InsertionSort.v
@@ -0,0 +1,151 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* This example tests the tactics in "real" condition: a part of the
+   proof of correctness of insertion sort. It requires propositional
+   reasoning, uninterpreted functions, and a bit of integer arithmetic.
+
+   Ideally, the proof of each lemma should consists only on
+   induction/destruct followed by a call to [smt]. What we currently
+   lack:
+     - we have to provide all the needed lemmas and unfold all the
+       definitions
+     - it requires too much from uninterpreted functions even when it is
+       not needed
+     - it sometimes fails? (may be realted to the previous item)
+ *)
+
+
+Add Rec LoadPath "../src" as SMTCoq.
+
+Require Import SMTCoq.
+Require Import ZArith List Bool.
+
+
+(* We should really make SMTCoq work with SSReflect! *)
+
+Lemma impl_implb (a b:bool) : (a -> b) <-> (a --> b).
+Proof. auto using (reflect_iff _ _ (ReflectFacts.implyP a b)). Qed.
+
+
+Lemma eq_false b : b = false <-> negb b.
+Proof. case b; intuition. Qed.
+
+
+Section InsertionSort.
+
+  Fixpoint insert (x:Z) (l:list Z) : list Z :=
+    match l with
+    | nil => x::nil
+    | y::ys => if (x <=? y)%Z then x::y::ys else y::(insert x ys)
+    end.
+
+  Fixpoint sort (l:list Z) : list Z :=
+    match l with
+    | nil => nil
+    | x::xs => insert x (sort xs)
+    end.
+
+
+  Section Spec.
+
+    Fixpoint is_sorted (l:list Z) : bool :=
+      match l with
+      | nil => true
+      | x::xs =>
+        match xs with
+        | nil => true
+        | y::_ => (x <=? y)%Z && (is_sorted xs)
+        end
+      end.
+
+    Fixpoint smaller (x:Z) (l:list Z) : bool :=
+      match l with
+      | nil => true
+      | y::ys => (x <=? y)%Z && (smaller x ys)
+      end.
+
+
+    Lemma is_sorted_smaller x y ys :
+      (((x <=? y) && is_sorted (y :: ys)) --> is_sorted (x :: ys)).
+    Proof.
+      destruct ys as [ |z zs].
+      - simpl. smt.
+      - change (is_sorted (y :: z :: zs)) with ((y <=? z)%Z && (is_sorted (z::zs))).
+        change (is_sorted (x :: z :: zs)) with ((x <=? z)%Z && (is_sorted (z::zs))).
+        (* [smt] or [verit] fail? *)
+        assert (H:forall b, (x <=? y) && ((y <=? z) && b) --> (x <=? z) && b) by smt.
+        apply H.
+    Qed.
+
+
+    Lemma is_sorted_cons x xs :
+      (is_sorted (x::xs)) <--> (is_sorted xs && smaller x xs).
+    Proof.
+      induction xs as [ |y ys IHys].
+      - reflexivity.
+      - change (is_sorted (x :: y :: ys)) with ((x <=? y)%Z && (is_sorted (y::ys))).
+        change (smaller x (y :: ys)) with ((x <=? y)%Z && (smaller x ys)).
+        generalize (is_sorted_smaller x y ys). revert IHys. rewrite !impl_implb.
+        (* Idem *)
+        assert (H:forall a b c d, (a <--> b && c) -->
+                                  ((x <=? y) && d --> a) -->
+                                  ((x <=? y) && d <-->
+                                  d && ((x <=? y) && c))) by smt.
+        apply H.
+    Qed.
+
+
+    Lemma insert_keeps_smaller x y ys :
+      smaller y ys --> (y <=? x) --> smaller y (insert x ys).
+    Proof.
+      induction ys as [ |z zs IHzs].
+      - simpl. smt.
+      - simpl. case (x <=? z).
+        + simpl.
+          (* [smt] or [verit] require [Compec (list Z)] but they should not *)
+          assert (H:forall a, (y <=? z) && a --> (y <=? x) --> (y <=? x) && ((y <=? z) && a)) by smt.
+          apply H.
+        + simpl. revert IHzs. rewrite impl_implb.
+          (* Idem *)
+          assert (H:forall a b, (a --> (y <=? x) --> b) --> (y <=? z) && a --> (y <=? x) --> (y <=? z) && b) by smt.
+          apply H.
+    Qed.
+
+
+    Lemma insert_keeps_sorted x l : is_sorted l -> is_sorted (insert x l).
+    Proof.
+      induction l as [ |y ys IHys].
+      - reflexivity.
+      - intro H. simpl. case_eq (x <=? y); intro Heq.
+        + change ((x <=? y)%Z && (is_sorted (y::ys))). rewrite Heq, H. reflexivity.
+        + rewrite eq_false in Heq.
+          rewrite (eqb_prop _ _ (is_sorted_cons _ _)) in H.
+          rewrite (eqb_prop _ _ (is_sorted_cons _ _)).
+          generalize (insert_keeps_smaller x y ys).
+          revert IHys H Heq. rewrite !impl_implb.
+          (* Idem *)
+          assert (H: forall a b c d, (a --> b) --> a && c --> negb (x <=? y) --> (c --> (y <=? x) --> d) --> b && d) by smt.
+          apply H.
+    Qed.
+
+
+    Theorem sort_sorts l : is_sorted (sort l).
+    Proof.
+      induction l as [ |x xs IHxs].
+      - reflexivity.
+      - simpl. now apply insert_keeps_sorted.
+    Qed.
+
+  End Spec.
+
+End InsertionSort.
diff --git a/examples/Non_terminating.v b/examples/Non_terminating.v
index 087301a..7dad08f 100644
--- a/examples/Non_terminating.v
+++ b/examples/Non_terminating.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import SMTCoq.
 
 Parameter g : Z -> Z.
diff --git a/examples/euf.log b/examples/euf.log
deleted file mode 100644
index 3bccc6a..0000000
--- a/examples/euf.log
+++ /dev/null
@@ -1,8 +0,0 @@
-1:(input (#1:(and #2:(= b a) #3:(= b c) #4:(= c d) #5:(= e c) #6:(= e f) (not #7:(= a f)))))
-2:(and (#2) 1 0)
-3:(and (#3) 1 1)
-4:(and (#5) 1 3)
-5:(and (#6) 1 4)
-6:(and ((not #7)) 1 5)
-7:(eq_transitive ((not #2) (not #3) (not #5) (not #6) #7))
-8:(resolution () 7 2 3 4 5 6)
diff --git a/examples/lia.lfsc b/examples/lia.lfsc
new file mode 100644
index 0000000..1aa900b
--- /dev/null
+++ b/examples/lia.lfsc
@@ -0,0 +1,43 @@
+unsat
+(check
+ ;; Declarations
+(% x (term Int)
+(% A1 (th_holds true)
+(% A0 (th_holds (not (impl (= Int (-_Int x (a_int 3) )  (a_int 7) ) (<=_Int (a_int 10)  x) )))
+(: (holds cln)
+
+ ;; Printing deferred declarations 
+
+
+;; BV const letification
+
+
+
+ ;; Printing the global let map
+(@ let1 false
+
+ ;; Printing aliasing declarations 
+
+
+ ;; Rewrites for Lemmas 
+
+ ;; In the preprocessor we trust 
+(th_let_pf _ (trust_f false) (\ .PA205
+(th_let_pf _ (trust_f (not let1)) (\ .PA227
+
+;; Printing mapping from preprocessed assertions into atoms 
+(decl_atom let1 (\ .v1 (\ .a1
+(satlem _ _ (ast _ _ _ .a1 (\ .l3 (clausify_false (contra _ .l3 .PA227)))) (\ .pb1
+(satlem _ _ (asf _ _ _ .a1 (\ .l2 (clausify_false (contra _ .PA205 .l2)))) (\ .pb4
+ ;; Theory Lemmas 
+
+;; BB atom mapping
+
+
+;; Bit-blasting definitional clauses 
+
+
+ ;; Bit-blasting learned clauses 
+
+(satlem_simplify _ _ _ (R _ _ .pb4 .pb1 .v1) (\ empty empty)))))))))))))))))))
+;;
diff --git a/examples/lia.smt2 b/examples/lia.smt2
new file mode 100644
index 0000000..df290d0
--- /dev/null
+++ b/examples/lia.smt2
@@ -0,0 +1,5 @@
+(set-logic QF_LIA)
+(declare-fun x () Int)
+(assert (not (=> (= (- x 3) 7) (<= 10 x))))
+(check-sat)
+(exit)
diff --git a/examples/lia.vtlog b/examples/lia.vtlog
new file mode 100644
index 0000000..d3a03ee
--- /dev/null
+++ b/examples/lia.vtlog
@@ -0,0 +1,7 @@
+1:(input ((not #1:(=> #2:(= #3:(- x 3) 7) #4:(<= 10 x)))))
+2:(tmp_LA_pre ((not #5:(=> #6:(and #7:(<= #3 7) #8:(<= 7 #3)) #4))) 1)
+3:(not_implies1 (#6) 2)
+4:(and (#8) 3 1)
+5:(not_implies2 ((not #4)) 2)
+6:(la_generic (#4 (not #8)))
+7:(resolution () 6 4 5)
diff --git a/examples/one_equality_switch.v b/examples/one_equality_switch.v
index 3473d08..61fd9c7 100644
--- a/examples/one_equality_switch.v
+++ b/examples/one_equality_switch.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import SMTCoq.
 Require Import Bool.
 Local Open Scope int63_scope.
diff --git a/examples/switching_input.v b/examples/switching_input.v
index 52261d8..629a3ad 100644
--- a/examples/switching_input.v
+++ b/examples/switching_input.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import SMTCoq.
 Require Import Bool.
 Local Open Scope int63_scope.
diff --git a/examples/sym_zeq.v b/examples/sym_zeq.v
index b940490..1c4be83 100644
--- a/examples/sym_zeq.v
+++ b/examples/sym_zeq.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import SMTCoq.
 Require Import Bool.
 Local Open Scope int63_scope.
diff --git a/src/BoolToProp.v b/src/BoolToProp.v
new file mode 100644
index 0000000..1b8c923
--- /dev/null
+++ b/src/BoolToProp.v
@@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Require Import
+        Bool ZArith BVList Logic BVList FArray
+        SMT_classes SMT_classes_instances ReflectFacts.
+Import BVList.BITVECTOR_LIST. 
+
+Local Coercion is_true : bool >-> Sortclass.
+
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+Infix "<-->" := Bool.eqb (at level 60, right associativity) : bool_scope.
+
+Ltac bool2prop :=
+  repeat
+    match goal with
+    | [ |- forall _ : bitvector _, _] => intro
+    | [ |- forall _ : farray _ _, _] => intro
+    | [ |- forall _ : _ -> _, _] => intro
+    | [ |- forall _ : Z, _] => intro
+    | [ |- forall _ : bool, _] => intro
+    | [ |- forall _ : Type, _] => intro
+    | [ p: Type |-  context[ forall _ : ?t, _ ] ] => intro
+
+    | [ |- forall t : Type, CompDec t -> _  ] => intro
+    | [ |- CompDec _ -> _  ] => intro
+
+    | [ |- context[ bv_ult _ _ ] ] => unfold is_true; rewrite bv_ult_B2P
+    | [ |- context[ bv_slt _ _ ] ] => unfold is_true; rewrite bv_slt_B2P
+    | [ |- context[ bv_eq _ _ ] ]  => unfold is_true; rewrite bv_eq_reflect
+    | [ |- context[ equal _ _ ] ]  => unfold is_true; rewrite equal_iff_eq
+    | [ |- context[ Z.ltb _ _ ] ]  => unfold is_true; rewrite Z.ltb_lt
+    | [ |- context[ Z.gtb _ _ ] ]  => unfold is_true; rewrite Z.gtb_lt
+    | [ |- context[ Z.leb _ _ ] ]  => unfold is_true; rewrite Z.leb_le
+    | [ |- context[ Z.geb _ _ ] ]  => unfold is_true; rewrite Z.geb_le
+    | [ |- context[ Z.eqb _ _ ] ]  => unfold is_true; rewrite Z.eqb_eq
+
+    | [ |- context[?G0 --> ?G1 ] ] =>
+      unfold is_true; rewrite <- (@reflect_iff (G0 = true -> G1 = true)  (G0 --> G1)); 
+      [ | apply implyP]
+
+    | [ |- context[?G0 || ?G1 ] ] =>
+      unfold is_true; rewrite <- (@reflect_iff (G0 = true \/ G1 = true) (G0 || G1)); 
+      [ | apply orP]
+
+    | [ |- context[?G0 && ?G1 ] ] =>
+      unfold is_true; rewrite <- (@reflect_iff (G0 = true /\ G1 = true) (G0 && G1)); 
+      [ | apply andP]
+
+    | [ |- context[?G0 <--> ?G1 ] ] =>
+      unfold is_true; rewrite <- (@reflect_iff (G0 = true <-> G1 = true) (G0 <--> G1)); 
+      [ | apply iffP]
+
+    | [ |- context[ negb ?G ] ] =>
+      unfold is_true; rewrite <- (@reflect_iff (G <> true) (negb G)); 
+      [ | apply negP]
+
+    | [R : CompDec ?t |- context[ CompDec ?t  ] ] => exact R
+
+    | [R : EqbType ?t |- context[ EqbType ?t  ] ] => exact R
+
+    | [ |- context[ false = true ] ] => rewrite FalseB
+                                              
+    | [ |- context[ true = true ] ] => rewrite TrueB
+
+    end.
diff --git a/src/Conversion_tactics.v b/src/Conversion_tactics.v
index 6d1ce3b..5c4be13 100644
--- a/src/Conversion_tactics.v
+++ b/src/Conversion_tactics.v
@@ -1,3 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+
 Require Import ZArith.
 
 (* Ce module représente la structure que l'on souhaite convertir vers Z *)
diff --git a/src/Misc.v b/src/Misc.v
index 889219e..fe724f4 100644
--- a/src/Misc.v
+++ b/src/Misc.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -1003,11 +999,39 @@ End Forall2.
 Implicit Arguments forallb2 [A B].
 
 
-(* 
-   Local Variables:
-   coq-load-path: ((rec "." "SMTCoq"))
-   End: 
-*)
+(* Compatibility between native-coq and Coq 8.5 *)
+
+Definition Nat_eqb :=
+  fix eqb (n m : nat) {struct n} : bool :=
+    match n with
+    | O => match m with
+           | O => true
+           | S _ => false
+           end
+    | S n' => match m with
+              | O => false
+              | S m' => eqb n' m'
+              end
+    end.
+
+Definition List_map_ext_in
+  : forall (A B : Type) (f g : A -> B) (l : list A),
+    (forall a : A, In a l -> f a = g a) -> List.map f l = List.map g l :=
+  fun (A B : Type) (f g : A -> B) (l : list A) =>
+    list_ind
+      (fun l0 : list A =>
+         (forall a : A, In a l0 -> f a = g a) -> List.map f l0 = List.map g l0)
+      (fun _ : forall a : A, False -> f a = g a => eq_refl)
+      (fun (a : A) (l0 : list A)
+           (IHl : (forall a0 : A, In a0 l0 -> f a0 = g a0) -> List.map f l0 = List.map g l0)
+           (H : forall a0 : A, a = a0 \/ In a0 l0 -> f a0 = g a0) =>
+         eq_ind_r (fun b : B => b :: List.map f l0 = g a :: List.map g l0)
+                  (eq_ind_r (fun l1 : list B => g a :: l1 = g a :: List.map g l0) eq_refl
+                            (IHl (fun (a0 : A) (H0 : In a0 l0) => H a0 (or_intror H0))))
+                  (H a (or_introl eq_refl))) l.
+
+
+(* Misc lemmas *)
 
 Lemma neg_eq_true_eq_false b : b = false <-> b <> true.
 Proof. destruct b; intuition. Qed.
diff --git a/src/PropToBool.v b/src/PropToBool.v
new file mode 100644
index 0000000..393f835
--- /dev/null
+++ b/src/PropToBool.v
@@ -0,0 +1,85 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import
+        Bool ZArith BVList Logic BVList FArray
+        SMT_classes SMT_classes_instances ReflectFacts.
+Import BVList.BITVECTOR_LIST. 
+
+Ltac prop2bool :=
+  repeat
+    match goal with
+    | [ |- forall _ : bitvector _, _] => intro
+    | [ |- forall _ : farray _ _, _] => intro
+    | [ |- forall _ : _ -> _, _] => intro
+    | [ |- forall _ : Z, _] => intro
+    | [ |- forall _ : bool, _] => intro
+    | [ |- forall _ : Type, _] => intro
+    | [ p: (CompDec ?t) |-  context[ forall _ : ?t, _ ] ] => intro
+
+    | [ |- forall t : Type, CompDec t -> _  ] => intro
+    | [ |- CompDec _ -> _  ] => intro
+    | [ |- context[ bv_ultP _ _ ] ] => rewrite <- bv_ult_B2P
+    | [ |- context[ bv_sltP _ _ ] ] => rewrite <- bv_slt_B2P
+    | [ |- context[ Z.lt _ _ ] ] => rewrite <- Z.ltb_lt
+    | [ |- context[ Z.gt _ _ ] ] => rewrite Z.gt_lt_iff; rewrite <- Z.ltb_lt
+    | [ |- context[ Z.le _ _ ] ] => rewrite <- Z.leb_le
+    | [ |- context[ Z.ge _ _ ] ] => rewrite Z.ge_le_iff; rewrite <- Z.leb_le
+    | [ |- context[ Z.eq _ _ ] ] => rewrite <- Z.eqb_eq
+
+    | [ p: (CompDec ?t) |- context[ @Logic.eq ?t _ _ ] ] =>
+      pose proof p as p0;
+      rewrite (@compdec_eq_eqb _ p0);
+      destruct p0;
+      try exact p
+
+    | [ Eqb : (EqbType ?ty)  |- _ ] => destruct Eqb; simpl
+
+    | [ |- context[ @Logic.eq (bitvector _) _ _ ] ] =>
+      rewrite <- bv_eq_reflect
+
+    | [ |- context[ @Logic.eq (farray _ _) _ _ ] ] =>
+      rewrite <- equal_iff_eq
+
+    | [ |- context[ @Logic.eq Z _ _ ] ] =>
+      rewrite <- Z.eqb_eq
+
+    | [ |- context[?G0 = true \/ ?G1 = true ] ] =>
+      rewrite (@reflect_iff (G0 = true \/ G1 = true) (orb G0 G1));
+      [ | apply orP]
+
+    | [ |- context[?G0 = true -> ?G1 = true ] ] =>
+      rewrite (@reflect_iff (G0 = true -> G1 = true) (implb G0 G1)); 
+      [ | apply implyP]
+
+    | [ |- context[?G0 = true /\ ?G1 = true ] ] =>
+      rewrite (@reflect_iff (G0 = true /\ G1 = true) (andb G0 G1));
+      [ | apply andP]
+
+    | [ |- context[?G0 = true <-> ?G1 = true ] ] =>
+      rewrite (@reflect_iff (G0 = true <-> G1 = true) (Bool.eqb G0 G1));
+      [ | apply iffP]
+          
+    | [ |- context[ ~ ?G = true ] ] =>
+      rewrite (@reflect_iff (~ G = true) (negb G));
+      [ | apply negP]
+
+    | [ |- context[ is_true ?G ] ] =>
+      unfold is_true
+
+    | [ |- context[ True ] ] => rewrite <- TrueB
+
+    | [ |- context[ False ] ] => rewrite <- FalseB
+
+    (* | [ |- _ : (CompDec _ )] => try easy *)
+    end.
+
diff --git a/src/ReflectFacts.v b/src/ReflectFacts.v
new file mode 100644
index 0000000..404ecc8
--- /dev/null
+++ b/src/ReflectFacts.v
@@ -0,0 +1,82 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import
+        Bool ZArith BVList Logic.
+
+Local Coercion is_true : bool >-> Sortclass.
+
+Section ReflectFacts.
+
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+
+Lemma reflect_iff : forall P b, reflect P b -> (P<->b=true).
+Proof.
+ intros; destruct H; intuition.
+ discriminate H.
+Qed.
+
+Lemma iff_reflect : forall P b, (P<->b=true) -> reflect P b.
+Proof.
+ intros.
+ destr_bool; constructor; try now apply H.
+ unfold not. intros. apply H in H0. destruct H. easy.
+Qed.
+
+Lemma reflect_dec : forall P b, reflect P b -> {P} + {~P}.
+Proof. intros; destruct H; [now left | now right]. Qed.
+
+ Lemma implyP : forall (b1 b2: bool), reflect (b1 -> b2) (b1 --> b2).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *; now apply H1.
+ Qed.
+
+ Lemma iffP : forall (b1 b2: bool), reflect (b1 <-> b2) (eqb b1 b2).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *; now apply H1.
+ Qed.
+
+ Lemma implyP2 : forall (b1 b2 b3: bool), reflect (b1 -> b2 -> b3) (b1 --> b2 --> b3).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *; now apply H1.
+ Qed.
+
+ Lemma andP : forall (b1 b2: bool), reflect (b1 /\ b2) (b1 && b2).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *; now apply H1.
+ Qed.
+
+ Lemma orP : forall (b1 b2: bool), reflect (b1 \/ b2) (b1 || b2).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *.
+        destruct H1 as [H1a | H1b ]; easy. left. easy. left. easy.
+        right. easy.
+ Qed.
+
+ Lemma negP : forall (b: bool), reflect (~ b) (negb b).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b; intros; try easy; try compute in *.
+        contradict H0. easy.
+ Qed.
+
+ Lemma eqP : forall (b1 b2: bool), reflect (b1 = b2) (Bool.eqb b1 b2).
+ Proof. intros; apply iff_reflect; split;
+        case_eq b1; case_eq b2; intros; try easy; try compute in *; now apply H1.
+ Qed.
+
+ Lemma FalseB : (false = true) <-> False.
+ Proof. split; auto. discriminate. Qed.
+
+ Lemma TrueB : (true = true) <-> True.
+ Proof. split; auto. Qed.
+
+End ReflectFacts.
diff --git a/src/SMTCoq.v b/src/SMTCoq.v
index a17c840..6b69058 100644
--- a/src/SMTCoq.v
+++ b/src/SMTCoq.v
@@ -1,83 +1,18 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
+Require Export PropToBool BoolToProp.  (* Before SMTCoq.State *)
 Require Export Int63 List PArray.
-Require Export State SMT_terms Trace.
+Require Export SMTCoq.State SMTCoq.SMT_terms SMTCoq.Trace SMT_classes_instances.
+Require Export Tactics.
 Require Export Conversion_tactics.
 Export Atom Form Sat_Checker Cnf_Checker Euf_Checker.
-
-Declare ML Module "smtcoq_plugin".
-
-Require Import Bool.
-Open Scope Z_scope.
-
-(* verit silently transforms an <implb a b> into a <or (not a) b> when
- instantiating a quantified theorem with <implb> *)
-Lemma impl_split a b:
-  implb a b = true -> orb (negb a) b = true.
-Proof.
-  intro H.
-  destruct a; destruct b; trivial.
-(* alternatively we could do <now verit_base H.> but it forces us to have veriT
-   installed when we compile SMTCoq. *)
-Qed.
-
-Hint Resolve impl_split.
-
-(* verit silently transforms an <implb (a || b) c> into a <or (not a) c>
-   or into a <or (not b) c> when instantiating such a quantified theorem *)
-Lemma impl_or_split_right a b c:
-  implb (a || b) c -> negb b || c.
-Proof.
-  intro H.
-  destruct a; destruct c; intuition.
-Qed.
-
-Lemma impl_or_split_left a b c:
-  implb (a || b) c -> negb a || c.
-Proof.
-  intro H.
-  destruct a; destruct c; intuition.
-Qed.
-
-(* verit considers equality modulo its symmetry, so we have to recover the
-   right direction in the instances of the theorems *)
-Definition hidden_eq a b := a =? b.
-Ltac all_rew :=
-  repeat match goal with
-         | [ |- context [ ?A =? ?B]] =>
-           change (A =? B) with (hidden_eq A B)
-         end;
-  repeat match goal with
-         | [ |- context [ hidden_eq ?A ?B] ] =>
-           replace (hidden_eq A B) with (B =? A);
-           [ | now rewrite Z.eqb_sym]
-         end.
-
-(* An automatic tactic that takes into account all those transformations *)
-Ltac vauto :=
-  try (let H := fresh "H" in
-       intro H; try (all_rew; apply H);
-       match goal with
-       | [ |- is_true (negb ?A || ?B) ] =>
-         try (eapply impl_or_split_right; apply H);
-         eapply impl_or_split_left; apply H
-       end;
-       apply H);
-  auto.
-
-Ltac verit :=
-  verit_base; vauto.
diff --git a/src/SMT_terms.v b/src/SMT_terms.v
index 65c0d8f..c411c99 100644
--- a/src/SMT_terms.v
+++ b/src/SMT_terms.v
@@ -1,22 +1,20 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
-Require Import Bool List Int63 PArray.
-Require Import Misc State.
-
+Require Import Bool Int63 PArray BinPos SMT_classes_instances.
+Require Import Misc State BVList. (* FArray Equalities DecidableTypeEx. *)
+Require FArray.
+Require List .
+Local Open Scope list_scope.
 Local Open Scope array_scope.
 Local Open Scope int63_scope.
 
@@ -40,7 +38,16 @@ Module Form.
   | Fimp (_:fargs)
   | Fxor (_:_lit) (_:_lit)
   | Fiff (_:_lit) (_:_lit)
-  | Fite (_:_lit) (_:_lit) (_:_lit).
+  | Fite (_:_lit) (_:_lit) (_:_lit)
+   (* Bit-blasting predicate (theory of bit vectors):
+        bbT a [l1;...;ln] means [l1;...;ln] is the bitwise representation of a
+      (in little endian)
+      WARNING: this is a slight infringement of stratification
+      *)
+  | FbbT (_:atom) (_:list _lit)
+  (* TODO: replace [list _lit] with [fargs] *)
+  .
+
 
   Definition is_Ftrue h :=
     match h with Ftrue => true | _ => false end.
@@ -49,13 +56,15 @@ Module Form.
     match h with Ffalse => true | _ => false end.
 
   Lemma is_Ftrue_correct : forall h, is_Ftrue h -> h = Ftrue.
-  Proof. destruct h;trivial;discriminate. Qed.
+  Proof. destruct h; trivial;discriminate. Qed.
 
   Lemma is_Ffalse_correct : forall h, is_Ffalse h -> h = Ffalse.
   Proof. destruct h;trivial;discriminate. Qed.
 
+
   Section Interp.
     Variable interp_atom : atom -> bool.
+    Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s.
 
     Section Interp_form.
 
@@ -79,6 +88,10 @@ Module Form.
         | Fite a b c =>
           if Lit.interp interp_var a then Lit.interp interp_var b
           else Lit.interp interp_var c
+        | FbbT a ls =>
+          let ils := List.map (Lit.interp interp_var) ls in
+          let n := N.of_nat (List.length ils) in
+          BITVECTOR_LIST.bv_eq (interp_bvatom a n) (BITVECTOR_LIST.of_bits ils)
         end.
 
     End Interp_form.
@@ -88,7 +101,7 @@ Module Form.
       Variable t_form : PArray.array form.
 
       Definition t_interp : PArray.array bool :=
-        PArray.foldi_left (fun i t_b hf => 
+        PArray.foldi_left (fun i t_b hf =>
             t_b.[i <- interp_aux (PArray.get t_b) hf])
         (PArray.make (PArray.length t_form) true) t_form.
 
@@ -98,8 +111,9 @@ Module Form.
         | Fnot2 _ l => Lit.blit l < i
         | Fand args | For args | Fimp args =>
           PArray.forallb (fun l => Lit.blit l < i) args
-        | Fxor a b | Fiff a b => (Lit.blit a < i) && (Lit.blit b < i) 
+        | Fxor a b | Fiff a b => (Lit.blit a < i) && (Lit.blit b < i)
         | Fite a b c => (Lit.blit a < i) && (Lit.blit b < i) && (Lit.blit c < i)
+        | FbbT _ ls => List.forallb (fun l => Lit.blit l < i) ls
         end.
 
       Lemma lt_form_interp_form_aux :
@@ -112,16 +126,19 @@ Module Form.
           try (apply afold_left_eq;unfold is_true in H0;
             rewrite PArray.forallb_spec in H0;intros;
               auto using Lit.interp_eq_compat).
-        f_equal;auto using Lit.interp_eq_compat.
-        apply afold_right_eq;unfold is_true in H0;
-          rewrite PArray.forallb_spec in H0;intros;
-            auto using Lit.interp_eq_compat.
-        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
-          rewrite !(Lit.interp_eq_compat f1 f2);auto.
-        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
-          rewrite !(Lit.interp_eq_compat f1 f2);auto.
-        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
-          rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        - f_equal;auto using Lit.interp_eq_compat.
+        - apply afold_right_eq;unfold is_true in H0;
+            rewrite PArray.forallb_spec in H0;intros;
+              auto using Lit.interp_eq_compat.
+        - unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+            rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        - unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+            rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        - unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+            rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        - replace (List.map (Lit.interp f2) l) with (List.map (Lit.interp f1) l); auto.
+          unfold is_true in H0. rewrite List.forallb_forall in H0.
+          apply List_map_ext_in. intros x Hx. apply Lit.interp_eq_compat; auto.
       Qed.
 
       Definition wf := PArray.forallbi lt_form t_form.
@@ -227,98 +244,160 @@ Module Form.
 
 End Form.
 
-(* TODO Move this *)
-Record typ_eqb : Type := Typ_eqb {
-  te_carrier : Type;
-  te_eqb : te_carrier -> te_carrier -> bool;
-  te_reflect : forall x y, reflect (x = y) (te_eqb x y)
-}.
-
-Section Typ_eqb_param.
-
-  Variable A : Type.
-  Variable r : { eq : A -> A -> bool & forall x y, reflect (x = y) (eq x y) }.
-
-  Definition typ_eqb_of_typ_eqb_param : typ_eqb :=
-    Typ_eqb A (projT1 r) (projT2 r).
-
-End Typ_eqb_param.
-
-(* Common used types into which we interpret *)
-
-(* Unit *)
 
-Section Unit_typ_eqb.
+Require OrderedTypeEx.
 
-  Let carrier : Type := unit.
-
-  Let eqb : carrier -> carrier -> bool :=
-    fun _ _ => true.
-
-  Lemma unit_reflect :
-    forall x y, reflect (x = y) (eqb x y).
-  Proof.
-    unfold eqb; intros x y; case x; case y; simpl;
-      constructor; reflexivity.
-  Qed.
-
-  Definition unit_typ_eqb :=
-    Typ_eqb carrier eqb unit_reflect.
-
-End Unit_typ_eqb.
-(* End TODO *)
 
 Module Typ.
 
+  Import FArray.
+
   Notation index := int (only parsing).
 
   Inductive type :=
+  | TFArray : type -> type -> type
   | Tindex : index -> type
   | TZ : type
   | Tbool : type
-  | Tpositive : type.
+  | Tpositive : type
+  | TBV : N -> type.
 
   Definition ftype := (list type * type)%type.
 
   Section Interp.
 
-    Variable t_i : PArray.array typ_eqb.
+    Import OrderedTypeEx.
+
+    Variable t_i : PArray.array typ_compdec.
 
-    Definition interp t :=
+    Fixpoint interp_compdec_aux (t:type) : {ty: Type & CompDec ty} :=
       match t with
-      | Tindex i => (t_i.[i]).(te_carrier)
-      | TZ => Z
-      | Tbool => bool
-      | Tpositive => positive
+      | TFArray ti te =>
+        existT (fun ty : Type => CompDec ty)
+               (@farray (type_compdec (projT2 (interp_compdec_aux ti)))
+                        (type_compdec (projT2 (interp_compdec_aux te)))
+                        (@ord_of_compdec _ (projT2 (interp_compdec_aux ti)))
+                        (@inh_of_compdec _ (projT2 (interp_compdec_aux te))))
+               (FArray_compdec
+                  (type_compdec (projT2 (interp_compdec_aux ti)))
+                  (type_compdec (projT2 (interp_compdec_aux te))))
+      | Tindex i =>
+        existT (fun ty : Type => CompDec ty)
+               (te_carrier (t_i .[ i])) (te_compdec (t_i .[ i]))
+      | TZ => existT (fun ty : Type => CompDec ty) Z Z_compdec
+      | Tbool => existT (fun ty : Type => CompDec ty) bool bool_compdec
+      | Tpositive => existT (fun ty : Type => CompDec ty) positive Positive_compdec
+      | TBV n => existT (fun ty : Type => CompDec ty) (BITVECTOR_LIST.bitvector n) (BV_compdec n)
       end.
 
+    Definition interp_compdec (t:type) : CompDec (projT1 (interp_compdec_aux t)) :=
+      projT2 (interp_compdec_aux t).
+
+    Definition interp (t:type) : Type := type_compdec (interp_compdec t).
+
+
     Definition interp_ftype (t:ftype) :=
-      List.fold_right (fun dom codom =>interp dom -> codom)
+      List.fold_right (fun dom codom => interp dom -> codom)
       (interp (snd t)) (fst t).
 
+
+    Definition dec_interp (t:type) : DecType (interp t).
+      destruct (interp_compdec t).
+      subst ty.
+      apply Decidable.
+    Defined.
+
+    Instance comp_interp (t:type) : Comparable (interp t).
+      destruct (interp_compdec t).
+      subst ty.
+      apply Comp.
+    Defined.
+
+    Instance ord_interp (t:type) : OrdType (interp t).
+      destruct (interp_compdec t).
+      subst ty.
+      apply Ordered.
+    Defined.
+
+
+    Definition inh_interp (t:type) : Inhabited (interp t).
+      unfold interp.
+      destruct (interp_compdec t).
+      apply Inh.
+    Defined.
+
+    Definition inhabitant_interp (t:type) : interp t := default_value.
+
+
+    Hint Resolve
+         dec_interp comp_interp ord_interp
+         inh_interp interp_compdec : typeclass_instances.
+
+
     (* Boolean equality over interpretation of a btype *)
     Section Interp_Equality.
 
+
       Definition i_eqb (t:type) : interp t -> interp t -> bool :=
-        match t with
-        | Tindex i => (t_i.[i]).(te_eqb)
-        | TZ => Z.eqb
-        | Tbool => Bool.eqb
-        | Tpositive => Peqb
-        end.
+        eqb_of_compdec (interp_compdec t).
+
+
+      Lemma eqb_compdec_spec {t} (c : CompDec t) : forall x y,
+          eqb_of_compdec c x y = true <-> x = y.
+        intros.
+        destruct c.
+        destruct Eqb.
+        simpl.
+        auto.
+      Qed.
+
+      Lemma eqb_compdec_spec_false {t} (c : CompDec t) : forall x y,
+          eqb_of_compdec c x y = false <-> x <> y.
+        intros.
+        destruct c.
+        destruct Eqb.
+        simpl.
+        split. intros.
+        unfold not. intros.
+        apply eqb_spec in H0.
+        rewrite H in H0. now contradict H0.
+        intros. unfold not in H.
+        rewrite <- not_true_iff_false.
+        unfold not. intros.
+        apply eqb_spec in H0.
+        apply H in H0. now contradict H0.
+      Qed.
 
       Lemma i_eqb_spec : forall t x y, i_eqb t x y <-> x = y.
       Proof.
-       destruct t;simpl;intros.
-       symmetry;apply reflect_iff;apply te_reflect.
-       apply Z.eqb_eq.
-       apply Bool.eqb_true_iff.
-       apply Peqb_eq.
+        intros.
+        unfold i_eqb.
+        apply eqb_compdec_spec.
+      Qed.
+
+      Lemma i_eqb_spec_false : forall t x y, i_eqb t x y = false <-> x <> y.
+      Proof.
+        intros.
+        unfold i_eqb.
+        apply eqb_compdec_spec_false.
       Qed.
 
+      Lemma reflect_eqb_compdec {t} (c : CompDec t) : forall x y,
+          reflect (x = y) (eqb_of_compdec c x y).
+        intros.
+        destruct c.
+        destruct Eqb.
+        simpl in *.
+        apply iff_reflect.
+        symmetry; auto.
+      Qed.
+
+
       Lemma reflect_i_eqb : forall t x y, reflect (x = y) (i_eqb t x y).
       Proof.
-        intros;apply iff_reflect;symmetry;apply i_eqb_spec.
+        intros.
+        unfold i_eqb.
+        apply reflect_eqb_compdec.
       Qed.
 
      Lemma i_eqb_sym : forall t x y, i_eqb t x y = i_eqb t y x.
@@ -328,6 +407,67 @@ Module Typ.
           rewrite is_true_iff in *; now rewrite i_eqb_spec in *.
       Qed.
 
+
+      (* Lemma i_eqb_compdec_tbv (c: CompDec): forall x y,  TBV x y = BITVECTOR_LIST_FIXED.bv_eq x y.  *)
+      (* Proof. *)
+
+      Definition i_eqb_eqb (t:type) : interp t -> interp t -> bool :=
+        match t with
+        | Tindex i => eqb_of_compdec (t_i.[i]).(te_compdec)
+        | TZ => Z.eqb (* Zeq_bool *)
+        | Tbool => Bool.eqb
+        | Tpositive => Peqb
+        | TBV n => (@BITVECTOR_LIST.bv_eq n)
+        | TFArray ti te => i_eqb (TFArray ti te)
+        end.
+
+
+      Lemma eqb_compdec_refl {t} (c : CompDec t) : forall x,
+          eqb_of_compdec c x x = true.
+        intros.
+        destruct c.
+        destruct Eqb.
+        simpl.
+        apply eqb_spec. auto.
+      Qed.
+
+      Lemma i_eqb_refl : forall t x, i_eqb t x x.
+      Proof.
+        intros.
+        unfold i_eqb.
+        apply eqb_compdec_refl.
+      Qed.
+
+
+      Lemma eqb_compdec_trans {t} (c : CompDec t) : forall x y z,
+          eqb_of_compdec c x y = true ->
+          eqb_of_compdec c y z = true ->
+          eqb_of_compdec c x z = true .
+        intros.
+        destruct c.
+        destruct Eqb.
+        simpl in *.
+        apply eqb_spec.
+        apply eqb_spec in H.
+        apply eqb_spec in H0.
+        subst; auto.
+      Qed.
+
+      Lemma i_eqb_trans : forall t x y z, i_eqb t x y -> i_eqb t y z -> i_eqb t x z.
+      Proof.
+        intros.
+        unfold i_eqb.
+        apply (eqb_compdec_trans _ x y z); auto.
+      Qed.
+
+
+      Lemma i_eqb_t : forall t x y, i_eqb t x y = i_eqb_eqb t x y.
+      Proof.
+        intros.
+        unfold i_eqb_eqb.
+        destruct t; simpl; auto; unfold i_eqb; simpl.
+      Qed.
+
     End Interp_Equality.
 
   End Interp.
@@ -355,34 +495,94 @@ Module Typ.
     Notation idcast := (Cast (fun P x => x)).
     (* La fonction cast calcule cast_result *)
 
-    Definition cast (A B: type) : cast_result A B :=
+    Fixpoint positive_cast (n m : positive) {struct n} :
+      option (forall P, P n -> P m) :=
+      match n, m return option (forall P, P n -> P m) with
+      | xH, xH => Some (fun P x => x)
+      | xO p, xO q =>
+        match positive_cast p q with
+        | Some k => Some (fun P => k (fun y => P (xO y)))
+        | None => None
+        end
+      | xI p, xI q =>
+        match positive_cast p q with
+        | Some k => Some (fun P => k (fun y => P (xI y)))
+        | None => None
+        end
+      | _, _ => None
+      end.
+
+    Definition N_cast (n m : N) : option (forall P, P n -> P m) :=
+      match n, m return option (forall P, P n -> P m) with
+      | N0, N0 => Some (fun P x => x)
+      | Npos p, Npos q =>
+        match positive_cast p q with
+        | Some k => Some (fun P => k (fun y => P (Npos y)))
+        | None => None
+        end
+      | _, _ => None
+      end.
+
+
+    (* TODO *)
+
+    Fixpoint cast (A B: type) : cast_result A B :=
       match A as C, B as D return cast_result C D with
       | Tindex i, Tindex j =>
-        match cast i j with
+        match Int63Op.cast i j with
         | Some k => Cast (fun P => k (fun y => P (Tindex y)))
         | None => NoCast
         end
       | TZ, TZ => idcast
       | Tbool, Tbool => idcast
       | Tpositive, Tpositive => idcast
+      | TBV n, TBV m =>
+        match N_cast n m with
+        | Some k => Cast (fun P => k (fun y => P (TBV y)))
+        | None => NoCast
+        end
+      | TFArray k1 e1, TFArray k2 e2 =>
+        match cast k1 k2, cast e1 e2 with
+        | Cast kk, Cast ke =>
+          let ka P :=
+              let Pb d := P (TFArray d e1) in
+              let Pc d := P (TFArray k2 d) in
+              fun x => ke Pc (kk Pb x)
+          in Cast ka
+        | _, _ => NoCast
+        end
       | _, _ => NoCast
       end.
 
-    Lemma cast_refl:
-      forall A, cast A A = Cast (fun P (H : P A) => H).
+    Lemma positive_cast_refl:
+      forall p, positive_cast p p = Some (fun P (H : P p) => H).
+    Proof. induction p as [p IHp|p IHp| ]; simpl; try rewrite IHp; auto. Qed.
+
+    Lemma N_cast_refl:
+      forall n, N_cast n n = Some (fun P (H : P n) => H).
+    Proof. intros [ |p]; simpl; try rewrite positive_cast_refl; auto. Qed.
+
+    Fixpoint cast_refl A:
+      cast A A = Cast (fun P (H : P A) => H).
     Proof.
-      intros A0;destruct A0;simpl;trivial.
-      rewrite cast_refl;trivial.
+      destruct A;simpl;trivial.
+      do 2 rewrite cast_refl. easy.
+      rewrite Int63Properties.cast_refl;trivial.
+      rewrite N_cast_refl;trivial.
     Qed.
 
+
     (* Remark : I use this definition because eqb will not be used only in the interpretation *)
-    Definition eqb (A B: type) : bool :=
+    Fixpoint eqb (A B: type) : bool :=
       match A, B with
       | Tindex i, Tindex j => i == j
       | TZ, TZ => true
       | Tbool, Tbool => true
       | Tpositive, Tpositive => true
-      | _, _ => false
+      | TBV n, TBV m => N.eqb n m
+      | TFArray k1 e1, TFArray k2 e2 =>
+        eqb k1 k2 && eqb e1 e2
+      | _,_ => false
       end.
 
 
@@ -398,10 +598,43 @@ Module Typ.
     Lemma not_is_true_eq_false : forall b:bool, ~ b <-> b = false.
     Proof. exact not_true_iff_false. Qed.
 
-    Lemma cast_diff: forall A B, eqb A B = false -> cast A B = NoCast.
+    Lemma positive_cast_diff: forall p q, p <> q -> positive_cast p q = None.
+    Proof.
+      induction p as [p IHp|p IHp| ]; intros [q|q| ]; auto; intro Heq.
+      - simpl. rewrite IHp; auto.
+        intro H. apply Heq. rewrite H. reflexivity.
+      - simpl. rewrite IHp; auto.
+        intro H. apply Heq. rewrite H. reflexivity.
+      - elim Heq. reflexivity.
+    Qed.
+
+    Lemma N_cast_diff: forall n m, n <> m -> N_cast n m = None.
     Proof.
-      intros A0 B0;destruct A0; destruct B0;simpl;trivial;try discriminate.
-      intros Heq;rewrite (cast_diff _ _ Heq);trivial.
+      intros [ |n] [ |m]; auto; intro Heq.
+      - elim Heq; reflexivity.
+      - simpl. rewrite positive_cast_diff; auto.
+        intro H. apply Heq. rewrite H. reflexivity.
+    Qed.
+
+    Fixpoint cast_diff A B: eqb A B = false -> cast A B = NoCast.
+    Proof.
+      destruct A; destruct B;simpl;trivial;try discriminate.
+      intros.
+      rewrite andb_false_iff in H.
+      destruct H; apply cast_diff in H; rewrite H; auto.
+      case (cast A1 B1); auto.
+      intros H. rewrite (Int63Properties.cast_diff _ _ H);trivial.
+      rewrite N.eqb_neq. intro Heq. now rewrite N_cast_diff.
+    Qed.
+
+    Lemma cast_eqb A B k: cast A B = Cast k -> eqb A B = true.
+    Proof.
+      intros.
+      apply not_false_iff_true.
+      unfold not.
+      intro.
+      apply cast_diff in H0.
+      rewrite H in H0. inversion H0.
     Qed.
 
     Lemma neq_cast : forall A B,
@@ -410,22 +643,65 @@ Module Typ.
       intros C D;case_eq (eqb C D);trivial;apply cast_diff.
     Qed.
 
-    Lemma reflect_eqb : forall x y, reflect (x = y) (eqb x y).
+    Fixpoint reflect_eqb x y: reflect (x = y) (eqb x y).
     Proof.
-      intros x y;destruct x;destruct y;simpl;try constructor;trivial;try discriminate.
-      apply iff_reflect;rewrite eqb_spec;split;intros H;[inversion H | subst];trivial.
+      destruct x;destruct y;simpl;try constructor;trivial;try discriminate.
+      apply iff_reflect.
+      split.
+      intro H. inversion H. subst.
+      rewrite andb_true_iff.
+      split;
+      [specialize (reflect_eqb y1 y1) | specialize (reflect_eqb y2 y2)];
+      apply reflect_iff in reflect_eqb; apply reflect_eqb; auto.
+      intros.
+      rewrite andb_true_iff in H; destruct H.
+      apply (reflect_iff _ _ (reflect_eqb x1 y1)) in H.
+      apply (reflect_iff _ _ (reflect_eqb x2 y2)) in H0.
+      subst; auto.
+      apply iff_reflect;rewrite Int63Properties.eqb_spec;split;intros H;[inversion H | subst]; trivial.
+      apply iff_reflect. rewrite N.eqb_eq. split;intros H;[inversion H | subst]; trivial.
     Qed.
 
     Lemma eqb_spec : forall x y, eqb x y <-> x = y.
     Proof.
-      intros;symmetry;apply reflect_iff;apply reflect_eqb.
+      intros.
+      symmetry.
+      apply reflect_iff.
+      apply reflect_eqb.
     Qed.
 
     Lemma eqb_refl : forall x, eqb x x.
     Proof. intros; rewrite eqb_spec; auto. Qed.
 
+
+    Lemma cast_eq A B k: cast A B = Cast k -> A = B.
+    Proof.
+      intros. apply eqb_spec. apply (cast_eqb _ _ k). auto.
+    Qed.
+
+    Lemma nocast_refl A B: cast A B = NoCast -> cast B A = NoCast.
+    Proof.
+      intros.
+      apply cast_diff.
+      rewrite neq_cast in H.
+      case_eq (eqb A B). intro.
+      rewrite H0 in H.
+      apply eqb_spec in H0.
+      rewrite H0 in H.
+      rewrite cast_refl in H.
+      now contradict H.
+      intro.
+      apply not_true_iff_false.
+      unfold not.
+      intro.
+      apply eqb_spec in H1.
+      rewrite H1 in H0. rewrite eqb_refl in H0. now contradict H0.
+    Qed.
+
+
   End Cast.
 
+
 End Typ.
 
 Arguments Typ.Cast {_} {_} _.
@@ -471,20 +747,28 @@ Proof.
 Qed.
 (* End move *)
 
+
 Module Atom.
 
   Notation func := int (only parsing).
- 
-  Inductive cop : Type := 
+
+  Inductive cop : Type :=
    | CO_xH
-   | CO_Z0.
+   | CO_Z0
+   | CO_BV (_: list bool) (_ :N).
 
   Inductive unop : Type :=
    | UO_xO
    | UO_xI
-   | UO_Zpos 
+   | UO_Zpos
    | UO_Zneg
-   | UO_Zopp.
+   | UO_Zopp
+   | UO_BVbitOf (_: N) (_: nat)
+   | UO_BVnot   (_: N)
+   | UO_BVneg   (_: N)
+   | UO_BVextr  (i: N) (n0: N) (n1: N) (* TODO n1 first arg *)
+   | UO_BVzextn (n: N) (i: N)
+   | UO_BVsextn (n: N) (i: N).
 
   Inductive binop : Type :=
    | BO_Zplus
@@ -494,17 +778,35 @@ Module Atom.
    | BO_Zle
    | BO_Zge
    | BO_Zgt
-   | BO_eq (_ : Typ.type).
+   | BO_eq (_ : Typ.type)
+   | BO_BVand (_: N)
+   | BO_BVor (_: N)
+   | BO_BVxor (_: N)
+   | BO_BVadd (_: N)
+   | BO_BVsubst (_: N)
+   | BO_BVmult (_: N)
+   | BO_BVult (_: N)
+   | BO_BVslt (_: N)
+   | BO_BVconcat (_: N) (_: N)
+   | BO_BVshl (_: N)
+   | BO_BVshr (_: N)
+   | BO_select (_ : Typ.type) (_ : Typ.type)
+   | BO_diffarray (_ : Typ.type) (_ : Typ.type)
+  .
 
   Inductive nop : Type :=
    | NO_distinct (_ : Typ.type).
 
+  Inductive terop : Type :=
+   | TO_store (_ : Typ.type) (_ : Typ.type).
+
   Notation hatom := int (only parsing).
- 
+
   Inductive atom : Type :=
    | Acop (_: cop)
    | Auop (_ : unop) (_:hatom)
    | Abop (_ : binop) (_:hatom) (_:hatom)
+   | Atop (_ : terop) (_:hatom) (_:hatom) (_:hatom)
    | Anop (_ : nop) (_: list hatom)
    | Aapp (_:func) (_: list hatom).
 
@@ -514,18 +816,25 @@ Module Atom.
   (** Equality *)
   Definition cop_eqb o o' :=
    match o, o' with
-   | CO_xH, CO_xH 
+   | CO_xH, CO_xH
    | CO_Z0, CO_Z0 => true
+   | CO_BV bv s, CO_BV bv' s' => N.eqb s s' && RAWBITVECTOR_LIST.beq_list bv bv'
    | _,_ => false
    end.
 
   Definition uop_eqb o o' :=
    match o, o' with
-   | UO_xO, UO_xO 
+   | UO_xO, UO_xO
    | UO_xI, UO_xI
-   | UO_Zpos, UO_Zpos 
+   | UO_Zpos, UO_Zpos
    | UO_Zneg, UO_Zneg
    | UO_Zopp, UO_Zopp => true
+   | UO_BVbitOf s1 n, UO_BVbitOf s2 m => Nat_eqb n m && N.eqb s1 s2
+   | UO_BVnot s1, UO_BVnot s2 => N.eqb s1 s2
+   | UO_BVneg s1, UO_BVneg s2 => N.eqb s1 s2
+   | UO_BVextr i0 n00 n01, UO_BVextr i1 n10 n11 => N.eqb i0 i1 && N.eqb n00 n10 && N.eqb n01 n11
+   | UO_BVzextn s1 i1, UO_BVzextn s2 i2 => N.eqb s1 s2 && N.eqb i1 i2
+   | UO_BVsextn s1 i1, UO_BVsextn s2 i2 => N.eqb s1 s2 && N.eqb i1 i2
    | _,_ => false
    end.
 
@@ -539,9 +848,27 @@ Module Atom.
    | BO_Zge, BO_Zge
    | BO_Zgt, BO_Zgt => true
    | BO_eq t, BO_eq t' => Typ.eqb t t'
+   | BO_BVand s1, BO_BVand s2 => N.eqb s1 s2
+   | BO_BVor s1, BO_BVor s2
+   | BO_BVxor s1, BO_BVxor s2
+   | BO_BVadd s1, BO_BVadd s2
+   | BO_BVsubst s1, BO_BVsubst s2
+   | BO_BVmult s1, BO_BVmult s2 => N.eqb s1 s2
+   | BO_BVult s1, BO_BVult s2 => N.eqb s1 s2
+   | BO_BVslt s1, BO_BVslt s2 => N.eqb s1 s2
+   | BO_BVconcat s1 s2, BO_BVconcat s3 s4 => N.eqb s1 s3 && N.eqb s2 s4
+   | BO_BVshl s1, BO_BVshl s2 => N.eqb s1 s2
+   | BO_BVshr s1, BO_BVshr s2 => N.eqb s1 s2
+   | BO_select ti te, BO_select ti' te'
+   | BO_diffarray ti te, BO_diffarray ti' te' => Typ.eqb ti ti' && Typ.eqb te te'
    | _,_ => false
    end.
 
+  Definition top_eqb o o' :=
+   match o, o' with
+   | TO_store ti te, TO_store ti' te' => Typ.eqb ti ti' && Typ.eqb te te'
+   end.
+
   Definition nop_eqb o o' :=
     match o, o' with
       | NO_distinct t, NO_distinct t' => Typ.eqb t t'
@@ -553,6 +880,8 @@ Module Atom.
     | Auop o t, Auop o' t' => uop_eqb o o' && (t == t')
     | Abop o t1 t2, Abop o' t1' t2' => bop_eqb o o' && (t1 == t1') && (t2 == t2')
     | Anop o t, Anop o' t' => nop_eqb o o' && list_beq Int63Native.eqb t t'
+    | Atop o t1 t2 t3, Atop o' t1' t2' t3' =>
+      top_eqb o o' && (t1 == t1') && (t2 == t2') && (t3 == t3')
     | Aapp a la, Aapp b lb => (a == b) && list_beq Int63Native.eqb la lb
     | _, _ => false
     end.
@@ -565,19 +894,109 @@ Module Atom.
 
   Lemma reflect_cop_eqb : forall o1 o2, reflect (o1 = o2) (cop_eqb o1 o2).
   Proof.
-   destruct o1;destruct o2;simpl;constructor;trivial;discriminate.
+    destruct o1; destruct o2; simpl; try (constructor; trivial; discriminate).
+    apply iff_reflect. split. intro.
+    inversion H. rewrite andb_true_iff. split.
+      rewrite N.eqb_refl; auto. apply RAWBITVECTOR_LIST.List_eq_refl; auto.
+      intros. rewrite andb_true_iff in H. destruct H as (Ha, Hb).
+        apply N.eqb_eq in Ha. rewrite RAWBITVECTOR_LIST.List_eq in Hb.
+        now rewrite Ha, Hb.
   Qed.
 
   Lemma reflect_uop_eqb : forall o1 o2, reflect (o1 = o2) (uop_eqb o1 o2).
   Proof.
-   destruct o1;destruct o2;simpl;constructor;trivial;discriminate.
+    intros [ | | | | | s1 n1 | s1 | s1 | s1 | s1 | s1 ] [ | | | | |s2 n2 | s2 | s2 | s2 | s2 | s2 ];simpl; try constructor;trivial; try discriminate.
+    - apply iff_reflect. case_eq (Nat_eqb n1 n2).
+      + case_eq ((s1 =? s2)%N).
+        * rewrite N.eqb_eq, beq_nat_true_iff.
+          intros -> ->. split; reflexivity.
+        * rewrite N.eqb_neq, beq_nat_true_iff.
+          intros H1 ->; split; try discriminate.
+          intro H. inversion H. elim H1. auto.
+      + split; auto.
+        * rewrite beq_nat_false_iff in H. intros. contradict H0.
+          intro H'. apply H. inversion H'. reflexivity.
+        *  intros. contradict H0. easy.
+    - apply iff_reflect. rewrite N.eqb_eq. split; intro H.
+      + now inversion H.
+      + now rewrite H.
+    - apply iff_reflect. rewrite N.eqb_eq. split; intro H.
+      + now inversion H.
+      + now rewrite H.
+    - intros. apply iff_reflect. split. intro H.
+      inversion H.
+      rewrite !andb_true_iff; split.
+      split; now rewrite N.eqb_eq.
+      now rewrite N.eqb_eq.
+      intros. rewrite !andb_true_iff in H.
+      destruct H as ((Ha, Hb), Hc).
+      rewrite N.eqb_eq in Ha, Hb, Hc.
+      subst.
+      reflexivity.
+    - intros. apply iff_reflect. split; intros.
+      + rewrite !andb_true_iff. inversion H.
+        split; try split; try now rewrite N.eqb_eq.
+      + rewrite !andb_true_iff in H.
+        destruct H as (Ha, Hb).
+        rewrite N.eqb_eq in Ha, Hb.
+        now subst.
+    - intros. apply iff_reflect. split; intros.
+      + rewrite !andb_true_iff. inversion H.
+        split; try split; try now rewrite N.eqb_eq.
+      + rewrite !andb_true_iff in H.
+        destruct H as (Ha, Hb).
+        rewrite N.eqb_eq in Ha, Hb.
+        now subst.
   Qed.
- 
+
+
   Lemma reflect_bop_eqb : forall o1 o2, reflect (o1 = o2) (bop_eqb o1 o2).
   Proof.
-   destruct o1;destruct o2;simpl;try (constructor;trivial;discriminate).
-   preflect (Typ.reflect_eqb t t0).
-   constructor;subst;trivial.
+    intros [ | | | | | | | A1|s1|s1 |s1 | s1 | s1 | s1 | s1 | s1 | s1 | s1 | s1 | I1 E1 | I1 E1 ]
+           [ | | | | | | | A2|s2|s2| s2 | s2 | s2 | s2 | s2 | s2 | s2 | s2 | s2 |I2 E2 | I2 E2 ];
+      simpl;try (constructor;trivial;discriminate).
+   - preflect (Typ.reflect_eqb A1 A2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - intros.
+     preflect (N.eqb_spec s1 s2).
+     preflect (N.eqb_spec n n0).
+     constructor;subst;trivial.
+
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+   - preflect (N.eqb_spec s1 s2).
+     constructor;subst;trivial.
+
+   - preflect (Typ.reflect_eqb I1 I2).
+     preflect (Typ.reflect_eqb E1 E2).
+     constructor;subst;trivial.
+   - preflect (Typ.reflect_eqb I1 I2).
+     preflect (Typ.reflect_eqb E1 E2).
+     constructor;subst;trivial.
+Qed.
+
+  Lemma reflect_top_eqb : forall o1 o2, reflect (o1 = o2) (top_eqb o1 o2).
+  Proof.
+    intros [ I1 E1 ] [ I2 E2 ]. simpl.
+    preflect (Typ.reflect_eqb I1 I2).
+    preflect (Typ.reflect_eqb E1 E2).
+    constructor;subst;trivial.
   Qed.
 
   Lemma reflect_nop_eqb : forall o1 o2, reflect (o1 = o2) (nop_eqb o1 o2).
@@ -594,32 +1013,40 @@ Module Atom.
     preflect (reflect_uop_eqb u u0); preflect (Int63Properties.reflect_eqb i i0);
       constructor;subst;trivial.
     (* Binary operators *)
-    preflect (reflect_bop_eqb b b0); 
+    preflect (reflect_bop_eqb b b0);
     preflect (Int63Properties.reflect_eqb i i1);
     preflect (Int63Properties.reflect_eqb i0 i2);
     constructor;subst;trivial.
+    (* Ternary operators *)
+    preflect (reflect_top_eqb t t0).
+    preflect (Int63Properties.reflect_eqb i i2).
+    preflect (Int63Properties.reflect_eqb i0 i3).
+    preflect (Int63Properties.reflect_eqb i1 i4).
+    constructor;subst;trivial.
     (* N-ary operators *)
-    preflect (reflect_nop_eqb n n0); preflect (reflect_list_beq _ _ Int63Properties.reflect_eqb l l0); constructor; subst; reflexivity.
+    preflect (reflect_nop_eqb n n0);
+    preflect (reflect_list_beq _ _ Int63Properties.reflect_eqb l l0);
+    constructor; subst; reflexivity.
     (* Application *)
     preflect (Int63Properties.reflect_eqb i i0);
     preflect (reflect_list_beq _ _ Int63Properties.reflect_eqb l l0);
     constructor;subst;trivial.
   Qed.
-  
+
   Lemma eqb_spec : forall t1 t2, eqb t1 t2 <-> t1 = t2.
   Proof.
-    intros;symmetry;apply reflect_iff;apply reflect_eqb.
+    intros;symmetry; apply reflect_iff; apply reflect_eqb.
   Qed.
-  
+
   (** Typing and interpretation *)
-  
+
   Record val (t:Type) (I:t -> Type) := Val {
     v_type : t;
     v_val : I v_type
   }.
 
   Section Typing_Interp.
-    Variable t_i : PArray.array typ_eqb.
+    Variable t_i : PArray.array typ_compdec.
 
     Local Notation interp_t := (Typ.interp t_i).
     Local Notation interp_ft := (Typ.interp_ftype t_i).
@@ -646,38 +1073,63 @@ Module Atom.
       simpl in H1; rewrite Typ.cast_refl in H1; auto.
     Qed.
 
-    (* Interprétation d'une fonction*)
+    (* Interpretation of a function*)
     Variable t_func : PArray.array tval.
 
     (** Type checking of atom assuming an type for hatom *)
     Section Typ_Aux.
       Variable get_type : hatom -> Typ.type.
 
-      Definition typ_cop o := 
+      Definition typ_cop o :=
         match o with
-        | CO_xH => Typ.Tpositive 
+        | CO_xH => Typ.Tpositive
         | CO_Z0 => Typ.TZ
+        | CO_BV _ s => Typ.TBV s
         end.
 
       Definition typ_uop o :=
         match o with
-        | UO_xO => (Typ.Tpositive,Typ.Tpositive) 
-        | UO_xI => (Typ.Tpositive,Typ.Tpositive) 
+        | UO_xO => (Typ.Tpositive,Typ.Tpositive)
+        | UO_xI => (Typ.Tpositive,Typ.Tpositive)
         | UO_Zpos => (Typ.Tpositive, Typ.TZ)
         | UO_Zneg => (Typ.Tpositive, Typ.TZ)
         | UO_Zopp => (Typ.TZ, Typ.TZ)
+        | UO_BVbitOf s _ => (Typ.TBV s, Typ.Tbool)
+        | UO_BVnot s => (Typ.TBV s, Typ.TBV s)
+        | UO_BVneg s => (Typ.TBV s, Typ.TBV s)
+        | UO_BVextr i n0 n1 => (Typ.TBV n1, Typ.TBV n0)
+        | UO_BVzextn s i => (Typ.TBV s, Typ.TBV (i + s))
+        | UO_BVsextn s i => (Typ.TBV s, Typ.TBV (i + s))
         end.
 
-      Definition typ_bop o := 
+      Definition typ_bop o :=
         match o with
-        | BO_Zplus  => ((Typ.TZ,Typ.TZ), Typ.TZ) 
-        | BO_Zminus => ((Typ.TZ,Typ.TZ), Typ.TZ) 
-        | BO_Zmult  => ((Typ.TZ,Typ.TZ), Typ.TZ) 
-        | BO_Zlt    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
-        | BO_Zle    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
-        | BO_Zge    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
+        | BO_Zplus  => ((Typ.TZ,Typ.TZ), Typ.TZ)
+        | BO_Zminus => ((Typ.TZ,Typ.TZ), Typ.TZ)
+        | BO_Zmult  => ((Typ.TZ,Typ.TZ), Typ.TZ)
+        | BO_Zlt    => ((Typ.TZ,Typ.TZ), Typ.Tbool)
+        | BO_Zle    => ((Typ.TZ,Typ.TZ), Typ.Tbool)
+        | BO_Zge    => ((Typ.TZ,Typ.TZ), Typ.Tbool)
         | BO_Zgt    => ((Typ.TZ,Typ.TZ), Typ.Tbool)
         | BO_eq t   => ((t,t),Typ.Tbool)
+        | BO_BVand s  => ((Typ.TBV s,Typ.TBV s), (Typ.TBV s))
+        | BO_BVor s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVxor s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVadd s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVsubst s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVmult s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVult s   => ((Typ.TBV s,Typ.TBV s), Typ.Tbool)
+        | BO_BVconcat s1 s2   => ((Typ.TBV s1,Typ.TBV s2), (Typ.TBV (s1 + s2)))
+        | BO_BVslt s   => ((Typ.TBV s,Typ.TBV s), Typ.Tbool)
+        | BO_BVshl s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_BVshr s   => ((Typ.TBV s,Typ.TBV s), Typ.TBV s)
+        | BO_select ti te => ((Typ.TFArray ti te, ti), te)
+        | BO_diffarray ti te => ((Typ.TFArray ti te, Typ.TFArray ti te), ti)
+        end.
+
+      Definition typ_top o :=
+        match o with
+        | TO_store ti te => ((Typ.TFArray ti te, ti, te), Typ.TFArray ti te)
         end.
 
       Definition typ_nop o :=
@@ -692,16 +1144,21 @@ Module Atom.
         | _, _ => false
         end.
 
-      Definition check_aux (a:atom) (t:Typ.type) : bool := 
+      Definition check_aux (a:atom) (t:Typ.type) : bool :=
         match a with
-        | Acop o => Typ.eqb (typ_cop o) t 
+        | Acop o => Typ.eqb (typ_cop o) t
         | Auop o a =>
           let (ta,t') := typ_uop o in
           Typ.eqb t' t && Typ.eqb (get_type a) ta
         | Abop o a1 a2 =>
           let (ta,t') := typ_bop o in
           let (ta1,ta2) := ta in
-          Typ.eqb t' t && Typ.eqb (get_type a1) ta1 && Typ.eqb (get_type a2) ta2 
+          Typ.eqb t' t && Typ.eqb (get_type a1) ta1 && Typ.eqb (get_type a2) ta2
+        | Atop o a1 a2 a3 =>
+          let (ta, t') := typ_top o in
+          let '(ta1, ta2, ta3) := ta in
+          Typ.eqb t' t && Typ.eqb (get_type a1) ta1 &&
+                  Typ.eqb (get_type a2) ta2 && Typ.eqb (get_type a3) ta3
         | Anop o a =>
           let (ta,t') := typ_nop o in
           (Typ.eqb t' t) && (List.forallb (fun t1 => Typ.eqb (get_type t1) ta) a)
@@ -715,7 +1172,7 @@ Module Atom.
       Lemma unicity : forall a t1 t2,
         check_aux a t1 -> check_aux a t2 -> t1 = t2.
       Proof.
-        destruct a;simpl. 
+        destruct a;simpl.
         (* Constants *)
         intros t1 t2;rewrite !Typ.eqb_spec;intros;subst;trivial.
         (* Unary operators *)
@@ -729,8 +1186,20 @@ Module Atom.
         intros [[H1 _] _] [[H2 _] _]; change (is_true (Typ.eqb (snd (typ_bop b)) t1)) in H1.
         change (is_true (Typ.eqb (snd (typ_bop b)) t2)) in H2.
         rewrite Typ.eqb_spec in H1, H2;subst;trivial.
+        (* Ternary operators *)
+        unfold is_true. intros.
+        destruct typ_top. destruct p. destruct p.
+        rewrite !andb_true_iff in H, H0.
+        destruct H as (((Ha, Hb), Hc), Hd).
+        destruct H0 as (((H0a, H0b), H0c), H0d).
+        apply Typ.eqb_spec in Ha.
+        apply Typ.eqb_spec in H0a. now subst.
         (* N-ary operators *)
-        intros t1 t2; destruct (typ_nop n) as [ta t']; unfold is_true; rewrite !andb_true_iff; change (is_true (Typ.eqb t' t1) /\ is_true (List.forallb (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> is_true (Typ.eqb t' t2) /\ is_true (List.forallb (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> t1 = t2); rewrite !Typ.eqb_spec; intros [H1 _] [H2 _]; subst; auto.
+        intros t1 t2; destruct (typ_nop n) as [ta t'];
+        unfold is_true; rewrite !andb_true_iff;
+        change (is_true (Typ.eqb t' t1) /\ is_true
+        (List.forallb (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> is_true (Typ.eqb t' t2) /\ is_true (List.forallb
+        (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> t1 = t2); rewrite !Typ.eqb_spec; intros [H1 _] [H2 _]; subst; auto.
         (* Application *)
         intros t1 t2;destruct (v_type Typ.ftype interp_ft (t_func.[ i])).
         unfold is_true;rewrite !andb_true_iff;intros [_ H1] [_ H2].
@@ -759,21 +1228,222 @@ Module Atom.
       Lemma check_aux_dec : forall a,
         {exists T, check_aux a T} + {forall T, check_aux a T = false}.
       Proof.
-        intros [op|op h|op h1 h2|op ha|f args]; simpl.
+        intros [op|op h|op h1 h2|op ha i i0|f args | i e ]; simpl.
         (* Constants *)
         left; destruct op; simpl.
         exists Typ.Tpositive; auto.
         exists Typ.TZ; auto.
+        exists (Typ.TBV n); now rewrite N.eqb_refl.
         (* Unary operators *)
-        destruct op; simpl; try (case (Typ.eqb (get_type h) Typ.Tpositive); [left; exists Typ.Tpositive|right; intro; rewrite andb_false_r]; reflexivity); try (case (Typ.eqb (get_type h) Typ.Tpositive); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]; reflexivity); case (Typ.eqb (get_type h) Typ.TZ); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]; reflexivity.
+        destruct op; simpl;
+        (case (Typ.eqb (get_type h) Typ.Tpositive)).
+           left; exists Typ.Tpositive; easy.
+            right; intros; rewrite andb_false_r; easy.
+            left; exists Typ.Tpositive; easy.
+            right; intros; rewrite andb_false_r; easy.
+
+            left; exists Typ.TZ; easy.
+            right; intros; rewrite andb_false_r; easy.
+            left; exists Typ.TZ; easy.
+            right; intros; rewrite andb_false_r; easy.
+
+
+         (case (Typ.eqb (get_type h) Typ.TZ)).
+          left. exists Typ.TZ. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) Typ.TZ)).
+          left. exists Typ.TZ. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n1))).
+           left. exists (Typ.TBV n0). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n1))).
+           left. exists (Typ.TBV n0). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV (i + n)). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV (i + n)). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV (i + n)). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
+         (case (Typ.eqb (get_type h) (Typ.TBV n))).
+           left. exists (Typ.TBV (i + n)). now rewrite N.eqb_refl; easy.
+           right. intros. rewrite andb_false_r. easy.
+
         (* Binary operators *)
-        destruct op; simpl; try (case (Typ.eqb (get_type h1) Typ.TZ); [case (Typ.eqb (get_type h2) Typ.TZ); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity); try (case (Typ.eqb (get_type h1) Typ.TZ); [case (Typ.eqb (get_type h2) Typ.TZ); [left; exists Typ.Tbool|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity); case (Typ.eqb (get_type h1) t); [case (Typ.eqb (get_type h2) t); [left; exists Typ.Tbool|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity.
+        destruct op; simpl.
+        (case (Typ.eqb (get_type h1) Typ.TZ)); (case (Typ.eqb (get_type h2) Typ.TZ)).
+          left. exists Typ.TZ. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) Typ.TZ)); (case (Typ.eqb (get_type h2) Typ.TZ)).
+          left. exists Typ.TZ. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _ )).
+          left. exists Typ.TZ. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists Typ.Tbool. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVor*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVxor*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVadd*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVsubst*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVmult*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVult*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.Tbool). easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVslt*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.Tbool). easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVconcat*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV (n + n0)). rewrite N.eqb_refl. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVshl*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+        (*additional case for BO_BVshr*)
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists (Typ.TBV n). now rewrite N.eqb_refl; easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+
+       (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists t0. rewrite Typ.eqb_refl. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+
+       (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _)).
+          left. exists t. rewrite Typ.eqb_refl. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+
+          (* Ternary operators *)
+        revert i i0; destruct op; simpl. intros h1 h2.
+        (case (Typ.eqb (get_type h1) _)); (case (Typ.eqb (get_type h2) _));
+        (case (Typ.eqb (get_type ha) _)).
+          left. exists (Typ.TFArray t t0). rewrite !Typ.eqb_refl. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
+          right. intros. rewrite andb_false_r. easy.
         (* N-ary operators *)
-        destruct op as [ty]; simpl; case (List.forallb (fun t1 : int => Typ.eqb (get_type t1) ty) ha).
+        destruct f as [ty]; simpl; case (List.forallb (fun t1 : int => Typ.eqb (get_type t1) ty) args).
         left; exists Typ.Tbool; auto.
         right; intro T; rewrite andb_false_r; auto.
         (* Application *)
-        case (v_type Typ.ftype interp_ft (t_func .[ f])); intros; apply check_args_dec.
+        case (v_type Typ.ftype interp_ft (t_func .[ i])); intros; apply check_args_dec.
       Qed.
 
     End Typ_Aux.
@@ -799,6 +1469,16 @@ Module Atom.
         | _, _ => bvtrue
         end.
 
+      Definition apply_terop (t1 t2 t3 r : Typ.type)
+            (op : interp_t t1 -> interp_t t2 -> interp_t t3 -> interp_t r) (tv1 tv2 tv3: bval) :=
+        let (t1', v1) := tv1 in
+        let (t2', v2) := tv2 in
+        let (t3', v3) := tv3 in
+        match Typ.cast t1' t1, Typ.cast t2' t2, Typ.cast t3' t3 with
+        | Typ.Cast k1, Typ.Cast k2, Typ.Cast k3  => Bval r (op (k1 _ v1) (k2 _ v2) (k3 _ v3))
+        | _, _, _ => bvtrue
+        end.
+
       Fixpoint apply_func
            targs tr (f:interp_ft (targs,tr)) (lv:list bval) : bval :=
         match targs as targs0 return interp_ft (targs0,tr) -> bval with
@@ -824,19 +1504,30 @@ Module Atom.
         match o with
         | CO_xH => Bval Typ.Tpositive xH
         | CO_Z0 => Bval Typ.TZ Z0
+        | CO_BV bv s => Bval (Typ.TBV s) (BITVECTOR_LIST._of_bits bv s)
         end.
 
-      Definition interp_uop o :=    
+      Definition interp_uop o :=
         match o with
         | UO_xO   => apply_unop Typ.Tpositive Typ.Tpositive xO
         | UO_xI   => apply_unop Typ.Tpositive Typ.Tpositive xI
         | UO_Zpos => apply_unop Typ.Tpositive Typ.TZ Zpos
         | UO_Zneg => apply_unop Typ.Tpositive Typ.TZ Zneg
         | UO_Zopp => apply_unop Typ.TZ Typ.TZ Zopp
+        | UO_BVbitOf s n => apply_unop (Typ.TBV s) Typ.Tbool (BITVECTOR_LIST.bitOf n)
+        | UO_BVnot s => apply_unop (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_not s)
+        | UO_BVneg s => apply_unop (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_neg s)
+        | UO_BVextr i n0 n1 =>
+          apply_unop (Typ.TBV n1) (Typ.TBV n0) (@BITVECTOR_LIST.bv_extr i n0 n1)
+        | UO_BVzextn s i =>
+          apply_unop (Typ.TBV s) (Typ.TBV (i + s)) (@BITVECTOR_LIST.bv_zextn s i)
+        | UO_BVsextn s i =>
+          apply_unop (Typ.TBV s) (Typ.TBV (i + s)) (@BITVECTOR_LIST.bv_sextn s i)
         end.
 
+
       Definition interp_bop o :=
-         match o with
+         match o  with
          | BO_Zplus => apply_binop Typ.TZ Typ.TZ Typ.TZ Zplus
          | BO_Zminus => apply_binop Typ.TZ Typ.TZ Typ.TZ Zminus
          | BO_Zmult => apply_binop Typ.TZ Typ.TZ Typ.TZ Zmult
@@ -845,6 +1536,37 @@ Module Atom.
          | BO_Zge => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zge_bool
          | BO_Zgt => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zgt_bool
          | BO_eq t => apply_binop t t Typ.Tbool (Typ.i_eqb t_i t)
+         | BO_BVand s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_and s)
+         | BO_BVor s  =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_or s)
+         | BO_BVxor s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_xor s)
+         | BO_BVadd s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_add s)
+         | BO_BVsubst s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_subt s)
+         | BO_BVmult s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_mult s)
+         | BO_BVult s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) Typ.Tbool (@BITVECTOR_LIST.bv_ult s)
+         | BO_BVslt s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) Typ.Tbool (@BITVECTOR_LIST.bv_slt s)
+         | BO_BVconcat s1 s2 =>
+           apply_binop (Typ.TBV s1) (Typ.TBV s2) (Typ.TBV (s1 + s2)) (@BITVECTOR_LIST.bv_concat s1 s2)
+         | BO_BVshl s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_shl s)
+         | BO_BVshr s =>
+           apply_binop (Typ.TBV s) (Typ.TBV s) (Typ.TBV s) (@BITVECTOR_LIST.bv_shr s)
+         | BO_select ti te => apply_binop (Typ.TFArray ti te) ti te FArray.select
+         | BO_diffarray ti te =>
+           apply_binop (Typ.TFArray ti te) (Typ.TFArray ti te) ti FArray.diff
+         end.
+
+      Definition interp_top o :=
+         match o with
+         | TO_store ti te =>
+           apply_terop (Typ.TFArray ti te) ti te (Typ.TFArray ti te) FArray.store
          end.
 
       Fixpoint compute_interp ty acc l :=
@@ -884,8 +1606,8 @@ Module Atom.
 
       Lemma compute_interp_spec : forall ty l acc,
         match compute_interp ty acc l with
-          | Some l' => forall i j, In2 i j l' <-> (In2 i j acc \/ (In j acc /\ exists a, In a l /\ interp_hatom a = Bval ty i) \/ (exists a b, In2 b a l /\ interp_hatom a = Bval ty i /\ interp_hatom b = Bval ty j))
-          | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty
+          | Some l' => forall i j, In2 i j l' <-> (In2 i j acc \/ (List.In j acc /\ exists a, List.In a l /\ interp_hatom a = Bval ty i) \/ (exists a b, In2 b a l /\ interp_hatom a = Bval ty i /\ interp_hatom b = Bval ty j))
+          | None => exists a, List.In a l /\ let (ta,_) := interp_hatom a in ta <> ty
         end.
       Proof.
         intro ty; induction l as [ |a q IHq]; simpl.
@@ -932,7 +1654,7 @@ Module Atom.
       Lemma compute_interp_spec_rev : forall ty l,
         match compute_interp ty nil l with
           | Some l' => forall i j, In2 j i (rev l') <-> (exists a b, In2 b a l /\ interp_hatom a = Bval ty i /\ interp_hatom b = Bval ty j)
-          | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty
+          | None => exists a, List.In a l /\ let (ta,_) := interp_hatom a in ta <> ty
         end.
       Proof.
         intros ty l; generalize (compute_interp_spec ty l nil); case (compute_interp ty nil l); auto; intros l' H i j; rewrite In2_rev, (H i j); split; auto; intros [H1|[[H1 _]|H1]]; auto; inversion H1.
@@ -943,6 +1665,7 @@ Module Atom.
         | Acop o => interp_cop o
         | Auop o a => interp_uop o (interp_hatom a)
         | Abop o a1 a2 => interp_bop o (interp_hatom a1) (interp_hatom a2)
+        | Atop o a1 a2 a3 => interp_top o (interp_hatom a1) (interp_hatom a2) (interp_hatom a3)
         | Anop (NO_distinct t) a =>
           match compute_interp t nil a with
             | Some l => Bval Typ.Tbool (distinct (Typ.i_eqb t_i t) (rev l))
@@ -961,6 +1684,14 @@ Module Atom.
         | _ => true
         end.
 
+      Definition interp_bv (v:bval) (s:N) : BITVECTOR_LIST.bitvector s :=
+        let (t,v) := v in
+        match Typ.cast t (Typ.TBV s) with
+        | Typ.Cast k => k _ v
+        | _ => BITVECTOR_LIST.zeros s
+        end.
+
+
 
       (* If an atom is well-typed, it has an interpretation *)
 
@@ -987,20 +1718,114 @@ Module Atom.
          check_aux get_type a t ->
          exists v, interp_aux a = (Bval t v).
       Proof.
-        intros [op|op h|op h1 h2|op ha|f l]; simpl.
+        intros [op|op h|op h1 h2|op h1 h2 h3|op ha|f l]; simpl.
         (* Constants *)
-        destruct op; intros [i| | | ]; simpl; try discriminate; intros _.
+        destruct op as [ | |l n]; intros [ | i | | | |size]; simpl; try discriminate.
         exists 1%positive; auto.
         exists 0%Z; auto.
+        intros H. exists (BITVECTOR_LIST._of_bits l size). unfold is_true in H. rewrite N.eqb_eq in H. now rewrite H.
         (* Unary operators *)
-        destruct op; intros [i| | | ]; simpl; try discriminate; rewrite Typ.eqb_spec; intro H1; destruct (check_aux_interp_hatom h) as [x Hx]; rewrite Hx; simpl; generalize x Hx; rewrite H1; intros y Hy; rewrite Typ.cast_refl.
+        destruct op as [ | | | | |n n0|n|n|n n0 n1|n n0|n n0]; intros [ | ind| | | |size];
+        simpl; try discriminate; try rewrite Typ.eqb_spec;
+        intros H1a; destruct (check_aux_interp_hatom h)
+        as [x Hx]; rewrite Hx; simpl; generalize x Hx;
+        try rewrite H1a; intros y Hy; try rewrite Typ.cast_refl.
         exists (y~0)%positive; auto.
         exists (y~1)%positive; auto.
         exists (Zpos y); auto.
         exists (Zneg y); auto.
         exists (- y)%Z; auto.
-        (* Binary operators *)
-        destruct op as [ | | | | | | |A]; intros [i| | | ]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff; try (change (Typ.eqb (get_type h1) Typ.TZ = true /\ Typ.eqb (get_type h2) Typ.TZ = true) with (is_true (Typ.eqb (get_type h1) Typ.TZ) /\ is_true (Typ.eqb (get_type h2) Typ.TZ)); rewrite !Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h1) as [x1 Hx1]; rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2; rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl).
+        (* bitOf *)
+        exists (BITVECTOR_LIST.bitOf n0 y); auto.
+        (* bv_not *)
+        intros.
+        apply andb_true_iff in H1a. destruct H1a as (Ha, Hb).
+        rewrite N.eqb_eq in Ha.
+        revert x y Hx Hy Hb.
+        rewrite <- Ha in *. intros.
+        apply Typ.eqb_spec in Hb.
+        revert x y Hx Hy.
+        rewrite Hb. intros.
+        exists (@BITVECTOR_LIST.bv_not n y); auto. rewrite Typ.cast_refl; auto.
+        (* bv_neg *)
+        intros.
+        apply andb_true_iff in H1a. destruct H1a as (Ha, Hb).
+        rewrite N.eqb_eq in Ha.
+        revert x y Hx Hy Hb.
+        rewrite <- Ha in *. intros.
+        apply Typ.eqb_spec in Hb.
+        revert x y Hx Hy.
+        rewrite Hb. intros.
+        exists (@BITVECTOR_LIST.bv_neg n y); auto. rewrite Typ.cast_refl; auto.
+        (* bv_extr *)
+        intros.
+        apply andb_true_iff in H1a. destruct H1a as (Ha, Hb).
+        rewrite N.eqb_eq in Ha.
+        revert x y Hx Hy Hb.
+        rewrite <- Ha in *. intros.
+        apply Typ.eqb_spec in Hb.
+        revert x y Hx Hy.
+        rewrite Hb. intros.
+        exists (@BITVECTOR_LIST.bv_extr n n0 n1 y); auto. rewrite Typ.cast_refl; auto.
+        (* bv_zextn *)
+        intros.
+        apply andb_true_iff in H1a. destruct H1a as (Ha, Hb).
+        rewrite N.eqb_eq in Ha.
+        revert x y Hx Hy Hb.
+        rewrite <- Ha in *. intros.
+        apply Typ.eqb_spec in Hb.
+        revert x y Hx Hy.
+        rewrite Hb. intros.
+        exists (@BITVECTOR_LIST.bv_zextn n n0 y); auto. rewrite Typ.cast_refl; auto.
+        (* bv_sextn *)
+        intros.
+        apply andb_true_iff in H1a. destruct H1a as (Ha, Hb).
+        rewrite N.eqb_eq in Ha.
+        revert x y Hx Hy Hb.
+        rewrite <- Ha in *. intros.
+        apply Typ.eqb_spec in Hb.
+        revert x y Hx Hy.
+        rewrite Hb. intros.
+        exists (@BITVECTOR_LIST.bv_sextn n n0 y); auto. rewrite Typ.cast_refl; auto.
+  (* Binary operators *)
+        destruct op as [ | | | | | | | A |s1|s2| s3 | s4 | s5 | s6 | s7 | s8 | s9 | s10 | n m | ti te | ti te];
+          [ intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] |
+            intros [ ti' te' | i | | | |s ] | |
+            ];
+        simpl; try discriminate; unfold is_true;
+        try (rewrite andb_true_iff ;change (Typ.eqb (get_type h1) Typ.TZ = true /\ Typ.eqb (get_type h2) Typ.TZ = true) with
+        (is_true (Typ.eqb (get_type h1) Typ.TZ) /\ is_true (Typ.eqb (get_type h2) Typ.TZ));
+        rewrite !Typ.eqb_spec; intros [H1 H2];
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1];
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2];
+        rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2;
+        rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl);
+
+        try (change (Typ.eqb (get_type h1) Typ.TBV = true /\ Typ.eqb (get_type h2) Typ.TBV = true) with
+        (is_true (Typ.eqb (get_type h1) Typ.TBV) /\ is_true (Typ.eqb (get_type h2) Typ.TBV));
+        rewrite !Typ.eqb_spec; intros [H1 H2];
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1];
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2];
+        rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2; rewrite H1, H2;
+        intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl).
+
         exists (y1 + y2)%Z; auto.
         exists (y1 - y2)%Z; auto.
         exists (y1 * y2)%Z; auto.
@@ -1008,14 +1833,218 @@ Module Atom.
         exists (y1 <=? y2)%Z; auto.
         exists (y1 >=? y2)%Z; auto.
         exists (y1 >? y2)%Z; auto.
-        change (Typ.eqb (get_type h1) A = true /\ Typ.eqb (get_type h2) A = true) with (is_true (Typ.eqb (get_type h1) A) /\ is_true (Typ.eqb (get_type h2) A)); rewrite !Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h1) as [x1 Hx1]; rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2; rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl; exists (Typ.i_eqb t_i A y1 y2); auto.
+        rewrite andb_true_iff ; change (Typ.eqb (get_type h1) A = true /\ Typ.eqb (get_type h2) A = true) with
+        (is_true (Typ.eqb (get_type h1) A) /\ is_true (Typ.eqb (get_type h2) A));
+        rewrite !Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h1) as [x1 Hx1];
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl;
+        generalize x1 Hx1 x2 Hx2; rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl;
+        exists (Typ.i_eqb t_i A y1 y2); auto.
+        (*BO_BVand*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_and y1 y2); auto.
+        (*BO_BVor*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_or y1 y2); auto.
+        (*BO_BVxor*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_xor y1 y2); auto.
+        (*BO_BVadd*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_add y1 y2); auto.
+        (*BO_BVsubt*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_subt y1 y2); auto.
+        (*BO_BVmult*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_mult y1 y2); auto.
+        (*BO_BVult*)
+        intros. rewrite !andb_true_iff in H. destruct H as (Hb, Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_ult y1 y2); auto.
+        (*BO_BVslt*)
+        intros. rewrite !andb_true_iff in H. destruct H as (Hb, Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_slt y1 y2); auto.
+        (*BO_BVconcat*)
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply N.eqb_eq in Ha.
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite !Typ.cast_refl.
+        rewrite <- Ha.
+        exists (BITVECTOR_LIST.bv_concat y1 y2); auto.
+        (*BO_BVshl*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_shl y1 y2); auto.
+        (*BO_BVshr*)
+        simpl in s.
+        intros. rewrite !andb_true_iff in H. destruct H as ((Ha, Hb), Hc).
+        apply Typ.eqb_spec in Hb.
+        apply Typ.eqb_spec in Hc.
+        rewrite N.eqb_eq in Ha.
+        revert Hb Hc. rewrite Ha in *. intros.
+
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        revert x1 Hx1 x2 Hx2.
+        rewrite Hb, Hc. intros y1 Hy1 y2 Hy2.
+        rewrite Typ.cast_refl.
+        exists (BITVECTOR_LIST.bv_shr y1 y2); auto.
+
+        (* BO_select *)
+        intros t' H.
+        rewrite !andb_true_iff in H.
+        destruct H as ((H1, H2), H3).
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        apply Typ.eqb_spec in H1.
+        apply Typ.eqb_spec in H2.
+        apply Typ.eqb_spec in H3.
+        revert x1 Hx1 x2 Hx2.
+        rewrite H2, H3, H1.
+        rewrite !Typ.cast_refl.
+        intros.
+        exists (FArray.select x1 x2); auto.
+
+        (* BO_diffarray *)
+        intros t' H.
+        rewrite !andb_true_iff in H.
+        destruct H as ((H1, H2), H3).
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1].
+        rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl.
+        apply Typ.eqb_spec in H1.
+        apply Typ.eqb_spec in H2.
+        apply Typ.eqb_spec in H3.
+        revert x1 Hx1 x2 Hx2.
+        rewrite H2, H3, H1.
+        rewrite !Typ.cast_refl.
+        intros.
+        exists (FArray.diff x1 x2); auto.
+
+        (* Ternary operatores *)
+        destruct op as [ti te]; intros [ ti' te' | | | | | ];
+          simpl; try discriminate; unfold is_true.
+        intros H.
+        rewrite !andb_true_iff in H.
+        destruct H as ((((H1, H2), H3), H4), H5).
+        apply Typ.eqb_spec in H1.
+        apply Typ.eqb_spec in H2.
+        apply Typ.eqb_spec in H3.
+        apply Typ.eqb_spec in H4.
+        apply Typ.eqb_spec in H5.
+        destruct (check_aux_interp_hatom h1) as [x1 Hx1]. rewrite Hx1;
+        destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2;
+        destruct (check_aux_interp_hatom h3) as [x3 Hx3]; rewrite Hx3; simpl.
+        revert x1 Hx1 x2 Hx2 x3 Hx3.
+        rewrite H3, H4, H5, H1, H2.
+        intros.
+        rewrite !Typ.cast_refl.
+        intros.
+        exists (FArray.store x1 x2 x3); auto.
+
         (* N-ary operators *)
-        destruct op as [A]; simpl; intros [ | | | ]; try discriminate; simpl; intros _; case (compute_interp A nil ha).
+        destruct op as [A]; simpl; intros [ | | | | | ]; try discriminate; simpl; intros _; case (compute_interp A nil ha).
         intro l; exists (distinct (Typ.i_eqb t_i A) (rev l)); auto.
         exists true; auto.
         (* Application *)
         intro t; apply check_args_interp_aux.
-      Qed.
+Qed.
 
 
       (* If an atom is not well-typed, its interpretation is bvtrue *)
@@ -1039,15 +2068,201 @@ Module Atom.
         (forall T, check_aux get_type a T = false) ->
         interp_aux a = bvtrue.
       Proof.
-        intros [op|op h|op h1 h2|op ha|f l]; simpl.
+        intros [op | op h | op h1 h2 | op h1 h2 h3 | op ha | f l]; simpl.
         (* Constants *)
         destruct op; simpl; intro H.
         discriminate (H Typ.Tpositive).
         discriminate (H Typ.TZ).
+        specialize (H (Typ.TBV n)). simpl in H. rewrite N.eqb_refl in H. now contradict H.
         (* Unary operators *)
-        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h) as [v Hv]; rewrite Hv; simpl; rewrite Typ.neq_cast; try (pose (H2 := H Typ.Tpositive); simpl in H2; rewrite H2; auto); pose (H2 := H Typ.TZ); simpl in H2; rewrite H2; auto.
+        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h) as [v Hv];
+          rewrite Hv; simpl; rewrite Typ.neq_cast;
+            try (pose (H2 := H Typ.Tpositive); simpl in H2; rewrite H2; auto);
+            try (pose (H2 := H Typ.TZ); simpl in H2; rewrite H2; auto);
+            try (pose (H2 := H Typ.Tbool); simpl in H2; rewrite H2; auto);
+            try (pose (H2 := H Typ.TBV); simpl in H2; rewrite H2; auto).
+            (* bv_not *)
+            specialize (H (Typ.TBV n)). simpl in H. rewrite andb_false_iff in H.
+            destruct H as [ H | H].
+              rewrite N.eqb_refl in H. now contradict H.
+              now rewrite H.
+            (* bv_neg *)
+            specialize (H (Typ.TBV n)). simpl in H. rewrite andb_false_iff in H.
+            destruct H as [ H | H].
+              rewrite N.eqb_refl in H. now contradict H.
+              now rewrite H.
+            (* bv_extr *)
+            specialize (H (Typ.TBV n0)). simpl in H. rewrite andb_false_iff in H.
+            destruct H as [ H | H].
+              rewrite N.eqb_refl in H. now contradict H.
+              now rewrite H.
+            (* bv_zextn *)
+            specialize (H (Typ.TBV (i + n))). simpl in H. rewrite andb_false_iff in H.
+            destruct H as [ H | H].
+              rewrite N.eqb_refl in H. now contradict H.
+              now rewrite H.
+            (* bv_sextn *)
+            specialize (H (Typ.TBV (i + n))). simpl in H. rewrite andb_false_iff in H.
+            destruct H as [ H | H].
+              rewrite N.eqb_refl in H. now contradict H.
+              now rewrite H.
         (* Binary operators *)
-        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h1) as [v1 Hv1]; destruct (check_aux_interp_hatom h2) as [v2 Hv2]; rewrite Hv1, Hv2; simpl; try (pose (H2 := H Typ.TZ); simpl in H2; rewrite andb_false_iff in H2; destruct H2 as [H2|H2]; [rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto); try (pose (H2 := H Typ.Tbool); simpl in H2; rewrite andb_false_iff in H2; destruct H2 as [H2|H2]; [rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto); case (Typ.cast (get_type h1) t); auto.
+        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h1) as [v1 Hv1];
+        destruct (check_aux_interp_hatom h2) as [v2 Hv2]; rewrite Hv1, Hv2; simpl;
+        try (pose (H2 := H Typ.TZ); simpl in H2; rewrite andb_false_iff in H2;
+        destruct H2 as [H2|H2]; [rewrite (Typ.neq_cast (get_type h1)),
+          H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto);
+        try (pose (H2 := H Typ.Tbool); simpl in H2; rewrite andb_false_iff in H2; destruct H2 as [H2|H2];
+        [rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto);
+        try (pose (H2 := H Typ.TBV); simpl in H2; rewrite !andb_false_iff in H2; destruct H2 as [[H2|H2]|H2];
+        [rewrite N.eqb_refl in H2; discriminate | rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2;
+        case (Typ.cast (get_type h1) Typ.TBV); case (Typ.cast (get_type h1) Typ.TBV)]; auto).
+        intros. simpl in H.
+        case_eq (Typ.cast (get_type h1) t). easy. easy.
+        case_eq (Typ.cast (get_type h1) t). easy. easy.
+        (*BVand*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVor*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVxor*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVadd*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVsubt*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVmult*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVult*)
+        specialize (H Typ.Tbool). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        specialize (H0 H). now rewrite H0.
+
+        case_eq (Typ.cast (get_type h1) (Typ.TBV n)). intros.
+        specialize (@Typ.cast_diff (get_type h2) (Typ.TBV n)). intros.
+        specialize (H1 H). easy.
+        easy.
+
+        case_eq (Typ.cast (get_type h1) (Typ.TBV n)). intros.
+        specialize (@Typ.cast_diff (get_type h2) (Typ.TBV n)). intros.
+        specialize (H1 H2). easy.
+        easy.
+
+        (*BVslt*)
+        specialize (H Typ.Tbool). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        specialize (H0 H). now rewrite H0.
+
+        case_eq (Typ.cast (get_type h1) (Typ.TBV n)). intros.
+        specialize (@Typ.cast_diff (get_type h2) (Typ.TBV n)). intros.
+        specialize (H1 H). easy.
+        easy.
+
+        case_eq (Typ.cast (get_type h1) (Typ.TBV n)). intros.
+        specialize (@Typ.cast_diff (get_type h2) (Typ.TBV n)). intros.
+        specialize (H1 H2). easy.
+        easy.
+        (*BVconcat*)
+        specialize (H (Typ.TBV (n+n0))). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVshl*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+        (*BVshr*)
+        specialize (H (Typ.TBV n)). simpl in H.
+        apply andb_false_iff in H. destruct H.
+        specialize (@Typ.cast_diff (get_type h1) (Typ.TBV n)). intros.
+        rewrite andb_false_iff in H. destruct H as [ H | H ].
+          rewrite N.eqb_refl in H. now contradict H.
+          apply Typ.cast_diff in H. now rewrite H.
+          apply Typ.cast_diff in H. rewrite H.
+          case (Typ.cast (get_type h1) (Typ.TBV n)); auto.
+
+        (* BO_select *)
+        specialize (H t0). simpl in H.
+        rewrite !andb_false_iff in H. destruct H. destruct H.
+        rewrite Typ.eqb_refl in H. now contradict H.
+        rewrite (Typ.cast_diff _ _ H); auto.
+        rewrite (Typ.cast_diff _ _ H); auto.
+        case (Typ.cast (get_type h1) (Typ.TFArray t t0)); auto.
+
+        (* BO_diffarray *)
+        specialize (H t). simpl in H.
+        rewrite !andb_false_iff in H. destruct H. destruct H.
+        rewrite Typ.eqb_refl in H. now contradict H.
+        rewrite (Typ.cast_diff _ _ H); auto.
+        rewrite (Typ.cast_diff _ _ H); auto.
+        case (Typ.cast (get_type h1) (Typ.TFArray t t0)); auto.
+
+        (* Ternary operators *)
+        destruct op; simpl; intro H;
+          destruct (check_aux_interp_hatom h1) as [v1 Hv1];
+          destruct (check_aux_interp_hatom h2) as [v2 Hv2];
+          destruct (check_aux_interp_hatom h3) as [v3 Hv3];
+          rewrite Hv1, Hv2, Hv3; simpl.
+        specialize (H (Typ.TFArray t t0)). simpl in H.
+        rewrite !andb_false_iff in H.
+        destruct H as [[ [ [ H | H] | H] | H] | H];
+          try (rewrite (Typ.cast_diff _ _ H); auto);
+          try (case (Typ.cast (get_type h1) (Typ.TFArray t t0)); auto);
+          try (rewrite !Typ.eqb_refl in H; now contradict H).
+        intros. case (Typ.cast (get_type h2) t); auto.
+
         (* N-ary operators *)
         destruct op as [A]; simpl; intro H; generalize (H Typ.Tbool); simpl; clear H; assert (H: forall l1, List.forallb (fun t1 : int => Typ.eqb (get_type t1) A) ha = false -> match compute_interp A l1 ha with | Some l => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l)) | None => bvtrue end = bvtrue).
         induction ha as [ |h ha Iha]; simpl.
@@ -1058,7 +2273,7 @@ Module Atom.
         apply H.
         (* Application *)
         apply check_args_interp_aux_contr.
-      Qed.
+Qed.
 
     End Interp_Aux.
 
@@ -1075,6 +2290,7 @@ Module Atom.
         | Acop _ => true
         | Auop _ h => h < i
         | Abop _ h1 h2 => (h1 < i) && (h2 < i)
+        | Atop _ h1 h2 h3 => (h1 < i) && (h2 < i) && (h3 < i)
         | Anop _ ha => List.forallb (fun h => h < i) ha
         | Aapp f args => List.forallb (fun h => h < i) args
         end.
@@ -1089,6 +2305,8 @@ Module Atom.
         rewrite Hf;trivial.
         (* Binary operators *)
         unfold is_true in H;rewrite andb_true_iff in H;destruct H;rewrite !Hf;trivial.
+        (* Ternary operators *)
+        unfold is_true in H;rewrite !andb_true_iff in H;do 2 destruct H;rewrite !Hf;trivial.
         (* N-ary operators *)
         destruct n as [A]; replace (compute_interp f1 A nil l) with (compute_interp f2 A nil l); trivial; assert (H1: forall acc, compute_interp f2 A acc l = compute_interp f1 A acc l); auto; induction l as [ |k l IHl]; simpl; auto; intro acc; simpl in H; unfold is_true in H; rewrite andb_true_iff in H; destruct H as [H1 H2]; rewrite (Hf _ H1); destruct (f2 k) as [ta va]; destruct (Typ.cast ta A) as [ka| ]; auto.
         (* Application *)
@@ -1205,18 +2423,32 @@ Module Atom.
         intros h Hh a IH; generalize (wf_t_i h Hh).
         case (t_atom.[h]); simpl.
         (* Constants *)
-        intros [ | ] _; simpl.
+        intros [ | | ] _; simpl.
         exists 1%positive; auto.
         exists 0%Z; auto.
+        exists (BITVECTOR_LIST._of_bits l n); auto.
         (* Unary operators *)
-        intros [ | | | | ] i H; simpl; destruct (IH i H) as [x Hx]; rewrite Hx; simpl.
+
+        intros [ | | | | | | | | i0 n0 n1| n i0| n i0] i H;
+          simpl; destruct (IH i H) as [x Hx]; rewrite Hx; simpl.
+
         case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists ((k interp_t x)~0)%positive; auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists ((k interp_t x)~1)%positive; auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists (Zpos (k interp_t x)); auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists (Zneg (k interp_t x)); auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.TZ); simpl; try (exists true; auto); intro k; exists (- k interp_t x)%Z; auto.
-        (* Binary operators *)
-        intros [ | | | | | | |A] h1 h2; simpl; rewrite andb_true_iff; intros [H1 H2]; destruct (IH h1 H1) as [x Hx]; destruct (IH h2 H2) as [y Hy]; rewrite Hx, Hy; simpl.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n)); simpl; [ | exists true; auto]. intro k; exists (BITVECTOR_LIST.bitOf n0 (k interp_t x)) ; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n)); simpl; [ | exists true; auto]. intro k; exists (BITVECTOR_LIST.bv_not (k interp_t x)) ; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n)); simpl; [ | exists true; auto]. intro k; exists (BITVECTOR_LIST.bv_neg (k interp_t x)) ; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n1));
+        simpl; [ | exists true; auto]. intro k; exists (BITVECTOR_LIST.bv_extr i0 n0 (k interp_t x)) ; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n));
+        simpl; [ | exists true; auto]. intro k. exists (BITVECTOR_LIST.bv_zextn i0 (k interp_t x)) ; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) (Typ.TBV n));
+        simpl; [ | exists true; auto]. intro k. exists (BITVECTOR_LIST.bv_sextn i0 (k interp_t x)) ; auto.
+
+       (* Binary operators *)
+        intros [ | | | | | | |A | | | | | | | | | | | | ti te| ti te] h1 h2; simpl; rewrite andb_true_iff; intros [H1 H2]; destruct (IH h1 H1) as [x Hx]; destruct (IH h2 H2) as [y Hy]; rewrite Hx, Hy; simpl.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x + k2 interp_t y)%Z; auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x - k2 interp_t y)%Z; auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x * k2 interp_t y)%Z; auto.
@@ -1225,13 +2457,95 @@ Module Atom.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x >=? k2 interp_t y); auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x >? k2 interp_t y); auto.
         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) A); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) A) as [k2| ]; simpl; try (exists true; reflexivity); exists (Typ.i_eqb t_i A (k1 interp_t x) (k2 interp_t y)); auto.
+
+        (*BO_BVand*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_and (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVor*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_or (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVxor*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_xor (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVadd*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_add (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVsubst*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_subt (k1 interp_t x) (k2 interp_t y)); auto.
+        (*BO_BVmult*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_mult (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVult*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_ult (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVslt*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_slt (k1 interp_t x) (k2 interp_t y));
+          auto.
+        (*BO_BVconcat*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV (n))); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV (n0))) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_concat (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVshl*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_shl (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (*BO_BVshr*)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TBV n)); simpl; try (exists true; auto);
+        intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TBV n)) as [k2| ];
+        simpl; try (exists true; reflexivity); exists (BITVECTOR_LIST.bv_shr (k1 interp_t x) (k2 interp_t y));
+        auto.
+        (* BO_select *)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TFArray ti te) );
+          simpl; try (exists true; auto); intro k1;
+            case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) ti) as [k2| ];
+            simpl; try (exists true; reflexivity).
+        exists (FArray.select (k1 interp_t x) (k2 interp_t y)); auto.
+
+        (* BO_diffarray *)
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TFArray ti te) );
+          simpl; try (exists true; auto); intro k1;
+            case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) (Typ.TFArray ti te)) as [k2| ];
+            simpl; try (exists true; reflexivity).
+        exists (FArray.diff (k1 interp_t x) (k2 interp_t y)); auto.
+
+        (* Ternary operators *)
+        intros [ti te] h1 h2 h3; simpl; rewrite !andb_true_iff; intros [[H1 H2] H3];
+          destruct (IH h1 H1) as [x Hx];
+          destruct (IH h2 H2) as [y Hy];
+          destruct (IH h3 H3) as [z Hz]; rewrite Hx, Hy, Hz; simpl.
+         case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) (Typ.TFArray ti te) );
+          simpl; try (exists true; auto); intro k1;
+         case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) ti );
+          simpl; try (exists true; auto); intro k2;
+            case (Typ.cast (v_type Typ.type interp_t (a .[ h3])) te) as [k3| ];
+            simpl; try (exists true; reflexivity).
+         exists (FArray.store (k1 interp_t x) (k2 interp_t y) (k3 interp_t z)); auto.
+
         (* N-ary operators *)
         intros [A] l; assert (forall acc, List.forallb (fun h0 : int => h0 < h) l = true -> exists v, match compute_interp (get a) A acc l with | Some l0 => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l0)) | None => bvtrue end = Bval (v_type Typ.type interp_t match compute_interp (get a) A acc l with | Some l0 => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l0)) | None => bvtrue end) v); auto; induction l as [ |i l IHl]; simpl.
         intros acc _; exists (distinct (Typ.i_eqb t_i A) (rev acc)); auto.
         intro acc; rewrite andb_true_iff; intros [H1 H2]; destruct (IH _ H1) as [va Hva]; rewrite Hva; simpl; case (Typ.cast (v_type Typ.type interp_t (a .[ i])) A); simpl; try (exists true; auto); intro k; destruct (IHl (k interp_t va :: acc) H2) as [vb Hvb]; exists vb; auto.
         (* Application *)
         intros i l H; apply (check_aux_interp_aux_lt_aux a h IH l H (t_func.[i])).
-      Qed.
+Qed.
 
       Lemma check_aux_interp_hatom_lt : forall h, h < length t_atom ->
         exists v, t_interp.[h] = Bval (get_type h) v.
@@ -1302,6 +2616,11 @@ Module Atom.
       let interp := interp_hatom t_atom in
       fun a => interp_bool (interp a).
 
+    Definition interp_form_hatom_bv t_atom :
+      hatom -> forall s, BITVECTOR_LIST.bitvector s :=
+      let interp := interp_hatom t_atom in
+      fun a s => interp_bv (interp a) s.
+
   End Typing_Interp.
 
   Definition check_atom t_atom :=
@@ -1319,3 +2638,24 @@ Module Atom.
 End Atom.
 
 Arguments Atom.Val {_} {_} _ _.
+
+(* These definitions are not used. This is just a hack, Coq refuses to
+   construct PArrays from OCaml if these are not here for some silly reason *)
+(*
+Section PredefinedArrays.
+  Variable t_i : PArray.array typ_compdec.
+
+  Definition mkarray_typ_compdec := @PArray.make typ_compdec.
+  Definition arrayset_typ_compdec := @PArray.set typ_compdec.
+
+  Definition mkarray_func := @PArray.make (Atom.tval t_i).
+  Definition arrayset_func := @PArray.set (Atom.tval t_i).
+
+  Definition mkarray_form := @PArray.make Form.form.
+  Definition arrayset_form := @PArray.set Form.form.
+
+  Definition mkarray_atom := @PArray.make Atom.atom.
+  Definition arrayset_atom := @PArray.set Atom.atom.
+
+End PredefinedArrays.
+*)
diff --git a/src/State.v b/src/State.v
index 6d31977..3125b06 100644
--- a/src/State.v
+++ b/src/State.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -268,6 +264,12 @@ Module C.
       | _ => false
     end.
 
+  Fixpoint has_true (c:t) :=
+    match c with
+      | nil => false
+      | l :: c => (l == Lit._true) || has_true c
+    end.
+  
 
   Section OR.
 
@@ -466,7 +468,8 @@ Module S.
 
   Lemma valid_get : forall rho s, valid rho s ->
     forall id, C.valid rho (get s id).
-  Proof. auto. Qed.
+  Proof. intros rho s H id. unfold valid in H. unfold Valuation.t in rho. apply H. Qed.
+  (** Proof. auto. Qed. **)
 
 
   (* Specification of internal_set *)
@@ -504,12 +507,47 @@ Module S.
      end
    end.
 
+  Fixpoint insert_no_simpl l1 c :=
+   match c with
+   | nil => l1:: nil
+   | l2 :: c' =>
+     match l1 ?= l2 with
+     | Lt => l1 :: c
+     | Eq => c
+     | Gt => l2 :: insert_no_simpl l1 c'
+     end
+   end.
+
+  Fixpoint insert_keep l1 c :=
+   match c with
+   | nil => l1:: nil
+   | l2 :: c' =>
+     match l1 ?= l2 with
+     | Lt | Eq => l1 :: c
+     | Gt => l2 :: insert_keep l1 c'
+     end
+   end.
+
+  Fixpoint sort c :=
+    match c with
+    | nil => nil
+    | l1 :: c => insert_no_simpl l1 (sort c)
+    end.
+
+  
   Fixpoint sort_uniq c :=
     match c with
     | nil => nil
     | l1 :: c => insert l1 (sort_uniq c)
     end.
 
+  Fixpoint sort_keep c :=
+    match c with
+    | nil => nil
+    | l1 :: c => insert_keep l1 (sort_keep c)
+    end.
+
+  
   Lemma insert_correct : forall rho (Hwf:Valuation.wf rho) l1 c,
     C.interp rho (insert l1 c) = C.interp rho (l1 :: c).
   Proof.
@@ -525,6 +563,25 @@ Module S.
     simpl;rewrite orb_assoc,(orb_comm (Lit.interp rho l1)),<-orb_assoc,IHc;trivial.
   Qed.
 
+  
+  Lemma insert_no_simpl_correct : forall rho (Hwf:Valuation.wf rho) l1 c,
+    C.interp rho (insert_no_simpl l1 c) = C.interp rho (l1 :: c).
+  Proof.
+    intros rho Hwf l1;induction c;simpl;trivial.
+    generalize (compare_spec' l1 a);destruct (l1 ?= a);intros;subst;simpl;auto.
+    destruct (Lit.interp rho a);simpl in *;auto.
+    simpl;rewrite orb_assoc,(orb_comm (Lit.interp rho l1)),<-orb_assoc,IHc;trivial.
+  Qed.
+
+  Lemma insert_keep_correct : forall rho (Hwf:Valuation.wf rho) l1 c,
+      C.interp rho (insert_keep l1 c) = C.interp rho (l1 :: c).
+  Proof.
+    intros rho Hwf l1;induction c;simpl;trivial.
+    generalize (compare_spec' l1 a);destruct (l1 ?= a);intros;subst;simpl;auto.
+    destruct (Lit.interp rho a);simpl in *;auto. rewrite orb_true_r; auto.
+  Qed.
+
+    
   Lemma sort_uniq_correct : forall rho (Hwf:Valuation.wf rho) c,
     C.interp rho (sort_uniq c) = C.interp rho c.
   Proof.
@@ -532,33 +589,72 @@ Module S.
     rewrite insert_correct;trivial;simpl;rewrite IHc;trivial.
   Qed.
 
+      
+  Lemma sort_correct : forall rho (Hwf:Valuation.wf rho) c,
+    C.interp rho (sort c) = C.interp rho c.
+  Proof.
+    intros rho Hwf;induction c;simpl;trivial.
+    rewrite insert_no_simpl_correct;trivial;simpl;rewrite IHc;trivial.
+  Qed.
+
+        
+  Lemma sort_keep_correct : forall rho (Hwf:Valuation.wf rho) c,
+    C.interp rho (sort_keep c) = C.interp rho c.
+  Proof.
+    intros rho Hwf;induction c;simpl;trivial.
+    rewrite insert_keep_correct;trivial;simpl;rewrite IHc;trivial.
+  Qed.
+
+  
+  (* Definition set_clause (s:t) pos (c:C.t) : t := *)
+  (*   set s pos (sort_uniq c). *)
+  
+  (* Version that does not simplify ~a \/ a *)
   Definition set_clause (s:t) pos (c:C.t) : t :=
-    set s pos (sort_uniq c).
+    set s pos (sort c).
 
   Lemma valid_set_clause :
     forall rho s, Valuation.wf rho -> valid rho s -> forall pos c,
-      C.valid rho c -> valid rho (set_clause s pos c).
+                 C.valid rho c -> valid rho (set_clause s pos c).
   Proof.
     unfold valid, get, set_clause. intros rho s Hrho Hs pos c Hc id.
     destruct (Int63Properties.reflect_eqb pos id);subst.
     case_eq (id < length s); intro H.
     unfold get;rewrite PArray.get_set_same; trivial.
-    unfold C.valid;rewrite sort_uniq_correct;trivial.
+    unfold C.valid;rewrite sort_correct;trivial.
     generalize (Hs id);rewrite !PArray.get_outofbound, PArray.default_set;trivial.
     rewrite length_set;trivial.
     rewrite get_set_other;trivial.
   Qed.
 
+  Definition set_clause_keep (s:t) pos (c:C.t) : t :=
+    set s pos (sort_keep c).
+
+
+  Lemma valid_set_clause_keep :
+    forall rho s, Valuation.wf rho -> valid rho s -> forall pos c,
+                 C.valid rho c -> valid rho (set_clause_keep s pos c).
+  Proof.
+    unfold valid, get, set_clause_keep. intros rho s Hrho Hs pos c Hc id.
+    destruct (Int63Properties.reflect_eqb pos id);subst.
+    case_eq (id < length s); intro H.
+    unfold get;rewrite PArray.get_set_same; trivial.
+    unfold C.valid;rewrite sort_keep_correct;trivial.
+    generalize (Hs id);rewrite !PArray.get_outofbound, PArray.default_set;trivial.
+    rewrite length_set;trivial.
+    rewrite get_set_other;trivial.
+  Qed.
 
   (* Resolution *)
 
+  Open Scope int63_scope.
+
   Definition set_resolve (s:t) pos (r:resolution) : t :=
     let len := PArray.length r in
     if len == 0 then s
     else
-      let c := foldi (fun i c => C.resolve (get s (r.[i])) c) 1 (len - 1)
-         (get s (r.[0])) in
-      internal_set s pos c.
+      let c := foldi (fun i c' => (C.resolve (get s (r.[i])) c')) 1 (len - 1) (get s (r.[0])) in
+      (* S.set_clause *) internal_set s pos c.
 
   Lemma valid_set_resolve :
     forall rho s, Valuation.wf rho -> valid rho s ->
@@ -567,8 +663,68 @@ Module S.
     unfold set_resolve; intros rho s Hrho Hv pos r.
     destruct (Int63Properties.reflect_eqb (length r) 0);[trivial | ].
     apply valid_internal_set;trivial.
+    (* apply S.valid_set_clause; auto. *)
     apply foldi_ind;auto.
-    intros i c _ _ Hc;apply C.resolve_correct;auto;apply Hv.
+    intros i c _ _ Hc. apply C.resolve_correct;auto;apply Hv.
+  Qed.
+
+
+  (* Weakening *)
+
+
+  Definition subclause (cl1 cl2 : list _lit) :=
+    List.forallb (fun l1 =>
+                    (l1 == Lit._false) || (l1 == Lit.neg Lit._true) ||
+                    List.existsb (fun l2 => l1 == l2) cl2) cl1.
+  
+  Definition check_weaken (s:t) (cid:clause_id) (cl:list _lit) : C.t :=
+    if subclause (get s cid) cl then cl else C._true.
+
+
+  Lemma check_weaken_valid : forall rho s (cid:clause_id) (cl:list _lit),
+      Valuation.wf rho ->
+      valid rho s ->
+      C.valid rho (check_weaken s cid cl).
+  Proof.
+    intros rho s cid cl Hw Hs.
+    unfold check_weaken, C.valid.
+    case_eq (subclause (get s cid) cl); try (intros; now apply C.interp_true).
+    specialize (Hs cid).
+    unfold C.valid, C.interp in Hs.
+    apply existsb_exists in Hs.
+    intro.
+    unfold subclause in H.
+    rewrite forallb_forall in H.
+    unfold C.valid, C.interp.
+    apply existsb_exists.
+    destruct Hs as (x, (Hi, Hax)).
+    specialize (H x Hi).
+    rewrite !orb_true_iff in H.
+    rewrite !eqb_spec in H.
+    destruct H as [[H | H] | H].
+    - contradict Hax. subst. apply Lit.interp_false; trivial.
+    - contradict Hax. subst. rewrite Lit.interp_neg.
+      rewrite not_true_iff_false, negb_false_iff, Lit.interp_true; trivial.
+    - apply existsb_exists in H.
+      destruct H as (x', (Hcl, Hxx')).
+      rewrite eqb_spec in Hxx'.
+      subst x'.
+      exists x. auto.
+  Qed.
+  
+  Definition set_weaken (s:t) pos (cid:clause_id) (cl:list _lit) : t :=
+      S.set_clause_keep s pos (check_weaken s cid cl).
+
+  
+      
+  Lemma valid_set_weaken :
+    forall rho s, Valuation.wf rho -> valid rho s ->
+      forall pos cid w, valid rho (set_weaken s pos cid w).
+  Proof.
+    intros.
+    apply S.valid_set_clause_keep; auto.
+    apply check_weaken_valid; auto.
   Qed.
 
+  
 End S.
diff --git a/src/Tactics.v b/src/Tactics.v
new file mode 100644
index 0000000..23818fb
--- /dev/null
+++ b/src/Tactics.v
@@ -0,0 +1,114 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import PropToBool BoolToProp.  (* Before SMTCoq.State *)
+Require Import Int63 List PArray Bool.
+Require Import SMTCoq.State SMTCoq.SMT_terms SMTCoq.Trace SMT_classes_instances.
+
+Declare ML Module "smtcoq_plugin".
+
+
+(** Handling quantifiers with veriT **)
+
+(* verit silently transforms an <implb a b> into a <or (not a) b> when
+ instantiating a quantified theorem with <implb> *)
+Lemma impl_split a b:
+  implb a b = true -> orb (negb a) b = true.
+Proof.
+  intro H.
+  destruct a; destruct b; trivial.
+(* alternatively we could do <now verit_base H.> but it forces us to have veriT
+   installed when we compile SMTCoq. *)
+Qed.
+
+Hint Resolve impl_split.
+
+(* verit silently transforms an <implb (a || b) c> into a <or (not a) c>
+   or into a <or (not b) c> when instantiating such a quantified theorem *)
+Lemma impl_or_split_right a b c:
+  implb (a || b) c = true -> negb b || c = true.
+Proof.
+  intro H.
+  destruct a; destruct c; intuition.
+Qed.
+
+Lemma impl_or_split_left a b c:
+  implb (a || b) c = true -> negb a || c = true.
+Proof.
+  intro H.
+  destruct a; destruct c; intuition.
+Qed.
+
+(* verit considers equality modulo its symmetry, so we have to recover the
+   right direction in the instances of the theorems *)
+Definition hidden_eq a b := a =? b.
+Ltac all_rew :=
+  repeat match goal with
+         | [ |- context [ ?A =? ?B]] =>
+           change (A =? B) with (hidden_eq A B)
+         end;
+  repeat match goal with
+         | [ |- context [ hidden_eq ?A ?B] ] =>
+           replace (hidden_eq A B) with (B =? A);
+           [ | now rewrite Z.eqb_sym]
+         end.
+
+(* An automatic tactic that takes into account all those transformations *)
+Ltac vauto :=
+  try (let H := fresh "H" in
+       intro H; try (all_rew; apply H);
+       match goal with
+       | [ |- is_true (negb ?A || ?B) ] =>
+         try (eapply impl_or_split_right; apply H);
+         eapply impl_or_split_left; apply H
+       end;
+       apply H);
+  auto.
+
+Ltac verit_bool :=
+  verit_bool_base; vauto.
+
+Ltac verit_bool_no_check :=
+  verit_bool_no_check_base; vauto.
+
+
+(** Tactics in Prop **)
+
+Ltac zchaff          := prop2bool; zchaff_bool; bool2prop.
+Ltac zchaff_no_check := prop2bool; zchaff_bool_no_check; bool2prop.
+
+Ltac verit           := prop2bool; verit_bool; bool2prop.
+Ltac verit_no_check  := prop2bool; verit_bool_no_check; bool2prop.
+
+Ltac cvc4            := prop2bool; cvc4_bool; bool2prop.
+Ltac cvc4_no_check   := prop2bool; cvc4_bool_no_check; bool2prop.
+
+
+(* Ltac smt := prop2bool; *)
+(*             repeat *)
+(*               match goal with *)
+(*                 | [ |- context[ CompDec ?t ] ] => try assumption *)
+(*                 | [ |- _ : bool] => verit_bool *)
+(*                 | [ |- _ : bool] => try (cvc4_bool; verit_bool) *)
+(*               end; *)
+(*             bool2prop. *)
+(* Ltac smt_no_check := prop2bool; *)
+(*             repeat *)
+(*               match goal with *)
+(*                 | [ |- context[ CompDec ?t ] ] => try assumption *)
+(*                 | [ |- _ : bool] => verit_bool_no_check *)
+(*                 | [ |- _ : bool] => try (cvc4_bool_no_check; verit_bool_no_check) *)
+(*               end; *)
+(*             bool2prop. *)
+
+Ltac smt := (prop2bool; try verit_bool; cvc4_bool; try verit_bool; bool2prop).
+Ltac smt_no_check := (prop2bool; try verit_bool_no_check; cvc4_bool_no_check; try verit_bool_no_check; bool2prop).
diff --git a/src/Trace.v b/src/Trace.v
index d01ccbe..4d832de 100644
--- a/src/Trace.v
+++ b/src/Trace.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,7 +12,9 @@
 
 Require Import Bool Int63 PArray.
 Require Structures.
-Require Import Misc State SMT_terms Cnf Euf Lia Syntactic Arithmetic Operators Assumptions.
+Require Import Misc State SMT_terms.
+Require Import Syntactic Arithmetic Operators Assumptions.
+Require Import Cnf Euf Lia BVList Bva_checker Array_checker.
 
 Local Open Scope array_scope.
 Local Open Scope int63_scope.
@@ -51,9 +49,7 @@ Section trace.
 
   (* For debugging *)
   (*
-
   Variable check_step_debug : S.t -> step -> option S.t.
-
   Definition _checker_debug_ (s: S.t) (t: _trace_) : sum S.t ((int*int)*S.t) :=
     let s' := PArray.foldi_left (fun i s a => PArray.foldi_left (fun j s' a' =>
       match s' with
@@ -65,7 +61,6 @@ Section trace.
         | u => u
       end) s a) (inl s) t in
     s'.
-
   Definition _checker_partial_ (s: S.t) (t: _trace_) (max:int) : S.t :=
     PArray.fold_left (fun s a => PArray.foldi_left (fun i s' a' => if i < max then check_step s' a' else s') s a) s t.
   *)
@@ -99,6 +94,12 @@ Module Sat_Checker.
  Inductive step :=
    | Res (_:int) (_:resolution).
 
+(*
+ Parameters (s s': (list _lit) -> bool) (t: (array (list _lit))) (i: int) (r: resolution).
+ Check (fun s (st:step) => let (pos, r) := st in S.set_resolve s pos r).
+ Check (_checker_ (fun s' (st:step) => let (pos, r) := st in S.set_resolve s' pos r) s t).
+*)
+
  Definition resolution_checker s t :=
    _checker_ (fun s (st:step) => let (pos, r) := st in S.set_resolve s pos r) s t.
 
@@ -180,16 +181,15 @@ Qed.
  Lemma theorem_checker :
    forall d c,
      checker d c = true ->
-     forall rho, negb (valid (interp_var rho) d).
+     forall rho, ~ (valid (interp_var rho) d).
  Proof.
-  intros d c H rho.
-  apply negb_true_iff. apply neg_eq_true_eq_false.
-  apply checker_correct with c;trivial.
-  split;compute;trivial;discriminate.
+   intros d c H rho;apply checker_correct with c;trivial.
+   split;compute;trivial;discriminate.
  Qed.
 
 End Sat_Checker.
 
+
 Module Cnf_Checker.
 
   Inductive step :=
@@ -222,13 +222,13 @@ Module Cnf_Checker.
     | ImmBuildProj pos cid i => S.set_clause s pos (check_ImmBuildProj t_form s cid i)
     end.
 
-  Lemma step_checker_correct : forall rho t_form,
+  Lemma step_checker_correct : forall rho rhobv t_form,
     Form.check_form t_form ->
-    forall s, S.valid (Form.interp_state_var rho t_form) s ->
-      forall st : step, S.valid (Form.interp_state_var rho t_form)
+    forall s, S.valid (Form.interp_state_var rho rhobv t_form) s ->
+      forall st : step, S.valid (Form.interp_state_var rho rhobv t_form)
         (step_checker t_form s st).
   Proof.
-    intros rho t_form Ht s H; destruct (Form.check_form_correct rho _ Ht) as [[Ht1 Ht2] Ht3]; intros [pos res|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid|pos cid|pos cid i]; simpl; try apply S.valid_set_clause; auto.
+    intros rho rhobv t_form Ht s H; destruct (Form.check_form_correct rho rhobv _ Ht) as [[Ht1 Ht2] Ht3]; intros [pos res|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid|pos cid|pos cid i]; simpl; try apply S.valid_set_clause; auto.
     apply S.valid_set_resolve; auto.
     apply valid_check_flatten; auto; try discriminate; intros a1 a2; unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a1; auto.
     apply valid_check_True; auto.
@@ -244,12 +244,12 @@ Module Cnf_Checker.
   Definition cnf_checker t_form s t :=
     _checker_ (step_checker t_form) s t.
 
-  Lemma cnf_checker_correct : forall rho t_form,
+  Lemma cnf_checker_correct : forall rho rhobv t_form,
     Form.check_form t_form -> forall s t confl,
       cnf_checker t_form C.is_false s t confl ->
-      ~ (S.valid (Form.interp_state_var rho t_form) s).
+      ~ (S.valid (Form.interp_state_var rho rhobv t_form) s).
   Proof.
-    unfold cnf_checker; intros rho t_form Ht; apply _checker__correct.
+    unfold cnf_checker; intros rho rhobv t_form Ht; apply _checker__correct.
     intros c H; apply C.is_false_correct; auto.
     apply step_checker_correct; auto.
   Qed.
@@ -265,9 +265,9 @@ Module Cnf_Checker.
 
  Lemma checker_correct : forall t_form l c,
     checker t_form l c = true ->
-    forall rho, ~ (Lit.interp (Form.interp_state_var rho t_form) l).
+    forall rho rhobv, ~ (Lit.interp (Form.interp_state_var rho rhobv t_form) l).
  Proof.
-   unfold checker; intros t_form l (nclauses, t, confl); unfold is_true; rewrite andb_true_iff; intros [H1 H2] rho H; apply (cnf_checker_correct (rho:=rho) H1 H2); destruct (Form.check_form_correct rho _ H1) as [[Ht1 Ht2] Ht3]; apply S.valid_set_clause; auto.
+   unfold checker; intros t_form l (nclauses, t, confl); unfold is_true; rewrite andb_true_iff; intros [H1 H2] rho rhobv H; apply (cnf_checker_correct (rho:=rho) (rhobv:=rhobv) H1 H2); destruct (Form.check_form_correct rho rhobv _ H1) as [[Ht1 Ht2] Ht3]; apply S.valid_set_clause; auto.
    apply S.valid_make; auto.
    unfold C.valid; simpl; rewrite H; auto.
  Qed.
@@ -278,9 +278,9 @@ Module Cnf_Checker.
 
  Lemma checker_b_correct : forall t_var t_form l b c,
     checker_b t_form l b c = true ->
-    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l = b.
+    Lit.interp (Form.interp_state_var (PArray.get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l = b.
  Proof.
-   unfold checker_b; intros t_var t_form l b c; case b; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l); auto; intros H1 H2; elim (checker_correct H2 (rho:=get t_var)); auto; rewrite Lit.interp_neg, H1; auto.
+   unfold checker_b; intros t_var t_form l b c; case b; case_eq (Lit.interp (Form.interp_state_var (get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l); auto; intros H1 H2; elim (checker_correct H2 (rho:=get t_var) (rhobv:=fun _ s => BITVECTOR_LIST.zeros s)); auto; rewrite Lit.interp_neg, H1; auto.
  Qed.
 
  Definition checker_eq t_form l1 l2 l (c:certif) :=
@@ -293,12 +293,12 @@ Module Cnf_Checker.
 
  Lemma checker_eq_correct : forall t_var t_form l1 l2 l c,
    checker_eq t_form l1 l2 l c = true ->
-    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l1 =
-    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l2.
+    Lit.interp (Form.interp_state_var (PArray.get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l1 =
+    Lit.interp (Form.interp_state_var (PArray.get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l2.
  Proof.
-   unfold checker_eq; intros t_var t_form l1 l2 l c; rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
-   unfold checker in H3; destruct c as (nclauses, t, confl); rewrite andb_true_iff in H3; destruct H3 as [H3 _]; destruct (Form.check_form_correct (get t_var) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
-   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l2); intro Heq2; auto; elim (checker_correct H3 (rho:=get t_var)); unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
+   unfold checker_eq; intros t_var t_form l1 l2 l c; rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _|intros a ls Heq]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
+   unfold checker in H3; destruct c as (nclauses, t, confl); rewrite andb_true_iff in H3; destruct H3 as [H3 _]; destruct (Form.check_form_correct (get t_var) (fun _ s => BITVECTOR_LIST.zeros s) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
+   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (get t_var) (fun _ s => BITVECTOR_LIST.zeros s) t_form) l2); intro Heq2; auto; elim (checker_correct H3 (rho:=get t_var) (rhobv:=fun _ s => BITVECTOR_LIST.zeros s)); unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
  Qed.
 
 End Cnf_Checker.
@@ -314,13 +314,14 @@ Module Euf_Checker.
 
   Section Checker.
 
-  Variable t_i : array typ_eqb.
+  Variable t_i : array  SMT_classes.typ_compdec.
   Variable t_func : array (Atom.tval t_i).
   Variable t_atom : array Atom.atom.
   Variable t_form : array Form.form.
 
 Inductive step :=
   | Res (pos:int) (res:resolution)
+  | Weaken (pos:int) (cid:clause_id) (cl:list _lit)
   | ImmFlatten (pos:int) (cid:clause_id) (lf:_lit)
   | CTrue (pos:int)
   | CFalse (pos:int)
@@ -337,12 +338,33 @@ Inductive step :=
   | LiaDiseq (pos:int) (l:_lit)
   | SplArith (pos:int) (orig:clause_id) (res:_lit) (l:list ZMicromega.ZArithProof)
   | SplDistinctElim (pos:int) (orig:clause_id) (res:_lit)
+  (* Bit-blasting *)
+  | BBVar (pos:int) (res:_lit)
+  | BBConst (pos:int) (res:_lit)
+  | BBOp (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBNot (pos:int) (orig:clause_id) (res:_lit)
+  | BBNeg (pos:int) (orig:clause_id) (res:_lit)
+  | BBAdd (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBConcat (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBMul (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBUlt (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBSlt (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBEq (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBDiseq (pos:int) (res:_lit)
+  | BBExtract (pos:int) (orig:clause_id) (res:_lit)
+  | BBZextend (pos:int) (orig:clause_id) (res:_lit)
+  | BBSextend (pos:int) (orig:clause_id) (res:_lit)
+  | BBShl (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | BBShr (pos:int) (orig1 orig2:clause_id) (res:_lit)
+  | RowEq (pos:int) (res: _lit)
+  | RowNeq (pos:int) (cl: C.t)
+  | Ext (pos:int) (res: _lit)
   (* Offer the possibility to discharge parts of the proof to (manual) Coq proofs.
      WARNING: this breaks extraction. *)
   | Hole (pos:int) (prem_id:list clause_id) (prem:list C.t) (concl:C.t)
-    (p:interp_conseq_uf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) prem concl)
+    (p:interp_conseq_uf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) prem concl)
   | ForallInst (pos:int) (lemma:Prop) (plemma:lemma) (concl:C.t)
-    (p: lemma -> interp_conseq_uf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) nil concl)
+    (p: lemma -> interp_conseq_uf (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) nil concl)
   .
 
   Local Open Scope list_scope.
@@ -352,6 +374,7 @@ Inductive step :=
   Definition step_checker s (st:step) :=
     match st with
       | Res pos res => S.set_resolve s pos res
+      | Weaken pos cid cl => S.set_weaken s pos cid cl
       | ImmFlatten pos cid lf => S.set_clause s pos (check_flatten t_atom t_form s cid lf)
       | CTrue pos => S.set_clause s pos Cnf.check_True
       | CFalse pos => S.set_clause s pos Cnf.check_False
@@ -368,46 +391,98 @@ Inductive step :=
       | LiaDiseq pos l => S.set_clause s pos (check_diseq t_form t_atom l)
       | SplArith pos orig res l => S.set_clause s pos (check_spl_arith t_form t_atom (S.get s orig) res l)
       | SplDistinctElim pos orig res => S.set_clause s pos (check_distinct_elim t_form t_atom (S.get s orig) res)
+      | BBVar pos res => S.set_clause s pos (check_bbVar t_atom t_form res)
+      | BBConst pos res => S.set_clause s pos (check_bbConst t_atom t_form res)
+      | BBOp pos orig1 orig2 res => S.set_clause s pos (check_bbOp t_atom t_form s orig1 orig2 res)
+      | BBNot pos orig res => S.set_clause s pos (check_bbNot t_atom t_form s orig res)
+      | BBNeg pos orig res => S.set_clause s pos (check_bbNeg t_atom t_form s orig res)
+      | BBAdd pos orig1 orig2 res => S.set_clause s pos (check_bbAdd t_atom t_form s orig1 orig2 res)
+      | BBConcat pos orig1 orig2 res => S.set_clause s pos (check_bbConcat t_atom t_form s orig1 orig2 res)
+      | BBMul pos orig1 orig2 res => S.set_clause s pos (check_bbMult t_atom t_form s orig1 orig2 res)
+      | BBUlt pos orig1 orig2 res => S.set_clause s pos (check_bbUlt t_atom t_form s orig1 orig2 res)
+      | BBSlt pos orig1 orig2 res => S.set_clause s pos (check_bbSlt t_atom t_form s orig1 orig2 res)
+      | BBEq pos orig1 orig2 res => S.set_clause s pos (check_bbEq t_atom t_form s orig1 orig2 res)
+      | BBDiseq pos res => S.set_clause s pos (check_bbDiseq t_atom t_form res)
+      | BBExtract pos orig res => S.set_clause s pos (check_bbExtract t_atom t_form s orig res)
+      | BBZextend pos orig res => S.set_clause s pos (check_bbZextend t_atom t_form s orig res)
+      | BBSextend pos orig res => S.set_clause s pos (check_bbSextend t_atom t_form s orig res)
+      | BBShl pos orig1 orig2 res => S.set_clause s pos (check_bbShl t_atom t_form s orig1 orig2 res)
+      | BBShr pos orig1 orig2 res => S.set_clause s pos (check_bbShr t_atom t_form s orig1 orig2 res)
+      | RowEq pos res => S.set_clause s pos (check_roweq t_form t_atom res)
+      | RowNeq pos cl => S.set_clause s pos (check_rowneq t_form t_atom cl)
+      | Ext pos res => S.set_clause s pos (check_ext t_form t_atom res)
       | @Hole pos prem_id prem concl _ => S.set_clause s pos (check_hole s prem_id prem concl)
       | @ForallInst pos lemma _ concl  _ => S.set_clause s pos concl
     end.
 
+  (* Opaque S.set_weaken. *)
+
   Lemma step_checker_correct :
-    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form in
       Form.check_form t_form -> Atom.check_atom t_atom ->
       Atom.wt t_i t_func t_atom ->
       forall s, S.valid rho s ->
         forall st : step, S.valid rho (step_checker s st).
   Proof.
-    intros rho H1 H2 H10 s Hs. destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [[Ht1 Ht2] Ht3]. destruct (Atom.check_atom_correct _ H2) as [Ha1 Ha2]. intros [pos res|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid|pos cid|pos cid i|pos l fl|pos l fl|pos l1 l2 fl|pos cl c|pos l|pos orig res l|pos orig res|pos prem_id prem concl p | pos lemma plemma concl p]; simpl; try apply S.valid_set_clause; auto.
-    apply S.valid_set_resolve; auto.
-    apply valid_check_flatten; auto; intros h1 h2 H.
-    rewrite (Syntactic.check_hatom_correct_bool _ _ _ Ha1 Ha2 _ _ H); auto.
-    rewrite (Syntactic.check_neg_hatom_correct_bool _ _ _ H10 Ha1 Ha2 _ _ H); auto.
-    apply valid_check_True; auto.
-    apply valid_check_False; auto.
-    apply valid_check_BuildDef; auto.
-    apply valid_check_BuildDef2; auto.
-    apply valid_check_BuildProj; auto.
-    apply valid_check_ImmBuildDef; auto.
-    apply valid_check_ImmBuildDef2; auto.
-    apply valid_check_ImmBuildProj; auto.
-    apply valid_check_trans; auto.
-    apply valid_check_congr; auto.
-    apply valid_check_congr_pred; auto.
-    apply valid_check_micromega; auto.
-    apply valid_check_diseq; auto.
-    apply valid_check_spl_arith; auto.
-    apply valid_check_distinct_elim; auto.
-    apply valid_check_hole; auto.
-    apply valid_check_forall_inst with lemma; auto.
+    set (empty_bv := (fun (a:Atom.atom) s => BITVECTOR_LIST.zeros s)).
+    intros rho H1 H2 H10 s Hs. destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) _ H1)
+    as [[Ht1 Ht2] Ht3]. destruct (Atom.check_atom_correct _ H2) as
+    [Ha1 Ha2]. intros [pos res|pos cid c|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid
+    |pos cid|pos cid i|pos l fl|pos l fl|pos l1 l2 fl|pos cl c|pos l|pos orig res l
+    |pos orig res|pos res|pos res|pos orig1 orig2 res|pos orig res|pos orig res
+    |pos orig1 orig2 res|pos orig1 orig2 res
+    |pos orig1 orig2 res|pos orig1 orig2 res|pos orig1 orig2 res|pos orig1 orig2 res
+    |pos cl |pos orig res |pos orig res |pos orig res | pos orig1 orig2 res | pos orig1 orig2 res |pos res|pos res
+    |pos res |pos prem_id prem concl p|pos lemma plemma concl p]; simpl; try apply S.valid_set_clause; auto.
+    - apply S.valid_set_resolve; auto.
+    - apply S.valid_set_weaken; auto.
+    - apply valid_check_flatten; auto; intros h1 h2 H.
+      + rewrite (Syntactic.check_hatom_correct_bool _ _ _ Ha1 Ha2 _ _ H); auto.
+      + rewrite (Syntactic.check_neg_hatom_correct_bool _ _ _ H10 Ha1 Ha2 _ _ H); auto.
+    - apply valid_check_True; auto.
+    - apply valid_check_False; auto.
+    - apply valid_check_BuildDef; auto.
+    - apply valid_check_BuildDef2; auto.
+    - apply valid_check_BuildProj; auto.
+    - apply valid_check_ImmBuildDef; auto.
+    - apply valid_check_ImmBuildDef2; auto.
+    - apply valid_check_ImmBuildProj; auto.
+    - apply valid_check_trans; auto.
+    - apply valid_check_congr; auto.
+    - apply valid_check_congr_pred; auto.
+    - apply valid_check_micromega; auto.
+    - apply valid_check_diseq; auto.
+    - apply valid_check_spl_arith; auto.
+    - apply valid_check_distinct_elim; auto.
+    - eapply valid_check_bbVar; eauto.
+    - apply valid_check_bbConst; auto.
+    - apply valid_check_bbOp; auto.
+    - apply valid_check_bbNot; auto.
+    - apply valid_check_bbNeg; auto.
+    - apply valid_check_bbAdd; auto.
+    - apply valid_check_bbConcat; auto.
+    - apply valid_check_bbMult; auto.
+    - apply valid_check_bbUlt; auto.
+    - apply valid_check_bbSlt; auto.
+    - apply valid_check_bbEq; auto.
+    - apply valid_check_bbDiseq; auto.
+    - apply valid_check_bbExtract; auto.
+    - apply valid_check_bbZextend; auto.
+    - apply valid_check_bbSextend; auto.
+    - apply valid_check_bbShl; auto.
+    - apply valid_check_bbShr; auto.
+    - apply valid_check_roweq; auto.
+    - apply valid_check_rowneq; auto.
+    - apply valid_check_ext; auto.
+    - apply valid_check_hole; auto.
+    - apply valid_check_forall_inst with lemma; auto.
   Qed.
 
   Definition euf_checker (* t_atom t_form *) s t :=
     _checker_ (step_checker (* t_atom t_form *)) s t.
 
   Lemma euf_checker_correct : (* forall t_i t_func t_atom t_form, *)
-    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form in
       Form.check_form t_form -> Atom.check_atom t_atom ->
       Atom.wt t_i t_func t_atom ->
       forall s t confl,
@@ -431,17 +506,17 @@ Inductive step :=
     end.
 
   Definition valid t_i t_func t_atom t_form d :=
-    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form in
     afold_left _ _ true andb (Lit.interp rho) d.
 
   Lemma add_roots_correct : (* forall t_i t_func t_atom t_form, *)
-    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form in
       Form.check_form t_form -> Atom.check_atom t_atom ->
       Atom.wt t_i t_func t_atom ->
       forall s d used_roots, S.valid rho s -> valid t_func t_atom t_form d ->
         S.valid rho (add_roots s d used_roots).
   Proof.
-    intros (* t_i t_func t_atom t_form *) rho H1 H2 H10 s d used_roots H3; unfold valid; intro H4; pose (H5 := (afold_left_andb_true_inv _ _ _ H4)); unfold add_roots; assert (Valuation.wf rho) by (destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [_ H]; auto); case used_roots.
+    intros (* t_i t_func t_atom t_form *) rho H1 H2 H10 s d used_roots H3; unfold valid; intro H4; pose (H5 := (afold_left_andb_true_inv _ _ _ H4)); unfold add_roots; assert (Valuation.wf rho) by (destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) _ H1) as [_ H]; auto); case used_roots.
     intro ur; apply (foldi_right_Ind _ _ (fun _ a => S.valid rho a)); auto; intros a i H6 Ha; apply S.valid_set_clause; auto; case_eq (ur .[ i] < length d).
     intro; unfold C.valid; simpl; rewrite H5; auto.
     intros; apply C.interp_true; auto.
@@ -455,14 +530,188 @@ Inductive step :=
     euf_checker (* t_atom t_form *) C.is_false (add_roots (S.make nclauses) d used_roots) t confl.
   Implicit Arguments checker [].
 
+
+  Definition setup_checker_step_debug d used_roots (c:certif) :=
+    let (nclauses, t, confl) := c in
+    let s := add_roots (S.make nclauses) d used_roots in
+    (s, Structures.trace_to_list t).
+
+
+  Definition position_of_step (st:step) :=
+    match st with
+      | Res pos _
+      | Weaken pos _ _
+      | ImmFlatten pos _ _
+      | CTrue pos
+      | CFalse pos
+      | BuildDef pos _
+      | BuildDef2 pos _
+      | BuildProj pos _ _
+      | ImmBuildDef pos _
+      | ImmBuildDef2 pos _
+      | ImmBuildProj pos _ _
+      | EqTr pos _ _
+      | EqCgr pos _ _
+      | EqCgrP pos _ _ _
+      | LiaMicromega pos _ _
+      | LiaDiseq pos _
+      | SplArith pos _ _ _
+      | SplDistinctElim pos _ _
+      | BBVar pos _
+      | BBConst pos _
+      | BBOp pos _ _ _
+      | BBNot pos _ _
+      | BBNeg pos _ _
+      | BBAdd pos _ _ _
+      | BBConcat pos _ _ _
+      | BBMul pos _ _ _
+      | BBUlt pos _ _ _
+      | BBSlt pos _ _ _
+      | BBEq pos _ _ _
+      | BBDiseq pos _
+      | BBExtract pos _ _
+      | BBZextend pos _ _
+      | BBSextend pos _ _
+      | BBShl pos _ _ _
+      | BBShr pos _ _ _
+      | RowEq pos _
+      | RowNeq pos _
+      | Ext pos _
+      | @Hole pos _ _ _ _
+      | @ForallInst pos _ _ _ _ => pos
+    end.
+
+
+  Definition checker_step_debug s step_t :=
+    let s := step_checker s step_t in
+    (s, C.has_true (S.get s (position_of_step step_t))).
+
+
+  Definition ignore_true_step (st:step) :=
+    match st with
+    | CTrue _
+    (* | Res _ _  *)
+    | @Hole _ _ _ _ _ => true
+    | _ => false
+    end.
+
+  Inductive name_step :=
+  | Name_Res
+  | Name_Weaken
+  | Name_ImmFlatten
+  | Name_CTrue
+  | Name_CFalse
+  | Name_BuildDef
+  | Name_BuildDef2
+  | Name_BuildProj
+  | Name_ImmBuildDef
+  | Name_ImmBuildDef2
+  | Name_ImmBuildProj
+  | Name_EqTr
+  | Name_EqCgr
+  | Name_EqCgrP
+  | Name_LiaMicromega
+  | Name_LiaDiseq
+  | Name_SplArith
+  | Name_SplDistinctElim
+  | Name_BBVar
+  | Name_BBConst
+  | Name_BBOp
+  | Name_BBNot
+  | Name_BBNeg
+  | Name_BBAdd
+  | Name_BBConcat
+  | Name_BBMul
+  | Name_BBUlt
+  | Name_BBSlt
+  | Name_BBEq
+  | Name_BBDiseq
+  | Name_BBExtract
+  | Name_BBZextend
+  | Name_BBSextend
+  | Name_BBShl
+  | Name_BBShr
+  | Name_RowEq
+  | Name_RowNeq
+  | Name_Ext
+  | Name_Hole
+  | Name_ForallInst.
+
+  Definition name_of_step (st:step) :=
+    match st with
+    | Res _ _ => Name_Res
+    | Weaken _ _ _ => Name_Weaken
+    | ImmFlatten _ _ _ => Name_ImmFlatten
+    | CTrue _ => Name_CTrue
+    | CFalse _ => Name_CFalse
+    | BuildDef _ _ => Name_BuildDef
+    | BuildDef2 _ _ => Name_BuildDef2
+    | BuildProj _ _ _ => Name_BuildProj
+    | ImmBuildDef _ _ => Name_ImmBuildDef
+    | ImmBuildDef2 _ _ => Name_ImmBuildDef2
+    | ImmBuildProj _ _ _ => Name_ImmBuildProj
+    | EqTr _ _ _ => Name_EqTr
+    | EqCgr _ _ _ => Name_EqCgr
+    | EqCgrP _ _ _ _ => Name_EqCgrP
+    | LiaMicromega _ _ _ => Name_LiaMicromega
+    | LiaDiseq _ _ => Name_LiaDiseq
+    | SplArith _ _ _ _ => Name_SplArith
+    | SplDistinctElim _ _ _ => Name_SplDistinctElim
+    | BBVar _ _ => Name_BBVar
+    | BBConst _ _ => Name_BBConst
+    | BBOp _ _ _ _ => Name_BBOp
+    | BBNot _ _ _ => Name_BBNot
+    | BBNeg _ _ _ => Name_BBNeg
+    | BBAdd _ _ _ _ => Name_BBAdd
+    | BBConcat _ _ _ _ => Name_BBConcat
+    | BBMul _ _ _ _ => Name_BBMul
+    | BBUlt _ _ _ _ => Name_BBUlt
+    | BBSlt _ _ _ _ => Name_BBSlt
+    | BBEq _ _ _ _ => Name_BBEq
+    | BBDiseq _ _ => Name_BBDiseq
+    | BBExtract _ _ _ => Name_BBExtract
+    | BBZextend _ _ _ => Name_BBZextend
+    | BBSextend _ _ _ => Name_BBSextend
+    | BBShl _ _ _ _ => Name_BBShl
+    | BBShr _ _ _ _ => Name_BBShr
+    | RowEq _ _ => Name_RowEq
+    | RowNeq _ _ => Name_RowNeq
+    | Ext _ _ => Name_Ext
+    | @Hole _ _ _ _ _ => Name_Hole
+    | @ForallInst _ _ _ _ _ => Name_ForallInst
+    end.
+
+
+  Definition checker_debug d used_roots (c:certif) :=
+    let (nclauses, t, confl) := c in
+    let s := add_roots (S.make nclauses) d used_roots in
+    let '(_, nb, failure) :=
+        Structures.trace_fold
+          (fun acc step =>
+             match acc with
+             | (s, nb, None) =>
+               let nb := S nb in
+               let s := step_checker s step in
+               if negb (ignore_true_step step) &&
+                  C.has_true (S.get s (position_of_step step)) then
+                 (s, nb, Some step)
+               else (s, nb, None)
+             | _ => acc
+             end
+          ) (s, O, None) t
+    in
+    match failure with
+    | Some st => Some (nb, name_of_step st)
+    | None => None
+    end
+  .
+
+
   Lemma checker_correct : forall (* t_i t_func t_atom t_form *) d used_roots c,
     checker (* t_i t_func t_atom t_form *) d used_roots c = true ->
-    negb (valid t_func t_atom t_form d).
+    ~ (valid t_func t_atom t_form d).
   Proof.
-    unfold checker; intros (* t_i t_func t_atom t_form *) d used_roots (nclauses, t, confl); rewrite !andb_true_iff.  intros [[[H1 H2] H10] H3].
-    apply Is_true_eq_true. apply negb_prop_intro. intro H.
-    apply Is_true_eq_true in H.
-    eelim euf_checker_correct; try eassumption; apply add_roots_correct; try eassumption; apply S.valid_make; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [_ H4]; auto.
+    unfold checker; intros (* t_i t_func t_atom t_form *) d used_roots (nclauses, t, confl); rewrite !andb_true_iff; intros [[[H1 H2] H10] H3] H; eelim euf_checker_correct; try eassumption; apply add_roots_correct; try eassumption; apply S.valid_make; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) _ H1) as [_ H4]; auto.
   Qed.
 
   Definition checker_b (* t_i t_func t_atom t_form *) l (b:bool) (c:certif) :=
@@ -472,12 +721,9 @@ Inductive step :=
 
   Lemma checker_b_correct : forall (* t_i t_func t_atom t_form *) l b c,
     checker_b (* t_func t_atom t_form *) l b c = true ->
-    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l = b.
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l = b.
   Proof.
-    unfold checker_b; intros (* t_i t_func t_atom t_form *) l b (nclauses, t, confl); case b; intros H2; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l); auto; intros H1;
-    assert (G:= checker_correct H2);
-    apply negb_true_iff in G; apply neg_eq_true_eq_false in G;
-    elim G; auto; unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; auto; rewrite Lit.interp_neg, H1; auto.
+   unfold checker_b; intros (* t_i t_func t_atom t_form *) l b (nclauses, t, confl); case b; intros H2; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l); auto; intros H1; elim (checker_correct H2); auto; unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; auto; rewrite Lit.interp_neg, H1; auto.
  Qed.
 
   Definition checker_eq (* t_i t_func t_atom t_form *) l1 l2 l (c:certif) :=
@@ -491,15 +737,12 @@ Inductive step :=
 
   Lemma checker_eq_correct : forall (* t_i t_func t_atom t_form *) l1 l2 l c,
     checker_eq (* t_func t_atom t_form *) l1 l2 l c = true ->
-    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l1 =
-    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l2.
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l1 =
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l2.
   Proof.
-   unfold checker_eq; intros (* t_i t_func t_atom t_form *) l1 l2 l (nclauses, t, confl); rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
-   unfold checker in H3; rewrite !andb_true_iff in H3; destruct H3 as [[[H3 _] _] _]; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
-   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l2); intro Heq2; auto;
-     assert (G:= checker_correct H3);
-    apply negb_true_iff in G; apply neg_eq_true_eq_false in G;
-   elim G; unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
+   unfold checker_eq; intros (* t_i t_func t_atom t_form *) l1 l2 l (nclauses, t, confl); rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _|intros a ls Heq]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
+   unfold checker in H3; rewrite !andb_true_iff in H3; destruct H3 as [[[H3 _] _] _]; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
+   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form) l2); intro Heq2; auto; elim (checker_correct H3); unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
  Qed.
 
 
diff --git a/src/array/Array_checker.v b/src/array/Array_checker.v
new file mode 100644
index 0000000..dd1a65f
--- /dev/null
+++ b/src/array/Array_checker.v
@@ -0,0 +1,1272 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool List Int63 PArray SMT_classes.
+Require Import Misc State SMT_terms FArray.
+
+Import Form.
+Import Atom.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Section certif.
+
+  Variable t_form : PArray.array Form.form.
+  Variable t_atom : PArray.array Atom.atom.
+
+  Local Notation get_atom := (PArray.get t_atom) (only parsing).
+  Local Notation get_form := (PArray.get t_form) (only parsing).
+
+
+  Definition check_roweq lres :=
+    if Lit.is_pos lres then
+      match get_form (Lit.blit lres) with
+      | Fatom a =>
+        match get_atom a with
+        | Abop (BO_eq te) xa v =>
+          match get_atom xa with
+          | Abop (BO_select ti1 te1) sa i =>
+            match get_atom sa with
+            | Atop (TO_store ti2 te2) fa j v2 =>
+              if Typ.eqb ti1 ti2 &&
+                 Typ.eqb te te1 && Typ.eqb te te2 &&
+                 (i == j) && (v == v2)
+              then lres::nil
+              else C._true
+            | _ => C._true
+            end
+          | _ => C._true
+          end
+        | _ => C._true
+        end
+      | _ => C._true
+      end
+    else C._true.
+
+
+  Definition store_of_me a b :=
+    match get_atom b with
+    | Atop (TO_store ti te) a' i _ =>
+      if (a' == a) then Some (ti, te, i) else None
+    | _ => None
+    end.
+ 
+  
+  Definition check_rowneq cl :=
+    match cl with
+    | leqij :: leqrow :: nil =>
+      if Lit.is_pos leqij && Lit.is_pos leqrow then
+        match get_form (Lit.blit leqij), get_form (Lit.blit leqrow) with
+        | Fatom eqij, Fatom eqrow =>
+          match get_atom eqij, get_atom eqrow with
+          | Abop (BO_eq ti) i j, Abop (BO_eq te) xa x =>
+            match get_atom xa, get_atom x with
+            | Abop (BO_select ti1 te1) sa j1, Abop (BO_select ti2 te2) sa2 j2 =>
+              if Typ.eqb ti ti1 && Typ.eqb ti ti2 &&
+                 Typ.eqb te te1 && Typ.eqb te te2 then
+                match store_of_me sa sa2, store_of_me sa2 sa with
+                | Some (ti3, te3, i1), None | None, Some (ti3, te3, i1) => 
+                  if Typ.eqb ti ti3 && Typ.eqb te te3 &&
+                     (((i1 == i) && (j1 == j) && (j2 == j)) ||
+                      ((i1 == j) && (j1 == i) && (j2 == i))) then
+                    cl
+                  else C._true
+                | _, _ => C._true
+                end
+              else C._true
+            | _, _ => C._true
+            end
+          | _, _ => C._true
+          end
+        | _, _ => C._true
+        end
+      else C._true
+    | _ => C._true
+    end.
+
+
+
+  Definition eq_sel_sym ti te a b sela selb :=
+    match get_atom sela, get_atom selb with
+    | Abop (BO_select ti1 te1) a' d1, Abop (BO_select ti2 te2) b' d2 =>
+      Typ.eqb ti ti1 && Typ.eqb ti ti2 &&
+      Typ.eqb te te1 && Typ.eqb te te2 &&
+      (a == a') && (b == b') && (d1 == d2) &&
+      match get_atom d1 with
+      | Abop (BO_diffarray ti3 te3) a3 b3 =>
+        Typ.eqb ti ti3 && Typ.eqb te te3 &&
+        (a3 == a) && (b3 == b)
+      | _ => false
+      end
+    | _, _ => false
+    end.
+  
+  
+  Definition check_ext lres :=
+    if Lit.is_pos lres then
+      match get_form (Lit.blit lres) with
+      | For args =>
+        if PArray.length args == 2 then
+          let l1 := args.[0] in
+          let l2 := args.[1] in
+          if Lit.is_pos l1 && negb (Lit.is_pos l2) then
+            match get_form (Lit.blit l1), get_form (Lit.blit l2) with
+            | Fatom eqa, Fatom eqsel =>
+              match get_atom eqa, get_atom eqsel with
+              | Abop (BO_eq (Typ.TFArray ti te)) a b, Abop (BO_eq te') sela selb => 
+                if Typ.eqb te te' && (eq_sel_sym ti te a b sela selb ||
+                                      eq_sel_sym ti te b a sela selb) then
+                  lres :: nil
+                else C._true
+              | _, _ => C._true
+              end
+            | _, _ => C._true
+            end
+          else C._true
+        else C._true
+      | _ => C._true
+      end
+    else C._true.
+
+
+  Section Correct.
+
+    Variables (t_i : array typ_compdec)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation check_atom :=
+      (check_aux t_i t_func (get_type t_i t_func t_atom)).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
+
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
+
+    Local Notation t_interp := (t_interp t_i t_func t_atom).
+
+    Local Notation interp_atom := (interp_aux t_i t_func (get t_interp)).
+
+    Let wf_t_atom : Atom.wf t_atom.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_atom : default t_atom = Atom.Acop Atom.CO_xH.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_form : default t_form = Form.Ftrue.
+    Proof.
+      destruct (Form.check_form_correct
+                  interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _];
+        destruct H; auto.
+    Qed.
+
+    Let wf_t_form : Form.wf t_form.
+    Proof.
+      destruct (Form.check_form_correct
+                  interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _];
+        destruct H; auto.
+    Qed.
+
+    Let wf_rho : Valuation.wf rho.
+    Proof.
+      destruct (Form.check_form_correct
+                  interp_form_hatom interp_form_hatom_bv _ ch_form); auto.
+    Qed.
+
+    Let rho_interp : forall x : int,
+        rho x = Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form.[ x]).
+    Proof. intros x;apply wf_interp_form;trivial. Qed.
+
+    Definition wf := PArray.forallbi lt_form t_form.
+
+    Hypothesis wf_t_i : wf.
+    Notation atom := int (only parsing).
+
+    
+    Lemma valid_check_roweq lres : C.valid rho (check_roweq lres).
+    Proof.
+      unfold check_roweq.
+      case_eq (Lit.is_pos lres); intro Heq; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a Heq2.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] a1 a2 Heq3; try (intros; now apply C.interp_true).
+      case_eq (t_atom .[ a1]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] b1 b2 Heq4; try (intros; now apply C.interp_true).
+      case_eq (t_atom .[ b1]); try (intros; now apply C.interp_true).
+      intros [ ] c1 c2 c3 Heq5.
+      (* roweq *)
+      - case_eq (Typ.eqb t0 t2 && Typ.eqb t t1 && 
+             Typ.eqb t t3 && (b2 == c2) && (a2 == c3)); simpl; intros Heq6; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq2. simpl.
+
+        rewrite !andb_true_iff in Heq6.
+        destruct Heq6 as ((((Heq6a, Heq6b), Heq6c), Heq6d), Heq6e).
+
+        apply Typ.eqb_spec in Heq6a.
+        apply Typ.eqb_spec in Heq6b.
+        apply Typ.eqb_spec in Heq6c.
+        apply Int63Properties.eqb_spec in Heq6d.
+        apply Int63Properties.eqb_spec in Heq6e.
+
+        pose proof (rho_interp (Lit.blit lres)) as Hrho.
+        rewrite Heq2 in Hrho. simpl in Hrho.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). assert (a < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq3. easy.
+        specialize (H0 H1). simpl in H0.
+        rewrite Heq3 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+        unfold get_type' in H2, H3, H0. unfold v_type in H2, H3, H0.
+
+        case_eq (t_interp .[ a]).
+          intros v_typea v_vala Htia. rewrite Htia in H0.
+          case_eq v_typea; intros; rewrite H4 in H0; try now contradict H0.
+
+        case_eq (t_interp .[ a1]).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2]).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia; trivial.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        rewrite Heq3 in Htia. simpl in Htia.
+        rewrite !Atom.t_interp_wf in Htia; trivial.
+        rewrite Htia1, Htia2 in Htia. simpl in Htia.
+
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+        generalize dependent v_vala.
+
+        rewrite H2, H3, H4.
+        rewrite !Typ.cast_refl. intros. simpl in Htia.
+        unfold Bval in Htia.
+
+        specialize (Atom.Bval_inj2 t_i (Typ.Tbool) (Typ.i_eqb t_i t v_vala1 v_vala2) (v_vala)).
+        intros. specialize (H5 Htia).
+
+        pose proof (H a1). assert (a1 < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq4. easy.
+        specialize (H6 H7). simpl in H6.
+        rewrite Heq4 in H6. simpl in H6.
+        rewrite !andb_true_iff in H6.
+        destruct H6 as ((H6a, H6b), H6c).
+        apply Typ.eqb_spec in H6a.
+        apply Typ.eqb_spec in H6b.
+        apply Typ.eqb_spec in H6c.
+
+        pose proof (H b1). assert (b1 < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq5. easy.
+        specialize (H6 H8). simpl in H6.
+        rewrite Heq5 in H6. simpl in H6.
+
+        rewrite !andb_true_iff in H6.
+        destruct H6 as (((H6d, H6e), H6f), H6h).
+        apply Typ.eqb_spec in H6e.
+        apply Typ.eqb_spec in H6f.
+        apply Typ.eqb_spec in H6h.
+
+        unfold get_type' in H6b, H6c, H6d.
+        unfold v_type in H6b, H6c, H6d.
+        case_eq (t_interp .[ b2]). 
+          intros v_typeb2 v_valb2 Htib2. rewrite Htib2 in H6c.
+        rewrite Atom.t_interp_wf in Htib2; trivial.
+        case_eq (t_interp .[ b1]). 
+          intros v_typeb1 v_valb1 Htib1. rewrite Htib1 in H6d.
+        rewrite Atom.t_interp_wf in Htib1; trivial.
+        rewrite <- Heq6d, <- Heq6e in *.
+
+        rewrite Heq5 in Htib1. simpl in Htib1.
+
+        generalize dependent v_valb2.
+
+        rewrite H6c. intros.
+        unfold Atom.interp_form_hatom, interp_hatom.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq3. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq4, Htia2. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq5, Htib2. simpl. 
+        rewrite Htib1. simpl.
+
+        rewrite Typ.cast_refl.
+        unfold apply_binop.
+        rewrite Typ.cast_refl.
+
+        case_eq (t_interp .[ b1]); intros.
+        pose proof H6.
+        rewrite H6 in H6b.
+        rewrite !Atom.t_interp_wf in H6; trivial.
+        rewrite Heq5 in H6.
+        simpl in H6. rewrite H6 in Htib1.
+        inversion Htib1.
+
+        generalize dependent v_val0.
+
+        rewrite H6b.
+        intros. rewrite Typ.cast_refl.
+        simpl.
+        unfold get_type' in H6a.
+        unfold v_type in H6a.
+        case_eq (t_interp .[ a1]).
+        intros.
+        rewrite H10 in H6a.
+        rewrite !Atom.t_interp_wf in H10; trivial.
+        rewrite H10 in Htia1.
+        inversion Htia1.
+        rewrite <- H6a in H14.
+
+        generalize dependent v_val0.
+
+        rewrite H14.
+        intros.
+        rewrite Typ.cast_refl.
+        simpl.
+
+        unfold apply_terop in H6.
+        unfold get_type', v_type in H6e, H6f, H6h.
+        case_eq ( t_interp .[ c1]); intros.
+        rewrite H13 in H6e.
+        rewrite H13 in H6.
+        case_eq (t_interp .[ b2]); intros.
+        rewrite H16 in H6f.
+        rewrite H16 in H6.
+        case_eq (t_interp .[ a2]); intros.
+        rewrite H17 in H6h.
+        rewrite H17 in H6.
+
+        generalize dependent v_val2. generalize dependent v_val3.
+        generalize dependent v_val4.
+
+        rewrite H6e, H6f, H6h.
+        rewrite !Typ.cast_refl.
+        intros.
+        unfold Bval in H6.
+
+        rewrite <- H11 in H6d.
+        rewrite H6b in H6d.
+        rewrite andb_true_iff in H6d.
+        destruct H6d as (H6d1, H6d2).
+        apply Typ.eqb_spec in H6d1.
+        apply Typ.eqb_spec in H6d2.
+
+        generalize dependent v_val2. generalize dependent v_val3.
+        generalize dependent v_val4.
+
+        rewrite H6d1, H6d2, H14.
+        intros.
+        specialize (Atom.Bval_inj2 t_i (Typ.TFArray t0 t) 
+        (store v_val2 v_val3 v_val4) (v_val0)).
+        intros. specialize (H18 H6).
+        rewrite <- H18.
+
+        rewrite !Atom.t_interp_wf in H16; trivial.
+        rewrite H16 in Htib2.
+        specialize (Atom.Bval_inj2 t_i t0 v_val3 v_valb2).
+        intros. specialize (H19 Htib2).
+        rewrite <- H19.
+
+        rewrite !Atom.t_interp_wf in H17; trivial.
+        rewrite H17 in Htia2.
+        specialize (Atom.Bval_inj2 t_i t v_val4 v_vala2).
+        intros. specialize (H20 Htia2).
+        rewrite <- H20.
+        apply Typ.i_eqb_spec.
+        apply (read_over_write (elt_dec:=(EqbToDecType _ (@Eqb _ _)))).
+    Qed.
+
+
+    
+    Lemma valid_check_rowneq cl : C.valid rho (check_rowneq cl).
+    Proof.
+        unfold check_rowneq.
+        case_eq (cl); [ intros | intros i l ]; simpl; try now apply C.interp_true.
+        case_eq (l); [ intros | intros j xsl ]; simpl; try now apply C.interp_true.
+        case_eq (xsl); intros; simpl; try now apply C.interp_true.
+        case_eq (Lit.is_pos i); intro Heq; simpl; try now apply C.interp_true.
+        case_eq (Lit.is_pos j); intro Heq2; simpl; try now apply C.interp_true.
+        case_eq (t_form .[ Lit.blit i]); try (intros; now apply C.interp_true).
+        intros a Heq3.
+        case_eq (t_form .[ Lit.blit j]); try (intros; now apply C.interp_true).
+        intros b Heq4.
+        case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+        intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] a1 a2 Heq5; try (intros; now apply C.interp_true).
+        case_eq (t_atom .[ b]); try (intros; now apply C.interp_true).
+        intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] b1 b2 Heq6; try (intros; now apply C.interp_true).
+        case_eq (t_atom .[ b1]); try (intros; now apply C.interp_true).
+        intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] c1 c2 Heq7; try (intros; now apply C.interp_true).
+        case_eq (t_atom .[ b2]); try (intros; now apply C.interp_true).
+        intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] d1 d2 Heq8; try (intros; now apply C.interp_true).
+        case_eq (Typ.eqb t t1 && Typ.eqb t t3 && Typ.eqb t0 t2 && Typ.eqb t0 t4); 
+          try (intros; now apply C.interp_true). intros Heq9.
+
+
+        rewrite !andb_true_iff in Heq9.
+        destruct Heq9 as (((Heq9a, Heq9b), Heq9c), Heq9d).
+
+        apply Typ.eqb_spec in Heq9a.
+        apply Typ.eqb_spec in Heq9b.
+        apply Typ.eqb_spec in Heq9c.
+        apply Typ.eqb_spec in Heq9d.
+        subst t1 t2 t3 t4.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        assert (H15: b1 < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq7. discriminate.
+        assert (H20: b2 < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq8. discriminate.
+        assert (H9: b < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. discriminate.
+        assert (H3: a < PArray.length t_atom).
+        apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq5. discriminate.
+
+
+        apply H2 in H15.
+        apply H2 in H20.
+        apply H2 in H3.
+        apply H2 in H9.
+
+        rewrite Heq7 in H15.
+        rewrite Heq8 in H20.
+        rewrite Heq6 in H9.
+        rewrite Heq5 in H3.
+
+        simpl in H15, H20, H3, H9.
+        
+        rewrite !andb_true_iff in H15, H20, H3, H9.
+
+        destruct H3 as ((H3, H6), H5).
+        destruct H9 as ((H9, H12), H11).
+        destruct H15 as ((H15, H18), H17).
+        destruct H20 as ((H20, H23), H22).
+        unfold get_type', v_type in H3, H5, H6, H9, H11, H12, H15, H17, H18, H20, H22, H23.
+
+        
+        case_eq (t_interp .[ a]).
+          intros v_typea v_vala Htia. rewrite Htia in H3.
+          case_eq v_typea; intros; rewrite H4 in H3; try now contradict H3.
+
+        case_eq (t_interp .[ a1]).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H6.
+        case_eq (t_interp .[ a2]).
+            intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H5.
+        rewrite Atom.t_interp_wf in Htia, Htia1, Htia2; trivial.
+        rewrite Heq5 in Htia. simpl in Htia.
+        rewrite !Atom.t_interp_wf in Htia; trivial.
+        rewrite Htia1, Htia2 in Htia. simpl in Htia.
+
+        apply Typ.eqb_spec in H5. apply Typ.eqb_spec in H6.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+        generalize dependent v_vala.
+        rewrite H5, H6, H4.
+        rewrite !Typ.cast_refl. intros. simpl in Htia.
+        unfold Bval in Htia.
+
+        specialize (Atom.Bval_inj2 t_i (Typ.Tbool) (Typ.i_eqb t_i t v_vala1 v_vala2) (v_vala)).
+        intros H8. specialize (H8 Htia).
+
+        case_eq (t_interp .[ b]).
+          intros v_typeb v_valb Htib. rewrite Htib in H9;
+          case_eq v_typeb; intros; rewrite H7 in H9; try now contradict H9.
+
+        case_eq (t_interp .[ b1]).
+          intros v_typeb1 v_valb1 Htib1. rewrite Htib1 in H12.
+        case_eq (t_interp .[ b2]).
+            intros v_typeb2 v_valb2 Htib2. rewrite Htib2 in H11.
+        rewrite Atom.t_interp_wf in Htib, Htib1, Htib2; trivial.
+        rewrite Heq6 in Htib. simpl in Htib.
+        rewrite !Atom.t_interp_wf in Htib; trivial.
+        rewrite Htib1, Htib2 in Htib. simpl in Htib.
+
+        apply Typ.eqb_spec in H11. apply Typ.eqb_spec in H12.
+
+
+        generalize dependent v_valb1. generalize dependent v_valb2.
+        generalize dependent v_valb.
+        rewrite H11, H12, H7.
+        rewrite !Typ.cast_refl. intros. simpl in Htib.
+        unfold Bval in Htib.
+
+        specialize (Atom.Bval_inj2 t_i (Typ.Tbool) (Typ.i_eqb t_i t0 v_valb1 v_valb2) (v_valb)).
+        intros H14. specialize (H14 Htib).
+
+       case_eq (t_interp .[ b1]).
+          intros v_typeb1' v_valb1' Htib1'. rewrite Htib1' in H15.
+
+        case_eq (t_interp .[ c1]).
+          intros v_typec1 v_valc1 Htic1. rewrite Htic1 in H18.
+        case_eq (t_interp .[ c2]).
+            pose proof Htib1' as Htib1''.
+            intros v_typec2 v_valc2 Htic2. rewrite Htic2 in H17.
+            pose proof Htic2 as Htic2''.
+        rewrite Atom.t_interp_wf in Htib1', Htic1, Htic2; trivial.
+        rewrite Heq7 in Htib1'. simpl in Htib1'.
+        rewrite !Atom.t_interp_wf in Htib1'; trivial.
+        rewrite Htic1, Htic2 in Htib1'. simpl in Htib1'.
+
+        apply Typ.eqb_spec in H17. apply Typ.eqb_spec in H18.
+        apply Typ.eqb_spec in H15. 
+
+        generalize dependent v_valc1. generalize dependent v_valc2.
+        generalize dependent v_valb1'.
+        rewrite H17, H18.
+        rewrite !Typ.cast_refl. intros. simpl in Htib1'.
+        unfold Bval in Htib1'.
+
+
+        generalize dependent v_valc1. generalize dependent v_valc2.
+        generalize dependent v_valb1'.
+
+        rewrite H15. intros.
+        specialize (Atom.Bval_inj2 t_i (v_typeb1') (select v_valc1 v_valc2) (v_valb1')).
+        intro H19. specialize (H19 Htib1').
+
+        (* b2 *)
+       case_eq (t_interp .[ b2]).
+          intros v_typeb2' v_valb2' Htib2'. rewrite Htib2' in H20.
+
+        case_eq (t_interp .[ d1]).
+          intros v_typed1 v_vald1 Htid1. rewrite Htid1 in H23.
+        case_eq (t_interp .[ d2]).
+            pose proof Htib2' as Htib2''.
+            intros v_typed2 v_vald2 Htid2. rewrite Htid2 in H22.
+        rewrite Atom.t_interp_wf in Htib2', Htid1, Htid2; trivial.
+        rewrite Heq8 in Htib2'. simpl in Htib2'.
+        rewrite !Atom.t_interp_wf in Htib2'; trivial.
+        rewrite Htid1, Htid2 in Htib2'. simpl in Htib2'.
+
+        apply Typ.eqb_spec in H22. apply Typ.eqb_spec in H23.
+        apply Typ.eqb_spec in H20. 
+
+        generalize dependent v_vald1. generalize dependent v_vald2.
+        generalize dependent v_valb2'.
+        rewrite H22, H23.
+        rewrite !Typ.cast_refl. intros. simpl in Htib2'.
+        unfold Bval in Htib2'.
+
+
+        generalize dependent v_vald1. generalize dependent v_vald2.
+        generalize dependent v_valb2'.
+
+        rewrite H20. intros.
+        specialize (Atom.Bval_inj2 t_i (v_typeb2') (select v_vald1 v_vald2) (v_valb2')).
+        intro H24. specialize (H24 Htib2').
+
+        
+        
+        case_eq (store_of_me c1 d1);
+          case_eq (store_of_me d1 c1);
+          try (intros; try(destruct p0, p0); now apply C.interp_true).
+        
+        - unfold store_of_me.
+          intro HT1. clear HT1.
+          case_eq (t_atom .[ d1]); try discriminate.
+          intros [ t5 t6 ] e1 e2 e3 Heq10 [[ti3 te3] i1].
+          case_eq (e1 == c1); try discriminate. intros Heq11c.
+          intro HT.
+          injection HT. intros. subst i1 te3 ti3. clear HT.
+
+          case_eq (
+              Typ.eqb t t5 && Typ.eqb v_typeb1' t6 &&
+                      ((e2 == a1) && (c2 == a2) && (d2 == a2) || (e2 == a2) && (c2 == a1) && (d2 == a1)));
+            simpl; intros Heq11; try (now apply C.interp_true).
+
+          unfold C.valid. simpl. rewrite orb_false_r.
+
+          case_eq (Lit.interp rho i). intros isit.
+          easy. intros isif. rewrite orb_false_l.
+          specialize (rho_interp ( Lit.blit i)).
+          rewrite Heq3 in rho_interp.
+          simpl in rho_interp.
+          unfold Lit.interp in isif.
+          rewrite Heq in isif. unfold Var.interp in isif.
+          rewrite rho_interp in isif.
+          unfold Atom.interp_form_hatom, interp_hatom in isif.
+          rewrite Atom.t_interp_wf in isif; trivial.
+          rewrite Heq5 in isif.
+          simpl in isif.
+          unfold interp_bool in isif.
+
+          unfold Lit.interp. rewrite Heq2.
+          unfold Var.interp.
+          rewrite !wf_interp_form; trivial. rewrite Heq4. simpl.
+
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as ((Heq11a, Heq11b), Heq11d).
+          rewrite !orb_true_iff in Heq11d.
+
+          apply Typ.eqb_spec in Heq11a.
+          apply Typ.eqb_spec in Heq11b.
+          apply Int63Properties.eqb_spec in Heq11c.
+          rewrite !andb_true_iff in Heq11d.
+          rewrite !Int63Properties.eqb_spec in Heq11d.
+
+
+          rewrite !Atom.t_interp_wf in isif; trivial.
+          rewrite Htia1, Htia2 in isif. simpl in isif.
+          unfold Bval in isif.
+
+
+          assert (H25: d1 < PArray.length t_atom).
+          apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq10. discriminate.
+          apply H2 in H25.
+          rewrite Heq10 in H25.
+          simpl in H25.
+          rewrite !andb_true_iff in H25.
+          destruct H25 as (((H25, H29), H28), H27).
+          unfold get_type', v_type in H25, H27, H28, H29.
+
+          case_eq (t_interp .[ d1]).
+          intros v_typed1' v_vald1' Htid1'. rewrite Htid1' in H25.
+          case_eq v_typed1'; intros; rewrite H10 in H25; try now contradict H25.
+          rewrite andb_true_iff in H25; destruct H25 as (H25a, H25b).
+
+          case_eq (t_interp .[ e1]).
+          intros v_typee1 v_vale1 Htie1. rewrite Htie1 in H29.
+          case_eq (t_interp .[ e2]).
+          intros v_typee2 v_vale2 Htie2. rewrite Htie2 in H28.
+          case_eq (t_interp .[ e3]).
+          intros v_typee3 v_vale3 Htie3. rewrite Htie3 in H27.
+          pose proof Htid1' as Htid1''.
+          rewrite Atom.t_interp_wf in Htid1', Htie1, Htie2, Htie3; trivial.
+          rewrite Heq10 in Htid1'. simpl in Htid1'.
+          rewrite !Atom.t_interp_wf in Htid1'; trivial.
+          rewrite Htie1, Htie2, Htie3 in Htid1'. simpl in Htid1'.
+
+          apply Typ.eqb_spec in H25a. apply Typ.eqb_spec in H25b.
+          apply Typ.eqb_spec in H27.  apply Typ.eqb_spec in H28.
+          apply Typ.eqb_spec in H29.
+
+          generalize dependent v_vale1. generalize dependent v_vale2.
+          generalize dependent v_vale3. generalize dependent v_vald1'.
+          rewrite H27, H28, H29.
+          rewrite !Typ.cast_refl. intros. simpl in Htid1'.
+          unfold Bval in Htid1'.
+
+
+          generalize dependent v_vale1. generalize dependent v_vale2.
+          generalize dependent v_vale3. generalize dependent v_vald1'.
+
+          rewrite H25a, H25b, H10. intros.
+          specialize (Atom.Bval_inj2 t_i (Typ.TFArray t1 t2)
+                                     (store v_vale1 v_vale2 v_vale3) (v_vald1')).
+          intro H25. specialize (H25 Htid1').
+          
+          unfold Atom.interp_form_hatom, interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Heq6. simpl.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Heq7, Heq8. simpl.
+          rewrite !Atom.t_interp_wf; trivial.
+
+          rewrite Htic1, Htic2, Htid1, Htid2.
+          subst. intros. simpl.
+          rewrite !Typ.cast_refl.
+          unfold apply_binop.
+          unfold Bval.
+          rewrite !Atom.t_interp_wf in Htib1''; trivial.
+          rewrite Htib1 in Htib1''.
+          inversion Htib1''.
+          rewrite !Atom.t_interp_wf in Htib2''; trivial.
+          rewrite Htib2 in Htib2''.
+          inversion Htib2''.
+
+          rewrite !Typ.cast_refl.
+
+          unfold interp_bool. rewrite Typ.cast_refl.
+          apply Typ.i_eqb_spec.
+
+          rewrite !Atom.t_interp_wf in Htid1''; trivial.
+          rewrite Htid1 in Htid1''.
+          inversion Htid1''.
+
+          subst.
+          rewrite (Atom.Bval_inj2 _ _ (v_vald1) (store v_vale1 v_vale2 v_vale3) Htid1'').
+          
+          rewrite Htie1 in Htic1.
+
+
+          rewrite (Atom.Bval_inj2 t_i (Typ.TFArray t1 t2) (v_vale1) (v_valc1) Htic1).
+
+          simpl in isif. rewrite !Typ.cast_refl in isif.
+          apply Typ.i_eqb_spec_false in isif.
+
+          rewrite !Atom.t_interp_wf in Htic2''; trivial.
+
+          destruct Heq11d as [((Heq11d1,Heq11d2),Heq11d3) | ((Heq11d1,Heq11d2),Heq11d3) ];
+            subst; intros;
+
+              rewrite Htid2 in Htic2;
+              rewrite <- (Atom.Bval_inj2 _ _  (v_vald2) (v_valc2) Htic2) in *. 
+          
+          + rewrite Htie2 in Htia1.
+            rewrite Htia2 in Htic2''.
+            rewrite <- (Atom.Bval_inj2 _ _ _ _ Htia1) in *.
+            rewrite (Atom.Bval_inj2 _ _ _ _ Htic2'') in *.
+            symmetry; now apply read_over_other_write.
+
+          + rewrite Htie2 in Htia2.
+            rewrite Htia1 in Htic2''.
+            rewrite <- (Atom.Bval_inj2 _ _ _ _ Htia2) in *.
+            rewrite (Atom.Bval_inj2 _ _ _ _ Htic2'') in *.
+            symmetry; apply read_over_other_write; now auto.
+
+
+        - unfold store_of_me.
+          case_eq (t_atom .[ c1]); try discriminate.
+          intros [ t5 t6 ] e1 e2 e3 Heq10 [[ti3 te3] i1].
+          case_eq (e1 == d1); try discriminate. intros Heq11d.
+          intro HT.
+          injection HT. intros E2 T6 T5 [ ]. subst i1 te3 ti3. clear HT.
+
+          case_eq (
+              Typ.eqb t t5 && Typ.eqb v_typeb1' t6 &&
+                      ((e2 == a1) && (c2 == a2) && (d2 == a2) || (e2 == a2) && (c2 == a1) && (d2 == a1)));
+            simpl; intros Heq11; try (now apply C.interp_true).
+
+          unfold C.valid. simpl. rewrite orb_false_r.
+
+          case_eq (Lit.interp rho i). intros isit.
+          easy. intros isif. rewrite orb_false_l.
+          specialize (rho_interp ( Lit.blit i)).
+          rewrite Heq3 in rho_interp.
+          simpl in rho_interp.
+          unfold Lit.interp in isif.
+          rewrite Heq in isif. unfold Var.interp in isif.
+          rewrite rho_interp in isif.
+          unfold Atom.interp_form_hatom, interp_hatom in isif.
+          rewrite Atom.t_interp_wf in isif; trivial.
+          rewrite Heq5 in isif.
+          simpl in isif.
+          unfold interp_bool in isif.
+
+          unfold Lit.interp. rewrite Heq2.
+          unfold Var.interp.
+          rewrite !wf_interp_form; trivial. rewrite Heq4. simpl.
+
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as ((Heq11a, Heq11b), Heq11c).
+          rewrite !orb_true_iff in Heq11c.
+
+          apply Typ.eqb_spec in Heq11a.
+          apply Typ.eqb_spec in Heq11b.
+          apply Int63Properties.eqb_spec in Heq11d.
+          rewrite !andb_true_iff in Heq11c.
+          rewrite !Int63Properties.eqb_spec in Heq11c.
+
+
+          rewrite !Atom.t_interp_wf in isif; trivial.
+          rewrite Htia1, Htia2 in isif. simpl in isif.
+          unfold Bval in isif.
+          rewrite !Typ.cast_refl in isif.
+          
+
+          assert (H25: c1 < PArray.length t_atom).
+          apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq10. discriminate.
+          apply H2 in H25.
+          rewrite Heq10 in H25.
+          simpl in H25.
+          rewrite !andb_true_iff in H25.
+          destruct H25 as (((H25, H29), H28), H27).
+          unfold get_type', v_type in H25, H27, H28, H29.
+
+          case_eq (t_interp .[ c1]).
+          intros v_typec1' v_valc1' Htic1'. rewrite Htic1' in H25.
+          case_eq v_typec1'; intros; rewrite H10 in H25; try now contradict H25.
+          rewrite andb_true_iff in H25; destruct H25 as (H25a, H25b).
+
+          case_eq (t_interp .[ e1]).
+          intros v_typee1 v_vale1 Htie1. rewrite Htie1 in H29.
+          case_eq (t_interp .[ e2]).
+          intros v_typee2 v_vale2 Htie2. rewrite Htie2 in H28.
+          case_eq (t_interp .[ e3]).
+          intros v_typee3 v_vale3 Htie3. rewrite Htie3 in H27.
+          pose proof Htic1' as Htic1''.
+          rewrite Atom.t_interp_wf in Htic1', Htie1, Htie2, Htie3; trivial.
+          rewrite Heq10 in Htic1'. simpl in Htic1'.
+          rewrite !Atom.t_interp_wf in Htic1'; trivial.
+          rewrite Htie1, Htie2, Htie3 in Htic1'. simpl in Htic1'.
+
+          apply Typ.eqb_spec in H25a. apply Typ.eqb_spec in H25b.
+          apply Typ.eqb_spec in H27.  apply Typ.eqb_spec in H28.
+          apply Typ.eqb_spec in H29.
+
+          generalize dependent v_vale1. generalize dependent v_vale2.
+          generalize dependent v_vale3. generalize dependent v_valc1'.
+          rewrite H27, H28, H29.
+          rewrite !Typ.cast_refl. intros. simpl in Htic1'.
+          unfold Bval in Htic1'.
+
+
+          generalize dependent v_vale1. generalize dependent v_vale2.
+          generalize dependent v_vale3. generalize dependent v_valc1'.
+
+          rewrite H25a, H25b, H10. intros.
+          specialize (Atom.Bval_inj2 t_i (Typ.TFArray t1 t2)
+                                     (store v_vale1 v_vale2 v_vale3) (v_valc1')).
+          intro H25. specialize (H25 Htic1').
+          
+          unfold Atom.interp_form_hatom, interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Heq6. simpl.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Heq7, Heq8. simpl.
+          rewrite !Atom.t_interp_wf; trivial.
+
+          rewrite Htid1, Htic2, Htic1, Htid2.
+          subst. intros. simpl.
+          rewrite !Typ.cast_refl.
+          unfold apply_binop.
+          unfold Bval.
+          rewrite !Atom.t_interp_wf in Htib1''; trivial.
+          rewrite Htib1 in Htib1''.
+          inversion Htib1''.
+          rewrite !Atom.t_interp_wf in Htib2''; trivial.
+          rewrite Htib2 in Htib2''.
+          inversion Htib2''.
+
+          rewrite !Typ.cast_refl.
+
+          unfold interp_bool. rewrite Typ.cast_refl.
+          apply Typ.i_eqb_spec.
+
+          rewrite !Atom.t_interp_wf in Htic1''; trivial.
+          rewrite Htic1 in Htic1''.
+          inversion Htic1''.
+
+          subst.
+          rewrite (Atom.Bval_inj2 _ _ (v_valc1) (store v_vale1 v_vale2 v_vale3) Htic1'').
+          
+          rewrite Htie1 in Htid1.
+
+
+          rewrite (Atom.Bval_inj2 t_i (Typ.TFArray t1 t2) (v_vale1) (v_vald1) Htid1).
+
+          apply Typ.i_eqb_spec_false in isif.
+
+          rewrite !Atom.t_interp_wf in Htic2''; trivial.
+
+          destruct Heq11c as [((Heq11c1,Heq11c2),Heq11c3) | ((Heq11c1,Heq11c2),Heq11c3) ];
+            subst; intros;
+
+              rewrite Htid2 in Htic2;
+              rewrite <- (Atom.Bval_inj2 _ _  (v_vald2) (v_valc2) Htic2) in *. 
+          
+          + rewrite Htie2 in Htia1.
+            rewrite Htia2 in Htic2''.
+            rewrite <- (Atom.Bval_inj2 _ _ _ _ Htia1) in *.
+            rewrite (Atom.Bval_inj2 _ _ _ _ Htic2'') in *.
+            now apply read_over_other_write.
+
+          + rewrite Htie2 in Htia2.
+            rewrite Htia1 in Htic2''.
+            rewrite <- (Atom.Bval_inj2 _ _ _ _ Htia2) in *.
+            rewrite (Atom.Bval_inj2 _ _ _ _ Htic2'') in *.
+            apply read_over_other_write; now auto.
+    Qed.
+
+  Axiom afold_left_or : forall a,
+    afold_left bool int false orb (Lit.interp rho) a =
+    C.interp rho (to_list a).
+
+  Require Import Psatz.
+
+  Lemma valid_check_ext lres : C.valid rho (check_ext lres).
+    unfold check_ext, eq_sel_sym.
+    case_eq (Lit.is_pos lres); intro Heq; simpl; try now apply C.interp_true.
+    case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+    intros a Heq2.
+    case_eq (length a == 2); [ intros Heq3 | intros Heq3; now apply C.interp_true].
+    case_eq (Lit.is_pos (a .[ 0]) && negb (Lit.is_pos (a .[ 1])));
+      [ intros Heq4 | intros Heq4; now apply C.interp_true].
+    case_eq (t_form .[ Lit.blit (a .[0])]); try (intros; now apply C.interp_true).
+    intros b Heq5.
+    case_eq (t_form .[ Lit.blit (a .[1])]); try (intros; now apply C.interp_true).
+    intros c Heq6.
+    case_eq (t_atom .[ b]); try (intros; now apply C.interp_true).
+    intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] b1 b2 Heq7; try (intros; now apply C.interp_true).
+    case_eq t; try (intros; now apply C.interp_true). intros t0 t1 Heq8.
+    case_eq (t_atom .[ c]); try (intros; now apply C.interp_true).
+    intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] c1 c2 Heq9; try (intros; now apply C.interp_true).
+    case_eq (Typ.eqb t1 t2); [ intros Heq10 | intros Heq10; now apply C.interp_true].
+    case_eq (t_atom .[ c1]); try (intros; now apply C.interp_true).
+    intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] d1 d2 Heq11; try (intros; now apply C.interp_true).
+    case_eq (t_atom .[ c2]); try (intros; now apply C.interp_true).
+    intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] e1 e2 Heq12; try (intros; now apply C.interp_true).
+    case_eq (t_atom .[ d2]);
+      try (intros; rewrite !andb_false_r; simpl; now apply C.interp_true).
+    intros [ | | | | | | | |N|N|N|N|N|N|N|N|N| | | | ] f1 f2 Heq14;
+      try (intros; rewrite !andb_false_r; simpl; now apply C.interp_true).
+    case_eq (Typ.eqb t0 t3 && Typ.eqb t0 t5 && Typ.eqb t1 t4 && Typ.eqb t1 t6);
+      [ intros Heq13'| intro; now apply C.interp_true].
+    simpl.
+    case_eq (Typ.eqb t0 t7 && Typ.eqb t1 t8);
+      [ intros Heq14'| intro; rewrite !andb_false_r; simpl; now apply C.interp_true].
+    simpl.
+    case_eq ((b1 == d1) && (b2 == e1) && (d2 == e2) && ((f1 == b1) && (f2 == b2))
+             || (b2 == d1) && (b1 == e1) && (d2 == e2) && ((f1 == b2) && (f2 == b1)));
+        [ intros Heq1314 | intro; now apply C.interp_true].
+
+    unfold C.valid. simpl. rewrite orb_false_r.
+
+    rewrite orb_true_iff in Heq1314.
+    rewrite !andb_true_iff in Heq13'.
+    rewrite !andb_true_iff in Heq14'.
+    rewrite !andb_true_iff in Heq1314.
+    destruct Heq13' as (((Heq13, Heq13f), Heq13a), Heq13d).
+    destruct Heq14' as (Heq15, Heq15a).
+
+    apply Typ.eqb_spec in Heq13.
+    apply Typ.eqb_spec in Heq13f.
+    apply Typ.eqb_spec in Heq13a.
+    apply Typ.eqb_spec in Heq13d.
+    apply Typ.eqb_spec in Heq15.
+    apply Typ.eqb_spec in Heq15a.
+    subst t3 t5 t4 t6 t7 t8.
+    rewrite !Int63Properties.eqb_spec in Heq1314.
+
+    unfold Lit.interp. rewrite Heq.
+    unfold Var.interp.
+    rewrite !wf_interp_form; trivial. rewrite Heq2. simpl.
+    rewrite afold_left_or.
+    unfold to_list.
+    rewrite Int63Properties.eqb_spec in Heq3.
+    rewrite Heq3.
+
+    (* for native-coq compatibility *)
+    assert (0 == 2 = false) as NCC.
+    { auto. } rewrite NCC.
+    (* simpl. *)
+    rewrite foldi_down_gt; auto.
+
+    (* simpl. *)
+    assert (2 - 1 = 1). { auto. }
+                        rewrite H.
+    rewrite foldi_down_eq; auto. 
+    simpl. rewrite orb_false_r.
+    assert (1 - 1 = 0) as Has2. { auto. }
+                                rewrite Has2.
+
+    case_eq (Lit.interp rho (a .[ 0])). intro Hisa0.
+    rewrite orb_true_l. easy. intro Hisa. rewrite orb_false_l.
+
+    pose proof (rho_interp (Lit.blit (a .[ 0]))).
+    pose proof (rho_interp (Lit.blit (a .[ 1]))).
+
+    rewrite Heq5 in H0. rewrite Heq6 in H1.
+    simpl in H0, H1.
+    unfold Lit.interp.
+    rewrite andb_true_iff in Heq4.
+    destruct Heq4 as (Heq4, Heq4a).
+    apply negb_true_iff in Heq4a.
+
+    unfold Lit.interp in Hisa.
+    rewrite Heq4 in Hisa. unfold Var.interp in Hisa.
+    rewrite Hisa in H0. symmetry in H0.
+    rewrite Heq4a.
+    unfold Var.interp.
+    rewrite H1.
+
+    generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+    rewrite PArray.forallbi_spec;intros.
+
+    (* b *)
+    pose proof (H2 b). assert (b < PArray.length t_atom).
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq7. easy.
+    specialize (H3 H4). simpl in H3.
+    rewrite Heq7 in H3. simpl in H3.
+    rewrite !andb_true_iff in H3. destruct H3. destruct H3.
+    unfold get_type' in H3, H5, H6. unfold v_type in H3, H5, H6.
+
+    case_eq (t_interp .[ b]).
+    intros v_typeb v_valb Htib. rewrite Htib in H3.
+    pose proof Htib as Htib''.
+    case_eq v_typeb; intros; rewrite H7 in H3; try now contradict H3.
+
+    case_eq (t_interp .[ b1]).
+    intros v_typeb1 v_valb1 Htib1. rewrite Htib1 in H6.
+    pose proof Htib1 as Htib1''.
+    case_eq (t_interp .[ b2]).
+    intros v_typeb2 v_valb2 Htib2. rewrite Htib2 in H5.
+    pose proof Htib2 as Htib2''.
+    rewrite Atom.t_interp_wf in Htib; trivial.
+    rewrite Atom.t_interp_wf in Htib1; trivial.
+    rewrite Atom.t_interp_wf in Htib2; trivial.
+    rewrite Heq7 in Htib. simpl in Htib.
+    rewrite !Atom.t_interp_wf in Htib; trivial.
+    rewrite Htib1, Htib2 in Htib.
+    unfold apply_binop in Htib.
+    apply Typ.eqb_spec in H5.
+    apply Typ.eqb_spec in H6.
+
+    generalize dependent v_valb1. generalize dependent v_valb2.
+    generalize dependent v_valb.
+    rewrite H5, H6, H7. rewrite !Typ.cast_refl. intros.
+
+    specialize (Atom.Bval_inj2 t_i (Typ.Tbool) (Typ.i_eqb t_i t v_valb1 v_valb2) (v_valb)).
+    intros. specialize (H8 Htib).
+
+    (* c *)
+    pose proof (H2 c). assert (c < PArray.length t_atom).
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy.
+    specialize (H9 H10). simpl in H9.
+    rewrite Heq9 in H9. simpl in H9.
+    rewrite !andb_true_iff in H9. destruct H9. destruct H9.
+    unfold get_type' in H9, H11, H12. unfold v_type in H9, H11, H12.
+
+    case_eq (t_interp .[ c]).
+    intros v_typec v_valc Htic. rewrite Htic in H9.
+    pose proof Htic as Htic''.
+    case_eq v_typec; intros; rewrite H13 in H9; try now contradict H9.
+
+    case_eq (t_interp .[ c1]).
+    intros v_typec1 v_valc1 Htic1. rewrite Htic1 in H12.
+    case_eq (t_interp .[ c2]).
+    intros v_typec2 v_valc2 Htic2. rewrite Htic2 in H11.
+    rewrite Atom.t_interp_wf in Htic; trivial.
+    rewrite Atom.t_interp_wf in Htic1; trivial.
+    rewrite Atom.t_interp_wf in Htic2; trivial.
+    rewrite Heq9 in Htic. simpl in Htic.
+    rewrite !Atom.t_interp_wf in Htic; trivial.
+    rewrite Htic1, Htic2 in Htic. simpl in Htic.
+
+    apply Typ.eqb_spec in H11. apply Typ.eqb_spec in H12.
+
+    generalize dependent v_valc1. generalize dependent v_valc2.
+    generalize dependent v_valc.
+    rewrite H11, H12, H13.
+    rewrite !Typ.cast_refl. intros. simpl in Htic.
+    unfold Bval in Htic.
+
+    specialize (Atom.Bval_inj2 t_i (Typ.Tbool) (Typ.i_eqb t_i t2 v_valc1 v_valc2) (v_valc)).
+    intros. specialize (H14 Htic).
+
+    (* c1 *)
+    pose proof (H2 c1). assert (c1 < PArray.length t_atom).
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq11. easy.
+    specialize (H15 H16). simpl in H15.
+    rewrite Heq11 in H15. simpl in H15.
+    rewrite !andb_true_iff in H15. destruct H15. destruct H15.
+    unfold get_type' in H15, H17, H18. unfold v_type in H15, H17, H18.
+
+    case_eq (t_interp .[ c1]).
+    intros v_typec1' v_valc1' Htic1'. rewrite Htic1' in H15.
+    pose proof Htic1' as Htic1'''.
+
+    case_eq (t_interp .[ d1]).
+    intros v_typed1 v_vald1 Htid1. rewrite Htid1 in H18.
+    case_eq (t_interp .[ d2]).
+    intros v_typed2 v_vald2 Htid2. rewrite Htid2 in H17.
+    rewrite Atom.t_interp_wf in Htic1'; trivial.
+    rewrite Atom.t_interp_wf in Htid1; trivial.
+    rewrite Atom.t_interp_wf in Htid2; trivial.
+    rewrite Heq11 in Htic1'. simpl in Htic1'.
+    rewrite !Atom.t_interp_wf in Htic1'; trivial.
+    rewrite Htid1, Htid2 in Htic1'. simpl in Htic1'.
+
+    apply Typ.eqb_spec in H15. apply Typ.eqb_spec in H17.
+    apply Typ.eqb_spec in H18.
+
+    generalize dependent v_vald1. generalize dependent v_vald2.
+    generalize dependent v_valc1'.
+
+    rewrite H15, H17, H18.
+    unfold Bval. rewrite <- H15.
+    rewrite !Typ.cast_refl. intros.
+
+    specialize (Atom.Bval_inj2 t_i t1 (select v_vald1 v_vald2) (v_valc1')).
+    intros. specialize (H19 Htic1').
+
+    (* c2 *)
+    pose proof (H2 c2). assert (c2 < PArray.length t_atom).
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq12. easy.
+    specialize (H20 H21). simpl in H20.
+    rewrite Heq12 in H20. simpl in H20.
+    rewrite !andb_true_iff in H20. destruct H20. destruct H20.
+    unfold get_type' in H20, H22, H23. unfold v_type in H20, H22, H23.
+
+    case_eq (t_interp .[ c2]).
+    intros v_typec2' v_valc2' Htic2'. rewrite Htic2' in H20.
+    pose proof Htic2' as Htic2'''.
+
+    case_eq (t_interp .[ e1]).
+    intros v_typee1 v_vale1 Htie1. rewrite Htie1 in H23.
+    case_eq (t_interp .[ e2]).
+    intros v_typee2 v_vale2 Htie2. rewrite Htie2 in H22.
+    pose proof Htie2 as Htie2''.
+    rewrite Atom.t_interp_wf in Htic2'; trivial.
+    rewrite Atom.t_interp_wf in Htie1; trivial.
+    rewrite Atom.t_interp_wf in Htie2; trivial.
+    rewrite Heq12 in Htic2'. simpl in Htic2'.
+    rewrite !Atom.t_interp_wf in Htic2'; trivial.
+    rewrite Htie1, Htie2 in Htic2'. simpl in Htic2'.
+
+    apply Typ.eqb_spec in H20. apply Typ.eqb_spec in H22.
+    apply Typ.eqb_spec in H23.
+
+    generalize dependent v_valc1'. generalize dependent v_valc2'.
+    generalize dependent v_vale1. generalize dependent v_vale2.
+
+    rewrite H22. rewrite H20 in *. rewrite H23.
+    unfold Bval. rewrite <- H20.
+    rewrite !Typ.cast_refl. intros.
+
+    specialize (Atom.Bval_inj2 t_i t1 (select v_vale1 v_vale2) (v_valc2')).
+    intros. specialize (H24 Htic2').
+
+    (* d2 *)
+    pose proof (H2 d2). assert (d2 < PArray.length t_atom).
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq14. easy.
+    specialize (H25 H26). simpl in H25.
+    rewrite Heq14 in H25. simpl in H25.
+    rewrite !andb_true_iff in H25. destruct H25. destruct H25.
+    unfold get_type' in H25, H27, H28. unfold v_type in H25, H27, H28.
+
+    case_eq (t_interp .[ d2]).
+    intros v_typed2' v_vald2' Htid2'. rewrite Htid2' in H25.
+    pose proof Htid2' as Htid2'''.
+
+    case_eq (t_interp .[ f1]).
+    intros v_typef1 v_valf1 Htif1. rewrite Htif1 in H28.
+    case_eq (t_interp .[ f2]).
+    intros v_typef2 v_valf2 Htif2. rewrite Htif2 in H27.
+    rewrite Atom.t_interp_wf in Htid2'; trivial.
+    rewrite Atom.t_interp_wf in Htif1; trivial.
+    rewrite Atom.t_interp_wf in Htif2; trivial.
+    rewrite Heq14 in Htid2'. simpl in Htid2'.
+    rewrite !Atom.t_interp_wf in Htid2'; trivial.
+    rewrite Htif1, Htif2 in Htid2'. simpl in Htid2'.
+
+    apply Typ.eqb_spec in H25. apply Typ.eqb_spec in H27.
+    apply Typ.eqb_spec in H28.
+
+    generalize dependent v_valf1. generalize dependent v_valf2.
+    generalize dependent v_vald2'.
+
+    rewrite H25, H27, H28.
+    unfold Bval. rewrite <- H25.
+    rewrite !Typ.cast_refl. intros.
+
+    specialize (Atom.Bval_inj2 t_i t0 (diff v_valf1 v_valf2) (v_vald2')).
+    intros. specialize (H29 Htid2').
+
+    (* semantics *)
+
+    unfold Atom.interp_form_hatom, interp_hatom.
+    rewrite !Atom.t_interp_wf; trivial.
+    rewrite Heq9. simpl.
+    rewrite !Atom.t_interp_wf; trivial.
+    rewrite  Heq11, Heq12. simpl.
+
+    unfold apply_binop.
+    rewrite !Atom.t_interp_wf; trivial.
+    rewrite Htid1, Heq14, Htie1, Htie2.
+    rewrite !Typ.cast_refl.
+    simpl. (* (* native-coq compatibility *) unfold interp_atom. *)
+    rewrite !Atom.t_interp_wf; trivial.
+    rewrite Htif1, Htif2. simpl.
+    rewrite !Typ.cast_refl. simpl.
+
+    rewrite !Atom.t_interp_wf in Htid2'''; trivial.
+    rewrite Htid2 in Htid2'''.
+    inversion Htid2'''.
+
+    rewrite !Atom.t_interp_wf in Htic1'''; trivial.
+    rewrite Htic1 in Htic1'''.
+    inversion Htic1'''.
+
+    rewrite !Atom.t_interp_wf in Htic2'''; trivial.
+    rewrite Htic2 in Htic2'''.
+    inversion Htic2'''.
+
+    generalize dependent v_valc1. generalize dependent v_valc2.
+    generalize dependent v_valc1'. generalize dependent v_valc2'.
+    generalize dependent v_vald1. generalize dependent v_vald2.
+
+    subst.
+    rewrite !Typ.cast_refl. simpl.
+    rewrite !Typ.cast_refl. intros. simpl.
+
+    apply negb_true_iff.
+    apply Typ.i_eqb_spec_false.
+    subst.
+    specialize (Atom.Bval_inj2 t_i v_typed2' (v_vald2) (diff v_valf1 v_valf2)).
+    intros. specialize (H5 Htid2''').
+    rewrite <- H5.
+    specialize (Atom.Bval_inj2 t_i v_typed2' (v_vale2) (v_vald2)).
+    intros.
+
+    unfold Atom.interp_form_hatom, interp_hatom in H0.
+    rewrite !Atom.t_interp_wf in H0; trivial.
+    rewrite Heq7 in H0. simpl in H0.
+    rewrite !Atom.t_interp_wf in H0; trivial.
+    rewrite Htib1, Htib2 in H0. simpl in H0.
+    rewrite !Typ.cast_refl in H0. simpl in H0.
+    apply Typ.i_eqb_spec_false in H0.
+
+
+    destruct Heq1314 as [Heq1314 | Heq1314];
+      destruct Heq1314 as (((Heq13a, Heq13b), Heq13c), (Heq13d, Heq13e));
+      subst.
+
+    - rewrite Htie2 in Htid2.
+      rewrite Htid1 in Htib1.
+      rewrite Htie1 in Htib2.
+      rewrite Htid1 in Htif1.
+      rewrite Htie1 in Htif2.
+
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htib1) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htib2) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htif1) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htif2) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htid2) in *.
+
+      now apply select_at_diff.
+
+    - rewrite Htie2 in Htid2.
+      rewrite Htid1 in Htib2.
+      rewrite Htie1 in Htib1.
+      rewrite Htid1 in Htif1.
+      rewrite Htie1 in Htif2.
+
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htib1) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htib2) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htif1) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htif2) in *.
+      rewrite (Atom.Bval_inj2 t_i _ _ _ Htid2) in *.
+
+      apply select_at_diff.
+      red in H0. red. intro. apply H0. auto.
+  Qed.
+  
+  End Correct.
+
+End certif.
diff --git a/src/array/FArray.v b/src/array/FArray.v
new file mode 100644
index 0000000..8b1701f
--- /dev/null
+++ b/src/array/FArray.v
@@ -0,0 +1,1863 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool OrderedType SMT_classes.
+Require Import ProofIrrelevance.
+
+(** This file formalizes functional arrays with extensionality as specified in
+    SMT-LIB 2. It gives realization to axioms that define the SMT-LIB theory of
+    arrays. For this, it uses a formalization of maps with the same approach as
+    FMaplist excepted that constraints on keys and elements are expressed
+    through the use of typeclasses instead of functors. *)
+
+Set Implicit Arguments.
+
+(** Raw maps (see FMaplist) *)
+Module Raw.
+
+  Section Array.
+
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+
+  Definition eqb_key (x y : key) : bool := if eq_dec x y then true else false.
+  Definition eqb_elt (x y : elt) : bool := if eq_dec x y then true else false.
+
+  Lemma eqb_key_eq x y : eqb_key x y = true <-> x = y.
+  Proof. unfold eqb_key. case (eq_dec x y); split; easy. Qed.
+
+  Lemma eqb_elt_eq x y : eqb_elt x y = true <-> x = y.
+  Proof. unfold eqb_elt. case (eq_dec x y); split; easy. Qed.
+
+  Hint Immediate eqb_key_eq eqb_elt_eq.
+
+  Definition farray := list (key * elt).
+
+  Definition eqk (a b : (key * elt)) := fst a = fst b.
+  Definition eqe (a b : (key * elt)) := snd a = snd b.
+  Definition eqke (a b : (key * elt)) := fst a = fst b /\ snd a = snd b.
+
+  Definition ltk (a b : (key * elt)) := lt (fst a) (fst b).
+
+  (* Definition ltke (a b : (key * elt)) := *)
+  (*   lt (fst a) (fst b) \/ ( (fst a) = (fst b) /\ lt (snd a) (snd b)). *)
+
+  Hint Unfold ltk (* ltke *) eqk eqke.
+  Hint Extern 2 (eqke ?a ?b) => split.
+
+  Global Instance lt_key_strorder : StrictOrder (lt : key -> key -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  Global Instance lt_elt_strorder : StrictOrder (lt : elt -> elt -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  Global Instance ke_dec : DecType (key * elt).
+  Proof.
+    split; auto.
+    intros; destruct x, y, z.
+    inversion H. inversion H0. trivial.
+    intros; destruct x, y.
+    destruct (eq_dec k k0).
+    destruct (eq_dec e e0).
+    left; rewrite e1, e2; auto.
+    right; unfold not in *. intro; inversion H. exact (n H2).
+    right; unfold not in *. intro; inversion H. exact (n H1).
+  Qed.
+
+  Global Instance ke_ord: OrdType (key * elt).
+  Proof.
+    exists ltk; unfold ltk; intros.
+    apply (lt_trans _ (fst y)); auto.
+    destruct x, y. simpl in H.
+    unfold not. intro. inversion H0.
+    apply (lt_not_eq k k0); auto.
+  Qed.
+
+  (* ltk ignore the second components *)
+
+   Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e').
+   Proof. auto. Qed.
+
+   Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x.
+   Proof. auto. Qed.
+   Hint Immediate ltk_right_r ltk_right_l.
+
+  Notation Sort := (sort ltk).
+  Notation Inf := (lelistA (ltk)).
+
+  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+  Definition In k m := exists e:elt, MapsTo k e m.
+
+  Notation NoDupA := (NoDupA eqk).
+
+  Hint Unfold MapsTo In.
+
+  (* Instance ke_ord: OrdType (key * elt). *)
+  (* Proof. *)
+  (*   exists ltke. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct H, H0. *)
+  (*   left; apply (lt_trans _ (fst y)); auto. *)
+  (*   destruct H0. left. rewrite <- H0. assumption. *)
+  (*   destruct H. left. rewrite H. assumption. *)
+  (*   destruct H, H0. *)
+  (*   right. split. *)
+  (*   apply (eq_trans _ (fst y)); trivial. *)
+  (*   apply (lt_trans _ (snd y)); trivial. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct x, y. simpl in H. *)
+  (*   destruct H. *)
+  (*   apply lt_not_eq in H. *)
+  (*   unfold not in *. intro. inversion H0. apply H. trivial. *)
+  (*   destruct H. apply lt_not_eq in H0. unfold not in *. intro.  *)
+  (*   inversion H1. apply H0; trivial. *)
+  (*   intros. *)
+  (*   unfold ltke. *)
+  (*   destruct (compare (fst x) (fst y)). *)
+  (*   apply LT. left; assumption. *)
+  (*   destruct (compare (snd x) (snd y)). *)
+  (*   apply LT. right; split; assumption. *)
+  (*   apply EQ. destruct x, y. simpl in *. rewrite e, e0; trivial. *)
+  (*   apply GT. right; symmetry in e; split; assumption. *)
+  (*   apply GT. left; assumption. *)
+  (* Qed. *)
+
+  (* Hint Immediate ke_ord. *)
+  (* Let ke_ord := ke_ord. *)
+
+  (* Instance keyelt_ord: OrdType (key * elt). *)
+
+
+  (* Variable keyelt_ord : OrdType (key * elt). *)
+   (* eqke is stricter than eqk *)
+
+   Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
+   Proof.
+     unfold eqk, eqke; intuition.
+   Qed.
+
+  (* eqk, eqke are equalities *)
+
+  Lemma eqk_refl : forall e, eqk e e.
+  Proof. auto. Qed.
+
+  Lemma eqke_refl : forall e, eqke e e.
+  Proof. auto. Qed.
+
+  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
+  Proof. auto. Qed.
+
+  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
+  Proof. unfold eqke; intuition. Qed.
+
+  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
+  Proof.
+    unfold eqke; intuition; [ eauto | congruence ].
+  Qed.
+
+  Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''.
+  Proof. eauto. Qed.
+
+  Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'.
+  Proof. unfold ltk, eqk. intros. apply lt_not_eq; auto. Qed.
+
+  Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'.
+  Proof.
+    unfold eqke, ltk; intuition; simpl in *; subst.
+    apply lt_not_eq in H. auto.
+  Qed.
+
+  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+  Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
+  Hint Immediate eqk_sym eqke_sym.
+
+  Global Instance eqk_equiv : Equivalence eqk.
+  Proof. split; eauto. Qed.
+
+  Global Instance eqke_equiv : Equivalence eqke.
+  Proof. split; eauto. Qed.
+
+  Global Instance ltk_strorder : StrictOrder ltk.
+  Proof.
+    split.
+    unfold Irreflexive, Reflexive, complement.
+    intros. apply lt_not_eq in H; auto.
+    unfold Transitive. intros x y z. apply lt_trans.
+  Qed.
+
+  (* Instance ltke_strorder : StrictOrder ltke. *)
+  (* Proof. *)
+  (*   split. *)
+  (*   unfold Irreflexive, Reflexive, complement. *)
+  (*   intros. apply lt_not_eq in H; auto. *)
+  (*   unfold Transitive. apply lt_trans. *)
+  (* Qed. *)
+
+  Global Instance eq_equiv : @Equivalence (key * elt) eq.
+  Proof.
+    split; auto.
+    unfold Transitive. apply eq_trans.
+  Qed.
+
+  (* Instance ltke_compat : Proper (eq ==> eq ==> iff) ltke. *)
+  (* Proof. *)
+  (*   split; rewrite H, H0; trivial. *)
+  (* Qed. *)
+
+  Global Instance ltk_compat : Proper (eq ==> eq ==> iff) ltk.
+  Proof.
+    split; rewrite H, H0; trivial.
+  Qed.
+
+  Global Instance ltk_compatk : Proper (eqk==>eqk==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') Hxx' (y,f) (y',f') Hyy'; compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+  Global Instance ltk_compat' : Proper (eqke==>eqke==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') (Hxx',_) (y,f) (y',f') (Hyy',_); compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+  Global Instance ltk_asym : Asymmetric ltk.
+  Proof. apply (StrictOrder_Asymmetric ltk_strorder). Qed.
+
+  (* Additional facts *)
+
+  Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
+  Proof.
+    unfold eqk, ltk.
+    unfold not. intros x x' H.
+    destruct x, x'. simpl in *.
+    intro.
+    symmetry in H.
+    apply lt_not_eq in H. auto.
+    subst. auto.
+  Qed.
+
+  Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''.
+  Proof. unfold ltk, eqk. destruct e, e', e''. simpl.
+    intros; subst; trivial.
+  Qed.
+
+  Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''.
+  Proof.
+    intros (k,e) (k',e') (k'',e'').
+    unfold ltk, eqk; simpl; intros; subst; trivial.
+  Qed.
+  Hint Resolve eqk_not_ltk.
+  Hint Immediate ltk_eqk eqk_ltk.
+  
+  Lemma InA_eqke_eqk :
+     forall x m, InA eqke x m -> InA eqk x m.
+  Proof.
+    unfold eqke; induction 1; intuition.
+  Qed.
+
+  Hint Resolve InA_eqke_eqk.
+
+  (* Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m. *)
+  (* Proof. *)
+  (*  intros; apply InA_eqA with p; auto with *. *)
+  (* Qed. *)
+
+  (* Lemma In_eq : forall l x y, eq x y -> InA eqke x l -> InA eqke y l. *)
+  (* Proof. intros. rewrite <- H; auto. Qed. *)
+
+  (* Lemma ListIn_In : forall l x, List.In x l -> InA eqk x l. *)
+  (* Proof. apply In_InA. split; auto. unfold Transitive. *)
+  (*   unfold eqk; intros. rewrite H, <- H0. auto. *)
+  (* Qed. *)
+  
+  (* Lemma Inf_lt : forall l x y, ltk x y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_ltA ltk_strorder). Qed. *)
+
+  (* Lemma Inf_eq : forall l x y, x = y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_eqA eq_equiv ltk_compat). Qed. *)
+
+  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
+
+  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
+  Proof.
+  firstorder.
+  exists x; auto.
+  induction H.
+  destruct y.
+  exists e; auto.
+  destruct IHInA as [e H0].
+  exists e; auto.
+  Qed.
+
+  Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
+  Proof.
+  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto with *.
+  Qed.
+
+  Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+  Proof.
+  destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
+  Qed.
+
+  Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_eqA eqk_equiv ltk_compatk). Qed.
+
+  Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_ltA ltk_strorder). Qed.
+
+  Hint Immediate Inf_eq.
+  Hint Resolve Inf_lt.
+
+  Lemma Sort_Inf_In :
+    forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p.
+  Proof.
+    exact (SortA_InfA_InA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+  Lemma Sort_Inf_NotIn :
+    forall l k e, Sort l -> Inf (k,e) l ->  ~In k l.
+  Proof.
+    intros; red; intros.
+    destruct H1 as [e' H2].
+    elim (@ltk_not_eqk (k,e) (k,e')).
+    eapply Sort_Inf_In; eauto.
+    red; simpl; auto.
+  Qed.
+
+  Hint Resolve Sort_Inf_NotIn.
+
+  Lemma Sort_NoDupA: forall l, Sort l -> NoDupA l.
+  Proof.
+    exact (SortA_NoDupA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+  Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'.
+  Proof.
+    inversion 1; intros; eapply Sort_Inf_In; eauto.
+  Qed.
+
+  Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) ->
+                                   ltk e e' \/ eqk e e'.
+  Proof.
+    inversion_clear 2; auto.
+    left; apply Sort_In_cons_1 with l; auto.
+  Qed.
+
+  Lemma Sort_In_cons_3 :
+    forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k.
+  Proof.
+    inversion_clear 1; red; intros.
+    destruct (Sort_Inf_NotIn H0 H1 (In_eq H2 H)).
+  Qed.
+
+  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l.
+  Proof.
+    inversion 1.
+    inversion_clear H0; eauto.
+    destruct H1; simpl in *; intuition.
+  Qed.
+
+  Lemma In_inv_2 : forall k k' e e' l,
+      InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Lemma In_inv_3 : forall x x' l,
+      InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Hint Resolve In_inv_2 In_inv_3.
+
+  (** * FMAPLIST interface implementaion  *)
+
+  (** * [empty] *)
+
+  Definition empty : farray := nil.
+
+  Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+    unfold Empty,empty.
+    intros a e.
+    intro abs.
+    inversion abs.
+  Qed.
+  Hint Resolve empty_1.
+
+  Lemma empty_sorted : Sort empty.
+  Proof.
+    unfold empty; auto.
+  Qed.
+
+  Lemma MapsTo_inj : forall x e e' l (Hl:Sort l),
+      MapsTo x e l -> MapsTo x e' l -> e = e'.
+    induction l.
+    - intros. apply empty_1 in H. contradiction.
+    - intros.
+      destruct a as (y, v).
+      pose proof H as HH.
+      pose proof H0 as HH0.
+      unfold MapsTo in H.
+      apply InA_eqke_eqk in H.
+      apply InA_eqke_eqk in H0.
+      apply (Sort_In_cons_2 Hl) in H.
+      apply (Sort_In_cons_2 Hl) in H0.
+      destruct H, H0.
+      + apply ltk_not_eqk in H.
+        apply ltk_not_eqk in H0.
+        assert (~ eqk (x, e) (y, v)). unfold not in *. intros. apply H. now apply eqk_sym.
+        assert (~ eqk (x, e') (y, v)). unfold not in *. intros. apply H. now apply eqk_sym.
+        specialize (In_inv_3 HH0 H2).
+        specialize (In_inv_3 HH H1).
+        inversion_clear Hl.
+        apply (IHl H3).
+      + apply ltk_not_eqk in H.
+        unfold eqk in H, H0; simpl in H, H0. contradiction.
+      + apply ltk_not_eqk in H0.
+        unfold eqk in H, H0; simpl in H, H0. contradiction.
+      + unfold eqk in H, H0. simpl in *. subst.
+        inversion_clear HH.
+        inversion_clear HH0.
+        unfold eqke in *. simpl in *. destruct H, H1; subst; auto.
+        apply InA_eqke_eqk in H1.
+        inversion_clear Hl.
+        specialize (Sort_Inf_In H2 H3 H1).
+        unfold ltk. simpl. intro. apply lt_not_eq in H4. contradiction.
+        apply InA_eqke_eqk in H.
+        inversion_clear Hl.
+        specialize (Sort_Inf_In H1 H2 H).
+        unfold ltk. simpl. intro. apply lt_not_eq in H3. contradiction.
+  Qed.
+
+  (** * [is_empty] *)
+
+  Definition is_empty (l : farray) : bool := if l then true else false.
+
+  Lemma is_empty_1 :forall m, Empty m -> is_empty m = true.
+  Proof.
+    unfold Empty, MapsTo.
+    intros m.
+    case m;auto.
+    intros (k,e) l inlist.
+    absurd (InA eqke (k, e) ((k, e) :: l));auto.
+  Qed.
+
+  Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
+  Proof.
+    intros m.
+    case m;auto.
+    intros p l abs.
+    inversion abs.
+  Qed.
+
+  (** * [mem] *)
+
+  Function mem (k : key) (s : farray) {struct s} : bool :=
+    match s with
+    | nil => false
+    | (k',_) :: l =>
+      match compare k k' with
+      | LT _ => false
+      | EQ _ => true
+      | GT _ => mem k l
+      end
+    end.
+
+  Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm.
+    functional induction (mem x m);intros sorted belong1;trivial.
+
+    inversion belong1. inversion H.
+
+    absurd (In x ((k', _x) :: l));try assumption.
+    apply Sort_Inf_NotIn with _x;auto.
+
+    apply IHb.
+    elim (sort_inv sorted);auto.
+    elim (In_inv belong1);auto.
+    intro abs.
+    absurd (eq x k'); auto.
+    symmetry in abs.
+    apply lt_not_eq in abs; auto.
+  Qed.
+
+  Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm; unfold In,MapsTo.
+    functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail).
+    exists _x; auto.
+    induction IHb; auto.
+    exists x0; auto.
+    inversion_clear sorted; auto.
+  Qed.
+
+  Lemma mem_3 : forall m (Hm:Sort m) x, mem x m = false -> ~ In x m.
+    intros.
+    rewrite <- not_true_iff_false in H.
+    unfold not in *. intros; apply H.
+    now apply mem_1.
+  Qed.
+
+  (** * [find] *)
+
+  Function find (k:key) (s: farray) {struct s} : option elt :=
+    match s with
+    | nil => None
+    | (k',x)::s' =>
+      match compare k k' with
+      | LT _ => None
+      | EQ _ => Some x
+      | GT _ => find k s'
+      end
+    end.
+
+  Lemma find_2 :  forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof.
+    intros m x. unfold MapsTo.
+    functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto.
+  Qed.
+
+  Lemma find_1 :  forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e.
+  Proof.
+    intros m Hm x e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (find x m);simpl; subst; try clear H_eq_1.
+
+    inversion 2.
+
+    inversion_clear 2.
+    clear e1;compute in H0; destruct H0.
+    apply lt_not_eq in H; auto. now contradict H.
+
+    clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply (lt_trans k') in _x; auto.
+    apply lt_not_eq in _x.
+    now contradict _x.
+
+    clear e1;inversion_clear 2.
+    compute in H0; destruct H0; intuition congruence.
+    generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply lt_not_eq in H. now contradict H.
+
+    clear e1; do 2 inversion_clear 1; auto.
+    compute in H2; destruct H2.
+    (* order. *)
+    subst. apply lt_not_eq in _x. now contradict _x.
+  Qed.
+
+  (** * [add] *)
+
+  Function add (k : key) (x : elt) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => (k,x) :: nil
+    | (k',y) :: l =>
+      match compare k k' with
+      | LT _ => (k,x)::s
+      | EQ _ => (k,x)::l
+      | GT _ => (k',y) :: add k x l
+      end
+    end.
+
+  Lemma add_1 : forall m x y e, eq x y -> MapsTo y e (add x e m).
+  Proof.
+    intros m x y e; generalize y; clear y.
+    unfold MapsTo.
+    functional induction (add x e m);simpl;auto.
+  Qed.
+
+  Lemma add_2 : forall m x y e e',
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof.
+    intros m x  y e e'.
+    generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m) ;simpl;auto;  clear e0.
+    subst;auto.
+
+    intros y' e'' eqky';  inversion_clear 1;  destruct H0; simpl in *.
+    (* order. *)
+    subst. now contradict eqky'.
+    auto.
+    auto.
+    intros y' e'' eqky'; inversion_clear 1; intuition.
+  Qed.
+
+  Lemma add_3 : forall m x y e e',
+      ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof.
+    intros m x y e e'. generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m);simpl; intros.
+    apply (In_inv_3 H0); compute; auto.
+    apply (In_inv_3 H0); compute; auto.
+    constructor 2; apply (In_inv_3 H0); compute; auto.
+    inversion_clear H0; auto.
+  Qed.
+
+  Lemma add_Inf : forall (m:farray)(x x':key)(e e':elt),
+      Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0,H1.
+    simpl; case (compare x x''); intuition.
+  Qed.
+  Hint Resolve add_Inf.
+
+  Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+    constructor; auto.
+    apply Inf_eq with (x',e'); auto.
+  Qed.
+
+  (** * [remove] *)
+
+  Function remove (k : key) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => nil
+    | (k',x) :: l =>
+      match compare k k' with
+      | LT _ => s
+      | EQ _ => l
+      | GT _ => (k',x) :: remove k l
+      end
+    end.
+
+  Lemma remove_1 : forall m (Hm:Sort m) x y, eq x y -> ~ In y (remove x m).
+  Proof.
+    intros m Hm x y; generalize Hm; clear Hm.
+    functional induction (remove x m);simpl;intros;subst.
+
+    red; inversion 1; inversion H0.
+
+    apply Sort_Inf_NotIn with x0; auto.
+
+    clear e0. inversion Hm. subst.
+    apply Sort_Inf_NotIn with x0; auto.
+
+    (* clear e0;inversion_clear Hm. *)
+    (* apply Sort_Inf_NotIn with x0; auto. *)
+    (* apply Inf_eq with (k',x0);auto; compute; apply eq_trans with x; auto. *)
+
+    clear e0;inversion_clear Hm.
+    assert (notin:~ In y (remove y l)) by auto.
+    intros (x1,abs).
+    inversion_clear abs.
+    compute in H1; destruct H1.
+    subst. apply lt_not_eq in _x; now contradict _x.
+    apply notin; exists x1; auto.
+  Qed.
+
+
+  Lemma remove_2 : forall m (Hm:Sort m) x y e,
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+
+    inversion_clear 3; auto.
+    compute in H1; destruct H1.
+    subst; now contradict H.
+    inversion_clear 1; inversion_clear 2; auto.
+  Qed.
+
+  Lemma remove_3 : forall m (Hm:Sort m) x y e,
+      MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto.
+    inversion_clear 1; inversion_clear 1; auto.
+  Qed.
+
+  Lemma remove_4_aux : forall m (Hm:Sort m) x y,
+      ~ eq x y -> In y m -> In y (remove x m).
+  Proof.
+    intros m Hm x y; generalize Hm; clear Hm.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+    rewrite In_alt.
+    inversion_clear 3; auto.
+    inversion H2.
+    unfold eqk in H3. simpl in H3. subst. now contradict H0.
+    apply In_alt.
+    exists x1. auto.
+    apply lt_not_eq in _x.
+    intros.
+    inversion_clear Hm.
+    inversion_clear H0.
+    unfold MapsTo in H3.
+    apply InA_eqke_eqk in H3.
+    unfold In.
+    destruct (eq_dec k' y).
+    exists x0.
+    apply InA_cons_hd.
+    split; simpl; auto.
+    inversion H3.
+    unfold eqk in H4. simpl in H4; subst. now contradict n.
+    assert ((exists e : elt, MapsTo y e (remove x l)) -> (exists e : elt, MapsTo y e ((k', x0) :: remove x l))).
+    intros.
+    destruct H6. exists x2.
+    apply InA_cons_tl. auto.
+    apply H6.
+    apply IHf; auto.
+    apply In_alt.
+    exists x1. auto.
+  Qed.
+
+  Lemma remove_4 : forall m (Hm:Sort m) x y,
+      ~ eq x y -> In y m <-> In y (remove x m).
+  Proof.
+    split.
+    apply remove_4_aux; auto.
+    revert H.
+    generalize Hm; clear Hm.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+    intros.
+    (* rewrite In_alt in *. *)
+    destruct H0 as (e, H0).
+    exists e.
+    apply InA_cons_tl. auto.
+    intros.
+    apply lt_not_eq in _x.
+    inversion_clear Hm.
+    apply In_inv in H0.
+    destruct H0.
+    (* destruct (eq_dec k' y). *)
+    exists x0.
+    apply InA_cons_hd. split; simpl; auto.
+    specialize (IHf H1 H H0).
+    inversion IHf.
+    exists x1.
+    apply InA_cons_tl. auto.
+  Qed.
+
+  Lemma remove_Inf : forall (m:farray)(Hm : Sort m)(x x':key)(e':elt),
+      Inf (x',e') m -> Inf (x',e') (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0.
+    simpl; case (compare x x''); intuition.
+    inversion_clear Hm.
+    apply Inf_lt with (x'',e''); auto.
+  Qed.
+  Hint Resolve remove_Inf.
+
+  Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+  Qed.
+
+  (** * [elements] *)
+
+  Definition elements (m: farray) := m.
+
+  Lemma elements_1 : forall m x e,
+      MapsTo x e m -> InA eqke (x,e) (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_2 : forall m x e,
+      InA eqke (x,e) (elements m) -> MapsTo x e m.
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3w : forall m (Hm:Sort m), NoDupA (elements m).
+  Proof.
+    intros.
+    apply Sort_NoDupA.
+    apply elements_3; auto.
+  Qed.
+
+  (** * [fold] *)
+
+  Function fold (A:Type)(f:key->elt->A->A)(m:farray) (acc:A) {struct m} :  A :=
+    match m with
+    | nil => acc
+    | (k,e)::m' => fold f m' (f k e acc)
+    end.
+
+  Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof.
+    intros; functional induction (fold f m i); auto.
+  Qed.
+
+  (** * [equal] *)
+
+  Function equal (cmp:elt->elt->bool)(m m' : farray) {struct m} : bool :=
+    match m, m' with
+    | nil, nil => true
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => cmp e e' && equal cmp l l'
+      | _    => false
+      end
+    | _, _ => false
+    end.
+
+  Definition Equivb cmp m m' :=
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
+
+  Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp,
+      Equivb cmp m m' -> equal cmp m m' = true.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; subst.
+    match goal with H: compare _ _ = _ |- _ => clear H end.
+    assert (cmp_e_e':cmp e e' = true).
+    apply H1 with x; auto.
+    rewrite cmp_e_e'; simpl.
+    apply IHb; auto.
+    inversion_clear Hm; auto.
+    inversion_clear Hm'; auto.
+    unfold Equivb; intuition.
+    destruct (H0 k).
+    assert (In k ((x,e) ::l)).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H2 H4)); auto.
+    inversion_clear Hm.
+    elim (Sort_Inf_NotIn H6 H7).
+    destruct H as (e'', hyp); exists e''; auto.
+    apply MapsTo_eq with k; auto.
+    destruct (H0 k).
+    assert (In k ((x,e') ::l')).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H3 H4)); auto.
+    subst.
+    inversion_clear Hm'.
+    now elim (Sort_Inf_NotIn H5 H6).
+    apply H1 with k; destruct (eq_dec x k); auto.
+
+
+    destruct (compare x x') as [Hlt|Heq|Hlt]; try contradiction; clear y.
+    destruct (H0 x).
+    assert (In x ((x',e')::l')).
+    apply H; auto.
+    exists e; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm'.
+    assert (Inf (x,e) l').
+    apply Inf_lt with (x',e'); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct (H0 x').
+    assert (In x' ((x,e)::l)).
+    apply H2; auto.
+    exists e'; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    subst; apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm.
+    assert (Inf (x',e') l).
+    apply Inf_lt with (x,e); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct m;
+      destruct m';try contradiction.
+
+    clear H1;destruct p as (k,e).
+    destruct (H0 k).
+    destruct H1.
+    exists e; auto.
+    inversion H1.
+
+    destruct p as (x,e).
+    destruct (H0 x).
+    destruct H.
+    exists e; auto.
+    inversion H.
+
+    destruct p;destruct p0;contradiction.
+  Qed.
+
+  Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp,
+      equal cmp m m' = true -> Equivb cmp m m'.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; try discriminate; subst;
+        try match goal with H: compare _ _ = _ |- _ => clear H end.
+
+    inversion H0.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e'; constructor; split; trivial; apply eq_trans with x; auto.
+    destruct (H k).
+    destruct (H9 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e; constructor; split; trivial; apply eq_trans with x'; auto.
+    destruct (H k).
+    destruct (H10 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H2 H4 H7).
+    inversion_clear H0.
+    destruct H9; simpl in *; subst.
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H4 H5).
+    exists e'0; apply MapsTo_eq with x; auto.
+      (* order. *)
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H2 H3).
+    exists e0; apply MapsTo_eq with x; auto.
+    (* order. *)
+    apply H8 with k; auto.
+  Qed.
+
+  (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *)
+
+  Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
+    eqk x y -> cmp (snd x) (snd y) = true ->
+    (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)).
+  Proof.
+    intros.
+    inversion H; subst.
+    inversion H0; subst.
+    destruct x; destruct y; compute in H1, H2.
+    split; intros.
+    apply equal_2; auto.
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl.
+    apply equal_1; auto.
+    apply equal_2; auto.
+    generalize (equal_1 H H0 H3).
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl; auto.
+  Qed.
+
+End Array.
+
+End Raw.
+
+
+(** * Functional Arrays *)
+
+Section FArray.
+
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+  Variable elt_comp : Comparable elt.
+  Variable key_inh :  Inhabited key.
+  Variable elt_inh :  Inhabited elt.
+
+  Set Implicit Arguments.
+
+  Definition NoDefault l := forall k:key, ~ Raw.MapsTo k default_value l.
+
+  Record farray :=
+    {this :> Raw.farray key elt;
+     sorted : sort (Raw.ltk key_ord) this;
+     nodefault : NoDefault this
+    }.
+
+  Lemma empty_nodefault : NoDefault (Raw.empty key elt).
+    unfold NoDefault.
+    intros.
+    apply Raw.empty_1.
+  Qed.
+
+  (** Boolean comparison over elements *)
+  Definition cmp (e e':elt) :=
+    match compare e e' with EQ _ => true | _ => false end.
+
+
+  Lemma cmp_refl : forall e, cmp e e = true.
+    unfold cmp.
+    intros.
+    destruct (compare e e); auto;
+      apply lt_not_eq in l; now contradict l.
+  Qed.
+
+  Lemma remove_nodefault : forall l (Hd:NoDefault l) (Hs:Sorted (Raw.ltk key_ord) l) x ,
+      NoDefault (Raw.remove key_comp x l).
+  Proof.
+    intros.
+    unfold NoDefault. intros.
+    unfold not. intro.
+    apply Raw.remove_3 in H; auto.
+    now apply Hd in H.
+  Qed.
+
+  Definition raw_add_nodefault (k:key) (x:elt) (l:Raw.farray key elt) :=
+    if cmp x default_value then
+      if Raw.mem key_comp k l then Raw.remove key_comp k l
+      else l
+    else Raw.add key_comp k x l.
+
+
+  Lemma add_sorted : forall l (Hs:Sorted (Raw.ltk key_ord) l) x e,
+      Sorted (Raw.ltk key_ord) (raw_add_nodefault x e l).
+  Proof.
+    intros.
+    unfold raw_add_nodefault.
+    case (cmp e default_value); auto.
+    case (Raw.mem key_comp x l); auto.
+    apply Raw.remove_sorted; auto.
+    apply Raw.add_sorted; auto.
+  Qed.
+
+  Lemma add_nodefault : forall l (Hd:NoDefault l) (Hs:Sorted (Raw.ltk key_ord) l) x e,
+      NoDefault (raw_add_nodefault x e l).
+  Proof.
+    intros.
+    unfold raw_add_nodefault.
+    case_eq (cmp e default_value); intro; auto.
+    case_eq (Raw.mem key_comp x l); intro; auto.
+    apply remove_nodefault; auto.
+    unfold NoDefault; intros.
+    assert (e <> default_value).
+      unfold cmp in H.
+      case (compare e default_value) in H; try now contradict H.
+      apply lt_not_eq in l0; auto.
+      apply lt_not_eq in l0; now auto.
+    destruct (eq_dec k x).
+    - symmetry in e0.
+      apply (Raw.add_1 key_dec key_comp l e) in e0.
+      unfold not; intro.
+      specialize (Raw.add_sorted key_dec key_comp Hs x e).
+      intro Hsadd.
+      specialize (Raw.MapsTo_inj key_dec Hsadd e0 H1).
+      intro. contradiction.
+    - unfold not; intro.
+      assert (x <> k). unfold not in *. intro. apply n. symmetry; auto.
+      specialize (Raw.add_3 key_dec key_comp l e H2 H1).
+      intro. now apply Hd in H3.
+  Qed.
+
+  Definition empty : farray :=
+    Build_farray (Raw.empty_sorted elt key_ord) empty_nodefault.
+
+  Definition is_empty m : bool := Raw.is_empty m.(this).
+
+  Definition add x e m : farray :=
+    Build_farray (add_sorted m.(sorted) x e)
+                (add_nodefault m.(nodefault) m.(sorted) x e).
+
+  Definition find x m : option elt := Raw.find key_comp x m.(this).
+
+  Definition remove x m : farray :=
+    Build_farray (Raw.remove_sorted key_comp m.(sorted) x) (remove_nodefault m.(nodefault) m.(sorted) x).
+
+  Definition mem x m : bool := Raw.mem key_comp x m.(this).
+  Definition elements m : list (key*elt) := Raw.elements m.(this).
+  Definition cardinal m := length m.(this).
+  Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A :=
+    Raw.fold f m.(this) i.
+  Definition equal m m' : bool := Raw.equal key_comp cmp m.(this) m'.(this).
+
+  Definition MapsTo x e m : Prop := Raw.MapsTo x e m.(this).
+  Definition In x m : Prop := Raw.In x m.(this).
+  Definition Empty m : Prop := Raw.Empty m.(this).
+
+  Definition Equal m m' := forall y, find y m = find y m'.
+  Definition Equiv m m' :=
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> e = e').
+  Definition Equivb m m' : Prop := Raw.Equivb cmp m.(this) m'.(this).
+
+  Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.eqk key elt.
+  Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.eqke key elt.
+  Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.ltk key elt key_ord.
+
+  Lemma MapsTo_1 : forall m x y e, eq x y -> MapsTo x e m -> MapsTo y e m.
+  Proof. intros m.
+    apply (Raw.MapsTo_eq key_dec elt_dec). Qed.
+
+  Lemma mem_1 : forall m x, In x m -> mem x m = true.
+  Proof. intros m; apply (Raw.mem_1); auto. apply m.(sorted). Qed.
+  Lemma mem_2 : forall m x, mem x m = true -> In x m.
+  Proof. intros m; apply (Raw.mem_2); auto. apply m.(sorted). Qed.
+
+  Lemma empty_1 : Empty empty.
+  Proof. apply Raw.empty_1. Qed.
+
+  Lemma is_empty_1 : forall m, Empty m -> is_empty m = true.
+  Proof. intros m; apply Raw.is_empty_1. Qed.
+  Lemma is_empty_2 :  forall m, is_empty m = true -> Empty m.
+  Proof. intros m; apply Raw.is_empty_2. Qed.
+
+  Lemma add_1 : forall m x y e, e <> default_value -> eq x y -> MapsTo y e (add x e m).
+  Proof. intros.
+    unfold add, raw_add_nodefault.
+    unfold MapsTo. simpl.
+    case_eq (cmp e default_value); intro; auto.
+    unfold cmp in H1. destruct (compare e default_value); try now contradict H1.
+    apply Raw.add_1; auto.
+  Qed.
+
+  Lemma add_2 : forall m x y e e', ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof.
+    intros.
+    unfold add, raw_add_nodefault, MapsTo. simpl.
+    case_eq (cmp e' default_value); intro; auto.
+    case_eq (Raw.mem key_comp x m); intro; auto.
+    apply (Raw.remove_2 _ m.(sorted)); auto.
+    apply Raw.add_2; auto.
+  Qed.
+
+  Lemma add_3 : forall m x y e e', ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof.
+    unfold add, raw_add_nodefault, MapsTo. simpl.
+    intros m x y e e'.
+    case_eq (cmp e' default_value); intro; auto.
+    case_eq (Raw.mem key_comp x m); intro; auto.
+    intro. apply (Raw.remove_3 _ m.(sorted)); auto.
+    apply Raw.add_3; auto.
+  Qed.
+
+  Lemma remove_1 : forall m x y, eq x y -> ~ In y (remove x m).
+  Proof. intros m; apply Raw.remove_1; auto. apply m.(sorted). Qed.
+
+  Lemma remove_2 : forall m x y e, ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof. intros m; apply Raw.remove_2; auto. apply m.(sorted). Qed.
+
+  Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof. intros m; apply Raw.remove_3; auto. apply m.(sorted). Qed.
+
+  Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e.
+  Proof. intros m; apply Raw.find_1; auto. apply m.(sorted). Qed.
+
+  Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof. intros m; apply Raw.find_2; auto. Qed.
+
+  Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
+  Proof. intros m; apply Raw.elements_1. Qed.
+
+  Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
+  Proof. intros m; apply Raw.elements_2. Qed.
+
+  Lemma elements_3 : forall m, sort lt_key (elements m).
+  Proof. intros m; apply Raw.elements_3; auto. apply m.(sorted). Qed.
+
+  Lemma elements_3w : forall m, NoDupA eq_key (elements m).
+  Proof. intros m; apply (Raw.elements_3w key_dec m.(sorted)). Qed.
+
+  Lemma cardinal_1 : forall m, cardinal m = length (elements m).
+  Proof. intros; reflexivity. Qed.
+
+  Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof. intros m; apply Raw.fold_1. Qed.
+
+  Lemma equal_1 : forall m m', Equivb m m' -> equal m m' = true.
+  Proof. intros m m'; apply Raw.equal_1; auto. apply m.(sorted). apply  m'.(sorted). Qed.
+
+  Lemma equal_2 : forall m m', equal m m' = true -> Equivb m m'.
+  Proof. intros m m'; apply Raw.equal_2; auto. apply m.(sorted). apply  m'.(sorted). Qed.
+
+  Fixpoint eq_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => True
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => eq e e' /\ eq_list l l'
+      | _       => False
+      end
+    | _, _ => False
+    end.
+
+  Definition eq m m' := eq_list m.(this) m'.(this).
+
+  Lemma nodefault_tail : forall x m, NoDefault (x :: m) -> NoDefault m.
+    unfold NoDefault. unfold not in *. intros.
+    apply (H k). unfold Raw.MapsTo. apply InA_cons_tl. apply H0.
+  Qed.
+
+  Lemma raw_equal_eq : forall a (Ha: Sorted (Raw.ltk key_ord) a) b (Hb: Sorted (Raw.ltk key_ord) b),
+      Raw.equal key_comp cmp a b = true -> a = b.
+  Proof.
+    induction a; intros.
+    simpl in H.
+    case b in *; auto.
+    now contradict H.
+    destruct a as (xa, ea).
+    simpl in H.
+    case b in *.
+    now contradict H.
+    destruct p as (xb, eb).
+    destruct (compare xa xb); auto; try (now contradict H).
+    rewrite andb_true_iff in H. destruct H.
+    unfold cmp in H.
+    destruct (compare ea eb); auto; try (now contradict H).
+    subst. apply f_equal.
+    apply IHa; auto.
+    now inversion Ha.
+    now inversion Hb.
+  Qed.
+
+  Lemma eq_equal : forall m m', eq m m' <-> equal m m' = true.
+  Proof.
+    intros (l,Hl,Hd); induction l.
+    intros (l',Hl',Hd'); unfold eq; simpl.
+    destruct l'; unfold equal; simpl; intuition.
+    intros (l',Hl',Hd'); unfold eq.
+    destruct l'.
+    destruct a; unfold equal; simpl; intuition.
+    destruct a as (x,e).
+    destruct p as (x',e').
+    unfold equal; simpl.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; simpl; intuition.
+    unfold cmp at 1.
+    case (compare e e');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+    clear HH; simpl.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    apply nodefault_tail in Hd.
+    apply nodefault_tail in Hd'.
+    destruct (IHl H Hd (Build_farray H2 Hd')).
+    unfold equal, eq in H5; simpl in H5; auto.
+    destruct (andb_prop _ _ H); clear H.
+    generalize H0; unfold cmp.
+    case (compare e e');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+      auto; intro; discriminate.
+    destruct (andb_prop _ _ H); clear H.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    apply nodefault_tail in Hd.
+    apply nodefault_tail in Hd'.
+    destruct (IHl H Hd (Build_farray H3 Hd')).
+    unfold equal, eq in H6; simpl in H6; auto.
+  Qed.
+
+  Lemma eq_1 : forall m m', Equivb m m' -> eq m m'.
+  Proof.
+    intros.
+    generalize (@equal_1 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eq_2 : forall m m', eq m m' -> Equivb m m'.
+  Proof.
+    intros.
+    generalize (@equal_2 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eqfarray_refl : forall m : farray, eq m m.
+  Proof.
+    intros (m,Hm,Hd); induction m; unfold eq; simpl; auto.
+    destruct a.
+    destruct (compare k k) as [Hlt|Heq|Hlt]; auto.
+    apply lt_not_eq in Hlt. auto.
+    split.
+    apply eq_refl.
+    inversion_clear Hm.
+    apply nodefault_tail in Hd.
+    apply (IHm H Hd).
+    apply lt_not_eq in Hlt. auto.
+  Qed.
+
+  Lemma eqfarray_sym : forall m1 m2 : farray, eq m1 m2 -> eq m2 m1.
+  Proof.
+    intros (m,Hm,Hd); induction m;
+      intros (m',Hm',Hd'); destruct m'; unfold eq; simpl;
+        try destruct a as (x,e); try destruct p as (x',e'); auto.
+    destruct (compare x x')  as [Hlt|Heq|Hlt]; try easy.
+    inversion_clear Hm; inversion_clear Hm'.
+    apply nodefault_tail in Hd. apply nodefault_tail in Hd'.
+    intro. destruct H3.
+    subst.
+    case (compare x' x');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    apply (IHm H Hd (Build_farray H1 Hd')); auto.
+  Qed.
+
+  Lemma eqfarray_trans : forall m1 m2 m3 : farray, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
+  Proof.
+    intros (m1,Hm1,Hd1); induction m1;
+      intros (m2,Hm2,Hd2); destruct m2;
+        intros (m3,Hm3,Hd3); destruct m3; unfold eq; simpl;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt']; try easy.
+    intros; destruct H, H0;  subst.
+    case (compare x'' x'');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply nodefault_tail in Hd1.
+    apply nodefault_tail in Hd2.
+    apply nodefault_tail in Hd3.
+    apply (IHm1 H Hd1 (Build_farray H3 Hd2) (Build_farray H5 Hd3)); intuition.
+  Qed.
+
+  Fixpoint lt_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => False
+    | nil, _  => True
+    | _, nil  => False
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | LT _ => True
+      | GT _ => False
+      | EQ _ => lt e e' \/ (e = e' /\ lt_list l l')
+      end
+    end.
+
+  Definition lt_farray m m' := lt_list m.(this) m'.(this).
+
+  Lemma lt_farray_trans : forall m1 m2 m3 : farray,
+      lt_farray m1 m2 -> lt_farray m2 m3 -> lt_farray m1 m3.
+  Proof.
+    intros (m1,Hm1,Hd1); induction m1;
+      intros (m2,Hm2,Hd2); destruct m2;
+        intros (m3,Hm3,Hd3); destruct m3; unfold lt_farray; simpl;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt'];
+      destruct (compare x x'') as [Hlt''|Heq''|Hlt'']; intros; subst; auto; try easy.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt.
+    apply (lt_trans _ x'') ; auto.
+    apply lt_not_eq in Hlt. now contradict Hlt.
+    apply (lt_trans x'') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    subst.
+    apply lt_not_eq in Hlt'. now contradict Hlt'.
+    apply (lt_trans x'') in Hlt'; apply lt_not_eq in Hlt'.
+    now contradict Hlt'. auto.
+    destruct H, H0.
+    left; apply lt_trans with e'; auto.
+    left. destruct H0. subst; auto.
+    left. destruct H. subst; auto.
+    right. destruct H, H0. subst; split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply nodefault_tail in Hd1.
+    apply nodefault_tail in Hd2.
+    apply nodefault_tail in Hd3.
+    apply (IHm1 H Hd1 (Build_farray H3 Hd2) (Build_farray H5 Hd3)); intuition.
+    apply lt_not_eq in Hlt''. now contradict Hlt''.
+  Qed.
+
+  Lemma lt_farray_not_eq : forall m1 m2 : farray, lt_farray m1 m2 -> ~ eq m1 m2.
+  Proof.
+    intros (m1,Hm1,Hd1); induction m1;
+      intros (m2,Hm2,Hd2); destruct m2; unfold eq, lt; simpl;
+        try destruct a as (x,e);
+        try destruct p as (x',e'); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; auto.
+    intuition.
+    inversion_clear Hm1; inversion_clear Hm2.
+    specialize (nodefault_tail Hd2).
+    specialize (nodefault_tail Hd1). intros.
+    subst.
+    apply (IHm1 H0 H6 (Build_farray H4 H7)); intuition.
+    unfold lt_farray in *.
+    simpl in H.
+    case (compare x' x') in *.
+    apply lt_not_eq in l. now contradict l.
+    destruct H.
+    apply lt_not_eq in H. now contradict H.
+    destruct H.
+    auto.
+    apply lt_not_eq in l. now contradict l.
+  Qed.
+
+  Definition compare_farray : forall m1 m2, Compare lt_farray eq m1 m2.
+  Proof.
+    intros (m1,Hm1,Hd1); induction m1;
+      intros (m2,Hm2,Hd2); destruct m2;
+        [ apply EQ | apply LT | apply GT | ]; auto.
+    (* cmp_solve. *)
+    unfold eq. simpl; auto.
+    unfold lt_farray. simpl; auto.
+    unfold lt_farray. simpl; auto.
+    destruct a as (x,e); destruct p as (x',e').
+    destruct (compare x x');
+      [ apply LT | | apply GT ].
+    unfold lt_farray. simpl.
+    destruct (compare x x'); auto.
+    subst. apply lt_not_eq in l; now contradict l.
+    apply (lt_trans x') in l; auto. subst. apply lt_not_eq in l; now contradict l.
+    (* subst. *)
+    destruct (compare e e');
+      [ apply LT | | apply GT ].
+    unfold lt_farray. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    assert (Hm11 : sort (Raw.ltk key_ord) m1).
+    inversion_clear Hm1; auto.
+    assert (Hm22 : sort (Raw.ltk key_ord) m2).
+    inversion_clear Hm2; auto.
+    specialize (nodefault_tail Hd2). specialize (nodefault_tail Hd1).
+    intros Hd11 Hd22.
+    destruct (IHm1 Hm11 Hd11 (Build_farray Hm22 Hd22));
+      [ apply LT | apply EQ | apply GT ].
+    unfold lt_farray in *. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold eq in *. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l; now contradict l).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l; now contradict l).
+    apply (lt_trans x) in l; auto. subst. apply lt_not_eq in l; now contradict l.
+  Qed.
+
+  Lemma eq_option_alt : forall (elt:Type)(o o':option elt),
+      o=o' <-> (forall e, o=Some e <-> o'=Some e).
+  Proof.
+    split; intros.
+    subst; split; auto.
+    destruct o; destruct o'; try rewrite H; auto.
+    symmetry; rewrite <- H; auto.
+  Qed.
+
+  Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e.
+  Proof.
+    split; [apply find_1|apply find_2].
+  Qed.
+
+  Lemma add_neq_mapsto_iff : forall m x y e e',
+      x <> y -> (MapsTo y e' (add x e m)  <-> MapsTo y e' m).
+  Proof.
+    split; [apply add_3|apply add_2]; auto.
+  Qed.
+
+
+  Lemma add_eq_o : forall m x y e,
+      x = y -> e <> default_value -> find y (add x e m) = Some e.
+  Proof. intros.
+    apply find_1.
+    apply add_1; auto.
+  Qed.
+
+  Lemma raw_add_d_rem : forall m (Hm: Sorted (Raw.ltk key_ord) m) x,
+      raw_add_nodefault x default_value m = Raw.remove key_comp x m.
+    intros.
+    unfold raw_add_nodefault.
+    rewrite cmp_refl.
+    case_eq (Raw.mem key_comp x m); intro.
+    auto.
+    apply Raw.mem_3 in H; auto.
+    apply raw_equal_eq; auto.
+    apply Raw.remove_sorted; auto.
+    apply Raw.equal_1; auto.
+    apply Raw.remove_sorted; auto.
+    unfold Raw.Equivb.
+    split.
+    intros.
+    destruct (eq_dec x k). subst.
+    split. intro. contradiction.
+    intro. contradict H0.
+    apply Raw.remove_1; auto.
+    apply Raw.remove_4; auto.
+
+    intros.
+    destruct (eq_dec x k).
+    assert (exists e, InA (Raw.eqk (elt:=elt)) (k, e) (Raw.remove key_comp x m)).
+    exists e'. apply Raw.InA_eqke_eqk; auto.
+    rewrite <- Raw.In_alt in H2; auto.
+    contradict H2.
+    apply Raw.remove_1; auto.
+    apply key_comp.
+    apply (Raw.remove_2 key_comp Hm n) in H0.
+    specialize (Raw.remove_sorted key_comp Hm x). intros.
+    specialize (Raw.MapsTo_inj key_dec H2 H0 H1).
+    intro. subst. apply cmp_refl.
+  Qed.
+
+  Lemma add_d_rem : forall m x, add x default_value m = remove x m.
+    intros.
+    unfold add, remove.
+    specialize (raw_add_d_rem m.(sorted) x). intro.
+    generalize (add_sorted m.(sorted) x default_value).
+    generalize (add_nodefault (nodefault m) (sorted m) x default_value).
+    generalize (Raw.remove_sorted key_comp (sorted m) x).
+    generalize (remove_nodefault (nodefault m) (sorted m) x).
+    rewrite H.
+    intros H4 H3 H2 H1.
+    rewrite (proof_irrelevance _ H1 H3), (proof_irrelevance _ H2 H4).
+    reflexivity.
+  Qed.
+
+  Lemma add_eq_d : forall m x y,
+      x = y -> find y (add x default_value m) = None.
+  Proof.
+    intros.
+    simpl.
+    rewrite add_d_rem.
+    case_eq (find y (remove x m)); auto.
+    intros.
+    apply find_2 in H0.
+    unfold MapsTo, Raw.MapsTo in H0.
+    assert (exists e, InA (Raw.eqk (elt:=elt)) (y, e) (remove x m).(this)).
+    exists e. apply Raw.InA_eqke_eqk in H0. auto.
+    rewrite <- Raw.In_alt in H1; auto.
+    contradict H1.
+    apply remove_1; auto.
+    apply key_comp.
+  Qed.
+
+  Lemma add_neq_o : forall m x y e,
+      ~ x = y -> find y (add x e m) = find y m.
+  Proof.
+    intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff.
+    apply add_neq_mapsto_iff; auto.
+  Qed.
+  Hint Resolve add_neq_o.
+
+  Lemma MapsTo_fun : forall m x (e e':elt),
+      MapsTo x e m -> MapsTo x e' m -> e=e'.
+  Proof.
+    intros.
+    generalize (find_1 H) (find_1 H0); clear H H0.
+    intros; rewrite H in H0; injection H0; auto.
+  Qed.
+
+  (** Another characterisation of [Equal] *)
+
+  Lemma Equal_mapsto_iff : forall m1 m2 : farray,
+      Equal m1 m2 <-> (forall k e, MapsTo k e m1 <-> MapsTo k e m2).
+  Proof.
+    intros m1 m2. split; [intros Heq k e|intros Hiff].
+    rewrite 2 find_mapsto_iff, Heq. split; auto.
+    intro k. rewrite eq_option_alt. intro e.
+    rewrite <- 2 find_mapsto_iff; auto.
+  Qed.
+
+  (** * Relations between [Equal], [Equiv] and [Equivb]. *)
+
+  (** First, [Equal] is [Equiv] with Leibniz on elements. *)
+
+  Lemma Equal_Equiv : forall (m m' : farray),
+      Equal m m' <-> Equiv m m'.
+  Proof.
+    intros. rewrite Equal_mapsto_iff. split; intros.
+    split.
+    split; intros (e,Hin); exists e; unfold MapsTo in H; [rewrite <- H|rewrite H]; auto.
+    intros; apply MapsTo_fun with m k; auto; rewrite H; auto.
+    split; intros H'.
+    destruct H.
+    assert (Hin : In k m') by (rewrite <- H; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite (H0 k e e'); auto.
+    destruct H.
+    assert (Hin : In k m) by (rewrite H; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite <- (H0 k e' e); auto.
+  Qed.
+
+  Lemma Equiv_Equivb : forall m m', Equiv m m' <-> Equivb m m'.
+  Proof.
+    unfold Equiv, Equivb, Raw.Equivb, cmp; intuition; specialize (H1 k e e' H H2).
+    destruct (compare e e'); auto; apply lt_not_eq in l; auto.
+    destruct (compare e e'); auto; now contradict H1.
+  Qed.
+
+  (** Composition of the two last results: relation between [Equal]
+    and [Equivb]. *)
+
+  Lemma Equal_Equivb : forall (m m':farray), Equal m m' <-> Equivb m m'.
+  Proof.
+    intros; rewrite Equal_Equiv.
+    apply Equiv_Equivb; auto.
+  Qed.
+
+  (** * Functional arrays with default value *)
+
+  Definition select (a: farray) (i: key) : elt :=
+    match find i a with
+    | Some v => v
+    | None => default_value
+    end.
+
+  Definition store (a: farray) (i: key) (v: elt) : farray := add i v a.
+
+  Lemma read_over_same_write : forall a i j v, i = j -> select (store a i v) j = v.
+  Proof.
+    intros a i j v Heq.
+    unfold select, store.
+    case_eq (cmp v default_value); intro; auto.
+    unfold cmp in H.
+    case (compare v default_value) in H; auto; try now contradict H.
+    rewrite e.
+    rewrite add_eq_d; auto.
+    assert (v <> default_value).
+    unfold cmp in H.
+    case (compare v default_value) in H; auto; try now contradict H.
+    apply lt_not_eq in l. auto.
+    apply lt_not_eq in l. auto.
+    rewrite (add_eq_o a Heq H0). auto.
+  Qed.
+
+  Lemma read_over_write : forall a i v, select (store a i v) i = v.
+  Proof.
+    intros; apply read_over_same_write; auto.
+  Qed.
+
+  Lemma read_over_other_write : forall a i j v,
+      i <> j -> select (store a i v) j = select a j.
+  Proof.
+    intros a i j v Hneq.
+    unfold select, store.
+    apply (add_neq_o a v) in Hneq.
+    rewrite Hneq. auto.
+  Qed.
+
+  Lemma find_ext_dec:
+    (forall m1 m2: farray, Equal m1 m2 -> (equal m1 m2) = true).
+  Proof. intros.
+    apply Equal_Equivb in H.
+    apply equal_1.
+    exact H.
+  Qed.
+
+  Lemma extensionnality_eqb : forall a b,
+      (forall i, select a i = select b i) -> equal a b = true.
+  Proof.
+    intros.
+    unfold select in H.
+    assert (forall i, find i a = find i b).
+    - intro i. specialize (H i).
+      case_eq (find i a);
+        case_eq (find i b);
+        intros; rewrite H0 in *; rewrite H1 in *; subst; auto.
+      + apply find_2 in H1.
+        contradict H1.
+        unfold MapsTo.
+        apply a.(nodefault).
+      + apply find_2 in H0.
+        contradict H0.
+        unfold MapsTo.
+        apply b.(nodefault).
+    - apply find_ext_dec in H0.
+      exact H0.
+  Qed.
+
+  Lemma equal_eq : forall a b, equal a b = true -> a = b.
+  Proof. intros. apply eq_equal in H.
+    destruct a as (a, asort, anodef), b as (b, bsort, bnodef).
+    unfold eq in H.
+    revert b bsort bnodef H.
+    induction a; intros; destruct b.
+    rewrite (proof_irrelevance _ asort bsort).
+    rewrite (proof_irrelevance _ anodef bnodef).
+    auto.
+    simpl in H. now contradict H.
+    simpl in H. destruct a; now contradict H.
+    simpl in H. destruct a, p.
+    destruct (compare k k0); auto; try (now contradict H).
+    destruct H.
+    subst.
+    inversion_clear asort.
+    inversion_clear bsort.
+    specialize (nodefault_tail bnodef).
+    specialize (nodefault_tail anodef). intros.
+    specialize (IHa H H4 b H2 H5 H0).
+    inversion IHa. subst.
+    rewrite (proof_irrelevance _ asort bsort).
+    rewrite (proof_irrelevance _ anodef bnodef).
+    reflexivity.
+ Qed.
+
+  Lemma notequal_neq : forall a b, equal a b = false -> a <> b.
+    intros.
+    red. intros.
+    apply not_true_iff_false in H.
+    unfold not in *. intros.
+    apply H. rewrite H0.
+    apply eq_equal. apply eqfarray_refl.
+  Qed.
+
+  Lemma extensionnality : forall a b, (forall i, select a i = select b i) -> a = b.
+  Proof.
+    intros; apply equal_eq; apply extensionnality_eqb; auto.
+  Qed.
+
+
+  Lemma eq_list_refl: forall a, eq_list a a.
+  Proof.
+    intro a.
+    induction a; intros.
+    - now simpl.
+    - simpl. destruct a as (k, e).
+      case_eq (compare k k); intros.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+      + split; easy.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+  Qed.
+
+  Lemma equal_refl: forall a, equal a a = true.
+  Proof. intros; apply eq_equal; apply eq_list_refl. Qed.
+
+  Lemma equal_iff_eq : forall a b, equal a b = true <-> a = b.
+  Proof.
+    intros a b.
+    split.
+    - apply equal_eq.
+    - intro; subst. apply equal_refl.
+  Qed.
+
+  Section Classical_extensionnality.
+
+    Require Import Classical_Pred_Type ClassicalEpsilon.
+
+    Lemma extensionnality2 : forall a b, a <> b -> (exists i, select a i <> select b i).
+    Proof.
+      intros.
+      apply not_all_ex_not.
+      unfold not in *.
+      intros. apply H. apply extensionnality; auto.
+    Qed.
+
+    Definition diff_index_p : forall a b, a <> b -> { i | select a i <> select b i } :=
+      (fun a b u => constructive_indefinite_description _ (@extensionnality2 _ _ u)).
+
+    Definition diff_index : forall a b, a <> b -> key :=
+      (fun a b u => proj1_sig (diff_index_p u)).
+
+
+    Example d : forall a b (u:a <> b), let i := diff_index u in select a i <> select b i.
+      unfold diff_index.
+      intros.
+      destruct (diff_index_p u). simpl. auto.
+    Qed.
+
+    Definition diff (a b: farray) : key.
+      case_eq (equal a b); intro.
+      - apply default_value.
+      - apply (diff_index (notequal_neq H)).
+        (* destruct (diff_index_p H). apply x. *)
+    Defined.
+
+   Lemma select_at_diff: forall a b, a <> b ->
+            select a (diff a b) <> select b (diff a b).
+   Proof.
+     intros a b H. unfold diff.
+     assert (equal a b = false).
+     apply not_true_iff_false.
+     red. intro. apply equal_eq in H0. subst. auto.
+     generalize (@notequal_neq a b).
+     rewrite H0.
+     intro.
+     unfold diff_index.
+     destruct (diff_index_p (n Logic.eq_refl)). simpl; auto.
+   Qed.
+
+  End Classical_extensionnality.
+
+End FArray.
+
+Arguments farray _ _ {_} {_}.
+Arguments select {_} {_} {_} {_} {_} _ _.
+Arguments store {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+Arguments diff {_} {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _.
+Arguments equal {_} {_} {_} {_} {_} {_} {_}  _ _.
+Arguments equal_iff_eq {_} {_} {_} {_} {_} {_} {_} _ _.
+Arguments read_over_same_write {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _ _ _ _.
+Arguments read_over_write {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+Arguments read_over_other_write {_} {_} {_} {_} {_} {_} {_} {_} _ _ _ _ _.
+Arguments extensionnality {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+Arguments extensionnality2 {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+Arguments select_at_diff {_} {_} {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+
+
+Notation "a '[' i ']'" := (select a i) (at level 1, format "a [ i ]") : farray_scope.
+Notation "a '[' i '<-' v ']'" := (store a i v)
+   (at level 1, format "a [ i  <-  v ]") : farray_scope.
+
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/array/FArray_default.v b/src/array/FArray_default.v
new file mode 100644
index 0000000..a8e8f44
--- /dev/null
+++ b/src/array/FArray_default.v
@@ -0,0 +1,1973 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool OrderedType SMT_classes.
+Require Import ProofIrrelevance.
+
+(** This file formalizes functional arrays with extensionality as specified in
+    SMT-LIB 2. It gives realization to axioms that define the SMT-LIB theory of
+    arrays. For this, it uses a formalization of maps with the same approach as
+    FMaplist excepted that constraints on keys and elements are expressed
+    through the use of typeclasses instead of functors. *)
+
+Set Implicit Arguments.
+
+(** Raw maps (see FMaplist) *)
+Module Raw.
+
+  Section Array.
+
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+
+  Definition eqb_key (x y : key) : bool := if eq_dec x y then true else false.
+  Definition eqb_elt (x y : elt) : bool := if eq_dec x y then true else false.
+
+  Lemma eqb_key_eq x y : eqb_key x y = true <-> x = y.
+  Proof. unfold eqb_key. case (eq_dec x y); split; easy. Qed.
+
+  Lemma eqb_elt_eq x y : eqb_elt x y = true <-> x = y.
+  Proof. unfold eqb_elt. case (eq_dec x y); split; easy. Qed.
+
+  Hint Immediate eqb_key_eq eqb_elt_eq.
+
+  Definition farray := list (key * elt).
+
+  Definition eqk (a b : (key * elt)) := fst a = fst b.
+  Definition eqe (a b : (key * elt)) := snd a = snd b.
+  Definition eqke (a b : (key * elt)) := fst a = fst b /\ snd a = snd b.
+
+  Definition ltk (a b : (key * elt)) := lt (fst a) (fst b).
+
+  (* Definition ltke (a b : (key * elt)) := *)
+  (*   lt (fst a) (fst b) \/ ( (fst a) = (fst b) /\ lt (snd a) (snd b)). *)
+
+  Hint Unfold ltk (* ltke *) eqk eqke.
+  Hint Extern 2 (eqke ?a ?b) => split.
+
+  Global Instance lt_key_strorder : StrictOrder (lt : key -> key -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  Global Instance lt_elt_strorder : StrictOrder (lt : elt -> elt -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  Global Instance ke_dec : DecType (key * elt).
+  Proof.
+    split; auto.
+    intros; destruct x, y, z.
+    inversion H. inversion H0. trivial.
+    intros; destruct x, y.
+    destruct (eq_dec k k0).
+    destruct (eq_dec e e0).
+    left; rewrite e1, e2; auto.
+    right; unfold not in *. intro; inversion H. exact (n H2).
+    right; unfold not in *. intro; inversion H. exact (n H1).
+  Qed.
+
+  Global Instance ke_ord: OrdType (key * elt).
+  Proof.
+    exists ltk; unfold ltk; intros.
+    apply (lt_trans _ (fst y)); auto.
+    destruct x, y. simpl in H.
+    unfold not. intro. inversion H0.
+    apply (lt_not_eq k k0); auto.
+  Qed.
+
+  (* ltk ignore the second components *)
+
+   Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e').
+   Proof. auto. Qed.
+
+   Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x.
+   Proof. auto. Qed.
+   Hint Immediate ltk_right_r ltk_right_l.
+
+  Notation Sort := (sort ltk).
+  Notation Inf := (lelistA (ltk)).
+
+  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+  Definition In k m := exists e:elt, MapsTo k e m.
+
+  Notation NoDupA := (NoDupA eqk).
+
+  Hint Unfold MapsTo In.
+
+  (* Instance ke_ord: OrdType (key * elt). *)
+  (* Proof. *)
+  (*   exists ltke. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct H, H0. *)
+  (*   left; apply (lt_trans _ (fst y)); auto. *)
+  (*   destruct H0. left. rewrite <- H0. assumption. *)
+  (*   destruct H. left. rewrite H. assumption. *)
+  (*   destruct H, H0. *)
+  (*   right. split. *)
+  (*   apply (eq_trans _ (fst y)); trivial. *)
+  (*   apply (lt_trans _ (snd y)); trivial. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct x, y. simpl in H. *)
+  (*   destruct H. *)
+  (*   apply lt_not_eq in H. *)
+  (*   unfold not in *. intro. inversion H0. apply H. trivial. *)
+  (*   destruct H. apply lt_not_eq in H0. unfold not in *. intro.  *)
+  (*   inversion H1. apply H0; trivial. *)
+  (*   intros. *)
+  (*   unfold ltke. *)
+  (*   destruct (compare (fst x) (fst y)). *)
+  (*   apply LT. left; assumption. *)
+  (*   destruct (compare (snd x) (snd y)). *)
+  (*   apply LT. right; split; assumption. *)
+  (*   apply EQ. destruct x, y. simpl in *. rewrite e, e0; trivial. *)
+  (*   apply GT. right; symmetry in e; split; assumption. *)
+  (*   apply GT. left; assumption. *)
+  (* Qed. *)
+
+  (* Hint Immediate ke_ord. *)
+  (* Let ke_ord := ke_ord. *)
+
+  (* Instance keyelt_ord: OrdType (key * elt). *)
+
+
+  (* Variable keyelt_ord : OrdType (key * elt). *)
+   (* eqke is stricter than eqk *)
+
+   Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
+   Proof.
+     unfold eqk, eqke; intuition.
+   Qed.
+
+  (* eqk, eqke are equalities *)
+
+  Lemma eqk_refl : forall e, eqk e e.
+  Proof. auto. Qed.
+
+  Lemma eqke_refl : forall e, eqke e e.
+  Proof. auto. Qed.
+
+  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
+  Proof. auto. Qed.
+
+  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
+  Proof. unfold eqke; intuition. Qed.
+
+  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
+  Proof.
+    unfold eqke; intuition; [ eauto | congruence ].
+  Qed.
+
+  Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''.
+  Proof. eauto. Qed.
+
+  Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'.
+  Proof. unfold ltk, eqk. intros. apply lt_not_eq; auto. Qed.
+
+  Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'.
+  Proof.
+    unfold eqke, ltk; intuition; simpl in *; subst.
+    apply lt_not_eq in H. auto.
+  Qed.
+
+  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+  Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
+  Hint Immediate eqk_sym eqke_sym.
+
+  Global Instance eqk_equiv : Equivalence eqk.
+  Proof. split; eauto. Qed.
+
+  Global Instance eqke_equiv : Equivalence eqke.
+  Proof. split; eauto. Qed.
+
+  Global Instance ltk_strorder : StrictOrder ltk.
+  Proof.
+    split.
+    unfold Irreflexive, Reflexive, complement.
+    intros. apply lt_not_eq in H; auto.
+    unfold Transitive. intros x y z. apply lt_trans.
+  Qed.
+
+  (* Instance ltke_strorder : StrictOrder ltke. *)
+  (* Proof. *)
+  (*   split. *)
+  (*   unfold Irreflexive, Reflexive, complement. *)
+  (*   intros. apply lt_not_eq in H; auto. *)
+  (*   unfold Transitive. apply lt_trans. *)
+  (* Qed. *)
+
+  Global Instance eq_equiv : @Equivalence (key * elt) eq.
+  Proof.
+    split; auto.
+    unfold Transitive. apply eq_trans.
+  Qed.
+
+  (* Instance ltke_compat : Proper (eq ==> eq ==> iff) ltke. *)
+  (* Proof. *)
+  (*   split; rewrite H, H0; trivial. *)
+  (* Qed. *)
+
+  Global Instance ltk_compat : Proper (eq ==> eq ==> iff) ltk.
+  Proof.
+    split; rewrite H, H0; trivial.
+  Qed.
+
+  Global Instance ltk_compatk : Proper (eqk==>eqk==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') Hxx' (y,f) (y',f') Hyy'; compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+  Global Instance ltk_compat' : Proper (eqke==>eqke==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') (Hxx',_) (y,f) (y',f') (Hyy',_); compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+  Global Instance ltk_asym : Asymmetric ltk.
+  Proof. apply (StrictOrder_Asymmetric ltk_strorder). Qed.
+
+  (* Additional facts *)
+
+  Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
+  Proof.
+    unfold eqk, ltk.
+    unfold not. intros x x' H.
+    destruct x, x'. simpl in *.
+    intro.
+    symmetry in H.
+    apply lt_not_eq in H. auto.
+    subst. auto.
+  Qed.
+
+  Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''.
+  Proof. unfold ltk, eqk. destruct e, e', e''. simpl.
+    intros; subst; trivial.
+  Qed.
+
+  Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''.
+  Proof.
+    intros (k,e) (k',e') (k'',e'').
+    unfold ltk, eqk; simpl; intros; subst; trivial.
+  Qed.
+  Hint Resolve eqk_not_ltk.
+  Hint Immediate ltk_eqk eqk_ltk.
+  
+  Lemma InA_eqke_eqk :
+     forall x m, InA eqke x m -> InA eqk x m.
+  Proof.
+    unfold eqke; induction 1; intuition.
+  Qed.
+
+  Hint Resolve InA_eqke_eqk.
+
+  (* Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m. *)
+  (* Proof. *)
+  (*  intros; apply InA_eqA with p; auto with *. *)
+  (* Qed. *)
+
+  (* Lemma In_eq : forall l x y, eq x y -> InA eqke x l -> InA eqke y l. *)
+  (* Proof. intros. rewrite <- H; auto. Qed. *)
+
+  (* Lemma ListIn_In : forall l x, List.In x l -> InA eqk x l. *)
+  (* Proof. apply In_InA. split; auto. unfold Transitive. *)
+  (*   unfold eqk; intros. rewrite H, <- H0. auto. *)
+  (* Qed. *)
+  
+  (* Lemma Inf_lt : forall l x y, ltk x y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_ltA ltk_strorder). Qed. *)
+
+  (* Lemma Inf_eq : forall l x y, x = y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_eqA eq_equiv ltk_compat). Qed. *)
+
+  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
+
+  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
+  Proof.
+  firstorder.
+  exists x; auto.
+  induction H.
+  destruct y.
+  exists e; auto.
+  destruct IHInA as [e H0].
+  exists e; auto.
+  Qed.
+
+  Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
+  Proof.
+  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto with *.
+  Qed.
+
+  Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+  Proof.
+  destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
+  Qed.
+
+  Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_eqA eqk_equiv ltk_compatk). Qed.
+
+  Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_ltA ltk_strorder). Qed.
+
+  Hint Immediate Inf_eq.
+  Hint Resolve Inf_lt.
+
+  Lemma Sort_Inf_In :
+    forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p.
+  Proof.
+    exact (SortA_InfA_InA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+  Lemma Sort_Inf_NotIn :
+    forall l k e, Sort l -> Inf (k,e) l ->  ~In k l.
+  Proof.
+    intros; red; intros.
+    destruct H1 as [e' H2].
+    elim (@ltk_not_eqk (k,e) (k,e')).
+    eapply Sort_Inf_In; eauto.
+    red; simpl; auto.
+  Qed.
+
+  Hint Resolve Sort_Inf_NotIn.
+
+  Lemma Sort_NoDupA: forall l, Sort l -> NoDupA l.
+  Proof.
+    exact (SortA_NoDupA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+  Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'.
+  Proof.
+    inversion 1; intros; eapply Sort_Inf_In; eauto.
+  Qed.
+
+  Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) ->
+                                   ltk e e' \/ eqk e e'.
+  Proof.
+    inversion_clear 2; auto.
+    left; apply Sort_In_cons_1 with l; auto.
+  Qed.
+
+  Lemma Sort_In_cons_3 :
+    forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k.
+  Proof.
+    inversion_clear 1; red; intros.
+    destruct (Sort_Inf_NotIn H0 H1 (In_eq H2 H)).
+  Qed.
+
+  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l.
+  Proof.
+    inversion 1.
+    inversion_clear H0; eauto.
+    destruct H1; simpl in *; intuition.
+  Qed.
+
+  Lemma In_inv_2 : forall k k' e e' l,
+      InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Lemma In_inv_3 : forall x x' l,
+      InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Hint Resolve In_inv_2 In_inv_3.
+
+  (** * FMAPLIST interface implementaion  *)
+
+  (** * [empty] *)
+
+  Definition empty : farray := nil.
+
+  Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+    unfold Empty,empty.
+    intros a e.
+    intro abs.
+    inversion abs.
+  Qed.
+  Hint Resolve empty_1.
+
+  Lemma empty_sorted : Sort empty.
+  Proof.
+    unfold empty; auto.
+  Qed.
+
+  Lemma MapsTo_inj : forall x e e' l (Hl:Sort l),
+      MapsTo x e l -> MapsTo x e' l -> e = e'.
+    induction l.
+    - intros. apply empty_1 in H. contradiction.
+    - intros.
+      destruct a as (y, v).
+      pose proof H as HH.
+      pose proof H0 as HH0.
+      unfold MapsTo in H.
+      apply InA_eqke_eqk in H.
+      apply InA_eqke_eqk in H0.
+      apply (Sort_In_cons_2 Hl) in H.
+      apply (Sort_In_cons_2 Hl) in H0.
+      destruct H, H0.
+      + apply ltk_not_eqk in H.
+        apply ltk_not_eqk in H0.
+        assert (~ eqk (x, e) (y, v)). unfold not in *. intros. apply H. now apply eqk_sym.
+        assert (~ eqk (x, e') (y, v)). unfold not in *. intros. apply H. now apply eqk_sym.
+        specialize (In_inv_3 HH0 H2).
+        specialize (In_inv_3 HH H1).
+        inversion_clear Hl.
+        apply (IHl H3).
+      + apply ltk_not_eqk in H.
+        unfold eqk in H, H0; simpl in H, H0. contradiction.
+      + apply ltk_not_eqk in H0.
+        unfold eqk in H, H0; simpl in H, H0. contradiction.
+      + unfold eqk in H, H0. simpl in *. subst.
+        inversion_clear HH.
+        inversion_clear HH0.
+        unfold eqke in *. simpl in *. destruct H, H1; subst; auto.
+        apply InA_eqke_eqk in H1.
+        inversion_clear Hl.
+        specialize (Sort_Inf_In H2 H3 H1).
+        unfold ltk. simpl. intro. apply lt_not_eq in H4. contradiction.
+        apply InA_eqke_eqk in H.
+        inversion_clear Hl.
+        specialize (Sort_Inf_In H1 H2 H).
+        unfold ltk. simpl. intro. apply lt_not_eq in H3. contradiction.
+  Qed.
+
+  (** * [is_empty] *)
+
+  Definition is_empty (l : farray) : bool := if l then true else false.
+
+  Lemma is_empty_1 :forall m, Empty m -> is_empty m = true.
+  Proof.
+    unfold Empty, MapsTo.
+    intros m.
+    case m;auto.
+    intros (k,e) l inlist.
+    absurd (InA eqke (k, e) ((k, e) :: l));auto.
+  Qed.
+
+  Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
+  Proof.
+    intros m.
+    case m;auto.
+    intros p l abs.
+    inversion abs.
+  Qed.
+
+  (** * [mem] *)
+
+  Function mem (k : key) (s : farray) {struct s} : bool :=
+    match s with
+    | nil => false
+    | (k',_) :: l =>
+      match compare k k' with
+      | LT _ => false
+      | EQ _ => true
+      | GT _ => mem k l
+      end
+    end.
+
+  Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm.
+    functional induction (mem x m);intros sorted belong1;trivial.
+
+    inversion belong1. inversion H.
+
+    absurd (In x ((k', _x) :: l));try assumption.
+    apply Sort_Inf_NotIn with _x;auto.
+
+    apply IHb.
+    elim (sort_inv sorted);auto.
+    elim (In_inv belong1);auto.
+    intro abs.
+    absurd (eq x k'); auto.
+    symmetry in abs.
+    apply lt_not_eq in abs; auto.
+  Qed.
+
+  Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm; unfold In,MapsTo.
+    functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail).
+    exists _x; auto.
+    induction IHb; auto.
+    exists x0; auto.
+    inversion_clear sorted; auto.
+  Qed.
+
+  Lemma mem_3 : forall m (Hm:Sort m) x, mem x m = false -> ~ In x m.
+    intros.
+    rewrite <- not_true_iff_false in H.
+    unfold not in *. intros; apply H.
+    now apply mem_1.
+  Qed.
+
+  (** * [find] *)
+
+  Function find (k:key) (s: farray) {struct s} : option elt :=
+    match s with
+    | nil => None
+    | (k',x)::s' =>
+      match compare k k' with
+      | LT _ => None
+      | EQ _ => Some x
+      | GT _ => find k s'
+      end
+    end.
+
+  Lemma find_2 :  forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof.
+    intros m x. unfold MapsTo.
+    functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto.
+  Qed.
+
+  Lemma find_1 :  forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e.
+  Proof.
+    intros m Hm x e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (find x m);simpl; subst; try clear H_eq_1.
+
+    inversion 2.
+
+    inversion_clear 2.
+    clear e1;compute in H0; destruct H0.
+    apply lt_not_eq in H; auto. now contradict H.
+
+    clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply (lt_trans k') in _x; auto.
+    apply lt_not_eq in _x.
+    now contradict _x.
+
+    clear e1;inversion_clear 2.
+    compute in H0; destruct H0; intuition congruence.
+    generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply lt_not_eq in H. now contradict H.
+
+    clear e1; do 2 inversion_clear 1; auto.
+    compute in H2; destruct H2.
+    (* order. *)
+    subst. apply lt_not_eq in _x. now contradict _x.
+  Qed.
+
+  (** * [add] *)
+
+  Function add (k : key) (x : elt) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => (k,x) :: nil
+    | (k',y) :: l =>
+      match compare k k' with
+      | LT _ => (k,x)::s
+      | EQ _ => (k,x)::l
+      | GT _ => (k',y) :: add k x l
+      end
+    end.
+
+  Lemma add_1 : forall m x y e, eq x y -> MapsTo y e (add x e m).
+  Proof.
+    intros m x y e; generalize y; clear y.
+    unfold MapsTo.
+    functional induction (add x e m);simpl;auto.
+  Qed.
+
+  Lemma add_2 : forall m x y e e',
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof.
+    intros m x  y e e'.
+    generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m) ;simpl;auto;  clear e0.
+    subst;auto.
+
+    intros y' e'' eqky';  inversion_clear 1;  destruct H0; simpl in *.
+    (* order. *)
+    subst. now contradict eqky'.
+    auto.
+    auto.
+    intros y' e'' eqky'; inversion_clear 1; intuition.
+  Qed.
+
+  Lemma add_3 : forall m x y e e',
+      ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof.
+    intros m x y e e'. generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m);simpl; intros.
+    apply (In_inv_3 H0); compute; auto.
+    apply (In_inv_3 H0); compute; auto.
+    constructor 2; apply (In_inv_3 H0); compute; auto.
+    inversion_clear H0; auto.
+  Qed.
+
+  Lemma add_Inf : forall (m:farray)(x x':key)(e e':elt),
+      Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0,H1.
+    simpl; case (compare x x''); intuition.
+  Qed.
+  Hint Resolve add_Inf.
+
+  Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+    constructor; auto.
+    apply Inf_eq with (x',e'); auto.
+  Qed.
+
+  (** * [remove] *)
+
+  Function remove (k : key) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => nil
+    | (k',x) :: l =>
+      match compare k k' with
+      | LT _ => s
+      | EQ _ => l
+      | GT _ => (k',x) :: remove k l
+      end
+    end.
+
+  Lemma remove_1 : forall m (Hm:Sort m) x y, eq x y -> ~ In y (remove x m).
+  Proof.
+    intros m Hm x y; generalize Hm; clear Hm.
+    functional induction (remove x m);simpl;intros;subst.
+
+    red; inversion 1; inversion H0.
+
+    apply Sort_Inf_NotIn with x0; auto.
+
+    clear e0. inversion Hm. subst.
+    apply Sort_Inf_NotIn with x0; auto.
+
+    (* clear e0;inversion_clear Hm. *)
+    (* apply Sort_Inf_NotIn with x0; auto. *)
+    (* apply Inf_eq with (k',x0);auto; compute; apply eq_trans with x; auto. *)
+
+    clear e0;inversion_clear Hm.
+    assert (notin:~ In y (remove y l)) by auto.
+    intros (x1,abs).
+    inversion_clear abs.
+    compute in H1; destruct H1.
+    subst. apply lt_not_eq in _x; now contradict _x.
+    apply notin; exists x1; auto.
+  Qed.
+
+
+  Lemma remove_2 : forall m (Hm:Sort m) x y e,
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+
+    inversion_clear 3; auto.
+    compute in H1; destruct H1.
+    subst; now contradict H.
+    inversion_clear 1; inversion_clear 2; auto.
+  Qed.
+
+  Lemma remove_3 : forall m (Hm:Sort m) x y e,
+      MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto.
+    inversion_clear 1; inversion_clear 1; auto.
+  Qed.
+
+  Lemma remove_4_aux : forall m (Hm:Sort m) x y,
+      ~ eq x y -> In y m -> In y (remove x m).
+  Proof.
+    intros m Hm x y; generalize Hm; clear Hm.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+    rewrite In_alt.
+    inversion_clear 3; auto.
+    inversion H2.
+    unfold eqk in H3. simpl in H3. subst. now contradict H0.
+    apply In_alt.
+    exists x1. auto.
+    apply lt_not_eq in _x.
+    intros.
+    inversion_clear Hm.
+    inversion_clear H0.
+    unfold MapsTo in H3.
+    apply InA_eqke_eqk in H3.
+    unfold In.
+    destruct (eq_dec k' y).
+    exists x0.
+    apply InA_cons_hd.
+    split; simpl; auto.
+    inversion H3.
+    unfold eqk in H4. simpl in H4; subst. now contradict n.
+    assert ((exists e : elt, MapsTo y e (remove x l)) -> (exists e : elt, MapsTo y e ((k', x0) :: remove x l))).
+    intros.
+    destruct H6. exists x2.
+    apply InA_cons_tl. auto.
+    apply H6.
+    apply IHf; auto.
+    apply In_alt.
+    exists x1. auto.
+  Qed.
+
+  Lemma remove_4 : forall m (Hm:Sort m) x y,
+      ~ eq x y -> In y m <-> In y (remove x m).
+  Proof.
+    split.
+    apply remove_4_aux; auto.
+    revert H.
+    generalize Hm; clear Hm.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+    intros.
+    (* rewrite In_alt in *. *)
+    destruct H0 as (e, H0).
+    exists e.
+    apply InA_cons_tl. auto.
+    intros.
+    apply lt_not_eq in _x.
+    inversion_clear Hm.
+    apply In_inv in H0.
+    destruct H0.
+    (* destruct (eq_dec k' y). *)
+    exists x0.
+    apply InA_cons_hd. split; simpl; auto.
+    specialize (IHf H1 H H0).
+    inversion IHf.
+    exists x1.
+    apply InA_cons_tl. auto.
+  Qed.
+
+  Lemma remove_Inf : forall (m:farray)(Hm : Sort m)(x x':key)(e':elt),
+      Inf (x',e') m -> Inf (x',e') (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0.
+    simpl; case (compare x x''); intuition.
+    inversion_clear Hm.
+    apply Inf_lt with (x'',e''); auto.
+  Qed.
+  Hint Resolve remove_Inf.
+
+  Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+  Qed.
+
+  (** * [elements] *)
+
+  Definition elements (m: farray) := m.
+
+  Lemma elements_1 : forall m x e,
+      MapsTo x e m -> InA eqke (x,e) (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_2 : forall m x e,
+      InA eqke (x,e) (elements m) -> MapsTo x e m.
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3w : forall m (Hm:Sort m), NoDupA (elements m).
+  Proof.
+    intros.
+    apply Sort_NoDupA.
+    apply elements_3; auto.
+  Qed.
+
+  (** * [fold] *)
+
+  Function fold (A:Type)(f:key->elt->A->A)(m:farray) (acc:A) {struct m} :  A :=
+    match m with
+    | nil => acc
+    | (k,e)::m' => fold f m' (f k e acc)
+    end.
+
+  Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof.
+    intros; functional induction (fold f m i); auto.
+  Qed.
+
+  (** * [equal] *)
+
+  Function equal (cmp:elt->elt->bool)(m m' : farray) {struct m} : bool :=
+    match m, m' with
+    | nil, nil => true
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => cmp e e' && equal cmp l l'
+      | _    => false
+      end
+    | _, _ => false
+    end.
+
+  Definition Equivb cmp m m' :=
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
+
+  Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp,
+      Equivb cmp m m' -> equal cmp m m' = true.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; subst.
+    match goal with H: compare _ _ = _ |- _ => clear H end.
+    assert (cmp_e_e':cmp e e' = true).
+    apply H1 with x; auto.
+    rewrite cmp_e_e'; simpl.
+    apply IHb; auto.
+    inversion_clear Hm; auto.
+    inversion_clear Hm'; auto.
+    unfold Equivb; intuition.
+    destruct (H0 k).
+    assert (In k ((x,e) ::l)).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H2 H4)); auto.
+    inversion_clear Hm.
+    elim (Sort_Inf_NotIn H6 H7).
+    destruct H as (e'', hyp); exists e''; auto.
+    apply MapsTo_eq with k; auto.
+    destruct (H0 k).
+    assert (In k ((x,e') ::l')).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H3 H4)); auto.
+    subst.
+    inversion_clear Hm'.
+    now elim (Sort_Inf_NotIn H5 H6).
+    apply H1 with k; destruct (eq_dec x k); auto.
+
+
+    destruct (compare x x') as [Hlt|Heq|Hlt]; try contradiction; clear y.
+    destruct (H0 x).
+    assert (In x ((x',e')::l')).
+    apply H; auto.
+    exists e; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm'.
+    assert (Inf (x,e) l').
+    apply Inf_lt with (x',e'); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct (H0 x').
+    assert (In x' ((x,e)::l)).
+    apply H2; auto.
+    exists e'; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    subst; apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm.
+    assert (Inf (x',e') l).
+    apply Inf_lt with (x,e); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct m;
+      destruct m';try contradiction.
+
+    clear H1;destruct p as (k,e).
+    destruct (H0 k).
+    destruct H1.
+    exists e; auto.
+    inversion H1.
+
+    destruct p as (x,e).
+    destruct (H0 x).
+    destruct H.
+    exists e; auto.
+    inversion H.
+
+    destruct p;destruct p0;contradiction.
+  Qed.
+
+  Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp,
+      equal cmp m m' = true -> Equivb cmp m m'.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; try discriminate; subst;
+        try match goal with H: compare _ _ = _ |- _ => clear H end.
+
+    inversion H0.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e'; constructor; split; trivial; apply eq_trans with x; auto.
+    destruct (H k).
+    destruct (H9 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e; constructor; split; trivial; apply eq_trans with x'; auto.
+    destruct (H k).
+    destruct (H10 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H2 H4 H7).
+    inversion_clear H0.
+    destruct H9; simpl in *; subst.
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H4 H5).
+    exists e'0; apply MapsTo_eq with x; auto.
+      (* order. *)
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H2 H3).
+    exists e0; apply MapsTo_eq with x; auto.
+    (* order. *)
+    apply H8 with k; auto.
+  Qed.
+
+  (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *)
+
+  Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
+    eqk x y -> cmp (snd x) (snd y) = true ->
+    (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)).
+  Proof.
+    intros.
+    inversion H; subst.
+    inversion H0; subst.
+    destruct x; destruct y; compute in H1, H2.
+    split; intros.
+    apply equal_2; auto.
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl.
+    apply equal_1; auto.
+    apply equal_2; auto.
+    generalize (equal_1 H H0 H3).
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl; auto.
+  Qed.
+
+End Array.
+
+End Raw.
+
+
+(** * Functional Arrays *)
+
+Section FArray.
+
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+  Variable elt_comp : Comparable elt.
+  (* Variable key_inh :  Inhabited key. *)
+  (* Variable elt_inh :  Inhabited elt. *)
+
+  Set Implicit Arguments.
+
+  Definition NoDefault l (d:elt) := forall k:key, ~ Raw.MapsTo k d l.
+
+  Record slist :=
+    {this :> Raw.farray key elt;
+     sorted : sort (Raw.ltk key_ord) this;
+     default : elt;
+     nodefault : NoDefault this default;
+    }.
+  Definition farray := slist.
+
+  Lemma empty_nodefault : forall d, NoDefault (Raw.empty key elt) d.
+    unfold NoDefault.
+    intros.
+    apply Raw.empty_1.
+  Qed.
+
+  (** Boolean comparison over elements *)
+  Definition cmp (e e':elt) :=
+    match compare e e' with EQ _ => true | _ => false end.
+
+
+  Lemma cmp_refl : forall e, cmp e e = true.
+    unfold cmp.
+    intros.
+    destruct (compare e e); auto;
+      apply lt_not_eq in l; now contradict l.
+  Qed.
+
+  Lemma remove_nodefault : forall l d (Hd:NoDefault l d) (Hs:Sorted (Raw.ltk key_ord) l) x ,
+      NoDefault (Raw.remove key_comp x l) d.
+  Proof.
+    intros.
+    unfold NoDefault. intros.
+    unfold not. intro.
+    apply Raw.remove_3 in H; auto.
+    now apply Hd in H.
+  Qed.
+
+  Definition raw_add_nodefault (k:key) (x:elt) (default:elt) (l:Raw.farray key elt) :=
+    if cmp x default then
+      if Raw.mem key_comp k l then Raw.remove key_comp k l
+      else l
+    else Raw.add key_comp k x l.
+
+
+  Lemma add_sorted : forall l d (Hs:Sorted (Raw.ltk key_ord) l) x e,
+      Sorted (Raw.ltk key_ord) (raw_add_nodefault x e d l).
+  Proof.
+    intros.
+    unfold raw_add_nodefault.
+    case (cmp e d); auto.
+    case (Raw.mem key_comp x l); auto.
+    apply Raw.remove_sorted; auto.
+    apply Raw.add_sorted; auto.
+  Qed.
+
+  Lemma add_nodefault : forall l d (Hd:NoDefault l d) (Hs:Sorted (Raw.ltk key_ord) l) x e,
+      NoDefault (raw_add_nodefault x e d l) d.
+  Proof.
+    intros.
+    unfold raw_add_nodefault.
+    case_eq (cmp e d); intro; auto.
+    case_eq (Raw.mem key_comp x l); intro; auto.
+    apply remove_nodefault; auto.
+    unfold NoDefault; intros.
+    assert (e <> d).
+      unfold cmp in H.
+      case (compare e d) in H; try now contradict H.
+      apply lt_not_eq in l0; auto.
+      apply lt_not_eq in l0; now auto.
+    destruct (eq_dec k x).
+    - symmetry in e0.
+      apply (Raw.add_1 key_dec key_comp l e) in e0.
+      unfold not; intro.
+      specialize (Raw.add_sorted key_dec key_comp Hs x e).
+      intro Hsadd.
+      specialize (Raw.MapsTo_inj key_dec Hsadd e0 H1).
+      intro. contradiction.
+    - unfold not; intro.
+      assert (x <> k). unfold not in *. intro. apply n. symmetry; auto.
+      specialize (Raw.add_3 key_dec key_comp l e H2 H1).
+      intro. now apply Hd in H3.
+  Qed.
+
+  (* Definition empty : farray := *)
+  (*   Build_slist (Raw.empty_sorted elt key_ord) empty_nodefault. *)
+
+  Definition const_array (default:elt) : farray :=
+    Build_slist
+      (Raw.empty_sorted elt key_ord)
+      (@empty_nodefault default).
+
+  Definition is_const_default m : bool := Raw.is_empty m.(this).
+
+  Definition add x e m : farray :=
+    Build_slist (add_sorted m.(default) m.(sorted) x e)
+                (add_nodefault m.(nodefault) m.(sorted) x e).
+
+  Definition find x m : option elt := Raw.find key_comp x m.(this).
+
+  Definition remove x m : farray :=
+    Build_slist
+      (Raw.remove_sorted key_comp m.(sorted) x)
+      (remove_nodefault m.(nodefault) m.(sorted) x).
+
+  Definition mem x m : bool := Raw.mem key_comp x m.(this).
+  Definition elements m : list (key*elt) := Raw.elements m.(this).
+  Definition cardinal m := length m.(this).
+  Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A :=
+    Raw.fold f m.(this) i.
+  Definition equal m m' : bool :=
+    if eq_dec m.(default) m'.(default) then
+       Raw.equal key_comp cmp m.(this) m'.(this)
+    else false.
+
+  Definition MapsTo x e m : Prop := Raw.MapsTo x e m.(this).
+  Definition In x m : Prop := Raw.In x m.(this).
+  Definition Empty m : Prop := Raw.Empty m.(this).
+
+  Definition Equal m m' :=
+    m.(default) = m'.(default) /\
+    forall y, find y m = find y m'.
+  
+  Definition Equiv m m' :=
+    m.(default) = m'.(default) /\
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> e = e').
+  
+  Definition Equivb m m' : Prop :=
+    m.(default) = m'.(default) /\
+    Raw.Equivb cmp m.(this) m'.(this).
+
+  Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.eqk key elt.
+  Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.eqke key elt.
+  Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.ltk key elt key_ord.
+
+  Lemma MapsTo_1 : forall m x y e, eq x y -> MapsTo x e m -> MapsTo y e m.
+  Proof. intros m.
+    apply (Raw.MapsTo_eq key_dec elt_dec). Qed.
+
+  Lemma mem_1 : forall m x, In x m -> mem x m = true.
+  Proof. intros m; apply (Raw.mem_1); auto. apply m.(sorted). Qed.
+  Lemma mem_2 : forall m x, mem x m = true -> In x m.
+  Proof. intros m; apply (Raw.mem_2); auto. apply m.(sorted). Qed.
+
+  
+  Lemma add_1 : forall m x y e, e <> m.(default) -> eq x y -> MapsTo y e (add x e m).
+  Proof. intros.
+    unfold add, raw_add_nodefault.
+    unfold MapsTo. simpl.
+    case_eq (cmp e m.(default)); intro; auto.
+    unfold cmp in H1. destruct (compare e m.(default)); try now contradict H1.
+    apply Raw.add_1; auto.
+  Qed.
+
+  Lemma add_2 : forall m x y e e', ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof.
+    intros.
+    unfold add, raw_add_nodefault, MapsTo. simpl.
+    case_eq (cmp e' m.(default)); intro; auto.
+    case_eq (Raw.mem key_comp x m); intro; auto.
+    apply (Raw.remove_2 _ m.(sorted)); auto.
+    apply Raw.add_2; auto.
+  Qed.
+
+  Lemma add_3 : forall m x y e e', ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof.
+    unfold add, raw_add_nodefault, MapsTo. simpl.
+    intros m x y e e'.
+    case_eq (cmp e' m.(default)); intro; auto.
+    case_eq (Raw.mem key_comp x m); intro; auto.
+    intro. apply (Raw.remove_3 _ m.(sorted)); auto.
+    apply Raw.add_3; auto.
+  Qed.
+
+  Lemma remove_1 : forall m x y, eq x y -> ~ In y (remove x m).
+  Proof. intros m; apply Raw.remove_1; auto. apply m.(sorted). Qed.
+
+  Lemma remove_2 : forall m x y e, ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof. intros m; apply Raw.remove_2; auto. apply m.(sorted). Qed.
+
+  Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof. intros m; apply Raw.remove_3; auto. apply m.(sorted). Qed.
+
+  Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e.
+  Proof. intros m; apply Raw.find_1; auto. apply m.(sorted). Qed.
+
+  Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof. intros m; apply Raw.find_2; auto. Qed.
+
+  Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
+  Proof. intros m; apply Raw.elements_1. Qed.
+
+  Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
+  Proof. intros m; apply Raw.elements_2. Qed.
+
+  Lemma elements_3 : forall m, sort lt_key (elements m).
+  Proof. intros m; apply Raw.elements_3; auto. apply m.(sorted). Qed.
+
+  Lemma elements_3w : forall m, NoDupA eq_key (elements m).
+  Proof. intros m; apply (Raw.elements_3w key_dec m.(sorted)). Qed.
+
+  Lemma cardinal_1 : forall m, cardinal m = length (elements m).
+  Proof. intros; reflexivity. Qed.
+
+  Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof. intros m; apply Raw.fold_1. Qed.
+
+  Lemma equal_1 : forall m m', Equivb m m' -> equal m m' = true.
+  Proof. intros m m'; unfold Equivb, equal.
+    case (eq_dec (default m) (default m')); intro H.
+    - intro H0. destruct H0.
+      apply Raw.equal_1; auto. apply m.(sorted). apply  m'.(sorted).
+    - intro H0. destruct H0. now contradict H.
+  Qed.
+
+  
+  Lemma equal_2 : forall m m', equal m m' = true -> Equivb m m'.
+  Proof. intros m m'; unfold Equivb, equal.
+    case (eq_dec (default m) (default m')); intros.
+    - split; auto. 
+      apply Raw.equal_2 in H; auto. apply m.(sorted). apply m'.(sorted).
+    - now contradict H.
+  Qed.
+
+  Fixpoint eq_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => True
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => eq e e' /\ eq_list l l'
+      | _       => False
+      end
+    | _, _ => False
+    end.
+
+  Definition eq m m' :=
+    if eq_dec m.(default) m'.(default) then
+      eq_list m.(this) m'.(this)
+    else False.
+
+  
+  Lemma nodefault_tail : forall x m d, NoDefault (x :: m) d -> NoDefault m d.
+    unfold NoDefault. unfold not in *. intros.
+    apply (H k). unfold Raw.MapsTo. apply InA_cons_tl. apply H0.
+  Qed.
+
+  Lemma raw_equal_eq : forall a (Ha: Sorted (Raw.ltk key_ord) a) b (Hb: Sorted (Raw.ltk key_ord) b),
+      Raw.equal key_comp cmp a b = true -> a = b.
+  Proof.
+    induction a; intros.
+    simpl in H.
+    case b in *; auto.
+    now contradict H.
+    destruct a as (xa, ea).
+    simpl in H.
+    case b in *.
+    now contradict H.
+    destruct p as (xb, eb).
+    destruct (compare xa xb); auto; try (now contradict H).
+    rewrite andb_true_iff in H. destruct H.
+    unfold cmp in H.
+    destruct (compare ea eb); auto; try (now contradict H).
+    subst. apply f_equal.
+    apply IHa; auto.
+    now inversion Ha.
+    now inversion Hb.
+  Qed.
+
+  Lemma eq_equal : forall m m', eq m m' <-> equal m m' = true.
+  Proof.
+    intros (l,Hl,d,Hd); induction l.
+    intros (l',Hl',d',Hd'); unfold eq, equal; simpl; case (eq_dec d d'); intro;
+      destruct l'; simpl; intuition.
+    intros (l',Hl',d',Hd'); unfold eq. simpl.
+    unfold equal; simpl; case (eq_dec d d'); intro He; simpl; [ | now intuition].
+    destruct l'.
+    destruct a; unfold equal; simpl; intuition.
+    destruct a as (x,e).
+    destruct p as (x',e').
+    unfold equal; simpl.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; simpl; intuition.
+    unfold cmp at 1.
+    case (compare e e');
+    subst x' e'; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+    clear HH; simpl.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    apply nodefault_tail in Hd.
+    apply nodefault_tail in Hd'.
+    destruct (IHl H Hd (Build_slist H2 Hd')).
+    unfold equal, eq in H5, H4; simpl in H5, H4; subst d'.
+    destruct (eq_dec d d); auto.
+    destruct (andb_prop _ _ H); clear H.
+    generalize H0; unfold cmp.
+    case (compare e e');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+      auto; intro; discriminate.
+    destruct (andb_prop _ _ H); clear H.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    apply nodefault_tail in Hd.
+    apply nodefault_tail in Hd'.
+    destruct (IHl H Hd (Build_slist H3 Hd')).
+    unfold equal, eq in H5, H6; simpl in H5, H6; subst d'.
+    destruct (eq_dec d d); auto. now contradict n.
+  Qed.
+
+  Lemma eq_1 : forall m m', Equivb m m' -> eq m m'.
+  Proof.
+    intros.
+    generalize (@equal_1 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eq_2 : forall m m', eq m m' -> Equivb m m'.
+  Proof.
+    intros.
+    generalize (@equal_2 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eqfarray_refl : forall m : farray, eq m m.
+  Proof.
+    intros (m,Hm,d,Hd). unfold eq. simpl.
+    destruct (eq_dec d d); auto.
+    induction m; simpl; auto.
+    destruct a.
+    destruct (compare k k) as [Hlt|Heq|Hlt]; auto.
+    apply lt_not_eq in Hlt. auto.
+    split.
+    apply eq_refl.
+    inversion_clear Hm.
+    apply nodefault_tail in Hd.
+    apply (IHm H Hd).
+    apply lt_not_eq in Hlt. auto.
+  Qed.
+
+  Lemma eqfarray_sym : forall m1 m2 : farray, eq m1 m2 -> eq m2 m1.
+  Proof.
+    unfold eq.
+    intros (m,Hm,d,Hd); induction m;
+      intros (m',Hm',d',Hd'); destruct m'; unfold eq; simpl;
+        destruct (eq_dec d d'); auto; intuition;
+        subst d'; destruct (eq_dec d d) as [He | He]; auto;
+          try destruct a as (x,e); try destruct p as (x',e'); auto; intuition.
+    destruct (compare x x')  as [Hlt|Heq|Hlt]; try easy.
+    inversion_clear Hm; inversion_clear Hm'. destruct H.
+    apply nodefault_tail in Hd. apply nodefault_tail in Hd'.
+    (* intro. destruct H3. *)
+    subst.
+    case (compare x' x');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    specialize (IHm H0 Hd (Build_slist H2 Hd')).
+    simpl in IHm. case (eq_dec d d) in IHm; intuition.
+  Qed.
+
+  Lemma eqfarray_trans : forall m1 m2 m3 : farray, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
+  Proof.
+    unfold eq.
+    intros (m1,Hm1,d1,Hd1); induction m1;
+      intros (m2,Hm2,d2,Hd2); destruct m2;
+        intros (m3,Hm3,d3,Hd3); destruct m3; unfold eq; simpl;
+          destruct (eq_dec d1 d2);
+          destruct (eq_dec d2 d3);
+          destruct (eq_dec d1 d3); simpl in *; subst; intuition;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt']; try easy.
+    intros; destruct H, H0;  subst.
+    case (compare x'' x'');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply nodefault_tail in Hd1.
+    apply nodefault_tail in Hd2.
+    apply nodefault_tail in Hd3.
+    specialize (IHm1 H Hd1 (Build_slist H3 Hd2) (Build_slist H5 Hd3)).
+    simpl in IHm1.
+    case (eq_dec d3 d3) in IHm1; intuition.
+  Qed.
+
+  Fixpoint lt_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => False
+    | nil, _  => True
+    | _, nil  => False
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | LT _ => True
+      | GT _ => False
+      | EQ _ => lt e e' \/ (e = e' /\ lt_list l l')
+      end
+    end.
+
+  Definition lt_farray m m' :=
+    lt m.(default) m'.(default) \/
+    (m.(default) = m'.(default) /\
+     lt_list m.(this) m'.(this)).
+
+  Lemma lt_farray_trans : forall m1 m2 m3 : farray,
+      lt_farray m1 m2 -> lt_farray m2 m3 -> lt_farray m1 m3.
+  Proof.
+    intros (m1,Hm1,d1,Hd1); induction m1;
+      intros (m2,Hm2,d2,Hd2); destruct m2;
+        intros (m3,Hm3,d3,Hd3); destruct m3; unfold lt_farray; simpl;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; intuition; auto;
+            try (left; apply (lt_trans d1 d2 d3); now auto);
+            try (left; subst; now auto);
+            try (right; subst; auto).
+    split; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt'];
+      destruct (compare x x'') as [Hlt''|Heq''|Hlt'']; intros; subst; auto; try easy.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt.
+    apply (lt_trans _ x'') ; auto.
+    apply lt_not_eq in Hlt. now contradict Hlt.
+    apply (lt_trans x'') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    subst.
+    apply lt_not_eq in Hlt'. now contradict Hlt'.
+    apply (lt_trans x'') in Hlt'; apply lt_not_eq in Hlt'.
+    now contradict Hlt'. auto.
+    destruct H2, H3.
+    left; apply lt_trans with e'; auto.
+    left. destruct H0. subst; auto.
+    left. destruct H. subst; auto.
+    right. destruct H, H0. subst; split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply nodefault_tail in Hd1.
+    apply nodefault_tail in Hd2.
+    apply nodefault_tail in Hd3.
+    specialize (IHm1 H Hd1 (Build_slist H3 Hd2) (Build_slist H5 Hd3)).
+    unfold lt_farray in IHm1. simpl in IHm1. destruct IHm1; auto.
+    apply lt_not_eq in H7. now contradict H7.
+    destruct H7; auto.
+    apply lt_not_eq in Hlt''. now contradict Hlt''.
+  Qed.
+
+  Lemma lt_farray_not_eq : forall m1 m2 : farray, lt_farray m1 m2 -> ~ eq m1 m2.
+  Proof.
+    intros (m1,Hm1,d1,Hd1); induction m1;
+      intros (m2,Hm2,d2,Hd2); destruct m2; unfold eq, lt, lt_farray; simpl;
+        try destruct a as (x,e);
+        try destruct p as (x',e'); try contradiction; auto; intuition;
+          destruct (eq_dec d1 d2); intuition.
+    apply lt_not_eq in H1. now contradict H1.
+    apply lt_not_eq in H1. now contradict H1.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; auto.
+    (* intuition. *)
+    inversion_clear Hm1; inversion_clear Hm2.
+    specialize (nodefault_tail Hd2).
+    specialize (nodefault_tail Hd1). intros.
+    subst.
+    apply (IHm1 H1 H6 (Build_slist H4 H7)); intuition;
+      unfold lt_farray in *; simpl in *;
+        try (apply lt_not_eq in H0; now contradict H0).
+    right; split; auto.
+    unfold eq. simpl.
+    destruct (eq_dec d2 d2); intuition.
+  Qed.
+
+  Definition compare_farray : forall m1 m2, Compare lt_farray eq m1 m2.
+  Proof.
+    intros m1 m2.
+    destruct (compare m1.(default) m2.(default)).
+    - apply LT.
+      unfold lt_farray. simpl; auto.
+    - revert m1 m2 e.
+      intros (m1,Hm1,d1,Hd1); induction m1;
+      intros (m2,Hm2,d2,Hd2); destruct m2; simpl; intro He; subst;
+        [ apply EQ | apply LT | apply GT | ]; auto.
+    (* cmp_solve. *)
+      + unfold eq. simpl. destruct (eq_dec d2 d2); auto.
+      + unfold lt_farray. simpl. right; auto.
+      + unfold lt_farray. simpl. right; auto.
+      + destruct a as (x,e); destruct p as (x',e').
+        destruct (compare x x');
+          [ apply LT | | apply GT ].
+        unfold lt_farray. simpl.
+        destruct (compare x x'); auto.
+        subst. apply lt_not_eq in l; now contradict l.
+        apply (lt_trans x') in l; auto. subst. apply lt_not_eq in l; now contradict l.
+        (* subst. *)
+        destruct (compare e e');
+          [ apply LT | | apply GT ].
+         * unfold lt_farray. simpl.
+           destruct (compare x x'); auto;
+             try (subst; apply lt_not_eq in l0; now contradict l0).
+         * assert (Hm11 : sort (Raw.ltk key_ord) m1).
+           inversion_clear Hm1; auto.
+           assert (Hm22 : sort (Raw.ltk key_ord) m2).
+           inversion_clear Hm2; auto.
+           specialize (nodefault_tail Hd2). specialize (nodefault_tail Hd1).
+           intros Hd11 Hd22.
+           destruct (IHm1 Hm11 Hd11 (Build_slist Hm22 Hd22));
+             [ simpl; auto | apply LT | apply EQ | apply GT ].
+           -- unfold lt_farray in *. simpl in *.
+              destruct (compare x x'); auto;
+                try (subst; apply lt_not_eq in l0; now contradict l0).
+              intuition.
+           -- unfold eq in *. simpl in *.
+              destruct (compare x x'); auto;
+                try (subst; apply lt_not_eq in l; now contradict l).
+              destruct (eq_dec d2 d2); intuition.
+           -- unfold lt_farray in *. simpl in *.
+              destruct (compare x' x); auto;
+                try (subst; apply lt_not_eq in l0; now contradict l0).
+              intuition.
+         * unfold lt_farray in *. simpl.
+           destruct (compare x' x); auto;
+             try (subst; apply lt_not_eq in l0; now contradict l0).
+         * unfold lt_farray in *. simpl.
+           destruct (compare x' x); auto;
+             try (subst; apply lt_not_eq in l; now contradict l).
+           apply (lt_trans x) in l; auto.
+           apply lt_not_eq in l; now contradict l.
+    - apply GT.
+      unfold lt_farray. simpl; auto.
+  Qed.
+
+  Lemma eq_option_alt : forall (elt:Type)(o o':option elt),
+      o=o' <-> (forall e, o=Some e <-> o'=Some e).
+  Proof.
+    split; intros.
+    subst; split; auto.
+    destruct o; destruct o'; try rewrite H; auto.
+    symmetry; rewrite <- H; auto.
+  Qed.
+
+  Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e.
+  Proof.
+    split; [apply find_1|apply find_2].
+  Qed.
+
+  Lemma add_neq_mapsto_iff : forall m x y e e',
+      x <> y -> (MapsTo y e' (add x e m)  <-> MapsTo y e' m).
+  Proof.
+    split; [apply add_3|apply add_2]; auto.
+  Qed.
+
+
+  Lemma add_eq_o : forall m x y e,
+      x = y -> e <> m.(default) -> find y (add x e m) = Some e.
+  Proof. intros.
+    apply find_1.
+    apply add_1; auto.
+  Qed.
+
+  Lemma raw_add_d_rem : forall m (Hm: Sorted (Raw.ltk key_ord) m) x d,
+      raw_add_nodefault x d d m = Raw.remove key_comp x m.
+    intros.
+    unfold raw_add_nodefault.
+    rewrite cmp_refl.
+    case_eq (Raw.mem key_comp x m); intro.
+    auto.
+    apply Raw.mem_3 in H; auto.
+    apply raw_equal_eq; auto.
+    apply Raw.remove_sorted; auto.
+    apply Raw.equal_1; auto.
+    apply Raw.remove_sorted; auto.
+    unfold Raw.Equivb.
+    split.
+    intros.
+    destruct (eq_dec x k). subst.
+    split. intro. contradiction.
+    intro. contradict H0.
+    apply Raw.remove_1; auto.
+    apply Raw.remove_4; auto.
+
+    intros.
+    destruct (eq_dec x k).
+    assert (exists e, InA (Raw.eqk (elt:=elt)) (k, e) (Raw.remove key_comp x m)).
+    exists e'. apply Raw.InA_eqke_eqk; auto.
+    rewrite <- Raw.In_alt in H2; auto.
+    contradict H2.
+    apply Raw.remove_1; auto.
+    apply key_comp.
+    apply (Raw.remove_2 key_comp Hm n) in H0.
+    specialize (Raw.remove_sorted key_comp Hm x). intros.
+    specialize (Raw.MapsTo_inj key_dec H2 H0 H1).
+    intro. subst. apply cmp_refl.
+  Qed.
+
+  Lemma add_d_rem : forall m x, add x m.(default) m = remove x m.
+    intros.
+    unfold add, remove.
+    specialize (raw_add_d_rem m.(sorted) x). intro.
+    generalize (add_sorted m.(default) m.(sorted) x m.(default)).
+    generalize (add_nodefault (nodefault m) (sorted m) x m.(default)).
+    generalize (Raw.remove_sorted key_comp (sorted m) x).
+    generalize (remove_nodefault (nodefault m) (sorted m) x).
+    rewrite H.
+    intros H4 H3 H2 H1.
+    rewrite (proof_irrelevance _ H1 H3), (proof_irrelevance _ H2 H4).
+    reflexivity.
+  Qed.
+
+  Lemma add_eq_d : forall m x y,
+      x = y -> find y (add x m.(default) m) = None.
+  Proof.
+    intros.
+    simpl.
+    rewrite add_d_rem.
+    case_eq (find y (remove x m)); auto.
+    intros.
+    apply find_2 in H0.
+    unfold MapsTo, Raw.MapsTo in H0.
+    assert (exists e, InA (Raw.eqk (elt:=elt)) (y, e) (remove x m).(this)).
+    exists e. apply Raw.InA_eqke_eqk in H0. auto.
+    rewrite <- Raw.In_alt in H1; auto.
+    contradict H1.
+    apply remove_1; auto.
+    apply key_comp.
+  Qed.
+
+  Lemma add_neq_o : forall m x y e,
+      ~ x = y -> find y (add x e m) = find y m.
+  Proof.
+    intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff.
+    apply add_neq_mapsto_iff; auto.
+  Qed.
+  Hint Resolve add_neq_o.
+
+  Lemma MapsTo_fun : forall m x (e e':elt),
+      MapsTo x e m -> MapsTo x e' m -> e=e'.
+  Proof.
+    intros.
+    generalize (find_1 H) (find_1 H0); clear H H0.
+    intros; rewrite H in H0; injection H0; auto.
+  Qed.
+
+  (** Another characterisation of [Equal] *)
+
+  Lemma Equal_mapsto_iff : forall m1 m2 : farray,
+      Equal m1 m2 <->
+      (m1.(default) = m2.(default) /\ forall k e, MapsTo k e m1 <-> MapsTo k e m2).
+  Proof.
+    intros m1 m2. split.
+    intros Heq.
+    unfold Equal in Heq. destruct Heq as (Hd, Heq).
+    split; auto.
+    intros k e.
+    rewrite 2 find_mapsto_iff, Heq. split; auto.
+    intros (Hd, Hiff).
+    unfold Equal. split; auto.
+    intro k. rewrite eq_option_alt. intro e.
+    rewrite <- 2 find_mapsto_iff; auto.
+  Qed.
+
+  (** * Relations between [Equal], [Equiv] and [Equivb]. *)
+
+  (** First, [Equal] is [Equiv] with Leibniz on elements. *)
+
+  Lemma Equal_Equiv : forall (m m' : farray),
+      Equal m m' <-> Equiv m m'.
+  Proof.
+    intros. rewrite Equal_mapsto_iff. split; intros.
+    destruct H as (Hd, H).
+    split; auto.
+    split. intro k.
+    unfold In, Raw.In.
+    split; intros H0; destruct H0 as (e, H0);
+    exists e; unfold MapsTo in H; [rewrite <- H|rewrite H]; auto.
+    intros; apply MapsTo_fun with m k; auto; rewrite H; auto.
+    unfold Equiv in H. destruct H as (Hd, (Hi, Hm)).
+    split; auto. intros k e. split; intro H.
+    assert (Hin : In k m') by (rewrite <- Hi; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite (Hm k e e'); auto.
+    assert (Hin : In k m) by (rewrite Hi; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite <- (Hm k e' e); auto.
+  Qed.
+
+  Lemma Equiv_Equivb : forall m m', Equiv m m' <-> Equivb m m'.
+  Proof.
+    unfold Equiv, Equivb, Raw.Equivb, cmp; intuition.
+    specialize (H2 k e e' H1 H3).
+    destruct (compare e e'); auto; apply lt_not_eq in l; auto.
+    specialize (H2 k e e' H1 H3).
+    destruct (compare e e'); auto; now contradict H2.
+  Qed.
+
+  (** Composition of the two last results: relation between [Equal]
+    and [Equivb]. *)
+
+  Lemma Equal_Equivb : forall (m m':farray), Equal m m' <-> Equivb m m'.
+  Proof.
+    intros; rewrite Equal_Equiv.
+    apply Equiv_Equivb; auto.
+  Qed.
+
+  (** * Functional arrays with default value *)
+
+  Definition select (a: farray) (i: key) : elt :=
+    match find i a with
+    | Some v => v
+    | None => a.(default)
+    end.
+
+  Definition store (a: farray) (i: key) (v: elt) : farray := add i v a.
+
+  Lemma read_over_same_write : forall a i j v, i = j -> select (store a i v) j = v.
+  Proof.
+    intros a i j v Heq.
+    unfold select, store.
+    case_eq (cmp v a.(default)); intro; auto.
+    unfold cmp in H.
+    case (compare v a.(default)) in H; auto; try now contradict H.
+    rewrite e.
+    rewrite add_eq_d; auto.
+    assert (v <> a.(default)).
+    unfold cmp in H.
+    case (compare v a.(default)) in H; auto; try now contradict H.
+    apply lt_not_eq in l. auto.
+    apply lt_not_eq in l. auto.
+    rewrite (add_eq_o a Heq H0). auto.
+  Qed.
+
+  Lemma read_over_write : forall a i v, select (store a i v) i = v.
+  Proof.
+    intros; apply read_over_same_write; auto.
+  Qed.
+
+  Lemma read_over_other_write : forall a i j v,
+      i <> j -> select (store a i v) j = select a j.
+  Proof.
+    intros a i j v Hneq.
+    unfold select, store.
+    apply (add_neq_o a v) in Hneq.
+    rewrite Hneq. auto.
+  Qed.
+
+  Lemma find_ext_dec:
+    (forall m1 m2: farray, Equal m1 m2 -> (equal m1 m2) = true).
+  Proof. intros.
+    apply Equal_Equivb in H.
+    apply equal_1.
+    exact H.
+  Qed.
+
+  (** Provable only if [elt] is an infinite type *)
+  Lemma extensionnality_eqb : forall a b,
+      (forall i, select a i = select b i) -> equal a b = true.
+  Proof.
+    intros.
+    unfold select in H.
+    (* assert ((exists i : key, find i a = None) -> a.(default) = b.(default)). *)
+    (* { *)
+    (*   intros. destruct H0. *)
+    (*   specialize (H x). *)
+    (*   rewrite H0 in H. *)
+    (*   i. specialize (H i). *)
+      
+    (*   case_eq (find i a); *)
+    (*     case_eq (find i b). *)
+    (*     intros. rewrite H0 in *; rewrite H1 in *. subst; auto. *)
+
+    (* } *)
+    
+    cut (a.(default) = b.(default)). intro Hd.
+    assert (forall i, find i a = find i b).
+    {
+      intro i. specialize (H i).
+      case_eq (find i a); case_eq (find i b);
+        intros; rewrite H0 in *; rewrite H1 in *; subst; auto.
+      + apply find_2 in H1.
+        contradict H1.
+        unfold MapsTo.
+        rewrite <- Hd.
+        apply a.(nodefault).
+      + apply find_2 in H0.
+        contradict H0.
+        unfold MapsTo.
+        rewrite Hd.
+        apply b.(nodefault).
+    }
+    apply find_ext_dec. split; auto.
+    cut (exists k, find k a = None /\ find k b = None). intro.
+    destruct H0 as (k, (Ha, Hb)). specialize (H k).
+    rewrite Ha, Hb in H. auto.
+    destruct a, b; simpl in *.
+    (* No *)
+  Qed.
+
+  Lemma equal_eq : forall a b, equal a b = true -> a = b.
+  Proof. intros. apply eq_equal in H.
+    destruct a as (a, asort, anodef), b as (b, bsort, bnodef).
+    unfold eq in H.
+    revert b bsort bnodef H.
+    induction a; intros; destruct b.
+    rewrite (proof_irrelevance _ asort bsort).
+    rewrite (proof_irrelevance _ anodef bnodef).
+    auto.
+    simpl in H. now contradict H.
+    simpl in H. destruct a; now contradict H.
+    simpl in H. destruct a, p.
+    destruct (compare k k0); auto; try (now contradict H).
+    destruct H.
+    subst.
+    inversion_clear asort.
+    inversion_clear bsort.
+    specialize (nodefault_tail bnodef).
+    specialize (nodefault_tail anodef). intros.
+    specialize (IHa H H4 b H2 H5 H0).
+    inversion IHa. subst.
+    rewrite (proof_irrelevance _ asort bsort).
+    rewrite (proof_irrelevance _ anodef bnodef).
+    reflexivity.
+ Qed.
+
+  Lemma notequal_neq : forall a b, equal a b = false -> a <> b.
+    intros.
+    red. intros.
+    apply not_true_iff_false in H.
+    unfold not in *. intros.
+    apply H. rewrite H0.
+    apply eq_equal. apply eqfarray_refl.
+  Qed.
+
+  Lemma extensionnality : forall a b, (forall i, select a i = select b i) -> a = b.
+  Proof.
+    intros; apply equal_eq; apply extensionnality_eqb; auto.
+  Qed.
+
+(** farray equal in Prop *)
+  Definition equalP (m m' : farray) : Prop :=
+    if equal m m' then True else False.
+
+  Lemma eq_list_refl: forall a, eq_list a a.
+  Proof.
+    intro a.
+    induction a; intros.
+    - now simpl.
+    - simpl. destruct a as (k, e).
+      case_eq (compare k k); intros.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+      + split; easy.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+  Qed.
+
+  Lemma equal_refl: forall a, equal a a = true.
+  Proof. intros; apply eq_equal; apply eq_list_refl. Qed.
+
+  Lemma equal_eqP : forall a b, equalP a b <-> a = b.
+  Proof. 
+     intros. split; intro H. unfold equalP in H.
+     case_eq (equal a b); intros; rewrite H0 in H.
+     now apply equal_eq. now contradict H.
+     rewrite H. unfold equalP.
+     now rewrite equal_refl.
+  Qed.
+
+ Lemma equal_B2P: forall (m m' : farray),
+                  equal m m' = true <-> equalP m m'.
+ Proof.
+     intros. split; intros.
+     apply equal_eq in H. rewrite H.
+     unfold equalP. now rewrite equal_refl.
+     apply equal_eqP in H.
+     now rewrite H, equal_refl.
+ Qed.
+
+  Section Classical_extensionnality.
+
+    Require Import Classical_Pred_Type ClassicalEpsilon.
+
+    Lemma extensionnality2 : forall a b, a <> b -> (exists i, select a i <> select b i).
+    Proof.
+      intros.
+      apply not_all_ex_not.
+      unfold not in *.
+      intros. apply H. apply extensionnality; auto.
+    Qed.
+
+    Definition diff_index_p : forall a b, a <> b -> { i | select a i <> select b i } :=
+      (fun a b u => constructive_indefinite_description _ (@extensionnality2 _ _ u)).
+
+    Definition diff_index : forall a b, a <> b -> key :=
+      (fun a b u => proj1_sig (diff_index_p u)).
+
+
+    Example d : forall a b (u:a <> b), let i := diff_index u in select a i <> select b i.
+      unfold diff_index.
+      intros.
+      destruct (diff_index_p u). simpl. auto.
+    Qed.
+
+    Definition diff (a b: farray) : key.
+      case_eq (equal a b); intro.
+      - apply default_value.
+      - apply (diff_index (notequal_neq H)).
+        (* destruct (diff_index_p H). apply x. *)
+    Defined.
+
+   Lemma select_at_diff: forall a b, a <> b ->
+            select a (diff a b) <> select b (diff a b).
+   Proof.
+     intros a b H. unfold diff.
+     assert (equal a b = false).
+     apply not_true_iff_false.
+     red. intro. apply equal_eq in H0. subst. auto.
+     generalize (@notequal_neq a b).
+     rewrite H0.
+     intro.
+     unfold diff_index.
+     destruct (diff_index_p (n Logic.eq_refl)). simpl; auto.
+   Qed.
+
+  End Classical_extensionnality.
+
+End FArray.
+
+Arguments farray _ _ {_} {_}.
+Arguments select {_} {_} {_} {_} {_} _ _.
+Arguments store {_} {_} {_} {_} {_} {_} {_} {_} _ _ _.
+Arguments diff {_} {_} {_} {_} {_} {_} {_} {_} {_} {_} _ _.
+Arguments equal {_} {_} {_} {_} {_} {_} {_}  _ _.
+Arguments equalP {_} {_} {_} {_} {_} {_} {_}  _ _.
+
+
+Notation "a '[' i ']'" := (select a i) (at level 1, format "a [ i ]") : farray_scope.
+Notation "a '[' i '<-' v ']'" := (store a i v)
+   (at level 1, format "a [ i  <-  v ]") : farray_scope.
+
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/array/FArray_ord.v b/src/array/FArray_ord.v
new file mode 100644
index 0000000..05a4d06
--- /dev/null
+++ b/src/array/FArray_ord.v
@@ -0,0 +1,1509 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import SetoidList Bool OrderedType OrdersLists RelationPairs Orders.
+(* Require Import List Bool NArith Psatz Int63. *)
+Require Import RelationClasses.
+
+
+Class DecType T := {
+ eq_refl : forall x : T, x = x;
+ eq_sym : forall x y : T, x = y -> y = x;
+ eq_trans : forall x y z : T, x = y -> y = z -> x = z;
+ eq_dec : forall x y : T, { x = y } + { x <> y }
+}.
+
+Hint Immediate eq_sym.
+Hint Resolve eq_refl eq_trans.
+
+Class OrdType T := {
+  lt: T -> T -> Prop;
+  lt_trans : forall x y z : T, lt x y -> lt y z -> lt x z;
+  lt_not_eq : forall x y : T, lt x y -> ~ eq x y
+  (* compare : forall x y : T, Compare lt eq x y *)
+}.
+
+Hint Resolve lt_not_eq lt_trans.
+
+(* Global Instance Comparable T `(OrdType T) : *)
+
+Class Comparable T {ot:OrdType T} := {
+  compare : forall x y : T, Compare lt eq x y
+}.
+
+
+Set Implicit Arguments.
+
+
+
+Module Raw.
+  
+  Section Array.
+
+  
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+
+  Definition eqb_key (x y : key) : bool := if eq_dec x y then true else false.
+  Definition eqb_elt (x y : elt) : bool := if eq_dec x y then true else false.
+
+  Lemma eqb_key_eq x y : eqb_key x y = true <-> x = y.
+  Proof. unfold eqb_key. case (eq_dec x y); split; easy. Qed.
+
+  Lemma eqb_elt_eq x y : eqb_elt x y = true <-> x = y.
+  Proof. unfold eqb_elt. case (eq_dec x y); split; easy. Qed.
+
+  Hint Immediate eqb_key_eq eqb_elt_eq.
+  
+  Definition farray := list (key * elt).
+
+  Definition eqk (a b : (key * elt)) := fst a = fst b.
+  Definition eqe (a b : (key * elt)) := snd a = snd b.
+  Definition eqke (a b : (key * elt)) := fst a = fst b /\ snd a = snd b.
+
+  Definition ltk (a b : (key * elt)) := lt (fst a) (fst b).
+
+  (* Definition ltke (a b : (key * elt)) := *)
+  (*   lt (fst a) (fst b) \/ ( (fst a) = (fst b) /\ lt (snd a) (snd b)). *)
+  
+  Hint Unfold ltk (* ltke *) eqk eqke.
+  Hint Extern 2 (eqke ?a ?b) => split.
+
+
+  Global Instance StrictOrder_OrdType T `(OrdType T) :
+    StrictOrder (lt : T -> T -> Prop).
+  Proof.
+    split.
+    unfold Irreflexive, Reflexive, complement.
+    intros. apply lt_not_eq in H0; auto.
+    unfold Transitive. intros x y z. apply lt_trans.
+  Qed.
+  
+  Check (lt : key -> key -> Prop).
+  
+  Global Instance lt_key_strorder : StrictOrder (lt : key -> key -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  Global Instance lt_elt_strorder : StrictOrder (lt : elt -> elt -> Prop).
+  Proof. apply StrictOrder_OrdType. Qed.
+
+  
+  Global Instance ke_dec : DecType (key * elt).
+  Proof.
+    split; auto.
+    intros; destruct x, y, z.
+    inversion H. inversion H0. trivial.
+    intros; destruct x, y.
+    destruct (eq_dec k k0).
+    destruct (eq_dec e e0).
+    left; rewrite e1, e2; auto.
+    right; unfold not in *. intro; inversion H. exact (n H2).
+    right; unfold not in *. intro; inversion H. exact (n H1).
+  Qed.
+
+  Global Instance ke_ord: OrdType (key * elt).
+  Proof.
+    exists ltk; unfold ltk; intros.
+    apply (lt_trans _ (fst y)); auto.
+    destruct x, y. simpl in H.
+    unfold not. intro. inversion H0.
+    apply (lt_not_eq k k0); auto.
+  Qed.
+
+
+  (* ltk ignore the second components *)
+
+   Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e').
+   Proof. auto. Qed.
+
+   Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x.
+   Proof. auto. Qed.
+   Hint Immediate ltk_right_r ltk_right_l.
+
+
+  
+  
+  Notation Sort := (sort ltk).
+  Notation Inf := (lelistA (ltk)).
+  
+  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+  Definition In k m := exists e:elt, MapsTo k e m.
+
+  Notation NoDupA := (NoDupA eqk).
+
+  Hint Unfold MapsTo In.
+
+  
+  (* Instance ke_ord: OrdType (key * elt). *)
+  (* Proof. *)
+  (*   exists ltke. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct H, H0. *)
+  (*   left; apply (lt_trans _ (fst y)); auto. *)
+  (*   destruct H0. left. rewrite <- H0. assumption. *)
+  (*   destruct H. left. rewrite H. assumption. *)
+  (*   destruct H, H0. *)
+  (*   right. split. *)
+  (*   apply (eq_trans _ (fst y)); trivial. *)
+  (*   apply (lt_trans _ (snd y)); trivial. *)
+  (*   unfold ltke. intros. *)
+  (*   destruct x, y. simpl in H. *)
+  (*   destruct H. *)
+  (*   apply lt_not_eq in H. *)
+  (*   unfold not in *. intro. inversion H0. apply H. trivial. *)
+  (*   destruct H. apply lt_not_eq in H0. unfold not in *. intro.  *)
+  (*   inversion H1. apply H0; trivial. *)
+  (*   intros. *)
+  (*   unfold ltke. *)
+  (*   destruct (compare (fst x) (fst y)). *)
+  (*   apply LT. left; assumption. *)
+  (*   destruct (compare (snd x) (snd y)). *)
+  (*   apply LT. right; split; assumption. *)
+  (*   apply EQ. destruct x, y. simpl in *. rewrite e, e0; trivial. *)
+  (*   apply GT. right; symmetry in e; split; assumption. *)
+  (*   apply GT. left; assumption. *)
+  (* Qed. *)
+
+  
+  (* Hint Immediate ke_ord. *)
+  (* Let ke_ord := ke_ord. *)
+
+  (* Instance keyelt_ord: OrdType (key * elt). *)
+
+
+  (* Variable keyelt_ord : OrdType (key * elt). *)
+   (* eqke is stricter than eqk *)
+
+   Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
+   Proof.
+     unfold eqk, eqke; intuition.
+   Qed.
+
+  (* eqk, eqke are equalities *)
+
+  Lemma eqk_refl : forall e, eqk e e.
+  Proof. auto. Qed.
+
+  Lemma eqke_refl : forall e, eqke e e.
+  Proof. auto. Qed.
+
+  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
+  Proof. auto. Qed.
+
+  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
+  Proof. unfold eqke; intuition. Qed.
+
+  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
+  Proof.
+    unfold eqke; intuition; [ eauto | congruence ].
+  Qed.
+   
+  Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''.
+  Proof. eauto. Qed.
+
+  Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'.
+  Proof. unfold ltk, eqk. intros. apply lt_not_eq; auto. Qed.
+
+  Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'.
+  Proof.
+    unfold eqke, ltk; intuition; simpl in *; subst.
+    apply lt_not_eq in H. auto.
+  Qed.
+  
+
+  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+  Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
+  Hint Immediate eqk_sym eqke_sym.
+
+
+  
+  Global Instance eqk_equiv : Equivalence eqk.
+  Proof. split; eauto. Qed.
+
+  Global Instance eqke_equiv : Equivalence eqke.
+  Proof. split; eauto. Qed.
+
+
+
+  Global Instance ltk_strorder : StrictOrder ltk.
+  Proof.
+    split.
+    unfold Irreflexive, Reflexive, complement.
+    intros. apply lt_not_eq in H; auto.
+    unfold Transitive. intros x y z. apply lt_trans.
+  Qed.
+
+
+  (* Instance ltke_strorder : StrictOrder ltke. *)
+  (* Proof. *)
+  (*   split. *)
+  (*   unfold Irreflexive, Reflexive, complement. *)
+  (*   intros. apply lt_not_eq in H; auto. *)
+  (*   unfold Transitive. apply lt_trans. *)
+  (* Qed. *)
+
+  Global Instance eq_equiv : @Equivalence (key * elt) eq.
+  Proof.
+    split; auto.
+    unfold Transitive. apply eq_trans.
+  Qed.
+    
+  (* Instance ltke_compat : Proper (eq ==> eq ==> iff) ltke. *)
+  (* Proof. *)
+  (*   split; rewrite H, H0; trivial. *)
+  (* Qed. *)
+    
+  Global Instance ltk_compat : Proper (eq ==> eq ==> iff) ltk.
+  Proof.
+    split; rewrite H, H0; trivial.
+  Qed.
+
+  
+  Global Instance ltk_compatk : Proper (eqk==>eqk==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') Hxx' (y,f) (y',f') Hyy'; compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+  Global Instance ltk_compat' : Proper (eqke==>eqke==>iff) ltk.
+  Proof.
+  intros (x,e) (x',e') (Hxx',_) (y,f) (y',f') (Hyy',_); compute.
+   compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
+  Qed.
+
+
+  Global Instance ltk_asym : Asymmetric ltk.
+  Proof. apply (StrictOrder_Asymmetric ltk_strorder). Qed.
+    
+
+  (* Additional facts *)
+
+  Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
+  Proof.
+    unfold eqk, ltk.
+    unfold not. intros x x' H.
+    destruct x, x'. simpl in *.
+    intro.
+    symmetry in H.
+    apply lt_not_eq in H. auto.
+    subst. auto.
+  Qed.
+
+  
+  Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''.
+  Proof. unfold ltk, eqk. destruct e, e', e''. simpl.
+    intros; subst; trivial.
+  Qed.
+
+  Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''.
+  Proof.
+    intros (k,e) (k',e') (k'',e'').
+    unfold ltk, eqk; simpl; intros; subst; trivial.
+  Qed.
+  Hint Resolve eqk_not_ltk.
+  Hint Immediate ltk_eqk eqk_ltk.
+  
+  Lemma InA_eqke_eqk :
+     forall x m, InA eqke x m -> InA eqk x m.
+  Proof.
+    unfold eqke; induction 1; intuition.
+  Qed.
+
+  Hint Resolve InA_eqke_eqk.
+
+  (* Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m. *)
+  (* Proof. *)
+  (*  intros; apply InA_eqA with p; auto with *. *)
+  (* Qed. *)
+
+  (* Lemma In_eq : forall l x y, eq x y -> InA eqke x l -> InA eqke y l. *)
+  (* Proof. intros. rewrite <- H; auto. Qed. *)
+
+  (* Lemma ListIn_In : forall l x, List.In x l -> InA eqk x l. *)
+  (* Proof. apply In_InA. split; auto. unfold Transitive. *)
+  (*   unfold eqk; intros. rewrite H, <- H0. auto. *)
+  (* Qed. *)
+  
+  (* Lemma Inf_lt : forall l x y, ltk x y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_ltA ltk_strorder). Qed. *)
+
+  (* Lemma Inf_eq : forall l x y, x = y -> Inf y l -> Inf x l. *)
+  (* Proof. exact (InfA_eqA eq_equiv ltk_compat). Qed. *)
+
+
+
+  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
+
+  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
+  Proof.
+  firstorder.
+  exists x; auto.
+  induction H.
+  destruct y.
+  exists e; auto.
+  destruct IHInA as [e H0].
+  exists e; auto.
+  Qed.
+
+  Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
+  Proof.
+  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto with *.
+  Qed.
+
+  Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+  Proof.
+  destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
+  Qed.
+
+  Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_eqA eqk_equiv ltk_compatk). Qed.
+
+  Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_ltA ltk_strorder). Qed.
+
+  Hint Immediate Inf_eq.
+  Hint Resolve Inf_lt.
+
+  
+
+  Lemma Sort_Inf_In :
+    forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p.
+  Proof.
+    exact (SortA_InfA_InA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+
+  
+  Lemma Sort_Inf_NotIn :
+    forall l k e, Sort l -> Inf (k,e) l ->  ~In k l.
+  Proof.
+    intros; red; intros.
+    destruct H1 as [e' H2].
+    elim (@ltk_not_eqk (k,e) (k,e')).
+    eapply Sort_Inf_In; eauto.
+    red; simpl; auto.
+  Qed.
+
+  Hint Resolve Sort_Inf_NotIn.
+  
+  Lemma Sort_NoDupA: forall l, Sort l -> NoDupA l.
+  Proof.
+    exact (SortA_NoDupA eqk_equiv ltk_strorder ltk_compatk).
+  Qed.
+
+  Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'.
+  Proof.
+    inversion 1; intros; eapply Sort_Inf_In; eauto.
+  Qed.
+
+  Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) ->
+                                   ltk e e' \/ eqk e e'.
+  Proof.
+    inversion_clear 2; auto.
+    left; apply Sort_In_cons_1 with l; auto.
+  Qed.
+
+  Lemma Sort_In_cons_3 :
+    forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k.
+  Proof.
+    inversion_clear 1; red; intros.
+    destruct (Sort_Inf_NotIn H0 H1 (In_eq H2 H)).
+  Qed.
+
+  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l.
+  Proof.
+    inversion 1.
+    inversion_clear H0; eauto.
+    destruct H1; simpl in *; intuition.
+  Qed.
+
+  Lemma In_inv_2 : forall k k' e e' l,
+      InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Lemma In_inv_3 : forall x x' l,
+      InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l.
+  Proof.
+    inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Hint Resolve In_inv_2 In_inv_3.
+
+
+
+
+  (** * FMAPLIST interface implementaion  *)
+
+
+
+
+  (** * [empty] *)
+
+  Definition empty : farray := nil.
+
+  Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+    unfold Empty,empty.
+    intros a e.
+    intro abs.
+    inversion abs.
+  Qed.
+  Hint Resolve empty_1.
+
+  Lemma empty_sorted : Sort empty.
+  Proof.
+    unfold empty; auto.
+  Qed.
+
+  (** * [is_empty] *)
+
+  Definition is_empty (l : farray) : bool := if l then true else false.
+
+  Lemma is_empty_1 :forall m, Empty m -> is_empty m = true.
+  Proof.
+    unfold Empty, MapsTo.
+    intros m.
+    case m;auto.
+    intros (k,e) l inlist.
+    absurd (InA eqke (k, e) ((k, e) :: l));auto.
+  Qed.
+
+  Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
+  Proof.
+    intros m.
+    case m;auto.
+    intros p l abs.
+    inversion abs.
+  Qed.
+
+  (** * [mem] *)
+
+  Function mem (k : key) (s : farray) {struct s} : bool :=
+    match s with
+    | nil => false
+    | (k',_) :: l =>
+      match compare k k' with
+      | LT _ => false
+      | EQ _ => true
+      | GT _ => mem k l
+      end
+    end.
+
+  Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm.
+    functional induction (mem x m);intros sorted belong1;trivial.
+
+    inversion belong1. inversion H.
+
+    absurd (In x ((k', _x) :: l));try assumption.
+    apply Sort_Inf_NotIn with _x;auto.
+
+    apply IHb.
+    elim (sort_inv sorted);auto.
+    elim (In_inv belong1);auto.
+    intro abs.
+    absurd (eq x k'); auto.
+    symmetry in abs.
+    apply lt_not_eq in abs; auto.
+  Qed.
+
+  Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m.
+  Proof.
+    intros m Hm x; generalize Hm; clear Hm; unfold In,MapsTo.
+    functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail).
+    exists _x; auto.
+    induction IHb; auto.
+    exists x0; auto.
+    inversion_clear sorted; auto.
+  Qed.
+
+  (** * [find] *)
+
+  Function find (k:key) (s: farray) {struct s} : option elt :=
+    match s with
+    | nil => None
+    | (k',x)::s' =>
+      match compare k k' with
+      | LT _ => None
+      | EQ _ => Some x
+      | GT _ => find k s'
+      end
+    end.
+
+  Lemma find_2 :  forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof.
+    intros m x. unfold MapsTo.
+    functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto.
+  Qed.
+
+  Lemma find_1 :  forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e.
+  Proof.
+    intros m Hm x e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (find x m);simpl; subst; try clear H_eq_1.
+
+    inversion 2.
+
+    inversion_clear 2.
+    clear e1;compute in H0; destruct H0.
+    apply lt_not_eq in H; auto. now contradict H.
+
+    clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply (lt_trans k') in _x; auto.
+    apply lt_not_eq in _x.
+    now contradict _x.
+    
+    clear e1;inversion_clear 2.
+    compute in H0; destruct H0; intuition congruence.
+    generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute.
+    (* order. *)
+    intros.
+    apply lt_not_eq in H. now contradict H.
+    
+    clear e1; do 2 inversion_clear 1; auto.
+    compute in H2; destruct H2.
+    (* order. *)
+    subst. apply lt_not_eq in _x. now contradict _x.
+  Qed.
+
+  (** * [add] *)
+
+  Function add (k : key) (x : elt) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => (k,x) :: nil
+    | (k',y) :: l =>
+      match compare k k' with
+      | LT _ => (k,x)::s
+      | EQ _ => (k,x)::l
+      | GT _ => (k',y) :: add k x l
+      end
+    end.
+
+  Lemma add_1 : forall m x y e, eq x y -> MapsTo y e (add x e m).
+  Proof.
+    intros m x y e; generalize y; clear y.
+    unfold MapsTo.
+    functional induction (add x e m);simpl;auto.
+  Qed.
+
+  Lemma add_2 : forall m x y e e',
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof.
+    intros m x  y e e'.
+    generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m) ;simpl;auto;  clear e0.
+    subst;auto.
+
+    intros y' e'' eqky';  inversion_clear 1;  destruct H0; simpl in *.
+    (* order. *)
+    subst. now contradict eqky'.
+    auto.
+    auto.
+    intros y' e'' eqky'; inversion_clear 1; intuition.
+  Qed.
+
+
+  Lemma add_3 : forall m x y e e',
+      ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof.
+    intros m x y e e'. generalize y e; clear y e; unfold MapsTo.
+    functional induction (add x e' m);simpl; intros.
+    apply (In_inv_3 H0); compute; auto.
+    apply (In_inv_3 H0); compute; auto.
+    constructor 2; apply (In_inv_3 H0); compute; auto.
+    inversion_clear H0; auto.
+  Qed.
+
+
+  Lemma add_Inf : forall (m:farray)(x x':key)(e e':elt),
+      Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0,H1.
+    simpl; case (compare x x''); intuition.
+  Qed.
+  Hint Resolve add_Inf.
+
+  Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+    constructor; auto.
+    apply Inf_eq with (x',e'); auto.
+  Qed.
+
+  (** * [remove] *)
+
+  Function remove (k : key) (s : farray) {struct s} : farray :=
+    match s with
+    | nil => nil
+    | (k',x) :: l =>
+      match compare k k' with
+      | LT _ => s
+      | EQ _ => l
+      | GT _ => (k',x) :: remove k l
+      end
+    end.
+
+  Lemma remove_1 : forall m (Hm:Sort m) x y, eq x y -> ~ In y (remove x m).
+  Proof.
+    intros m Hm x y; generalize Hm; clear Hm.
+    functional induction (remove x m);simpl;intros;subst.
+
+    red; inversion 1; inversion H0.
+
+    apply Sort_Inf_NotIn with x0; auto.
+
+    clear e0. inversion Hm. subst.
+    apply Sort_Inf_NotIn with x0; auto.
+    
+
+    (* clear e0;inversion_clear Hm. *)
+    (* apply Sort_Inf_NotIn with x0; auto. *)
+    (* apply Inf_eq with (k',x0);auto; compute; apply eq_trans with x; auto. *)
+
+    clear e0;inversion_clear Hm.
+    assert (notin:~ In y (remove y l)) by auto.
+    intros (x1,abs).
+    inversion_clear abs.
+    compute in H1; destruct H1.
+    subst. apply lt_not_eq in _x; now contradict _x.
+    apply notin; exists x1; auto.
+  Qed.
+
+
+  Lemma remove_2 : forall m (Hm:Sort m) x y e,
+      ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto;
+      match goal with
+      | [H: compare _ _ = _ |- _ ] => clear H
+      | _ => idtac
+      end.
+
+    inversion_clear 3; auto.
+    compute in H1; destruct H1.
+    subst; now contradict H.
+    inversion_clear 1; inversion_clear 2; auto.
+  Qed.
+
+  Lemma remove_3 : forall m (Hm:Sort m) x y e,
+      MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof.
+    intros m Hm x y e; generalize Hm; clear Hm; unfold MapsTo.
+    functional induction (remove x m);subst;auto.
+    inversion_clear 1; inversion_clear 1; auto.
+  Qed.
+
+  Lemma remove_Inf : forall (m:farray)(Hm : Sort m)(x x':key)(e':elt),
+      Inf (x',e') m -> Inf (x',e') (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x'',e'').
+    inversion_clear H.
+    compute in H0.
+    simpl; case (compare x x''); intuition.
+    inversion_clear Hm.
+    apply Inf_lt with (x'',e''); auto.
+  Qed.
+  Hint Resolve remove_Inf.
+
+  Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
+  Proof.
+    induction m.
+    simpl; intuition.
+    intros.
+    destruct a as (x',e').
+    simpl; case (compare x x'); intuition; inversion_clear Hm; auto.
+  Qed.
+
+  (** * [elements] *)
+
+  Definition elements (m: farray) := m.
+
+  Lemma elements_1 : forall m x e,
+      MapsTo x e m -> InA eqke (x,e) (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_2 : forall m x e,
+      InA eqke (x,e) (elements m) -> MapsTo x e m.
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m).
+  Proof.
+    auto.
+  Qed.
+
+  Lemma elements_3w : forall m (Hm:Sort m), NoDupA (elements m).
+  Proof.
+    intros.
+    apply Sort_NoDupA.
+    apply elements_3; auto.
+  Qed.
+
+  (** * [fold] *)
+
+  Function fold (A:Type)(f:key->elt->A->A)(m:farray) (acc:A) {struct m} :  A :=
+    match m with
+    | nil => acc
+    | (k,e)::m' => fold f m' (f k e acc)
+    end.
+
+  Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof.
+    intros; functional induction (fold f m i); auto.
+  Qed.
+
+  (** * [equal] *)
+
+  Function equal (cmp:elt->elt->bool)(m m' : farray) {struct m} : bool :=
+    match m, m' with
+    | nil, nil => true
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => cmp e e' && equal cmp l l'
+      | _    => false
+      end
+    | _, _ => false
+    end.
+
+  Definition Equivb cmp m m' :=
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
+
+  Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp,
+      Equivb cmp m m' -> equal cmp m m' = true.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; subst.
+    match goal with H: compare _ _ = _ |- _ => clear H end.
+    assert (cmp_e_e':cmp e e' = true).
+    apply H1 with x; auto.
+    rewrite cmp_e_e'; simpl.
+    apply IHb; auto.
+    inversion_clear Hm; auto.
+    inversion_clear Hm'; auto.
+    unfold Equivb; intuition.
+    destruct (H0 k).
+    assert (In k ((x,e) ::l)).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H2 H4)); auto.
+    inversion_clear Hm.
+    elim (Sort_Inf_NotIn H6 H7).
+    destruct H as (e'', hyp); exists e''; auto.
+    apply MapsTo_eq with k; auto.
+    destruct (H0 k).
+    assert (In k ((x,e') ::l')).
+    destruct H as (e'', hyp); exists e''; auto.
+    destruct (In_inv (H3 H4)); auto.
+    subst.
+    inversion_clear Hm'.
+    now elim (Sort_Inf_NotIn H5 H6).
+    apply H1 with k; destruct (eq_dec x k); auto.
+
+
+    destruct (compare x x') as [Hlt|Heq|Hlt]; try contradiction; clear y.
+    destruct (H0 x).
+    assert (In x ((x',e')::l')).
+    apply H; auto.
+    exists e; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm'.
+    assert (Inf (x,e) l').
+    apply Inf_lt with (x',e'); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct (H0 x').
+    assert (In x' ((x,e)::l)).
+    apply H2; auto.
+    exists e'; auto.
+    destruct (In_inv H3).
+    (* order. *)
+    subst; apply lt_not_eq in Hlt; now contradict Hlt.
+    inversion_clear Hm.
+    assert (Inf (x',e') l).
+    apply Inf_lt with (x,e); auto.
+    elim (Sort_Inf_NotIn H5 H7 H4).
+
+    destruct m;
+      destruct m';try contradiction.
+
+    clear H1;destruct p as (k,e).
+    destruct (H0 k).
+    destruct H1.
+    exists e; auto.
+    inversion H1.
+
+    destruct p as (x,e).
+    destruct (H0 x).
+    destruct H.
+    exists e; auto.
+    inversion H.
+
+    destruct p;destruct p0;contradiction.
+  Qed.
+
+
+  Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp,
+      equal cmp m m' = true -> Equivb cmp m m'.
+  Proof.
+    intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+    functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
+      intuition; try discriminate; subst;
+        try match goal with H: compare _ _ = _ |- _ => clear H end.
+
+    inversion H0.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e'; constructor; split; trivial; apply eq_trans with x; auto.
+    destruct (H k).
+    destruct (H9 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H1 H3 H6).
+    destruct (In_inv H0).
+    exists e; constructor; split; trivial; apply eq_trans with x'; auto.
+    destruct (H k).
+    destruct (H10 H8) as (e'',hyp).
+    exists e''; auto.
+
+    inversion_clear Hm;inversion_clear Hm'.
+    destruct (andb_prop _ _ H); clear H.
+    destruct (IHb H2 H4 H7).
+    inversion_clear H0.
+    destruct H9; simpl in *; subst.
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H4 H5).
+    exists e'0; apply MapsTo_eq with x; auto.
+      (* order. *)
+    inversion_clear H1.
+    destruct H0; simpl in *; subst; auto.
+    elim (Sort_Inf_NotIn H2 H3).
+    exists e0; apply MapsTo_eq with x; auto.
+    (* order. *)
+    apply H8 with k; auto.
+  Qed.
+
+  (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *)
+
+  Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
+    eqk x y -> cmp (snd x) (snd y) = true ->
+    (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)).
+  Proof.
+    intros.
+    inversion H; subst.
+    inversion H0; subst.
+    destruct x; destruct y; compute in H1, H2.
+    split; intros.
+    apply equal_2; auto.
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl.
+    apply equal_1; auto.
+    apply equal_2; auto.
+    generalize (equal_1 H H0 H3).
+    simpl.
+    case (compare k k0);
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    rewrite H2; simpl; auto.
+  Qed.
+
+End Array.
+
+End Raw.
+
+
+
+Section FArray.
+
+  Variable key : Type.
+  Variable elt : Type.
+  Variable key_dec : DecType key.
+  Variable key_ord : OrdType key.
+  Variable key_comp : Comparable key.
+  Variable elt_dec : DecType elt.
+  Variable elt_ord : OrdType elt.
+  Variable elt_comp : Comparable elt.
+
+  Set Implicit Arguments.
+
+  Record slist :=
+    {this :> Raw.farray key elt; sorted : sort (Raw.ltk key_ord) this}.
+  Definition farray := slist.
+
+  (* Boolean comparison over elements *)
+  Definition cmp (e e':elt) :=
+    match compare e e' with EQ _ => true | _ => false end.
+  
+  Definition empty : farray := Build_slist (Raw.empty_sorted elt key_ord).
+  Definition is_empty m : bool := Raw.is_empty m.(this).
+  Definition add x e m : farray :=
+    Build_slist (Raw.add_sorted key_dec key_comp m.(sorted) x e).
+  Definition find x m : option elt := Raw.find key_comp x m.(this).
+  Definition remove x m : farray :=
+    Build_slist (Raw.remove_sorted key_comp m.(sorted) x).
+  Definition mem x m : bool := Raw.mem key_comp x m.(this).
+  Definition elements m : list (key*elt) := Raw.elements m.(this).
+  Definition cardinal m := length m.(this).
+  Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A :=
+    Raw.fold f m.(this) i.
+  Definition equal m m' : bool := Raw.equal key_comp cmp m.(this) m'.(this).
+
+  Definition MapsTo x e m : Prop := Raw.MapsTo x e m.(this).
+  Definition In x m : Prop := Raw.In x m.(this).
+  Definition Empty m : Prop := Raw.Empty m.(this).
+
+  Definition Equal m m' := forall y, find y m = find y m'.
+  Definition Equiv m m' :=
+    (forall k, In k m <-> In k m') /\
+    (forall k e e', MapsTo k e m -> MapsTo k e' m' -> e = e').
+  Definition Equivb m m' : Prop := Raw.Equivb cmp m.(this) m'.(this).
+
+  Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.eqk key elt.
+  Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.eqke key elt.
+  Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.ltk key elt key_ord.
+
+  Lemma MapsTo_1 : forall m x y e, eq x y -> MapsTo x e m -> MapsTo y e m.
+  Proof. intros m.
+    apply (Raw.MapsTo_eq key_dec elt_dec). Qed.
+
+  Lemma mem_1 : forall m x, In x m -> mem x m = true.
+  Proof. intros m; apply (Raw.mem_1); auto. apply m.(sorted). Qed.
+  Lemma mem_2 : forall m x, mem x m = true -> In x m.
+  Proof. intros m; apply (Raw.mem_2); auto. apply m.(sorted). Qed.
+
+  Lemma empty_1 : Empty empty.
+  Proof. apply Raw.empty_1. Qed.
+
+  Lemma is_empty_1 : forall m, Empty m -> is_empty m = true.
+  Proof. intros m; apply Raw.is_empty_1. Qed.
+  Lemma is_empty_2 :  forall m, is_empty m = true -> Empty m.
+  Proof. intros m; apply Raw.is_empty_2. Qed.
+
+  Lemma add_1 : forall m x y e, eq x y -> MapsTo y e (add x e m).
+  Proof. intros m; apply Raw.add_1; auto. Qed.
+  Lemma add_2 : forall m x y e e', ~ eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+  Proof. intros m; apply Raw.add_2; auto. Qed.
+  Lemma add_3 : forall m x y e e', ~ eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+  Proof. intros m; apply Raw.add_3; auto. Qed.
+
+  Lemma remove_1 : forall m x y, eq x y -> ~ In y (remove x m).
+  Proof. intros m; apply Raw.remove_1; auto. apply m.(sorted). Qed.
+  Lemma remove_2 : forall m x y e, ~ eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+  Proof. intros m; apply Raw.remove_2; auto. apply m.(sorted). Qed.
+  Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m.
+  Proof. intros m; apply Raw.remove_3; auto. apply m.(sorted). Qed.
+
+  Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e.
+  Proof. intros m; apply Raw.find_1; auto. apply m.(sorted). Qed.
+  Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m.
+  Proof. intros m; apply Raw.find_2; auto. Qed.
+
+  Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
+  Proof. intros m; apply Raw.elements_1. Qed.
+  Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
+  Proof. intros m; apply Raw.elements_2. Qed.
+  Lemma elements_3 : forall m, sort lt_key (elements m).
+  Proof. intros m; apply Raw.elements_3; auto. apply m.(sorted). Qed.
+  Lemma elements_3w : forall m, NoDupA eq_key (elements m).
+  Proof. intros m; apply (Raw.elements_3w key_dec m.(sorted)). Qed.
+
+  Lemma cardinal_1 : forall m, cardinal m = length (elements m).
+  Proof. intros; reflexivity. Qed.
+
+  Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A),
+      fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+  Proof. intros m; apply Raw.fold_1. Qed.
+
+  Lemma equal_1 : forall m m', Equivb m m' -> equal m m' = true.
+  Proof. intros m m'; apply Raw.equal_1; auto. apply m.(sorted). apply  m'.(sorted). Qed.
+  Lemma equal_2 : forall m m', equal m m' = true -> Equivb m m'.
+  Proof. intros m m'; apply Raw.equal_2; auto. apply m.(sorted). apply  m'.(sorted). Qed.
+
+
+
+  Fixpoint eq_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => True
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | EQ _ => eq e e' /\ eq_list l l'
+      | _       => False
+      end
+    | _, _ => False
+    end.
+
+  Definition eq m m' := eq_list m.(this) m'.(this).
+
+  Lemma eq_equal : forall m m', eq m m' <-> equal m m' = true.
+  Proof.
+    intros (l,Hl); induction l.
+    intros (l',Hl'); unfold eq; simpl.
+    destruct l'; unfold equal; simpl; intuition.
+    intros (l',Hl'); unfold eq.
+    destruct l'.
+    destruct a; unfold equal; simpl; intuition.
+    destruct a as (x,e).
+    destruct p as (x',e').
+    unfold equal; simpl.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; simpl; intuition.
+    unfold cmp at 1.
+    case (compare e e');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+    clear HH; simpl.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    destruct (IHl H (Build_slist H2)).
+    unfold equal, eq in H5; simpl in H5; auto.
+    destruct (andb_prop _ _ H); clear H.
+    generalize H0; unfold cmp.
+    case (compare e e');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH);
+      auto; intro; discriminate.
+    destruct (andb_prop _ _ H); clear H.
+    inversion_clear Hl.
+    inversion_clear Hl'.
+    destruct (IHl H (Build_slist H3)).
+    unfold equal, eq in H6; simpl in H6; auto.
+  Qed.
+
+  Lemma eq_1 : forall m m', Equivb m m' -> eq m m'.
+  Proof.
+    intros.
+    generalize (@equal_1 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eq_2 : forall m m', eq m m' -> Equivb m m'.
+  Proof.
+    intros.
+    generalize (@equal_2 m m').
+    generalize (@eq_equal m m').
+    intuition.
+  Qed.
+
+  Lemma eqfarray_refl : forall m : farray, eq m m.
+  Proof.
+    intros (m,Hm); induction m; unfold eq; simpl; auto.
+    destruct a.
+    destruct (compare k k) as [Hlt|Heq|Hlt]; auto.
+    apply lt_not_eq in Hlt. auto.
+    split.
+    apply eq_refl.
+    inversion_clear Hm.
+    apply (IHm H).
+    apply lt_not_eq in Hlt. auto.
+  Qed.
+
+  Lemma eqfarray_sym : forall m1 m2 : farray, eq m1 m2 -> eq m2 m1.
+  Proof.
+    intros (m,Hm); induction m;
+      intros (m', Hm'); destruct m'; unfold eq; simpl;
+        try destruct a as (x,e); try destruct p as (x',e'); auto.
+    destruct (compare x x')  as [Hlt|Heq|Hlt]; try easy.
+    inversion_clear Hm; inversion_clear Hm'.
+    intro. destruct H3.
+    subst.
+    case (compare x' x');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    apply (IHm H (Build_slist H1)); auto.
+  Qed.
+
+  Lemma eqfarray_trans : forall m1 m2 m3 : farray, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
+  Proof.
+    intros (m1,Hm1); induction m1;
+      intros (m2, Hm2); destruct m2;
+        intros (m3, Hm3); destruct m3; unfold eq; simpl;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt']; try easy.
+    intros; destruct H, H0;  subst.
+    case (compare x'' x'');
+    subst; intro HH; try (apply lt_not_eq in HH; now contradict HH).
+    split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply (IHm1 H (Build_slist H3) (Build_slist H5)); intuition.
+  Qed.
+
+
+
+  Fixpoint lt_list (m m' : list (key * elt)) : Prop :=
+    match m, m' with
+    | nil, nil => False
+    | nil, _  => True
+    | _, nil  => False
+    | (x,e)::l, (x',e')::l' =>
+      match compare x x' with
+      | LT _ => True
+      | GT _ => False
+      | EQ _ => lt e e' \/ (e = e' /\ lt_list l l')
+      end
+    end.
+
+  Definition lt_farray m m' := lt_list m.(this) m'.(this).
+
+  Lemma lt_farray_trans : forall m1 m2 m3 : farray,
+      lt_farray m1 m2 -> lt_farray m2 m3 -> lt_farray m1 m3.
+  Proof.
+    intros (m1,Hm1); induction m1;
+      intros (m2, Hm2); destruct m2;
+        intros (m3, Hm3); destruct m3; unfold lt_farray; simpl;
+          try destruct a as (x,e);
+          try destruct p as (x',e');
+          try destruct p0 as (x'',e''); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt];
+      destruct (compare x' x'') as [Hlt'|Heq'|Hlt'];
+      destruct (compare x x'') as [Hlt''|Heq''|Hlt'']; intros; subst; auto; try easy.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    apply (lt_trans x') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt.
+    apply (lt_trans _ x'') ; auto.
+    apply lt_not_eq in Hlt. now contradict Hlt.
+    apply (lt_trans x'') in Hlt; apply lt_not_eq in Hlt.
+    now contradict Hlt. auto.
+    subst.
+    apply lt_not_eq in Hlt'. now contradict Hlt'.
+    apply (lt_trans x'') in Hlt'; apply lt_not_eq in Hlt'.
+    now contradict Hlt'. auto.
+    destruct H, H0.
+    left; apply lt_trans with e'; auto.
+    left. destruct H0. subst; auto.
+    left. destruct H. subst; auto.
+    right. destruct H, H0. subst; split; auto.
+    inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+    apply (IHm1 H (Build_slist H3) (Build_slist H5)); intuition.
+    apply lt_not_eq in Hlt''. now contradict Hlt''.
+  Qed.
+
+  Lemma lt_farray_not_eq : forall m1 m2 : farray, lt_farray m1 m2 -> ~ eq m1 m2.
+  Proof.
+    intros (m1,Hm1); induction m1;
+      intros (m2, Hm2); destruct m2; unfold eq, lt; simpl;
+        try destruct a as (x,e);
+        try destruct p as (x',e'); try contradiction; auto.
+    destruct (compare x x') as [Hlt|Heq|Hlt]; auto.
+    intuition.
+    inversion_clear Hm1; inversion_clear Hm2.
+    subst.
+    apply (IHm1 H0 (Build_slist H4)); intuition.
+    unfold lt_farray in *.
+    simpl in H.
+    case (compare x' x') in *.
+    apply lt_not_eq in l. now contradict l.
+    destruct H.
+    apply lt_not_eq in H. now contradict H.
+    destruct H.
+    auto.
+    apply lt_not_eq in l. now contradict l.
+  Qed.
+
+  Definition compare_farray : forall m1 m2, Compare lt_farray eq m1 m2.
+  Proof.
+    intros (m1,Hm1); induction m1;
+      intros (m2, Hm2); destruct m2;
+        [ apply EQ | apply LT | apply GT | ]; auto.
+    (* cmp_solve. *)
+    unfold eq. simpl; auto.
+    unfold lt_farray. simpl; auto.
+    unfold lt_farray. simpl; auto.
+    destruct a as (x,e); destruct p as (x',e').
+    destruct (compare x x');
+      [ apply LT | | apply GT ].
+    unfold lt_farray. simpl.
+    destruct (compare x x'); auto.
+    subst. apply lt_not_eq in l; now contradict l.
+    apply (lt_trans x') in l; auto. subst. apply lt_not_eq in l; now contradict l.
+    (* subst. *)
+    destruct (compare e e');
+      [ apply LT | | apply GT ].
+    unfold lt_farray. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    assert (Hm11 : sort (Raw.ltk key_ord) m1).
+    inversion_clear Hm1; auto.
+    assert (Hm22 : sort (Raw.ltk key_ord) m2).
+    inversion_clear Hm2; auto.
+    destruct (IHm1 Hm11 (Build_slist Hm22));
+      [ apply LT | apply EQ | apply GT ].
+    unfold lt_farray in *. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold eq in *. simpl.
+    destruct (compare x x'); auto; try (subst; apply lt_not_eq in l; now contradict l).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l0; now contradict l0).
+    unfold lt_farray in *. simpl.
+    destruct (compare x' x); auto; try (subst; apply lt_not_eq in l; now contradict l).
+    apply (lt_trans x) in l; auto. subst. apply lt_not_eq in l; now contradict l.
+  Qed.
+  (* TODO *)
+
+  
+  
+  Lemma eq_option_alt : forall (elt:Type)(o o':option elt),
+      o=o' <-> (forall e, o=Some e <-> o'=Some e).
+  Proof.
+    split; intros.
+    subst; split; auto.
+    destruct o; destruct o'; try rewrite H; auto.
+    symmetry; rewrite <- H; auto.
+  Qed.
+
+  Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e.
+  Proof.
+    split; [apply find_1|apply find_2].
+  Qed.
+
+  Lemma add_neq_mapsto_iff : forall m x y e e',
+      x <> y -> (MapsTo y e' (add x e m)  <-> MapsTo y e' m).
+  Proof.
+    split; [apply add_3|apply add_2]; auto.
+  Qed.
+
+
+  Lemma add_eq_o : forall m x y e,
+      x = y -> find y (add x e m) = Some e.
+  Proof. intros.
+    apply find_1.
+    apply add_1. auto.
+  Qed.
+
+  Lemma add_neq_o : forall m x y e,
+      ~ x = y -> find y (add x e m) = find y m.
+  Proof.
+    intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff.
+    apply add_neq_mapsto_iff; auto.
+  Qed.
+  Hint Resolve add_neq_o.
+
+
+
+  Lemma MapsTo_fun : forall m x (e e':elt),
+      MapsTo x e m -> MapsTo x e' m -> e=e'.
+  Proof.
+    intros.
+    generalize (find_1 H) (find_1 H0); clear H H0.
+    intros; rewrite H in H0; injection H0; auto.
+  Qed.
+
+
+  (** Another characterisation of [Equal] *)
+
+  Lemma Equal_mapsto_iff : forall m1 m2 : farray,
+      Equal m1 m2 <-> (forall k e, MapsTo k e m1 <-> MapsTo k e m2).
+  Proof.
+    intros m1 m2. split; [intros Heq k e|intros Hiff].
+    rewrite 2 find_mapsto_iff, Heq. split; auto.
+    intro k. rewrite eq_option_alt. intro e.
+    rewrite <- 2 find_mapsto_iff; auto.
+  Qed.
+
+  (** * Relations between [Equal], [Equiv] and [Equivb]. *)
+
+  (** First, [Equal] is [Equiv] with Leibniz on elements. *)
+
+  Lemma Equal_Equiv : forall (m m' : farray),
+      Equal m m' <-> Equiv m m'.
+  Proof.
+    intros. rewrite Equal_mapsto_iff. split; intros.
+    split.
+    split; intros (e,Hin); exists e; unfold MapsTo in H; [rewrite <- H|rewrite H]; auto.
+    intros; apply MapsTo_fun with m k; auto; rewrite H; auto.
+    split; intros H'.
+    destruct H.
+    assert (Hin : In k m') by (rewrite <- H; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite (H0 k e e'); auto.
+    destruct H.
+    assert (Hin : In k m) by (rewrite H; exists e; auto).
+    destruct Hin as (e',He').
+    rewrite <- (H0 k e' e); auto.
+  Qed.
+
+  Lemma Equiv_Equivb : forall m m', Equiv m m' <-> Equivb m m'.
+  Proof.
+    unfold Equiv, Equivb, Raw.Equivb, cmp; intuition; specialize (H1 k e e' H H2).
+    destruct (compare e e'); auto; apply lt_not_eq in l; auto.
+    destruct (compare e e'); auto; now contradict H1.
+  Qed.
+
+
+  (** Composition of the two last results: relation between [Equal]
+    and [Equivb]. *)
+
+  Lemma Equal_Equivb : forall (m m':farray), Equal m m' <-> Equivb m m'.
+  Proof.
+    intros; rewrite Equal_Equiv.
+    apply Equiv_Equivb; auto.
+  Qed.
+  
+
+  (** * Functional arrays *)
+
+  
+  Definition select (a: farray) (i: key) : option elt := find i a.
+
+
+  Definition store (a: farray) (i: key) (v: elt) : farray := add i v a.
+
+
+  Lemma read_over_same_write : forall a i j v, i = j -> select (store a i v) j = Some v.
+  Proof.
+    intros a i j v Heq.
+    unfold select, store.
+    intros. rewrite add_eq_o; auto.
+  Qed.  
+
+
+  Lemma read_over_other_write : forall a i j v,
+      i <> j -> select (store a i v) j = select a j.
+  Proof.
+    intros a i j v Hneq.
+    unfold select, store.
+    rewrite add_neq_o; auto.
+  Qed. 
+
+
+  (* TODO *)
+  Lemma find_ext_dec:
+    (forall m1 m2: farray, Equal m1 m2 -> (equal m1 m2) = true).
+  Proof. intros.
+    apply Equal_Equivb in H.
+    apply equal_1.
+    exact H.
+  Qed.
+
+
+  Lemma extensionnality : forall a b,
+      (forall i, select a i = select b i) -> equal a b = true.
+  Proof.
+    intros.
+    unfold select in H.
+    apply find_ext_dec in H.
+    exact H.
+  Qed.
+
+  Require Import ProofIrrelevance.
+  
+  Lemma equal_eq : forall a b, equal a b = true -> a = b.
+  Proof. 
+    intros. apply eq_equal in H.
+    destruct a as (a, asort), b as (b, bsort).
+    unfold eq in H.
+    revert b bsort H.
+    induction a; intros; destruct b.
+    apply f_equal. apply proof_irrelevance.
+    simpl in H. now contradict H.
+    simpl in H. destruct a; now contradict H.
+    simpl in H. destruct a, p.
+    destruct (compare k k0); auto; try (now contradict H).
+    destruct H.
+    subst.
+    inversion_clear asort.
+    inversion_clear bsort.
+    specialize (IHa H b H2 H0).
+    inversion IHa. subst.
+    apply f_equal.  apply proof_irrelevance.
+ Qed.
+
+(** farray equal in Prop *)
+  Definition equalP (m m' : farray) : Prop :=
+    if equal m m' then True else False.
+
+  Lemma eq_list_refl: forall a, eq_list a a.
+  Proof.
+    intro a.
+    induction a; intros.
+    - now simpl.
+    - simpl. destruct a as (k, e).
+      case_eq (compare k k); intros.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+      + split; easy.
+      + revert H. generalize l.
+        apply lt_not_eq in l. now contradict l.
+  Qed.
+
+  Lemma equal_refl: forall a, equal a a = true.
+  Proof. intros; apply eq_equal; apply eq_list_refl. Qed.
+
+  Lemma equal_eqP : forall a b, equalP a b <-> a = b.
+  Proof. 
+     intros. split; intro H. unfold equalP in H.
+     case_eq (equal a b); intros; rewrite H0 in H.
+     now apply equal_eq. now contradict H.
+     rewrite H. unfold equalP.
+     now rewrite equal_refl.
+  Qed.
+
+ Lemma equal_B2P: forall (m m' : farray),
+                  equal m m' = true <-> equalP m m'.
+ Proof.
+     intros. split; intros.
+     apply equal_eq in H. rewrite H.
+     unfold equalP. now rewrite equal_refl.
+     apply equal_eqP in H.
+     now rewrite H, equal_refl.
+ Qed.
+
+End FArray.
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/bva/BVList.v b/src/bva/BVList.v
new file mode 100644
index 0000000..48befd6
--- /dev/null
+++ b/src/bva/BVList.v
@@ -0,0 +1,2704 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import List Bool NArith Psatz Int63 Nnat.
+Require Import Misc.
+Import ListNotations.
+Local Open Scope list_scope.
+Local Open Scope N_scope.
+Local Open Scope bool_scope.
+
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(* We temporarily assume proof irrelevance to handle dependently typed
+   bit vectors *)
+Axiom proof_irrelevance : forall (P : Prop) (p1 p2 : P), p1 = p2.
+
+Lemma inj a a' : N.to_nat a = N.to_nat a' -> a = a'.
+Proof. intros. lia. Qed.
+
+  Fixpoint leb (n m: nat) : bool :=
+    match n with
+      | O => 
+      match m with
+        | O => true
+        | S m' => true
+      end
+      | S n' =>
+      match m with
+        | O => false
+        | S m' => leb n' m'
+      end
+    end.
+
+Module Type BITVECTOR.
+
+  Parameter bitvector : N -> Type.
+  Parameter bits      : forall n, bitvector n -> list bool.
+  Parameter of_bits   : forall (l:list bool), bitvector (N.of_nat (List.length l)).
+  Parameter bitOf     : forall n, nat -> bitvector n -> bool.
+
+  (* Constants *)
+  Parameter zeros     : forall n, bitvector n.
+
+  (*equality*)
+  Parameter bv_eq     : forall n, bitvector n -> bitvector n -> bool.
+
+  (*binary operations*)
+  Parameter bv_concat : forall n m, bitvector n -> bitvector m -> bitvector (n + m).
+  Parameter bv_and    : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_or     : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_xor    : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_add    : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_subt   : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_mult   : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_ult    : forall n, bitvector n -> bitvector n -> bool.
+  Parameter bv_slt    : forall n, bitvector n -> bitvector n -> bool.
+
+  Parameter bv_ultP   : forall n, bitvector n -> bitvector n -> Prop.
+  Parameter bv_sltP   : forall n, bitvector n -> bitvector n -> Prop.
+
+  Parameter bv_shl    : forall n, bitvector n -> bitvector n -> bitvector n.
+  Parameter bv_shr    : forall n, bitvector n -> bitvector n -> bitvector n.
+
+    (*unary operations*)
+  Parameter bv_not    : forall n,     bitvector n -> bitvector n.
+  Parameter bv_neg    : forall n,     bitvector n -> bitvector n.
+  Parameter bv_extr   : forall (i n0 n1 : N), bitvector n1 -> bitvector n0.
+
+ (* Parameter bv_extr   : forall (n i j : N) {H0: n >= j} {H1: j >= i}, bitvector n -> bitvector (j - i). *)
+
+  Parameter bv_zextn  : forall (n i: N), bitvector n -> bitvector (i + n).
+  Parameter bv_sextn  : forall (n i: N), bitvector n -> bitvector (i + n).
+ (* Parameter bv_extr   : forall n i j : N, bitvector n -> n >= j -> j >= i -> bitvector (j - i). *)
+
+  (* Specification *)
+  Axiom bits_size     : forall n (bv:bitvector n), List.length (bits bv) = N.to_nat n.
+  Axiom bv_eq_reflect : forall n (a b:bitvector n), bv_eq a b = true <-> a = b.
+  Axiom bv_eq_refl    : forall n (a:bitvector n), bv_eq a a = true.
+
+  Axiom bv_ult_B2P    : forall n (a b:bitvector n), bv_ult a b = true <-> bv_ultP a b.
+  Axiom bv_slt_B2P    : forall n (a b:bitvector n), bv_slt a b = true <-> bv_sltP a b.
+  Axiom bv_ult_not_eq : forall n (a b:bitvector n), bv_ult a b = true -> a <> b.
+  Axiom bv_slt_not_eq : forall n (a b:bitvector n), bv_slt a b = true -> a <> b.
+  Axiom bv_ult_not_eqP: forall n (a b:bitvector n), bv_ultP a b -> a <> b.
+  Axiom bv_slt_not_eqP: forall n (a b:bitvector n), bv_sltP a b -> a <> b.
+
+  Axiom bv_and_comm   : forall n (a b:bitvector n), bv_eq (bv_and a b) (bv_and b a) = true.
+  Axiom bv_or_comm    : forall n (a b:bitvector n), bv_eq (bv_or a b) (bv_or b a) = true.
+  Axiom bv_add_comm   : forall n (a b:bitvector n), bv_eq (bv_add a b) (bv_add b a) = true. 
+
+  Axiom bv_and_assoc  : forall n (a b c: bitvector n), bv_eq (bv_and a (bv_and b c)) (bv_and (bv_and a b) c) = true.
+  Axiom bv_or_assoc   : forall n (a b c: bitvector n), bv_eq (bv_or a (bv_or b c)) (bv_or (bv_or a b) c) = true.
+  Axiom bv_xor_assoc  : forall n (a b c: bitvector n), bv_eq (bv_xor a (bv_xor b c)) (bv_xor (bv_xor a b) c) = true.
+  Axiom bv_add_assoc  : forall n (a b c: bitvector n), bv_eq (bv_add a (bv_add b c)) (bv_add (bv_add a b) c) = true.
+  Axiom bv_not_involutive: forall n (a: bitvector n), bv_eq (bv_not (bv_not a)) a = true.
+
+  Parameter _of_bits  : forall (l: list bool) (s : N), bitvector s.
+
+End BITVECTOR.
+
+Module Type RAWBITVECTOR.
+
+Parameter bitvector  : Type.
+Parameter size       : bitvector -> N.
+Parameter bits       : bitvector -> list bool.
+Parameter of_bits    : list bool -> bitvector.
+Parameter _of_bits   : list bool -> N -> bitvector.
+Parameter bitOf      : nat -> bitvector -> bool.
+
+(* Constants *)
+Parameter zeros      : N -> bitvector.
+
+(*equality*)
+Parameter bv_eq      : bitvector -> bitvector -> bool.
+
+(*binary operations*)
+Parameter bv_concat  : bitvector -> bitvector -> bitvector.
+Parameter bv_and     : bitvector -> bitvector -> bitvector.
+Parameter bv_or      : bitvector -> bitvector -> bitvector.
+Parameter bv_xor     : bitvector -> bitvector -> bitvector.
+Parameter bv_add     : bitvector -> bitvector -> bitvector.
+Parameter bv_mult    : bitvector -> bitvector -> bitvector.
+Parameter bv_subt    : bitvector -> bitvector -> bitvector.
+Parameter bv_ult     : bitvector -> bitvector -> bool.
+Parameter bv_slt     : bitvector -> bitvector -> bool.
+
+Parameter bv_ultP    : bitvector -> bitvector -> Prop.
+Parameter bv_sltP    : bitvector -> bitvector -> Prop.
+
+Parameter bv_shl     : bitvector -> bitvector -> bitvector.
+Parameter bv_shr     : bitvector -> bitvector -> bitvector.
+
+(*unary operations*)
+Parameter bv_not     : bitvector -> bitvector.
+Parameter bv_neg     : bitvector -> bitvector.
+Parameter bv_extr    : forall (i n0 n1: N), bitvector -> bitvector.
+
+(*Parameter bv_extr    : forall (n i j: N) {H0: n >= j} {H1: j >= i}, bitvector -> bitvector.*)
+
+Parameter bv_zextn   : forall (n i: N), bitvector -> bitvector.
+Parameter bv_sextn   : forall (n i: N), bitvector -> bitvector.
+
+(* All the operations are size-preserving *)
+
+Axiom bits_size      : forall bv, List.length (bits bv) = N.to_nat (size bv).
+Axiom of_bits_size   : forall l, N.to_nat (size (of_bits l)) = List.length l.
+Axiom _of_bits_size  : forall l s,(size (_of_bits l s)) = s.
+Axiom zeros_size     : forall n, size (zeros n) = n.
+Axiom bv_concat_size : forall n m a b, size a = n -> size b = m -> size (bv_concat a b) = n + m.
+Axiom bv_and_size    : forall n a b, size a = n -> size b = n -> size (bv_and a b) = n.
+Axiom bv_or_size     : forall n a b, size a = n -> size b = n -> size (bv_or a b) = n.
+Axiom bv_xor_size    : forall n a b, size a = n -> size b = n -> size (bv_xor a b) = n.
+Axiom bv_add_size    : forall n a b, size a = n -> size b = n -> size (bv_add a b) = n.
+Axiom bv_subt_size   : forall n a b, size a = n -> size b = n -> size (bv_subt a b) = n.
+Axiom bv_mult_size   : forall n a b, size a = n -> size b = n -> size (bv_mult a b) = n.
+Axiom bv_not_size    : forall n a, size a = n -> size (bv_not a) = n.
+Axiom bv_neg_size    : forall n a, size a = n -> size (bv_neg a) = n.
+Axiom bv_shl_size    : forall n a b, size a = n -> size b = n -> size (bv_shl a b) = n.
+Axiom bv_shr_size    : forall n a b, size a = n -> size b = n -> size (bv_shr a b) = n.
+
+Axiom bv_extr_size   : forall i n0 n1 a, size a = n1 -> size (@bv_extr i n0 n1 a) = n0.
+
+(*
+Axiom bv_extr_size   : forall n (i j: N) a (H0: n >= j) (H1: j >= i), 
+  size a = n -> size (@bv_extr n i j H0 H1 a) = (j - i).
+*)
+
+Axiom bv_zextn_size  : forall (n i: N) a, 
+  size a = n -> size (@bv_zextn n i a) = (i + n).
+Axiom bv_sextn_size  : forall (n i: N) a, 
+  size a = n -> size (@bv_sextn n i a) = (i + n).
+
+(* Specification *)
+Axiom bv_eq_reflect  : forall a b, bv_eq a b = true <-> a = b.
+Axiom bv_eq_refl     : forall a, bv_eq a a = true.
+
+
+Axiom bv_ult_not_eq  : forall a b, bv_ult a b = true -> a <> b.
+Axiom bv_slt_not_eq  : forall a b, bv_slt a b = true -> a <> b.
+Axiom bv_ult_not_eqP : forall a b, bv_ultP a b -> a <> b.
+Axiom bv_slt_not_eqP : forall a b, bv_sltP a b -> a <> b.
+Axiom bv_ult_B2P     : forall a b, bv_ult a b = true <-> bv_ultP a b.
+Axiom bv_slt_B2P     : forall a b, bv_slt a b = true <-> bv_sltP a b.
+
+
+Axiom bv_and_comm    : forall n a b, size a = n -> size b = n -> bv_and a b = bv_and b a.
+Axiom bv_or_comm     : forall n a b, size a = n -> size b = n -> bv_or a b = bv_or b a.
+Axiom bv_add_comm    : forall n a b, size a = n -> size b = n -> bv_add a b = bv_add b a.
+
+Axiom bv_and_assoc   : forall n a b c, size a = n -> size b = n -> size c = n -> 
+                                    (bv_and a (bv_and b c)) = (bv_and (bv_and a b) c).
+Axiom bv_or_assoc    : forall n a b c, size a = n -> size b = n -> size c = n -> 
+                                    (bv_or a (bv_or b c)) = (bv_or (bv_or a b) c).
+Axiom bv_xor_assoc   : forall n a b c, size a = n -> size b = n -> size c = n -> 
+                                    (bv_xor a (bv_xor b c)) = (bv_xor (bv_xor a b) c).
+Axiom bv_add_assoc   : forall n a b c, size a = n -> size b = n -> size c = n -> 
+                                    (bv_add a (bv_add b c)) = (bv_add (bv_add a b) c).
+Axiom bv_not_involutive: forall a, bv_not (bv_not a) = a.
+
+End RAWBITVECTOR.
+
+Module RAW2BITVECTOR (M:RAWBITVECTOR) <: BITVECTOR.
+
+  Record bitvector_ (n:N) : Type :=
+    MkBitvector
+      { bv :> M.bitvector;
+        wf : M.size bv = n
+      }.
+  Definition bitvector := bitvector_.
+
+  Definition bits n (bv:bitvector n) := M.bits bv.
+
+  Lemma of_bits_size l : M.size (M.of_bits l) = N.of_nat (List.length l).
+  Proof. now rewrite <- M.of_bits_size, N2Nat.id. Qed.
+
+  Lemma _of_bits_size l s: M.size (M._of_bits l s) = s.
+  Proof. apply (M._of_bits_size l s). Qed. 
+
+  Definition of_bits (l:list bool) : bitvector (N.of_nat (List.length l)) :=
+    @MkBitvector _ (M.of_bits l) (of_bits_size l).
+
+  Definition _of_bits (l: list bool) (s : N): bitvector s :=
+  @MkBitvector _ (M._of_bits l s) (_of_bits_size l s).
+
+  Definition bitOf n p (bv:bitvector n) : bool := M.bitOf p bv.
+
+  Definition zeros (n:N) : bitvector n :=
+    @MkBitvector _ (M.zeros n) (M.zeros_size n).
+
+  Definition bv_eq n (bv1 bv2:bitvector n) := M.bv_eq bv1 bv2.
+
+  Definition bv_ultP n (bv1 bv2:bitvector n) := M.bv_ultP bv1 bv2.
+
+  Definition bv_sltP n (bv1 bv2:bitvector n) := M.bv_sltP bv1 bv2.
+
+  Definition bv_and n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_and bv1 bv2) (M.bv_and_size (wf bv1) (wf bv2)).
+
+  Definition bv_or n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_or bv1 bv2) (M.bv_or_size (wf bv1) (wf bv2)).
+
+  Definition bv_add n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_add bv1 bv2) (M.bv_add_size (wf bv1) (wf bv2)).
+
+  Definition bv_subt n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_subt bv1 bv2) (M.bv_subt_size (wf bv1) (wf bv2)).
+
+  Definition bv_mult n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_mult bv1 bv2) (M.bv_mult_size (wf bv1) (wf bv2)).
+
+  Definition bv_xor n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_xor bv1 bv2) (M.bv_xor_size (wf bv1) (wf bv2)).
+
+  Definition bv_ult n (bv1 bv2:bitvector n) : bool := M.bv_ult bv1 bv2.
+
+  Definition bv_slt n (bv1 bv2:bitvector n) : bool := M.bv_slt bv1 bv2.
+
+  Definition bv_not n (bv1: bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_not bv1) (M.bv_not_size (wf bv1)).
+
+  Definition bv_neg n (bv1: bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_neg bv1) (M.bv_neg_size (wf bv1)).
+
+  Definition bv_concat n m (bv1:bitvector n) (bv2: bitvector m) : bitvector (n + m) :=
+    @MkBitvector (n + m) (M.bv_concat bv1 bv2) (M.bv_concat_size (wf bv1) (wf bv2)).
+
+  Definition bv_extr (i n0 n1: N) (bv1: bitvector n1) : bitvector n0 :=
+    @MkBitvector n0 (@M.bv_extr i n0 n1 bv1) (@M.bv_extr_size i n0 n1 bv1 (wf bv1)).
+
+(*
+  Definition bv_extr  n (i j: N) (H0: n >= j) (H1: j >= i) (bv1: bitvector n) : bitvector (j - i) :=
+    @MkBitvector (j - i) (@M.bv_extr n i j H0 H1 bv1) (@M.bv_extr_size n i j bv1 H0 H1 (wf bv1)).
+*)
+
+  Definition bv_zextn n (i: N)  (bv1: bitvector n) : bitvector (i + n) :=
+    @MkBitvector (i + n) (@M.bv_zextn n i bv1) (@M.bv_zextn_size n i bv1 (wf bv1)).
+
+  Definition bv_sextn n (i: N)  (bv1: bitvector n) : bitvector (i + n) :=
+    @MkBitvector (i + n) (@M.bv_sextn n i bv1) (@M.bv_sextn_size n i bv1 (wf bv1)).
+
+  Definition bv_shl n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_shl bv1 bv2) (M.bv_shl_size (wf bv1) (wf bv2)).
+
+  Definition bv_shr n (bv1 bv2:bitvector n) : bitvector n :=
+    @MkBitvector n (M.bv_shr bv1 bv2) (M.bv_shr_size (wf bv1) (wf bv2)).
+
+  Lemma bits_size n (bv:bitvector n) : List.length (bits bv) = N.to_nat n.
+  Proof. unfold bits. now rewrite M.bits_size, wf. Qed.
+
+  (* The next lemma is provable only if we assume proof irrelevance *)
+  Lemma bv_eq_reflect n (a b: bitvector n) : bv_eq a b = true <-> a = b.
+  Proof.
+    unfold bv_eq. rewrite M.bv_eq_reflect. split.
+    - revert a b. intros [a Ha] [b Hb]. simpl. intros ->.
+      rewrite (proof_irrelevance Ha Hb). reflexivity.
+    - intros. case a in *. case b in *. simpl in *.
+      now inversion H. (* now intros ->. *)
+  Qed.
+
+  Lemma bv_eq_refl n (a : bitvector n) : bv_eq a a = true.
+  Proof.
+    unfold bv_eq. now rewrite M.bv_eq_reflect.
+  Qed.
+
+  Lemma bv_ult_not_eqP: forall n (a b: bitvector n), bv_ultP a b -> a <> b.
+  Proof. 
+    unfold bv_ultP, bv_ult. intros n a b H.
+    apply M.bv_ult_not_eqP in H. unfold not in *; intros. apply H.
+    apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl.
+  Qed.
+
+  Lemma bv_slt_not_eqP: forall n (a b: bitvector n), bv_sltP a b -> a <> b.
+  Proof. 
+    unfold bv_sltP, bv_slt. intros n a b H.
+    apply M.bv_slt_not_eqP in H. unfold not in *; intros. apply H.
+    apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl.
+  Qed.
+
+  Lemma bv_ult_not_eq: forall n (a b: bitvector n), bv_ult a b = true -> a <> b.
+  Proof. 
+    unfold bv_ult. intros n a b H.
+    apply M.bv_ult_not_eq in H. unfold not in *; intros. apply H.
+    apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl.
+  Qed.
+
+  Lemma bv_slt_not_eq: forall n (a b: bitvector n), bv_slt a b = true -> a <> b.
+  Proof. 
+    unfold bv_slt. intros n a b H.
+    apply M.bv_slt_not_eq in H. unfold not in *; intros. apply H.
+    apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl.
+  Qed.
+
+  Lemma bv_ult_B2P: forall n (a b: bitvector n), bv_ult a b = true <-> bv_ultP a b.
+  Proof. 
+      unfold bv_ultP, bv_ult; intros; split; intros;
+      now apply M.bv_ult_B2P.
+  Qed. 
+
+  Lemma bv_slt_B2P: forall n (a b: bitvector n), bv_slt a b = true <-> bv_sltP a b.
+  Proof. 
+      unfold bv_ultP, bv_slt; intros; split; intros;
+      now apply M.bv_slt_B2P.
+  Qed.
+
+  Lemma bv_and_comm n (a b:bitvector n) : bv_eq (bv_and a b) (bv_and b a) = true.
+  Proof.
+    unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_and_comm n); now rewrite wf.
+  Qed.
+
+  Lemma bv_or_comm n (a b:bitvector n) : bv_eq (bv_or a b) (bv_or b a) = true.
+  Proof.
+    unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_or_comm n); now rewrite wf.
+  Qed.
+
+  Lemma bv_add_comm n (a b:bitvector n) : bv_eq (bv_add a b) (bv_add b a) = true.
+  Proof.
+    unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_add_comm n); now rewrite wf.
+  Qed.
+
+  Lemma bv_and_assoc : forall n (a b c :bitvector n), bv_eq (bv_and a (bv_and b c)) (bv_and (bv_and a b) c) = true.
+  Proof.
+     intros n a b c.
+     unfold bv_eq. rewrite M.bv_eq_reflect. simpl. 
+     apply (@M.bv_and_assoc n a b c); now rewrite wf.
+  Qed.
+
+  Lemma bv_or_assoc : forall n (a b c :bitvector n), bv_eq (bv_or a (bv_or b c)) (bv_or (bv_or a b) c) = true.
+  Proof.
+     intros n a b c.
+     unfold bv_eq. rewrite M.bv_eq_reflect. simpl. 
+     apply (@M.bv_or_assoc n a b c); now rewrite wf.
+  Qed.
+
+  Lemma bv_xor_assoc : forall n (a b c :bitvector n), bv_eq (bv_xor a (bv_xor b c)) (bv_xor (bv_xor a b) c) = true.
+  Proof.
+     intros n a b c.
+     unfold bv_eq. rewrite M.bv_eq_reflect. simpl. 
+     apply (@M.bv_xor_assoc n a b c); now rewrite wf.
+  Qed.
+
+  Lemma bv_add_assoc : forall n (a b c :bitvector n), bv_eq (bv_add a (bv_add b c)) (bv_add (bv_add a b) c) = true.
+  Proof.
+     intros n a b c.
+     unfold bv_eq. rewrite M.bv_eq_reflect. simpl. 
+     apply (@M.bv_add_assoc n a b c); now rewrite wf.
+  Qed.
+
+  Lemma bv_not_involutive: forall n (a: bitvector n), bv_eq (bv_not (bv_not a)) a = true.
+  Proof.
+       intros n a.
+       unfold bv_eq. rewrite M.bv_eq_reflect. simpl. 
+       apply (@M.bv_not_involutive a); now rewrite wf.
+  Qed.
+
+
+End RAW2BITVECTOR.
+
+Module RAWBITVECTOR_LIST <: RAWBITVECTOR.
+
+Definition bitvector := list bool.
+Definition bits (a:bitvector) : list bool := a.
+Definition size (a:bitvector) := N.of_nat (List.length a).
+Definition of_bits (a:list bool) : bitvector := a.
+
+Lemma bits_size bv : List.length (bits bv) = N.to_nat (size bv).
+Proof. unfold bits, size. now rewrite Nat2N.id. Qed.
+
+Lemma of_bits_size l : N.to_nat (size (of_bits l)) = List.length l.
+Proof. unfold of_bits, size. now rewrite Nat2N.id. Qed.
+
+Fixpoint beq_list (l m : list bool) {struct l} :=
+  match l, m with
+    | nil, nil => true
+    | x :: l', y :: m' => (Bool.eqb x y) && (beq_list l' m')
+    | _, _ => false
+  end.
+
+Definition bv_eq (a b: bitvector): bool:=
+  if ((size a) =? (size b)) then beq_list (bits a) (bits b) else false.
+
+Fixpoint beq_listP (l m : list bool) {struct l} :=
+  match l, m with
+    | nil, nil => True
+    | x :: l', y :: m' => (x = y) /\ (beq_listP l' m')
+    | _, _ => False
+  end.
+
+Lemma bv_mk_eq l1 l2 : bv_eq l1 l2 = beq_list l1 l2.
+Proof.
+  unfold bv_eq, size, bits.
+  case_eq (Nat_eqb (length l1) (length l2)); intro Heq.
+  - now rewrite (EqNat.beq_nat_true _ _ Heq), N.eqb_refl.
+  - replace (N.of_nat (length l1) =? N.of_nat (length l2)) with false.
+    * revert l2 Heq. induction l1 as [ |b1 l1 IHl1]; intros [ |b2 l2]; simpl in *; auto.
+      intro Heq. now rewrite <- (IHl1 _ Heq), andb_false_r.
+    * symmetry. rewrite N.eqb_neq. intro H. apply Nat2N.inj in H. rewrite H in Heq.
+      rewrite <- EqNat.beq_nat_refl in Heq. discriminate.
+Qed.
+
+Definition bv_concat (a b: bitvector) : bitvector := b ++ a.
+
+Section Map2.
+
+  Variables A B C: Type.
+  Variable f : A -> B -> C.
+
+  Fixpoint map2 (l1 : list A) (l2 : list B) {struct l1} : list C :=
+    match l1, l2 with
+      | b1::tl1, b2::tl2 => (f b1 b2)::(map2 tl1 tl2)
+      | _, _ => nil
+    end.
+
+End Map2.
+
+Section Fold_left2.
+
+  Variables A B: Type.
+  Variable f : A -> B -> B -> A.
+
+  Fixpoint fold_left2 (xs ys: list B) (acc:A) {struct xs} : A :=
+    match xs, ys with
+    | nil, _ | _, nil => acc
+    | x::xs, y::ys    => fold_left2 xs ys (f acc x y)
+    end.
+
+  Lemma foo : forall (I: A -> Prop) acc, I acc -> 
+              (forall a b1 b2, I a -> I (f a b1 b2)) -> 
+              forall xs ys, I (fold_left2 xs ys acc).
+  Proof. intros I acc H0 H1 xs. revert acc H0.
+         induction xs as [ | a xs IHxs]; intros acc H.
+         simpl. auto.
+         intros [ | b ys].
+            + simpl. exact H.
+            + simpl. apply IHxs, H1. exact H.
+  Qed.
+
+Fixpoint mk_list_true_acc (t: nat) (acc: list bool) : list bool :=
+  match t with
+    | O    => acc
+    | S t' => mk_list_true_acc t' (true::acc)
+  end.
+
+Fixpoint mk_list_true (t: nat) : list bool :=
+  match t with
+    | O    => []
+    | S t' => true::(mk_list_true t')
+  end.
+
+Fixpoint mk_list_false_acc (t: nat) (acc: list bool) : list bool :=
+  match t with
+    | O    => acc
+    | S t' => mk_list_false_acc t' (false::acc)
+  end.
+
+Fixpoint mk_list_false (t: nat) : list bool :=
+  match t with
+    | O    => []
+    | S t' => false::(mk_list_false t')
+  end.
+
+Definition zeros (n : N) : bitvector := mk_list_false (N.to_nat n).
+
+End Fold_left2.
+
+Definition bitOf (n: nat) (a: bitvector): bool := nth n a false.
+
+Definition bv_and (a b : bitvector) : bitvector :=
+  match (@size a) =? (@size b) with
+    | true => map2 andb (@bits a) (@bits b)
+    | _    => nil
+  end.
+
+Definition bv_or (a b : bitvector) : bitvector :=
+  match (@size a) =? (@size b) with
+    | true => map2 orb (@bits a) (@bits b)
+    | _    => nil
+  end.
+
+Definition bv_xor (a b : bitvector) : bitvector :=
+  match (@size a) =? (@size b) with
+    | true => map2 xorb (@bits a) (@bits b)
+    | _    => nil
+  end.
+
+Definition bv_not (a: bitvector) : bitvector := map negb (@bits a).
+
+
+(*arithmetic operations*)
+
+ (*addition*)
+
+Definition add_carry b1 b2 c :=
+  match b1, b2, c with
+    | true,  true,  true  => (true, true)
+    | true,  true,  false
+    | true,  false, true
+    | false, true,  true  => (false, true)
+    | false, false, true
+    | false, true,  false
+    | true,  false, false => (true, false)
+    | false, false, false => (false, false)
+  end.
+
+(* Truncating addition in little-endian, direct style *)
+
+Fixpoint add_list_ingr bs1 bs2 c {struct bs1} :=
+  match bs1, bs2 with
+    | nil, _               => nil
+    | _ , nil              => nil
+    | b1 :: bs1, b2 :: bs2 =>
+      let (r, c) := add_carry b1 b2 c in r :: (add_list_ingr bs1 bs2 c)
+  end.
+
+Definition add_list (a b: list bool) := add_list_ingr a b false.
+
+Definition bv_add (a b : bitvector) : bitvector :=
+  match (@size a) =? (@size b) with
+    | true => add_list a b
+    | _    => nil
+  end.
+
+  (*substraction*)
+
+Definition twos_complement b :=
+  add_list_ingr (map negb b) (mk_list_false (length b)) true.
+  
+Definition bv_neg (a: bitvector) : bitvector := (twos_complement a).
+
+Definition subst_list' a b := add_list a (twos_complement b).
+
+Definition bv_subt' (a b : bitvector) : bitvector :=
+   match (@size a) =? (@size b) with
+     | true => (subst_list' (@bits a) (@bits b))
+     | _    => nil
+   end.
+
+Definition subst_borrow b1 b2 b :=
+  match b1, b2, b with
+    | true,  true,  true  => (true, true)
+    | true,  true,  false => (false, false)
+    | true,  false, true  => (false, false)
+    | false, true,  true  => (false, true)
+    | false, false, true  => (true, true)
+    | false, true,  false => (true, true)
+    | true,  false, false => (true, false)
+    | false, false, false => (false, false)
+  end.
+
+Fixpoint subst_list_borrow bs1 bs2 b {struct bs1} :=
+  match bs1, bs2 with
+    | nil, _               => nil
+    | _ , nil              => nil
+    | b1 :: bs1, b2 :: bs2 =>
+      let (r, b) := subst_borrow b1 b2 b in r :: (subst_list_borrow bs1 bs2 b)
+  end.
+
+Definition subst_list (a b: list bool) := subst_list_borrow a b false.
+
+Definition bv_subt (a b : bitvector) : bitvector :=
+  match (@size a) =? (@size b) with 
+    | true => subst_list (@bits a) (@bits b)
+    | _    => nil 
+  end.
+  
+(*less than*)
+
+Fixpoint ult_list_big_endian (x y: list bool) :=
+  match x, y with
+    | nil, _  => false
+    | _ , nil => false
+    | xi :: nil, yi :: nil => andb (negb xi) yi
+    | xi :: x', yi :: y' =>
+      orb (andb (Bool.eqb xi yi) (ult_list_big_endian x' y'))
+          (andb (negb xi) yi)
+  end.
+
+Definition ult_list (x y: list bool) :=
+  (ult_list_big_endian (List.rev x) (List.rev y)).
+
+
+Fixpoint slt_list_big_endian (x y: list bool) :=
+  match x, y with
+    | nil, _  => false
+    | _ , nil => false
+    | xi :: nil, yi :: nil => andb xi (negb yi)
+    | xi :: x', yi :: y' =>
+      orb (andb (Bool.eqb xi yi) (ult_list_big_endian x' y'))
+          (andb xi (negb yi))
+  end.
+
+Definition slt_list (x y: list bool) :=
+  slt_list_big_endian (List.rev x) (List.rev y).
+
+
+Definition bv_ult (a b : bitvector) : bool :=
+  if @size a =? @size b then ult_list a b else false.
+
+
+Definition bv_slt (a b : bitvector) : bool :=
+  if @size a =? @size b then slt_list a b else false.
+
+Definition ult_listP (x y: list bool) :=
+  if ult_list x y then True else False.
+
+Definition slt_listP (x y: list bool) :=
+  if slt_list x y then True else False.
+
+Definition bv_ultP (a b : bitvector) : Prop :=
+  if @size a =? @size b then ult_listP a b else False.
+
+Definition bv_sltP (a b : bitvector) : Prop :=
+  if @size a =? @size b then slt_listP a b else False.
+
+
+  (*multiplication*)
+
+Fixpoint mult_list_carry (a b :list bool) n {struct a}: list bool :=
+  match a with
+    | nil      => mk_list_false n
+    | a' :: xs =>
+      if a' then
+        add_list b (mult_list_carry xs (false :: b) n)
+      else
+        mult_list_carry xs (false :: b) n
+  end.
+
+Fixpoint mult_list_carry2 (a b :list bool) n {struct a}: list bool :=
+  match a with
+    | nil      => mk_list_false n
+    | a' :: xs =>
+      if a' then
+        add_list b (mult_list_carry2 xs (false :: (removelast b)) n)
+      else
+        mult_list_carry2 xs (false :: (removelast b)) n
+  end.
+  
+Fixpoint and_with_bool (a: list bool) (bt: bool) : list bool :=
+  match a with
+    | nil => nil
+    | ai :: a' => (bt && ai) :: and_with_bool a' bt 
+  end.
+
+
+Fixpoint mult_bool_step_k_h (a b: list bool) (c: bool) (k: Z) : list bool :=
+  match a, b with
+    | nil , _ => nil
+    | ai :: a', bi :: b' =>
+      if (k - 1 <? 0)%Z then
+        let carry_out := (ai && bi) || ((xorb ai bi) && c) in
+        let curr := xorb (xorb ai bi) c in
+        curr :: mult_bool_step_k_h a' b' carry_out (k - 1)
+      else
+        ai :: mult_bool_step_k_h a' b c (k - 1)
+    | ai :: a' , nil => ai :: mult_bool_step_k_h a' b c k
+  end.
+
+Local Open Scope int63_scope.
+
+Fixpoint top_k_bools (a: list bool) (k: int) : list bool :=
+  if (k == 0) then nil
+  else match a with
+         | nil => nil
+         | ai :: a' => ai :: top_k_bools a' (k - 1)
+       end.
+
+
+Fixpoint mult_bool_step (a b: list bool) (res: list bool) (k k': nat) : list bool :=
+  let ak := List.firstn (S k') a in
+  let b' := and_with_bool ak (nth k b false) in
+  let res' := mult_bool_step_k_h res b' false (Z.of_nat k) in
+  match k' with
+    | O => res'
+    (* | S O => res' *)
+    | S pk' => mult_bool_step a b res' (S k) pk'
+  end.
+
+Definition bvmult_bool (a b: list bool) (n: nat) : list bool :=
+  let res := and_with_bool a (nth 0 b false) in
+  match n with
+    | O => res
+    | S O => res
+    | S (S k) => mult_bool_step a b res 1 k
+  end.
+
+Definition mult_list a b := bvmult_bool a b (length a).
+
+Definition bv_mult (a b : bitvector) : bitvector :=
+  if ((@size a) =? (@size b))
+  then mult_list a b
+  else zeros (@size a).
+
+(* Theorems *)
+
+Lemma length_mk_list_false: forall n, length (mk_list_false n) = n.
+Proof. intro n.
+       induction n as [ | n' IHn].
+       - simpl. auto.
+       - simpl. apply f_equal. exact IHn.
+Qed.
+
+Definition _of_bits (a:list bool) (s: N) := 
+if (N.of_nat (length a) =? s) then a else zeros s.
+
+Lemma _of_bits_size l s: (size (_of_bits l s)) = s.
+Proof. unfold of_bits, size. unfold _of_bits.
+       case_eq ( N.of_nat (length l) =? s).
+       intros. now rewrite N.eqb_eq in H.
+       intros. unfold zeros. rewrite length_mk_list_false.
+       now rewrite N2Nat.id.
+Qed.
+
+Lemma length_mk_list_true: forall n, length (mk_list_true n) = n.
+Proof. intro n.
+       induction n as [ | n' IHn].
+       - simpl. auto.
+       - simpl. apply f_equal. exact IHn.
+Qed.
+
+Lemma zeros_size (n : N) : size (zeros n) = n.
+Proof. unfold size, zeros. now rewrite length_mk_list_false, N2Nat.id. Qed. 
+
+Lemma List_eq : forall (l m: list bool), beq_list l m = true <-> l = m.
+Proof.
+    induction l; destruct m; simpl; split; intro; try (reflexivity || discriminate).
+    - rewrite andb_true_iff in H. destruct H. rewrite eqb_true_iff in H. rewrite H.
+    apply f_equal. apply IHl. exact H0.
+    - inversion H. subst b. subst m. rewrite andb_true_iff. split.
+      + apply eqb_reflx.
+      + apply IHl; reflexivity.
+Qed.
+
+Lemma List_eqP : forall (l m: list bool), beq_listP l m  <-> l = m.
+Proof.
+    induction l; destruct m; simpl; split; intro; try (reflexivity || discriminate); try now contradict H.
+    - destruct H. rewrite H.
+      apply f_equal. apply IHl. exact H0.
+    - inversion H. subst b. subst m. split.
+      + reflexivity.
+      + apply IHl; reflexivity.
+Qed.
+
+Lemma List_eq_refl : forall (l: list bool), beq_list l l = true.
+Proof.
+    induction l; simpl; try (reflexivity || discriminate).
+    - rewrite andb_true_iff. split. apply eqb_reflx. apply IHl.
+Qed.
+
+Lemma List_eqP_refl : forall (l: list bool), beq_listP l l  <-> l = l.
+Proof. intro l.
+       induction l as [ | xl xsl IHl ]; intros.
+       - easy.
+       - simpl. repeat split. now apply IHl.
+Qed.
+
+Lemma List_neq : forall (l m: list bool), beq_list l m = false -> l <> m.
+Proof. 
+       intro l.
+       induction l.
+       - intros. case m in *; simpl. now contradict H. easy.
+       - intros. simpl in H.
+         case_eq m; intros; rewrite H0 in H. 
+           easy. simpl.
+           case_eq (Bool.eqb a b); intros.
+           rewrite H1 in H. rewrite andb_true_l in H.
+           apply Bool.eqb_prop in H1.
+           specialize (IHl l0 H).
+           rewrite H1. 
+           unfold not in *.
+           intros. apply IHl.
+           now inversion H2.
+           apply Bool.eqb_false_iff in H1.
+           unfold not in *.
+           intros. apply H1.
+           now inversion H2.
+Qed.
+
+Lemma List_neqP : forall (l m: list bool), ~beq_listP l m -> l <> m.
+Proof. 
+       intro l.
+       induction l.
+       - intros. case m in *; simpl. now contradict H. easy.
+       - intros. unfold not in H. simpl in H.
+         case_eq m; intros. easy.
+         rewrite H0 in H.
+         unfold not. intros. apply H. inversion H1.
+         split; try easy.
+         now apply List_eqP_refl.
+Qed.
+
+Lemma bv_eq_reflect a b : bv_eq a b = true <-> a = b.
+Proof.
+  unfold bv_eq. case_eq (size a =? size b); intro Heq; simpl.
+  - apply List_eq.
+  - split; try discriminate.
+    intro H. rewrite H, N.eqb_refl in Heq. discriminate.
+Qed.
+
+Lemma bv_eq_refl a: bv_eq a a = true.
+Proof.
+  unfold bv_eq. rewrite N.eqb_refl. now apply List_eq. 
+Qed.
+
+Lemma bv_concat_size n m a b : size a = n -> size b = m -> size (bv_concat a b) = (n + m)%N.
+Proof.
+  unfold bv_concat, size. intros H0 H1.
+  rewrite app_length, Nat2N.inj_add, H0, H1; now rewrite N.add_comm.
+Qed.
+
+(*list bitwise AND properties*)
+
+Lemma map2_and_comm: forall (a b: list bool), (map2 andb a b) = (map2 andb b a).
+Proof. intros a. induction a as [ | a' xs IHxs].
+       intros [ | b' ys].
+       - simpl. auto.
+       - simpl. auto.
+       - intros [ | b' ys].
+         + simpl. auto.
+         + intros. simpl. 
+           cut (a' && b' = b' && a'). intro H. rewrite <- H. apply f_equal.
+           apply IHxs. apply andb_comm.
+Qed.
+
+Lemma map2_and_assoc: forall (a b c: list bool), (map2 andb a (map2 andb b c)) = (map2 andb (map2 andb a b) c).
+Proof. intro a. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b' ys].
+        -  simpl. auto.
+        - intros [ | c' zs].
+          + simpl. auto.
+          + simpl. cut (a' && (b' && c') = a' && b' && c'). intro H. rewrite <- H. apply f_equal.
+            apply IHxs. apply andb_assoc.
+Qed.
+
+Lemma map2_and_idem1:  forall (a b: list bool), (map2 andb (map2 andb a b) a) = (map2 andb a b).
+Proof. intros a. induction a as [ | a' xs IHxs].
+       intros [ | b' ys].
+       - simpl. auto.
+       - simpl. auto.
+       - intros [ | b' ys].
+         + simpl. auto.
+         + intros. simpl. 
+           cut (a' && b' && a' = a' && b'). intro H. rewrite H. apply f_equal.
+           apply IHxs. rewrite andb_comm, andb_assoc, andb_diag. reflexivity. 
+Qed.
+
+Lemma map2_and_idem_comm:  forall (a b: list bool), (map2 andb (map2 andb a b) a) = (map2 andb b a).
+Proof. intros a b. symmetry. rewrite <- map2_and_comm. symmetry; apply map2_and_idem1. Qed.
+
+Lemma map2_and_idem2:  forall (a b: list bool), (map2 andb (map2 andb a b) b) = (map2 andb a b).
+Proof. intros a. induction a as [ | a' xs IHxs].
+       intros [ | b' ys].
+       - simpl. auto.
+       - simpl. auto.
+       - intros [ | b' ys].
+         + simpl. auto.
+         + intros. simpl. 
+           cut (a' && b' && b' = a' && b'). intro H. rewrite H. apply f_equal.
+           apply IHxs. rewrite <- andb_assoc. rewrite andb_diag. reflexivity. 
+Qed.
+
+Lemma map2_and_idem_comm2:  forall (a b: list bool), (map2 andb (map2 andb a b) b) = (map2 andb b a).
+Proof. intros a b. symmetry. rewrite <- map2_and_comm. symmetry; apply map2_and_idem2. Qed.
+
+Lemma map2_and_empty_empty1:  forall (a: list bool), (map2 andb a []) = [].
+Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed.
+
+Lemma map2_and_empty_empty2:  forall (a: list bool), (map2 andb [] a) = [].
+Proof. intros a. rewrite map2_and_comm. apply map2_and_empty_empty1. Qed.
+
+Lemma map2_nth_empty_false:  forall (i: nat), nth i [] false = false.
+Proof. intros i. induction i as [ | IHi]; simpl; reflexivity. Qed.
+
+Lemma mk_list_true_equiv: forall t acc, mk_list_true_acc t acc = (List.rev (mk_list_true t)) ++ acc.
+Proof. induction t as [ |t IHt]; auto; intro acc; simpl; rewrite IHt.
+       rewrite app_assoc_reverse.
+       apply f_equal. simpl. reflexivity.
+Qed.
+
+Lemma mk_list_false_equiv: forall t acc, mk_list_false_acc t acc = (List.rev (mk_list_false t)) ++ acc.
+Proof. induction t as [ |t IHt]; auto; intro acc; simpl; rewrite IHt. 
+       rewrite app_assoc_reverse.
+       apply f_equal. simpl. reflexivity.
+Qed.
+
+Lemma len_mk_list_true_empty: length (mk_list_true_acc 0 []) = 0%nat.
+Proof. simpl. reflexivity. Qed.
+
+Lemma add_mk_list_true: forall n acc, length (mk_list_true_acc n acc) = (n + length acc)%nat.
+Proof. intros n.
+       induction n as [ | n' IHn].
+         + auto.
+         + intro acc. simpl. rewrite IHn. simpl. lia.
+Qed.
+
+Lemma map2_and_nth_bitOf: forall (a b: list bool) (i: nat), 
+                          (length a) = (length b) ->
+                          (i <= (length a))%nat ->
+                          nth i (map2 andb a b) false = (nth i a false) && (nth i b false).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+         - intros [ | b ys].
+           + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity.
+           + intros i H0 H1. rewrite map2_and_empty_empty2.
+             rewrite map2_nth_empty_false. reflexivity.
+         - intros [ | b ys].
+           + intros i H0 H1. rewrite map2_and_empty_empty1.
+             rewrite map2_nth_empty_false. rewrite andb_false_r. reflexivity.
+           + intros i H0 H1. simpl.
+             revert i H1. intros [ | i]; [ |intros IHi].
+             * simpl. auto.
+             * apply IHxs.
+                 inversion H0; reflexivity.
+                 inversion IHi; lia.
+Qed.
+
+Lemma length_mk_list_true_full: forall n, length (mk_list_true_acc n []) = n.
+Proof. intro n. rewrite (@add_mk_list_true n []). auto. Qed.
+
+Lemma mk_list_app: forall n acc, mk_list_true_acc n acc = mk_list_true_acc n [] ++ acc.
+Proof. intro n.
+       induction n as [ | n IHn].
+         + auto.
+         + intro acc. simpl in *. rewrite IHn. 
+           cut (mk_list_true_acc n [] ++ [true] = mk_list_true_acc n [true]). intro H.
+           rewrite <- H. rewrite <- app_assoc. unfold app. reflexivity.
+           rewrite <- IHn. reflexivity.
+Qed.
+
+Lemma mk_list_ltrue: forall n, mk_list_true_acc n [true] = mk_list_true_acc (S n) [].
+Proof. intro n. induction n as [ | n IHn]; auto. Qed.
+
+Lemma map2_and_1_neutral: forall (a: list bool), (map2 andb a (mk_list_true (length a))) = a.
+Proof. intro a.
+       induction a as [ | a xs IHxs]. 
+         + auto.
+         + simpl. rewrite IHxs.
+           rewrite andb_true_r. reflexivity.
+Qed.
+
+Lemma map2_and_0_absorb: forall (a: list bool), (map2 andb a (mk_list_false (length a))) = (mk_list_false (length a)).
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - simpl. reflexivity.
+       - simpl. rewrite IHxs.
+         rewrite andb_false_r; reflexivity.
+Qed.
+
+Lemma map2_and_length: forall (a b: list bool), length a = length b -> length a = length (map2 andb a b).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b ys].
+       - simpl. intros. exact H.
+       - intros. simpl in *. apply f_equal. apply IHxs.
+         inversion H; auto.
+Qed.
+
+(*bitvector AND properties*)
+
+Lemma bv_and_size n a b : size a = n -> size b = n -> size (bv_and a b) = n.
+Proof.
+  unfold bv_and. intros H1 H2. rewrite H1, H2.
+  rewrite N.eqb_compare. rewrite N.compare_refl.
+  unfold size in *. rewrite <- map2_and_length.
+  - exact H1.
+  - unfold bits. now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_and_comm n a b : size a = n -> size b = n -> bv_and a b = bv_and b a.
+Proof.
+  intros H1 H2. unfold bv_and. rewrite H1, H2.
+  rewrite N.eqb_compare, N.compare_refl.
+  rewrite map2_and_comm. reflexivity.
+Qed.
+
+Lemma bv_and_assoc: forall n a b c, size a = n -> size b = n -> size c = n -> 
+                                  (bv_and a (bv_and b c)) = (bv_and (bv_and a b) c).
+Proof. intros n a b c H0 H1 H2.
+       unfold bv_and, size, bits in *. rewrite H1, H2.  
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite H0. rewrite N.compare_refl.
+       rewrite <- (@map2_and_length a b). rewrite <- map2_and_length. rewrite H0, H1.
+       rewrite N.compare_refl.
+       rewrite map2_and_assoc; reflexivity.
+       now rewrite <- Nat2N.inj_iff, H1.
+       now rewrite <- Nat2N.inj_iff, H0.
+Qed.
+
+Lemma bv_and_idem1:  forall a b n, size a = n -> size b = n -> (bv_and (bv_and a b) a) = (bv_and a b).
+Proof. intros a b n H0 H1.
+        unfold bv_and. rewrite H0. do 2 rewrite N.eqb_compare.
+       unfold size in *.
+       rewrite H1. rewrite N.compare_refl.
+       rewrite <- H0. unfold bits.
+       rewrite <- map2_and_length. rewrite N.compare_refl. 
+       rewrite map2_and_idem1; reflexivity.
+       now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_and_idem2: forall a b n, size a = n ->  size b = n -> (bv_and (bv_and a b) b) = (bv_and a b).
+Proof. intros a b n H0 H1.
+       unfold bv_and. rewrite H0. do 2 rewrite N.eqb_compare.
+       unfold size in *.
+       rewrite H1. rewrite N.compare_refl.
+       rewrite <- H0. unfold bits.
+       rewrite <- map2_and_length. rewrite N.compare_refl. 
+       rewrite map2_and_idem2; reflexivity.
+       now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Definition bv_empty: bitvector := nil.
+
+Lemma bv_and_empty_empty1: forall a, (bv_and a bv_empty) = bv_empty.
+Proof. intros a. unfold bv_empty, bv_and, size, bits. simpl.
+       rewrite map2_and_empty_empty1.
+       case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl.
+         - apply (N.compare_eq (N.of_nat (length a))) in H.
+           rewrite H. simpl. reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+Qed.
+
+Lemma bv_and_nth_bitOf: forall a b n (i: nat), 
+                          (size a) = n -> (size b) = n ->
+                          (i <= (nat_of_N (size a)))%nat ->
+                          nth i (bits (bv_and a b)) false = (nth i (bits a) false) && (nth i (bits b) false).
+Proof. intros a b n i H0 H1 H2. 
+       unfold bv_and. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       apply map2_and_nth_bitOf; unfold size in *; unfold bits.
+       now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2.
+Qed.
+
+Lemma bv_and_empty_empty2: forall a, (bv_and bv_empty a) = bv_empty.
+Proof. intro a. unfold bv_and, bv_empty, size.
+       case (length a); simpl; auto.
+Qed.
+
+Lemma bv_and_1_neutral: forall a, (bv_and a (mk_list_true (length (bits a)))) = a.
+Proof. intro a. unfold bv_and.
+       rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_true.
+       rewrite N.compare_refl.
+       rewrite map2_and_1_neutral. reflexivity.
+Qed.
+
+Lemma bv_and_0_absorb: forall a, (bv_and a (mk_list_false (length (bits a)))) = (mk_list_false (length (bits a))).
+Proof. intro a. unfold bv_and.
+       rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false. 
+       rewrite N.compare_refl.
+       rewrite map2_and_0_absorb. reflexivity.
+Qed.
+
+(* lists bitwise OR properties *)
+
+Lemma map2_or_comm: forall (a b: list bool), (map2 orb a b) = (map2 orb b a).
+Proof. intros a. induction a as [ | a' xs IHxs].
+       intros [ | b' ys].
+       - simpl. auto.
+       - simpl. auto.
+       - intros [ | b' ys].
+         + simpl. auto.
+         + intros. simpl. 
+           cut (a' || b' = b' || a'). intro H. rewrite <- H. apply f_equal.
+           apply IHxs. apply orb_comm.
+Qed.
+
+Lemma map2_or_assoc: forall (a b c: list bool), (map2 orb a (map2 orb b c)) = (map2 orb (map2 orb a b) c).
+Proof. intro a. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b' ys].
+        -  simpl. auto.
+        - intros [ | c' zs].
+          + simpl. auto.
+          + simpl. cut (a' || (b' || c') = a' || b' || c'). intro H. rewrite <- H. apply f_equal.
+            apply IHxs. apply orb_assoc.
+Qed.
+
+Lemma map2_or_length: forall (a b: list bool), length a = length b -> length a = length (map2 orb a b).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b ys].
+       - simpl. intros. exact H.
+       - intros. simpl in *. apply f_equal. apply IHxs.
+         inversion H; auto.
+Qed.
+
+Lemma map2_or_empty_empty1:  forall (a: list bool), (map2 orb a []) = [].
+Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed.
+
+Lemma map2_or_empty_empty2:  forall (a: list bool), (map2 orb [] a) = [].
+Proof. intros a. rewrite map2_or_comm. apply map2_or_empty_empty1. Qed.
+
+Lemma map2_or_nth_bitOf: forall (a b: list bool) (i: nat), 
+                          (length a) = (length b) ->
+                          (i <= (length a))%nat ->
+                          nth i (map2 orb a b) false = (nth i a false) || (nth i b false).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+         - intros [ | b ys].
+           + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity.
+           + intros i H0 H1. rewrite map2_or_empty_empty2.
+             rewrite map2_nth_empty_false. contradict H1. simpl. unfold not. intros. easy.
+         - intros [ | b ys].
+           + intros i H0 H1. rewrite map2_or_empty_empty1.
+             rewrite map2_nth_empty_false. rewrite orb_false_r. rewrite H0 in H1.
+             contradict H1. simpl. unfold not. intros. easy.
+           + intros i H0 H1. simpl.
+             revert i H1. intros [ | i]; [ |intros IHi].
+             * simpl. auto.
+             * apply IHxs.
+                 inversion H0; reflexivity.
+                 inversion IHi; lia.
+Qed.
+
+Lemma map2_or_0_neutral: forall (a: list bool), (map2 orb a (mk_list_false (length a))) = a.
+Proof. intro a.
+       induction a as [ | a xs IHxs]. 
+         + auto.
+         + simpl. rewrite IHxs.
+           rewrite orb_false_r. reflexivity.
+Qed.
+
+Lemma map2_or_1_true: forall (a: list bool), (map2 orb a (mk_list_true (length a))) = (mk_list_true (length a)).
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - simpl. reflexivity.
+       - simpl. rewrite IHxs.
+         rewrite orb_true_r; reflexivity.
+Qed.
+
+(*bitvector OR properties*)
+
+Lemma bv_or_size n a b : size a = n -> size b = n -> size (bv_or a b) = n.
+Proof.
+  unfold bv_or. intros H1 H2. rewrite H1, H2.
+  rewrite N.eqb_compare. rewrite N.compare_refl.
+  unfold size in *. rewrite <- map2_or_length.
+  - exact H1.
+  - unfold bits. now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_or_comm: forall n a b, (size a) = n -> (size b) = n -> bv_or a b = bv_or b a.
+Proof. intros a b n H0 H1. unfold bv_or.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite map2_or_comm. reflexivity.
+Qed.
+
+Lemma bv_or_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n ->  
+                                  (bv_or a (bv_or b c)) = (bv_or (bv_or a b) c).
+Proof. intros n a b c H0 H1 H2. 
+       unfold bv_or. rewrite H1, H2.  
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold size, bits in *. rewrite <- (@map2_or_length b c).
+       rewrite H0, H1.
+       rewrite N.compare_refl.
+       rewrite N.eqb_compare. rewrite N.eqb_compare.
+       rewrite N.compare_refl. rewrite <- (@map2_or_length a b).
+       rewrite H0. rewrite N.compare_refl.
+       rewrite map2_or_assoc; reflexivity.
+       now rewrite <- Nat2N.inj_iff, H0.
+       now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_or_empty_empty1: forall a, (bv_or a bv_empty) = bv_empty.
+Proof. intros a. unfold bv_empty. 
+       unfold bv_or, bits, size. simpl.
+       case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl.
+         - apply (N.compare_eq (N.of_nat (length a)) 0) in H.
+           rewrite H. simpl. rewrite map2_or_empty_empty1; reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+Qed.
+
+Lemma bv_or_nth_bitOf: forall a b n (i: nat), 
+                          (size a) = n -> (size b) = n ->
+                          (i <= (nat_of_N (size a)))%nat ->
+                          nth i (bits (bv_or a b)) false = (nth i (bits a) false) || (nth i (bits b) false).
+Proof. intros a b n i H0 H1 H2. 
+       unfold bv_or. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       apply map2_or_nth_bitOf; unfold size in *; unfold bits.
+       now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2.
+Qed.
+
+Lemma bv_or_0_neutral: forall a, (bv_or a (mk_list_false (length (bits a)))) = a.
+Proof. intro a. unfold bv_or.
+       rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false.
+       rewrite N.compare_refl.
+       rewrite map2_or_0_neutral. reflexivity.
+Qed.
+
+Lemma bv_or_1_true: forall a, (bv_or a (mk_list_true (length (bits a)))) = (mk_list_true (length (bits a))).
+Proof. intro a. unfold bv_or.
+       rewrite N.eqb_compare.  unfold size, bits. rewrite length_mk_list_true.
+       rewrite N.compare_refl.
+       rewrite map2_or_1_true. reflexivity.
+Qed.
+
+(* lists bitwise XOR properties *)
+
+Lemma map2_xor_comm: forall (a b: list bool), (map2 xorb a b) = (map2 xorb b a).
+Proof. intros a. induction a as [ | a' xs IHxs].
+       intros [ | b' ys].
+       - simpl. auto.
+       - simpl. auto.
+       - intros [ | b' ys].
+         + simpl. auto.
+         + intros. simpl. 
+           cut (xorb a' b' = xorb b' a'). intro H. rewrite <- H. apply f_equal.
+           apply IHxs. apply xorb_comm.
+Qed.
+
+Lemma map2_xor_assoc: forall (a b c: list bool), (map2 xorb a (map2 xorb b c)) = (map2 xorb (map2 xorb a b) c).
+Proof. intro a. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b' ys].
+        -  simpl. auto.
+        - intros [ | c' zs].
+          + simpl. auto.
+          + simpl. cut (xorb a' (xorb b' c') = (xorb (xorb a'  b')  c')). intro H. rewrite <- H. apply f_equal.
+            apply IHxs. rewrite xorb_assoc_reverse. reflexivity.
+Qed.
+
+Lemma map2_xor_length: forall (a b: list bool), length a = length b -> length a = length (map2 xorb a b).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b ys].
+       - simpl. intros. exact H.
+       - intros. simpl in *. apply f_equal. apply IHxs.
+         inversion H; auto.
+Qed.
+
+Lemma map2_xor_empty_empty1:  forall (a: list bool), (map2 xorb a []) = [].
+Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed.
+
+Lemma map2_xor_empty_empty2:  forall (a: list bool), (map2 xorb [] a) = [].
+Proof. intros a. rewrite map2_xor_comm. apply map2_xor_empty_empty1. Qed.
+
+Lemma map2_xor_nth_bitOf: forall (a b: list bool) (i: nat), 
+                          (length a) = (length b) ->
+                          (i <= (length a))%nat ->
+                          nth i (map2 xorb a b) false = xorb (nth i a false) (nth i b false).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+         - intros [ | b ys].
+           + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity.
+           + intros i H0 H1. rewrite map2_xor_empty_empty2.
+             rewrite map2_nth_empty_false. contradict H1. simpl. unfold not. intros. easy.
+         - intros [ | b ys].
+           + intros i H0 H1. rewrite map2_xor_empty_empty1.
+             rewrite map2_nth_empty_false. rewrite xorb_false_r. rewrite H0 in H1.
+             contradict H1. simpl. unfold not. intros. easy.
+           + intros i H0 H1. simpl.
+             revert i H1. intros [ | i]; [ |intros IHi].
+             * simpl. auto.
+             * apply IHxs.
+                 inversion H0; reflexivity.
+                 inversion IHi; lia.
+Qed.
+
+Lemma map2_xor_0_neutral: forall (a: list bool), (map2 xorb a (mk_list_false (length a))) = a.
+Proof. intro a.
+       induction a as [ | a xs IHxs]. 
+         + auto.
+         + simpl. rewrite IHxs.
+           rewrite xorb_false_r. reflexivity.
+Qed.
+
+Lemma map2_xor_1_true: forall (a: list bool), (map2 xorb a (mk_list_true (length a))) = map negb a.
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - simpl. reflexivity.
+       - simpl. rewrite IHxs. rewrite <- IHxs.
+         rewrite xorb_true_r; reflexivity.
+Qed.
+
+(*bitvector OR properties*)
+
+Lemma bv_xor_size n a b : size a = n -> size b = n -> size (bv_xor a b) = n.
+Proof.
+  unfold bv_xor. intros H1 H2. rewrite H1, H2.
+  rewrite N.eqb_compare. rewrite N.compare_refl.
+  unfold size in *. rewrite <- map2_xor_length.
+  - exact H1.
+  - unfold bits. now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_xor_comm: forall n a b, (size a) = n -> (size b) = n -> bv_xor a b = bv_xor b a.
+Proof. intros n a b H0 H1. unfold bv_xor.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite map2_xor_comm. reflexivity.
+Qed.
+
+Lemma bv_xor_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n ->  
+                                  (bv_xor a (bv_xor b c)) = (bv_xor (bv_xor a b) c).
+Proof. intros n a b c H0 H1 H2. 
+       unfold bv_xor. rewrite H1, H2.  
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold size, bits in *. rewrite <- (@map2_xor_length b c).
+       rewrite H0, H1.
+       rewrite N.compare_refl.
+       rewrite N.eqb_compare. rewrite N.eqb_compare.
+       rewrite N.compare_refl. rewrite <- (@map2_xor_length a b).
+       rewrite H0. rewrite N.compare_refl.
+       rewrite map2_xor_assoc; reflexivity.
+       now rewrite <- Nat2N.inj_iff, H0.
+       now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_xor_empty_empty1: forall a, (bv_xor a bv_empty) = bv_empty.
+Proof. intros a. unfold bv_empty. 
+       unfold bv_xor, bits, size. simpl.
+       case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl.
+         - apply (N.compare_eq (N.of_nat (length a)) 0) in H.
+           rewrite H. simpl. rewrite map2_xor_empty_empty1; reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+         - rewrite N.eqb_compare. rewrite H; reflexivity.
+Qed.
+
+Lemma bv_xor_nth_bitOf: forall a b n (i: nat), 
+                          (size a) = n -> (size b) = n ->
+                          (i <= (nat_of_N (size a)))%nat ->
+                          nth i (bits (bv_xor a b)) false = xorb (nth i (bits a) false) (nth i (bits b) false).
+Proof. intros a b n i H0 H1 H2. 
+       unfold bv_xor. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       apply map2_xor_nth_bitOf; unfold size in *; unfold bits.
+       now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2.
+Qed.
+
+Lemma bv_xor_0_neutral: forall a, (bv_xor a (mk_list_false (length (bits a)))) = a.
+Proof. intro a. unfold bv_xor.
+       rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false.
+       rewrite N.compare_refl.
+       rewrite map2_xor_0_neutral. reflexivity.
+Qed.
+
+Lemma bv_xor_1_true: forall a, (bv_xor a (mk_list_true (length (bits a)))) = map negb a.
+Proof. intro a. unfold bv_xor.
+       rewrite N.eqb_compare.  unfold size, bits. rewrite length_mk_list_true.
+       rewrite N.compare_refl.
+       rewrite map2_xor_1_true. reflexivity.
+Qed.
+
+(*bitwise NOT properties*)
+
+Lemma not_list_length: forall a, length a = length (map negb a).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - auto. 
+       - simpl. apply f_equal. exact IHxs.
+Qed.
+
+Lemma not_list_involutative: forall a, map negb (map negb a) = a.
+Proof. intro a.
+       induction a as [ | a xs IHxs]; auto.
+       simpl. rewrite negb_involutive. apply f_equal. exact IHxs.
+Qed.
+
+Lemma not_list_false_true: forall n, map negb (mk_list_false n) = mk_list_true n.
+Proof. intro n.
+       induction n as [ | n IHn].
+       - auto.
+       - simpl. apply f_equal. exact IHn.
+Qed.
+
+Lemma not_list_true_false: forall n, map negb (mk_list_true n) = mk_list_false n.
+Proof. intro n.
+       induction n as [ | n IHn].
+       - auto.
+       - simpl. apply f_equal. exact IHn.
+Qed.
+
+Lemma not_list_and_or: forall a b, map negb (map2 andb a b) = map2 orb (map negb a) (map negb b).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - auto.
+       - intros [ | b ys].
+         + auto.
+         + simpl. rewrite negb_andb. apply f_equal. apply IHxs.
+Qed.
+
+Lemma not_list_or_and: forall a b, map negb (map2 orb a b) = map2 andb (map negb a) (map negb b).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - auto.
+       - intros [ | b ys].
+         + auto.
+         + simpl. rewrite negb_orb. apply f_equal. apply IHxs.
+Qed.
+
+(*bitvector NOT properties*)
+
+Lemma bv_not_size: forall n a, (size a) = n -> size (bv_not a) = n.
+Proof. intros n a H. unfold bv_not.
+       unfold size, bits in *. rewrite <- not_list_length. exact H.
+Qed.
+
+Lemma bv_not_involutive: forall a, bv_not (bv_not a) = a.
+Proof. intro a. unfold bv_not.
+       unfold size, bits. rewrite not_list_involutative. reflexivity.
+Qed.
+
+Lemma bv_not_false_true: forall n, bv_not (mk_list_false n) = (mk_list_true n).
+Proof. intros n. unfold bv_not.
+       unfold size, bits. rewrite not_list_false_true. reflexivity.
+Qed.
+
+Lemma bv_not_true_false: forall n, bv_not (mk_list_true n) = (mk_list_false n).
+Proof. intros n. unfold bv_not.
+       unfold size, bits. rewrite not_list_true_false. reflexivity.
+Qed.
+
+Lemma bv_not_and_or: forall n a b, (size a) = n -> (size b) = n -> bv_not (bv_and a b) = bv_or (bv_not a) (bv_not b).
+Proof. intros n a b H0 H1. unfold bv_and in *.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold bv_or, size, bits in *.
+       do 2 rewrite <- not_list_length. rewrite H0, H1.
+       rewrite N.eqb_compare. rewrite N.compare_refl. 
+       unfold bv_not, size, bits in *. 
+       rewrite not_list_and_or. reflexivity.
+Qed.
+
+Lemma bv_not_or_and: forall n a b, (size a) = n -> (size b) = n -> bv_not (bv_or a b) = bv_and (bv_not a) (bv_not b).
+Proof. intros n a b H0 H1. unfold bv_and, size, bits in *. 
+       do 2 rewrite <- not_list_length.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold bv_or, size, bits in *.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. 
+       unfold bv_not, size, bits in *.
+       rewrite not_list_or_and. reflexivity.
+Qed.
+
+(* list bitwise ADD properties*)
+
+Lemma add_carry_ff: forall a, add_carry a false false = (a, false).
+Proof. intros a.
+       case a; simpl; auto.
+Qed.
+
+Lemma add_carry_neg_f: forall a, add_carry a (negb a) false = (true, false).
+Proof. intros a.
+       case a; simpl; auto.
+Qed.
+
+Lemma add_carry_neg_f_r: forall a, add_carry (negb a) a false = (true, false).
+Proof. intros a.
+       case a; simpl; auto.
+Qed.
+
+Lemma add_carry_neg_t: forall a, add_carry a (negb a) true = (false, true).
+Proof. intros a.
+       case a; simpl; auto.
+Qed.
+
+Lemma add_carry_tt: forall a, add_carry a true true = (a, true).
+Proof. intro a. case a; auto. Qed.
+
+Lemma add_list_empty_l: forall (a: list bool), (add_list [] a) = [].
+Proof. intro a. induction a as [ | a xs IHxs].
+         - unfold add_list. simpl. reflexivity.
+         - apply IHxs.
+Qed.
+
+Lemma add_list_empty_r: forall (a: list bool), (add_list a []) = [].
+Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed.
+
+Lemma add_list_ingr_l: forall (a: list bool) (c: bool), (add_list_ingr [] a c) = [].
+Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed.
+
+Lemma add_list_ingr_r: forall (a: list bool) (c: bool), (add_list_ingr a [] c) = [].
+Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed.
+
+Lemma add_list_carry_comm: forall (a b:  list bool) (c: bool), add_list_ingr a b c = add_list_ingr b a c.
+Proof. intros a. induction a as [ | a' xs IHxs]; intros b c.
+       - simpl. rewrite add_list_ingr_r. reflexivity.
+       - case b as [ | b' ys].
+         + simpl. auto.
+         + simpl in *. cut (add_carry a' b' c = add_carry b' a' c).
+           * intro H. rewrite H. destruct (add_carry b' a' c) as (r, c0).
+             rewrite IHxs. reflexivity.
+           * case a', b', c;  auto.
+Qed.
+
+Lemma add_list_comm: forall (a b: list bool), (add_list a b) = (add_list b a).
+Proof. intros a b. unfold add_list. apply (add_list_carry_comm a b false). Qed.
+
+Lemma add_list_carry_assoc: forall (a b c:  list bool) (d1 d2 d3 d4: bool),
+                            add_carry d1 d2 false = add_carry d3 d4 false ->
+                            (add_list_ingr (add_list_ingr a b d1) c d2) = (add_list_ingr a (add_list_ingr b c d3) d4).
+Proof. intros a. induction a as [ | a' xs IHxs]; intros b c d1 d2 d3 d4.
+       - simpl. reflexivity.
+       - case b as [ | b' ys].
+         + simpl. auto.
+         + case c as [ | c' zs].
+           * simpl. rewrite add_list_ingr_r. auto.
+           * simpl.
+             case_eq (add_carry a' b' d1); intros r0 c0 Heq0. simpl.
+             case_eq (add_carry r0 c' d2); intros r1 c1 Heq1.
+             case_eq (add_carry b' c' d3); intros r3 c3 Heq3.
+             case_eq (add_carry a' r3 d4); intros r2 c2 Heq2.
+             intro H. rewrite (IHxs _ _ c0 c1 c3 c2);
+               revert Heq0 Heq1 Heq3 Heq2;
+               case a', b', c', d1, d2, d3, d4; simpl; do 4 (intros H'; inversion_clear H'); 
+                 try reflexivity; simpl in H; discriminate.
+Qed.
+
+Lemma add_list_carry_length_eq: forall (a b: list bool) c, length a = length b -> length a = length (add_list_ingr a b c).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. auto.
+       intros [ | b ys].
+       - simpl. intros. exact H.
+       - intros. simpl in *.
+         case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal.
+         specialize (@IHxs ys). apply IHxs. inversion H; reflexivity.
+Qed.
+
+Lemma add_list_carry_length_ge: forall (a b: list bool) c, (length a >= length b)%nat -> length b = length (add_list_ingr a b c).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. intros b H0 H1. lia.
+       intros [ | b ys].
+       - simpl. intros. auto.
+       - intros. simpl in *.
+         case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal.
+         specialize (@IHxs ys). apply IHxs. lia.
+Qed.
+
+Lemma add_list_carry_length_le: forall (a b: list bool) c, (length b >= length a)%nat -> length a = length (add_list_ingr a b c).
+Proof. induction a as [ | a' xs IHxs].
+       simpl. intros b H0 H1. reflexivity.
+       intros [ | b ys].
+       - simpl. intros. contradict H. lia.
+       - intros. simpl in *.
+         case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal.
+         specialize (@IHxs ys). apply IHxs. lia.
+Qed.
+
+Lemma bv_neg_size: forall n a, (size a) = n -> size (bv_neg a) = n.
+Proof. intros n a H. unfold bv_neg.
+       unfold size, bits in *. unfold twos_complement.
+       specialize (@add_list_carry_length_eq  (map negb a) (mk_list_false (length a)) true).
+       intros. rewrite <- H0. now rewrite map_length.
+       rewrite map_length.
+       now rewrite length_mk_list_false.
+Qed.
+
+Lemma length_add_list_eq: forall (a b: list bool), length a = length b -> length a = length (add_list a b).
+Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_eq a b false). exact H. Qed.
+
+Lemma length_add_list_ge: forall (a b: list bool), (length a >= length b)%nat -> length b = length (add_list a b).
+Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_ge a b false). exact H. Qed.
+
+Lemma length_add_list_le: forall (a b: list bool), (length b >= length a)%nat -> length a = length (add_list a b).
+Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_le a b false). exact H. Qed.
+
+Lemma add_list_assoc: forall (a b c: list bool), (add_list (add_list a b) c) = (add_list a (add_list b c)).
+Proof. intros a b c. unfold add_list.
+       apply (@add_list_carry_assoc a b c false false false false).
+       simpl; reflexivity.
+Qed.
+
+Lemma add_list_carry_empty_neutral_n_l: forall (a: list bool) n, (n >= (length a))%nat -> (add_list_ingr (mk_list_false n) a false) = a.
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - intro n. rewrite add_list_ingr_r. reflexivity.
+       - intros [ | n]. 
+         + simpl. intro H. contradict H. easy.
+         + simpl. intro H.
+           case a'; apply f_equal; apply IHxs; lia.
+Qed.
+
+Lemma add_list_carry_empty_neutral_n_r: forall (a: list bool) n, (n >= (length a))%nat -> (add_list_ingr a (mk_list_false n) false) = a.
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - intro n. rewrite add_list_ingr_l. reflexivity.
+       - intros [ | n]. 
+         + simpl. intro H. contradict H. easy.
+         + simpl. intro H.
+           case a'; apply f_equal; apply IHxs; lia.
+Qed.
+
+Lemma add_list_carry_empty_neutral_l: forall (a: list bool), (add_list_ingr (mk_list_false (length a)) a false) = a.
+Proof. intro a.
+       rewrite add_list_carry_empty_neutral_n_l; auto.
+Qed.
+
+Lemma add_list_carry_empty_neutral_r: forall (a: list bool), (add_list_ingr a (mk_list_false (length a)) false) = a.
+Proof. intro a.
+       rewrite add_list_carry_empty_neutral_n_r; auto.
+Qed.
+
+Lemma add_list_empty_neutral_n_l: forall (a: list bool) n, (n >= (length a))%nat -> (add_list (mk_list_false n) a) = a.
+Proof. intros a. unfold add_list.
+       apply (@add_list_carry_empty_neutral_n_l a).
+Qed.
+
+Lemma add_list_empty_neutral_n_r: forall (a: list bool) n, (n >= (length a))%nat -> (add_list a (mk_list_false n)) = a.
+Proof. intros a. unfold add_list.
+       apply (@add_list_carry_empty_neutral_n_r a).
+Qed.
+
+Lemma add_list_empty_neutral_r: forall (a: list bool), (add_list a (mk_list_false (length a))) = a.
+Proof. intros a. unfold add_list.
+       apply (@add_list_carry_empty_neutral_r a).
+Qed.
+
+Lemma add_list_empty_neutral_l: forall (a: list bool), (add_list (mk_list_false (length a)) a) = a.
+Proof. intros a. unfold add_list.
+       apply (@add_list_carry_empty_neutral_l a).
+Qed.
+
+Lemma add_list_carry_unit_t : forall a, add_list_ingr a (mk_list_true (length a)) true = a.
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. reflexivity.
+       - simpl. case_eq (add_carry a true true). intros r0 c0 Heq0.
+         rewrite add_carry_tt in Heq0. inversion Heq0.
+         apply f_equal. exact IHxs.
+Qed.
+
+Lemma add_list_carry_twice: forall a c, add_list_ingr a a c = removelast (c :: a).
+Proof. intro a. 
+       induction a as [ | a xs IHxs].
+       - intros c. simpl. reflexivity.
+       - intros [ | ].
+         + simpl. case a.
+           * simpl. rewrite IHxs.
+             case_eq xs. intro Heq0. simpl. reflexivity.
+             reflexivity.
+           * simpl. rewrite IHxs.
+             case_eq xs. intro Heq0. simpl. reflexivity.
+             reflexivity.
+         + simpl. case a.
+           * simpl. rewrite IHxs.
+             case_eq xs. intro Heq0. simpl. reflexivity.
+             reflexivity.
+           * simpl. rewrite IHxs.
+             case_eq xs. intro Heq0. simpl. reflexivity.
+             reflexivity.
+Qed.
+
+Lemma add_list_twice: forall a, add_list a a = removelast (false :: a).
+Proof. intro a. 
+       unfold add_list. rewrite add_list_carry_twice. reflexivity.
+Qed.
+
+(*bitvector ADD properties*)
+
+Lemma bv_add_size: forall n a b, (size a) = n -> (@size b) = n -> size (bv_add a b) = n.
+Proof. intros n a b H0 H1.
+       unfold bv_add. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold size, bits in *. rewrite <- (@length_add_list_eq a b). auto.
+       now rewrite <- Nat2N.inj_iff, H0.
+Qed.
+
+Lemma bv_add_comm: forall n a b, (size a) = n -> (size b) = n -> bv_add a b = bv_add b a.
+Proof. intros n a b H0 H1.
+       unfold bv_add, size, bits in *. rewrite H0, H1.
+       rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite add_list_comm. reflexivity.
+Qed.
+
+Lemma bv_add_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n ->  
+                                  (bv_add a (bv_add b c)) = (bv_add (bv_add a b) c).
+Proof. intros n a b c H0 H1 H2.
+       unfold bv_add, size, bits in *. rewrite H1, H2.
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite <- (@length_add_list_eq b c). rewrite H0, H1.
+       rewrite N.compare_refl. rewrite N.eqb_compare.
+       rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite <- (@length_add_list_eq a b). rewrite H0.
+       rewrite N.compare_refl.
+       rewrite add_list_assoc. reflexivity.
+       now rewrite <- Nat2N.inj_iff, H0.
+       now rewrite <- Nat2N.inj_iff, H1.
+Qed.
+
+Lemma bv_add_empty_neutral_l: forall a, (bv_add (mk_list_false (length (bits a))) a) = a.
+Proof. intro a. unfold bv_add, size, bits. 
+       rewrite N.eqb_compare. rewrite length_mk_list_false. rewrite N.compare_refl.
+       rewrite add_list_empty_neutral_l. reflexivity.
+Qed.
+
+Lemma bv_add_empty_neutral_r: forall a, (bv_add a (mk_list_false (length (bits a)))) = a.
+Proof. intro a. unfold bv_add, size, bits.
+       rewrite N.eqb_compare. rewrite length_mk_list_false. rewrite N.compare_refl.
+       rewrite add_list_empty_neutral_r. reflexivity.
+Qed.
+
+Lemma bv_add_twice: forall a, bv_add a a = removelast (false :: a).
+Proof. intro a. unfold bv_add, size, bits.
+       rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite add_list_twice. reflexivity.
+Qed.
+
+(* bitwise SUBST properties *)
+
+Lemma subst_list_empty_empty_l: forall a, (subst_list [] a) = [].
+Proof. intro a. unfold subst_list; auto. Qed.
+
+Lemma subst_list_empty_empty_r: forall a, (subst_list a []) = [].
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - auto.
+       - unfold subst_list; auto. 
+Qed.
+
+Lemma subst_list'_empty_empty_r: forall a, (subst_list' a []) = [].
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - auto.
+       - unfold subst_list' in *. unfold twos_complement. simpl. reflexivity.
+Qed.
+
+Lemma subst_list_borrow_length: forall (a b: list bool) c, length a = length b -> length a = length (subst_list_borrow a b c). 
+Proof. induction a as [ | a' xs IHxs]. 
+       simpl. auto. 
+       intros [ | b ys].
+       - simpl. intros. exact H. 
+       - intros. simpl in *. 
+         case_eq (subst_borrow a' b c); intros r c0 Heq. simpl. apply f_equal. 
+         specialize (@IHxs ys). apply IHxs. inversion H; reflexivity. 
+Qed.
+
+Lemma length_twos_complement: forall (a: list bool), length a = length (twos_complement a).
+Proof. intro a.
+      induction a as [ | a' xs IHxs].
+      - auto.
+      - unfold twos_complement. specialize (@add_list_carry_length_eq (map negb (a' :: xs)) (mk_list_false (length (a' :: xs))) true).        
+        intro H. rewrite <- H. simpl. apply f_equal. rewrite <- not_list_length. reflexivity.
+        rewrite length_mk_list_false. rewrite <- not_list_length. reflexivity.
+Qed.
+
+Lemma subst_list_length: forall (a b: list bool), length a = length b -> length a = length (subst_list a b). 
+Proof. intros a b H. unfold subst_list. apply (@subst_list_borrow_length a b false). exact H. Qed.
+
+Lemma subst_list'_length: forall (a b: list bool), length a = length b -> length a = length (subst_list' a b).
+Proof. intros a b H. unfold subst_list'.
+       rewrite <- (@length_add_list_eq a (twos_complement b)).
+       - reflexivity.
+       - rewrite <- (@length_twos_complement b). exact H.
+Qed.
+
+Lemma subst_list_borrow_empty_neutral: forall (a: list bool), (subst_list_borrow a (mk_list_false (length a)) false) = a.
+Proof. intro a. induction a as [ | a' xs IHxs].
+       - simpl. reflexivity.
+       - simpl.
+         cut(subst_borrow a' false false = (a', false)).
+         + intro H. rewrite H. rewrite IHxs. reflexivity.
+         + unfold subst_borrow. case a'; auto.
+Qed.
+
+Lemma subst_list_empty_neutral: forall (a: list bool), (subst_list a (mk_list_false (length a))) = a.
+Proof. intros a. unfold subst_list.
+       apply (@subst_list_borrow_empty_neutral a).
+Qed.
+
+Lemma twos_complement_cons_false: forall a, false :: twos_complement a = twos_complement (false :: a).
+Proof. intro a.
+       induction a as [ | a xs IHxs]; unfold twos_complement; simpl; reflexivity.
+Qed.
+
+Lemma twos_complement_false_false: forall n, twos_complement (mk_list_false n) = mk_list_false n.
+Proof. intro n.
+       induction n as [ | n IHn].
+       - auto.
+       - simpl. rewrite <- twos_complement_cons_false.
+         apply f_equal. exact IHn.
+Qed.
+
+Lemma subst_list'_empty_neutral: forall (a: list bool), (subst_list' a (mk_list_false (length a))) = a.
+Proof. intros a. unfold subst_list'.
+       rewrite (@twos_complement_false_false (length a)).
+       rewrite add_list_empty_neutral_r. reflexivity.
+Qed.
+
+(* some list ult and slt properties *)
+
+Lemma ult_list_big_endian_trans : forall x y z,
+    ult_list_big_endian x y = true ->
+    ult_list_big_endian y z = true ->
+    ult_list_big_endian x z = true.
+Proof.
+  intros x. induction x.
+  simpl. easy.
+  intros y z.
+  case y.
+  simpl. case x; easy.
+  intros b l.
+  intros.
+  simpl in *. case x in *.
+  case z in *. simpl in H0. case l in *; easy.
+  case l in *.
+  rewrite andb_true_iff in H.
+  destruct H.
+  apply negb_true_iff in H. subst.
+  simpl. case z in *. easy.
+  rewrite !orb_true_iff, !andb_true_iff in H0.
+  destruct H0.
+  destruct H.
+  apply Bool.eqb_prop in H.
+  subst.
+  rewrite orb_true_iff. now right.
+  destruct H. easy.
+  rewrite !orb_true_iff, !andb_true_iff in H, H0.
+  destruct H.
+  simpl in H. easy.
+  destruct H.
+  apply negb_true_iff in H. subst.
+  simpl.
+  destruct H0.
+  destruct H.
+  apply Bool.eqb_prop in H.
+  subst.
+  case z; easy.
+  destruct H. easy.
+  case l in *.
+  rewrite !orb_true_iff, !andb_true_iff in H.
+  simpl in H. destruct H. destruct H. case x in H1; easy.
+  destruct H.
+  apply negb_true_iff in H. subst.
+  simpl in H0.
+  case z in *; try easy.
+  case z in *; simpl in H0; try easy.
+  case b in H0; simpl in H0; try easy.
+  case z in *; try easy.
+  rewrite !orb_true_iff, !andb_true_iff in *.
+  destruct H.
+  destruct H.
+  destruct H0.
+  destruct H0.
+  apply Bool.eqb_prop in H.
+  apply Bool.eqb_prop in H0.
+  subst.
+  left.
+  split.
+  apply Bool.eqb_reflx.
+  now apply (IHx (b1 :: l) z H1 H2).
+  right. apply Bool.eqb_prop in H. now subst.
+  right. destruct H0, H0.
+  apply Bool.eqb_prop in H0. now subst.
+  split; easy.
+Qed.  
+  
+
+Lemma ult_list_trans : forall x y z,
+    ult_list x y = true -> ult_list y z = true -> ult_list x z = true.
+Proof. unfold ult_list. intros x y z. apply ult_list_big_endian_trans.
+Qed.
+
+Lemma ult_list_big_endian_not_eq : forall x y,
+    ult_list_big_endian x y = true -> x <> y.
+Proof.
+  intros x. induction x.
+  simpl. easy.
+  intros y.
+  case y.
+  simpl. case x; easy.
+  intros b l.
+  simpl.
+  specialize (IHx l).
+  case x in *.
+  simpl.
+  case l in *. case a; case b; simpl; easy.
+  easy.
+  rewrite !orb_true_iff, !andb_true_iff.
+  intro.
+  destruct H.
+  destruct H.
+  apply IHx in H0.
+  apply Bool.eqb_prop in H.
+  rewrite H in *.
+  unfold not in *; intro.
+  inversion H1; subst. now apply H0.
+  destruct H.
+  apply negb_true_iff in H. subst. easy.
+Qed.  
+
+Lemma ult_list_not_eq : forall x y, ult_list x y = true -> x <> y.
+Proof. unfold ult_list.
+  unfold not. intros.
+  apply ult_list_big_endian_not_eq in H.
+  subst. auto.
+Qed.
+
+Lemma slt_list_big_endian_not_eq : forall x y,
+    slt_list_big_endian x y = true -> x <> y.
+Proof.
+  intros x. induction x.
+  simpl. easy.
+  intros y.
+  case y.
+  simpl. case x; easy.
+  intros b l.
+  simpl.
+  specialize (IHx l).
+  case x in *.
+  simpl.
+  case l in *. case a; case b; simpl; easy.
+  easy.
+  rewrite !orb_true_iff, !andb_true_iff.
+  intro.
+  destruct H.
+  destruct H.
+  apply ult_list_big_endian_not_eq in H0.
+  apply Bool.eqb_prop in H. rewrite H in *.
+  unfold not in *. intros. apply H0. now inversion H1.
+  destruct H.
+  apply negb_true_iff in H0. subst. easy.
+Qed.  
+
+Lemma slt_list_not_eq : forall x y, slt_list x y = true -> x <> y.
+Proof. unfold slt_list.
+  unfold not. intros.
+  apply slt_list_big_endian_not_eq in H.
+  subst. auto.
+Qed.
+
+
+Lemma ult_list_not_eqP : forall x y, ult_listP x y -> x <> y.
+Proof. unfold ult_listP.
+  unfold not. intros. unfold ult_list in H.
+  case_eq (ult_list_big_endian (List.rev x) (List.rev y)); intros.
+  apply ult_list_big_endian_not_eq in H1. subst. now contradict H1.
+  now rewrite H1 in H.
+Qed.
+
+Lemma slt_list_not_eqP : forall x y, slt_listP x y -> x <> y.
+Proof. unfold slt_listP.
+  unfold not. intros. unfold slt_list in H.
+  case_eq (slt_list_big_endian (List.rev x) (List.rev y)); intros.
+  apply slt_list_big_endian_not_eq in H1. subst. now contradict H1.
+  now rewrite H1 in H.
+Qed.
+
+Lemma bv_ult_B2P: forall x y, bv_ult x y = true <-> bv_ultP x y.
+Proof. intros. split; intros; unfold bv_ult, bv_ultP in *.
+       case_eq (size x =? size y); intros;
+       rewrite H0 in H; unfold ult_listP. now rewrite H.
+       now contradict H.
+       unfold ult_listP in *.
+       case_eq (size x =? size y); intros.
+       rewrite H0 in H.
+       case_eq (ult_list x y); intros. easy.
+       rewrite H1 in H. now contradict H.
+       rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma bv_slt_B2P: forall x y, bv_slt x y = true <-> bv_sltP x y.
+Proof. intros. split; intros; unfold bv_slt, bv_sltP in *.
+       case_eq (size x =? size y); intros;
+       rewrite H0 in H; unfold slt_listP. now rewrite H.
+       now contradict H.
+       unfold slt_listP in *.
+       case_eq (size x =? size y); intros.
+       rewrite H0 in H.
+       case_eq (slt_list x y); intros. easy.
+       rewrite H1 in H. now contradict H.
+       rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma nlt_be_neq_gt: forall x y,
+    length x = length y -> ult_list_big_endian x y = false ->
+    beq_list x y = false -> ult_list_big_endian y x = true.
+Proof. intro x.
+       induction x as [ | x xs IHxs ].
+       - intros. simpl in *. case y in *; now contradict H. 
+       - intros.
+         simpl in H1.
+
+         case_eq y; intros.
+         rewrite H2 in H. now contradict H.
+         simpl.
+         case_eq l. intros. case_eq xs. intros.
+         rewrite H2 in H1.
+         rewrite H4 in H0, H. simpl in H0, H.
+         rewrite H2, H3 in H0, H.
+         rewrite H4, H3 in H1. simpl in H1. rewrite andb_true_r in H1.
+         case b in *; case x in *; easy.
+         intros.
+         rewrite H4, H2, H3 in H. now contradict H.
+         intros.
+         rewrite H2, H3 in H0, H1.
+
+         simpl in H0.
+         case_eq xs. intros. rewrite H4, H2, H3 in H. now contradict H.
+         intros. rewrite H4 in H0.
+         rewrite <- H3, <- H4.
+         rewrite <- H3, <- H4 in H0.
+         rewrite <- H3 in H1.
+         rewrite orb_false_iff in H0.
+         destruct H0.
+
+         case_eq (Bool.eqb x b); intros.
+         rewrite H6 in H0, H1.
+         rewrite andb_true_l in H0, H1.
+         assert (Bool.eqb b x = true).
+          { case b in *; case x in *; easy. }
+         rewrite H7. rewrite andb_true_l.
+         rewrite orb_true_iff.
+         left.
+         apply IHxs. rewrite H2 in H.
+         now inversion H.
+         easy. easy.
+         assert (Bool.eqb b x = false). 
+           { case b in *; case x in *; easy. }
+         rewrite H7. rewrite orb_false_l.
+         case x in *. case b in *.
+         now contradict H6.
+         now easy.
+         case b in *.
+         now contradict H5.
+         now contradict H6.
+Qed.
+
+(** bitvector ult/slt *)
+
+Lemma bv_ult_not_eqP : forall x y, bv_ultP x y -> x <> y.
+Proof. intros x y. unfold bv_ultP.
+       case_eq (size x =? size y); intros.
+       - now apply ult_list_not_eqP in H0.
+       - now contradict H0.
+Qed.
+
+Lemma bv_slt_not_eqP : forall x y, bv_sltP x y -> x <> y.
+Proof. intros x y. unfold bv_sltP.
+       case_eq (size x =? size y); intros.
+       - now apply slt_list_not_eqP in H0.
+       - now contradict H0.
+Qed.
+
+Lemma bv_ult_not_eq : forall x y, bv_ult x y = true -> x <> y.
+Proof. intros x y. unfold bv_ult.
+       case_eq (size x =? size y); intros.
+       - now apply ult_list_not_eq in H0.
+       - now contradict H0.
+Qed.
+
+Lemma bv_slt_not_eq : forall x y, bv_slt x y = true -> x <> y.
+Proof. intros x y. unfold bv_slt.
+       case_eq (size x =? size y); intros.
+       - now apply slt_list_not_eq in H0.
+       - now contradict H0.
+Qed.
+
+Lemma rev_eq: forall x y, beq_list x y = true ->
+                     beq_list (List.rev x) (List.rev y)  = true.
+Proof. intros.
+       apply List_eq in H.
+       rewrite H.
+       now apply List_eq_refl.
+Qed.
+
+Lemma rev_neq: forall x y, beq_list x y = false ->
+                      beq_list (List.rev x) (List.rev y) = false.
+Proof. intros.
+       specialize (@List_neq x y H).
+       intros.
+       apply not_true_is_false.
+       unfold not in *.
+       intros. apply H0.
+       apply List_eq in H1.
+
+       specialize (f_equal (@List.rev bool) H1 ).
+       intros.
+       now rewrite !rev_involutive in H2.
+Qed.
+
+Lemma nlt_neq_gt: forall x y,
+    length x = length y -> ult_list x y = false -> 
+    beq_list x y = false -> ult_list y x = true.
+Proof. intros.
+  unfold ult_list in *.
+  apply nlt_be_neq_gt.
+  now rewrite !rev_length.
+  easy. 
+  now apply rev_neq in H1.
+Qed.
+
+(* bitvector SUBT properties *)
+
+Lemma bv_subt_size: forall n a b, size a = n -> size b = n -> size (bv_subt a b) = n.
+Proof. intros n a b H0 H1.
+       unfold bv_subt, size, bits in *. rewrite H0, H1. rewrite N.eqb_compare.
+       rewrite N.compare_refl. rewrite <- subst_list_length. exact H0.
+       now rewrite <- Nat2N.inj_iff, H0.
+Qed.
+
+Lemma bv_subt_empty_neutral_r: forall a, (bv_subt a (mk_list_false (length (bits a)))) = a.
+Proof. intro a. unfold bv_subt, size, bits.
+       rewrite N.eqb_compare. rewrite length_mk_list_false.
+       rewrite N.compare_refl.
+       rewrite subst_list_empty_neutral. reflexivity.
+Qed.
+
+Lemma bv_subt'_size: forall n a b, (size a) = n -> (size b) = n -> size (bv_subt' a b) = n.
+Proof. intros n a b H0 H1. unfold bv_subt', size, bits in *.
+       rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite <- subst_list'_length. exact H0.
+       now rewrite <- Nat2N.inj_iff, H0.
+Qed.
+
+Lemma bv_subt'_empty_neutral_r: forall a, (bv_subt' a (mk_list_false (length (bits a)))) = a.
+Proof. intro a. unfold bv_subt', size, bits.
+       rewrite N.eqb_compare. rewrite length_mk_list_false.
+       rewrite N.compare_refl.
+       rewrite subst_list'_empty_neutral. reflexivity.
+Qed.
+
+(* bitwise ADD-NEG properties *)
+
+Lemma add_neg_list_carry_false: forall a b c, add_list_ingr a (add_list_ingr b c true) false = add_list_ingr a (add_list_ingr b c false) true.
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. auto.
+       - case b as [ | b ys].
+         + simpl. auto.
+         + case c as [ | c zs].
+           * simpl. auto.
+           * simpl.
+             case_eq (add_carry b c false); intros r0 c0 Heq0.
+             case_eq (add_carry b c true); intros r1 c1 Heq1.
+             case_eq (add_carry a r1 false); intros r2 c2 Heq2.
+             case_eq (add_carry a r0 true); intros r3 c3 Heq3.
+             case a, b, c; inversion Heq0; inversion Heq1; 
+             inversion Heq2; inversion Heq3; rewrite <- H2 in H4; 
+             rewrite <- H0 in H5; inversion H4; inversion H5; apply f_equal;
+             try reflexivity; rewrite IHxs; reflexivity.
+Qed.
+
+
+Lemma add_neg_list_carry_neg_f: forall a, (add_list_ingr a (map negb a) false) = mk_list_true (length a).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. reflexivity.
+       - simpl. 
+         case_eq (add_carry a (negb a) false); intros r0 c0 Heq0.
+         rewrite add_carry_neg_f in Heq0.
+         inversion Heq0. rewrite IHxs. reflexivity.
+Qed.
+
+Lemma add_neg_list_carry_neg_f_r: forall a, (add_list_ingr (map negb a) a false) = mk_list_true (length a).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. reflexivity.
+       - simpl. 
+         case_eq (add_carry (negb a) a false); intros r0 c0 Heq0.
+         rewrite add_carry_neg_f_r in Heq0.
+         inversion Heq0. rewrite IHxs. reflexivity.
+Qed.
+
+Lemma add_neg_list_carry_neg_t: forall a, (add_list_ingr a (map negb a) true) = mk_list_false (length a).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. reflexivity.
+       - simpl. 
+         case_eq (add_carry a (negb a) true); intros r0 c0 Heq0.
+         rewrite add_carry_neg_t in Heq0.
+         inversion Heq0. rewrite IHxs. reflexivity.
+Qed.
+
+Lemma add_neg_list_carry: forall a, add_list_ingr a (twos_complement a) false = mk_list_false (length a).
+Proof. intro a.
+       induction a as [ | a xs IHxs].
+       - simpl. reflexivity.
+       - unfold twos_complement. rewrite add_neg_list_carry_false. rewrite not_list_length at 1.
+         rewrite add_list_carry_empty_neutral_r.
+         rewrite add_neg_list_carry_neg_t. reflexivity.
+Qed.
+
+Lemma add_neg_list_absorb: forall a, add_list a (twos_complement a) = mk_list_false (length a).
+Proof. intro a. unfold add_list. rewrite add_neg_list_carry. reflexivity. Qed.
+
+(* bitvector ADD-NEG properties *)
+
+Lemma bv_add_neg_unit: forall a, bv_add a (bv_not a) = mk_list_true (nat_of_N (size a)).
+Proof. intro a. unfold bv_add, bv_not, size, bits. rewrite not_list_length.
+       rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold add_list. rewrite add_neg_list_carry_neg_f.
+       rewrite Nat2N.id, not_list_length. reflexivity.
+Qed. 
+
+
+(* bitwise ADD-SUBST properties *)
+
+Lemma add_subst_list_carry_opp: forall n a b, (length a) = n -> (length b) = n -> (add_list_ingr (subst_list' a b) b false) = a.
+Proof. intros n a b H0 H1.
+       unfold subst_list', twos_complement, add_list.
+       rewrite add_neg_list_carry_false. rewrite not_list_length at 1.
+       rewrite add_list_carry_empty_neutral_r.
+       specialize (@add_list_carry_assoc a (map negb b) b true false false true).
+       intro H2. rewrite H2; try auto. rewrite add_neg_list_carry_neg_f_r.
+       rewrite H1. rewrite <- H0. rewrite add_list_carry_unit_t; reflexivity.
+Qed.
+
+Lemma add_subst_opp:  forall n a b, (length a) = n -> (length b) = n -> (add_list (subst_list' a b) b) = a.
+Proof. intros n a b H0 H1. unfold add_list, size, bits.
+       apply (@add_subst_list_carry_opp n a b); easy.
+Qed.
+
+(* bitvector ADD-SUBT properties *)
+
+Lemma bv_add_subst_opp:  forall n a b, (size a) = n -> (size b) = n -> (bv_add (bv_subt' a b) b) = a.
+Proof. intros n a b H0 H1. unfold bv_add, bv_subt', add_list, size, bits in *.
+       rewrite H0, H1.
+       rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl.
+       rewrite <- (@subst_list'_length a b). rewrite H0.
+       rewrite N.compare_refl. rewrite (@add_subst_list_carry_opp (nat_of_N n) a b); auto;
+       inversion H0; rewrite Nat2N.id; auto.
+       symmetry. now rewrite <- Nat2N.inj_iff, H0.
+        now rewrite <- Nat2N.inj_iff, H0.
+Qed.
+
+ (* bitvector MULT properties *) 
+
+Lemma prop_mult_bool_step_k_h_len: forall a b c k,
+length (mult_bool_step_k_h a b c k) = length a.
+Proof. intro a.
+       induction a as [ | xa xsa IHa ].
+       - intros. simpl. easy.
+       - intros.
+         case b in *. simpl. rewrite IHa. simpl. omega.
+         simpl. case (k - 1 <? 0)%Z; simpl; now rewrite IHa.
+Qed. 
+
+
+Lemma empty_list_length: forall {A: Type} (a: list A), (length a = 0)%nat <-> a = [].
+Proof. intros A a.
+       induction a; split; intros; auto; contradict H; easy.
+Qed.
+
+Lemma prop_mult_bool_step: forall k' a b res k, 
+                       length (mult_bool_step a b res k k') = (length res)%nat.
+Proof. intro k'.
+       induction k'.
+       - intros. simpl. rewrite prop_mult_bool_step_k_h_len. simpl. omega.
+       - intros. simpl. rewrite IHk'. rewrite prop_mult_bool_step_k_h_len. simpl; omega.
+Qed.
+
+Lemma and_with_bool_len: forall a b, length (and_with_bool a (nth 0 b false)) = length a.
+Proof. intro a.
+       - induction a.
+         intros. now simpl.
+         intros. simpl. now rewrite IHa.
+Qed.
+
+Lemma bv_mult_size: forall n a b, (size a) = n -> (@size b) = n -> size (bv_mult a b) = n.
+Proof. intros n a b H0 H1.
+       unfold bv_mult, size, bits in *.
+       rewrite H0, H1.
+       rewrite N.eqb_compare. rewrite N.compare_refl.
+       unfold mult_list, bvmult_bool.
+       case_eq (length a).
+         intros.
+         + rewrite empty_list_length in H. rewrite H in *. now simpl in *.
+         + intros.
+           case n0 in *. now rewrite and_with_bool_len.
+           rewrite prop_mult_bool_step. now rewrite and_with_bool_len.
+Qed.
+
+ (** list extraction *)
+  Fixpoint extract (x: list bool) (i j: nat) : list bool :=
+    match x with
+      | [] => []
+      | bx :: x' => 
+      match i with
+        | O      =>
+        match j with
+          | O    => []
+          | S j' => bx :: extract x' i j'
+        end
+        | S i'   => 
+        match j with
+          | O    => []
+          | S j' => extract x' i' j'
+        end
+     end
+   end.
+
+  Lemma zero_false: forall p, ~ 0 >= Npos p.
+  Proof. intro p. induction p; lia. Qed.
+
+  Lemma min_distr: forall i j: N, N.to_nat (j - i) = ((N.to_nat j) - (N.to_nat i))%nat.
+  Proof. intros i j; case i; case j in *; try intros; lia. Qed. 
+
+  Lemma posSn: forall n, (Pos.to_nat (Pos.of_succ_nat n)) = S n.
+  Proof. intros; case n; [easy | intros; lia ]. Qed.
+
+  Lemma _length_extract: forall a (i j: N) (H0: (N.of_nat (length a)) >= j) (H1: j >= i), 
+                         length (extract a 0 (N.to_nat j)) = (N.to_nat j).
+  Proof. intro a.
+         induction a as [ | xa xsa IHa ].
+         - simpl. case i in *. case j in *.
+           easy. lia.
+           case j in *; lia.
+         - intros. simpl.
+           case_eq j. intros.
+           now simpl.
+           intros. rewrite <- H.
+           case_eq (N.to_nat j).
+           easy. intros. simpl.
+           apply f_equal.
+           specialize (@IHa 0%N (N.of_nat n)).
+           rewrite Nat2N.id in IHa.
+           apply IHa.
+           apply (f_equal (N.of_nat)) in H2.
+           rewrite N2Nat.id in H2.
+           rewrite H2 in H0. simpl in *. lia.
+           lia.
+  Qed.
+
+  Lemma length_extract: forall a (i j: N) (H0: (N.of_nat (length a)) >= j) (H1: j >= i), 
+                        length (extract a (N.to_nat i) (N.to_nat j)) = (N.to_nat (j - i)).
+  Proof. intro a.
+       induction a as [ | xa xsa IHa].
+       - intros. simpl.
+         case i in *. case j in *.
+         easy. simpl in *.
+         contradict H0. apply zero_false.
+         case j in *. now simpl.
+         apply zero_false in H0; now contradict H0.
+       - intros. simpl.     
+         case_eq (N.to_nat i). intros.
+         case_eq (N.to_nat j). intros.
+         rewrite min_distr. now rewrite H, H2.
+         intros. simpl.
+         rewrite min_distr. rewrite H, H2.
+         simpl. apply f_equal.
+
+         specialize (@IHa 0%N (N.of_nat n)).
+         rewrite Nat2N.id in IHa.
+         simpl in *.
+         rewrite IHa. lia.
+         lia. lia.
+         intros.
+         case_eq (N.to_nat j).
+         simpl. intros.
+         rewrite min_distr. rewrite H, H2. now simpl.
+         intros.
+         rewrite min_distr. rewrite H, H2.
+         simpl.
+         specialize (@IHa (N.of_nat n) (N.of_nat n0)).
+         rewrite !Nat2N.id in IHa.
+         rewrite IHa. lia.
+         apply (f_equal (N.of_nat)) in H2.
+         rewrite N2Nat.id in H2.
+         rewrite H2 in H0. simpl in H0. lia.
+         lia.
+Qed.
+
+  (** bit-vector extraction *)
+  Definition bv_extr (i n0 n1: N) a : bitvector :=
+    if (N.ltb n1 (n0 + i)) then mk_list_false (nat_of_N n0)
+    else  extract a (nat_of_N i) (nat_of_N (n0 + i)).
+
+  Lemma not_ltb: forall (n0 n1 i: N), (n1 <? n0 + i)%N = false -> n1 >= n0 + i.
+  Proof. intro n0.
+         induction n0.
+         intros. simpl in *.
+         apply N.ltb_nlt in H.
+         apply N.nlt_ge in H. lia.
+         intros. simpl.
+         case_eq i.
+         intros. subst. simpl in H.
+         apply N.ltb_nlt in H.
+         apply N.nlt_ge in H. intros. simpl in H. lia.
+         intros. subst.
+         apply N.ltb_nlt in H.
+         apply N.nlt_ge in H. lia.
+  Qed.
+         
+  
+  Lemma bv_extr_size: forall (i n0 n1 : N) a, 
+                      size a = n1 -> size (@bv_extr i n0 n1 a) = n0%N.
+  Proof. 
+    intros. unfold bv_extr, size in *.
+    case_eq (n1 <? n0 + i).
+    intros. now rewrite length_mk_list_false, N2Nat.id.
+    intros.
+    specialize (@length_extract a i (n0 + i)). intros.
+    assert ((n0 + i - i) = n0)%N.
+    { lia. } rewrite H2 in H1.
+    rewrite H1.
+      now rewrite N2Nat.id.
+      rewrite H.
+      now apply not_ltb.
+      lia.
+  Qed.
+ 
+ (*
+  Definition bv_extr (n i j: N) {H0: n >= j} {H1: j >= i} {a: bitvector} : bitvector :=
+    extract a (nat_of_N i) (nat_of_N j).
+
+
+  Lemma bv_extr_size: forall n (i j: N) a (H0: n >= j) (H1: j >= i), 
+                      size a = n -> size (@bv_extr n i j H0 H1 a) = (j - i)%N.
+  Proof. 
+    intros. unfold bv_extr, size in *.
+    rewrite <- N2Nat.id. apply f_equal.
+    rewrite <- H in H0. 
+    specialize (@length_extract a i j H0 H1); intros; apply H2.
+  Qed.
+ *)
+
+  (** list extension *)
+  Fixpoint extend (x: list bool) (i: nat) (b: bool) {struct i}: list bool :=
+    match i with
+      | O => x
+      | S i' =>  b :: extend x i' b
+    end.
+
+  Definition zextend (x: list bool) (i: nat): list bool :=
+    extend x i false.
+
+  Definition sextend (x: list bool) (i: nat): list bool :=
+    match x with
+      | []       => mk_list_false i
+      | xb :: x' => extend x i xb
+    end.
+
+  Lemma extend_size_zero: forall i b, (length (extend [] i b)) = i.
+  Proof.
+    intros.
+    induction i as [ | xi IHi].
+    - now simpl.
+    - simpl. now rewrite IHi.
+  Qed.
+
+  Lemma extend_size_one: forall i a b, length (extend [a] i b) = S i.
+  Proof. intros.
+         induction i.
+         - now simpl.
+         - simpl. now rewrite IHi.
+  Qed.
+
+  Lemma length_extend: forall a i b, length (extend a i b) = ((length a) + i)%nat.
+  Proof. intro a.
+         induction a.
+         - intros. simpl. now rewrite extend_size_zero.
+         - intros.
+           induction i.
+           + intros. simpl. lia.
+           + intros. simpl. apply f_equal.
+             rewrite IHi. simpl. lia.
+   Qed.
+
+  Lemma zextend_size_zero: forall i, (length (zextend [] i)) = i.
+  Proof.
+    intros. unfold zextend. apply extend_size_zero. 
+  Qed.
+
+  Lemma zextend_size_one: forall i a, length (zextend [a] i) = S i.
+  Proof.
+    intros. unfold zextend. apply extend_size_one. 
+  Qed.
+
+  Lemma length_zextend: forall a i, length (zextend a i) = ((length a) + i)%nat.
+  Proof.
+     intros. unfold zextend. apply length_extend.
+  Qed.
+
+  Lemma sextend_size_zero: forall i, (length (sextend [] i)) = i.
+  Proof.
+    intros. unfold sextend. now rewrite length_mk_list_false.
+  Qed.
+
+  Lemma sextend_size_one: forall i a, length (sextend [a] i) = S i.
+  Proof.
+    intros. unfold sextend. apply extend_size_one. 
+  Qed.
+
+  Lemma length_sextend: forall a i, length (sextend a i) = ((length a) + i)%nat.
+  Proof.
+     intros. unfold sextend.
+     case_eq a. intros. rewrite length_mk_list_false. easy.
+     intros. apply length_extend.
+  Qed.
+
+  (** bit-vector extension *)
+  Definition bv_zextn (n i: N) (a: bitvector): bitvector :=
+    zextend a (nat_of_N i).
+
+  Definition bv_sextn (n i: N) (a: bitvector): bitvector :=
+    sextend a (nat_of_N i).
+
+  Lemma plus_distr: forall i j: N, N.to_nat (j + i) = ((N.to_nat j) + (N.to_nat i))%nat.
+  Proof. intros i j; case i; case j in *; try intros; lia. Qed. 
+ 
+  Lemma bv_zextn_size: forall n (i: N) a, 
+                      size a = n -> size (@bv_zextn n i a) = (i + n)%N.
+  Proof.
+    intros. unfold bv_zextn, zextend, size in *.
+    rewrite <- N2Nat.id. apply f_equal. 
+    specialize (@length_extend a (nat_of_N i) false). intros.
+    rewrite H0. rewrite plus_distr. rewrite plus_comm.
+    apply f_equal.
+    apply (f_equal (N.to_nat)) in H.
+    now rewrite Nat2N.id in H.
+  Qed.
+
+  Lemma bv_sextn_size: forall n (i: N) a, 
+                      size a = n -> size (@bv_sextn n i a) = (i + n)%N.
+  Proof.
+    intros. unfold bv_sextn, sextend, size in *.
+    rewrite <- N2Nat.id. apply f_equal.
+    case_eq a.
+    intros. rewrite length_mk_list_false.
+    rewrite H0 in H. simpl in H. rewrite <- H.
+    lia.
+    intros.
+    specialize (@length_extend a (nat_of_N i) b). intros.
+    subst. rewrite plus_distr. rewrite plus_comm.
+    rewrite Nat2N.id.
+    now rewrite <- H1.
+  Qed.
+
+  (** shift left *)
+
+Fixpoint pow2 (n: nat): nat :=
+  match n with
+    | O => 1%nat
+    | S n' => (2 * pow2 n')%nat
+  end.
+
+Fixpoint _list2nat_be (a: list bool) (n i: nat) : nat :=
+  match a with
+    | [] => n
+    | xa :: xsa =>
+        if xa then _list2nat_be xsa (n + (pow2 i)) (i + 1)
+        else _list2nat_be xsa n (i + 1)
+  end.
+
+Definition list2nat_be (a: list bool) := _list2nat_be a 0 0.
+
+Definition _shl_be (a: list bool) : list bool :=
+   match a with
+     | [] => []
+     | _ => false :: removelast a 
+   end.
+
+Fixpoint nshl_be (a: list bool) (n: nat): list bool :=
+    match n with
+      | O => a
+      | S n' => nshl_be (_shl_be a) n'  
+    end.
+
+Definition shl_be (a b: list bool): list bool :=
+nshl_be a (list2nat_be b).
+
+Lemma length__shl_be: forall a, length (_shl_be a) = length a.
+Proof. intro a.
+       induction a; intros.
+       - now simpl.
+       - simpl. rewrite <- IHa.
+         case_eq a0; easy.
+Qed.
+
+Lemma length_nshl_be: forall n a, length (nshl_be a n) = length a.
+Proof. intro n.
+       induction n; intros; simpl.
+       - reflexivity.
+       - now rewrite (IHn (_shl_be a)), length__shl_be.
+Qed.
+
+Lemma length_shl_be: forall a b n, n = (length a) -> n = (length b)%nat -> 
+                     n = (length (shl_be a b)).
+Proof.
+    intros.
+    unfold shl_be. now rewrite length_nshl_be.
+Qed.
+
+  (** bit-vector extension *)
+Definition bv_shl (a b : bitvector) : bitvector :=
+  if ((@size a) =? (@size b))
+  then shl_be a b
+  else zeros (@size a).
+
+Lemma bv_shl_size n a b : size a = n -> size b = n -> size (bv_shl a b) = n.
+Proof.
+  unfold bv_shl. intros H1 H2. rewrite H1, H2.
+  rewrite N.eqb_compare. rewrite N.compare_refl.
+  unfold size in *. rewrite <- (@length_shl_be a b (nat_of_N n)).
+  now rewrite N2Nat.id.
+  now apply (f_equal (N.to_nat)) in H1; rewrite Nat2N.id in H1.
+  now apply (f_equal (N.to_nat)) in H2; rewrite Nat2N.id in H2.
+Qed.
+
+  (** shift right *)
+
+Definition _shr_be (a: list bool) : list bool :=
+   match a with
+     | [] => []
+     | xa :: xsa => xsa ++ [false]
+   end.
+
+Fixpoint nshr_be (a: list bool) (n: nat): list bool :=
+    match n with
+      | O => a
+      | S n' => nshr_be (_shr_be a) n'  
+    end.
+
+Definition shr_be (a b: list bool): list bool :=
+nshr_be a (list2nat_be b).
+
+Lemma length__shr_be: forall a, length (_shr_be a) = length a.
+Proof. intro a.
+       induction a; intros.
+       - now simpl.
+       - simpl. rewrite <- IHa.
+         case_eq a0; easy.
+Qed.
+
+Lemma length_nshr_be: forall n a, length (nshr_be a n) = length a.
+Proof. intro n.
+       induction n; intros; simpl.
+       - reflexivity.
+       - now rewrite (IHn (_shr_be a)), length__shr_be.
+Qed.
+
+Lemma length_shr_be: forall a b n, n = (length a) -> n = (length b)%nat -> 
+                     n = (length (shr_be a b)).
+Proof.
+    intros.
+    unfold shr_be. now rewrite length_nshr_be.
+Qed.
+
+  (** bit-vector extension *)
+Definition bv_shr (a b : bitvector) : bitvector :=
+  if ((@size a) =? (@size b))
+  then shr_be a b
+  else zeros (@size a).
+
+Lemma bv_shr_size n a b : size a = n -> size b = n -> size (bv_shr a b) = n.
+Proof.
+  unfold bv_shr. intros H1 H2. rewrite H1, H2.
+  rewrite N.eqb_compare. rewrite N.compare_refl.
+  unfold size in *. rewrite <- (@length_shr_be a b (nat_of_N n)).
+  now rewrite N2Nat.id.
+  now apply (f_equal (N.to_nat)) in H1; rewrite Nat2N.id in H1.
+  now apply (f_equal (N.to_nat)) in H2; rewrite Nat2N.id in H2.
+Qed.
+
+End RAWBITVECTOR_LIST.
+
+Module BITVECTOR_LIST <: BITVECTOR.
+
+  Include RAW2BITVECTOR(RAWBITVECTOR_LIST).
+
+  Notation "x |0" := (cons false x) (left associativity, at level 73, format "x |0"): bv_scope.
+  Notation "x |1" := (cons true x) (left associativity, at level 73, format "x |1"): bv_scope.
+  Notation "'b|0'" := [false] (at level 70): bv_scope.
+  Notation "'b|1'" := [true] (at level 70): bv_scope.
+  Notation "# x |" := (@of_bits x) (no associativity, at level 1, format "# x |"): bv_scope.
+  Notation "v @ p" := (bitOf p v) (at level 1, format "v @ p ") : bv_scope.
+
+End BITVECTOR_LIST.
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/bva/Bva_checker.v b/src/bva/Bva_checker.v
new file mode 100644
index 0000000..81e0a30
--- /dev/null
+++ b/src/bva/Bva_checker.v
@@ -0,0 +1,8576 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** A small checker for bit-vectors bit-blasting *)
+
+(*Add Rec LoadPath "." as SMTCoq.*)
+
+Require Structures.
+
+Require Import Int63 Int63Properties PArray SMT_classes.
+
+Require Import Misc State SMT_terms BVList Psatz.
+Require Import Bool List BoolEq NZParity Nnat.
+Require Import BinPos BinNat Pnat Init.Peano.
+
+Require FArray.
+
+Import ListNotations.
+Import Form.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+Local Open Scope list_scope.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+
+Section Checker.
+
+  Import Atom.
+
+  Variable t_atom : PArray.array atom.
+  Variable t_form : PArray.array form.
+
+  Local Notation get_form := (PArray.get t_form) (only parsing).
+  Local Notation get_atom := (PArray.get t_atom) (only parsing).
+
+  (** * Bit-blasting a constant bitvector:
+
+       --------------------------- bbConst
+        bbT(#b0010, [0; 1; 0; 0])
+   *)
+
+  Fixpoint check_bbc (a_bv: list bool) (bs: list _lit) :=
+    match a_bv, bs with
+    | nil, nil => true
+    | v :: a_bv, b::bs =>
+      if Lit.is_pos b then
+        match get_form (Lit.blit b), v with
+          | Ftrue, true | Ffalse, false => check_bbc a_bv bs
+          | _, _ => false
+        end
+      else false
+    | _, _ => false
+    end.
+
+  (** Checker for bitblasting of bitvector constants *)
+  Definition check_bbConst lres :=
+    if Lit.is_pos lres then
+      match get_form (Lit.blit lres) with
+        | FbbT a bs =>
+          match get_atom a with
+            | Acop (CO_BV bv N) =>
+              if check_bbc bv bs && (N.of_nat (length bv) =? N)%N
+              then lres::nil
+              else C._true
+            | _ => C._true
+          end
+        | _ => C._true
+      end
+    else C._true.
+
+
+  (** * Bit-blasting a variable:
+
+              x ∈ BV n
+       ----------------------- bbVar
+        bbT(x, [x₀; ...; xₙ₋₁])
+   *)
+
+  Fixpoint check_bb (a: int) (bs: list _lit) (i n: nat) :=
+    match bs with
+    | nil => Nat_eqb i n                     (* We go up to n *)
+    | b::bs =>
+      if Lit.is_pos b then
+        match get_form (Lit.blit b) with
+        | Fatom a' =>
+          match get_atom a' with
+          | Auop (UO_BVbitOf N p) a' =>
+            (* TODO:
+               Do not need to check [Nat_eqb l (N.to_nat N)] at every iteration *)
+            if (a == a')                     (* We bit blast the right bv *)
+                 && (Nat_eqb i p)            (* We consider bits after bits *)
+                 && (Nat_eqb n (N.to_nat N)) (* The bv has indeed type BV n *)
+            then check_bb a bs (S i) n
+            else false
+          | _ => false
+          end
+        | _ => false
+        end
+      else false
+    end.
+
+  (** Checker for bitblasting of bitvector variables *)
+  Definition check_bbVar lres :=
+    if Lit.is_pos lres then
+      match get_form (Lit.blit lres) with
+      | FbbT a bs =>
+        if check_bb a bs O (List.length bs)%N
+        then lres::nil
+        else C._true
+      | _ => C._true
+      end
+    else C._true.
+
+  Variable s : S.t.
+
+  (** * Bit-blasting bitvector not ...
+
+           bbT(a, [a0; ...; an])
+        ------------------------------ bbNot
+         bbT(not a, [~a0; ...; ~an])
+   *)
+
+  (* Helper function for bv_not *)
+  Fixpoint check_not (bs br : list _lit)  :=
+    match bs, br with
+    | nil, nil => true
+    | b::bs, r::br => (r == Lit.neg b) && check_not bs br
+    | _, _ => false
+    end.
+
+  (** Checker for bitblasting of bitvector not *)
+  Definition check_bbNot pos lres :=
+    match S.get s pos with
+    | l::nil =>
+      if (Lit.is_pos l) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l), get_form (Lit.blit lres) with
+        | FbbT a bs, FbbT r br =>
+          match get_atom r with
+          | Auop (UO_BVnot N) a' =>
+            if (a == a') && check_not bs br &&
+              (N.of_nat (length bs) =? N)%N
+            then lres::nil
+            else C._true
+          | _ => C._true
+          end
+        | _, _ => C._true
+        end
+      else C._true
+    | _ => C._true
+    end.
+
+  (** * Bit-blasting bitwise operations: bbAnd, bbOr, ...
+
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a&b, [a0 /\ b0; ...; an /\ bn])
+   *)
+
+Fixpoint check_symopp (bs1 bs2 bsres : list _lit) (bvop: binop)  :=
+    match bs1, bs2, bsres with
+    | nil, nil, nil => true
+    | b1::bs1, b2::bs2, bres::bsres =>
+      if Lit.is_pos bres then
+        let (ires, bvop) := 
+        match get_form (Lit.blit bres), bvop with
+
+          | Fand args, BO_BVand n  =>
+            ((if PArray.length args == 2 then
+                let a1 := args.[0] in
+                let a2 := args.[1] in
+                ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1))
+              else false), BO_BVand (n-1))
+
+          | For args, BO_BVor n  =>
+            ((if PArray.length args == 2 then
+                let a1 := args.[0] in
+                let a2 := args.[1] in
+                ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1))
+              else false), BO_BVor (n-1))
+
+          | Fxor a1 a2, BO_BVxor n =>
+             (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)),
+             BO_BVxor (n-1))
+
+          | Fiff a1 a2, (BO_eq (Typ.TBV n))  =>
+             (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)),
+             BO_eq (Typ.TBV n))
+
+          | _, _ => (false, bvop)
+        end in
+        if ires then check_symopp bs1 bs2 bsres bvop
+        else false
+      else false
+    | _, _, _ => false
+    end.
+
+  Lemma empty_list_length: forall {A: Type} (a: list A), (length a = 0)%nat <-> a = [].
+  Proof. intros A a.
+         induction a; split; intros; auto; contradict H; easy.
+  Qed.
+
+  (** Checker for bitblasting of bitwise operators on bitvectors *)
+  Definition check_bbOp pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+    | l1::nil, l2::nil =>
+      if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+        | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres =>
+          match get_atom a with
+
+          | Abop (BO_BVand n) a1' a2' =>
+            if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1')))
+                 && (@check_symopp bs1 bs2 bsres (BO_BVand n))
+                 && (N.of_nat (length bs1) =? n)%N
+            then lres::nil
+            else C._true
+
+          | Abop (BO_BVor n) a1' a2' =>
+             if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1')))
+                  && (check_symopp bs1 bs2 bsres  (BO_BVor n))
+                  && (N.of_nat (length bs1) =? n)%N
+             then lres::nil
+             else C._true
+
+          | Abop (BO_BVxor n) a1' a2' =>
+             if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1')))
+                  && (check_symopp bs1 bs2 bsres  (BO_BVxor n))
+                  && (N.of_nat (length bs1) =? n)%N
+             then lres::nil
+             else C._true
+
+       | _ => C._true
+          end
+        | _, _, _ => C._true
+        end
+      else C._true
+    | _, _ => C._true
+    end.
+
+   (** * Bit-blasting bitvector equality
+
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbEq
+         (a = b) <-> ((a0 <-> b0) /\ ... /\ (an <-> bn))
+   *)
+
+  Fixpoint check_eq (bs1 bs2 bsres: list _lit) :=
+    match bs1, bs2, bsres with
+    | nil, nil, nil => true
+    | b1::bs1, b2::bs2, bres :: bsres =>
+      match bs1, bs2, bsres with
+      | _::_, _::_, [] => 
+        if Lit.is_pos bres then
+          match get_form (Lit.blit bres) with
+          | Fand args =>
+            match PArray.to_list args with
+            | bres :: bsres =>
+              if Lit.is_pos bres then
+                let ires := 
+                    match get_form (Lit.blit bres) with
+                    | Fiff a1 a2  =>
+                      ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1))
+                    | _ => false
+                    end in
+                if ires then check_eq bs1 bs2 bsres
+                else false
+              else false
+            | _ => false
+            end
+          | _ => false
+          end
+        else false
+      | _, _, _ =>
+        if Lit.is_pos bres then
+          let ires := 
+              match get_form (Lit.blit bres) with
+              | Fiff a1 a2  =>
+                ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1))
+              | _ => false
+              end in
+          if ires then check_eq bs1 bs2 bsres
+          else false
+        else false
+      end
+    | _, _, _ => false
+    end.
+
+  (** Checker for bitblasting of equality between bitvector terms  *)
+  Definition check_bbEq pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+    | l1::nil, l2::nil =>
+      if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+        | FbbT a1 bs1, FbbT a2 bs2, Fiff leq lbb =>
+          if (Bool.eqb (Lit.is_pos leq) (Lit.is_pos lbb)) then
+          match get_form (Lit.blit leq), get_form (Lit.blit lbb) with
+          | Fatom a, _ (* | _, Fatom a *) =>
+            match get_atom a with
+            | Abop (BO_eq (Typ.TBV n)) a1' a2' =>
+              if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1')))
+                   && (check_eq bs1 bs2 [lbb])
+                   && (N.of_nat (length bs1) =? n)%N
+              then lres::nil
+              else C._true
+            | _ => C._true
+            end
+          | _, _ => C._true
+          end
+          else C._true
+        | _, _, _ => C._true
+        end
+      else C._true
+    | _, _ => C._true
+    end.
+
+  (** * Bitvector Arithmetic *)
+
+  (** Representaion for symbolic carry computations *)
+  Inductive carry : Type :=
+  | Clit (_:_lit)
+  | Cand (_:carry) (_:carry)
+  | Cxor (_:carry) (_:carry)
+  | Cor (_:carry) (_:carry)
+  | Ciff (_:carry) (_:carry)
+  .
+
+  
+  (** Check if a symbolic carry computation is equal to a literal
+     representation. This function does not account for potential symmetries *)
+  (* c should always be a positive literal in carry computations *)
+  Fixpoint eq_carry_lit (carry : carry) (c : _lit) :=
+    if Lit.is_pos c then
+      match carry with
+        | Clit l => l == c
+
+        | Cand c1 c2  =>
+          match get_form (Lit.blit c) with
+          | Fand args =>
+            if PArray.length args == 2 then
+              (eq_carry_lit c1 (args.[0]) && eq_carry_lit c2 (args.[1]))
+              (* || (eq_carry_lit c1 (args.[1]) && eq_carry_lit c2 (args.[0])) *)
+            else false
+          | _ => false
+          end
+
+        | Cxor c1 c2  =>
+          match get_form (Lit.blit c) with
+            | Fxor a1 a2 =>
+              (eq_carry_lit c1 a1 && eq_carry_lit c2 a2)
+                (* || (eq_carry_lit c1 a2 && eq_carry_lit c2 a1) *)
+            | _ => false
+          end
+
+        | Cor c1 c2  =>
+          match get_form (Lit.blit c) with
+          | For args =>
+            if PArray.length args == 2 then
+              (eq_carry_lit c1 (args.[0]) && eq_carry_lit c2 (args.[1]))
+                (* || (eq_carry_lit c1 (args.[1]) && eq_carry_lit c2 (args.[0])) *)
+            else false
+          | _ => false
+          end
+
+        | Ciff c1 c2  =>
+          match get_form (Lit.blit c) with
+            | Fiff a1 a2 =>
+              (eq_carry_lit c1 a1 && eq_carry_lit c2 a2)
+                (* || (eq_carry_lit c1 a2 && eq_carry_lit c2 a1) *)
+            | _ => false
+          end
+      end
+    else
+      (* c can be negative only when it is literal false *)
+      match carry with
+        | Clit l => l == c
+        | _ => false
+      end.
+
+  (** Checks if [bsres] is the result of bvand of bs1 and bs2. The inital
+      value for the carry is [false]. *)
+  Fixpoint check_add (bs1 bs2 bsres : list _lit) (carry : carry) :=
+    match bs1, bs2, bsres with
+      | nil, nil, nil => true
+      | b1::bs1, b2::bs2, bres::bsres =>
+        if Lit.is_pos bres then
+          match get_form (Lit.blit bres) with
+            | Fxor xab c  =>
+             if Lit.is_pos xab then
+              match get_form (Lit.blit xab) with
+                | Fxor a1 a2  =>
+                  (* This is the way LFSC computes carries *)
+                  let carry' := Cor (Cand (Clit b1) (Clit b2))
+                                   (Cand (Cxor (Clit b1) (Clit b2)) carry) in
+                  (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)))
+                    && eq_carry_lit carry c
+                    && check_add bs1 bs2 bsres carry'
+                | _ => false
+              end
+            else false
+            | _ => false
+          end
+        else false
+      | _, _, _ => false
+    end.
+
+  (** * Checker for bitblasting of bitvector addition *)
+  Definition check_bbAdd pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+      | l1::nil, l2::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+            | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres =>
+              match get_atom a with
+
+                | Abop (BO_BVadd n) a1' a2' =>
+                  if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1')))
+                       && (check_add bs1 bs2 bsres (Clit Lit._false))
+                       && (N.of_nat (length bs1) =? n)%N
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _, _ => C._true
+          end
+        else C._true
+      | _, _ => C._true
+    end.
+
+  (** * Bit-blasting bitvector negation ...
+
+           bbT(a, [a0; ...; an])
+        ------------------------------ bbNeg
+               bbT(-a, [...])
+   *)
+
+  (* Helper function for bv_neg *)
+  Definition check_neg (bs br : list _lit) :=
+    let z := map (fun _ => Lit._false) bs in
+    let nbs := map (fun l => Lit.neg l) bs in
+    check_add nbs z br (Clit Lit._true).
+
+  (** Checker for bitblasting of bitvector negation *)
+  Definition check_bbNeg pos lres :=
+    match S.get s pos with
+    | l::nil =>
+      if (Lit.is_pos l) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l), get_form (Lit.blit lres) with
+        | FbbT a bs, FbbT r br =>
+          match get_atom r with
+          | Auop (UO_BVneg n) a' =>
+            if (a == a') && check_neg bs br &&
+               (N.of_nat (length bs) =? n)%N
+            then lres::nil
+            else C._true
+          | _ => C._true
+          end
+        | _, _ => C._true
+        end
+      else C._true
+    | _ => C._true
+    end.
+
+  Fixpoint and_with_bit (a: list _lit) (bt: _lit) : list carry :=
+    match a with
+      | nil => nil
+      | ai :: a' => (Cand (Clit bt) (Clit ai)) :: and_with_bit a' bt 
+    end.
+
+  Fixpoint mult_step_k_h (a b: list carry) (c: carry) (k: Z) : list carry :=
+    match a, b with
+      | nil, _ => []
+      | ai :: a', bi :: b' =>
+        if (k - 1 <? 0)%Z then
+          let carry_out := Cor (Cand ai bi) (Cand (Cxor ai bi) c) in
+          let curr := Cxor (Cxor ai bi) c in
+          curr :: mult_step_k_h a' b' carry_out (k - 1)
+        else
+          ai :: mult_step_k_h a' b c (k - 1)
+      | ai :: a', nil =>  ai :: mult_step_k_h a' b c k
+    end.
+
+  Fixpoint mult_step (a b: list _lit) (res: list carry) (k k': nat) : list carry :=
+    let ak := List.firstn (S k') a in
+    let b' := and_with_bit ak (nth k b Lit._false) in
+    let res' := mult_step_k_h res b' (Clit Lit._false) (Z.of_nat k) in
+    match k' with 
+      | O => res'
+      (* | S O => res' *)
+      | S pk' => mult_step a b res' (S k) pk'
+    end.
+
+  Definition bblast_bvmult (a b: list _lit) (n: nat) : list carry :=
+    let res := and_with_bit a (nth 0 b Lit._false) in
+    match n with
+      | O => res
+      | S O => res
+      | S (S k) => mult_step a b res 1 k
+    end.
+
+  Fixpoint mkzeros (k: nat) : list carry :=
+    match k with
+      | O => nil
+      | S k => (Clit Lit._false) :: mkzeros k
+    end .
+
+  Fixpoint bblast_bvadd (a b: list carry) (c: carry) : list carry :=
+    match a, b  with
+      | nil, _ | _, nil => nil
+      | ai :: a', bi :: b' =>
+        let c' := (Cor (Cand ai bi) (Cand (Cxor ai bi) c)) in
+        (Cxor (Cxor ai bi) c') :: (bblast_bvadd a' b' c')
+    end.
+
+  Fixpoint mult_shift (a b: list _lit) (n: nat) : list carry :=
+    match a with
+      | nil => mkzeros n
+      | ai :: a' =>
+        (bblast_bvadd (and_with_bit b ai)
+                      (mult_shift a' (Lit._false :: b) n) (Clit Lit._false))
+    end.
+
+  Definition check_mult (bs1 bs2 bsres: list _lit) : bool :=
+   if Nat_eqb (length bs1) (length bs2)%nat then
+    let bvm12 := bblast_bvmult bs1 bs2 (length bs1) in
+    forallb2 eq_carry_lit bvm12 bsres
+   else false.
+
+  (** * Checker for bitblasting of bitvector multiplication *)
+  Definition check_bbMult pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+      | l1::nil, l2::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+            | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres =>
+              match get_atom a with
+
+                | Abop (BO_BVmult n) a1' a2' =>
+                  if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) )
+                       && (check_mult bs1 bs2 bsres)
+                       && (N.of_nat (length bs1) =? n)%N
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _, _ => C._true
+          end
+        else C._true
+      | _, _ => C._true
+    end.
+
+  (** * Checker for bitblasting of bitvector comparison: lt *)
+
+  Fixpoint ult_big_endian_lit_list (bs1 bs2: list _lit) :=
+    match bs1, bs2 with
+      | nil, _ => Clit (Lit._false)
+      | _, nil => Clit (Lit._false)
+      | xi :: nil, yi :: nil => (Cand (Clit (Lit.neg xi)) (Clit yi))
+      | xi :: x', yi :: y'   =>
+        (Cor (Cand (Ciff (Clit xi) (Clit yi)) (ult_big_endian_lit_list x' y'))
+             (Cand (Clit (Lit.neg xi)) (Clit yi)))
+    end.
+
+  Definition ult_lit_list (x y: list _lit) :=
+    ult_big_endian_lit_list (List.rev x) (List.rev y).
+
+  Definition check_ult (bs1 bs2: list _lit) (bsres: _lit) : bool :=
+    if Lit.is_pos bsres then
+      eq_carry_lit (ult_lit_list bs1 bs2) bsres
+    else false.
+
+  Definition check_bbUlt pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+    | l1::nil, l2::nil =>
+      if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+        | FbbT a1 bs1, FbbT a2 bs2, Fiff llt lbb =>
+          if (Bool.eqb (Lit.is_pos llt) (Lit.is_pos lbb)) then
+          match get_form (Lit.blit llt), get_form (Lit.blit lbb) with
+          | Fatom a, _ (* | _, Fatom a *) =>
+            match get_atom a with
+            | Abop (BO_BVult n) a1' a2' =>
+              if ((a1 == a1') && (a2 == a2'))
+                   && (check_ult bs1 bs2 lbb)
+                   && (N.of_nat (length bs1) =? n)%N
+                   && (N.of_nat (length bs2) =? n)%N
+              then lres::nil
+              else C._true
+            | _ => C._true
+            end
+          | _, _ => C._true
+          end
+          else C._true
+        | _, _, _ => C._true
+        end
+      else C._true
+    | _, _ => C._true
+    end.
+
+  Definition slt_big_endian_lit_list (x y: list _lit) :=
+    match x, y with
+      | nil, _ => Clit (Lit._false)
+      | _, nil => Clit (Lit._false)
+      | xi :: nil, yi :: nil => (Cand (Clit xi) (Clit (Lit.neg yi)))
+      | xi :: x', yi :: y'   =>
+        (Cor (Cand (Ciff (Clit xi) (Clit yi)) (ult_big_endian_lit_list x' y')) 
+             (Cand (Clit xi) (Clit (Lit.neg yi))))
+    end.
+
+  Definition slt_lit_list (x y: list _lit) :=
+    slt_big_endian_lit_list (List.rev x) (List.rev y).
+
+  Definition check_slt (bs1 bs2: list _lit) (bsres: _lit) : bool := 
+    if Lit.is_pos bsres then
+      eq_carry_lit (slt_lit_list bs1 bs2) bsres
+    else false.
+
+  Definition check_bbSlt pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+    | l1::nil, l2::nil =>
+      if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+        match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+        | FbbT a1 bs1, FbbT a2 bs2, Fiff llt lbb =>
+          if (Bool.eqb (Lit.is_pos llt) (Lit.is_pos lbb)) then
+          match get_form (Lit.blit llt), get_form (Lit.blit lbb) with
+          | Fatom a, _ (* | _, Fatom a *) =>
+            match get_atom a with
+            | Abop (BO_BVslt n) a1' a2' =>
+              if ((a1 == a1') && (a2 == a2'))
+                   && (check_slt bs1 bs2 lbb)
+                   && (N.of_nat (length bs1) =? n)%N
+                   && (N.of_nat (length bs2) =? n)%N
+              then lres::nil
+              else C._true
+            | _ => C._true
+            end
+          | _, _ => C._true
+          end
+          else C._true
+        | _, _, _ => C._true
+        end
+      else C._true
+    | _, _ => C._true
+    end.
+
+  (** * Checker for bitblasting of bitvector concatenation *)
+
+(*
+  Fixpoint lit_to_carry (bs: list _lit) : list carry :=
+    match bs with
+      | nil => []
+      | xbs :: xsbs => Clit xbs :: lit_to_carry xsbs
+    end.
+
+  Fixpoint h_check_bbConcat (bs1 bs2: list _lit) {struct bs1}: list carry :=
+    match bs1 with
+      | nil => 
+      match bs2 with
+        | nil => []
+        | xbs2 :: xsbs2 => lit_to_carry bs2
+      end
+      | xbs1 :: xsbs1 => Clit xbs1 :: (h_check_bbConcat xsbs1 bs2)
+    end.
+    *)
+
+  Fixpoint lit_to_carry (bs: list _lit) : list carry :=
+    match bs with
+      | nil => []
+      | xbs :: xsbs => Clit xbs :: lit_to_carry xsbs
+    end.
+
+  Definition check_concat (bs1 bs2 bsres: list _lit) : bool :=
+    if (forallb2 eq_carry_lit (lit_to_carry (bs2 ++ bs1)) bsres) then true else false.
+
+  Definition check_bbConcat pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+      | l1::nil, l2::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+            | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres =>
+              match get_atom a with
+
+                | Abop (BO_BVconcat n m) a1' a2' =>
+                  if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) )
+                       && (check_concat bs1 bs2 bsres)
+                       && (N.of_nat (length bs1) =? n)%N
+                       && (N.of_nat (length bs2) =? m)%N
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _, _ => C._true
+          end
+        else C._true
+      | _, _ => C._true
+    end.
+
+(* bitwise disequality *)
+
+  Fixpoint List_diseqb (a b: list bool) : bool :=
+  match a, b with
+    | nil, nil =>  false
+    | xa :: xsa, xb :: xsb =>
+      if (Bool.eqb xa false) then 
+        (if (Bool.eqb xb false) then List_diseqb xsa xsb else  true)
+      else (if (Bool.eqb xb true) then List_diseqb xsa xsb else  true)
+    | _, _ => true
+  end.
+
+
+  (** Checker for bitvector disequality *)
+  Definition check_bbDiseq lres :=
+  if negb (Lit.is_pos lres) then
+      match get_form (Lit.blit lres) with
+          | Fatom f => 
+          match (get_atom f) with
+            |  Abop (BO_eq (Typ.TBV n)) a b =>
+             match (get_atom a), (get_atom b) with
+               | (Acop (CO_BV bv1 n1)), (Acop (CO_BV bv2 n2)) =>
+                  if List_diseqb bv1 bv2 
+                     && (N.of_nat (length bv1) =? n)%N
+                     && (N.of_nat (length bv2) =? n)%N
+                     && (n1 =? n)%N && (n2 =? n)%N
+                  then lres::nil
+                  else C._true
+               | _, _ => C._true
+             end
+           | _ => C._true
+         end
+          | _ => C._true
+      end
+    else C._true.
+
+
+  (** Checker for bitvector extraction *)
+  Fixpoint extract_lit (x: list _lit) (i j: nat) : list _lit :=
+    match x with
+      | []         => []
+      | bx :: x'   => 
+        match i with
+          | O      =>
+            match j with
+              | O    => []
+              | S j' => bx :: extract_lit x' i j'
+            end
+          | S i'   => 
+            match j with
+              | O    => []
+              | S j' => extract_lit x' i' j'
+            end
+        end
+   end.
+
+   Definition check_extract (bs bsres: list _lit) (i j: N) : bool :=
+     if (N.ltb (N.of_nat (length bs)) j) 
+     then false
+     else
+       if (forallb2 eq_carry_lit (lit_to_carry (extract_lit bs (nat_of_N i) (nat_of_N j))) bsres)
+       then true
+       else false.
+
+  Definition check_extract3 (bs bsres: list _lit) (i j: N) : bool :=
+    forallb2 (fun l1 l2 => l1 == l2) (extract_lit bs (nat_of_N i) (nat_of_N j)) bsres.
+
+
+  (** Checker for bitvector extraction *)
+  Fixpoint check_extract2 (x bsres: list _lit) (i j: nat) : bool :=
+    match x with
+      | [] => match bsres with [] => true | _ => false end
+      | bx :: x' => 
+        match i with
+          | O      =>
+            match j, bsres with
+            | O, nil => true
+            | S j', b :: bsres' => (bx == b) && check_extract2 x' bsres' i j'
+            | _, _ => false
+            end
+          | S i'   => 
+            match j, bsres with
+              | O, nil => true
+              | S j', _ => check_extract2 x' bsres i' j'
+              | _, _ => false
+            end
+        end
+   end.
+
+  Definition check_bbExtract pos lres :=
+    match S.get s pos with
+      | l1::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit lres) with
+            | FbbT a1 bs, FbbT a bsres =>
+              match get_atom a with
+
+                | Auop (UO_BVextr i n0 n1) a1' =>
+                  if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) )
+                       && (check_extract bs bsres i (n0 + i))
+                       && (N.of_nat (length bs) =? n1)%N
+                       && (N.leb (n0 + i) n1)
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _ => C._true
+          end
+        else C._true
+      | _ => C._true
+    end.
+
+
+  (** Checker for unsigned bitvector extension *)
+  Fixpoint extend_lit (x: list _lit) (i: nat) (b: _lit) {struct i}: list _lit :=
+    match i with
+      | O => x
+      | S i' =>  b :: extend_lit x i' b
+    end.
+
+  Definition zextend_lit (x: list _lit) (i: nat): list _lit :=
+    extend_lit x i Lit._false.
+
+   Definition lit_of_bool (b: bool) :_lit :=
+     if (Bool.eqb b true) then Lit._true
+     else Lit._false.
+
+   Definition check_zextend (bs bsres: list _lit) (i: N) : bool :=
+     if (forallb2 eq_carry_lit (lit_to_carry (zextend_lit bs (nat_of_N i))) bsres)
+    then true else false.
+
+  Definition check_bbZextend pos lres :=
+    match S.get s pos with
+      | l1::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit lres) with
+            | FbbT a1 bs, FbbT a bsres =>
+              match get_atom a with
+
+                | Auop (UO_BVzextn n i) a1' =>
+                  if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) )
+                       && (check_zextend bs bsres i)
+                       && (N.of_nat (length bs) =? n)%N
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _ => C._true
+          end
+        else C._true
+      | _ => C._true
+    end.
+
+  (** Checker for signed bitvector extension *)
+
+
+  Fixpoint mk_list_lit_false (t: nat) : list _lit :=
+    match t with
+      | O    => []
+      | S t' => Lit._false :: (mk_list_lit_false t')
+    end.
+
+  Definition sextend_lit (x: list _lit) (i: nat): list _lit :=
+    match x with
+      | []       => mk_list_lit_false i
+      | xb :: x' => extend_lit x i xb
+    end.
+
+   Definition check_sextend (bs bsres: list _lit) (i: N) : bool :=
+     if (forallb2 eq_carry_lit (lit_to_carry (sextend_lit bs (nat_of_N i))) bsres)
+    then true else false.
+
+  Definition check_bbSextend pos lres :=
+    match S.get s pos with
+      | l1::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit lres) with
+            | FbbT a1 bs, FbbT a bsres =>
+              match get_atom a with
+
+                | Auop (UO_BVsextn n i) a1' =>
+                  if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) )
+                       && (check_sextend bs bsres i)
+                       && (N.of_nat (length bs) =? n)%N
+                  then lres::nil
+                  else C._true
+
+                | _ => C._true
+              end
+            | _, _ => C._true
+          end
+        else C._true
+      | _ => C._true
+    end.
+
+
+(** Checker for the bit-blasted left shift (in big endian) *)
+
+Definition _shl_lit_be (a: list _lit) : list _lit :=
+   match a with
+     | [] => []
+     | _ => Lit._false :: removelast a 
+   end.
+
+Fixpoint nshl_lit_be (a: list _lit) (n: nat): list _lit :=
+    match n with
+      | O => a
+      | S n' => nshl_lit_be (_shl_lit_be a) n'  
+    end.
+
+Definition shl_lit_be (a: list _lit) (b: list bool): list _lit :=
+  nshl_lit_be a (RAWBITVECTOR_LIST.list2nat_be b).
+
+
+ Definition check_shl (bs1: list _lit) (bs2: list bool) (bsres: list _lit) : bool :=
+    if (Structures.nat_eqb (length bs1) (length bs2)) then
+      if (forallb2 eq_carry_lit (lit_to_carry (shl_lit_be bs1 bs2)) bsres)
+      then true else false
+    else false.
+
+  Definition check_bbShl pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+      | l1::nil, l2::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+            | FbbT a1 bs1, Fatom a2, FbbT a bsres =>
+              match get_atom a with
+                | Abop (BO_BVshl n) a1' a2' =>
+                  match (get_atom a2) with
+                    |  (Acop (CO_BV bv2 n2)) =>                
+                      if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) )
+                         && check_shl bs1 bv2 bsres
+                         && (N.of_nat (length bs1) =? n)%N
+                         && (N.of_nat (length bv2) =? n)%N
+                         && (n2 =? n)%N
+                      then lres::nil
+                      else C._true
+                    |  _ => C._true
+                  end
+                | _ => C._true
+              end
+            | _, _, _ => C._true
+          end
+        else C._true
+      | _, _ => C._true
+    end.
+
+(** Checker for the bit-blasted right shift (in big endian) *)
+
+Definition _shr_lit_be (a: list _lit) : list _lit :=
+   match a with
+     | [] => []
+     | xa :: xsa => xsa ++ [Lit._false]
+   end.
+
+Fixpoint nshr_lit_be (a: list _lit) (n: nat): list _lit :=
+    match n with
+      | O => a
+      | S n' => nshr_lit_be (_shr_lit_be a) n'  
+    end.
+
+Definition shr_lit_be (a: list _lit) (b: list bool): list _lit :=
+  nshr_lit_be a (RAWBITVECTOR_LIST.list2nat_be b).
+
+
+ Definition check_shr (bs1: list _lit) (bs2: list bool) (bsres: list _lit) : bool :=
+    if (Structures.nat_eqb (length bs1) (length bs2)) then
+      if (forallb2 eq_carry_lit (lit_to_carry (shr_lit_be bs1 bs2)) bsres)
+      then true else false
+    else false.
+
+  Definition check_bbShr pos1 pos2 lres :=
+    match S.get s pos1, S.get s pos2 with
+      | l1::nil, l2::nil =>
+        if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then
+          match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with
+            | FbbT a1 bs1, Fatom a2, FbbT a bsres =>
+              match get_atom a with
+                | Abop (BO_BVshr n) a1' a2' =>
+                  match (get_atom a2) with
+                    |  (Acop (CO_BV bv2 n2)) =>                
+                      if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) )
+                         && check_shr bs1 bv2 bsres
+                         && (N.of_nat (length bs1) =? n)%N
+                         && (N.of_nat (length bv2) =? n)%N
+                         && (n2 =? n)%N
+                      then lres::nil
+                      else C._true
+                    |  _ => C._true
+                  end
+                | _ => C._true
+              end
+            | _, _, _ => C._true
+          end
+        else C._true
+      | _, _ => C._true
+    end.
+
+  Section Proof.
+
+    Variables (t_i : array typ_compdec)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation check_atom :=
+      (check_aux t_i t_func (get_type t_i t_func t_atom)).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
+
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
+
+  Fixpoint interp_carry (c: carry) : bool :=
+    match c with
+      | Clit l => (Lit.interp rho l)
+      | Cand c1 c2 => (interp_carry c1) && (interp_carry c2)
+      | Cor c1 c2 => (interp_carry  c1) || (interp_carry c2)
+      | Cxor c1 c2 => xorb (interp_carry c1) (interp_carry c2)
+      | Ciff c1 c2 => Bool.eqb (interp_carry c1) (interp_carry c2)
+    end.
+
+    Hypothesis Hs : S.valid rho s.
+
+    Local Notation t_interp := (t_interp t_i t_func t_atom).
+
+    Local Notation interp_atom :=
+      (interp_aux t_i t_func (get t_interp)).
+
+    Let wf_t_atom : Atom.wf t_atom.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_atom : default t_atom = Atom.Acop Atom.CO_xH.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_form : default t_form = Form.Ftrue.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_t_form : Form.wf t_form.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_rho : Valuation.wf rho.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto.
+    Qed.
+
+    Lemma lit_interp_true : Lit.interp rho Lit._true = true.
+    Proof. 
+       apply Lit.interp_true. 
+       apply wf_rho. 
+     Qed.
+
+    Lemma lit_interp_false : Lit.interp rho Lit._false = false.
+    Proof. 
+      specialize (Lit.interp_false rho wf_rho). intros.
+      rewrite <- not_true_iff_false.
+      unfold not in *.
+      intros. now apply H. 
+     Qed.
+
+     Let rho_interp : forall x : int, rho x = Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form.[ x]).
+     Proof. intros x;apply wf_interp_form;trivial. Qed.
+
+      Definition wf := PArray.forallbi lt_form t_form.
+
+      Hypothesis wf_t_i : wf.
+      Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s.
+      Notation atom := int (only parsing).
+
+Lemma id'' a : N.of_nat (N.to_nat a) = a.
+Proof.
+ destruct a as [ | p]; simpl; trivial.
+ destruct (Pos2Nat.is_succ p) as (n,H). rewrite H. simpl. f_equal.
+ apply Pos2Nat.inj. rewrite H. apply SuccNat2Pos.id_succ.
+Qed.
+
+Lemma inj a a' : N.to_nat a = N.to_nat a' -> a = a'.
+Proof.
+ intro H. rewrite <- (id'' a), <- (id'' a'). now f_equal.
+Qed.
+
+Lemma inj_iff a a' : N.to_nat a = N.to_nat a' <-> a = a'.
+Proof.
+ split. apply inj. intros; now subst.
+Qed.
+
+Lemma id' n : N.to_nat (N.of_nat n) = n.
+Proof.
+ induction n; simpl; trivial. apply SuccNat2Pos.id_succ.
+Qed.
+
+Lemma nth_eq1: forall i a xs,
+nth (S i) (a :: xs) 1 = nth i xs 1.
+Proof. intros.
+       now simpl.
+Qed.
+
+Theorem nat_case: forall (n:nat) (P:nat -> Prop), P 0%nat -> (forall m:nat, P (S m)) -> P n.
+Proof. induction n; auto. Qed.
+
+Theorem le_lt_or_eq : forall (n m: nat), (n <= m)%nat -> (n < m)%nat \/ n = m.
+Proof.
+induction 1; auto with arith.
+Qed.
+
+Lemma le_le_S_eq : forall (n m: nat), (n <= m)%nat -> (S n <= m)%nat \/ n = m.
+Proof le_lt_or_eq.
+
+Lemma Nat_eqb_eq: forall n m, Nat_eqb n m = true -> n = m.
+Proof. induction n.
+       intros n Hm. simpl in Hm. case_eq n. reflexivity.
+         intros. rewrite H in Hm. now contradict H.
+       intros m Hm.
+       case_eq m. intros. rewrite H in Hm. simpl in Hm.
+        now contradict Hm.
+       intros. rewrite H in Hm. simpl in Hm.
+       specialize (@IHn n0 Hm). now rewrite IHn.
+Qed.
+
+Lemma diseq_neg_eq: forall (la lb: list bool),
+      List_diseqb la lb = true -> negb (RAWBITVECTOR_LIST.beq_list la lb) = true.
+Proof. intro la.
+       induction la.
+       - intros. simpl in H. case lb in *.
+           now contradict H.
+           now simpl.
+       - intros.
+         simpl in *.
+         case lb in *.
+          easy.
+          case_eq (Bool.eqb a false).
+          intros. rewrite H0 in H.
+          case_eq (Bool.eqb b false).
+          intros. rewrite H1 in H.
+          case a in *. now contradict H0.
+          case b in *. now contradict H1.
+          simpl.
+          apply IHla. easy.
+          case a in *. now contradict H0.
+          case b in *. intros.
+          now simpl.
+          intros. simpl.
+          apply IHla.
+          simpl in H. easy.
+          intros. rewrite H0 in H.
+          case_eq (Bool.eqb b true ). intros.
+          case a in *. 
+          case b in *. simpl.
+          apply IHla. simpl in H. easy.
+          now simpl.
+          now contradict H0.
+          intros.
+          case a in *.
+          case b in *. simpl in *. now contradict H1.
+          now simpl in *.
+          case b in *. now simpl in *.
+          simpl in *. now contradict H.
+Qed.
+
+Lemma valid_check_bbDiseq lres : C.valid rho (check_bbDiseq lres).
+Proof. 
+      unfold check_bbDiseq.
+      case_eq (Lit.is_pos lres); intro Heq; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+        intros f Heq2.
+      case_eq (t_atom .[ f]); try (intros; now apply C.interp_true).
+
+      intros [ | | | | | | |[ A B | A| | | |n]|N|N|N|N|N|N|N|N|N| | | | ];
+         try (intros; now apply C.interp_true). intros a b Heq3.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros c Heq4.
+      case_eq c; try (intros; now apply C.interp_true).
+      intros la n1 Heq5.
+      case_eq (t_atom .[ b]); try (intros; now apply C.interp_true).
+      intros c0 Heq6.
+      case_eq c0; try (intros; now apply C.interp_true).
+      intros lb n2 Heq7.
+      case_eq (List_diseqb la lb && (N.of_nat (Datatypes.length la) =? n)%N
+              && (N.of_nat (Datatypes.length lb) =? n)%N 
+              && (n1 =? n)%N && (n2 =? n)%N);
+         try (intros; now apply C.interp_true). intros Heq8.
+
+      unfold C.valid. simpl. rewrite orb_false_r.
+      unfold Lit.interp. rewrite Heq.
+      unfold Var.interp.
+      rewrite wf_interp_form; trivial. rewrite Heq2. simpl.
+      unfold Atom.interp_form_hatom, interp_hatom.
+      rewrite Atom.t_interp_wf; trivial.
+      rewrite Heq3. simpl.
+      rewrite !Atom.t_interp_wf; trivial.
+      rewrite Heq4, Heq6. simpl.
+      rewrite Heq5, Heq7. simpl.
+
+        rewrite !andb_true_iff in Heq8.
+        destruct Heq8 as (((Heq8, Ha), Hb), Hc).
+        destruct Heq8 as (Heq8, Hd).
+        rewrite N.eqb_eq in Hb, Hc.
+        rewrite Hb, Hc.
+        rewrite Typ.N_cast_refl. simpl.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        (* a *)
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq4, Heq5. easy. }
+        specialize (@H0 H1). rewrite Heq4 in H0. simpl in H0.
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        rewrite Atom.t_interp_wf in Htia; trivial.
+        rewrite Heq4, Heq5 in Htia. simpl in Htia.
+        rewrite Hb in Htia.
+        unfold Bval in Htia.
+        rewrite Heq5 in H0. simpl in H0.
+        inversion Htia.
+
+        generalize dependent v_vala.
+        rewrite <- H3. intros.
+
+        (* b *)
+        pose proof (H b). 
+        assert (b < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6, Heq7. easy. }
+        specialize (@H2 H4). rewrite Heq6 in H2. simpl in H2.
+        unfold get_type' in H2. unfold v_type in H2.
+        case_eq (t_interp .[ b]).
+        intros v_typeb v_valb Htib. rewrite Htib in H2.
+        rewrite Atom.t_interp_wf in Htib; trivial.
+        rewrite Heq6, Heq7 in Htib. simpl in Htib.
+        rewrite Hc in Htib.
+        unfold Bval in Htib.
+        rewrite Heq7 in H2. simpl in H2.
+        inversion Htib.
+
+        generalize dependent v_valb.
+        rewrite <- H6. intros.
+
+        (* f *)
+        pose proof (H f). 
+        assert (f < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq3. easy. }
+        specialize (@H5 H7). rewrite Heq3 in H5. simpl in H5.
+        unfold get_type' in H5. unfold v_type in H5.
+        case_eq (t_interp .[ f]).
+        intros v_typef v_valf Htif. rewrite Htif in H5.
+        rewrite Atom.t_interp_wf in Htif; trivial.
+        rewrite Heq3 in Htif. simpl in Htif.
+        rewrite !Atom.t_interp_wf in Htif; trivial.
+        rewrite Heq4, Heq6 in Htif.
+        rewrite Heq5, Heq7 in Htif.
+        simpl in Htif.
+        rewrite Hb, Hc in Htif.
+        rewrite Typ.N_cast_refl in Htif.
+        unfold Bval in Htif.
+        rewrite !andb_true_iff in H5.
+        destruct H5. destruct H5.
+
+        inversion Htif.
+
+        generalize dependent v_valf.
+        rewrite <- H11. intros.
+
+        unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits.
+        rewrite N.eqb_eq in Ha, Hd.
+
+        generalize (BITVECTOR_LIST._of_bits_size la n).
+
+        unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits.
+
+        rewrite Hd.
+
+        generalize (BITVECTOR_LIST._of_bits_size lb n).
+        unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits.
+        rewrite Ha.
+        intros.
+
+        unfold Typ.i_eqb. simpl.
+        unfold BITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bv_eq.
+        simpl.
+        rewrite e, e0.
+        rewrite N.eqb_refl.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        apply diseq_neg_eq. easy.
+Qed.
+
+Lemma prop_checkbb: forall (a: int) (bs: list _lit) (i n: nat),
+                    (length bs = (n - i))%nat ->
+                    (check_bb a bs i n = true) ->
+                    (forall i0, (i <= i0 < n )%nat ->
+                    Lit.interp rho (nth (i0 - i) bs 1) = 
+                    (@BITVECTOR_LIST.bitOf (N.of_nat n) i0 (interp_form_hatom_bv a (N.of_nat n)))).
+Proof. intros a bs.
+       revert a.
+       induction bs as [ | b ys IHys].
+       - intros. simpl in H. 
+         cut (i = n). intro Hn. rewrite Hn in H1.
+         contradict H1. omega. omega.
+       - intros. simpl in H0.
+         case_eq (Lit.is_pos b). intros Heq0. rewrite Heq0 in H0.
+         case_eq (t_form .[ Lit.blit b] ). intros i1 Heq1. rewrite Heq1 in H0.
+         case_eq (t_atom .[ i1]). intros c Heq2. 
+         rewrite Heq2 in H0; now contradict H0.
+         intros u i2 Heq2. 
+         rewrite Heq2 in H0.
+         case_eq u; try (intro Heq'; rewrite Heq' in H0; now contradict H0).
+
+         intros. rewrite H2 in H0.
+         case_eq ((a == i2) && Nat_eqb i n1 && Nat_eqb n (N.to_nat n0)). intros Hif.
+         rewrite Hif in H0.
+         do 2 rewrite andb_true_iff in Hif. destruct Hif as ((Hif0 & Hif1) & Hif2).
+         specialize (@IHys a (S i) n).
+         inversion H.
+         cut (Datatypes.length ys = (n - S i)%nat). intro HSi.
+         specialize (@IHys HSi H0).
+
+         cut (((S i) <= i0 < n)%nat \/ i = i0).
+         intro Hd. destruct Hd as [Hd | Hd].
+         inversion Hd.
+         induction i0 as [ | k IHk].
+         now contradict H3.
+         specialize (@IHys (S k)).
+         cut ((S k - i)%nat = S (k - i)%nat). intro ISk.
+         rewrite ISk.
+         rewrite (@nth_eq1 (k - i) b ys).
+         cut ((S k - S i)%nat = (k - i)%nat). intro ISki.
+         specialize (@IHys Hd).
+         now rewrite ISki in IHys.
+         now simpl. omega.
+         rewrite Hd.
+         cut ((i0 - i0 = 0)%nat). intro Hi0. rewrite Hi0.
+         simpl.
+
+         unfold Lit.interp.
+         rewrite Heq0.
+         unfold Var.interp.
+         rewrite rho_interp.
+         rewrite Heq1.
+
+         rewrite Lit.eqb_spec in Hif0.
+         rewrite Hif0. rewrite <- Hd.
+
+         generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+         rewrite PArray.forallbi_spec;intros.
+         assert (i1 < PArray.length t_atom).
+         {
+           apply PArray.get_not_default_lt.
+           rewrite Heq2. now rewrite def_t_atom.
+         }
+
+         specialize (@H3 i1 H5).
+         rewrite Heq2 in H3. simpl in H3.
+         rewrite H2 in H3. simpl in H3.
+         rewrite !andb_true_iff in H3.
+         decompose [and] H3. clear H3.
+         simpl in H7.
+
+         unfold get_type' in H6, H7.
+         unfold v_type in H6, H7.
+         case_eq (t_interp .[ i1]).
+         intros. rewrite H3 in H6. simpl in H6.
+         case_eq (v_type0); intros; try (rewrite H8 in H6; now contradict H6).
+         simpl.
+
+         unfold Atom.interp_form_hatom_bv.
+         unfold Atom.interp_form_hatom.
+         unfold Atom.interp_hatom.
+         rewrite Atom.t_interp_wf; trivial.
+         rewrite Heq2.
+         simpl.
+
+         rewrite H2. simpl.
+         cut (i = n1). intro Hin1. rewrite Hin1.
+         cut (n = (N.to_nat n0)). intro Hnn0.
+         rewrite Hnn0. 
+         rewrite id''.
+         case_eq (t_interp .[ i2]).
+
+         intros. rewrite H9 in H7. rewrite <- H9.
+         case_eq v_type1; intros; rewrite H10 in H7; try (now contradict H7).
+         cut (n2 = n0)%N. intros Hn2n0. rewrite Hn2n0 in H10. 
+
+         rewrite H9. simpl.
+         unfold interp_bool.
+         case_eq (Typ.cast v_type1 (Typ.TBV n0)).
+         (* split *)
+         split. rewrite H10.
+         simpl.
+         rewrite Typ.N_cast_refl. intros.
+         contradict H11. easy.
+
+         apply Typ.eqb_spec in H7. inversion H7. easy.
+
+         now apply Nat_eqb_eq in Hif2.
+         now apply Nat_eqb_eq in Hif1.
+
+         omega.
+         destruct H1.
+         specialize (@le_le_S_eq i i0). intros H11.
+         specialize (@H11 H1).
+         destruct H11. left. split. exact H5. exact H3.
+         right. exact H5.
+         omega.
+         intro H3. rewrite H3 in H0. now contradict H0.
+         intros n0 Hn. rewrite Hn in H0. now contradict H0.
+         intros n0 Hn. rewrite Hn in H0. now contradict H0.
+         intros i3 n0 n1 Heq. rewrite Heq in H0. now contradict H0.
+         intros n0 i3 Heq. rewrite Heq in H0. now contradict H0.
+         intros n0 i3 Heq. rewrite Heq in H0. now contradict H0. 
+         intros b0 i2 i3 Heq. rewrite Heq in H0. now contradict H0.
+         intros t i2 i3 i4 Heq. rewrite Heq in H0. now contradict H0.
+         intros n0 l Heq. rewrite Heq in H0. now contradict H0.
+         intros i2 l Heq. rewrite Heq in H0. now contradict H0.
+         intros Heq. rewrite Heq in H0. now contradict H0.
+         intros Heq. rewrite Heq in H0. now contradict H0.
+         intros i1 i2 Heq. rewrite Heq in H0. now contradict H0.
+         intros a0 Heq. rewrite Heq in H0. now contradict H0.
+         intros a0 Heq. rewrite Heq in H0. now contradict H0.
+         intros a0 Heq. rewrite Heq in H0. now contradict H0.
+         intros i1 i2 Heq. rewrite Heq in H0. now contradict H0.
+         intros i1 i2 Heq. rewrite Heq in H0. now contradict H0.
+         intros i1 i2 i3 Heq. rewrite Heq in H0. now contradict H0.
+         intros i1 l Heq. rewrite Heq in H0. now contradict H0.
+         intros Heq. rewrite Heq in H0. now contradict H0.       
+Qed.
+
+Lemma prop_checkbb': forall (a: int) (bs: list _lit),
+                     (check_bb a bs 0 (length bs) = true) ->
+                     (forall i0, (i0 < (length bs) )%nat ->
+                     (Lit.interp rho  (nth i0 bs 1)) = 
+                     (@BITVECTOR_LIST.bitOf (N.of_nat(length bs)) i0 
+                     (interp_form_hatom_bv a (N.of_nat (length bs))))).
+Proof. intros.
+       specialize (@prop_checkbb a bs 0 (length bs)).
+       intros Hp.
+       cut ((i0 - 0)%nat = i0%nat).
+       intro Hc.
+       cut (Datatypes.length bs = (Datatypes.length bs - 0)%nat).
+       intro Hc2.
+       specialize (@Hp Hc2 H i0).
+       cut ( (0 <= i0 < Datatypes.length bs)%nat). intro Hc3.
+       specialize (@Hp Hc3).
+       now rewrite Hc in Hp.
+       omega. omega. omega.
+Qed.
+
+
+Lemma eq_rec: forall (n: N) (a b: BITVECTOR_LIST.bitvector n), BITVECTOR_LIST.bv a = BITVECTOR_LIST.bv b 
+                         ->
+                          a = b.
+Proof. intros. destruct a, b. 
+       unfold BITVECTOR_LIST.bv in H.
+       revert wf0.
+       rewrite H. intros.
+       now rewrite (proof_irrelevance wf0 wf1).
+Qed.
+
+Lemma nth_eq0: forall i a b xs ys,
+nth (S i) (a :: xs) false = nth (S i) (b :: ys) false -> nth i xs false = nth i ys false.
+Proof. intros.
+       now simpl in H.
+Qed.
+
+Lemma nth_eq: forall (a b: list bool), (length a) = (length b) -> 
+ (forall (i: nat), 
+ (i < length a)%nat ->
+ nth i a false = nth i b false) -> a = b.
+Proof. intros a.
+       induction a as [ | a xs IHxs].
+       - intros. simpl in *. symmetry in H.
+         now rewrite empty_list_length in H.
+       - intros [ | b ys] H0.
+         + simpl in *. now contradict H0.
+         + specialize (@IHxs ys).
+           inversion H0. specialize (@IHxs H1).
+           intros.         
+           pose proof (@H 0%nat). simpl in H2.
+           cut ((0 < S (Datatypes.length xs))%nat). intro HS.
+           specialize (@H2 HS). rewrite H2; apply f_equal.
+           apply IHxs. intros. apply (@nth_eq0 i a b xs ys).
+           apply H. simpl. omega. omega.
+Qed.
+
+Lemma is_even_0: is_even 0 = true.
+Proof. apply refl_equal. Qed.
+
+Lemma rho_1: Lit.interp rho 1 = false.
+Proof. unfold Lit.interp.
+       unfold Lit.is_pos.
+       simpl.
+       cut (is_even 1 = false). intro Hev. rewrite Hev.
+       unfold Var.interp.
+       destruct wf_rho. unfold Lit.blit.
+       cut (1 >> 1 = 0). intros Heq0. rewrite Heq0. 
+       unfold negb. now rewrite H.
+       easy. easy.
+Qed.
+
+Lemma rho_false: Lit.interp rho false = true.
+Proof. unfold Lit.interp.
+       unfold Lit.is_pos.
+       simpl.
+       cut (is_even 0 = true). intro Hev. rewrite Hev.
+       unfold Var.interp.
+       destruct wf_rho. simpl. unfold Lit.blit.
+       cut (0 >> 1 = 0). intros Heq0. rewrite Heq0. exact H.
+       now rewrite lsr_0_l.
+       apply is_even_0.
+Qed.
+
+Lemma bitOf_of_bits: forall l (a: BITVECTOR_LIST.bitvector (N.of_nat (length l))), 
+                               (forall i, 
+                               (i < (length l))%nat ->
+                               nth i l false = 
+                               (@BITVECTOR_LIST.bitOf (N.of_nat (length l)) i a))
+                               ->
+                               (BITVECTOR_LIST.bv_eq a (BITVECTOR_LIST.of_bits l)).
+Proof. intros l a H.
+       unfold BITVECTOR_LIST.of_bits in *.
+       unfold BITVECTOR_LIST.bitOf in *.
+       unfold BITVECTOR_LIST.bv_eq, BITVECTOR_LIST.bv in *.
+       unfold RAWBITVECTOR_LIST.bitOf in *.
+       destruct a.
+       unfold RAWBITVECTOR_LIST.of_bits.
+       unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits in *.
+       rewrite wf0.       
+       rewrite N.eqb_compare.
+       rewrite N.compare_refl.
+       cut (Datatypes.length l = Datatypes.length bv). intro wf1.
+
+       apply (@nth_eq l bv wf1) in H.
+
+       rewrite H.
+       unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits in *.
+       rewrite RAWBITVECTOR_LIST.List_eq_refl; auto.
+       apply inj_iff in wf0. now do 2 rewrite id' in wf0.
+
+Qed.
+
+Lemma valid_check_bbVar lres : C.valid rho (check_bbVar lres).
+Proof.
+      unfold check_bbVar.
+      case_eq (Lit.is_pos lres); intro Heq1; [ |now apply C.interp_true].
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bs Heq0.
+      case_eq (check_bb a bs 0 (Datatypes.length bs)); intro Heq2; [ |now apply C.interp_true].
+      unfold C.valid. simpl. rewrite orb_false_r.
+      unfold Lit.interp. rewrite Heq1.
+      unfold Var.interp.
+      rewrite wf_interp_form; trivial. rewrite Heq0. simpl.
+      apply bitOf_of_bits. intros. 
+      cut (Lit.interp rho 1 = false). intro Hr. rewrite <- Hr. 
+      rewrite map_nth.
+      remember (@prop_checkbb' a bs Heq2 i).
+      rewrite map_length in H.
+      rewrite map_length.
+      clear Heqe.
+      now apply e in H.
+      now apply rho_1.
+Qed.
+
+Lemma check_bbc_length : forall bv bs, check_bbc bv bs = true -> length bv = length bs.
+Proof.
+  intro bv. induction bv.
+  intro bs. case bs.
+  simpl; trivial.
+  simpl; easy.
+  intro bs. case bs in *.
+  simpl; easy.
+  simpl.
+  case (Lit.is_pos i); try easy.
+  case (t_form .[ Lit.blit i]); try easy;
+  case a; try easy; intro Hc; apply IHbv in Hc; now rewrite Hc.
+Qed.
+
+Lemma nth_nil : forall A i (d:A), nth i [] d = d.
+Proof.
+  intros. unfold nth. case i; trivial.
+Qed.
+
+Lemma prop_check_bbc: forall bv bs,
+                     (check_bbc bv bs = true) ->
+                     (forall i, (i < (length bs) )%nat ->
+                     (Lit.interp rho (nth i bs 1)) = nth i bv false).
+Proof.
+  intro bv. induction bv.
+  intros bs. case bs. 
+  intros.
+  do 2 rewrite nth_nil. easy.
+  simpl. easy.
+  intros bs.
+  case bs. simpl. easy.
+  intros b l Hc i Hlen.
+  case i in *.
+  simpl.
+  simpl in Hc.
+  case_eq (Lit.is_pos b).
+  intro Hposb.
+  rewrite Hposb in Hc.
+  case_eq (t_form .[ Lit.blit b]); try (intros; rewrite H in Hc; now contradict Hc).
+  intros Hb.
+  rewrite Hb in Hc.
+  generalize (rho_interp (Lit.blit b)). rewrite Hb. simpl.
+  intro Hbb.
+  unfold Lit.interp, Var.interp.
+  rewrite Hbb, Hposb.
+  case a in *.
+  trivial. now contradict Hc.
+  intro Hb.
+  rewrite Hb in Hc.
+  generalize (rho_interp (Lit.blit b)). rewrite Hb. simpl.
+  intro Hbb.
+  unfold Lit.interp, Var.interp.
+  rewrite Hbb, Hposb.
+  case a in *.
+  now contradict Hc. trivial.
+  intro Hposb. rewrite Hposb in Hc. now contradict Hc.
+  simpl.
+  apply IHbv.
+  simpl in Hc.
+  case (Lit.is_pos b) in Hc; try now contradict Hc.
+  case (t_form .[ Lit.blit b]) in Hc; try now contradict Hc.
+  case a in Hc; try now contradict Hc. exact Hc.
+  case a in Hc; try now contradict Hc. exact Hc.
+  simpl in Hlen. omega.
+Qed.
+
+Lemma prop_check_bbc2: forall l bs, check_bbc l bs = true ->
+RAWBITVECTOR_LIST.beq_list l (map (Lit.interp rho) bs) = true.
+Proof. intro l.
+       induction l as [ | xl xsl IHl ].
+       - intros. simpl in *.
+         case bs in *. now simpl. now contradict H.
+       - intros. simpl in H.
+         case bs in *. now contradict H.
+         simpl.
+         case_eq (Lit.is_pos i); intros.
+         rewrite H0 in H.
+         case_eq (t_form .[ Lit.blit i]); intros; try (rewrite H1 in H; now contradict H).
+         rewrite H1 in H.
+         case xl in *.
+         rewrite andb_true_iff. split.
+         unfold Lit.interp. rewrite H0.
+         unfold Var.interp.
+         specialize (rho_interp (Lit.blit i)).
+         rewrite H1 in rho_interp. simpl in rho_interp.
+         rewrite rho_interp. easy.
+         apply IHl; easy.
+         now contradict H.
+         rewrite H1 in H.
+         case xl in *. now contradict H.
+         rewrite andb_true_iff.
+         split.
+         specialize (rho_interp (Lit.blit i)).
+         rewrite H1 in rho_interp. simpl in rho_interp.
+         unfold Lit.interp. rewrite H0.
+         unfold Var.interp.
+         rewrite rho_interp. easy.
+         apply IHl; easy.
+         rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma valid_check_bbConst lres : C.valid rho (check_bbConst lres).
+Proof.
+  unfold check_bbConst.
+  case_eq (Lit.is_pos lres); intro Heq1; [ |now apply C.interp_true].
+  case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+  intros a bs Heq0.
+  case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+  intros c Ha.
+  case_eq c; try (intros; now apply C.interp_true).
+  intros l N Hc.
+  case_eq (check_bbc l bs &&
+      (N.of_nat (Datatypes.length l) =? N)%N);
+  try (intros; now apply C.interp_true).
+  intro Hcheck.
+  unfold C.valid. simpl. rewrite orb_false_r.
+  unfold Lit.interp. rewrite Heq1.
+  unfold Var.interp.
+  rewrite wf_interp_form; trivial. rewrite Heq0. simpl.
+
+  assert (Hinterpa:
+            (interp_form_hatom_bv a = interp_bv t_i (interp_atom (t_atom .[a])))).
+  {
+    unfold Atom.interp_form_hatom_bv.
+    unfold Atom.interp_hatom.
+    rewrite !Atom.t_interp_wf; trivial.
+  }
+    rewrite Hinterpa.
+    rewrite Ha, Hc. simpl.
+
+ unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+ assert ((N.of_nat (Datatypes.length (map (Lit.interp rho) bs))) = N).
+  {
+    rewrite andb_true_iff in Hcheck.
+    destruct Hcheck as (Hcheck1 & Hcheck2).
+    apply check_bbc_length in Hcheck1.
+    rewrite N.eqb_eq in Hcheck2.
+    rewrite Hcheck1 in Hcheck2.
+    now rewrite map_length.
+  }
+
+ generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs)
+        ).
+
+ rewrite H.
+ intros.
+
+ rewrite Typ.N_cast_refl.
+
+  unfold BITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bv_eq.
+  simpl.
+  unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST._of_bits.
+
+ rewrite andb_true_iff in Hcheck.
+ destruct Hcheck as (Hcheck1 & Hcheck2).
+ pose proof Hcheck1.
+ apply check_bbc_length in Hcheck1.
+ rewrite N.eqb_eq in Hcheck2.
+ rewrite Hcheck2.
+ rewrite N.eqb_refl.
+ rewrite Hcheck1, map_length, N.eqb_refl.
+ unfold RAWBITVECTOR_LIST.bits.
+
+ now apply prop_check_bbc2.
+Qed.
+
+Lemma prop_check_not:
+  forall bs br, length bs = length br ->
+           check_not bs br = true ->
+           map (Lit.interp rho) br = map (fun l => negb (Lit.interp rho l)) bs.
+Proof.
+  intro bs; induction bs; intros br Hlen Hcheck.
+  - simpl in Hlen. symmetry in Hlen. apply empty_list_length in Hlen. rewrite Hlen; now simpl.
+  - case br in *.
+    + simpl in Hcheck; now contradict Hcheck.
+    + simpl in Hlen. inversion Hlen as [Hlen'].
+      simpl in Hcheck. rewrite andb_true_iff in Hcheck; destruct Hcheck as (Hcheck1, Hcheck2).
+      apply Int63Properties.eqb_spec in Hcheck1; rewrite Hcheck1.
+      simpl. rewrite Lit.interp_neg. apply f_equal.
+      apply IHbs; auto.
+Qed.
+
+Lemma check_not_length:
+  forall bs br, check_not bs br = true -> length bs = length br.
+Proof.
+  intro bs; induction bs; intros br Hcheck.
+  - case br in *.
+    + auto.
+    + simpl in Hcheck; now contradict Hcheck.
+  - case br in *.
+    + simpl in Hcheck; now contradict Hcheck.
+    + simpl in *.
+      rewrite andb_true_iff in Hcheck.
+      destruct Hcheck as (_, Hcheck').
+      apply IHbs in Hcheck'; auto.
+Qed.
+
+Lemma valid_check_bbNot pos lres : C.valid rho (check_bbNot pos lres).
+Proof.
+  unfold check_bbNot.
+  case_eq (S.get s pos); [ (intros; now apply C.interp_true) | ].
+  intros l ls Hpos.
+  case_eq ls; [ | (intros; now apply C.interp_true) ].
+  intro Hnil.
+  case_eq (Lit.is_pos l && Lit.is_pos lres); [ | (intros; now apply C.interp_true) ].
+  intro Hpos'.
+  case_eq (t_form .[ Lit.blit l]); try (intros; now apply C.interp_true).
+  intros a bs HBl.
+  case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+  intros r br HBr.
+  case_eq (t_atom .[ r]); try (intros; now apply C.interp_true).
+  intros u a'.
+  case_eq u; try (intros; now apply C.interp_true).
+  intros n Huot Hr.
+  case_eq ((a == a')
+             && check_not bs br
+             && (N.of_nat (Datatypes.length bs) =? n)%N);
+    try (intros; now apply C.interp_true).
+  intro Hc.
+  rewrite !andb_true_iff in Hc.
+  destruct Hc as ((Ha, Hcheck), Hlen).
+  rewrite N.eqb_eq in Hlen.
+  apply Int63Properties.eqb_spec in Ha.
+  generalize (Hs pos).
+  rewrite Hpos, Hnil.
+  unfold C.valid, C.interp; simpl; rewrite !orb_false_r.
+  unfold Lit.interp, Var.interp.
+  rewrite andb_true_iff in Hpos'.
+  destruct Hpos' as (Hposl, Hposlres).
+  rewrite Hposl, Hposlres.
+  rewrite !rho_interp. rewrite HBl, HBr. simpl.
+
+  intro Heqa.
+  apply BITVECTOR_LIST.bv_eq_reflect in Heqa.
+  apply BITVECTOR_LIST.bv_eq_reflect.
+
+
+  generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+  rewrite PArray.forallbi_spec;intros.
+
+  pose proof (H r). 
+  assert (r < PArray.length t_atom).
+  {
+    apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Hr. easy.
+  }
+
+  specialize (@H0 H1). rewrite Hr in H0. simpl in H0.
+  rewrite !andb_true_iff in H0. destruct H0.
+
+  unfold get_type' in H0. unfold v_type in H0.
+  case_eq (t_interp .[ r]).
+  intros v_typer v_valr Htir. rewrite Htir in H0.
+  case_eq (v_typer); intros; rewrite H3 in H0; try (now contradict H1).
+  rename H3 into Hv.
+
+  (* interp_form_hatom_bv r = 
+          interp_bv t_i (interp_atom (t_atom .[r])) *)
+  assert (interp_form_hatom_bv r = 
+          interp_bv t_i (interp_atom (t_atom .[r]))).
+  {
+    unfold Atom.interp_form_hatom_bv.
+    unfold Atom.interp_hatom.
+    rewrite !Atom.t_interp_wf; trivial.
+  }
+
+  rewrite H3, Hr. simpl.
+  unfold interp_bv.
+  apply Typ.eqb_spec in H2.
+  unfold get_type' in H2.
+  unfold v_type in H2.
+  case_eq (t_interp .[ a']).
+  intros. rewrite H4 in H2. simpl.
+
+  revert v_val0 H4.  
+  rewrite H2. intros.
+  rewrite Typ.cast_refl.
+  simpl.
+
+  assert ( (N.of_nat (Datatypes.length (map (Lit.interp rho) br))) = n).
+  {
+    apply check_not_length in Hcheck. rewrite Hcheck in Hlen.
+    now rewrite map_length.
+  }
+
+  unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+  generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) br)
+        ).
+
+  rewrite H5.
+  intros.
+  rewrite Typ.N_cast_refl.
+  unfold BITVECTOR_LIST.bv_not, RAWBITVECTOR_LIST.bv_not.
+
+  apply eq_rec.
+  simpl.
+
+  rewrite <- Ha in *.
+
+   (* interp_form_hatom_bv a = 
+          interp_bv t_i (interp_atom (t_atom .[a])) *)
+  assert (interp_form_hatom_bv a = 
+          interp_bv t_i (interp_atom (t_atom .[a]))).
+  {
+    unfold Atom.interp_form_hatom_bv.
+    unfold Atom.interp_hatom.
+    rewrite !Atom.t_interp_wf; trivial.
+  }
+
+  rewrite H6 in Heqa.
+  unfold interp_bv in Heqa.
+  rewrite <- !Atom.t_interp_wf in Heqa; trivial.
+  rewrite H4 in Heqa.
+  revert Heqa . 
+
+  assert ( (N.of_nat (Datatypes.length (map (Lit.interp rho) bs))) = n).
+  {
+    now rewrite map_length.
+  }
+
+  unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+  generalize (
+         BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs)
+        ).
+
+  rewrite H7.
+  rewrite Typ.cast_refl. intros.
+  rewrite Heqa. simpl.
+
+  specialize (@prop_check_not bs br). intros.
+  symmetry.
+  unfold RAWBITVECTOR_LIST.bits.
+  rewrite map_map; apply H8; auto.
+
+  now apply check_not_length in Hcheck.
+
+Qed.
+
+Lemma eq_head: forall {A: Type} a b (l: list A), (a :: l) = (b :: l) <-> a = b.
+Proof. intros A a b l; split; [intros H; inversion H|intros ->]; auto. Qed.
+
+Axiom afold_left_and : forall a, 
+      afold_left bool int true andb (Lit.interp rho) a = List.forallb (Lit.interp rho) (to_list a).
+
+  Axiom afold_left_or : forall a,
+    afold_left bool int false orb (Lit.interp rho) a =
+    C.interp rho (to_list a).
+
+  Axiom afold_left_xor : forall a,
+    afold_left bool int false xorb (Lit.interp rho) a =
+    C.interp rho (to_list a).
+
+Lemma eqb_spec : forall x y, (x == y) = true <-> x = y.
+Proof.
+ split;auto using eqb_correct, eqb_complete.
+Qed.
+
+Lemma to_list_two: forall {A:Type} (a: PArray.array A), 
+       PArray.length a = 2 -> (to_list a) = a .[0] :: a .[1] :: nil.
+Proof. intros A a H.
+       rewrite to_list_to_list_ntr. unfold to_list_ntr.
+       rewrite H.
+       cut (0 == 2 = false). intro H1.
+       rewrite H1.
+       unfold foldi_ntr. rewrite foldi_cont_lt; auto.
+       auto.
+Qed.
+
+Lemma check_symopp_and: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N,
+      check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVand N) = true ->
+      check_symopp xbs1 ybs2 zbsres (BO_BVand (N-1)) = true.
+Proof. intros.
+       induction N. simpl.
+       simpl in H. 
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case (PArray.length a == 2) in H.
+       case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)
+         || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H.
+       exact H.
+       now contradict H.
+       now contradict H.
+       now contradict H.
+       unfold check_symopp in H.
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case (PArray.length a == 2) in H.
+       case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)
+        || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H.
+       apply H.
+       now contradict H.
+       now contradict H.
+       now contradict H.
+Qed.
+
+Lemma check_symopp_or: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N,
+      check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVor N) = true ->
+      check_symopp xbs1 ybs2 zbsres (BO_BVor (N-1)) = true.
+Proof. intros.
+       induction N. simpl.
+       simpl in H. 
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case (PArray.length a == 2) in H.
+       case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)
+         || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H.
+       exact H.
+       now contradict H.
+       now contradict H.
+       now contradict H.
+       unfold check_symopp in H.
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case (PArray.length a == 2) in H.
+       case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)
+        || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H.
+       apply H.
+       now contradict H.
+       now contradict H.
+       now contradict H.
+Qed.
+
+Lemma check_symopp_xor: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N,
+      check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVxor N) = true ->
+      check_symopp xbs1 ybs2 zbsres (BO_BVxor (N-1)) = true.
+Proof. intros.
+       induction N. simpl.
+       simpl in H. 
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H.
+       exact H.
+       now contradict H.
+       now contradict H.
+       unfold check_symopp in H.
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H.
+       apply H.
+       now contradict H.
+       now contradict H.
+Qed.
+
+Lemma check_symopp_bvand: forall bs1 bs2 bsres N, 
+  let n := length bsres in
+  (length bs1 = n)%nat -> 
+  (length bs2 = n)%nat -> 
+  check_symopp bs1 bs2 bsres (BO_BVand N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 andb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)).
+Proof. intro bs1.
+         induction bs1 as [ | ibs1 xbs1 IHbs1].
+         - intros. simpl in *. rewrite <- H0 in H.
+           rewrite <- H in H0. unfold n in H0.
+           symmetry in H0.
+           rewrite empty_list_length in H0.
+           unfold map. now rewrite H0.
+         - intros [ | ibs2 ybs2].
+           + intros.
+             simpl in *. now contradict H1.
+           + intros [ | ibsres zbsres ].
+             * intros. simpl in *. now contradict H.
+             * intros. simpl.
+               specialize (IHbs1 ybs2 zbsres (N-1)%N). 
+               rewrite IHbs1. rewrite eq_head.
+               unfold Lit.interp, Var.interp.
+               case_eq (Lit.is_pos ibsres); intro Heq0.
+               case_eq (Lit.is_pos ibs1); intro Heq1.
+               case_eq (Lit.is_pos ibs2); intro Heq2.
+               rewrite wf_interp_form; trivial.
+               simpl in H1.
+               rewrite Heq0 in H1.
+               case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_and.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+             (*   apply length_to_list in H4. *)
+                unfold forallb.
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_true_r.
+                intros. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)).
+                intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6.
+                rewrite H5, H6. rewrite andb_true_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_comm.
+                intros. rewrite H5 in H1. now contradict H1.
+                intros. rewrite H3 in H1. now contradict H1.
+
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_and.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+                unfold forallb.
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_true_r.
+                intros H4. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7. rewrite andb_true_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_comm.
+                intros. rewrite H5 in H1. now contradict H1.
+                intros. rewrite H3 in H1. now contradict H1.
+
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+               case_eq (Lit.is_pos ibs2).
+               intro Heq2.
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_and.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+                unfold forallb.
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_true_r.
+                intros. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7. rewrite andb_true_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite andb_comm.
+                intros. rewrite H5 in H1. now contradict H1.
+                intros. rewrite H3 in H1. now contradict H1.
+
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              intros.
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H3 in H1. simpl.
+               rewrite afold_left_and.
+
+               case_eq (PArray.length a == 2). intros H5.
+                rewrite H5 in H1.
+                rewrite eqb_spec in H5.
+                apply to_list_two in H5.
+                unfold forallb.
+                rewrite H5.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H6.
+                rewrite andb_true_iff in H6. destruct H6 as (H6 & H7).
+                rewrite eqb_spec in H6, H7. rewrite H6, H7.
+                unfold Lit.interp.
+                rewrite Heq1, H2.
+                unfold Var.interp. now rewrite andb_true_r.
+                intros H6. rewrite H6 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H7.
+                rewrite andb_true_iff in H7. destruct H7 as (H7 & H8).
+                rewrite eqb_spec in H7, H8.
+                rewrite H7, H8. rewrite andb_true_r.
+                unfold Lit.interp.
+                rewrite Heq1, H2.
+                unfold Var.interp. now rewrite andb_comm.
+                intros. rewrite H4 in H1. now contradict H1.
+                intros. rewrite H4 in H1. now contradict H1.
+
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              rewrite Heq0 in H1. now contradict H1.
+              now inversion H.
+              now inversion H0.
+              apply (@check_symopp_and ibs1 ibs2 xbs1 ybs2 ibsres zbsres N).
+              exact H1.
+Qed.
+
+
+Lemma check_symopp_bvor: forall bs1 bs2 bsres N, 
+  let n := length bsres in
+  (length bs1 = n)%nat -> 
+  (length bs2 = n)%nat -> 
+  check_symopp bs1 bs2 bsres (BO_BVor N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 orb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)).
+Proof. intro bs1.
+         induction bs1 as [ | ibs1 xbs1 IHbs1].
+         - intros. simpl in *. rewrite <- H0 in H.
+           rewrite <- H in H0. unfold n in H0.
+           symmetry in H0.
+           rewrite empty_list_length in H0.
+           unfold map. now rewrite H0.
+         - intros [ | ibs2 ybs2].
+           + intros.
+             simpl in *. now contradict H1.
+           + intros [ | ibsres zbsres ].
+             * intros. simpl in *. now contradict H.
+             * intros. simpl.
+               specialize (IHbs1 ybs2 zbsres (N-1)%N). 
+               rewrite IHbs1. rewrite eq_head.
+               unfold Lit.interp, Var.interp.
+               case_eq (Lit.is_pos ibsres); intro Heq0.
+               case_eq (Lit.is_pos ibs1); intro Heq1.
+               case_eq (Lit.is_pos ibs2); intro Heq2.
+               rewrite wf_interp_form; trivial.
+               simpl in H1.
+               rewrite Heq0 in H1.
+               case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_or.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+                unfold forallb.
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold C.interp. unfold existsb. rewrite orb_false_r.
+
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                now unfold Var.interp.
+
+                intros. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)).
+                intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6.
+                rewrite H5, H6. rewrite orb_false_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite orb_comm.
+                intros. rewrite H5 in H1. now contradict H1.
+                intros. rewrite H3 in H1. now contradict H1.
+
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_or.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+                unfold C.interp.
+                unfold existsb.
+
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite orb_false_r.
+                intros H4. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7. rewrite orb_false_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite orb_comm.
+                intros. rewrite H5, Heq0 in H1. now contradict H1.
+                intros. rewrite H3, Heq0 in H1. now contradict H1.
+
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+               case_eq (Lit.is_pos ibs2).
+               intro Heq2.
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+               rewrite afold_left_or.
+
+                case_eq (PArray.length a == 2). intros. rewrite H3 in H1.
+                rewrite eqb_spec in H3.
+                apply to_list_two in H3.
+                unfold forallb.
+                rewrite H3.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold C.interp, existsb.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite orb_false_r.
+                intros. rewrite H4 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7. rewrite orb_false_r.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite orb_comm.
+                intros. rewrite Heq0, H5 in H1. now contradict H1.
+                intros. rewrite Heq0, H3 in H1. now contradict H1.
+
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              intros.
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H3 in H1. simpl.
+               rewrite afold_left_or.
+
+               case_eq (PArray.length a == 2). intros H5.
+                rewrite H5 in H1.
+                rewrite eqb_spec in H5.
+                apply to_list_two in H5.
+                unfold forallb.
+                rewrite H5.
+                case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H6.
+                rewrite andb_true_iff in H6. destruct H6 as (H6 & H7).
+                rewrite eqb_spec in H6, H7. rewrite H6, H7.
+                unfold C.interp, Lit.interp, existsb.
+                rewrite Heq1, H2.
+                unfold Var.interp. now rewrite orb_false_r.
+                intros H6. rewrite H6 in H1. simpl in *.
+                case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H7.
+                rewrite andb_true_iff in H7. destruct H7 as (H7 & H8).
+                rewrite eqb_spec in H7, H8.
+                rewrite H7, H8. rewrite orb_false_r.
+                unfold Lit.interp.
+                rewrite Heq1, H2.
+                unfold Var.interp. now rewrite orb_comm.
+                intros. rewrite Heq0, H4 in H1. now contradict H1.
+                intros. rewrite Heq0, H4 in H1. now contradict H1.
+
+              rewrite Heq0 in H1.
+              try (intros a Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              rewrite Heq0 in H1.
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              rewrite Heq0 in H1. now contradict H1.
+              now inversion H.
+              now inversion H0.
+              apply (@check_symopp_or ibs1 ibs2 xbs1 ybs2 ibsres zbsres N).
+              exact H1.
+Qed.
+
+
+Lemma check_symopp_bvxor: forall bs1 bs2 bsres N, 
+  let n := length bsres in
+  (length bs1 = n)%nat -> 
+  (length bs2 = n)%nat -> 
+  check_symopp bs1 bs2 bsres (BO_BVxor N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 xorb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)).
+Proof. intro bs1.
+         induction bs1 as [ | ibs1 xbs1 IHbs1].
+         - intros. simpl in *. rewrite <- H0 in H.
+           rewrite <- H in H0. unfold n in H0.
+           symmetry in H0.
+           rewrite empty_list_length in H0.
+           unfold map. now rewrite H0.
+         - intros [ | ibs2 ybs2].
+           + intros.
+             simpl in *. now contradict H1.
+           + intros [ | ibsres zbsres ].
+             * intros. simpl in *. now contradict H.
+             * intros. simpl.
+               specialize (IHbs1 ybs2 zbsres (N-1)%N). 
+               rewrite IHbs1. rewrite eq_head.
+               unfold Lit.interp, Var.interp.
+               case_eq (Lit.is_pos ibsres); intro Heq0.
+               case_eq (Lit.is_pos ibs1); intro Heq1.
+               case_eq (Lit.is_pos ibs2); intro Heq2.
+               rewrite wf_interp_form; trivial.
+               simpl in H1.
+               rewrite Heq0 in H1.
+               case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               intros. rewrite H2 in H1. simpl.
+                case_eq ((i == ibs1) && (i0 == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                now unfold Var.interp.
+
+                intros H4. rewrite H4 in H1. simpl in *.
+                case_eq ((i == ibs2) && (i0 == ibs1)).
+                intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6.
+                rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite xorb_comm.
+                intros. rewrite H3 in H1. now contradict H1.
+
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+              try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+
+               intros. rewrite H2 in H1. simpl.
+                case_eq ((i == ibs1) && (i0 == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                now unfold Var.interp.
+                intros H4. rewrite Heq0, H4 in H1. simpl in *.
+                case_eq ((i == ibs2) && (i0 == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite xorb_comm.
+                intros. rewrite H3 in H1. now contradict H1.
+
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+               case_eq (Lit.is_pos ibs2).
+               intro Heq2.
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+              rewrite Heq0 in H1.
+              case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+
+               intros. rewrite H2 in H1. simpl.
+
+                case_eq ((i == ibs1) && (i0 == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                now unfold Var.interp.
+                intros H4. rewrite Heq0, H4 in H1. simpl in *.
+                case_eq ((i == ibs2) && (i0 == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite xorb_comm.
+                intros. rewrite H3 in H1. now contradict H1.
+
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+               intro Heq2.
+               rewrite wf_interp_form; trivial. simpl in H1.
+               case_eq (t_form .[ Lit.blit ibsres]).
+               rewrite Heq0 in H1.
+               case_eq (t_form .[ Lit.blit ibsres]).
+               try (intros i Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               intros. contradict H3. discriminate.
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+               rewrite Heq0 in H1.
+               try (intros a Heq; rewrite Heq in H1; now contradict H1).
+
+               intros. rewrite H2 in H1. simpl.
+                case_eq ((i == ibs1) && (i0 == ibs2)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H5 & H6).
+                rewrite eqb_spec in H5, H6. rewrite H5, H6.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                now unfold Var.interp.
+                intros H4. rewrite Heq0, H4 in H1. simpl in *.
+                case_eq ((i == ibs2) && (i0 == ibs1)). intros H5.
+                rewrite andb_true_iff in H5. destruct H5 as (H6 & H7).
+                rewrite eqb_spec in H6, H7.
+                rewrite H6, H7.
+                unfold Lit.interp.
+                rewrite Heq1, Heq2.
+                unfold Var.interp. now rewrite xorb_comm.
+                intros. rewrite H3 in H1. now contradict H1.
+                rewrite Heq0 in H1.
+                try (intros i i0 Heq; rewrite Heq in H1; now contradict H1).
+                rewrite Heq0 in H1.                
+                try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1).
+                rewrite Heq0 in H1.                
+                try (intros i l Heq; rewrite Heq in H1; now contradict H1).
+
+              rewrite wf_interp_form; trivial. simpl in H1.
+              rewrite Heq0 in H1. now contradict H1.
+              now inversion H.
+              now inversion H0.
+              apply (@check_symopp_xor ibs1 ibs2 xbs1 ybs2 ibsres zbsres N).
+              exact H1.
+Qed.
+
+Lemma check_symopp_bvand_length: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVand N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case (PArray.length a == 2) in H; try easy.
+  case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+
+Lemma check_symopp_bvand_length2: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVand N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case (PArray.length a == 2) in H; try easy.
+  case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+Lemma check_symopp_bvand_length3: forall bs1 bs2 bsres n,
+  check_symopp bs1 bs2 bsres (BO_BVand (N.of_nat n)) = true ->
+  (length bs1 = n)%nat ->
+  (length bsres = n)%nat.
+Proof. intros bs1 bs2 bsres.
+       revert bs1 bs2.
+       induction bsres as [ | xbsres xsbsres IHbsres ].
+       - intros.
+         case bs1 in *.
+           simpl in H. 
+           case bs2 in *.
+             easy. now contradict H.
+           case bs2 in *.
+            simpl in H. now contradict H.
+            simpl in H. now contradict H.
+       - intros.
+         case bs1 in *. 
+         simpl in H.
+         case bs2 in *.
+           now contradict H.
+           now contradict H.
+           simpl in H.
+           case bs2 in *.
+             now contradict H.
+             case (Lit.is_pos xbsres) in *.
+             case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H.
+             case (PArray.length a == 2) in *.
+             case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in *.
+             specialize (IHbsres bs1 bs2 (n-1)%nat).
+             simpl in H0.
+             assert (length bs1 = (n-1)%nat).
+             { omega. }
+
+             cut ( (BO_BVand (N.of_nat n - 1)) = (BO_BVand (N.of_nat (n - 1)))).
+
+             intros.
+             revert H.
+             rewrite H2.
+             intros.
+             specialize (IHbsres H H1).
+             simpl. rewrite IHbsres. omega.
+
+             simpl.
+             cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))).
+             intros. now rewrite H2.
+
+            case n. now simpl.
+            intros. lia.
+             now contradict H.
+             now contradict H.
+             now contradict H.
+Qed.
+
+Lemma check_symopp_bvor_length: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVor N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case (PArray.length a == 2) in H; try easy.
+  case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+Lemma check_symopp_bvor_length2: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVor N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case (PArray.length a == 2) in H; try easy.
+  case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+Lemma check_symopp_bvor_length3: forall bs1 bs2 bsres n,
+  check_symopp bs1 bs2 bsres (BO_BVor (N.of_nat n)) = true ->
+  (length bs1 = n)%nat ->
+  (length bsres = n)%nat.
+Proof. intros bs1 bs2 bsres.
+       revert bs1 bs2.
+       induction bsres as [ | xbsres xsbsres IHbsres ].
+       - intros.
+         case bs1 in *.
+           simpl in H. 
+           case bs2 in *.
+             easy. now contradict H.
+           case bs2 in *.
+            simpl in H. now contradict H.
+            simpl in H. now contradict H.
+       - intros.
+         case bs1 in *. 
+         simpl in H.
+         case bs2 in *.
+           now contradict H.
+           now contradict H.
+           simpl in H.
+           case bs2 in *.
+             now contradict H.
+             case (Lit.is_pos xbsres) in *.
+             case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H.
+             case (PArray.length a == 2) in *.
+             case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in *.
+             specialize (IHbsres bs1 bs2 (n-1)%nat).
+             simpl in H0.
+             assert (length bs1 = (n-1)%nat).
+             { omega. }
+
+             cut ( (BO_BVor (N.of_nat n - 1)) = (BO_BVor (N.of_nat (n - 1)))).
+
+             intros.
+             revert H.
+             rewrite H2.
+             intros.
+             specialize (IHbsres H H1).
+             simpl. rewrite IHbsres. omega.
+
+             simpl.
+             cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))).
+             intros. now rewrite H2.
+
+            case n. now simpl.
+            intros. lia.
+             now contradict H.
+             now contradict H.
+             now contradict H.
+Qed.
+
+Lemma check_symopp_bvxor_length: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVxor N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+
+Lemma check_symopp_bvxor_length2: forall bs1 bs2 bsres N,
+  let n := length bsres in
+  check_symopp bs1 bs2 bsres (BO_BVxor N) = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 N H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in H; try easy.
+  specialize (IHrbsres bs1 bs2 (N - 1)%N H).
+  simpl.
+  simpl in n.
+  fold n' in n.
+  unfold n.
+  split; apply f_equal. easy. easy.
+  easy.
+Qed.
+
+Lemma check_symopp_bvxor_length3: forall bs1 bs2 bsres n,
+  check_symopp bs1 bs2 bsres (BO_BVxor (N.of_nat n)) = true ->
+  (length bs1 = n)%nat ->
+  (length bsres = n)%nat.
+Proof. intros bs1 bs2 bsres.
+       revert bs1 bs2.
+       induction bsres as [ | xbsres xsbsres IHbsres ].
+       - intros.
+         case bs1 in *.
+           simpl in H. 
+           case bs2 in *.
+             easy. now contradict H.
+           case bs2 in *.
+            simpl in H. now contradict H.
+            simpl in H. now contradict H.
+       - intros.
+         case bs1 in *. 
+         simpl in H.
+         case bs2 in *.
+           now contradict H.
+           now contradict H.
+           simpl in H.
+           case bs2 in *.
+             now contradict H.
+             case (Lit.is_pos xbsres) in *.
+             case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H.
+             case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in *.
+             specialize (IHbsres bs1 bs2 (n-1)%nat).
+             simpl in H0.
+             assert (length bs1 = (n-1)%nat).
+             { omega. }
+
+             cut ( (BO_BVxor (N.of_nat n - 1)) = (BO_BVxor (N.of_nat (n - 1)))).
+
+             intros.
+             revert H.
+             rewrite H2.
+             intros.
+             specialize (IHbsres H H1).
+             simpl. rewrite IHbsres. omega.
+
+             simpl.
+             cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))).
+             intros. now rewrite H2.
+
+            case n. now simpl.
+            intros. lia.
+            now contradict H.
+            now contradict H.
+Qed.
+
+Lemma check_symopp_bvand_nl: forall bs1 bs2 bsres N, 
+  check_symopp bs1 bs2 bsres (BO_BVand N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 andb (List.map (Lit.interp rho) bs1)
+                          (List.map (Lit.interp rho) bs2)).
+Proof.
+  intros.
+  pose proof H.
+  apply check_symopp_bvand_length in H.
+  destruct H.
+  apply check_symopp_bvand in H0. easy. easy. easy.
+Qed.
+
+Lemma check_symopp_bvor_nl: forall bs1 bs2 bsres N, 
+  check_symopp bs1 bs2 bsres (BO_BVor N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 orb (List.map (Lit.interp rho) bs1)
+                          (List.map (Lit.interp rho) bs2)).
+Proof.
+  intros.
+  pose proof H.
+  apply check_symopp_bvor_length in H.
+  destruct H.
+  apply check_symopp_bvor in H0. easy. easy. easy.
+Qed.
+
+Lemma check_symopp_bvxor_nl: forall bs1 bs2 bsres N, 
+  check_symopp bs1 bs2 bsres (BO_BVxor N) = true ->
+  (List.map (Lit.interp rho) bsres) = 
+  (RAWBITVECTOR_LIST.map2 xorb (List.map (Lit.interp rho) bs1)
+                          (List.map (Lit.interp rho) bs2)).
+Proof.
+  intros.
+  pose proof H.
+  apply check_symopp_bvxor_length in H.
+  destruct H.
+  apply check_symopp_bvxor in H0. easy. easy. easy.
+Qed.
+
+Lemma valid_check_bbOp pos1 pos2 lres: C.valid rho (check_bbOp pos1 pos2 lres).
+Proof.
+      unfold check_bbOp.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9;
+        try (intros; now apply C.interp_true).
+      (* BVand *)
+      - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1'));
+          simpl; intros Heq10; try (now apply C.interp_true).
+
+        case_eq (
+                 check_symopp bs1 bs2 bsres (BO_BVand N) &&
+                 (N.of_nat (Datatypes.length bs1) =? N)%N); 
+        simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Atom.t_interp_wf; trivial.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } 
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop. rewrite Htia1, Htia2.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea).
+          intros i j Hv. rewrite Hv in H0. now contradict H0.
+          intros i Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros n Hv. rewrite Hv in H0.
+
+        (** n = N **)
+        apply N.eqb_eq in H0.
+        rewrite <- H0 in *.
+        revert v_vala Htia. rewrite Hv.
+        intros v_vala Htia.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        revert v_vala1 Htia1 v_vala2 Htia2.
+        rewrite H2, H3.
+        unfold bvtrue.
+        rewrite Typ.cast_refl.
+
+        intros v_vala1 Htia1 v_vala2 Htia2.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite orb_true_iff in Heq10.
+        do 2 rewrite andb_true_iff in Heq10.
+        destruct Heq10 as [Heq10 | Heq10];
+          destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2.
+        rewrite Heq10a1, Heq10a2 in *.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        rewrite Htia1 in HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        simpl in HSp2.
+        rewrite Htia2 in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvand_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 andb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_and_length 
+          (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          now rewrite map_length.
+          apply check_symopp_bvand_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+       }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 andb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_and, RAWBITVECTOR_LIST.bv_and.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvand_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. easy.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+
+        (** symmetric case*)
+        rewrite Heq10a1, Heq10a2 in *.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+       }
+
+        rewrite H4 in HSp2.
+        rewrite Htia1 in HSp2.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp1.
+        simpl in HSp1.
+        rewrite Htia2 in HSp1.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvand_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 andb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_and_length 
+          (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          apply check_symopp_bvand_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite map_length.
+          apply check_symopp_bvand_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 andb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_and, RAWBITVECTOR_LIST.bv_and.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvand_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. 
+        now rewrite RAWBITVECTOR_LIST.map2_and_comm.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+
+      (* BVor *)
+      - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); 
+           simpl; intros Heq10; try (now apply C.interp_true).
+
+        case_eq (
+                 check_symopp bs1 bs2 bsres (BO_BVor N) &&
+                 (N.of_nat (Datatypes.length bs1) =? N)%N); 
+        simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Atom.t_interp_wf; trivial.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop. rewrite Htia1, Htia2.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea).
+          intros i j Hv. rewrite Hv in H0. now contradict H0.
+          intros i Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros n Hv. rewrite Hv in H0.
+
+        (** n = N **)
+        apply N.eqb_eq in H0.
+        rewrite <- H0 in *.
+        revert v_vala Htia. rewrite Hv.
+        intros v_vala Htia.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        revert v_vala1 Htia1 v_vala2 Htia2.
+        rewrite H2, H3.
+        unfold bvtrue.
+        rewrite Typ.cast_refl.
+
+        intros v_vala1 Htia1 v_vala2 Htia2.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite orb_true_iff in Heq10.
+        do 2 rewrite andb_true_iff in Heq10.
+        destruct Heq10 as [Heq10 | Heq10];
+          destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2.
+        rewrite Heq10a1, Heq10a2 in *.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        rewrite Htia1 in HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        simpl in HSp2.
+        rewrite Htia2 in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvor_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 orb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        rewrite andb_true_iff in Heq11.
+        {
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_or_length 
+            (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          now rewrite map_length.
+          apply check_symopp_bvor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 orb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_or, RAWBITVECTOR_LIST.bv_or.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. easy.
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+
+       (** symmetric case*)
+        rewrite Heq10a1, Heq10a2 in *.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp2.
+        rewrite Htia1 in HSp2.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp1.
+        simpl in HSp1.
+        rewrite Htia2 in HSp1.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvor_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 orb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        rewrite andb_true_iff in Heq11.
+        {
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_or_length 
+            (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          apply check_symopp_bvor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite map_length.
+          apply check_symopp_bvor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 orb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_or, RAWBITVECTOR_LIST.bv_or.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. 
+        now rewrite RAWBITVECTOR_LIST.map2_or_comm.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+
+        (** BVxor **)
+        - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); 
+            simpl; intros Heq10; try (now apply C.interp_true).
+
+        case_eq (
+                 check_symopp bs1 bs2 bsres (BO_BVxor N) &&
+                 (N.of_nat (Datatypes.length bs1) =? N)%N); 
+        simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite Atom.t_interp_wf; trivial.
+        rewrite Atom.t_interp_wf; trivial.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a).
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop. rewrite Htia1, Htia2.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea).
+          intros i j Hv. rewrite Hv in H0. now contradict H0.
+          intros i Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros Hv. rewrite Hv in H0. now contradict H0.
+          intros n Hv. rewrite Hv in H0.
+
+        (** n = N **)
+        apply N.eqb_eq in H0.
+        rewrite <- H0 in *.
+        revert v_vala Htia. rewrite Hv.
+        intros v_vala Htia.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        revert v_vala1 Htia1 v_vala2 Htia2.
+        rewrite H2, H3.
+        unfold bvtrue.
+        rewrite Typ.cast_refl.
+
+        intros v_vala1 Htia1 v_vala2 Htia2.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite orb_true_iff in Heq10.
+        do 2 rewrite andb_true_iff in Heq10.
+        destruct Heq10 as [Heq10 | Heq10];
+          destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2.
+        rewrite Heq10a1, Heq10a2 in *.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+          rewrite H4 in HSp1.
+          rewrite Htia1 in HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        simpl in HSp2.
+        rewrite Htia2 in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvxor_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 xorb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        rewrite andb_true_iff in Heq11.
+        {
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_xor_length 
+            (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          now rewrite map_length.
+          apply check_symopp_bvxor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 xorb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_xor, RAWBITVECTOR_LIST.bv_xor.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvxor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. easy.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+
+       (** symmetric case*)
+        rewrite Heq10a1, Heq10a2 in *.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp2.
+        rewrite Htia1 in HSp2.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2'
+        = 
+        interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp1.
+        simpl in HSp1.
+        rewrite Htia2 in HSp1.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+        unfold Bval, interp_bv.
+
+        rewrite (@check_symopp_bvxor_nl bs1 bs2 bsres N).
+
+        assert (
+          H100: (N.of_nat
+            (Datatypes.length
+               (RAWBITVECTOR_LIST.map2 xorb (map (Lit.interp rho) bs1)
+                  (map (Lit.interp rho) bs2)))) = N).
+        rewrite andb_true_iff in Heq11.
+        {
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          specialize (@RAWBITVECTOR_LIST.map2_xor_length 
+            (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)).
+          intros. rewrite <- H6.
+          apply check_symopp_bvxor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite map_length.
+          apply check_symopp_bvxor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          now rewrite !map_length, Heq11a, Heq11b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        generalize (
+          BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 xorb 
+          (map (Lit.interp rho) bs1) 
+          (map (Lit.interp rho) bs2))
+        ).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+
+        unfold BITVECTOR_LIST.bv_xor, RAWBITVECTOR_LIST.bv_xor.
+        unfold RAWBITVECTOR_LIST.size.
+        unfold RAWBITVECTOR_LIST.bits.
+
+        unfold interp_bv in HSp1, HSp2.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2.
+
+        assert (
+          H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_symopp_bvxor_length2 in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite <- Heq11a in Heq11b.
+          rewrite <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp2.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)
+        ).
+
+        rewrite H101. intros.
+
+        assert (
+        H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        revert HSp1.
+
+        generalize (
+        BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)
+        ).
+
+        rewrite H102. intros.
+
+        rewrite Typ.cast_refl in *.
+        rewrite HSp1, HSp2. simpl.
+        apply eq_rec. simpl.
+        rewrite H101, H102.
+        rewrite N.eqb_compare, N.compare_refl. 
+        now rewrite RAWBITVECTOR_LIST.map2_xor_comm.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11, Heq11r).
+        exact Heq11.
+Qed.
+
+Lemma check_symopp_eq: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres n,
+      check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_eq (Typ.TBV n)) = true ->
+      check_symopp xbs1 ybs2 zbsres (BO_eq (Typ.TBV n))  = true.
+Proof. intros.
+       simpl in H. 
+       case (Lit.is_pos ibsres) in H.
+       case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy).
+       case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H.
+       exact H.
+       now contradict H.
+       now contradict H.
+Qed.
+
+Lemma bool_eqb_comm: forall ibs1 ibs2,  Bool.eqb ibs1 ibs2 = Bool.eqb ibs2 ibs1.
+Proof. intros. case_eq ibs1. intros. case_eq ibs2. intros. easy. intros. easy. intros. easy. Qed.
+
+Lemma check_symopp_eq': forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres n,
+      check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_eq (Typ.TBV n)) = true ->
+      Bool.eqb (Lit.interp rho ibs1) (Lit.interp rho ibs2) = Lit.interp rho ibsres.
+Proof. intros.
+       simpl in H.
+       case_eq (Lit.is_pos ibsres). intros. rewrite H0 in H.
+       case_eq (t_form .[ Lit.blit ibsres]); intros; rewrite H1 in H; try (now contradict H).
+       specialize (@rho_interp ( Lit.blit ibsres)).
+       rewrite H1 in rho_interp. simpl in rho_interp.
+       case_eq ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)).
+       intros. rewrite orb_true_iff in H2. destruct H2.
+       rewrite andb_true_iff in H2. destruct H2. rewrite eqb_spec in H2, H3.
+       rewrite H2, H3 in rho_interp.
+       rewrite <- rho_interp. unfold Lit.interp. rewrite H0. now unfold Var.interp.
+       intros. rewrite andb_true_iff in H2. destruct H2. rewrite eqb_spec in H2, H3.
+       rewrite H2, H3 in rho_interp. rewrite bool_eqb_comm in rho_interp.
+       rewrite <- rho_interp. unfold Lit.interp. rewrite H0. now unfold Var.interp.
+       intros. rewrite H2 in H. now contradict H.
+       intros. rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma  check_symopp_bveq: forall bs1 bs2 a4 n, check_symopp bs1 bs2 (to_list a4) (BO_eq (Typ.TBV n)) = true ->
+                          RAWBITVECTOR_LIST.beq_list (map (Lit.interp rho) bs1)
+                          (map (Lit.interp rho) bs2) = forallb (Lit.interp rho) (to_list a4).
+Proof. intros. revert bs1 bs2 H.
+       induction (to_list a4) as [ | xa4 xsa4 IHa4].
+       - intros.
+         case_eq bs1. intros. rewrite H0 in H.
+         case_eq bs2. intros. rewrite H1 in H.
+         simpl. easy.
+         intros. rewrite H1 in H. simpl in H. now contradict H.
+         intros. rewrite H0 in H. simpl in H.
+         case_eq bs2. intros. rewrite H1 in H. now contradict H.
+         intros. rewrite H1 in H. now contradict H.
+       - intros. unfold check_symopp in H.
+         case_eq bs1. intros. rewrite H0 in H.
+         case_eq bs2. intros. rewrite H1 in H. now contradict H.
+         intros. rewrite H1 in H. now contradict H.
+         intros. fold check_symopp in H.
+         case_eq bs2. intros. rewrite H1 in H. simpl in H.
+         rewrite H0 in H. simpl in H. now contradict H. 
+         intros. rewrite H0, H1 in H.
+         pose proof H. apply check_symopp_eq' in H2.
+         apply check_symopp_eq in H.
+         specialize (IHa4 l l0 H). simpl. rewrite IHa4.
+         case (forallb (Lit.interp rho) xsa4); [ do 2 rewrite andb_true_r | now do 2 rewrite andb_false_r].
+         exact H2.
+Qed.
+
+Lemma beq_list_comm: forall bs1 bs2, RAWBITVECTOR_LIST.beq_list bs2 bs1 =  
+                                     RAWBITVECTOR_LIST.beq_list bs1 bs2.
+Proof. intro bs1. 
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros. case bs2. easy.
+         intros. easy.
+       - intros. case bs2. easy.
+         intros.  simpl.
+         specialize (@IHbs1 l). rewrite IHbs1.
+         case (RAWBITVECTOR_LIST.beq_list xsbs1 l). do 2 rewrite andb_true_r.
+         unfold Bool.eqb.
+         case b. easy. easy.
+         now do 2 rewrite andb_false_r.
+Qed.
+
+Lemma prop_check_eq: forall bs1 bs2 bsres,
+      (length bs1) = (length bs2) ->
+      check_eq bs1 bs2 bsres = true ->
+      forallb2 Bool.eqb (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) =
+      forallb (Lit.interp rho) bsres.
+Proof. intro bs1.
+  induction bs1 as [ | x1 bs1 IHbs1 ].
+  - intros bs2 bsres Hlen Hcheck.
+    case bs2 in *.
+    + case bsres in *.
+      * now simpl.
+      * contradict Hcheck; now simpl.
+    + contradict Hcheck; now simpl.
+  - intros bs2 bsres Hlen Hcheck.
+    symmetry.
+    case bs2 in *.
+    + case bsres in *; contradict Hcheck; now simpl.
+    + case bsres in *.
+      * contradict Hcheck; now simpl.
+      * simpl.
+        rename i into x2. rename i0 into r1.
+        simpl in Hlen. inversion Hlen.
+        rename H0 into Hlen'.
+
+        case bsres in *.
+        (*--*) simpl in Hcheck.
+           case_eq (Lit.is_pos r1); intros; rewrite H in Hcheck;
+           try (case bs1 in *; try (now contradict Hcheck); case bs2 in *;
+                try (now contradict Hcheck));
+           rename H into Hposr1;
+           case_eq (t_form .[ Lit.blit r1]);intros; rewrite H in Hcheck; try (now contradict Hcheck); 
+           rename H into Hform_r1;
+           generalize (rho_interp (Lit.blit r1)); rewrite Hform_r1; simpl;
+           intro Hi.
+           (*++*) rename i into arg1; rename i0 into arg2.
+              unfold Lit.interp at 1, Var.interp at 1.
+              rewrite Hposr1, Hi. repeat (rewrite andb_true_r).
+              case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)).
+              (* ** *) intros Hif.
+                 rewrite orb_true_iff in Hif.
+                 repeat (rewrite andb_true_iff in Hif).
+                 repeat (rewrite eqb_spec in Hif).
+                 destruct Hif as [ Hif1 | Hif2 ].
+                (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2.
+                (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2.
+                     now rewrite bool_eqb_comm.
+             (* ** *)intros Hif. rewrite Hif in Hcheck. now contradict Hcheck.
+
+           (* ++ *)
+             case_eq (to_list a);
+                intros; rewrite H in Hcheck; try (now contradict Hcheck).
+              rename H into Ha, i1 into a1, l into rargs.
+              case_eq (Lit.is_pos a1);
+                intros; rewrite H in Hcheck; try (now contradict Hcheck).
+              rename H into Hposa1.
+              case_eq (t_form .[ Lit.blit a1]);
+                intros; rewrite H in Hcheck; try (now contradict Hcheck).
+              rename H into Hform_a1.
+              rename i into x1', i0 into x2', i1 into arg1, i2 into arg2.
+              generalize (rho_interp (Lit.blit a1)). rewrite Hform_a1. simpl.
+              intro Heqx1x2.
+              rewrite afold_left_and in Hi.
+              rewrite Ha in Hi. simpl in Hi.
+              unfold Lit.interp at 1, Var.interp at 1.
+              rewrite Hposr1, Hi. repeat (rewrite andb_true_r).
+              unfold Lit.interp at 1, Var.interp at 1.
+              rewrite Hposa1. rewrite Heqx1x2.
+
+              case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)).
+              (* ** *) intros Hif.
+                 rewrite Hif in Hcheck.
+                 apply (@IHbs1 _ _ Hlen') in Hcheck.
+                 simpl in Hcheck. rewrite Hcheck.
+                 repeat (rewrite orb_true_iff in Hif).
+                 repeat (rewrite andb_true_iff in Hif).
+                 repeat (rewrite eqb_spec in Hif).
+                 destruct Hif as [ Hif1 | Hif2 ].
+                (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2.
+                (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2.
+                     now rewrite bool_eqb_comm.
+              (* ** *) intros Hif. rewrite Hif in Hcheck. now contradict Hcheck.
+
+       (* -- *) simpl in Hcheck.
+           case_eq (Lit.is_pos r1); intros; rewrite H in Hcheck;
+           try (case bs1 in *; try (now contradict Hcheck); case bs2 in *;
+                try (now contradict Hcheck));
+           rename H into Hposr1;
+           case_eq (t_form .[ Lit.blit r1]);intros; rewrite H in Hcheck; try (now contradict Hcheck); 
+           rename H into Hform_r1;
+           generalize (rho_interp (Lit.blit r1)); rewrite Hform_r1; simpl;
+           intro Hi.
+          (* ++ *) contradict Hcheck. simpl.
+              case ((i0 == x1) && (i1 == x2) || (i0 == x2) && (i1 == x1)); easy.
+          (* ++ *) rename i0 into x1', i1 into x2', i2 into arg1, i3 into arg2.
+              unfold Lit.interp at 1, Var.interp at 1.
+              rewrite Hposr1, Hi.
+              case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)).
+             (* ** *) intros Hif. rewrite Hif in Hcheck.
+                 apply (@IHbs1 _ _ Hlen') in Hcheck.
+                 simpl in Hcheck. rewrite Hcheck.
+                 repeat (rewrite orb_true_iff in Hif).
+                 repeat (rewrite andb_true_iff in Hif).
+                 repeat (rewrite eqb_spec in Hif).
+                 destruct Hif as [ Hif1 | Hif2 ].
+                (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2.
+                (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2.
+                     now rewrite bool_eqb_comm.
+            (*  ** *) intros Hif. rewrite Hif in Hcheck. now contradict Hcheck.
+Qed.
+
+Lemma length_check_eq: forall bs1 bs2 bsres,
+  check_eq bs1 bs2 bsres = true -> length bs1 = length bs2.
+Proof.
+  intro bs1.
+  induction bs1.
+  + intros. case bs2 in *. trivial.
+    simpl in H. now contradict H.
+  + intros.
+    case bs2 in *.
+    - simpl in H. now contradict H.
+    - simpl. apply f_equal.
+      simpl in H.
+      revert H.
+      case bsres. easy.
+      intros r rl.
+      case rl.
+      case (Lit.is_pos r).
+      case (t_form .[ Lit.blit r]); try easy.
+      intro a0.
+      case bs1 in *; try easy; case bs2; try easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      intros i1 l a0.
+      case (to_list a0); try easy.
+      intros i2 l0.
+      case (Lit.is_pos i2); try easy.
+      case (t_form .[ Lit.blit i2]); try easy.
+      intros i3 i4.
+      case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)).
+      apply IHbs1.
+      easy.
+      intros _ _ i2 l0 a0.
+      case (to_list a0); try easy.
+      intros i1 l.
+      case (Lit.is_pos i1); try easy.
+      case (t_form .[ Lit.blit i1]); try easy.
+      intros i3 i4.
+      case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)).
+      apply IHbs1.
+      easy.
+      intros i2 l0 a0.
+      case (to_list a0); try easy.
+      intros i9 l.
+      case (Lit.is_pos i9); try easy.
+      case (t_form .[ Lit.blit i9]); try easy.
+      intros i3 i4.
+      case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)).
+      apply IHbs1.
+      easy.
+      intros _ _ i2 l0 a0.
+      case (to_list a0); try easy.
+      intros i9 l.
+      case (Lit.is_pos i9); try easy.
+      case (t_form .[ Lit.blit i9]); try easy.
+      intros i3 i4.
+      case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)).
+      apply IHbs1.
+      easy.
+      case bs1; try easy; case bs2; easy.
+      case bs1; try easy; case bs2; easy.
+      case bs1; try easy; case bs2; easy.
+      case bs1; try easy; case bs2.
+
+      simpl. easy.
+
+      intros i0 l i1 i2.
+      case ((i1 == a) && (i2 == i) || (i1 == i) && (i2 == a)); easy.
+      simpl.
+      intros _ l i1 i2.
+      case ((i1 == a) && (i2 == i) || (i1 == i) && (i2 == a)); easy.
+      easy.
+      case bs1 in *; try easy; case bs2; easy.
+      case bs1 in *; try easy; case bs2; easy.
+      case bs1 in *; try easy; case bs2; easy.
+      case bs1 in *; try easy; case bs2; try easy.
+      case (Lit.is_pos r); try easy.
+      case (t_form .[ Lit.blit r]); try easy.
+      simpl. intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)); easy.
+      case (Lit.is_pos r); try easy.
+      case (t_form .[ Lit.blit r]); try easy.
+      simpl. intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)); easy.
+      case (Lit.is_pos r); try easy.
+      case (t_form .[ Lit.blit r]); try easy.
+      intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)).
+      intros x2 rbs2 xr rbrs.
+      apply IHbs1. easy.
+Qed.
+
+Lemma valid_check_bbEq pos1 pos2 lres : C.valid rho (check_bbEq pos1 pos2 lres).
+  Proof.
+       unfold check_bbEq.
+       case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+       case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+       case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+       case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+       case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+       case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8.
+       case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12.
+       case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10.
+       case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true).
+
+       intros [ | | | | | | | [ A B | A | | | |n]|N|N|N|N|N|N|N|N|N| | | | ]; 
+          try (intros; now apply C.interp_true).
+
+       intros a1' a2' Heq9.
+       case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); 
+         simpl; intros Heq15; try (now apply C.interp_true).
+
+       case_eq (check_eq bs1 bs2 [bsres] &&
+       (N.of_nat (Datatypes.length bs1) =? n)%N); 
+       simpl; intros Heq16; try (now apply C.interp_true).
+
+       unfold C.valid. simpl.
+       rewrite orb_false_r.
+       unfold Lit.interp. rewrite Heq5.
+       unfold Var.interp.
+       rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+       generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+       rewrite PArray.forallbi_spec;intros.
+
+       pose proof (H a3).
+       assert (a3 < PArray.length t_atom).
+       { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+       specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+       rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+       unfold get_type' in H0. unfold v_type in H0.
+       case_eq (t_interp .[ a3]).
+       intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0.
+
+       case_eq (v_typea3); intros; rewrite H4 in H0; try (now contradict H0).
+       rename H4 into Hv.
+
+       generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+       unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+       unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+       rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+       generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+       unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+       unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+       rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+       unfold get_type' in H2, H3. unfold v_type in H2, H3.
+       case_eq (t_interp .[ a1']).
+         intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+       case_eq (t_interp .[ a2']).
+         intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+       simpl in v_vala2, v_vala2.
+
+       apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+       (** case a1 = a1' and a2 = a2' **)
+       rewrite orb_true_iff in Heq15.
+       do 2 rewrite andb_true_iff in Heq15.
+       destruct Heq15 as [Heq15 | Heq15];
+       destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2
+       ;rewrite Heq15a1, Heq15a2 in *.
+
+        (* interp_form_hatom_bv a1' =  
+                 interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' =
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia1; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite !Atom.t_interp_wf in Htia1; trivial.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1.
+
+        (* interp_form_hatom_bv a2' =  
+                 interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' =
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia2; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite !Atom.t_interp_wf in Htia2; trivial.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+
+        rewrite H2, H3.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (
+        H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as (Heq16, Heq16r).
+          rewrite N.eqb_eq in Heq16r.
+          apply length_check_eq in Heq16.
+          rewrite Heq16 in Heq16r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl.
+
+        assert (
+        H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as (Heq16, Heq16r).
+          rewrite N.eqb_eq in Heq16r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite !Typ.cast_refl. intros.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+        apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)).
+
+        unfold Lit.interp, Var.interp.
+        rewrite rho_interp.
+        rewrite Heq10. simpl.
+
+        unfold Atom.interp_form_hatom.
+        unfold Atom.interp_hatom.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Htia1, Htia2. simpl.
+        rewrite Typ.N_cast_refl. simpl.
+
+        rewrite Form.wf_interp_form; trivial.
+        simpl.
+        apply Bool.eqb_prop in Heq12.
+        rewrite Heq12.
+        rewrite HSp1, HSp2.
+        simpl.
+
+        rewrite Typ.i_eqb_t. simpl.
+
+        unfold BITVECTOR_LIST.bv_eq.
+        unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bits.
+        unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        unfold RAWBITVECTOR_LIST.size.
+
+        case_eq (Lit.is_pos bsres).
+        intros Hpos.
+
+        rewrite andb_true_iff in Heq16.
+        destruct Heq16 as (Heq16 & Heq16r).
+        rewrite N.eqb_eq in Heq16r. simpl.
+        pose proof Heq16 as Heq16p.
+
+        apply length_check_eq in Heq16.
+        rewrite !map_length, Heq16.
+        rewrite N.eqb_compare, N.compare_refl.
+        pose proof (Heq16) as Hleq.
+
+        rewrite (@prop_check_eq _ _ [bsres]). simpl.
+        rewrite andb_true_r. unfold Lit.interp, Var.interp.
+        generalize (rho_interp (Lit.blit bsres)). simpl.
+        intro Hbres. rewrite Hbres. simpl.
+        rewrite Hpos.
+        simpl. now unfold Atom.interp_form_hatom, interp_hatom.
+        exact Hleq.
+
+        exact Heq16p.
+
+        intros Hpos.
+        rewrite andb_true_iff in Heq16.
+        destruct Heq16 as (Heq16 & Heq16r).
+
+        contradict Heq16.
+        case bs1 in *; try now simpl; case bs2 in *; now simpl.
+        case bs2 in *. simpl. easy.
+        simpl. rewrite Hpos. case bs1; intros; auto; case bs2; auto.
+
+        pose proof Heq16 as Heq16'.
+
+        rewrite andb_true_iff in Heq16.
+        destruct Heq16 as (Heq16 & Heq16r).
+        apply length_check_eq in Heq16; auto.
+
+       (** case symmetry **)
+
+
+        (* interp_form_hatom_bv a1' = 
+                 interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' =
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia1; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite !Atom.t_interp_wf in Htia1; trivial.
+        rewrite Htia1 in HSp2.
+        unfold interp_bv in HSp2.
+
+        (* interp_form_hatom_bv a2' =
+                 interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' =
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia2; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite !Atom.t_interp_wf in Htia2; trivial.
+        rewrite Htia2 in HSp1.
+        unfold interp_bv in HSp1.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+
+        rewrite H2, H3.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (
+        H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n
+        ).
+        {
+          rewrite N.eqb_eq in Heq16r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H100.
+        rewrite !Typ.cast_refl.
+
+        assert (
+        H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n
+        ).
+        {
+          rewrite N.eqb_eq in Heq16r.
+          rewrite Heq16 in Heq16r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl.
+
+        intros.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+        apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)).
+
+        unfold Lit.interp, Var.interp.
+        rewrite rho_interp.
+        rewrite Heq10. simpl.
+
+        unfold Atom.interp_form_hatom.
+        unfold Atom.interp_hatom.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Htia1, Htia2. simpl.
+        rewrite Typ.N_cast_refl. simpl.
+
+        rewrite Form.wf_interp_form; trivial.
+        simpl.
+        apply Bool.eqb_prop in Heq12.
+        rewrite Heq12.
+        rewrite HSp1, HSp2.
+        simpl.
+
+        rewrite Typ.i_eqb_t. simpl.
+
+        unfold BITVECTOR_LIST.bv_eq.
+        unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bits.
+        unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        unfold RAWBITVECTOR_LIST.size.
+
+        case_eq (Lit.is_pos bsres).
+        intros Hpos.
+
+        rewrite beq_list_comm.
+        rewrite !map_length, Heq16, N.eqb_compare, N.compare_refl.
+
+        rewrite (@prop_check_eq _ _ [bsres]). simpl.
+        rewrite andb_true_r. unfold Lit.interp, Var.interp.
+        generalize (rho_interp (Lit.blit bsres)). simpl.
+        intro Hbres. rewrite Hbres.
+
+        rewrite andb_true_iff in Heq16'.
+        destruct Heq16' as (Heq16' & Heq16'r).
+        rewrite Hpos.
+        now unfold Atom.interp_form_hatom, interp_hatom.
+        intros. exact Heq16.
+
+        rewrite andb_true_iff in Heq16'.
+        destruct Heq16' as (Heq16' & Heq16'r).
+        exact Heq16'.
+
+        intros Hpos.
+        contradict Heq16'.
+        case bs1 in *; try now simpl; case bs2 in *; now simpl.
+        case bs2 in *; try now simpl; case bs2 in *; now simpl.
+        simpl. easy.
+        simpl.
+        case bs1 in *; try now simpl; case bs2 in *; now simpl.
+        rewrite Hpos.
+        case bs2 in *; try now simpl; case bs2 in *; now simpl.
+        now rewrite andb_false_l.
+
+        case bs2 in *; rewrite Hpos; simpl; easy.
+Qed.
+
+Lemma check_add_bvadd_length: forall bs1 bs2 bsres c,
+  let n := length bsres in
+  check_add bs1 bs2 bsres c = true ->
+  (length bs1 = n)%nat /\ (length bs2 = n)%nat .
+Proof.
+  intros.
+  revert bs1 bs2 c H.
+  induction bsres as [ | r rbsres ].
+  intros.
+  simpl in H.
+  case bs1 in *. simpl in H.
+  case bs2 in *. simpl in *. easy. easy.
+  case bs2 in *. simpl in *. easy.
+  simpl in *. easy.
+  intros.
+  case bs1 in *.
+  case bs2 in *.
+  simpl in *. easy.
+  simpl in *. easy.
+  case bs2 in *. simpl in *. easy.
+  set (n' := length rbsres).
+  fold n' in n, IHrbsres, H.
+  simpl in IHrbsres.
+  simpl in H.
+  case (Lit.is_pos r) in H.
+  case (t_form .[ Lit.blit r]) in H; try easy.
+  case (Lit.is_pos i1) in H.  
+  case (t_form .[ Lit.blit i1]) in H; try now contradict H.
+  rewrite andb_true_iff in H. destruct H.
+  specialize (IHrbsres bs1 bs2 ((Cor (Cand (Clit i) (Clit i0)) (Cand (Cxor (Clit i) (Clit i0)) c))) H0). 
+  simpl.
+  simpl in n.
+  split; apply f_equal. easy. easy.
+  easy. easy.
+Qed.
+
+Lemma prop_eq_carry_lit: forall c i, eq_carry_lit c i = true -> interp_carry c = (Lit.interp rho i).
+Proof. intro c.
+  induction c. 
+  - intros. simpl in *. 
+    case (Lit.is_pos i0 ) in H; rewrite eqb_spec in H; now rewrite H.
+  - intros. simpl. 
+    pose proof IHc1. pose proof IHc2.
+    simpl in H.
+    case_eq ( Lit.is_pos i). intros Hip0.
+    rewrite Hip0 in H.
+    case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H.
+    case_eq (PArray.length a == 2). intros Hl. rewrite Hl in H.
+    (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H.
+
+    specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp.
+    simpl in rho_interp.
+    rewrite afold_left_and in rho_interp.
+    rewrite eqb_spec in Hl.
+    apply to_list_two in Hl.
+    rewrite Hl in rho_interp.
+    simpl in rho_interp.
+    rewrite andb_true_r in rho_interp.
+
+    (* destruct H. *)
+    + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3.
+      unfold Lit.interp at 3. unfold Var.interp.
+      rewrite Hip0. now rewrite rho_interp.
+    (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *)
+    (*   unfold Lit.interp at 3. unfold Var.interp. *)
+    (*   rewrite Hip0. rewrite rho_interp. now rewrite andb_comm. *)
+    + intros. rewrite H3 in H. now contradict H.
+    + intros. rewrite H2 in H. now contradict H.
+
+  - intros. simpl. 
+    pose proof IHc1. pose proof IHc2.
+    simpl in H.
+    case_eq ( Lit.is_pos i). intros Hip0.
+    rewrite Hip0 in H.
+    case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H.
+    (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H.
+
+    specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp.
+    simpl in rho_interp.
+
+    (* destruct H. *)
+    + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3.
+      unfold Lit.interp at 3. unfold Var.interp.
+      rewrite Hip0. now rewrite rho_interp.
+    (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *)
+    (*   unfold Lit.interp at 3. unfold Var.interp. *)
+    (*   rewrite Hip0. rewrite rho_interp. now rewrite xorb_comm. *)
+    + intros. rewrite H2 in H. now contradict H.
+
+  - intros. simpl. 
+    pose proof IHc1. pose proof IHc2.
+    simpl in H.
+    case_eq ( Lit.is_pos i). intros Hip0.
+    rewrite Hip0 in H.
+    case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H.
+    case_eq (PArray.length a == 2). intros Hl. rewrite Hl in H.
+    (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H.
+
+    specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp.
+    simpl in rho_interp.
+    rewrite afold_left_or in rho_interp.
+    rewrite eqb_spec in Hl.
+    apply to_list_two in Hl.
+    rewrite Hl in rho_interp.
+    simpl in rho_interp.
+    rewrite orb_false_r in rho_interp.
+
+    (* destruct H. *)
+    + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3.
+      unfold Lit.interp at 3. unfold Var.interp.
+      rewrite Hip0. now rewrite rho_interp.
+    (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *)
+    (*   unfold Lit.interp at 3. unfold Var.interp. *)
+    (*   rewrite Hip0. rewrite rho_interp. now rewrite orb_comm. *)
+    + intros. rewrite H3 in H. now contradict H.
+    + intros. rewrite H2 in H. now contradict H.
+
+  - intros. simpl. 
+    pose proof IHc1. pose proof IHc2.
+    simpl in H.
+    case_eq ( Lit.is_pos i). intros Hip0.
+    rewrite Hip0 in H.
+    case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H.
+    (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H.
+
+    specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp.
+    simpl in rho_interp.
+
+    (* destruct H. *)
+    + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3.
+      unfold Lit.interp at 3. unfold Var.interp.
+      rewrite Hip0. now rewrite rho_interp.
+    (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *)
+    (*   unfold Lit.interp at 3. unfold Var.interp. *)
+    (*   rewrite Hip0. rewrite rho_interp. *)
+    (*   case_eq (Bool.eqb (Lit.interp rho i0) (Lit.interp rho i1)). *)
+    (*   intros. apply Bool.eqb_prop in H4. rewrite H4. apply Bool.eqb_reflx. *)
+    (*   intros. apply Bool.eqb_false_iff in H4. apply Bool.eqb_false_iff. unfold not in *. intro. symmetry in H5. *)
+    (*   apply H4; trivial. *)
+    + intros. rewrite H2 in H. now contradict H.
+Qed.
+
+
+
+Lemma map_cons T U (f: T -> U) (h: T) (l: list T): map f (h :: l) = f h :: map f l.
+Proof. auto. Qed.
+
+Lemma prop_check_ult: forall bs1 bs2, 
+  length bs1 = length bs2 ->
+  RAWBITVECTOR_LIST.ult_list_big_endian
+    (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)
+  = interp_carry (ult_big_endian_lit_list bs1 bs2).
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1 ].
+       - intros. simpl in *. 
+         symmetry in H; rewrite empty_list_length in H.
+         specialize (Lit.interp_false rho wf_rho).
+         intros. unfold is_true in H0; now rewrite not_true_iff_false in H0.
+       - intros.
+         case_eq bs2. intros. rewrite H0 in *. now contradict H.
+         intros. rewrite H0 in *.
+         inversion H.
+         rewrite !map_cons.
+         simpl.
+         case xsbs1 in *. simpl.
+         case l in *. simpl. now rewrite Lit.interp_neg.
+         now contradict H2.
+         case l in *. simpl.
+         now contradict H2. 
+         rewrite !map_cons.
+         unfold interp_carry.
+         fold interp_carry.
+         specialize (@IHbs1 (i1 :: l)).
+         rewrite !map_cons in IHbs1.
+         rewrite Lit.interp_neg.
+         now rewrite IHbs1.
+Qed.
+
+Lemma prop_check_slt: forall bs1 bs2, 
+  length bs1 = length bs2 ->
+  RAWBITVECTOR_LIST.slt_list_big_endian
+    (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)
+  = interp_carry (slt_big_endian_lit_list bs1 bs2).
+Proof. intros.
+       case bs1 in *. simpl.
+       specialize (Lit.interp_false rho wf_rho).
+         intros. unfold is_true in H0; now rewrite not_true_iff_false in H0.
+       case bs2 in *.
+         now contradict H.
+         rewrite !map_cons.
+         case bs1 in *. simpl.
+         case bs2 in *. simpl. now rewrite Lit.interp_neg. 
+         now contradict H.
+         case bs2 in  *.
+           now contradict H.
+           unfold slt_big_endian_lit_list.
+           unfold RAWBITVECTOR_LIST.slt_list_big_endian.
+           rewrite !map_cons.
+           unfold interp_carry.
+           fold interp_carry.
+           rewrite <- !map_cons.
+           rewrite Lit.interp_neg.
+           rewrite prop_check_ult.
+           now apply f_equal.
+           simpl.
+           now inversion H.
+Qed.
+
+Lemma prop_check_ult2: forall bs1 bs2 bsres,
+length bs1 = length bs2 ->
+check_ult bs1 bs2 bsres = true ->
+interp_carry (ult_big_endian_lit_list (rev bs1) (rev bs2)) = Lit.interp rho bsres.
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros.
+         case bs2 in *.
+         unfold check_ult in H0.
+         simpl in *.
+         case_eq (Lit.is_pos bsres). intros Hbsres.
+         rewrite Hbsres in H0.
+         case (Lit.is_pos bsres) in H0; rewrite eqb_spec in H0; now rewrite H0.
+         intros. rewrite H1 in H0. now contradict H0.
+
+         now contradict H.
+
+       - intros.
+         case bs2 in *.
+         now contradict H.
+         simpl.
+         unfold check_ult,ult_lit_list in H0.
+         simpl in H0.
+         case_eq (Lit.is_pos bsres). intros Hbsres.
+         rewrite Hbsres in H0.
+
+         now apply prop_eq_carry_lit.
+
+         intros. rewrite H1 in H0. now contradict H0.
+Qed.
+
+Lemma prop_check_slt2: forall bs1 bs2 bsres,
+length bs1 = length bs2 ->
+check_slt bs1 bs2 bsres = true ->
+interp_carry (slt_big_endian_lit_list (rev bs1) (rev bs2)) = Lit.interp rho bsres.
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros.
+         case bs2 in *.
+         unfold check_slt in H0.
+         simpl in *.
+         case_eq (Lit.is_pos bsres). intros Hbsres.
+         rewrite Hbsres in H0.
+         case (Lit.is_pos bsres) in H0; rewrite eqb_spec in H0; now rewrite H0.
+         intros. rewrite H1 in H0. now contradict H0.
+
+         now contradict H.
+
+       - intros.
+         case bs2 in *.
+         now contradict H.
+         simpl.
+         unfold check_slt, slt_lit_list in H0.
+         simpl in H0.
+         case_eq (Lit.is_pos bsres). intros Hbsres.
+         rewrite Hbsres in H0.
+         now apply prop_eq_carry_lit.
+
+         intros. rewrite H1 in H0. now contradict H0.
+Qed.
+
+Lemma prop_lit: forall bsres, 
+Lit.is_pos bsres = true ->
+Lit.interp 
+  (interp_state_var (fun a0 : int => interp_bool t_i (t_interp .[ a0]))
+     interp_form_hatom_bv t_form) bsres =
+Form.interp (fun a0 : int => interp_bool t_i (t_interp .[ a0]))
+  interp_form_hatom_bv t_form (t_form .[ Lit.blit bsres]).
+Proof. intros.
+       rewrite <- rho_interp.
+       simpl.
+       unfold Lit.interp, Var.interp.
+       rewrite H.
+       simpl. easy.
+Qed.
+
+Lemma prop_lit2: forall bsres, 
+Lit.is_pos bsres = false ->
+Lit.interp 
+  (interp_state_var (fun a0 : int => interp_bool t_i (t_interp .[ a0]))
+     interp_form_hatom_bv t_form) bsres =
+negb (Form.interp (fun a0 : int => interp_bool t_i (t_interp .[ a0]))
+  interp_form_hatom_bv t_form (t_form .[ Lit.blit bsres])).
+Proof. intros.
+       rewrite <- rho_interp.
+       simpl.
+       unfold Lit.interp, Var.interp.
+       rewrite H.
+       simpl. easy.
+Qed.
+
+Lemma valid_check_bbUlt pos1 pos2 lres : C.valid rho (check_bbUlt pos1 pos2 lres).
+Proof.
+      unfold check_bbUlt.
+       case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+       case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+       case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+       case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+       case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+       case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8.
+       case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12.
+       case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10.
+       case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true).
+
+       intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ]; 
+         try (intros; now apply C.interp_true).
+
+       intros a1' a2' Heq9.
+         case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq15; try (now apply C.interp_true).
+
+       case_eq (check_ult bs1 bs2 bsres &&
+          (N.of_nat (Datatypes.length bs1) =? N)%N &&
+          (N.of_nat (Datatypes.length bs2) =? N)%N); 
+       simpl; intros Heq16; try (now apply C.interp_true).
+
+       unfold C.valid. simpl.
+
+       rewrite orb_false_r.
+       unfold Lit.interp. rewrite Heq5.
+       unfold Var.interp.
+       rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+       generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+       rewrite PArray.forallbi_spec;intros.
+
+       pose proof (H a3).
+       assert (a3 < PArray.length t_atom).
+       { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+       specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+       rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+       unfold get_type' in H0. unfold v_type in H0.
+       case_eq (t_interp .[ a3]).
+       intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0.
+       case_eq (v_typea3);  intros; rewrite H4 in H0; try (now contradict H0).
+       rename H4 into Hv.
+
+       generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+       unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+       unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+       rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+       generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+       unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+       unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+       rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+       unfold get_type' in H2, H3. unfold v_type in H2, H3.
+       case_eq (t_interp .[ a1']).
+         intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+       case_eq (t_interp .[ a2']).
+         intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+       simpl in v_vala2, v_vala2.
+
+       apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+       (** case a1 = a1' and a2 = a2' **)
+       rewrite andb_true_iff in Heq15.
+       destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2
+       ;rewrite Heq15a1, Heq15a2 in *.
+
+
+        (* interp_form_hatom_bv a1' =
+                 interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' =
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia1; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite !Atom.t_interp_wf in Htia1; trivial.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1.
+
+        (* interp_form_hatom_bv a2' =
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' =
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia2; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite !Atom.t_interp_wf in Htia2; trivial.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+
+        rewrite H2, H3.
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (
+        H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as ((Heq16a, Heq16b), Heq16c).
+          rewrite N.eqb_eq in Heq16c.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H100.
+
+        assert (
+        H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as ((Heq16a, Heq16b), Heq16c).
+          rewrite N.eqb_eq in Heq16b.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).       
+
+        rewrite H101.
+
+        rewrite Typ.cast_refl in *.
+
+        intros.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+        apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)).
+
+        unfold Lit.interp, Var.interp.
+        rewrite rho_interp.
+        rewrite Heq10. simpl.
+
+        unfold Atom.interp_form_hatom.
+        unfold Atom.interp_hatom.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Htia1, Htia2. simpl.
+
+        rewrite Form.wf_interp_form; trivial.
+        simpl.
+        apply Bool.eqb_prop in Heq12.
+        rewrite Heq12.
+        rewrite HSp1, HSp2.
+
+        case_eq (Lit.is_pos bsres).
+        intros Hpos.
+
+        unfold BITVECTOR_LIST.bv_ult.
+        unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.bits.
+        unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        simpl.
+        unfold RAWBITVECTOR_LIST.size.
+        simpl.
+
+        rewrite !Typ.N_cast_refl.
+        rewrite !andb_true_iff in Heq16.
+        destruct Heq16 as ((Heq16 & Heq16l) & Heq16r).
+        rewrite N.eqb_eq in Heq16r, Heq16l.
+        rewrite map_length, Heq16l.
+        rewrite H100.
+        rewrite N.eqb_compare. rewrite N.compare_refl.
+
+        unfold RAWBITVECTOR_LIST.ult_list.
+        specialize (@prop_check_ult (List.rev bs1) (List.rev bs2)).
+        intros.
+
+        cut ( Datatypes.length (List.rev bs1) = Datatypes.length (List.rev bs2)).
+        intros. specialize (H6 H7).
+        do 2 rewrite <- List.map_rev.
+        rewrite H6.
+
+        pose proof (rho_interp).
+        specialize (H8 (Lit.blit a)).
+        rewrite Heq10 in H8.
+        simpl in H8.
+
+        rewrite !rev_length in H7.
+        specialize (@prop_check_ult2 bs1 bs2 bsres H7 Heq16).
+        intros.
+        rewrite H9.
+        simpl.       
+        unfold Atom.interp_form_hatom, interp_hatom.
+        simpl.
+        now rewrite prop_lit.
+
+        rewrite !rev_length.
+        apply (f_equal nat_of_N) in Heq16l.
+        apply (f_equal nat_of_N) in Heq16r.
+        rewrite Nat2N.id in Heq16l, Heq16r.
+        now rewrite Heq16l, Heq16r.
+
+        intros.
+        rewrite !andb_true_iff in Heq16.
+        destruct Heq16 as ((Heq16 & Heq16l) & Heq16r).
+        rewrite N.eqb_eq in Heq16r, Heq16l.
+
+        contradict Heq16.
+        unfold check_ult.
+        rewrite H6. easy.
+Qed.
+
+Lemma valid_check_bbSlt pos1 pos2 lres : C.valid rho (check_bbSlt pos1 pos2 lres).
+Proof.
+      unfold check_bbSlt.
+       case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+       case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+       case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+       case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+       case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+       case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+       case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8.
+       case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12.
+       case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10.
+       case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true).
+
+       intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; 
+          try (intros; now apply C.interp_true).
+
+       case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq15; try (now apply C.interp_true).
+
+       case_eq (check_slt bs1 bs2 bsres &&
+          (N.of_nat (Datatypes.length bs1) =? N)%N &&
+          (N.of_nat (Datatypes.length bs2) =? N)%N); 
+       simpl; intros Heq16; try (now apply C.interp_true).
+
+       unfold C.valid. simpl.
+
+       rewrite orb_false_r.
+       unfold Lit.interp. rewrite Heq5.
+       unfold Var.interp.
+       rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+       generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+       rewrite PArray.forallbi_spec;intros.
+
+       pose proof (H a3).
+       assert (a3 < PArray.length t_atom).
+       { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+       specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+       rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+       unfold get_type' in H0. unfold v_type in H0.
+       case_eq (t_interp .[ a3]).
+       intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0.
+       case_eq (v_typea3);  intros; rewrite H4 in H0; try (now contradict H0).
+       rename H4 into Hv.
+
+       generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+       unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+       unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+       rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+       generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+       unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+       unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+       rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+       unfold get_type' in H2, H3. unfold v_type in H2, H3.
+       case_eq (t_interp .[ a1']).
+         intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+       case_eq (t_interp .[ a2']).
+         intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+       simpl in v_vala2, v_vala2.
+
+       apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+       (** case a1 = a1' and a2 = a2' **)
+       rewrite andb_true_iff in Heq15.
+       destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2
+       ;rewrite Heq15a1, Heq15a2 in *.
+
+
+        (* interp_form_hatom_bv a1' =
+                 interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' =
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia1; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite !Atom.t_interp_wf in Htia1; trivial.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1.
+
+        (* interp_form_hatom_bv a2' =
+                 interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' =
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia2; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H5 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite !Atom.t_interp_wf in Htia2; trivial.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2.
+
+        generalize dependent v_vala1. generalize dependent v_vala2.
+        rewrite H2, H3. 
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (
+        H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as ((Heq16a, Heq16b), Heq16c).
+          rewrite N.eqb_eq in Heq16c.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H100.
+
+        assert (
+        H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N
+        ).
+        {
+          rewrite !andb_true_iff in Heq16.
+          destruct Heq16 as ((Heq16a, Heq16b), Heq16c).
+          rewrite N.eqb_eq in Heq16b.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).       
+
+        rewrite H101.
+
+        rewrite Typ.cast_refl in *.
+
+        intros.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+        apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)).
+
+        unfold Lit.interp, Var.interp.
+        rewrite rho_interp.
+        rewrite Heq10. simpl.
+
+        unfold Atom.interp_form_hatom.
+        unfold Atom.interp_hatom.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Heq9. simpl.
+        rewrite !Atom.t_interp_wf; trivial.
+        rewrite Htia1, Htia2. simpl.
+
+        rewrite Form.wf_interp_form; trivial.
+        simpl.
+        apply Bool.eqb_prop in Heq12.
+        rewrite Heq12.
+        rewrite HSp1, HSp2.
+
+        case_eq (Lit.is_pos bsres).
+        intros Hpos.
+
+        unfold BITVECTOR_LIST.bv_slt.
+        unfold RAWBITVECTOR_LIST.bv_slt, RAWBITVECTOR_LIST.bits.
+        unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+        simpl.
+        unfold RAWBITVECTOR_LIST.size.
+        simpl.
+
+        rewrite !Typ.N_cast_refl.
+        rewrite !andb_true_iff in Heq16.
+        destruct Heq16 as ((Heq16 & Heq16l) & Heq16r).
+        rewrite N.eqb_eq in Heq16r, Heq16l.
+        rewrite map_length, Heq16l.
+        rewrite H100.
+        rewrite N.eqb_compare. rewrite N.compare_refl.
+
+        unfold RAWBITVECTOR_LIST.slt_list.
+        specialize (@prop_check_slt (List.rev bs1) (List.rev bs2)).
+        intros.
+
+        cut ( Datatypes.length (List.rev bs1) = Datatypes.length (List.rev bs2)).
+        intros. specialize (H6 H7).
+        do 2 rewrite <- List.map_rev.
+        rewrite H6.
+
+        pose proof (rho_interp).
+        specialize (H8 (Lit.blit a)).
+        rewrite Heq10 in H8.
+        simpl in H8.
+
+        rewrite !rev_length in H7.
+        specialize (@prop_check_slt2 bs1 bs2 bsres H7 Heq16).
+        intros.
+        rewrite H9.
+        simpl.
+        unfold Atom.interp_form_hatom, interp_hatom.
+        simpl.
+        now rewrite prop_lit.
+
+        rewrite !rev_length.
+        apply (f_equal nat_of_N) in Heq16l.
+        apply (f_equal nat_of_N) in Heq16r.
+        rewrite Nat2N.id in Heq16l, Heq16r.
+        now rewrite Heq16l, Heq16r.
+
+        intros.
+        rewrite !andb_true_iff in Heq16.
+        destruct Heq16 as ((Heq16 & Heq16l) & Heq16r).
+        rewrite N.eqb_eq in Heq16r, Heq16l.
+
+        contradict Heq16.
+        unfold check_slt.
+        rewrite H6. easy.
+Qed.
+
+Lemma check_add_list:forall bs1 bs2 bsres c, 
+  let n := length bsres in
+  (length bs1 = n)%nat -> 
+  (length bs2 = n)%nat -> 
+  check_add bs1 bs2 bsres c ->
+                      (RAWBITVECTOR_LIST.add_list_ingr (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)
+                        (interp_carry c))
+                        =
+                        (map (Lit.interp rho) bsres).
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros. simpl in H1.
+         case_eq bs2. intros. rewrite H2 in H1. simpl.
+         case_eq bsres. intros. rewrite H3 in H1. now simpl.
+         intros. rewrite H3 in H1. now contradict H1.
+         intros. rewrite H2 in H1. now contradict H1.
+      - intros.
+        case_eq bs2. intros. rewrite H2 in H1. simpl in H1. now contradict H1.
+        intros. rewrite H2 in H1.
+        case_eq bsres. intros. rewrite H3 in H1. simpl in H1. now contradict H1.
+        intros. rewrite H3 in H1. simpl in H1.
+        case_eq ( Lit.is_pos i0). intros. rewrite H4 in H1.
+        case_eq ( t_form .[ Lit.blit i0]); intros; rewrite H5 in H1; try now contradict H.
+        case_eq ( Lit.is_pos i1). intros. rewrite H6 in H1.
+        case_eq ( t_form .[ Lit.blit i1]); intros; rewrite H7 in H1; try now contradict H.
+        unfold is_true in H1.
+        rewrite andb_true_iff in H1. destruct H1.
+        unfold n in *.
+        rewrite H3 in H.
+        rewrite H2, H3 in H0.
+        inversion H. inversion H0.
+
+        specialize 
+        (@IHbs1 l l0 
+        ((Cor (Cand (Clit xbs1) (Clit i)) (Cand (Cxor (Clit xbs1) (Clit i)) c)))
+        H10 H11 H8).
+
+        simpl in *. unfold RAWBITVECTOR_LIST.of_bits in IHbs1.
+        case_eq (RAWBITVECTOR_LIST.add_carry (Lit.interp rho xbs1) (Lit.interp rho i)
+        (interp_carry c)). intros r c0 Heqrc.
+
+        (** rho_interp Lit.blit i0 **)
+        pose proof (rho_interp (Lit.blit i0)).
+        rewrite H5 in H9. simpl in H9.
+
+        (** rho_interp Lit.blit i1 **)
+        pose proof (rho_interp (Lit.blit i1)).
+        rewrite H7 in H12. simpl in H12.
+
+        unfold Lit.interp at 3.
+        rewrite H4. unfold Var.interp. rewrite H9.
+        rewrite <- IHbs1.
+        simpl.
+        cut (r = xorb (Lit.interp rho i1) (Lit.interp rho i2)).
+        cut (c0 =  (Lit.interp rho xbs1 && Lit.interp rho i
+        || xorb (Lit.interp rho xbs1) (Lit.interp rho i) && interp_carry c)).
+        intros. now rewrite H13, H14.
+
+        (* c *)
+        case ((Lit.interp rho xbs1)) in *.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc. easy.
+        inversion Heqrc. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc. easy.
+        inversion Heqrc. easy.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc. easy.
+        inversion Heqrc. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc. easy.
+        inversion Heqrc. easy.
+
+        (* r *)
+        rewrite andb_true_iff in H1.
+        destruct H1.
+        rewrite orb_true_iff in H1.
+        destruct H1; rewrite andb_true_iff in H1; destruct H1.
+        rewrite eqb_spec in H1, H14. rewrite H1, H14 in *.
+
+        apply  prop_eq_carry_lit in H13. rewrite <- H13.
+
+        case ((Lit.interp rho xbs1)) in *.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy. 
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+
+        rewrite eqb_spec in H1, H14. rewrite H1, H14 in *.
+
+        apply  prop_eq_carry_lit in H13. rewrite <- H13.
+
+        case ((Lit.interp rho xbs1)) in *.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy. 
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((Lit.interp rho i)) in *.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        case ((interp_carry c)) in *.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+        inversion Heqrc.
+        unfold Lit.interp, Var.interp.
+        rewrite H6, H12. easy.
+
+        (** contradictions **)
+        intros. rewrite H6 in H1. now contradict H1.
+        intros. rewrite H4 in H1. now contradict H1.
+Qed.
+
+Lemma check_add_bvadd: forall bs1 bs2 bsres n, 
+  (N.of_nat(length bs1) = n)%N -> 
+  (N.of_nat(length bs2) = n)%N -> 
+  (N.of_nat(length bsres) = n)%N ->  
+  check_add bs1 bs2 bsres (Clit Lit._false) = true ->
+  (RAWBITVECTOR_LIST.bv_add (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) =
+   (map (Lit.interp rho) bsres)).
+Proof. intros.
+       pose proof H as H'. pose proof H0 as H0'. pose proof H1 as H1'.
+       rewrite <- H1 in H. apply Nat2N.inj in H.
+       rewrite <- H1 in H0. apply Nat2N.inj in H0.
+       specialize (@check_add_list bs1 bs2 bsres ( (Clit Lit._false)) H H0 H2). intros.
+       unfold RAWBITVECTOR_LIST.bv_add.
+       unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits.
+       unfold BITVECTOR_LIST.of_bits.
+       rewrite !map_length, H, H0.
+       rewrite N.eqb_refl.
+
+       assert (  (interp_carry (Clit Lit._false)) = false).
+       {
+         specialize (Lit.interp_false rho wf_rho). intros.
+         unfold is_true in H4.
+         rewrite not_true_iff_false in H4.
+         now unfold interp_carry.
+       }
+
+       rewrite H4 in H3.
+       unfold RAWBITVECTOR_LIST.add_list.
+       apply H3.
+Qed.
+
+Lemma valid_check_bbAdd pos1 pos2 lres : C.valid rho (check_bbAdd pos1 pos2 lres).
+Proof.
+      unfold check_bbAdd.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9;
+        try (intros; now apply C.interp_true).
+
+      (* BVadd *)
+      - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1'));
+            simpl; intros Heq10; try (now apply C.interp_true).
+        case_eq (
+                 check_add bs1 bs2 bsres (Clit Lit._false) &&
+                 (N.of_nat (Datatypes.length bs1) =? N)%N
+        ); simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H4 in H0; try (now contradict H0).
+        rename H4 into Hv.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite orb_true_iff in Heq10.
+        do 2 rewrite andb_true_iff in Heq10.
+        destruct Heq10 as [Heq10 | Heq10];
+          destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2
+        ;rewrite Heq10a1, Heq10a2 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H4. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_add_bvadd_length in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite N.eqb_eq in Heq11r.
+          rewrite Heq11a in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+        rewrite H5 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1. 
+
+        revert HSp1.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+        rewrite H6 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2. 
+
+        revert HSp2.
+
+        assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_add_bvadd_length in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite Heq11a, <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H102.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp2.
+
+        pose proof Heq11.
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11 & Heq11r).
+        rewrite N.eqb_eq in Heq11r.
+
+        apply check_add_bvadd_length in Heq11.
+
+        unfold BITVECTOR_LIST.bv_add. simpl.
+        apply eq_rec.
+        simpl.
+
+        specialize (@check_add_bvadd bs1 bs2 bsres N).
+
+        intros. apply H8.
+        exact Heq11r.
+        destruct Heq11 as (Heq11a & Heq11b).
+        rewrite <- Heq11b in Heq11a.
+        rewrite Heq11a in Heq11r. easy.
+        destruct Heq11 as (Heq11a & Heq11b).
+        rewrite Heq11a in Heq11r. easy.
+        rewrite andb_true_iff in H7.
+        destruct H7 as (H7 & H7r).
+        exact H7.
+
+        (** symmetic case **)
+
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H4. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_add_bvadd_length in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite N.eqb_eq in Heq11r.
+          rewrite Heq11a in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H5 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite Htia1 in HSp2.
+        unfold interp_bv in HSp2.
+
+        revert HSp2.
+
+        assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          apply check_add_bvadd_length in Heq11.
+          destruct Heq11 as (Heq11a, Heq11b).
+          rewrite Heq11a, <- Heq11b in Heq11r.
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H102.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp2.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H6 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia2 in HSp1.
+        unfold interp_bv in HSp1.
+
+        revert HSp1.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp1.
+
+        pose proof Heq11.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11 & Heq11r).
+        rewrite N.eqb_eq in Heq11r.
+
+        apply check_add_bvadd_length in Heq11.
+
+        unfold BITVECTOR_LIST.bv_add. simpl.
+        apply eq_rec.
+        simpl.
+
+        specialize (@RAWBITVECTOR_LIST.bv_add_comm N).
+        intros. rewrite H8.
+
+        specialize (@check_add_bvadd bs1 bs2 bsres N).
+
+        intros. apply H9.
+        exact Heq11r.
+        destruct Heq11 as (Heq11a & Heq11b).
+        rewrite <- Heq11b in Heq11a.
+        rewrite Heq11a in Heq11r. easy.
+        destruct Heq11 as (Heq11a & Heq11b).
+        rewrite Heq11a in Heq11r. easy.
+
+        rewrite andb_true_iff in H7.
+        destruct H7 as (H7 & H7r).
+        exact H7.
+
+        unfold RAWBITVECTOR_LIST.size.
+        destruct Heq11 as (Heq11a, Heq11b).
+        rewrite <- Heq11a in Heq11b.
+        rewrite <- Heq11b in Heq11r.
+        now rewrite map_length.
+
+        unfold RAWBITVECTOR_LIST.size.
+        now rewrite map_length.
+Qed.
+
+Lemma mk_list_false_eq: forall bs, (map (fun _ : int => Lit.interp rho Lit._false) bs) =
+ (RAWBITVECTOR_LIST.mk_list_false (Datatypes.length bs)).
+Proof. intro bs.
+       induction bs as [ | xbs xsbs IHbs ].
+       - now simpl.
+       - simpl. rewrite IHbs. specialize (@Lit.interp_false rho wf_rho).
+        intros. unfold is_true in H. apply not_true_is_false in H.
+        now rewrite H.
+Qed. 
+
+Lemma map_interp_neg: forall bs, (map (fun x : int => negb (Lit.interp rho x)) bs) =
+  (map (fun x : int => Lit.interp rho (Lit.neg x)) bs).
+Proof. intro bs. 
+       induction bs as [ | xbs xsbs IHbs ].
+       - now simpl.
+       - simpl. rewrite IHbs.
+         now rewrite Lit.interp_neg.
+Qed.
+
+Lemma prop_check_neg: forall bs bsres n, 
+  (N.of_nat(length bs) = n)%N -> 
+  (N.of_nat(length bsres) = n)%N ->  
+  check_neg bs bsres = true ->
+  RAWBITVECTOR_LIST.bv_neg (map (Lit.interp rho) bs) = map (Lit.interp rho) bsres.
+Proof. intros.
+
+       unfold check_neg in H1.
+       specialize (@check_add_list (map (fun l : int => Lit.neg l) bs)
+       (map (fun _ : int => Lit._false) bs) bsres (Clit Lit._true)).
+
+       intros. simpl in H2.
+       cut ( Datatypes.length (map (fun l : int => Lit.neg l) bs) =
+       Datatypes.length bsres ). intros.
+       cut (Datatypes.length (map (fun _ : int => Lit._false) bs) =
+       Datatypes.length bsres). intros.
+       specialize (H2 H3 H4 H1).
+       unfold BITVECTOR_LIST.bv_neg, RAWBITVECTOR_LIST.bv_neg.
+       unfold RAWBITVECTOR_LIST.twos_complement.
+
+       rewrite !map_map in H2.
+       rewrite !map_map.
+       rewrite mk_list_false_eq in H2.
+       rewrite <- map_interp_neg in H2.
+       rewrite Lit.interp_true in H2.
+       rewrite <- H2.
+       now rewrite map_length.
+
+       easy.
+
+       rewrite map_length. 
+       apply (f_equal (N.to_nat)) in H.
+       apply (f_equal (N.to_nat)) in H0.
+       rewrite Nat2N.id in H, H0.
+       now rewrite H, H0.
+
+       rewrite map_length. 
+       apply (f_equal (N.to_nat)) in H.
+       apply (f_equal (N.to_nat)) in H0.
+       rewrite Nat2N.id in H, H0.
+       now rewrite H, H0.
+Qed.
+
+Lemma check_neg_length: forall bs bsres,
+  check_neg bs bsres = true -> (length bs = length bsres)%nat.
+Proof. intros.
+       unfold check_neg in H.
+       specialize (@check_add_bvadd_length  (map (fun l : int => Lit.neg l) bs)
+       (map (fun _ : int => Lit._false) bs) bsres  (Clit Lit._true)).
+       intros. simpl in H0.
+       specialize (H0 H).
+       destruct H0. now rewrite map_length in H0.
+Qed.
+
+Lemma valid_check_bbNeg pos lres : C.valid rho (check_bbNeg pos lres).
+Proof.
+      unfold check_bbNeg.
+      case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | | | | ] a1' Heq9; try now apply C.interp_true.
+
+      case_eq ((a1 == a1') && check_neg bs1 bsres &&
+      (N.of_nat (Datatypes.length bs1) =? n)%N); 
+      simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl.  rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea); intros; rewrite H3 in H0; try (now contradict H0).
+        rename H3 into Hv.
+
+        generalize (Hs pos). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        unfold get_type' in H2. unfold v_type in H2.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2.
+
+        (** case a1 = a1' **)
+        do 2 rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq10, Heq11).
+        destruct Heq10 as (Heq10a1 & Heq10a2). 
+        rewrite Int63Properties.eqb_spec in Heq10a1; rewrite Heq10a1 in *.
+
+       (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H3. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+        revert v_vala1 Htia1. rewrite H2. intros.
+        rewrite Htia1.
+        unfold apply_unop.
+        rewrite Typ.cast_refl.
+        unfold Bval.
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n).
+        {
+          apply check_neg_length in Heq10a2.
+          rewrite N.eqb_eq in Heq11.
+          rewrite Heq10a2 in Heq11.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+
+        rewrite Typ.cast_refl. 
+        intros.
+        unfold BITVECTOR_LIST.bv_neg.
+        apply eq_rec.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1.
+
+        revert HSp1.
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n).
+        {
+          rewrite N.eqb_eq in Heq11.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+
+        rewrite Typ.cast_refl. 
+        intros.
+        rewrite HSp1. simpl.
+
+        specialize(@prop_check_neg bs1 bsres).
+        intros. apply H5 with n.
+        now rewrite N.eqb_eq in Heq11.
+
+        pose proof Heq10a2 as Heq10a3.
+        apply check_neg_length in Heq10a3.
+        rewrite <- Heq10a3.
+        now rewrite N.eqb_eq in Heq11.
+
+        easy.
+Qed.
+
+Lemma prop_forallb2: forall {A B} {f: A -> B -> bool} l1 l2, forallb2 f l1 l2 = true -> length l1 = length l2.
+Proof. intros A B f l1.
+       induction l1 as [ | xl1 xsl1 IHl1].
+       - intros. simpl in H.
+         case l2 in *. easy.
+         now contradict H.
+       - intros. simpl in H.
+         case l2 in *.
+         now contradict H.
+         simpl.
+         rewrite andb_true_iff in H. destruct H.
+         apply IHl1 in H0. now rewrite H0.
+Qed.
+
+Lemma prop_and_with_bit: forall a b, map interp_carry (and_with_bit a b) = 
+                          RAWBITVECTOR_LIST.and_with_bool (map (Lit.interp rho) a) (Lit.interp rho b).
+Proof. intro a.
+       induction a as [ | xa xsa IHa ].
+       - intros. now simpl in *.
+       - intros. simpl in *. now rewrite IHa.
+Qed.
+
+Lemma prop_mult_step_k_h: forall a b c k, 
+                          map interp_carry (mult_step_k_h a b c k) = 
+                          RAWBITVECTOR_LIST.mult_bool_step_k_h
+                            (map interp_carry a) (map interp_carry b)
+                            (interp_carry c) k.
+Proof. intro a.
+       induction a as [ | xa xsa IHa ].
+       - intros. case b.
+         now simpl.
+         intros. now simpl.
+       - intros. case b in *. simpl.
+         rewrite IHa. now simpl.
+         intros. simpl.
+         case (k - 1 <? 0)%Z.
+         simpl. apply f_equal.
+         apply IHa.
+         rewrite <- map_cons. simpl. apply f_equal.
+         apply IHa.
+Qed.
+
+Lemma prop_interp_firstn: forall xk' a, map (Lit.interp rho) (List.firstn xk' a) = (List.firstn xk' (map (Lit.interp rho) a)).
+Proof.   intro xk'0.
+          induction xk'0.
+           + intros. now simpl. 
+           + intros. simpl.
+             case a. now simpl.
+             intros. simpl. apply f_equal. apply IHxk'0.
+Qed.
+
+Lemma map_firstn: forall A B n (l: list A) (f:A -> B), firstn n (map f l) = map f (firstn n l). 
+Proof.
+  intros A B n.
+  induction n; intro l; induction l; try now simpl.
+  intros. simpl. apply f_equal. apply IHn.
+Qed.
+
+Lemma prop_mult_step: forall a b res k k',
+      (map interp_carry (mult_step a b res k k')) = 
+      RAWBITVECTOR_LIST.mult_bool_step (map (Lit.interp rho) a) (map (Lit.interp rho) b)
+                                       (map interp_carry res) k k'.
+Proof. intros. revert a b res k.
+       assert (false = (Lit.interp rho (Lit._false))) as Ha.
+       {
+         specialize (Lit.interp_false rho wf_rho). intros.
+         unfold is_true in H. rewrite not_true_iff_false in H.
+         now rewrite H.
+       }
+
+       assert (false = interp_carry (Clit Lit._false)).
+       {
+         unfold interp_carry.
+         specialize (Lit.interp_false rho wf_rho). intros.
+         unfold is_true in H. rewrite not_true_iff_false in H.
+         now rewrite H.
+       }
+
+       assert ([] = map (interp_carry) []). { now simpl. }
+
+       induction k' as [ | xk' xsk' IHk' ].
+       - intros.
+         case a. simpl. rewrite H; apply prop_mult_step_k_h.
+         intros. simpl. rewrite H. rewrite prop_mult_step_k_h. simpl. now rewrite map_nth.
+       - intros. simpl.
+         rewrite xsk', prop_mult_step_k_h, prop_and_with_bit.
+         rewrite <- map_nth, <- Ha, <- H.
+         case a. now simpl. simpl. intros.
+         case l. now simpl. simpl. intros.
+         case xk'. now simpl. intros. now rewrite map_firstn.
+Qed.
+
+Lemma prop_bblast_bvmult: forall a b n,
+                          (map interp_carry (bblast_bvmult a b n)) =
+                          RAWBITVECTOR_LIST.bvmult_bool (map (Lit.interp rho) a)  
+                                                        (map (Lit.interp rho) b)
+                                                        n.
+Proof. intros.
+       revert a b.
+       induction n.
+       - intros. simpl. rewrite prop_and_with_bit.
+         rewrite <- map_nth.
+         specialize (Lit.interp_false rho wf_rho). intros.
+         unfold is_true in H. rewrite not_true_iff_false in H.
+         now rewrite H.
+       - intros. simpl.
+         specialize (Lit.interp_false rho wf_rho). intros.
+         unfold is_true in H. rewrite not_true_iff_false in H.
+         case n in *.
+         rewrite prop_and_with_bit; rewrite <- map_nth; now rewrite H.
+         rewrite prop_mult_step; rewrite prop_and_with_bit; rewrite <- map_nth; now rewrite H.
+Qed.
+
+Lemma prop_mult_step_k_h_len: forall a b c k,
+length (mult_step_k_h a b c k) = length a .
+Proof. intro a.
+       induction a as [ | xa xsa IHa ].
+       - intros. simpl. easy.
+       - intros.
+         case b in *. simpl. rewrite IHa. simpl. omega.
+         simpl. case (k - 1 <? 0)%Z; simpl; now rewrite IHa.
+Qed.
+
+Lemma prop_mult_step3: forall k' a b res k, 
+                         length (mult_step a b res k k') = (length res)%nat.
+Proof. intro k'.
+       induction k'.
+       - intros. simpl. rewrite prop_mult_step_k_h_len. simpl. omega.
+       - intros. simpl.
+         rewrite IHk'. rewrite prop_mult_step_k_h_len. simpl; omega.
+Qed.
+
+Lemma prop_and_with_bit2: forall bs1 b, length (and_with_bit bs1 b) = length bs1.
+Proof. intros bs1.
+       induction bs1.
+       - intros. now simpl.
+       - intros. simpl. now rewrite IHbs1.
+Qed.
+
+Lemma check_bvmult_length: forall bs1 bs2,
+  let bsres0 := bblast_bvmult bs1 bs2 (length bs1) in
+  length bs1 = length bs2 -> length bs1 = length bsres0.
+Proof. intros. unfold bblast_bvmult in bsres0.
+       case_eq (length bs1). intros. unfold bsres0.
+       rewrite H0.
+       specialize (@prop_and_with_bit2 bs1 (nth 0 bs2 Lit._false)). intros.
+       now rewrite H1.
+       intros. unfold bsres0. rewrite H0.
+       case n in *.
+       simpl. rewrite prop_and_with_bit2. auto.
+       rewrite prop_mult_step3. rewrite prop_and_with_bit2. auto.
+Qed.
+
+Lemma check_bvmult_length2: forall bs1 bs2 bsres,
+  check_mult bs1 bs2 bsres = true -> length bs1 = length bs2 .
+Proof. intros bs1.
+       induction bs1.
+       - intros. case bs2 in *.
+         + easy.
+         + unfold check_mult in H.
+           now contradict H.
+       - intros. unfold check_mult in H.
+         case_eq (Nat_eqb (Datatypes.length (a :: bs1)) ((Datatypes.length bs2))).
+         intros. now apply Nat_eqb_eq in H0.
+         intros. rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma prop_eq_carry_lit2: forall a b, forallb2 eq_carry_lit a b = true -> 
+                          (map interp_carry a) = (map (Lit.interp rho) b).
+Proof. intro a.
+       induction a.
+       - intros. simpl in H.
+         case b in *. now simpl.
+         now contradict H.
+       - intros. 
+         case b in *.
+         now simpl.
+         simpl in *. rewrite andb_true_iff in H; destruct H.
+         apply prop_eq_carry_lit in H.
+         rewrite H. apply f_equal. now apply IHa.
+Qed.
+
+Lemma prop_main: forall bs1 bs2 bsres,
+                 check_mult bs1 bs2 bsres = true ->
+                 map interp_carry (bblast_bvmult bs1 bs2 (Datatypes.length (map (Lit.interp rho) bs1))) =
+                 map (Lit.interp rho) bsres.
+Proof. intros. unfold check_mult in H.
+       case_eq (Nat_eqb (Datatypes.length bs1) (Datatypes.length bs2)). intros.
+       rewrite H0 in H. apply prop_eq_carry_lit2 in H.
+       rewrite map_length.
+       now rewrite H.
+       intros. rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma valid_check_bbMult pos1 pos2 lres : C.valid rho (check_bbMult pos1 pos2 lres).
+Proof.  
+      unfold check_bbMult.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; try (intros; now apply C.interp_true).
+      (* BVmult *)
+      - case_eq ((a1 == a1') && (a2 == a2') (* || (a1 == a2') && (a2 == a1')*) );
+            simpl; intros Heq10; try (now apply C.interp_true).
+
+        case_eq ( 
+                 check_mult bs1 bs2 bsres &&
+                 (N.of_nat (Datatypes.length bs1) =? N)%N
+                ); simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl.  rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H4 in H0; try (now contradict H0).
+        rename H4 into Hv.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite andb_true_iff in Heq10.
+        destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2;
+        rewrite Heq10a1, Heq10a2 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H4. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite Typ.cast_refl.
+        unfold Bval.
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          pose proof Heq11 as Heq11'.
+          apply prop_main in Heq11.
+          rewrite <- Heq11. rewrite !map_length.
+          specialize (@check_bvmult_length bs1 bs2).
+          intros. simpl in H5. rewrite <- H5.
+          now rewrite N.eqb_eq in Heq11r.
+          now apply check_bvmult_length2 in Heq11'.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+
+        rewrite Typ.cast_refl.
+        intros.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H5 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1.
+
+        revert HSp1.
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+        rewrite H101.
+
+        rewrite Typ.cast_refl.
+        intros.
+
+        rewrite HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H6 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2.
+
+        revert HSp2. 
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N).
+        {
+          rewrite andb_true_iff in Heq11.
+          destruct Heq11 as (Heq11, Heq11r).
+          rewrite N.eqb_eq in Heq11r.
+          apply check_bvmult_length2 in Heq11.
+          rewrite Heq11 in Heq11r.
+          now rewrite map_length.
+        }
+
+        generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H102.
+
+        rewrite Typ.cast_refl.
+        intros. rewrite HSp2.
+
+        pose proof Heq11.
+
+        unfold BITVECTOR_LIST.bv_mult.
+        unfold RAWBITVECTOR_LIST.bv_mult.
+        unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits.
+        unfold BITVECTOR_LIST.of_bits.
+
+        unfold BITVECTOR_LIST.bv.
+        unfold RAWBITVECTOR_LIST.of_bits.
+        apply eq_rec. simpl.
+
+        rewrite andb_true_iff in Heq11.
+        destruct Heq11 as (Heq11 & Heq11r).
+        rewrite N.eqb_eq in Heq11r.
+        rewrite map_length, Heq11r.
+
+        apply check_bvmult_length2 in Heq11.
+        rewrite Heq11 in Heq11r.
+        rewrite map_length, Heq11r.
+        rewrite N.eqb_compare, N.compare_refl.
+        unfold RAWBITVECTOR_LIST.mult_list.
+        rewrite <- prop_bblast_bvmult.
+
+        rewrite andb_true_iff in H7. 
+        destruct H7 as (H7 & H7r).
+
+        rewrite map_length.
+        apply prop_main in H7.
+        rewrite map_length in H7.
+        rewrite <- H7.
+
+        easy.
+Qed.
+
+  
+Lemma prop_interp_carry3: forall bs2,  map interp_carry (lit_to_carry bs2) = map (Lit.interp rho) bs2.
+Proof. intro bs2.
+       induction bs2 as [ | xbs2 xsbs2 IHbs2 ].
+       - now simpl.
+       - simpl. now rewrite IHbs2.
+Qed.
+
+Lemma check_concat_map: forall bs1 bs2,
+ map (Lit.interp rho) bs1 ++ map (Lit.interp rho) bs2 = map (Lit.interp rho) (bs1 ++ bs2).
+Proof. intro bs1.
+       induction bs1.
+       - intros. now simpl.
+       - intros. simpl. now rewrite IHbs1.
+Qed.
+
+Lemma concat_nil: forall {A} (a: list A), a ++ [] = a.
+Proof. intros A a.
+       case a; [ easy | intros; apply app_nil_r ].
+Qed.
+
+
+(* for native-coq compatibility *)
+Lemma concat_map : forall (A B : Set) (f : A -> B) (l0 l1 : list A),
+  map f (l0 ++ l1) = (map f l0) ++ (map f l1).
+Proof.
+  induction l0 as [ | xl0 xsl0 IHl0]; intros.
+  - now simpl.
+  - simpl. now rewrite IHl0.
+Qed. 
+
+Lemma check_concat_bvconcat: forall bs1 bs2 bsres , 
+  check_concat bs1 bs2 bsres = true ->
+  (RAWBITVECTOR_LIST.bv_concat (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) =
+   (map (Lit.interp rho) bsres)).
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1 ].
+       - intros. simpl.
+         unfold check_concat in H. simpl in H.
+         case_eq (forallb2 eq_carry_lit (lit_to_carry bs2) bsres); intros.
+         rewrite concat_nil in H.
+         apply prop_eq_carry_lit2 in H0.
+         unfold RAWBITVECTOR_LIST.bv_concat.
+         rewrite concat_nil.
+         now rewrite prop_interp_carry3 in H0.
+         unfold RAWBITVECTOR_LIST.bv_concat.
+         rewrite concat_nil.
+         rewrite concat_nil in H.
+         rewrite H0 in H. now contradict H.
+       - intros. unfold check_concat in H.
+         case_eq (forallb2 eq_carry_lit (lit_to_carry (bs2 ++ xbs1 :: xsbs1)) bsres); intros.
+         apply prop_eq_carry_lit2 in H0.
+         rewrite prop_interp_carry3 in H0.
+         simpl in H0. simpl.
+         unfold RAWBITVECTOR_LIST.bv_concat.
+         specialize (concat_map (Lit.interp rho)). intros.
+         rewrite <- H0. simpl.
+         rewrite <- !check_concat_map.
+         apply f_equal.
+         now simpl.
+         rewrite H0 in H; now contradict H.
+Qed.
+
+Lemma app_length : forall (l1 l2: list bool), (length (l1 ++ l2))%nat = ((length l1) + (length l2))%nat.
+Proof.
+  induction l1; simpl; auto.
+Qed.
+
+Lemma concat_len: forall (bs1 bs2 bsres: list bool), bs1 ++ bs2 = bsres ->
+                              ((length bs1) + (length bs2))%nat = (length bsres)%nat.
+Proof. intro bs1.
+       induction bs1.
+       - intros. simpl. simpl in H. now rewrite H.
+       - intros. simpl. simpl in H. rewrite <- H. simpl.
+         now rewrite app_length.
+Qed.
+
+Lemma valid_check_bbConcat pos1 pos2 lres : C.valid rho (check_bbConcat pos1 pos2 lres).
+Proof.
+      unfold check_bbConcat.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ]  a1' a2' Heq9; try (intros; now apply C.interp_true).
+      (* BVconcat *)
+    - case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true).
+        case_eq (
+             check_concat bs1 bs2 bsres && (N.of_nat (Datatypes.length bs1) =? N)%N &&
+             (N.of_nat (Datatypes.length bs2) =? n)%N
+        ); simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H4 in H0; try (now contradict H0).
+        rename H4 into Hv.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp2.
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite andb_true_iff in Heq10.
+        destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2;
+        rewrite Heq10a1, Heq10a2 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H4. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (N + n)%N).
+        {
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as ((Heq11, Heq11l) & Heq11r).
+          apply  check_concat_bvconcat in Heq11.
+          unfold RAWBITVECTOR_LIST.bv_concat in Heq11.
+          apply concat_len in Heq11.
+          apply N.eqb_eq in Heq11l.
+          apply N.eqb_eq in Heq11r.
+          rewrite !map_length in Heq11.
+          rewrite <- Heq11l, <- Heq11r.
+          rewrite map_length. lia.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H5 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1. 
+
+        revert HSp1.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N).
+        {
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as ((Heq11, Heq11l) & Heq11r).
+          apply  check_concat_bvconcat in Heq11.
+          apply N.eqb_eq in Heq11l.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp1.
+
+        (* interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2'])) *)
+        assert (interp_form_hatom_bv a2' = 
+                interp_bv t_i (interp_atom (t_atom .[a2']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia2.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia2. easy.
+        }
+
+        rewrite H6 in HSp2.
+        unfold interp_bv in HSp2.
+        rewrite Htia2 in HSp2.
+        unfold interp_bv in HSp2. 
+
+        revert HSp2.
+
+        assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n).
+        {
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as ((Heq11, Heq11l) & Heq11r).
+          apply  check_concat_bvconcat in Heq11.
+          apply N.eqb_eq in Heq11r.
+          now rewrite map_length.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)).
+
+        rewrite H102.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp2. simpl.
+        unfold BITVECTOR_LIST.bv_concat.
+        apply eq_rec. simpl.
+        apply check_concat_bvconcat.
+
+        rewrite !andb_true_iff in Heq11.
+        now destruct Heq11 as ((Heq11, Heq11l) & Heq11r).
+Qed.
+
+Lemma extract_interp_zero: forall a n, RAWBITVECTOR_LIST.extract (map (Lit.interp rho) a) 0 n =
+map (Lit.interp rho) (extract_lit a 0 n).
+Proof. intro a.
+       induction a as [ | xa xsa IHa].
+       - intros. now simpl.
+       - intros. simpl.
+         case_eq n.
+         now simpl.
+         intros. simpl. apply f_equal.
+         now rewrite IHa.
+Qed.
+
+Lemma extract_interp_all: forall a m n, RAWBITVECTOR_LIST.extract (map (Lit.interp rho) a) m n =
+map (Lit.interp rho) (extract_lit a m n).
+Proof. intro a.
+       induction a as [ | xa xsa IHa].
+       - intros. now simpl.
+       - intros. case_eq m.
+         intros. apply extract_interp_zero.
+         intros. simpl.         
+         case_eq n.
+         now simpl.
+         intros. simpl.
+         now rewrite IHa.
+Qed.
+
+Lemma extract_interp_main: forall bs1 bsres (i n0: N),
+                  check_extract bs1 bsres i (n0 + i) = true ->
+                  @RAWBITVECTOR_LIST.bv_extr i n0 (N.of_nat (length bs1)) 
+                    (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres.
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros. simpl.
+         unfold check_extract in H. simpl in H.
+         unfold RAWBITVECTOR_LIST.bv_extr.
+          case_eq (nat_of_N i).
+          intros. simpl.
+          case_eq (nat_of_N n0).
+          intros. simpl.
+         case_eq ((0 <? n0 + i)%N); intros.
+          rewrite H2 in H. now contradict H.
+          rewrite H2 in H.
+         case_eq bsres. intros. now simpl.
+          intros. rewrite H3 in H. now contradict H.
+          intros.
+          case_eq bsres. intros.
+          apply (f_equal (N.of_nat)) in H1.
+          apply (f_equal (N.of_nat)) in H0.
+          rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H.
+          simpl in H. now contradict H0.
+          intros. rewrite H2 in H.
+          case ((0 <? n0 + i)%N) in H; now contradict H.
+          intros.
+          case_eq (N.to_nat n0).
+          intros.
+          apply (f_equal (N.of_nat)) in H1.
+          apply (f_equal (N.of_nat)) in H0.
+          rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H.
+          simpl in H. now contradict H0.
+          intros.
+          apply (f_equal (N.of_nat)) in H1.
+          apply (f_equal (N.of_nat)) in H0.
+          rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H.
+          simpl in H. now contradict H0.
+       - intros. unfold check_extract in H.
+         case_eq ((N.of_nat (Datatypes.length (xbs1 :: xsbs1)) <? n0 + i)%N).
+         intros. rewrite H0 in H. now contradict H.
+         intros. rewrite H0 in H.         
+         case_eq (
+          forallb2 eq_carry_lit
+          (lit_to_carry
+          (extract_lit (xbs1 :: xsbs1) 
+          (N.to_nat i) (N.to_nat (n0 + i)))) bsres); intros.
+         apply prop_eq_carry_lit2 in H1.
+         rewrite prop_interp_carry3 in H1.
+         simpl in H1. simpl.
+
+         unfold RAWBITVECTOR_LIST.bv_extr in *.
+         simpl in *.
+         case_eq (N.to_nat i); intros; rewrite H2 in H1.
+         case_eq (N.to_nat (n0 + i)); intros; rewrite H3 in H1.
+         rewrite <- H1. rewrite H0. easy.
+         rewrite H0.        
+
+         simpl in H1.
+         rewrite <- H1. simpl. apply f_equal.
+         
+         now rewrite extract_interp_zero.
+         
+         case_eq (N.to_nat (n0 + i)); intros; rewrite H3 in H1.
+         rewrite H0.
+         rewrite <- H1. easy.
+         
+         rewrite H0.
+         now rewrite extract_interp_all.
+         
+         rewrite H1 in H. now contradict H.
+Qed.
+
+  Lemma Npos_dist: forall p p0: positive, (Npos (p + p0))%N = (Npos p + Npos p0)%N.
+  Proof. intros. case p in *; case p0 in *; easy. Qed.
+
+  Lemma not_ltb2: forall (n0 n1 i: N), (n1 >= n0 + i)%N -> (n1 <? n0 + i)%N = false.
+  Proof. intro n0.
+         induction n0.
+         intros. simpl in *.
+         now apply N.ltb_nlt in H.
+
+         intros. simpl.
+         case_eq i.
+         intros. subst. simpl in H.
+         now apply N.ltb_nlt in H.
+         intros. subst.
+         apply N.ltb_nlt in H.
+         now rewrite Npos_dist.
+  Qed.
+
+Lemma valid_check_bbExtract pos lres : C.valid rho (check_bbExtract pos lres).
+Proof.
+      unfold check_bbExtract.
+      case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq5.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | | | | ]  a1'  Heq6; try (intros; now apply C.interp_true).
+      (* BVextract *)
+    - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true).
+        case_eq (
+          check_extract bs1 bsres i (n0 + i) &&
+          (N.of_nat (Datatypes.length bs1) =? n1)%N && (n0 + i <=? n1)%N
+        ); simpl; intros Heq8; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq3.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq5. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. }
+        specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H3 in H0; try (now contradict H2).
+        rename H0 into Hv.
+
+        generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp.
+        unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp.
+        unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp.
+        rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp.
+
+        unfold get_type' in H2. unfold v_type in H2.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2.
+
+        (** case a1 = a1' **)
+        rewrite eqb_spec in Heq7; rewrite Heq7 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H0. rewrite Heq6. simpl.
+        unfold interp_bv. unfold apply_unop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H2.
+        intros v_vala1 Htia1.
+        rewrite Htia1.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n0%N).
+        {
+           rewrite !andb_true_iff in Heq8.
+           destruct Heq8 as ((Heq8a, Heq8b), Heq8c).
+           rewrite map_length.
+           specialize (@extract_interp_main bs1 bsres i n0 Heq8a).
+           intros.
+           unfold RAWBITVECTOR_LIST.bv_extr in H4.
+           assert (length (RAWBITVECTOR_LIST.extract (map (Lit.interp rho) bs1) (N.to_nat i)
+           (N.to_nat (n0 + i))) = length (map (Lit.interp rho) bsres)).
+           rewrite N.eqb_eq in Heq8b.
+           rewrite Heq8b in H4.
+           case_eq ((n1 <? n0 + i)%N); intros.
+           apply N.leb_le in Heq8c.
+           assert ((n0 + i <= n1)%N -> (n1 >= n0 + i)%N).
+           { lia. } apply H6 in Heq8c.
+           apply not_ltb2 in Heq8c. 
+           rewrite Heq8c in H5. now contradict H5.
+           rewrite H5 in H4.
+           now rewrite H4.
+           rewrite RAWBITVECTOR_LIST.length_extract, !map_length in H5.
+           assert ((n0 + i - i)%N = n0).
+           { lia. } rewrite H6 in H5.
+           now rewrite <- H5, N2Nat.id.
+           
+           rewrite map_length. 
+           rewrite N.eqb_eq in Heq8b.
+           rewrite Heq8b. unfold is_true.
+           apply N.leb_le in Heq8c.
+           assert ((n0 + i <= n1)%N -> (n1 >= n0 + i)%N).
+           { lia. } now apply H6 in Heq8c.
+           lia.
+         }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp.
+        unfold interp_bv in HSp.
+        rewrite Htia1 in HSp.
+        unfold interp_bv in HSp. 
+
+        revert HSp.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n1).
+        {  rewrite !andb_true_iff in Heq8.
+           destruct Heq8 as ((Heq8a, Heq8b), Heq8c).
+           rewrite map_length.
+           now rewrite N.eqb_eq in Heq8b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp. simpl.
+        unfold BITVECTOR_LIST.bv_extr.
+        apply eq_rec. simpl.
+        rewrite !andb_true_iff in Heq8.
+        destruct Heq8 as (Heq8a, Heq8b).
+        specialize (@extract_interp_main bs1 bsres i n0).
+        intros.
+        rewrite map_length in H101.
+        rewrite H101 in H5. now apply H5.
+Qed.
+
+Lemma zextend_interp_zero: forall a, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) a) O =
+(map (Lit.interp rho) (zextend_lit a 0)).
+Proof. now simpl. Qed.
+
+Lemma zextend_interp_empty: forall i, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) []) i =
+map (Lit.interp rho) (zextend_lit [] i).
+Proof. simpl. intro i.
+       induction i.
+       - intros. now simpl.
+       - intros. simpl.
+         unfold RAWBITVECTOR_LIST.zextend in *.
+         simpl. rewrite IHi.
+         assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+        now rewrite H.
+ Qed.
+
+Lemma zextend_interp_all: forall a i, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) a) i =
+map (Lit.interp rho) (zextend_lit a i).
+Proof. intro a.
+       induction a as [ | xa xsa IHa].
+       - intros. simpl.
+         induction i.
+         + intros. now simpl.
+         + intros. unfold RAWBITVECTOR_LIST.zextend in *.
+           simpl. rewrite IHi.
+           assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+           now rewrite H.
+        - intros. 
+          induction i.
+          + now simpl.
+          + unfold RAWBITVECTOR_LIST.zextend, zextend_lit in *.
+            simpl in *. rewrite <- IHi.
+           assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+           now rewrite H.
+Qed.
+
+Lemma zextend_interp_main: forall bs1 bsres (n i: N),
+                           check_zextend bs1 bsres i = true ->
+                           @RAWBITVECTOR_LIST.bv_zextn n i
+                             (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres.
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros. simpl.
+         unfold check_zextend in H. simpl in H.
+         case_eq (forallb2 eq_carry_lit
+          (lit_to_carry (zextend_lit [] (N.to_nat i))) bsres).
+         intros.
+         apply prop_eq_carry_lit2 in H0.
+         rewrite prop_interp_carry3 in H0.
+         simpl in H0.
+         unfold RAWBITVECTOR_LIST.bv_zextn.
+         now rewrite zextend_interp_empty.
+         intros. rewrite H0 in H. now contradict H0.
+       - intros. unfold RAWBITVECTOR_LIST.bv_zextn, check_zextend in H.
+         case_eq (
+          forallb2 eq_carry_lit
+          (lit_to_carry
+             (zextend_lit (xbs1 :: xsbs1) (N.to_nat i)))
+          bsres); intros.
+         apply prop_eq_carry_lit2 in H0.
+         rewrite prop_interp_carry3 in H0.
+         simpl in H0. simpl.
+
+         unfold RAWBITVECTOR_LIST.bv_zextn in *.
+         case_eq (N.to_nat i). intros. rewrite H1 in H0.
+         now simpl in *.
+         intros. rewrite H1 in H0.
+         rewrite <- H0.
+         rewrite <- zextend_interp_all.
+         simpl.
+         assert (Lit.interp rho Lit._false = false).
+         { specialize (Lit.interp_false rho wf_rho). intros.
+            rewrite <- not_true_iff_false.
+            unfold not in *.
+            intros. now apply H2. }
+         reflexivity.
+
+         rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma valid_check_bbZextend pos lres : C.valid rho (check_bbZextend pos lres).
+Proof.
+      unfold check_bbZextend.
+      case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq5.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | | | | ]  a1'  Heq6; try (intros; now apply C.interp_true).
+      (* BVzextend *)
+    - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true).
+        case_eq (
+            check_zextend bs1 bsres i && (N.of_nat (Datatypes.length bs1) =? n)%N
+        ); simpl; intros Heq8; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq3.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq5. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. }
+        specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H3 in H0; try (now contradict H0).
+        rename H0 into Hv.
+
+        generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp.
+        unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp.
+        unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp.
+        rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp.
+
+        unfold get_type' in H2. unfold v_type in H2.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2.
+
+        (** case a1 = a1' **)
+        rewrite eqb_spec in Heq7; rewrite Heq7 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H0. rewrite Heq6. simpl.
+        unfold interp_bv. unfold apply_unop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H2.
+        intros v_vala1 Htia1.
+        rewrite Htia1.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (i + n)%N).
+        {
+           rewrite andb_true_iff in Heq8.
+           destruct Heq8 as (Heq8a, Heq8b).
+           rewrite map_length.
+           specialize (@zextend_interp_main bs1 bsres n i).
+           intros.
+           apply H4 in Heq8a.
+           unfold RAWBITVECTOR_LIST.bv_zextn in Heq8a.
+           assert (length (RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) bs1) (N.to_nat i)) 
+           = length (map (Lit.interp rho) bsres)).
+           { now rewrite Heq8a. }
+           rewrite RAWBITVECTOR_LIST.length_zextend, !map_length in H5.
+           apply (f_equal (N.of_nat)) in H5.
+           rewrite <- H5.
+           
+           rewrite N.eqb_eq in Heq8b.
+           apply (f_equal (N.to_nat)) in Heq8b.
+           rewrite Nat2N.id in Heq8b.
+           rewrite Heq8b. lia.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp.
+        unfold interp_bv in HSp.
+        rewrite Htia1 in HSp.
+        unfold interp_bv in HSp. 
+
+        revert HSp.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n).
+        {
+           rewrite andb_true_iff in Heq8.
+           destruct Heq8 as (Heq8a, Heq8b).
+           rewrite map_length.
+           now rewrite N.eqb_eq in Heq8b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp. simpl.
+        unfold BITVECTOR_LIST.bv_zextn.
+        apply eq_rec. simpl.
+        rewrite andb_true_iff in Heq8.
+        destruct Heq8 as (Heq8a, Heq8b).
+        now apply zextend_interp_main.
+Qed.    
+
+Lemma sextend_interp_zero: forall a, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) a) O =
+(map (Lit.interp rho) (sextend_lit a 0)).
+Proof. intros.
+       unfold RAWBITVECTOR_LIST.sextend.
+       case_eq a; intros; now simpl.
+Qed.
+
+Lemma sextend_interp_empty: forall i, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) []) i =
+map (Lit.interp rho) (sextend_lit [] i).
+Proof. simpl. intro i.
+       induction i.
+       - intros. now simpl.
+       - intros. simpl.
+         unfold RAWBITVECTOR_LIST.sextend in *.
+         simpl. rewrite IHi.
+         assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+        now rewrite H.
+ Qed.
+
+Lemma sextend_interp_all: forall a i, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) a) i =
+map (Lit.interp rho) (sextend_lit a i).
+Proof. intro a.
+       induction a as [ | xa xsa IHa].
+       - intros. simpl.
+         induction i.
+         + intros. now simpl.
+         + intros. unfold RAWBITVECTOR_LIST.sextend in *.
+           simpl. rewrite IHi.
+           assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+           now rewrite H.
+        - intros. 
+          induction i.
+          + now simpl.
+          + unfold RAWBITVECTOR_LIST.sextend, zextend_lit in *.
+            simpl in *. rewrite <- IHi.
+           assert (Lit.interp rho Lit._false = false).
+           { specialize (Lit.interp_false rho wf_rho). intros.
+              rewrite <- not_true_iff_false.
+              unfold not in *.
+              intros. now apply H. }
+           reflexivity.
+Qed.
+
+Lemma sextend_interp_main: forall bs1 bsres (n i: N),
+                           check_sextend bs1 bsres i = true ->
+                           @RAWBITVECTOR_LIST.bv_sextn n i
+                             (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres.
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1].
+       - intros. simpl.
+         unfold check_zextend in H. simpl in H.
+         case_eq (forallb2 eq_carry_lit
+          (lit_to_carry (sextend_lit [] (N.to_nat i))) bsres).
+         intros.
+         apply prop_eq_carry_lit2 in H0.
+         rewrite prop_interp_carry3 in H0.
+         simpl in H0.
+         unfold RAWBITVECTOR_LIST.bv_sextn.
+         now rewrite sextend_interp_empty.
+         intros. 
+         unfold check_sextend in H.
+         rewrite H0 in H. now contradict H0.
+       - intros. unfold RAWBITVECTOR_LIST.bv_sextn, check_sextend in H.
+         case_eq (
+          forallb2 eq_carry_lit
+          (lit_to_carry
+             (sextend_lit (xbs1 :: xsbs1) (N.to_nat i)))
+          bsres); intros.
+         apply prop_eq_carry_lit2 in H0.
+         rewrite prop_interp_carry3 in H0.
+         simpl in H0.
+
+         unfold RAWBITVECTOR_LIST.bv_sextn in *.
+         case_eq (N.to_nat i). intros. rewrite H1 in H0.
+         now simpl in *.
+         intros. rewrite H1 in H0.
+         rewrite <- H0.
+         
+         rewrite sextend_interp_all.
+         now simpl.
+
+         rewrite H0 in H. now contradict H.
+Qed.
+
+Lemma valid_check_bbSextend pos lres : C.valid rho (check_bbSextend pos lres).
+Proof.
+      unfold check_bbSextend.
+      case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq5.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | | | | | ]  a1'  Heq6; try (intros; now apply C.interp_true).
+      (* BVsextend *)
+    - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true).
+        case_eq (
+            check_sextend bs1 bsres i && (N.of_nat (Datatypes.length bs1) =? n)%N
+        ); simpl; intros Heq8; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq3.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq5. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. }
+        specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H3 in H0; try (now contradict H0).
+        rename H0 into Hv.
+
+        generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp.
+        unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp.
+        unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp.
+        rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp.
+
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp.
+
+        unfold get_type' in H2. unfold v_type in H2.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2.
+
+        (** case a1 = a1' **)
+        rewrite eqb_spec in Heq7; rewrite Heq7 in *.
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H0. rewrite Heq6. simpl.
+        unfold interp_bv. unfold apply_unop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H2.
+        intros v_vala1 Htia1.
+        rewrite Htia1.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (i + n)%N).
+        {
+           rewrite andb_true_iff in Heq8.
+           destruct Heq8 as (Heq8a, Heq8b).
+           rewrite map_length.
+           specialize (@sextend_interp_main bs1 bsres n i).
+           intros.
+           apply H4 in Heq8a.
+           unfold RAWBITVECTOR_LIST.bv_sextn in Heq8a.
+           assert (length (RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) bs1) (N.to_nat i)) 
+           = length (map (Lit.interp rho) bsres)).
+           { now rewrite Heq8a. }
+           rewrite RAWBITVECTOR_LIST.length_sextend, !map_length in H5.
+           apply (f_equal (N.of_nat)) in H5.
+           rewrite <- H5.
+           
+           rewrite N.eqb_eq in Heq8b.
+           apply (f_equal (N.to_nat)) in Heq8b.
+           rewrite Nat2N.id in Heq8b.
+           rewrite Heq8b. lia.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H4 in HSp.
+        unfold interp_bv in HSp.
+        rewrite Htia1 in HSp.
+        unfold interp_bv in HSp. 
+
+        revert HSp.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n).
+        {
+           rewrite andb_true_iff in Heq8.
+           destruct Heq8 as (Heq8a, Heq8b).
+           rewrite map_length.
+           now rewrite N.eqb_eq in Heq8b.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp. simpl.
+        unfold BITVECTOR_LIST.bv_sextn.
+        apply eq_rec. simpl.
+        rewrite andb_true_iff in Heq8.
+        destruct Heq8 as (Heq8a, Heq8b).
+        now apply sextend_interp_main.
+Qed.
+
+
+Lemma nshl_lit_empty: forall b, nshl_lit_be [] b = [].
+Proof. intro b.
+       induction b; intros; now simpl.
+Qed.
+
+Lemma shl_lit_empty: forall b, shl_lit_be [] b = [].
+Proof. intro b. unfold shl_lit_be. now rewrite nshl_lit_empty. Qed.
+
+Lemma rawbv_nshl_empty: forall b, RAWBITVECTOR_LIST.nshl_be [] b = [].
+Proof. intro b.
+       induction b; intros; now simpl.
+Qed.
+
+Lemma bv_shl_empty: forall b, RAWBITVECTOR_LIST.bv_shl [] b = [].
+Proof. intro b. unfold RAWBITVECTOR_LIST.bv_shl.
+       case_eq b; simpl; intros.
+       unfold RAWBITVECTOR_LIST.shl_be. now rewrite rawbv_nshl_empty.
+       unfold RAWBITVECTOR_LIST.size. simpl.
+       unfold RAWBITVECTOR_LIST.zeros. now simpl.
+ Qed.
+
+Lemma helper: forall {A} (l0: list A) i0, S (S (length match l0 with
+                       | [] => []
+                       | _ :: _ => i0 :: removelast l0
+                       end)) = S (S (length l0)).
+Proof. intros A l0.
+       induction l0; intros.
+       - now simpl.
+       - simpl. now rewrite IHl0.
+Qed.
+ 
+Lemma length_shl_lit_be: forall a, length (_shl_lit_be a) = length a.
+Proof. intro a.
+       induction a; intros.
+       - now simpl.
+       - unfold _shl_lit_be. simpl.
+         case_eq a0; intros.
+         + easy.
+         + apply f_equal.
+           case_eq l; intros. 
+           now simpl.
+           simpl. now rewrite helper.
+Qed.
+
+Lemma length_nshl_lit_be: forall n a, length (nshl_lit_be a n) = length a.
+Proof. intros n.
+       induction n; intros.
+       - now simpl.
+       - simpl. rewrite (IHn (_shl_lit_be a)).
+         simpl. unfold nshl_lit_be. now rewrite length_shl_lit_be.
+Qed.
+
+Lemma length_shl_be: forall a b, length a = length (shl_lit_be a b).
+Proof. intros. unfold shl_lit_be. now rewrite length_nshl_lit_be. Qed.
+
+Lemma length_check_shsl: forall bs1 bs2 bsres , 
+  check_shl bs1 bs2 bsres = true -> length bs1 = length bs2 -> length bs1 = length bsres.
+Proof. intro bs1.
+       induction bs1; intros.
+       - case_eq bs2; simpl; intros.
+         + subst. unfold check_shl in H. simpl in H.
+           case_eq bsres; simpl; intros; subst; easy.
+         + rewrite H1 in H. unfold check_shl in H. simpl in H.
+           now contradict H.
+       - simpl in *.
+         unfold check_shl in H. simpl in H.
+         case_eq bs2; simpl; intros; subst. simpl in H. now contradict H.
+         simpl in *. inversion H0. rewrite H2, Structures.nat_eqb_refl in H.
+         case_eq (forallb2 eq_carry_lit (lit_to_carry (shl_lit_be (a :: bs1) (b :: l))) bsres); intros.
+         +  apply prop_eq_carry_lit2 in H1.
+            rewrite prop_interp_carry3 in H1.
+            simpl in H1.
+            assert (length (map (Lit.interp rho) (shl_lit_be (a :: bs1) (b :: l))) = 
+                    length (map (Lit.interp rho) bsres)).
+            { now rewrite H1. }
+            rewrite !map_length in H3.
+            rewrite <- (length_shl_be (a :: bs1) (b :: l)) in H3.
+            now simpl in *.
+        + rewrite H1 in H; now contradict H.
+Qed.
+
+Lemma map_lst: forall l i, match map (Lit.interp rho) l with
+| [] => []
+| _ :: _ => Lit.interp rho i :: removelast (map (Lit.interp rho) l)
+end = map (Lit.interp rho) match l with
+                           | [] => []
+                           | _ :: _ => i :: removelast l
+                           end.
+Proof. intro l.
+       induction l; intros. now simpl.
+       simpl. apply f_equal. now rewrite IHl.
+Qed.
+
+Lemma prop_shl_be: forall a, RAWBITVECTOR_LIST._shl_be (map (Lit.interp rho) a) =
+ (map (Lit.interp rho) (_shl_lit_be a)).
+Proof. intro a.  
+       case_eq a; intros.
+       - now simpl.
+       - unfold RAWBITVECTOR_LIST._shl_be, _shl_lit_be. simpl.
+         assert (Lit.interp rho (Lit._false) = false).
+         { specialize (Lit.interp_false rho wf_rho). intros.
+           rewrite <- not_true_iff_false.
+           unfold not in *.
+           intros. now apply H0. 
+         }
+        rewrite H0. apply f_equal.
+        now rewrite map_lst.
+Qed.
+
+Lemma nshl_interp: forall n bs1, 
+RAWBITVECTOR_LIST.nshl_be (map (Lit.interp rho) bs1) n =
+map (Lit.interp rho) (nshl_lit_be bs1 n).
+Proof. intro n.
+       induction n; intros.
+       - now simpl.
+       - simpl. specialize (@IHn (_shl_lit_be bs1)).
+         rewrite <- IHn. simpl.
+         now rewrite prop_shl_be.
+Qed.
+
+Lemma shl_interp: forall bs1 bs2, 
+RAWBITVECTOR_LIST.shl_be (map (Lit.interp rho) bs1) bs2 =
+map (Lit.interp rho) (shl_lit_be bs1 bs2).
+Proof. intros.
+       unfold RAWBITVECTOR_LIST.shl_be, shl_lit_be.
+       now rewrite nshl_interp.
+Qed.
+
+
+Lemma check_shl_bvshl: forall bs1 bs2 bsres , 
+  check_shl bs1 bs2 bsres = true ->
+  (RAWBITVECTOR_LIST.bv_shl (map (Lit.interp rho) bs1) bs2 =
+   (map (Lit.interp rho) bsres)).
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1 ].
+       - intros. simpl.
+         unfold check_shl, shl_lit_be in H.
+         case_eq (Structures.nat_eqb (@length int []) (length bs2)); intros.
+         rewrite Structures.nat_eqb_eq in H0.
+         rewrite <- H0 in H. simpl in H.
+         rewrite nshl_lit_empty in H.
+         case_eq bsres; intros. simpl.
+         now rewrite bv_shl_empty.
+         subst; now contradict H.
+         rewrite H0 in H; now contradict H.
+       - intros. unfold check_shl in H.
+         case_eq (Structures.nat_eqb (Datatypes.length (xbs1 :: xsbs1)) (Datatypes.length bs2)); intros.
+         rewrite H0 in H.
+         case_eq (
+          forallb2 eq_carry_lit (lit_to_carry (shl_lit_be (xbs1 :: xsbs1) bs2)) bsres); intros.
+         apply prop_eq_carry_lit2 in H1.
+         rewrite prop_interp_carry3 in H1.
+         
+         unfold RAWBITVECTOR_LIST.bv_shl.
+         rewrite Structures.nat_eqb_eq in H0.
+         unfold RAWBITVECTOR_LIST.size.
+         rewrite !map_length. rewrite H0, N.eqb_refl.
+         now rewrite <- H1, shl_interp.
+    
+         rewrite H1 in H; now contradict H.
+         rewrite H0 in H; now contradict H.
+Qed.
+
+Lemma valid_check_bbShl pos1 pos2 lres : C.valid rho (check_bbShl pos1 pos2 lres).
+Proof.
+      unfold check_bbShl.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 (*bs2*) Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ]  a1' a2' Heq9; try (intros; now apply C.interp_true).
+       case_eq (t_atom .[ a2]); try (intros; now apply C.interp_true). intros c Heqa2.
+       case_eq c; try (intros; now apply C.interp_true). intros bv2 n0 Heqc.
+      (* BVshl *)
+      case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true).
+        case_eq (
+                check_shl bs1 bv2 bsres && (N.of_nat (Datatypes.length bs1) =? n)%N &&
+                (N.of_nat (Datatypes.length bv2) =? n)%N && (n0 =? n)%N
+        ); simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+        pose proof (H a2). 
+        assert (a2 < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heqa2, Heqc. easy. }
+        specialize (@H4 H5). rewrite Heqa2 in H4. simpl in H4.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H6 in H0; try (now contradict H0).
+        rename H6 into Hv.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        (*apply BITVECTOR_LIST.bv_eq_reflect in HSp2.*)
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite andb_true_iff in Heq10.
+        destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2;
+        rewrite Heq10a1, Heq10a2 in *.
+
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H6. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n%N).
+        { 
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d).
+          apply length_check_shsl in Heq11.
+          rewrite map_length, <- Heq11.
+          now apply N.eqb_eq in Heq11l.
+          apply N.eqb_eq in Heq11r.
+          apply N.eqb_eq in Heq11l.
+          apply (f_equal (N.to_nat)) in Heq11l.
+          apply (f_equal (N.to_nat)) in Heq11r.
+          rewrite Nat2N.id in Heq11l, Heq11r.
+          now rewrite Heq11l, Heq11r.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H7 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1. 
+
+        revert HSp1.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n).
+        {
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d).
+          rewrite map_length.
+          now apply N.eqb_eq in Heq11l.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp1.
+
+        rewrite Heqa2 in Htia2. simpl in Htia2.
+        unfold interp_cop in Htia2. rewrite Heqc in Htia2. unfold Bval in Htia2.
+        rewrite !andb_true_iff in Heq11.
+        destruct Heq11 as (((Heq1a, Heq11b), Heq11c), Heq11d).
+        apply N.eqb_eq in Heq11d.
+        rewrite Heq11d in *.
+        specialize (Bval_inj2 _  (Typ.TBV n) (BITVECTOR_LIST._of_bits bv2 n) v_vala2); intros.
+        apply H8 in Htia2. rewrite <- Htia2.
+
+        unfold BITVECTOR_LIST.bv_shl.
+        apply eq_rec. simpl.
+        apply check_shl_bvshl.
+
+        now unfold RAWBITVECTOR_LIST._of_bits; rewrite Heq11c.
+Qed.
+
+
+Lemma nshr_lit_empty: forall b, nshr_lit_be [] b = [].
+Proof. intro b.
+       induction b; intros; now simpl.
+Qed.
+
+Lemma shr_lit_empty: forall b, shr_lit_be [] b = [].
+Proof. intro b. unfold shr_lit_be. now rewrite nshr_lit_empty. Qed.
+
+Lemma rawbv_nshr_empty: forall b, RAWBITVECTOR_LIST.nshr_be [] b = [].
+Proof. intro b.
+       induction b; intros; now simpl.
+Qed.
+
+Lemma bv_shr_empty: forall b, RAWBITVECTOR_LIST.bv_shr [] b = [].
+Proof. intro b. unfold RAWBITVECTOR_LIST.bv_shr.
+       case_eq b; simpl; intros.
+       unfold RAWBITVECTOR_LIST.shr_be. now rewrite rawbv_nshr_empty.
+       unfold RAWBITVECTOR_LIST.size. simpl.
+       unfold RAWBITVECTOR_LIST.zeros. now simpl.
+ Qed.
+
+Lemma helper2: forall {A} (l: list A) a, Datatypes.length (l ++ [a]) = S (Datatypes.length l).
+Proof. intros A l.
+       induction l; intros.
+       - now simpl.
+       - simpl. now rewrite IHl.
+Qed. 
+
+Lemma length_shr_lit_be: forall a, length (_shr_lit_be a) = length a.
+Proof. intro a.
+       induction a; intros.
+       - now simpl.
+       - unfold _shr_lit_be. simpl.
+         case_eq a0; intros.
+         + easy.
+         + simpl. apply f_equal.
+           case_eq l; intros. 
+           now simpl.
+           simpl. now rewrite helper2.
+Qed.
+
+Lemma length_nshr_lit_be: forall n a, length (nshr_lit_be a n) = length a.
+Proof. intros n.
+       induction n; intros.
+       - now simpl.
+       - simpl. rewrite (IHn (_shr_lit_be a)).
+         simpl. unfold nshr_lit_be. now rewrite length_shr_lit_be.
+Qed.
+
+Lemma length_shr_be: forall a b, length a = length (shr_lit_be a b).
+Proof. intros. unfold shr_lit_be. now rewrite length_nshr_lit_be. Qed.
+
+Lemma length_check_shsr: forall bs1 bs2 bsres , 
+  check_shr bs1 bs2 bsres = true -> length bs1 = length bs2 -> length bs1 = length bsres.
+Proof. intro bs1.
+       induction bs1; intros.
+       - case_eq bs2; simpl; intros.
+         + subst. unfold check_shl in H. simpl in H.
+           case_eq bsres; simpl; intros; subst; easy.
+         + rewrite H1 in H. unfold check_shl in H. simpl in H.
+           now contradict H.
+       - simpl in *.
+         unfold check_shr in H. simpl in H.
+         case_eq bs2; simpl; intros; subst. simpl in H. now contradict H.
+         simpl in *. inversion H0. rewrite H2, Structures.nat_eqb_refl in H.
+         case_eq (forallb2 eq_carry_lit (lit_to_carry (shr_lit_be (a :: bs1) (b :: l))) bsres); intros.
+         +  apply prop_eq_carry_lit2 in H1.
+            rewrite prop_interp_carry3 in H1.
+            simpl in H1.
+            assert (length (map (Lit.interp rho) (shr_lit_be (a :: bs1) (b :: l))) = 
+                    length (map (Lit.interp rho) bsres)).
+            { now rewrite H1. }
+            rewrite !map_length in H3.
+            rewrite <- (length_shr_be (a :: bs1) (b :: l)) in H3.
+            now simpl in *.
+        + rewrite H1 in H; now contradict H.
+Qed.
+
+Lemma prop_shr_be: forall a, RAWBITVECTOR_LIST._shr_be (map (Lit.interp rho) a) =
+ (map (Lit.interp rho) (_shr_lit_be a)).
+Proof. intro a.  
+       case_eq a; intros.
+       - now simpl.
+       - unfold RAWBITVECTOR_LIST._shr_be, _shr_lit_be. simpl.
+         rewrite map_app. simpl.
+         assert (Lit.interp rho (Lit._false) = false).
+         { specialize (Lit.interp_false rho wf_rho). intros.
+           rewrite <- not_true_iff_false.
+           unfold not in *.
+           intros. now apply H0. 
+         }
+        now rewrite H0.
+Qed.
+
+Lemma nshr_interp: forall n bs1, 
+RAWBITVECTOR_LIST.nshr_be (map (Lit.interp rho) bs1) n =
+map (Lit.interp rho) (nshr_lit_be bs1 n).
+Proof. intro n.
+       induction n; intros.
+       - now simpl.
+       - simpl. specialize (@IHn (_shr_lit_be bs1)).
+         rewrite <- IHn. simpl.
+         now rewrite prop_shr_be.
+Qed.
+
+Lemma shr_interp: forall bs1 bs2, 
+RAWBITVECTOR_LIST.shr_be (map (Lit.interp rho) bs1) bs2 =
+map (Lit.interp rho) (shr_lit_be bs1 bs2).
+Proof. intros.
+       unfold RAWBITVECTOR_LIST.shr_be, shr_lit_be.
+       now rewrite nshr_interp.
+Qed.
+
+
+Lemma check_shr_bvshr: forall bs1 bs2 bsres , 
+  check_shr bs1 bs2 bsres = true ->
+  (RAWBITVECTOR_LIST.bv_shr (map (Lit.interp rho) bs1) bs2 =
+   (map (Lit.interp rho) bsres)).
+Proof. intro bs1.
+       induction bs1 as [ | xbs1 xsbs1 IHbs1 ].
+       - intros. simpl.
+         unfold check_shr, shr_lit_be in H.
+         case_eq (Structures.nat_eqb (@length int []) (length bs2)); intros.
+         rewrite Structures.nat_eqb_eq in H0.
+         rewrite <- H0 in H. simpl in H.
+         rewrite nshr_lit_empty in H.
+         case_eq bsres; intros. simpl.
+         now rewrite bv_shr_empty.
+         subst; now contradict H.
+         rewrite H0 in H; now contradict H.
+       - intros. unfold check_shr in H.
+         case_eq (Structures.nat_eqb (Datatypes.length (xbs1 :: xsbs1)) (Datatypes.length bs2)); intros.
+         rewrite H0 in H.
+         case_eq (
+          forallb2 eq_carry_lit (lit_to_carry (shr_lit_be (xbs1 :: xsbs1) bs2)) bsres); intros.
+         apply prop_eq_carry_lit2 in H1.
+         rewrite prop_interp_carry3 in H1.
+         
+         unfold RAWBITVECTOR_LIST.bv_shr.
+         rewrite Structures.nat_eqb_eq in H0.
+         unfold RAWBITVECTOR_LIST.size.
+         rewrite !map_length. rewrite H0, N.eqb_refl.
+         now rewrite <- H1, shr_interp.
+    
+         rewrite H1 in H; now contradict H.
+         rewrite H0 in H; now contradict H.
+Qed.
+
+
+Lemma valid_check_bbShr pos1 pos2 lres : C.valid rho (check_bbShr pos1 pos2 lres).
+Proof.
+      unfold check_bbShr.
+      case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true.
+      case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true.
+      case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true.
+      case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true.
+      case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6.
+      case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 (*bs2*) Heq7.
+      case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true).
+      intros a bsres Heq8.
+      case_eq (t_atom .[ a]); try (intros; now apply C.interp_true).
+      intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ]  a1' a2' Heq9; try (intros; now apply C.interp_true).
+       case_eq (t_atom .[ a2]); try (intros; now apply C.interp_true). intros c Heqa2.
+       case_eq c; try (intros; now apply C.interp_true). intros bv2 n0 Heqc.
+      (* BVshr *)
+      case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true).
+        case_eq (
+                check_shr bs1 bv2 bsres && (N.of_nat (Datatypes.length bs1) =? n)%N &&
+                (N.of_nat (Datatypes.length bv2) =? n)%N && (n0 =? n)%N
+        ); simpl; intros Heq11; try (now apply C.interp_true).
+
+        unfold C.valid. simpl. rewrite orb_false_r.
+        unfold Lit.interp. rewrite Heq5.
+        unfold Var.interp.
+        rewrite wf_interp_form; trivial. rewrite Heq8. simpl.
+
+        apply BITVECTOR_LIST.bv_eq_reflect.
+
+        generalize wt_t_atom. unfold Atom.wt. unfold is_true.
+        rewrite PArray.forallbi_spec;intros.
+
+        pose proof (H a). 
+        assert (a < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. }
+        specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0.
+        rewrite !andb_true_iff in H0. destruct H0. destruct H0.
+
+        pose proof (H a2). 
+        assert (a2 < PArray.length t_atom).
+        { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heqa2, Heqc. easy. }
+        specialize (@H4 H5). rewrite Heqa2 in H4. simpl in H4.
+
+        unfold get_type' in H0. unfold v_type in H0.
+        case_eq (t_interp .[ a]).
+        intros v_typea v_vala Htia. rewrite Htia in H0.
+        case_eq (v_typea);  intros; rewrite H6 in H0; try (now contradict H0).
+        rename H6 into Hv.
+
+        generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1.
+        unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1.
+        unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1.
+        rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1.
+
+        generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2.
+        unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2.
+        unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2.
+        rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2.
+
+        (*apply BITVECTOR_LIST.bv_eq_reflect in HSp2.*)
+        apply BITVECTOR_LIST.bv_eq_reflect in HSp1.
+
+        (** case a1 = a1' and a2 = a2' **)
+        rewrite andb_true_iff in Heq10.
+        destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2;
+        rewrite Heq10a1, Heq10a2 in *.
+
+        unfold get_type' in H2, H3. unfold v_type in H2, H3.
+        case_eq (t_interp .[ a1']).
+          intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3.
+        case_eq (t_interp .[ a2']).
+          intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2.
+        rewrite Atom.t_interp_wf in Htia1; trivial.
+        rewrite Atom.t_interp_wf in Htia2; trivial.
+        unfold apply_binop.
+        apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3.
+
+
+        (* interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a])) *)
+        assert (interp_form_hatom_bv a = 
+                interp_bv t_i (interp_atom (t_atom .[a]))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia. easy.
+        }
+
+        rewrite H6. rewrite Heq9. simpl.
+        unfold interp_bv. unfold apply_binop.
+
+        rewrite !Atom.t_interp_wf; trivial.
+
+        revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2.
+        intros v_vala2 Htia2 v_vala1 Htia1.
+        rewrite Htia1, Htia2.
+        rewrite !Typ.cast_refl.
+        unfold Bval.
+
+        assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n%N).
+        { 
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d).
+          apply length_check_shsr in Heq11.
+          rewrite map_length, <- Heq11.
+          now apply N.eqb_eq in Heq11l.
+          apply N.eqb_eq in Heq11r.
+          apply N.eqb_eq in Heq11l.
+          apply (f_equal (N.to_nat)) in Heq11l.
+          apply (f_equal (N.to_nat)) in Heq11r.
+          rewrite Nat2N.id in Heq11l, Heq11r.
+          now rewrite Heq11l, Heq11r.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)).
+
+        rewrite H100.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        (* interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1'])) *)
+        assert (interp_form_hatom_bv a1' = 
+                interp_bv t_i (interp_atom (t_atom .[a1']))).
+        {
+          rewrite !Atom.t_interp_wf in Htia; trivial.
+          rewrite Htia1.
+          unfold Atom.interp_form_hatom_bv.
+          unfold Atom.interp_hatom.
+          rewrite !Atom.t_interp_wf; trivial.
+          rewrite Htia1. easy.
+        }
+
+        rewrite H7 in HSp1.
+        unfold interp_bv in HSp1.
+        rewrite Htia1 in HSp1.
+        unfold interp_bv in HSp1. 
+
+        revert HSp1.
+
+        assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n).
+        {
+          rewrite !andb_true_iff in Heq11.
+          destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d).
+          rewrite map_length.
+          now apply N.eqb_eq in Heq11l.
+        }
+
+        unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits.
+
+        generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)).
+
+        rewrite H101.
+        rewrite Typ.cast_refl. intros.
+        simpl.
+
+        rewrite HSp1.
+
+        rewrite Heqa2 in Htia2. simpl in Htia2.
+        unfold interp_cop in Htia2. rewrite Heqc in Htia2. unfold Bval in Htia2.
+        rewrite !andb_true_iff in Heq11.
+        destruct Heq11 as (((Heq1a, Heq11b), Heq11c), Heq11d).
+        apply N.eqb_eq in Heq11d.
+        rewrite Heq11d in *.
+        specialize (Bval_inj2 _  (Typ.TBV n) (BITVECTOR_LIST._of_bits bv2 n) v_vala2); intros.
+        apply H8 in Htia2. rewrite <- Htia2.
+
+        unfold BITVECTOR_LIST.bv_shr.
+        apply eq_rec. simpl.
+        apply check_shr_bvshr.
+
+        now unfold RAWBITVECTOR_LIST._of_bits; rewrite Heq11c.
+Qed.
+
+  End Proof.
+
+End Checker.
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/classes/SMT_classes.v b/src/classes/SMT_classes.v
new file mode 100644
index 0000000..5f79faf
--- /dev/null
+++ b/src/classes/SMT_classes.v
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool OrderedType.
+
+(** This file defines a number of typeclasses which are useful to build the
+    terms of SMT (in particular arrays indexed by instances of these
+    classes). *)
+
+
+(** Boolean equality to decidable equality *)
+Definition eqb_to_eq_dec :
+  forall T (eqb : T -> T -> bool) (eqb_spec : forall x y, eqb x y = true <-> x = y) (x y : T),
+    { x = y } + { x <> y }.
+  intros.
+  case_eq (eqb x y); intro.
+  left. apply eqb_spec; auto.
+  right. red. intro. apply eqb_spec in H0. rewrite H in H0. now contradict H0.
+  Defined.
+
+
+(** Types with a Boolean equality that reflects in Leibniz equality *)
+Class EqbType T := {
+ eqb : T -> T -> bool;
+ eqb_spec : forall x y, eqb x y = true <-> x = y
+}.
+
+
+(** Types with a decidable equality *)
+Class DecType T := {
+ eq_refl : forall x : T, x = x;
+ eq_sym : forall x y : T, x = y -> y = x;
+ eq_trans : forall x y z : T, x = y -> y = z -> x = z;
+ eq_dec : forall x y : T, { x = y } + { x <> y }
+}.
+
+
+Hint Immediate eq_sym.
+Hint Resolve eq_refl eq_trans.
+
+(** Types equipped with Boolean equality are decidable *)
+Instance EqbToDecType T `(EqbType T) : DecType T.
+Proof.
+  destruct H.
+  split; auto.
+  intros; subst; auto.
+  apply (eqb_to_eq_dec _ eqb0); auto.
+Defined.
+
+
+(** Class of types with a partial order *)
+Class OrdType T := {
+  lt: T -> T -> Prop;
+  lt_trans : forall x y z : T, lt x y -> lt y z -> lt x z;
+  lt_not_eq : forall x y : T, lt x y -> ~ eq x y
+  (* compare : forall x y : T, Compare lt eq x y *)
+}.
+
+Hint Resolve lt_not_eq lt_trans.
+
+
+Global Instance StrictOrder_OrdType T `(OrdType T) :
+  StrictOrder (lt : T -> T -> Prop).
+Proof.
+  split.
+  unfold Irreflexive, Reflexive, complement.
+  intros. apply lt_not_eq in H0; auto.
+  unfold Transitive. intros x y z. apply lt_trans.
+Qed.
+
+(** Augment class of partial order with a compare function to obtain a total
+    order *)
+Class Comparable T {ot:OrdType T} := {
+  compare : forall x y : T, Compare lt eq x y
+}.
+
+
+(** Class of inhabited types *)
+Class Inhabited T := {
+  default_value : T
+}.
+
+(** * CompDec: Merging all previous classes *)
+
+Class CompDec T := {
+  ty := T;
+  Eqb :> EqbType ty;
+  Decidable := EqbToDecType ty Eqb;
+  Ordered :> OrdType ty;       
+  Comp :> @Comparable ty Ordered;
+  Inh :> Inhabited ty
+}.
+
+
+Instance ord_of_compdec t `{c: CompDec t} : (OrdType t) := 
+  let (_, _, _, ord, _, _) := c in ord.
+
+Instance inh_of_compdec t `{c: CompDec t} : (Inhabited t) := 
+  let (_, _, _, _, _, inh) := c in inh.
+
+Instance comp_of_compdec t `{c: CompDec t} : @Comparable t (ord_of_compdec t).
+destruct c; trivial.
+Defined.
+
+Instance eqbtype_of_compdec t `{c: CompDec t} : EqbType t :=
+  let (_, eqbtype, _, _, _, inh) := c in eqbtype.
+
+Instance dec_of_compdec t `{c: CompDec t} : DecType t :=
+  let (_, _, dec, _, _, inh) := c in dec.
+
+
+Definition type_compdec {ty:Type} (cd : CompDec ty) := ty.
+
+Definition eqb_of_compdec {t} (c : CompDec t) : t -> t -> bool :=
+  match c with
+  | {| ty := ty; Eqb := {| eqb := eqb |} |} => eqb
+  end.
+
+
+Lemma compdec_eq_eqb {T:Type} {c : CompDec T} : forall x y : T,
+    x = y <-> eqb_of_compdec c x y = true.
+Proof.
+  destruct c. destruct Eqb0.
+  simpl. intros. rewrite eqb_spec0. reflexivity.
+Qed.
+
+Hint Resolve
+     ord_of_compdec
+     inh_of_compdec
+     comp_of_compdec
+     eqbtype_of_compdec
+     dec_of_compdec : typeclass_instances.
+
+
+Record typ_compdec : Type := Typ_compdec {
+  te_carrier : Type;
+  te_compdec : CompDec te_carrier
+}.
+
+Section CompDec_from.
+
+  Variable T : Type.
+  Variable eqb' : T -> T -> bool.
+  Variable lt' : T -> T -> Prop.
+  Variable d : T.
+
+  Hypothesis eqb_spec' : forall x y : T, eqb' x y = true <-> x = y.
+  Hypothesis lt_trans': forall x y z : T, lt' x y -> lt' y z -> lt' x z.
+  Hypothesis lt_neq': forall x y : T, lt' x y -> x <> y.
+  
+  Variable compare': forall x y : T, Compare lt' eq x y.
+  
+  Program Instance CompDec_from : (CompDec T) := {|
+    Eqb := {| eqb := eqb' |};
+    Ordered := {| lt := lt'; lt_trans := lt_trans' |};
+    Comp := {| compare := compare' |};
+    Inh := {| default_value := d |}
+  |}.
+
+  
+  Definition typ_compdec_from : typ_compdec :=
+    Typ_compdec T CompDec_from.
+  
+End CompDec_from.
diff --git a/src/classes/SMT_classes_instances.v b/src/classes/SMT_classes_instances.v
new file mode 100644
index 0000000..d6180a0
--- /dev/null
+++ b/src/classes/SMT_classes_instances.v
@@ -0,0 +1,600 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool OrderedType BinPos ZArith.
+Require Import Int63.
+Require Import State BVList.
+Require Structures.
+Require Export SMT_classes.
+
+
+Section Unit.
+
+  Let eqb : unit -> unit -> bool := fun _ _ => true.
+
+  Let lt : unit -> unit -> Prop := fun _ _ => False.
+  
+  Instance unit_ord : OrdType unit.
+  Proof. exists lt; unfold lt; trivial.
+    intros; contradict H; trivial.
+  Defined.
+
+  Instance unit_eqbtype : EqbType unit.
+  Proof.
+    exists eqb. intros. destruct x, y. unfold eqb. split; trivial.
+  Defined.
+
+  Instance unit_comp : @Comparable unit unit_ord.
+  Proof.
+    split. intros. destruct x, y.
+    apply OrderedType.EQ; trivial.
+  Defined.
+
+  Instance unit_inh : Inhabited unit := {| default_value := tt |}.
+  
+  Instance unit_compdec : CompDec unit := {|
+    Eqb := unit_eqbtype;
+    Ordered := unit_ord;
+    Comp := unit_comp;
+    Inh := unit_inh
+  |}.
+
+
+  
+  Definition unit_typ_compdec := Typ_compdec unit unit_compdec.
+
+
+  Lemma eqb_eq_unit : forall x y, eqb x y <-> x = y.
+  Proof. intros. split; case x; case y; unfold eqb; intros; now auto.
+  Qed.
+  
+End Unit.
+
+
+Section Bool.
+
+  Definition ltb_bool x y := negb x && y.
+
+  Definition lt_bool x y := ltb_bool x y = true.
+  
+  Instance bool_ord : OrdType bool.
+  Proof.
+    exists lt_bool.
+    intros x y z.
+    case x; case y; case z; intros; simpl; subst; auto. 
+    intros x y.
+    case x; case y; intros; simpl in H; easy. 
+  Defined.
+
+  Instance bool_eqbtype : EqbType bool :=
+    {| eqb := Bool.eqb; eqb_spec := eqb_true_iff |}.
+  
+  Instance bool_dec : DecType bool :=
+    EqbToDecType _ bool_eqbtype.
+
+  Instance bool_comp: Comparable bool.
+  Proof.
+    constructor.
+    intros x y.
+    case_eq (ltb_bool x y).
+    intros.
+    apply OrderedType.LT.
+    unfold lt, bool_ord, lt_bool. auto.
+    case_eq (Bool.eqb x y).
+    intros.
+    apply OrderedType.EQ.
+    apply Bool.eqb_prop. auto.
+    intros.
+    apply OrderedType.GT.
+    unfold lt, bool_ord, lt_bool. auto.
+    case x in *; case y in *; auto.
+  Defined.
+
+  Instance bool_inh : Inhabited bool := {| default_value := false|}.
+
+  Instance bool_compdec : CompDec bool := {|
+    Eqb := bool_eqbtype;                                    
+    Ordered := bool_ord;                                    
+    Comp := bool_comp;
+    Inh := bool_inh
+  |}.
+
+
+  Lemma ltb_bool_iff_lt: forall x y, ltb_bool x y = true <-> lt_bool x y.
+  Proof. intros x y; split; intro H;
+         case_eq x; case_eq y; intros; subst; compute in *; easy.
+  Qed.
+
+End Bool.
+
+
+Section Z.
+
+  Require Import OrderedTypeEx.
+
+  Instance Z_ord : OrdType Z.
+  Proof.
+    exists Z_as_OT.lt.
+    exact Z_as_OT.lt_trans.
+    exact Z_as_OT.lt_not_eq.
+  Defined.
+
+  Instance Z_eqbtype : EqbType Z :=
+    {| eqb := Z.eqb; eqb_spec := Z.eqb_eq |}.
+
+  (* Instance Z_eqbtype : EqbType Z := *)
+  (*   {| eqb := Zeq_bool; eqb_spec := fun x y => symmetry (Zeq_is_eq_bool x y) |}. *)
+  
+  Instance Z_dec : DecType Z :=
+    EqbToDecType _ Z_eqbtype.
+
+  
+  Instance Z_comp: Comparable Z.
+  Proof.
+    constructor.
+    apply Z_as_OT.compare.
+  Defined.
+
+
+  Instance Z_inh : Inhabited Z := {| default_value := 0%Z |}.
+
+    
+  Instance Z_compdec : CompDec Z := {|
+    Eqb := Z_eqbtype;                                    
+    Ordered := Z_ord;                                    
+    Comp := Z_comp;
+    Inh := Z_inh
+  |}.
+
+  (** lt and eq predicates in Prop and their equivalences with the ones in bool *)
+  Definition eqP_Z x y := if Z.eqb x y then True else False.
+  Definition ltP_Z x y := if Z.ltb x y then True else False.
+  Definition leP_Z x y := if Z.leb x y then True else False.
+  Definition gtP_Z x y := if Z.gtb x y then True else False.
+  Definition geP_Z x y := if Z.geb x y then True else False.
+
+  Lemma eq_Z_B2P: forall x y, Z.eqb x y = true <-> eqP_Z x y.
+  Proof. intros x y; split; intro H.
+         unfold eqP_Z; now rewrite H.
+         unfold eqP_Z in H.
+         case_eq ((x =? y)%Z ); intros; try now subst.
+         rewrite H0 in H. now contradict H.
+  Qed.
+
+  Lemma lt_Z_B2P: forall x y, Z.ltb x y = true <-> ltP_Z x y.
+  Proof. intros x y; split; intro H.
+         unfold ltP_Z; now rewrite H.
+         unfold ltP_Z in H.
+         case_eq ((x <? y)%Z ); intros; try now subst.
+         rewrite H0 in H. now contradict H.
+  Qed.
+
+  Lemma le_Z_B2P: forall x y, Z.leb x y = true <-> leP_Z x y.
+  Proof. intros x y; split; intro H.
+         unfold leP_Z; now rewrite H.
+         unfold leP_Z in H.
+         case_eq ((x <=? y)%Z ); intros; try now subst.
+         rewrite H0 in H. now contradict H.
+  Qed.
+
+  Lemma gt_Z_B2P: forall x y, Z.gtb x y = true <-> gtP_Z x y.
+  Proof. intros x y; split; intro H.
+         unfold gtP_Z; now rewrite H.
+         unfold gtP_Z in H.
+         case_eq ((x >? y)%Z ); intros; try now subst.
+         rewrite H0 in H. now contradict H.
+  Qed.
+
+  Lemma ge_Z_B2P: forall x y, Z.geb x y = true <-> geP_Z x y.
+  Proof. intros x y; split; intro H.
+         unfold geP_Z; now rewrite H.
+         unfold geP_Z in H.
+         case_eq ((x >=? y)%Z ); intros; try now subst.
+         rewrite H0 in H. now contradict H.
+  Qed.
+
+  Lemma lt_Z_B2P': forall x y, ltP_Z x y <-> Z.lt x y.
+  Proof. intros x y; split; intro H.
+         unfold ltP_Z in H. 
+         case_eq ((x <? y)%Z ); intros; rewrite H0 in H; try easy.
+         now apply Z.ltb_lt in H0.
+         apply lt_Z_B2P.
+         now apply Z.ltb_lt.
+  Qed.
+
+  Lemma le_Z_B2P': forall x y, leP_Z x y <-> Z.le x y.
+  Proof. intros x y; split; intro H.
+         unfold leP_Z in H. 
+         case_eq ((x <=? y)%Z ); intros; rewrite H0 in H; try easy.
+         now apply Z.leb_le in H0.
+         apply le_Z_B2P.
+         now apply Z.leb_le.
+  Qed.
+
+  Lemma gt_Z_B2P': forall x y, gtP_Z x y <-> Z.gt x y.
+  Proof. intros x y; split; intro H.
+         unfold gtP_Z in H. 
+         case_eq ((x >? y)%Z ); intros; rewrite H0 in H; try easy.
+         now apply Zgt_is_gt_bool in H0.
+         apply gt_Z_B2P.
+         now apply Zgt_is_gt_bool.
+  Qed.
+
+  Lemma ge_Z_B2P': forall x y, geP_Z x y <-> Z.ge x y.
+  Proof. intros x y; split; intro H.
+         unfold geP_Z in H. 
+         case_eq ((x >=? y)%Z ); intros; rewrite H0 in H; try easy.
+         rewrite Z.geb_leb in H0. rewrite le_Z_B2P in H0.
+         apply le_Z_B2P' in H0. now apply Z.ge_le_iff.
+         apply ge_Z_B2P.
+         rewrite Z.geb_leb. rewrite le_Z_B2P.
+         apply le_Z_B2P'. now apply Z.ge_le_iff.
+  Qed.
+
+  Lemma leibniz_eq_Z_B2P: forall x y, eqP_Z x y <-> Logic.eq x y.
+  Proof. intros x y; split; intro H.
+         unfold eqP_Z in H. case_eq ((x =? y)%Z); intros.
+         now apply Z.eqb_eq in H0. rewrite H0 in H. now contradict H.
+         rewrite H. unfold eqP_Z. now rewrite Z.eqb_refl.
+  Qed.
+
+End Z.
+
+
+Section Nat.
+
+  Require Import OrderedTypeEx.
+
+  Instance Nat_ord : OrdType nat.
+  Proof.
+    
+    exists Nat_as_OT.lt.
+    exact Nat_as_OT.lt_trans.
+    exact Nat_as_OT.lt_not_eq.
+  Defined.
+
+  Instance Nat_eqbtype : EqbType nat :=
+    {| eqb := Structures.nat_eqb; eqb_spec := Structures.nat_eqb_eq |}.
+  
+  Instance Nat_dec : DecType nat :=
+    EqbToDecType _ Nat_eqbtype.
+
+  
+  Instance Nat_comp: Comparable nat.
+  Proof.
+    constructor.
+    apply Nat_as_OT.compare.
+  Defined.
+
+
+  Instance Nat_inh : Inhabited nat := {| default_value := O%nat |}.
+
+    
+  Instance Nat_compdec : CompDec nat := {|
+    Eqb := Nat_eqbtype;                                    
+    Ordered := Nat_ord;                                    
+    Comp := Nat_comp;
+    Inh := Nat_inh
+  |}.
+
+End Nat.
+
+
+Section Positive.
+
+  
+  Require Import OrderedTypeEx.
+
+  Instance Positive_ord : OrdType positive.
+  Proof.
+    exists Positive_as_OT.lt.
+    exact Positive_as_OT.lt_trans.
+    exact Positive_as_OT.lt_not_eq.
+  Defined.
+
+  Instance Positive_eqbtype : EqbType positive :=
+    {| eqb := Pos.eqb; eqb_spec := Pos.eqb_eq |}.
+  
+  Instance Positive_dec : DecType positive :=
+    EqbToDecType _ Positive_eqbtype.
+
+  Instance Positive_comp: Comparable positive.
+  Proof.
+    constructor.
+    apply Positive_as_OT.compare.
+  Defined.
+
+  Instance Positive_inh : Inhabited positive := {| default_value := 1%positive |}.
+
+  Instance Positive_compdec : CompDec positive := {|
+    Eqb := Positive_eqbtype;                                    
+    Ordered := Positive_ord;                                    
+    Comp := Positive_comp;
+    Inh := Positive_inh
+  |}.
+
+
+End Positive.
+
+
+Section BV.
+
+  Import BITVECTOR_LIST.
+
+  
+  Instance BV_ord n : OrdType (bitvector n).
+  Proof.
+    exists (fun a b => (bv_ult a b)).
+    unfold bv_ult, RAWBITVECTOR_LIST.bv_ult.
+    intros x y z; destruct x, y, z.
+    simpl. rewrite wf0, wf1, wf2. rewrite N.eqb_refl. simpl.
+    apply RAWBITVECTOR_LIST.ult_list_trans.
+    intros x y; destruct x, y.
+    simpl.
+    intros. unfold not.
+    intros. rewrite H0 in H.
+    unfold bv_ult, bv in *.
+    unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.size in H.
+    rewrite N.eqb_refl in H.
+    apply RAWBITVECTOR_LIST.ult_list_not_eq in H.
+    apply H. easy.
+  Defined.
+
+  Instance BV_eqbtype n : EqbType (bitvector n) :=
+    {| eqb := @bv_eq n;
+       eqb_spec := @bv_eq_reflect n |}.
+
+  Instance BV_dec n : DecType (bitvector n) :=
+    EqbToDecType _ (BV_eqbtype n).
+
+  
+  Instance BV_comp n: Comparable (bitvector n).
+  Proof.
+    constructor.
+    intros x y.
+    case_eq (bv_ult x y).
+    intros.
+    apply OrderedType.LT.
+    unfold lt, BV_ord. auto.
+    case_eq (bv_eq x y).
+    intros.
+    apply OrderedType.EQ.
+    apply bv_eq_reflect. auto.
+    intros.
+    apply OrderedType.GT.
+    unfold lt, BV_ord. auto.
+    destruct (BV_ord n).
+    unfold bv_ult.
+    unfold bv_eq, RAWBITVECTOR_LIST.bv_eq,
+    RAWBITVECTOR_LIST.bits in H.
+    unfold bv_ult, RAWBITVECTOR_LIST.bv_ult in H0.
+    unfold is_true.
+
+    unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.size.
+    destruct x, y. simpl in *.
+    unfold RAWBITVECTOR_LIST.size in *.
+    rewrite wf0, wf1 in *.
+    rewrite N.eqb_refl in *.
+
+    apply RAWBITVECTOR_LIST.nlt_be_neq_gt.
+    rewrite !List.rev_length.
+    apply (f_equal (N.to_nat)) in wf0.
+    apply (f_equal (N.to_nat)) in wf1.
+    rewrite Nnat.Nat2N.id in wf0, wf1.
+    now rewrite wf0, wf1.
+    unfold RAWBITVECTOR_LIST.ult_list in H0. easy.
+    now apply RAWBITVECTOR_LIST.rev_neq in H.
+  Defined.
+
+  Instance BV_inh n : Inhabited (bitvector n) :=
+    {| default_value := zeros n |}.
+
+
+  Instance BV_compdec n: CompDec (bitvector n) := {|
+    Eqb := BV_eqbtype n;                                    
+    Ordered := BV_ord n;                                    
+    Comp := BV_comp n;
+    Inh := BV_inh n
+  |}.
+
+End BV.
+
+
+
+Section FArray.
+
+  Require Import FArray.
+  
+  Instance FArray_ord key elt
+           `{key_ord: OrdType key}
+           `{elt_ord: OrdType elt}
+           `{elt_dec: DecType elt}
+           `{elt_inh: Inhabited elt}
+           `{key_comp: @Comparable key key_ord} : OrdType (farray key elt).
+  Proof.
+    exists (@lt_farray key elt key_ord key_comp elt_ord elt_inh).
+    apply lt_farray_trans.
+    unfold not.
+    intros.
+    apply lt_farray_not_eq in H.
+    apply H.
+    rewrite H0.
+    apply eqfarray_refl. auto.
+  Defined.
+
+  Instance FArray_eqbtype key elt
+           `{key_ord: OrdType key}
+           `{elt_ord: OrdType elt}
+           `{elt_eqbtype: EqbType elt}
+           `{key_comp: @Comparable key key_ord}
+           `{elt_comp: @Comparable elt elt_ord}
+           `{elt_inh: Inhabited elt}
+    : EqbType (farray key elt).
+  Proof.
+    exists FArray.equal.
+    intros.
+    split.
+    apply FArray.equal_eq.
+    intros. subst. apply eq_equal. apply eqfarray_refl.
+    apply EqbToDecType. auto.
+  Defined.
+
+  
+  Instance FArray_dec key elt
+           `{key_ord: OrdType key}
+           `{elt_ord: OrdType elt}
+           `{elt_eqbtype: EqbType elt}
+           `{key_comp: @Comparable key key_ord}
+           `{elt_comp: @Comparable elt elt_ord}
+           `{elt_inh: Inhabited elt}
+    : DecType (farray key elt) :=
+    EqbToDecType _ (FArray_eqbtype key elt).
+
+  
+  Instance FArray_comp key elt
+           `{key_ord: OrdType key}
+           `{elt_ord: OrdType elt}
+           `{elt_eqbtype: EqbType elt}
+           `{key_comp: @Comparable key key_ord}
+           `{elt_inh: Inhabited elt}
+           `{elt_comp: @Comparable elt elt_ord} : Comparable (farray key elt).
+  Proof.
+    constructor.
+    intros.
+    destruct (compare_farray key_comp (EqbToDecType _ elt_eqbtype) elt_comp x y).
+    - apply OrderedType.LT. auto.
+    - apply OrderedType.EQ.
+      specialize (@eq_equal key elt key_ord key_comp elt_ord elt_comp elt_inh x y).
+      intros.
+      apply H in e.
+      now apply equal_eq in e.
+    - apply OrderedType.GT. auto.
+  Defined.
+
+  Instance FArray_inh key elt
+           `{key_ord: OrdType key}
+           `{elt_inh: Inhabited elt} : Inhabited (farray key elt) :=
+    {| default_value := FArray.empty key_ord elt_inh |}.
+
+
+  Program Instance FArray_compdec key elt
+          `{key_compdec: CompDec key}
+          `{elt_compdec: CompDec elt} :
+    CompDec (farray key elt) :=
+    {|
+      Eqb := FArray_eqbtype key elt;
+      Ordered := FArray_ord key elt;
+      (*  Comp := FArray_comp key elt ; *)
+      Inh := FArray_inh key elt
+    |}.
+  
+  Next Obligation.
+    constructor.
+    destruct key_compdec, elt_compdec.
+    simpl in *.
+    unfold lt_farray.
+    intros. simpl.
+    unfold EqbToDecType. simpl.
+    case_eq (compare x y); intros.
+    apply OrderedType.LT.
+    destruct (compare x y); try discriminate H; auto.
+    apply OrderedType.EQ.
+    destruct (compare x y); try discriminate H; auto.
+    apply OrderedType.GT.
+    destruct (compare y x); try discriminate H; auto; clear H.
+  Defined.
+
+End FArray.
+
+
+Section Int63.
+  
+  Local Open Scope int63_scope.
+
+  Let int_lt x y :=
+    if Int63Native.ltb x y then True else False.
+  
+  Instance int63_ord : OrdType int.
+  Proof.
+    exists int_lt; unfold int_lt.
+    - intros x y z. 
+      case_eq (x < y); intro;
+        case_eq (y < z); intro;
+          case_eq (x < z); intro;
+            simpl; try easy.
+      contradict H1.
+      rewrite not_false_iff_true.
+      rewrite Int63Axioms.ltb_spec in *.
+      exact (Z.lt_trans _ _ _ H H0).
+    - intros x y.
+      case_eq (x < y); intro; simpl; try easy.
+      intros.
+      rewrite Int63Axioms.ltb_spec in *.
+      rewrite <- Int63Properties.to_Z_eq.
+      exact (Z.lt_neq _ _ H).
+  Defined.
+  
+  Instance int63_eqbtype : EqbType int :=
+    {| eqb := Int63Native.eqb; eqb_spec := Int63Properties.eqb_spec |}.
+
+  Instance int63_dec : DecType int :=
+    EqbToDecType _ int63_eqbtype.
+
+
+  Instance int63_comp: Comparable int.
+  Proof.
+    constructor.
+    intros x y.
+    case_eq (x < y); intro;
+      case_eq (x == y); intro; unfold lt in *; simpl.
+    - rewrite Int63Properties.eqb_spec in H0.
+      contradict H0.
+      assert (int_lt x y). unfold int_lt.
+      rewrite H; trivial.
+      remember lt_not_eq. unfold lt in *. simpl in n.
+      exact (n _ _ H0).
+    - apply LT. unfold int_lt. rewrite H; trivial.
+    - apply EQ. rewrite Int63Properties.eqb_spec in H0; trivial.
+    - apply GT. unfold int_lt.
+      case_eq (y < x); intro; simpl; try easy.
+      specialize (leb_ltb_eqb x y); intro.
+      contradict H2.
+      rewrite leb_negb_gtb. rewrite H1. simpl.
+      red. intro. symmetry in H2.
+      rewrite orb_true_iff in H2. destruct H2; contradict H2.
+      rewrite H. auto.
+      rewrite H0. auto.
+  Defined.
+
+
+  Instance int63_inh : Inhabited int := {| default_value := 0 |}.
+    
+  Instance int63_compdec : CompDec int := {|
+    Eqb := int63_eqbtype;                                    
+    Ordered := int63_ord;                                    
+    Comp := int63_comp;
+    Inh := int63_inh
+  |}.
+         
+
+End Int63.
+
+
+Hint Resolve unit_ord bool_ord Z_ord Positive_ord BV_ord FArray_ord : typeclass_instances.
+Hint Resolve unit_eqbtype bool_eqbtype Z_eqbtype Positive_eqbtype BV_eqbtype FArray_eqbtype : typeclass_instances.
+Hint Resolve bool_dec Z_dec Positive_dec BV_dec FArray_dec : typeclass_instances.
+Hint Resolve unit_comp bool_comp Z_comp Positive_comp BV_comp FArray_comp : typeclass_instances.
+Hint Resolve unit_inh bool_inh Z_inh Positive_inh BV_inh FArray_inh : typeclass_instances.
+Hint Resolve unit_compdec bool_compdec Z_compdec Positive_compdec BV_compdec FArray_compdec : typeclass_instances.
+
+Hint Resolve int63_ord int63_inh int63_eqbtype int63_dec int63_comp int63_compdec
+  : typeclass_instances.
diff --git a/src/cnf/Cnf.v b/src/cnf/Cnf.v
index b5ecfb0..73f9f97 100644
--- a/src/cnf/Cnf.v
+++ b/src/cnf/Cnf.v
@@ -1,22 +1,17 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
-(* Add LoadPath ".." as SMTCoq. *)
 Require Import PArray List Bool.
-Require Import Misc State SMT_terms.
+Require Import Misc State SMT_terms BVList.
 
 Import Form.
 
@@ -255,14 +250,15 @@ Section CHECKER.
   (** The correctness proofs *)
 
   Variable interp_atom : atom -> bool.
+  Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s.
 
   Hypothesis Hch_f : check_form t_form.
 
-  Local Notation rho := (Form.interp_state_var interp_atom t_form).
+  Local Notation rho := (Form.interp_state_var interp_atom interp_bvatom t_form).
 
   Let Hwfrho : Valuation.wf rho.
   Proof.
-    destruct (check_form_correct interp_atom _ Hch_f) as (_, H);exact H. 
+    destruct (check_form_correct interp_atom interp_bvatom _ Hch_f) as (_, H);exact H. 
   Qed.
 
   Lemma valid_check_True : C.valid rho check_True.
@@ -279,9 +275,9 @@ Section CHECKER.
   Qed.
 
   Let rho_interp : forall x : int,
-    rho x = interp interp_atom t_form (t_form.[ x]).
+    rho x = interp interp_atom interp_bvatom t_form (t_form.[ x]).
   Proof.
-    destruct (check_form_correct interp_atom _ Hch_f) as ((H,H0), _).
+    destruct (check_form_correct interp_atom interp_bvatom _ Hch_f) as ((H,H0), _).
     intros x;apply wf_interp_form;trivial.
   Qed.
 
diff --git a/src/euf/Euf.v b/src/euf/Euf.v
index 70b23da..7818246 100644
--- a/src/euf/Euf.v
+++ b/src/euf/Euf.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,7 +12,6 @@
 
 Require Import Bool List Int63 PArray.
 Require Import State SMT_terms.
-
 Local Open Scope array_scope.
 Local Open Scope int63_scope.
 
@@ -141,7 +136,7 @@ Section certif.
 
   Section Proof.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -153,8 +148,11 @@ Section certif.
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
 
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
+
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
     Let wf_t_atom : Atom.wf t_atom.
     Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
@@ -164,32 +162,32 @@ Section certif.
 
     Let def_t_form : default t_form = Form.Ftrue.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
     Qed.
 
     Let wf_t_form : Form.wf t_form.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
     Qed.
 
     Let wf_rho : Valuation.wf rho.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto.
     Qed.
 
     Lemma valid_C_true : C.interp rho C._true.
     Proof.
       apply C.interp_true.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form);trivial.
     Qed.
     Hint Resolve valid_C_true.
 
     Local Notation interp := (Atom.interp t_i t_func t_atom).
 
     Lemma wf_interp_form : forall x,
-       rho x = Form.interp interp_form_hatom t_form (t_form.[x]).
+       rho x = Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form.[x]).
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form).
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form).
       destruct H; intros x;rewrite Form.wf_interp_form;trivial.
     Qed.
 
@@ -248,8 +246,8 @@ Section certif.
       destruct (Typ.cast ta u);destruct (Typ.cast tb u);trivial.
       apply f_equal; apply eq_true_iff_eq.
       match goal with |- ?x = _ <-> ?y = _ =>
-         change (is_true x <-> is_true y) end.
-      rewrite !Typ.i_eqb_spec;split;auto.
+                      change (is_true x <-> is_true y) end.
+      split; intro; rewrite Typ.i_eqb_sym in H; auto.
     Qed.
 
     Lemma interp_binop_eqb_trans:
@@ -270,7 +268,7 @@ Section certif.
       unfold Atom.interp_hatom.
       rewrite HHa, HHb, HHc;simpl;rewrite Typ.cast_refl.
       unfold Atom.interp_bool;simpl.
-      rewrite !Typ.i_eqb_spec;intros HH;rewrite HH;trivial.
+      apply Typ.i_eqb_trans.
     Qed.
 
     Lemma check_trans_aux_correct :
@@ -291,9 +289,9 @@ Section certif.
       rewrite eqb_spec in H7. rewrite eqb_spec in H8. subst.
       tunicity. subst t. rewrite H4, H1;auto.
       rewrite eqb_spec in H7. rewrite eqb_spec in H8. subst.
-      tunicity;subst t;rewrite interp_binop_eqb_sym in H1;rewrite H4, H1;auto.
+      tunicity. subst t;rewrite interp_binop_eqb_sym in H1;rewrite H4, H1;auto.
       apply get_eq_interp;intros.
-      destruct (Int63Properties.reflect_eqb t2 b). subst;tunicity; subst t.
+      destruct (Int63Properties.reflect_eqb t2 b);subst;tunicity; try subst t.
       apply (IHeqs u);trivial.
       simpl;unfold is_true;rewrite orb_true_iff.
       rewrite Lit.interp_nlit;unfold Var.interp.
@@ -318,7 +316,7 @@ Section certif.
       case_eq (rho (Lit.blit a));[rewrite H4; intros | simpl;auto].
       destruct H1;[left | auto].
       apply interp_binop_eqb_trans with (5:= H1);trivial.
-      destruct (Int63Properties.reflect_eqb t1 a0);[subst;tunicity; try subst t|auto].
+      destruct (Int63Properties.reflect_eqb t1 a0);[subst;tunicity;try subst t|auto].
       apply (IHeqs u);trivial.
       simpl;unfold is_true;rewrite orb_true_iff.
       rewrite Lit.interp_nlit;unfold Var.interp.
@@ -345,7 +343,7 @@ Section certif.
       generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H3. unfold Atom.get_type in H3. rewrite H3. intros [vb HHb].
       unfold Atom.interp_hatom.
       rewrite HHb;simpl;rewrite Typ.cast_refl;simpl.
-      rewrite !Typ.i_eqb_spec;trivial.
+      apply Typ.i_eqb_refl.
       auto.
       apply get_eq_interp;intros.
       apply check_trans_aux_correct with t;trivial.
@@ -412,9 +410,10 @@ Section certif.
        inversion H6;subst.
        unfold Atom.interp_hatom in H10.
        rewrite <- HHa; rewrite <- HHb, H10;trivial.
-      rewrite Typ.i_eqb_spec.
-      inversion H7.
-      apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+       inversion H7.
+       apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+       rewrite H9.
+       apply Typ.i_eqb_refl.
       intros x y;destruct (Typ.reflect_eqb x y);auto.
       (* bop *)
       destruct (Atom.reflect_bop_eqb b0 b1);[subst | auto].
@@ -432,9 +431,10 @@ Section certif.
        inversion H12;clear H12;subst.
        unfold Atom.interp_hatom in H10, H8.
        rewrite <- HHa. rewrite <- HHb, H10, H8;trivial.
-      rewrite Typ.i_eqb_spec.
       inversion H7.
       apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+      rewrite H9.
+      apply Typ.i_eqb_refl.
       intros x y;destruct (Typ.reflect_eqb x y);auto.
       (* op *)
       destruct (Int63Properties.reflect_eqb i i0);[subst | auto].
@@ -453,9 +453,10 @@ Section certif.
         induction H6;simpl;trivial.
         unfold Atom.interp_hatom in H4.
         rewrite IHForall2, H4;trivial.
-      rewrite Typ.i_eqb_spec.
       inversion H7.
       apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+      rewrite H9.
+      apply Typ.i_eqb_refl.
       intros x y;destruct (Typ.reflect_eqb x y);auto.
     Qed.
 
@@ -537,3 +538,10 @@ Section certif.
   End Proof.
 
 End certif.
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/extraction/Extract.v b/src/extraction/Extract.v
index 2663fb3..30d6f8d 100644
--- a/src/extraction/Extract.v
+++ b/src/extraction/Extract.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/extrNative.ml b/src/extraction/extrNative.ml
index d8d1265..6ce641b 100644
--- a/src/extraction/extrNative.ml
+++ b/src/extraction/extrNative.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/extrNative.mli b/src/extraction/extrNative.mli
index 3f255bf..48d2df6 100644
--- a/src/extraction/extrNative.mli
+++ b/src/extraction/extrNative.mli
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/sat_checker.ml b/src/extraction/sat_checker.ml
index 0ed36a3..ff366d0 100644
--- a/src/extraction/sat_checker.ml
+++ b/src/extraction/sat_checker.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/sat_checker.mli b/src/extraction/sat_checker.mli
index ed63e26..e61dc0d 100644
--- a/src/extraction/sat_checker.mli
+++ b/src/extraction/sat_checker.mli
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/smt_checker.ml b/src/extraction/smt_checker.ml
index ed446b7..3434340 100644
--- a/src/extraction/smt_checker.ml
+++ b/src/extraction/smt_checker.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/smt_checker.mli b/src/extraction/smt_checker.mli
index 2fbf9b8..c244c06 100644
--- a/src/extraction/smt_checker.mli
+++ b/src/extraction/smt_checker.mli
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/smtcoq.ml b/src/extraction/smtcoq.ml
index 07ed9a3..d7633e9 100644
--- a/src/extraction/smtcoq.ml
+++ b/src/extraction/smtcoq.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/smtcoq.mli b/src/extraction/smtcoq.mli
index 7b33e0f..b0b18b1 100644
--- a/src/extraction/smtcoq.mli
+++ b/src/extraction/smtcoq.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 type solver = Zchaff | Verit
 val usage : string
 val string_of_solver : solver -> string
diff --git a/src/extraction/test.ml b/src/extraction/test.ml
index f91a661..a523389 100644
--- a/src/extraction/test.ml
+++ b/src/extraction/test.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/test.mli b/src/extraction/test.mli
deleted file mode 100644
index 8b13789..0000000
--- a/src/extraction/test.mli
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/extraction/verit_checker.ml b/src/extraction/verit_checker.ml
index 3f9a701..1471134 100644
--- a/src/extraction/verit_checker.ml
+++ b/src/extraction/verit_checker.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/verit_checker.mli b/src/extraction/verit_checker.mli
index 3c43d22..a8ac01e 100644
--- a/src/extraction/verit_checker.mli
+++ b/src/extraction/verit_checker.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 module Mc = Structures.Micromega_plugin_Certificate.Mc
 val mkInt : int -> ExtrNative.uint
 val mkArray : 'a array -> 'a ExtrNative.parray
diff --git a/src/extraction/zchaff_checker.ml b/src/extraction/zchaff_checker.ml
index eb28fe8..124a1c3 100644
--- a/src/extraction/zchaff_checker.ml
+++ b/src/extraction/zchaff_checker.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/extraction/zchaff_checker.mli b/src/extraction/zchaff_checker.mli
index d24a1e3..ffaf5d1 100644
--- a/src/extraction/zchaff_checker.mli
+++ b/src/extraction/zchaff_checker.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val mkInt : int -> ExtrNative.uint
 val mkArray : 'a array -> 'a ExtrNative.parray
 val make_roots :
diff --git a/src/lfsc/Makefile b/src/lfsc/Makefile
new file mode 100644
index 0000000..6a101c4
--- /dev/null
+++ b/src/lfsc/Makefile
@@ -0,0 +1,12 @@
+native:
+	ocamlbuild -r -tags annot,bin_annot,rectypes -libs nums,unix -no-hygiene lfsctosmtcoq.native
+
+byte:
+	ocamlbuild -r -tags annot,bin_annot,rectypes -libs nums,unix -no-hygiene lfsctosmtcoq.d.byte
+
+prof:
+	ocamlbuild -r -tags annot,bin_annot,profile,rectypes -tag profile -libs nums,unix -no-hygiene lfsctosmtcoq.native
+
+clean:
+	ocamlbuild -clean
+	rm *.cm* *.o *.ml*.d lfscLexer.ml lfscParser.mli lfscParser.ml
diff --git a/src/lfsc/Readme.md b/src/lfsc/Readme.md
new file mode 100644
index 0000000..353fbb0
--- /dev/null
+++ b/src/lfsc/Readme.md
@@ -0,0 +1,5 @@
+# lfsctosmtcoq
+
+Conversion of LFSC proofs produced by CVC4 to the proof traces format of veriT
+for SMTCoq.
+
diff --git a/src/lfsc/ast.ml b/src/lfsc/ast.ml
new file mode 100644
index 0000000..29a4afc
--- /dev/null
+++ b/src/lfsc/ast.ml
@@ -0,0 +1,961 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+
+exception CVC4Sat
+
+let debug =
+  (* true *)
+  false
+
+(********************************)
+(* Type definitions for the AST *)
+(********************************)
+
+type mpz = Big_int.big_int
+type mpq = Num.num
+
+
+type name = Name of Hstring.t | S_Hole of int
+type symbol = { sname : name; stype : term }
+
+and dterm =
+  | Type
+  | Kind
+  | Mpz
+  | Mpq
+  | Const of symbol
+  | App of term * term list
+  | Int of mpz
+  | Rat of mpq
+  | Pi of symbol * term
+  | Lambda of symbol * term
+  | Hole of int
+  | Ptr of term
+  | SideCond of Hstring.t * term list * term * term
+
+and term = { mutable value: dterm; ttype: term }
+(* TODO: remove type annotations in terms *)
+
+type command =
+  | Check of term
+  | Define of Hstring.t * term
+  | Declare of Hstring.t * term
+
+
+type proof = command list
+
+
+module H = struct
+  let holds = Hstring.make "holds"
+  let th_holds = Hstring.make "th_holds"
+  let mp_add = Hstring.make "mp_add"
+  let mp_mul = Hstring.make "mp_mul"
+  let uminus = Hstring.make "~"
+  let eq = Hstring.make "="
+end
+
+
+let is_rule t =
+  match t.ttype.value with
+  | App ({value=Const{sname=Name n}}, _) -> n == H.holds || n == H.th_holds
+  | _ -> false
+
+
+let rec deref t = match t.value with
+  | Ptr t -> deref t
+  | _ -> t
+
+
+let value t = (deref t).value
+
+
+let ttype t = deref (deref t).ttype
+
+
+let rec name c = match value c with
+  | Const {sname=Name n} -> Some n
+  | _ -> None
+
+
+let rec app_name r = match value r with
+  | App ({value=Const{sname=Name n}}, args) -> Some (n, args)
+  | _ -> None
+
+
+(*******************)
+(* Pretty printing *)
+(*******************)
+
+let address_of (x:'a) : nativeint =
+  if Obj.is_block (Obj.repr x) then
+    Nativeint.shift_left (Nativeint.of_int (Obj.magic x)) 1 (* magic *)
+  else
+    invalid_arg "Can only find address of boxed values."
+ 
+let rec print_symbol fmt { sname } = match sname with
+  | Name n -> Hstring.print fmt n
+  | S_Hole i -> fprintf fmt "_s%d" i
+
+and print_tval pty fmt t = match t.value with
+  | Type -> fprintf fmt "type"
+  | Kind -> fprintf fmt "kind"
+  | Mpz -> fprintf fmt "mpz"
+  | Mpq -> fprintf fmt "mpz"
+  | Const s -> print_symbol fmt s
+  | App (f, args) when pty && is_rule t ->
+    let color = (Hashtbl.hash f.value mod 216) + 16 in
+    let op, cl = sprintf "\x1b[38;5;%dm" color, "\x1b[0m" in
+    fprintf fmt "@[@<0>%s(%a@<0>%s%a@<0>%s)@,@<0>%s@]"
+      op
+      (print_tval false) f
+      cl
+      (fun fmt -> List.iter (fprintf fmt "@ %a" (print_term pty))) args
+      op cl
+  | App (f, args) ->
+    fprintf fmt "@[(%a%a)@,@]"
+      (print_tval false) f
+      (fun fmt -> List.iter (fprintf fmt "@ %a" (print_term pty))) args
+
+  | Int n -> pp_print_string fmt (Big_int.string_of_big_int n)
+  | Rat q -> pp_print_string fmt (Num.string_of_num q)
+  | Pi (s, t) ->
+    fprintf fmt "(! %a@ %a@ %a)@,"
+      print_symbol s
+      (print_term false) s.stype
+      (print_term pty) t
+  | Lambda (s, t) ->
+    fprintf fmt "(%% %a@ %a@ %a)@," print_symbol s (print_term pty) s.stype
+      (print_term pty) t
+  | Hole i ->
+    if false && debug then
+      fprintf fmt "_%d[%nx]" i (address_of t)
+    else 
+      fprintf fmt "_%d" i
+        
+  | Ptr t when (* true || *) debug -> fprintf fmt "*%a" (print_term pty) t
+
+  | Ptr t -> print_term pty fmt t
+    
+  | SideCond (name, args, expected, t) ->
+    fprintf fmt "(! _ (^ (%a%a)@ %a)@ %a)"
+      Hstring.print name
+      (fun fmt -> List.iter (fprintf fmt "@ %a" (print_term pty))) args
+      (print_term pty) expected
+      (print_term pty) t
+
+
+and print_term pty fmt t = match t with
+  | {value = Type | Kind | Ptr _ | Const _}
+  | {ttype = {value = Type | Kind | Const _ | Ptr _}} ->
+    print_tval pty fmt t
+  | _  when t.ttype == t ->
+    print_tval pty fmt t
+  (* | _ when pty -> *)
+  (*   fprintf fmt "[@[%a:%a@]]" (print_tval pty) t (print_term pty) t.ttype *)
+  | _ when pty && is_rule t ->
+    let op, cl = "\x1b[30m", "\x1b[0m" in
+    fprintf fmt "@\n@[@<0>%s(: %a@<0>%s@\n%a@<0>%s)@<0>%s@,@]"
+      op (print_term false) t.ttype cl (print_tval pty) t op cl
+  (* | _ when pty -> *)
+  (*   fprintf fmt "@[(:@ %a@ %a)@]" *)
+  (*     (print_term false) t.ttype (print_tval pty) t *)
+  (* | _ when pty -> *)
+  (*   fprintf fmt "@[%a\x1b[30m:%a\x1b[0m)@]" *)
+  (*     (print_tval pty) t (print_term false) t.ttype *)
+  | _ ->
+    fprintf fmt "@[%a@]" (print_tval pty) t
+
+
+let print_term_type = print_term true
+let print_term = print_term false
+
+let print_command fmt = function
+  | Check t ->
+    fprintf fmt "(check@ (:@\n@\n %a@ @\n@\n%a))"
+      print_term t.ttype print_term_type t
+  | Define (s, t) ->
+    fprintf fmt "(define %a@ %a)" Hstring.print s print_term t
+  | Declare (s, t) ->
+    fprintf fmt "(declare %a@ %a)" Hstring.print s print_term t
+
+let print_proof fmt =
+  List.iter (fprintf fmt "@[<1>%a@]@\n@." print_command) 
+
+
+
+let compare_symbol s1 s2 = match s1.sname, s2.sname with
+  | Name n1, Name n2 -> Hstring.compare n1 n2
+  | Name _, _ -> -1
+  | _, Name _ -> 1
+  | S_Hole i1, S_Hole i2 -> Pervasives.compare i1 i2
+
+
+let rec compare_term ?(mod_eq=false) t1 t2 = match t1.value, t2.value with
+  | Ptr t1, _ -> compare_term ~mod_eq t1 t2
+  | _, Ptr t2 -> compare_term ~mod_eq t1 t2
+  | Type, Type | Kind, Kind | Mpz, Mpz | Mpq, Mpz -> 0
+  | Type, _ -> -1 | _, Type -> 1
+  | Kind, _ -> -1 | _, Kind -> 1
+  | Mpz, _ -> -1 | _, Mpz -> 1
+  | Mpq, _ -> -1 | _, Mpq -> 1
+  | Int n1, Int n2 -> Big_int.compare_big_int n1 n2
+  | Int _, _ -> -1 | _, Int _ -> 1
+  | Rat q1, Rat q2 -> Num.compare_num q1 q2
+  | Rat _, _ -> -1 | _, Rat _ -> 1
+  | Const s1, Const s2 -> compare_symbol s1 s2
+  | Const _, _ -> -1 | _, Const _ -> 1
+  | App ({value=Const{sname=Name n1}}, [ty1; a1; b1]),
+    App ({value=Const{sname=Name n2}}, [ty2; a2; b2])
+    when n1 == H.eq && n2 == H.eq && mod_eq ->
+    let c = compare_term ~mod_eq ty1 ty2 in
+    if c <> 0 then c
+    else
+      let ca1a2 = compare_term ~mod_eq a1 a2 in
+      let ca1b2 = compare_term ~mod_eq a1 b2 in
+      let cb1b2 = compare_term ~mod_eq b1 b2 in
+      let cb1a2 = compare_term ~mod_eq b1 a2 in
+      if ca1a2 = 0 && cb1b2 = 0 then 0
+      else if ca1b2 = 0 && cb1a2 = 0 then 0
+      else if ca1a2 <> 0 then ca1a2 else cb1b2
+  | App (f1, l1), App (f2, l2) ->
+    let c = compare_term ~mod_eq f1 f2 in
+    if c <> 0 then c else
+    compare_term_list ~mod_eq l1 l2
+  | App _, _ -> -1 | _, App _ -> 1
+    
+  | Pi (s1, t1), Pi (s2, t2) ->
+    let c = compare_symbol s1 s2 in
+    if c <> 0 then c
+    else compare_term ~mod_eq t1 t2
+  | Pi _, _ -> -1 | _, Pi _ -> 1
+
+  | Lambda (s1, t1), Lambda (s2, t2) ->
+    let c = compare_symbol s1 s2 in
+    if c <> 0 then c
+    else compare_term ~mod_eq t1 t2
+  | Lambda _, _ -> -1 | _, Lambda _ -> 1
+
+  (* ignore side conditions *)
+  | SideCond (_, _, _, t), _ -> compare_term ~mod_eq t t2
+  | _, SideCond (_, _, _, t) -> compare_term ~mod_eq t1 t
+
+  | Hole i1, Hole i2 -> Pervasives.compare i1 i2
+
+
+and compare_term_list ?(mod_eq=false) l1 l2 = match l1, l2 with
+  | [], [] -> 0
+  | [], _ -> -1
+  | _, [] -> 1
+  | t1 :: r1, t2 :: r2 ->
+    let c = compare_term ~mod_eq t1 t2 in
+    if c <> 0 then c
+    else compare_term_list ~mod_eq r1 r2
+
+
+let rec hash_term t = match t.value with
+  | Ptr t -> hash_term t
+  | v -> Hashtbl.hash_param 100 500 v
+
+
+module Term = struct
+  type t = term
+  let compare = compare_term ~mod_eq:false
+  let equal x y = compare_term x y = 0
+  let hash t = Hashtbl.hash_param 10 100 t.value (* hash_term *)
+  (* let hasht = Hashtbl.hash *)
+  (* let rec hash = *)
+  (*   let cpt = ref 0 in *)
+  (*   fun hh t -> *)
+  (*   incr cpt; *)
+  (*   if !cpt > 10 then hh else *)
+  (*   hh + *)
+  (*   let v = t.value in *)
+  (*   match v with *)
+  (*   | Hole _ | Type | Kind |  Mpz | Mpq | Int _ | Rat _ | Const _ -> hasht v *)
+  (*   | SideCond (_, args, exp, t) -> *)
+  (*     List.fold_left (fun acc t -> hash hh t + 31*acc) (hash hh t) args *)
+  (*   | App (f, args) -> *)
+  (*     List.fold_left (fun acc t -> hash hh t + 31*acc) (hash hh f) args *)
+  (*   | Pi (s, x) -> ((Hashtbl.hash s) + 31*(hash hh x)) * 7 *)
+  (*   | Lambda (s, x) -> ((Hashtbl.hash s) + 31*(hash hh x)) * 9 *)
+  (*   | Ptr t' -> 0 *)
+  (*     (\* t.value <- t'.value; *\) *)
+  (*     (\* hash hh (deref t') *\) *)
+  (* let hash = hash 0 *)
+end
+
+
+
+
+let rec holes_address acc t = match t.value with
+  | Hole i -> (i, t) :: acc
+  | Type | Kind |  Mpz | Mpq | Int _ | Rat _  -> acc
+  | SideCond (name, args, exp, t) -> acc
+  | Const _ -> acc
+  | App (f, args) ->
+    List.fold_left holes_address acc args 
+  | Pi (s, x) -> holes_address acc x
+  | Lambda (s, x) -> holes_address acc x
+  | Ptr t -> holes_address acc t
+
+let holes_address = holes_address []
+
+
+let check_holes_integrity where h1 h2 =
+  List.iter (fun (i, a) ->
+      List.iter (fun (j, b) ->
+          if j = i && a != b then
+            (
+              eprintf "\n%s: Hole _%d was at %nx, now at %nx\n@." where i
+                (address_of a) (address_of b);
+              (* eprintf "\n%s: Hole _%d has changed\n@." where i; *)
+              assert false)
+        ) h2
+    ) h1
+
+let check_term_integrity where t = 
+  let h = holes_address t in
+  check_holes_integrity (where ^ "term has != _") h h
+    
+
+
+let eq_name s1 s2 = match s1, s2 with
+  | S_Hole i1, S_Hole i2 -> i1 == i2
+  | Name n1, Name n2 -> n1 == n2
+  | _ -> false
+
+module HN = Hashtbl.Make (struct
+    type t = name
+    let equal = eq_name
+    let hash = function
+      | S_Hole i -> i * 7
+      | Name n -> Hstring.hash n * 9
+  end)
+
+let symbols = HN.create 21
+let register_symbol s = HN.add symbols s.sname s.stype
+let remove_symbol s = HN.remove symbols s.sname
+
+let definitions = HN.create 21
+let add_definition n t = HN.add definitions n t
+let remove_definition n = HN.remove definitions n
+
+
+exception TypingError of term * term
+
+
+(**************************)
+(* Predefined terms/types *)
+(**************************)
+
+
+let rec kind = { value = Kind; ttype = kind }
+
+let lfsc_type = { value = Type; ttype = kind }
+
+let mpz = { value = Mpz; ttype = lfsc_type }
+
+let mpq = { value = Mpq; ttype = lfsc_type }
+
+let mk_mpz n = { value = Int n; ttype = mpz }
+
+let mpz_of_int n = { value = Int (Big_int.big_int_of_int n); ttype = mpz }
+
+let mk_mpq n = { value = Rat n; ttype = mpq }
+
+
+let mk_symbol s stype =
+  { sname = Name (Hstring.make s) ; stype }
+  (* { sname = Name (String.concat "." (List.rev (n :: scope))) ; stype } *)
+
+let mk_symbol_hole =
+  let cpt = ref 0 in
+  fun stype ->
+    incr cpt;
+    { sname = S_Hole !cpt; stype }
+
+let is_hole = function { value = Hole _ } -> true | _ -> false
+
+let is_hole_symbol = function { sname = S_Hole _ } -> true | _ -> false
+
+let mk_hole =
+  let cpt = ref 0 in
+  fun ttype ->
+    incr cpt;
+    { value = Hole !cpt; ttype }
+
+(* let mk_rec_hole () = *)
+(*   let rec h = { value = Hole !cpt; ttype = h } in *)
+(*   h *)
+
+let mk_hole_hole () =
+  mk_hole (mk_hole lfsc_type)
+
+
+(*****************************)
+(* Side conditions callbacks *)
+(*****************************)
+
+let callbacks_table = Hstring.H.create 7
+
+
+let mp_add x y =
+  (* eprintf "mp_add %a %a@." print_term x print_term y;  *)
+  match value x, value y with
+  | Int xi, Int yi -> mk_mpz (Big_int.add_big_int xi yi)
+  | _ -> assert false
+
+let mp_mul x y = match value x, value y with
+  | Int xi, Int yi -> mk_mpz (Big_int.mult_big_int xi yi)
+  | _ -> assert false
+
+let uminus x = match value x with
+  | Int xi -> mk_mpz (Big_int.minus_big_int xi)
+  | _ -> assert false
+
+
+let rec eval_arg x = match app_name x with
+  | Some (n, [x]) when n == H.uminus -> uminus (eval_arg x)
+  | Some (n, [x; y]) when n == H.mp_add -> mp_add (eval_arg x) (eval_arg y)
+  | Some (n, [x; y]) when n == H.mp_mul -> mp_mul (eval_arg x) (eval_arg y)
+  | _ -> x
+
+
+let callback name l =
+  try
+    let f = Hstring.H.find callbacks_table name in
+    (* eprintf "apply %s ... @." name; *)
+    let l = List.map eval_arg l in
+    f l
+  with Not_found ->
+    failwith ("No side condition for " ^ Hstring.view name)
+
+
+
+(* type sc_check = String * term list * term *)
+
+
+(* type sc_tree = *)
+(*   | SCEmpty *)
+(*   (\* | SCLeaf of sc_check *\) *)
+(*   | SCBranches of sc_check * sc_tree list *)
+
+
+(* let sct = ref (SCEmpty) *)
+
+
+let sc_to_check = ref []
+  
+
+
+(**********************************)
+(* Smart constructors for the AST *)
+(**********************************)
+
+module MSym = Map.Make (struct
+    type t = symbol
+    let compare = compare_symbol
+  end)
+
+
+let empty_subst = MSym.empty
+
+let fresh_alpha =
+  let cpt = ref 0 in
+  fun ty -> incr cpt;
+    mk_symbol ("'a"^string_of_int !cpt) ty
+
+
+let get_t ?(gen=true) sigma s =
+  try
+    let x = MSym.find s sigma in
+    if not gen && is_hole x then raise Not_found;
+    x
+  with Not_found -> try
+      HN.find definitions s.sname
+    with Not_found ->
+      { value = Const s; ttype = s.stype }
+
+
+type substres = T of term | V of dterm | Same
+
+
+let apply_subst_sym sigma s =
+  try
+    let x = MSym.find s sigma in
+    T x
+  with Not_found -> Same
+    (* try *)
+    (*   T (Hashtbl.find definitions s) *)
+    (* with Not_found -> Same *)
+
+
+let print_subst fmt sigma =
+  fprintf fmt "@[<v 1>[";
+  MSym.iter (fun s t ->
+      fprintf fmt "@ %a -> %a;" print_symbol s print_term t) sigma;
+  fprintf fmt " ]@]"
+
+
+let rec apply_subst_val sigma tval = match tval with
+  | Type | Kind |  Mpz | Mpq | Int _ | Rat _ | Hole _ -> Same
+    
+  (* | Ptr t -> *)
+  (*   V (Ptr (apply_subst sigma t)) *)
+  (* | Ptr t -> apply_subst_val sigma t.value *)
+
+  | Ptr t ->
+    T (apply_subst sigma t)
+               
+  | Const s when is_hole_symbol s -> Same (* raise Exit *)
+  | Const s -> apply_subst_sym sigma s
+  | App (f, args) ->
+    let nf = apply_subst sigma f in
+    let nargs = List.rev_map (apply_subst sigma) args |> List.rev in
+    if nf == f && List.for_all2 (==) nargs args then (* V tval *) Same
+    else
+    V (App(nf, nargs))
+      
+  | Pi (s, x) ->
+    let s = { s with stype = apply_subst sigma s.stype } in
+    let sigma = MSym.remove s sigma in
+    let newx = apply_subst sigma x in
+    if x == newx then (* V tval *) Same
+    else
+    V (Pi (s, newx))
+
+  | Lambda (s, x) ->
+    let s = { s with stype = apply_subst sigma s.stype } in
+    let sigma = MSym.remove s sigma in
+    let newx = apply_subst sigma x in
+    if x == newx then (* V tval *) Same
+    else
+    V (Lambda (s, newx))
+
+  | SideCond (name, args, exp, t) ->
+    let nt = apply_subst sigma t in
+    let nexp = apply_subst sigma exp in
+    let nargs = List.rev_map (apply_subst sigma) args |> List.rev in
+    if nt == t && nexp == exp && List.for_all2 (==) nargs args then (* V tval *) Same
+    else
+    V (SideCond (name, nargs, nexp, nt))
+
+
+
+and apply_subst sigma t =
+  match apply_subst_val sigma t.value with
+  | Same -> t
+  | T t -> t
+  | V value ->
+    let ttype = apply_subst sigma t.ttype in
+    if value == t.value && ttype == t.ttype then t
+    else { value; ttype }
+
+
+
+let get_real t = apply_subst MSym.empty t
+
+
+let rec flatten_term_value t = match t.value with
+  | Hole _ | Type | Kind |  Mpz | Mpq | Int _ | Rat _  -> ()
+  | SideCond (_, args, exp, t) ->
+    List.iter flatten_term args;
+    flatten_term exp;
+    flatten_term t
+  | Const s -> flatten_term s.stype
+  | App (f, args) ->
+    flatten_term f;
+    List.iter flatten_term args 
+  | Pi (s, x) | Lambda (s, x) ->
+    flatten_term s.stype;
+    flatten_term x    
+  | Ptr t' ->
+    t.value <- (deref t').value
+    (* flatten_term t *)
+
+
+and flatten_term t =
+  flatten_term_value t
+  (* ; *)
+  (* match t.value with *)
+  (* | Type | Kind -> () *)
+  (* | _ -> flatten_term t.ttype *)
+
+
+let rec has_ptr_val t = match t.value with
+  | Hole _ | Type | Kind |  Mpz | Mpq | Int _ | Rat _  -> false
+  | SideCond (_, args, exp, t) ->
+    List.exists has_ptr args || has_ptr exp || has_ptr t
+  | Const s -> has_ptr s.stype
+  | App (f, args) -> has_ptr f || List.exists has_ptr args
+  | Pi (s, x) | Lambda (s, x) -> has_ptr s.stype || has_ptr x    
+  | Ptr _ -> true
+
+and has_ptr t = 
+  has_ptr_val t ||
+  match t.value with
+  | Type | Kind -> false
+  | _ -> has_ptr t.ttype
+
+
+let add_subst x v sigma = MSym.add x v sigma
+  (* let sigma = List.rev_map (fun (y, w) -> y, apply_subst [x,v] w) sigma |> List.rev in *)
+  (* (x, apply_subst sigma v) :: sigma *)
+
+
+
+let rec occur_check subt t =
+  compare_term t subt = 0
+  ||
+  match t.value with
+  | Type | Kind |  Mpz | Mpq | Int _ | Rat _ | Hole _ | Const _ -> false
+
+  | Ptr t -> occur_check subt t
+
+  | App (f, args) ->
+    occur_check subt f ||
+    List.exists (occur_check subt) args
+      
+  | Pi (s, x) -> occur_check subt x
+
+  | Lambda (s, x) -> occur_check subt x
+
+  | SideCond (name, args, exp, t) ->
+    occur_check subt exp ||
+    occur_check subt t ||
+    List.exists (occur_check subt) args
+ 
+
+
+
+let rec fill_hole sigma h t =
+  match h.value with
+  | Hole _ ->
+    if debug then
+      eprintf ">>>>> Fill hole @[%a@] with @[%a@]@."
+        print_term h print_term t;
+    let t' = apply_subst sigma t in
+    (* h.value <- t'.value; (\* KLUDGE *\) *)
+    if not (occur_check h t') then h.value <- Ptr (deref t');
+    if debug then
+      eprintf ">>>>>>>>> @[%a@]@." print_term_type h;
+    fill_hole sigma h.ttype t'.ttype;
+    (* (try compat_with sigma t'.ttype h.ttype with _ -> ()); *)
+  | _ -> ()
+
+
+
+
+(* Raise TypingError if t2 is not compatible with t1 *)
+(* apsub is false if we want to prevent application of substitutions *)
+and compat_with1 ?(apsub=true) sigma t1 t2 =
+  if debug then (
+    eprintf "compat_with(%b): @[<hov>%a@] and @[<hov>%a@]@."
+      apsub print_term t1 print_term t2;
+    eprintf "  with sigma = %a@." print_subst sigma
+  );
+
+  match t1.value, t2.value with
+  | Type, Type  
+  | Kind, Kind
+  | Mpz, Mpz
+  | Mpq, Mpz -> ()
+
+  | Int z1, Int z2 -> if not (Big_int.eq_big_int z1 z2) then raise Exit
+  | Rat q1, Rat q2 -> if not (Num.eq_num q1 q2) then raise Exit
+
+  | Ptr t, _ -> compat_with1 ~apsub sigma t t2
+  | _, Ptr t -> compat_with1 ~apsub sigma t1 t
+
+  | Const s1, Const s2 ->
+    if apsub then
+      let a2 = get_t sigma s2 in
+      let a1 = get_t ~gen:(not (is_hole a2)) sigma s1 in
+      compat_with1 sigma ~apsub:false a1 a2
+    else
+    if not (eq_name s1.sname s2.sname) then raise Exit
+
+  | App (f1, args1), App (f2, args2) ->
+    compat_with1 sigma f1 f2;
+    List.iter2 (compat_with sigma) args1 args2
+
+  | Pi (s1, t1), Pi (s2, t2) ->
+    compat_with1 sigma s1.stype s2.stype;
+    let a = s2 in
+    let ta = { value = Const a; ttype = a.stype } in
+    compat_with1 (add_subst s1 ta sigma) t1 t2;
+
+  | Lambda (s1, t1), Lambda (s2, t2) ->
+    compat_with sigma s1.stype s2.stype;
+    let a = s2 in
+    let ta = { value = Const a; ttype = a.stype } in
+    compat_with1 (add_subst s1 ta sigma) t1 t2;
+
+
+  | SideCond (name, args, expected, t1), _ ->
+    check_side_condition name
+      (List.rev_map (apply_subst sigma) args |> List.rev)
+      (apply_subst sigma expected);
+    compat_with1 sigma t1 t2
+
+  (* ignore side conditions on the right *)
+  | _, SideCond (name, args, expected, t2) ->
+    compat_with1 sigma t1 t2
+
+  | Hole i, Hole j when i = j -> ()
+  (* failwith ("Cannot infer type of holes, too many holes.") *)
+
+  | _, Hole _ -> fill_hole sigma t2 t1
+  | Hole _, _ -> fill_hole sigma t1 t2
+
+
+  | Const s, _ ->
+    if apsub then
+      let a = get_t sigma s in
+      compat_with1 sigma ~apsub:false a t2
+    else
+      raise Exit
+
+  | _, Const s ->
+    if apsub then
+      let a = get_t sigma s in
+      compat_with1 sigma ~apsub:false a t1
+    else
+      raise Exit
+
+  | _ -> raise Exit
+
+
+and compat_with sigma t1 t2 =
+  try compat_with1 sigma t1 t2 
+  with Exit ->
+    raise (TypingError (apply_subst sigma t1, apply_subst sigma t2))
+
+
+
+and term_equal t1 t2 =
+  try
+    compat_with empty_subst t1 t2;
+    true
+  with
+  | TypingError _ | Failure _ -> false
+
+
+
+and check_side_condition name l expected =
+  if debug then
+    eprintf "Adding side condition : (%a%a) =?= %a@."
+      Hstring.print name
+      (fun fmt -> List.iter (fprintf fmt "@ %a" print_term)) l
+      print_term expected;
+  (* if not (term_equal (callback name l) expected) then *)
+  (*   failwith ("Side condition " ^ name ^ " failed"); *)
+  sc_to_check := (name, l, expected) :: !sc_to_check
+
+
+
+let rec ty_of_app sigma ty args = match ty.value, args with
+  | Pi (s, t), a :: rargs ->
+    let sigma = add_subst s a sigma in
+    compat_with sigma s.stype a.ttype;
+    ty_of_app sigma t rargs
+
+  | SideCond (name, scargs, expected, t), args ->
+      check_side_condition name
+        (List.rev_map (apply_subst sigma) scargs |> List.rev)
+        (apply_subst sigma expected);
+      ty_of_app sigma t args
+
+  | _, [] -> apply_subst sigma ty
+  | _ -> failwith ("Type of function not a pi-type.")
+
+
+let mk_const x =
+  if debug then eprintf "mk_const %s@." x;
+  try
+    let stype = HN.find symbols (Name (Hstring.make x)) in
+    let s = mk_symbol x stype in
+    try
+      HN.find definitions s.sname
+    with Not_found -> { value = Const s; ttype = stype }
+  with Not_found -> failwith ("Symbol " ^ x ^ " is not declared.")
+
+
+let symbol_to_const s = { value = Const s; ttype = s.stype }
+  
+
+let rec mk_app ?(lookup=true) sigma f args =
+  if debug then
+    eprintf "mk_App : %a@." (print_tval false)
+      { value = App (f, args); ttype = lfsc_type } ;
+
+  match f.value, args with
+  | Lambda (x, r), a :: rargs ->
+    let sigma = MSym.remove x sigma in
+    mk_app (add_subst x a sigma) r rargs
+      
+  (* | Const {sname = Name "mp_add"}, [x; y] -> mp_add x y *)
+
+  (* | Const {sname = Name "mp_mul"}, [x; y] -> mp_mul x y *)
+      
+  | Const s, _ when lookup ->
+    (* find the definition if it has one *)
+    let f = get_t sigma s in
+    mk_app ~lookup:false sigma f args
+
+  | x, [] ->
+    (* Delayed beta-reduction *)
+    apply_subst sigma f
+      
+  | _ ->
+    (* TODO: check if empty_subst or sigma *)
+    { value = App (f, args); ttype = ty_of_app empty_subst f.ttype args }
+
+
+let mk_app = mk_app empty_subst
+
+
+let rec hole_nbs acc t = match value t with
+  | Hole nb -> nb :: acc
+  | App (f, args) -> List.fold_left hole_nbs (hole_nbs acc f) args 
+  | Pi (s, x) | Lambda (s, x) -> hole_nbs acc x
+  | Ptr t -> hole_nbs acc t
+  | _ -> acc
+
+
+let rec min_hole acc t = match value t with
+  | Hole nb ->
+    (match acc with Some n when nb < n -> Some nb  | None -> Some nb | _ -> acc)
+  | App (f, args) -> List.fold_left min_hole (min_hole acc f) args 
+  | Pi (s, x) | Lambda (s, x) -> min_hole acc x
+  | Ptr t -> min_hole acc t
+  | _ -> acc
+
+
+let compare_int_opt m1 m2 = match m1, m2 with
+  | None, None -> 0
+  | Some _, None -> -1
+  | None, Some _ -> 1
+  | Some n1, Some n2 -> compare n1 n2
+
+
+let compare_sc_checks (_, args1, exp1) (_, args2, exp2) =
+  let el1 = hole_nbs [] exp1 in
+  let el2 = hole_nbs [] exp2 in
+
+  let al1 = List.fold_left hole_nbs [] args1 in
+  let al2 = List.fold_left hole_nbs [] args2 in
+
+  if List.exists (fun n -> List.mem n al1) el2 then 1
+  else if List.exists (fun n -> List.mem n al2) el1 then -1
+  else if el1 = [] then 1
+  else if el2 = [] then -1
+  else compare el1 el2
+
+
+let sort_sc_checks l = List.fast_sort compare_sc_checks l
+
+
+let run_side_conditions () =
+  (* List.iter (fun (name, l, expected)  -> *)
+  (*     eprintf "\nSorted side condition : (%s%a) =?= %a@." *)
+  (*       name *)
+  (*       (fun fmt -> List.iter (fprintf fmt "@ %a" print_term)) l *)
+  (*       print_term expected; *)
+  (*   ) (List.flatten !all_scs |> sort_sc_checks); *)
+
+  List.iter (fun (name, l, expected) ->
+      let res = callback name l in
+      if not (term_equal res expected) then
+        failwith (asprintf "Side condition %a failed: Got %a, expected %a"
+                    Hstring.print name print_term res print_term expected);
+    ) (sort_sc_checks !sc_to_check);
+  sc_to_check := [];
+  ()
+
+
+let mk_pi s t =
+  (* let s = if is_hole_symbol s then fresh_alpha s.stype else s in *)
+  { value = Pi (s, t); ttype = lfsc_type }
+
+let mk_lambda s t =
+  (* sc_to_check := List.rev !sc_to_check; *)
+  (* run_side_conditions (); *)
+  (* let s = if is_hole_symbol s then fresh_alpha s.stype else s in *)
+  { value = Lambda (s, t);
+    ttype = mk_pi s t.ttype }
+
+  
+let mk_ascr ty t =
+  if debug then
+    eprintf "\nMK ASCR:: should have type %a, has type %a\n@."
+      print_term ty print_term t.ttype;
+  compat_with empty_subst ty t.ttype; t
+  (* { t with ttype = ty } *)
+
+
+let add_sc name args expected t =
+  { value = SideCond (Hstring.make name, args, expected, t);
+    ttype = t.ttype }
+
+
+let mk_declare n ty =
+  let s = mk_symbol n ty in
+  register_symbol s
+
+let mk_define n t =
+  let s = mk_symbol n t.ttype in
+  register_symbol s;
+  add_definition s.sname t
+
+
+
+let mk_check t = run_side_conditions ()
+
+
+let clear_sc () = sc_to_check := []
+
+
+
+let rec hash_term_mod_eq p = match p.value with
+  | App ({value=Const{sname=Name n}} as f, [ty; a; b])
+    when n == H.eq &&
+         compare_term ~mod_eq:true a b > 0 ->
+    Term.hash (mk_app f [ty; b; a])
+  | App (f, args) ->
+    List.fold_left
+      (fun acc t -> 7*(acc + hash_term_mod_eq f)) 1 (f:: args)
+  | Pi (s, x) ->
+    (Hashtbl.hash_param 100 500 s + hash_term_mod_eq x) * 11
+  | Lambda (s, x) ->
+    (Hashtbl.hash_param 100 500 s + hash_term_mod_eq x) * 13
+  | _ -> Hashtbl.hash_param 100 500 p
+
+
+module Term_modeq = struct
+  type t = term
+  let compare = compare_term ~mod_eq:true
+  let equal x y = compare_term ~mod_eq:true x y = 0
+  let hash t =
+    (* eprintf "HASH: %a@." print_term t; *)
+    hash_term_mod_eq t 
+end
+
+
+(* 
+   Local Variables:
+   compile-command: "make"
+   indent-tabs-mode: nil
+   End: 
+*)
diff --git a/src/lfsc/ast.mli b/src/lfsc/ast.mli
new file mode 100644
index 0000000..0e5d5bf
--- /dev/null
+++ b/src/lfsc/ast.mli
@@ -0,0 +1,239 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Construction and internal representation of LFSC proofs and rules with type
+    checking.
+*)
+
+exception CVC4Sat
+
+(** {2 Structures for LFSC proofs, terms and types } *)
+
+
+(** Implementation of the LFSC type [mpz] for integers. *)
+type mpz = Big_int.big_int
+
+(** Implementation of the LFSC type [mpq] for rationnals. *)
+type mpq = Num.num
+
+
+type name = Name of Hstring.t | S_Hole of int
+
+(** Type of symbols used in lambda/pi abstractions. *)
+type symbol = { sname : name; stype : term }
+
+(** Types of terms *)
+and dterm =
+  | Type                     (** The type [type] *)
+  | Kind                     (** The type [kind] *)
+  | Mpz                      (** The type [mpz] *)
+  | Mpq                      (** The type [mpq] *)
+  | Const of symbol          (** Constants *)
+  | App of term * term list  (** Functions *)
+  | Int of mpz               (** Integers *)
+  | Rat of mpq               (** Rationals *)
+  | Pi of symbol * term      (** Pi-abstractions *)
+  | Lambda of symbol * term  (** Lambda-abstractions *)
+  | Hole of int              (** Hole/Variable (to be filled) *)
+  | Ptr of term              (** Pointer to another term (used to fill holes
+                                 and keep physical equality). Pointers can be
+                                 removed with {!flatten}. *)
+  | SideCond of Hstring.t * term list * term * term
+  (** Side conditions. The last argument is the term
+      to which the side-condition expression
+      evaluates. *)
+
+(** LFSC terms and types (same thing). Terms are annotated with their types. *)
+and term = { mutable value: dterm; ttype: term }
+
+(** Equality over terms (performs unification). To compare terms for equality
+    use [compare_tem t1 t2 = 0] instead. *)
+val term_equal : term -> term -> bool
+
+(** Comparision between terms *)
+val compare_term : ?mod_eq:bool -> term -> term -> int
+val compare_term_list : ?mod_eq:bool -> term list -> term list -> int
+
+val hash_term : term -> int
+
+(** The type of LFSC top-level commands *)
+type command =
+  | Check of term
+  | Define of Hstring.t * term
+  | Declare of Hstring.t * term
+
+(** The type of LFSC proofs *)
+type proof = command list
+
+
+(** Term module to build structures over terms. *)
+module Term : sig
+  type t = term
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
+
+module Term_modeq : sig
+  type t = term
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
+
+
+(** {2 Pretty printing } *)
+
+val print_term : Format.formatter -> term -> unit
+
+val print_term_type : Format.formatter -> term -> unit
+
+val print_symbol : Format.formatter -> symbol -> unit
+  
+val print_command : Format.formatter -> command -> unit
+
+val print_proof : Format.formatter -> proof -> unit
+
+
+(** {2 Predefined LFSC types } *)
+
+(** The LFSC type [type]. *)
+val lfsc_type : term
+
+(** The LFSC type [kind] (of type [type]). *)
+val kind : term
+
+(** The LFSC type [mpz]. *)
+val mpz : term
+
+(** The LFSC type [mpq]. *)
+val mpq : term
+
+(** Constructor for LFSC integers. *)
+val mk_mpz : mpz -> term
+
+val mpz_of_int : int -> term
+
+(** Constructor for LFSC rationals. *)
+val mk_mpq : mpq -> term
+
+
+
+(** {2 Utilities functions } *)
+
+(* val unify : term -> term -> unit *)
+
+(** @deprecated *)
+val  get_real : term -> term
+
+(** Remove pointers in term and type *)
+val flatten_term : term -> unit
+
+(** Returs [true] if the term contains pointers.*)
+val has_ptr : term -> bool
+
+
+(** follow pointers *)
+val deref : term -> term
+
+(** derefenced value *)
+val value : term -> dterm
+
+(** derefenced type *)
+val ttype : term -> term
+
+(** get dereferenced constant name (None if it's not a constant or it has no
+    name) *)
+val name : term -> Hstring.t option
+
+(** get dereferenced application name and its arguments (None if it's not a
+    function application or the function symbol has no name) *)
+val app_name : term -> (Hstring.t * term list) option
+
+
+
+(** {2 Smart constructors with type checking and unification } *)
+
+
+(** Exception raised when the proof does not type check. *)
+exception TypingError of term * term
+
+(** Constructor for symbols, given their name and their type. *)
+val mk_symbol : string -> term -> symbol
+
+(** Create a hole symbol to be filled later on. *)
+val mk_symbol_hole : term -> symbol
+
+(** Create a constant term of a predeclared name. *)
+val mk_const : string -> term
+
+(** Create a constant term from a symbol. *)
+val symbol_to_const : symbol -> term
+
+(** Constructor for function application. This performs type inference and
+    destructive unfification of type variables (holes), as well as
+    beta-reduction. *)
+val mk_app : term -> term list -> term
+
+(** Constructor for a (fresh) unspecified hole term (i.e. a variable) given its
+    type. *)
+val mk_hole : term -> term
+
+(** Create and unspecified term of unspecified type. *)
+val mk_hole_hole : unit -> term
+
+(** Create a pi-abstraction. [mk_pi s t] returns Π s : s.stype. t. *)
+val mk_pi : symbol -> term -> term
+
+(** Create a lambda-abstraction. [mk_lambda s t] returns λ s : s.stype. t. *)
+val mk_lambda : symbol -> term -> term
+
+(** Ascription, or type check. [mk_ascr ty t] checks that t has type ty, while
+    performing all type checking operations decribed in {!mk_app}. *)
+val mk_ascr : term -> term -> term
+
+
+(** [mk_declare s ty] registers declaration of symbol [s] as having type
+    [ty]. *)
+val mk_declare : string -> term -> unit
+
+
+(** [mk_define s t] registers [s] to be a definition for the term [t]. It is
+    inlined in the subsequent terms. *)
+val mk_define : string -> term -> unit
+
+(** Create a check command. *)
+val mk_check : term -> unit
+
+
+(** {2 Auxiliary functions} *)
+
+val register_symbol : symbol -> unit
+
+val remove_symbol : symbol -> unit
+
+val add_definition : name -> term -> unit
+
+val remove_definition : name -> unit
+
+
+(** {2 Side-conditions} *)
+
+(** Table for callback functions of side conditions. *)
+val callbacks_table : (term list -> term) Hstring.H.t
+
+(** Add a side-condition to the callback table, and returns the continuation of
+    the side condition in LFSC terms. See {!Builtin}. *)
+val add_sc : string -> term list -> term -> term -> term
+
+(** Remove pending side-conditions evaluations *)
+val clear_sc : unit -> unit
diff --git a/src/lfsc/builtin.ml b/src/lfsc/builtin.ml
new file mode 100644
index 0000000..7d0151b
--- /dev/null
+++ b/src/lfsc/builtin.ml
@@ -0,0 +1,1313 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Ast
+open Format
+
+
+module H = struct
+  let mp_add = Hstring.make "mp_add"
+  let mp_mul = Hstring.make "mp_mul"
+  let mp_is_neg = Hstring.make "mp_is_neg"
+  let mp_is_zero = Hstring.make "mp_is_zero"
+
+  let uminus = Hstring.make "~"
+
+  let bool_lfsc = Hstring.make "bool_lfsc"
+  let tt = Hstring.make "tt"
+  let ff = Hstring.make "ff"
+
+  let var = Hstring.make "var"
+  let lit = Hstring.make "lit"
+  let clause = Hstring.make "clause"
+  let cln = Hstring.make "cln"
+
+  let okay = Hstring.make "okay"
+  let ok = Hstring.make "ok"
+
+  let pos = Hstring.make "pos"
+  let neg = Hstring.make "neg"
+  let clc = Hstring.make "clc"
+
+  let concat_cl = Hstring.make "concat_cl"
+
+  let clr = Hstring.make "clr"
+
+  let formula = Hstring.make "formula"
+
+
+  let not_ = Hstring.make "not"
+  let and_ = Hstring.make "and"
+  let or_ = Hstring.make "or"
+  let impl_ = Hstring.make "impl"
+  let iff_ = Hstring.make "iff"
+  let xor_ = Hstring.make "xor"
+  let ifte_ = Hstring.make "ifte"
+
+  let ite = Hstring.make "ite"
+  let iff = Hstring.make "iff"
+  let flet = Hstring.make "flet"
+  let impl = Hstring.make "impl"
+  let gt_Int = Hstring.make ">_Int"
+  let ge_Int = Hstring.make ">=_Int"
+  let lt_Int = Hstring.make "<_Int"
+  let le_Int = Hstring.make "<=_Int"
+  let plus_Int = Hstring.make "+_Int"
+  let minus_Int = Hstring.make "-_Int"
+  let times_Int = Hstring.make "*_Int"
+  let div_Int = Hstring.make "/_Int"
+  let uminus_Int = Hstring.make "u-_Int"
+
+  let sort = Hstring.make "sort"
+  let term = Hstring.make "term"
+  let tBool = Hstring.make "Bool"
+  let p_app = Hstring.make "p_app"
+  let arrow = Hstring.make "arrow"
+  let apply = Hstring.make "apply"
+
+  let bitVec = Hstring.make "BitVec"
+
+  let bit = Hstring.make "bit"
+  let b0 = Hstring.make "b0"
+  let b1 = Hstring.make "b1"
+
+  let bv = Hstring.make "bv"
+  let bvn = Hstring.make "bvn"
+  let bvc = Hstring.make "bvc"
+
+  let bblt = Hstring.make "bblt"
+  let bbltn = Hstring.make "bbltn"
+  let bbltc = Hstring.make "bbltc"
+
+  let var_bv = Hstring.make "var_bv"
+
+  let a_var_bv = Hstring.make "a_var_bv"
+  let a_bv = Hstring.make "a_bv"
+  let a_int = Hstring.make "a_int"
+
+
+  let bitof = Hstring.make "bitof"
+  let bblast_term = Hstring.make "bblast_term"
+
+  let eq = Hstring.make "="
+  let bvand = Hstring.make "bvand"
+  let bvor = Hstring.make "bvor"
+  let bvxor = Hstring.make "bvxor"
+  let bvnand = Hstring.make "bvnand"
+  let bvnor = Hstring.make "bvnor"
+  let bvxnor = Hstring.make "bvxnor"
+  let bvmul = Hstring.make "bvmul"
+  let bvadd = Hstring.make "bvadd"
+  let bvsub = Hstring.make "bvsub"
+  let bvudiv = Hstring.make "bvudiv"
+  let bvurem = Hstring.make "bvurem"
+  let bvsdiv = Hstring.make "bvsdiv"
+  let bvsrem = Hstring.make "bvsrem"
+  let bvsmod = Hstring.make "bvsmod"
+  let bvshl = Hstring.make "bvshl"
+  let bvlshr = Hstring.make "bvlshr"
+  let bvashr = Hstring.make "bvashr"
+
+
+  let bvnot = Hstring.make "bvnot"
+  let bvneg = Hstring.make "bvneg"
+  let bvult = Hstring.make "bvult"
+  let bvslt = Hstring.make "bvslt"
+  let bvule = Hstring.make "bvule"
+  let bvsle = Hstring.make "bvsle"
+  let concat = Hstring.make "concat"
+  let extract = Hstring.make "extract"
+  let zero_extend = Hstring.make "zero_extend"
+  let sign_extend = Hstring.make "sign_extend"
+  let array = Hstring.make "Array"
+  let read = Hstring.make "read"
+  let write = Hstring.make "write"
+
+  let diff = Hstring.make "diff"
+
+  let append = Hstring.make "append"
+  let simplify_clause = Hstring.make "simplify_clause"
+  let bv_constants_are_disequal = Hstring.make "bv_constants_are_disequal"
+  let bblt_len = Hstring.make "bblt_len"
+  let bblast_const = Hstring.make "bblast_const"
+  let bblast_var = Hstring.make "bblast_var"      
+  let bblast_concat = Hstring.make "bblast_concat"
+  let bblast_extract = Hstring.make "bblast_extract"
+  let bblast_zextend = Hstring.make "bblast_zextend"
+  let bblast_sextend = Hstring.make "bblast_sextend"
+  let bblast_bvand = Hstring.make "bblast_bvand"
+  let bblast_bvnot = Hstring.make "bblast_bvnot"
+  let bblast_bvor = Hstring.make "bblast_bvor"
+  let bblast_bvxor = Hstring.make "bblast_bvxor"
+  let bblast_bvadd = Hstring.make "bblast_bvadd"
+  let bblast_zero = Hstring.make "bblast_zero"
+  let bblast_bvneg = Hstring.make "bblast_bvneg"
+  let bblast_bvmul = Hstring.make "bblast_bvmul"
+  let bblast_eq = Hstring.make "bblast_eq"
+  let bblast_bvult = Hstring.make "bblast_bvult"
+  let bblast_bvslt = Hstring.make "bblast_bvslt"
+
+  
+  let th_let_pf = Hstring.make "th_let_pf"
+  let th_holds = Hstring.make "th_holds"
+  let ttrue = Hstring.make "true"
+  let tfalse = Hstring.make "false"
+  let a_var_bv = Hstring.make "a_var_bv"
+  let eq = Hstring.make "="
+  let trust_f = Hstring.make "trust_f"
+  let ext = Hstring.make "ext"
+  let decl_atom = Hstring.make "decl_atom"
+  let asf = Hstring.make "asf"
+  let ast = Hstring.make "ast"
+  let cong = Hstring.make "cong"
+  let symm = Hstring.make "symm"
+  let negsymm = Hstring.make "negsymm"
+  let trans = Hstring.make "trans"
+  let negtrans = Hstring.make "negtrans"
+  let negtrans1 = Hstring.make "negtrans1"
+  let negtrans2 = Hstring.make "negtrans2"
+  let refl = Hstring.make "refl"
+  let or_elim_1 = Hstring.make "or_elim_1"
+  let or_elim_2 = Hstring.make "or_elim_2"
+  let iff_elim_1 = Hstring.make "iff_elim_1"
+  let iff_elim_2 = Hstring.make "iff_elim_2"
+  let impl_elim = Hstring.make "impl_elim"
+  let not_and_elim = Hstring.make "not_and_elim"
+  let xor_elim_1 = Hstring.make "xor_elim_1"
+  let xor_elim_2 = Hstring.make "xor_elim_2"
+  let ite_elim_1 = Hstring.make "ite_elim_1"
+  let ite_elim_2 = Hstring.make "ite_elim_2"
+  let ite_elim_3 = Hstring.make "ite_elim_3"
+  let not_ite_elim_1 = Hstring.make "not_ite_elim_1"
+  let not_ite_elim_2 = Hstring.make "not_ite_elim_2"
+  let not_ite_elim_3 = Hstring.make "not_ite_elim_3"
+  let not_iff_elim = Hstring.make "not_iff_elim"
+  let not_xor_elim = Hstring.make "not_xor_elim"
+  let iff_elim_2 = Hstring.make "iff_elim_2"
+  let and_elim_1 = Hstring.make "and_elim_1"
+  let not_impl_elim = Hstring.make "not_impl_elim"
+  let not_or_elim = Hstring.make "not_or_elim"
+  let and_elim_2 = Hstring.make "and_elim_2"
+  let not_not_elim = Hstring.make "not_not_elim"
+  let not_not_intro = Hstring.make "not_not_intro"
+  let pred_eq_t = Hstring.make "pred_eq_t"
+  let pred_eq_f = Hstring.make "pred_eq_f"
+  let trust_f = Hstring.make "trust_f"
+
+  let tInt = Hstring.make "Int"
+  let eq_transitive = Hstring.make "eq_transitive"
+  let row1 = Hstring.make "row1"
+  let row = Hstring.make "row"
+  let negativerow = Hstring.make "negativerow"
+  let bv_disequal_constants = Hstring.make "bv_disequal_constants"
+  let truth = Hstring.make "truth"
+  let holds = Hstring.make "holds"
+  let q = Hstring.make "Q"
+  let r = Hstring.make "R"
+  let satlem_simplify = Hstring.make "satlem_simplify"
+  let intro_assump_f = Hstring.make "intro_assump_f"
+  let intro_assump_t = Hstring.make "intro_assump_t"
+  let clausify_false = Hstring.make "clausify_false"
+  let trust = Hstring.make "trust"
+  let contra = Hstring.make "contra"
+  let bb_cl = Hstring.make "bb.cl"
+
+  let satlem = Hstring.make "satlem"
+
+  let bv_bbl_var = Hstring.make "bv_bbl_var"
+  let bv_bbl_const = Hstring.make "bv_bbl_const"
+  let bv_bbl_bvand = Hstring.make "bv_bbl_bvand"
+  let bv_bbl_bvor = Hstring.make "bv_bbl_bvor"
+  let bv_bbl_bvxor = Hstring.make "bv_bbl_bvxor"
+  let bv_bbl_bvnot = Hstring.make "bv_bbl_bvnot"
+  let bv_bbl_bvneg = Hstring.make "bv_bbl_bvneg"
+  let bv_bbl_bvadd = Hstring.make "bv_bbl_bvadd"
+  let bv_bbl_bvmul = Hstring.make "bv_bbl_bvmul"
+  let bv_bbl_bvult = Hstring.make "bv_bbl_bvult"
+  let bv_bbl_bvslt = Hstring.make "bv_bbl_bvslt"
+  let bv_bbl_concat = Hstring.make "bv_bbl_concat"
+  let bv_bbl_extract = Hstring.make "bv_bbl_extract"
+  let bv_bbl_zero_extend = Hstring.make "bv_bbl_zero_extend"
+  let bv_bbl_sign_extend = Hstring.make "bv_bbl_sign_extend"
+      
+  let decl_bblast = Hstring.make "decl_bblast"
+  let decl_bblast_with_alias = Hstring.make "decl_bblast_with_alias"
+  let bv_bbl_eq = Hstring.make "bv_bbl_="
+  let bv_bbl_eq_swap = Hstring.make "bv_bbl_=_swap"
+  let bv_bbl_bvult = Hstring.make "bv_bbl_bvult"
+  let bv_bbl_bvslt = Hstring.make "bv_bbl_bvslt"
+      
+  
+end
+
+let scope = ref []
+
+
+let declare_get s =
+  scope := [s];
+  fun ty ->
+  mk_declare s ty;
+  let c = mk_const s in
+  scope := [];
+  c
+
+
+let define s =
+  scope := [s];
+  fun t ->
+    mk_define s t;
+    scope := []
+
+
+let pi n ty =
+  let n = String.concat "." (List.rev (n :: !scope)) in
+  let s = mk_symbol n ty in
+  register_symbol s;
+  fun t ->
+    let pi_abstr = mk_pi s t in
+    remove_symbol s;
+    pi_abstr
+
+
+let pi_d n ty ft =
+  let n = String.concat "." (List.rev (n :: !scope)) in
+  let s = mk_symbol n ty in
+  register_symbol s;
+  let pi_abstr = mk_pi s (ft (symbol_to_const s)) in
+  remove_symbol s;
+  pi_abstr
+
+
+let mp_add_s = declare_get "mp_add" (pi "a" mpz (pi "b" mpz mpz))
+let mp_add x y = match value x, value y with
+  | Int xi, Int yi -> mk_mpz (Big_int.add_big_int xi yi)
+  | _ -> mk_app mp_add_s [x; y]
+
+let mp_mul_s = declare_get "mp_mul" (pi "a" mpz (pi "b" mpz mpz))
+let mp_mul x y = match value x, value y with
+  | Int xi, Int yi -> mk_mpz (Big_int.mult_big_int xi yi)
+  | _ -> mk_app mp_add_s [x; y]
+
+
+
+let rec eval_arg x = match app_name x with
+  | Some (n, [x; y]) when n == H.mp_add -> mp_add (eval_arg x) (eval_arg y)
+  | Some (n, [x; y]) when n == H.mp_mul -> mp_mul (eval_arg x) (eval_arg y)
+  | _ -> x
+
+
+let mp_isneg x =
+  (* eprintf "mp_isneg %a .@." print_term x; *)
+  match value x with
+  | Int n -> Big_int.sign_big_int n < 0
+  | _ -> failwith ("mp_isneg")
+
+let mp_iszero x = match value x with
+  | Int n -> Big_int.sign_big_int n = 0
+  | _ -> failwith ("mp_iszero")
+
+
+let uminus = declare_get "~" (pi "a" mpz mpz)
+
+let bool_lfsc = declare_get "bool_lfsc" lfsc_type
+let tt = declare_get "tt" bool_lfsc
+let ff = declare_get "ff" bool_lfsc
+
+let var = declare_get "var" lfsc_type
+let lit = declare_get "lit" lfsc_type
+let clause = declare_get "clause" lfsc_type
+let cln = declare_get "cln" clause
+
+let okay = declare_get "okay" lfsc_type
+let ok = declare_get "ok" okay
+
+let pos_s = declare_get "pos" (pi "x" var lit)
+let neg_s = declare_get "neg" (pi "x" var lit)
+let clc_s = declare_get "clc" (pi "x" lit (pi "c" clause clause))
+
+let concat_cl_s = declare_get "concat_cl"
+    (pi "c1" clause (pi "c2" clause clause))
+
+let clr_s = declare_get "clr" (pi "l" lit (pi "c" clause clause))
+
+let formula = declare_get "formula" lfsc_type
+let th_holds_s = declare_get "th_holds" (pi "f" formula lfsc_type)
+
+let th_holds f = mk_app th_holds_s [f]
+
+let ttrue = declare_get "true" formula
+let tfalse = declare_get "false" formula
+
+(* some definitions *)
+let _ =
+  define "formula_op1" (pi "f" formula formula);
+  define "formula_op2"
+    (pi "f1" formula
+    (pi "f2" formula formula));
+  define "formula_op3"
+    (pi "f1" formula
+    (pi "f2" formula
+    (pi "f3" formula formula)))
+
+let not_s = declare_get "not" (mk_const "formula_op1")
+let and_s = declare_get "and" (mk_const "formula_op2")
+let or_s = declare_get "or" (mk_const "formula_op2")
+let impl_s = declare_get "impl" (mk_const "formula_op2")
+let iff_s = declare_get "iff" (mk_const "formula_op2")
+let xor_s = declare_get "xor" (mk_const "formula_op2")
+let ifte_s = declare_get "ifte" (mk_const "formula_op3")
+
+
+let sort = declare_get "sort" lfsc_type
+let term_s = declare_get "term" (pi "t" sort lfsc_type)
+let term x = mk_app term_s [x] 
+let tBool = declare_get "Bool" sort
+let p_app_s = declare_get "p_app" (pi "x" (term tBool) formula)
+let p_app b = mk_app p_app_s [b]
+let arrow_s = declare_get "arrow" (pi "s1" sort (pi "s2" sort sort))
+let arrow s1 s2 = mk_app arrow_s [s1; s2]
+let apply_s = declare_get "apply"
+    (pi_d "s1" sort (fun s1 ->
+    (pi_d "s2" sort (fun s2 ->
+    (pi "t1" (term (arrow s1 s2))
+    (pi "t2" (term s1)
+       (term s2)))))))
+let apply s1 s2 f x = mk_app apply_s [s1; s2; f; x]
+
+
+let eq_s = declare_get "="
+    (pi_d "s" sort (fun s ->
+    (pi "x" (term s)
+    (pi "y" (term s) formula))))
+
+let eq ty x y = mk_app eq_s [ty; x; y]
+
+let pos v = mk_app pos_s [v] 
+let neg v = mk_app neg_s [v] 
+let clc x c = mk_app clc_s [x; c]
+let clr l c = mk_app clr_s [l; c]
+let concat_cl c1 c2 = mk_app concat_cl_s [c1; c2]
+
+
+let not_ a = mk_app not_s [a]
+let and_ a b = mk_app and_s [a; b]
+let or_ a b = mk_app or_s [a; b]
+let impl_ a b = mk_app impl_s [a; b]
+let iff_ a b = mk_app iff_s [a; b]
+let xor_ a b = mk_app xor_s [a; b]
+let ifte_ a b c = mk_app ifte_s [a; b; c]
+
+(* Bit vector syntax / symbols *)
+
+let bitVec_s = declare_get "BitVec" (pi "n" mpz sort)
+let bitVec n = mk_app bitVec_s [n]
+
+let bit = declare_get "bit" lfsc_type
+let b0 = declare_get "b0" bit
+let b1 = declare_get "b1" bit
+
+let bv = declare_get "bv" lfsc_type
+let bvn = declare_get "bvn" bv
+let bvc_s = declare_get "bvc" (pi "b" bit (pi "v" bv bv))
+let bvc b v = mk_app bvc_s [b; v]
+
+
+let bblt = declare_get "bblt" lfsc_type
+let bbltn = declare_get "bbltn" bblt
+let bbltc_s = declare_get "bbltc" (pi "f" formula (pi "v" bblt bblt))
+let bbltc f v = mk_app bbltc_s [f; v]
+
+let var_bv = declare_get "var_bv" lfsc_type
+
+let a_var_bv_s = declare_get "a_var_bv"
+    (pi_d "n" mpz (fun n ->
+         (pi "v" var_bv (term (bitVec n)))))
+let a_var_bv n v = mk_app a_var_bv_s [n; v]
+
+let a_bv_s = declare_get "a_bv"
+    (pi_d "n" mpz (fun n ->
+         (pi "v" bv (term (bitVec n)))))
+let a_bv n v = mk_app a_bv_s [n; v]
+
+
+
+let bitof_s = declare_get "bitof" (pi "x" var_bv (pi "n" mpz formula))
+let bitof x n =  mk_app bitof_s [x; n]
+
+let bblast_term_s = declare_get "bblast_term"
+    (pi_d "n" mpz (fun n ->
+    (pi "x" (term (bitVec n))
+    (pi "y" bblt lfsc_type))))        
+let bblast_term n x y = mk_app bblast_term_s [n; x; y]
+
+let _ = 
+  define "bvop2"
+	(pi_d "n" mpz (fun n ->
+	(pi "x" (term (bitVec n))
+        (pi "y" (term (bitVec n))
+           (term (bitVec n))))))
+
+let bvand_s = declare_get "bvand" (mk_const "bvop2")
+let bvor_s = declare_get "bvor" (mk_const "bvop2")
+let bvxor_s = declare_get "bvxor" (mk_const "bvop2")
+let bvnand_s = declare_get "bvnand" (mk_const "bvop2")
+let bvnor_s = declare_get "bvnor" (mk_const "bvop2")
+let bvxnor_s = declare_get "bvxnor" (mk_const "bvop2")
+let bvmul_s = declare_get "bvmul" (mk_const "bvop2")
+let bvadd_s = declare_get "bvadd" (mk_const "bvop2")
+let bvsub_s = declare_get "bvsub" (mk_const "bvop2")
+let bvudiv_s = declare_get "bvudiv" (mk_const "bvop2")
+let bvurem_s = declare_get "bvurem" (mk_const "bvop2")
+let bvsdiv_s = declare_get "bvsdiv" (mk_const "bvop2")
+let bvsrem_s = declare_get "bvsrem" (mk_const "bvop2")
+let bvsmod_s = declare_get "bvsmod" (mk_const "bvop2")
+let bvshl_s = declare_get "bvshl" (mk_const "bvop2")
+let bvlshr_s = declare_get "bvlshr" (mk_const "bvop2")
+let bvashr_s = declare_get "bvashr" (mk_const "bvop2")
+
+let bvand n a b = mk_app bvand_s [n; a; b]
+let bvor n a b = mk_app bvor_s [n; a; b]
+let bvxor n a b = mk_app bvxor_s [n; a; b]
+let bvnand n a b = mk_app bvnand_s [n; a; b]
+let bvnor n a b = mk_app bvnor_s [n; a; b]
+let bvxnor n a b = mk_app bvxnor_s [n; a; b]
+let bvmul n a b = mk_app bvmul_s [n; a; b]
+let bvadd n a b = mk_app bvadd_s [n; a; b]
+let bvsub n a b = mk_app bvsub_s [n; a; b]
+let bvudiv n a b = mk_app bvudiv_s [n; a; b]
+let bvurem n a b = mk_app bvurem_s [n; a; b]
+let bvsdiv n a b = mk_app bvsdiv_s [n; a; b]
+let bvsrem n a b = mk_app bvsrem_s [n; a; b]
+let bvsmod n a b = mk_app bvsmod_s [n; a; b]
+let bvshl n a b = mk_app bvshl_s [n; a; b]
+let bvlshr n a b = mk_app bvlshr_s [n; a; b]
+let bvashr n a b = mk_app bvashr_s [n; a; b]
+
+let _ = 
+  define "bvop1"
+	(pi_d "n" mpz (fun n ->
+	(pi "x" (term (bitVec n))
+           (term (bitVec n)))))
+
+let bvnot_s = declare_get "bvnot" (mk_const "bvop1")
+let bvneg_s = declare_get "bvneg" (mk_const "bvop1")
+
+let bvnot n a = mk_app bvnot_s [n; a]
+let bvneg n a = mk_app bvneg_s [n; a]
+
+
+let _ = 
+  define "bvpred"
+	(pi_d "n" mpz (fun n ->
+	(pi "x" (term (bitVec n))
+        (pi "y" (term (bitVec n))
+           formula))))
+
+let bvult_s = declare_get "bvult" (mk_const "bvpred")
+let bvslt_s = declare_get "bvslt" (mk_const "bvpred")
+
+let bvult n a b = mk_app bvult_s [n; a; b]
+let bvslt n a b = mk_app bvslt_s [n; a; b]
+
+
+let concat_s = declare_get "concat"
+    (pi_d "n" mpz (fun n ->
+    (pi_d "m" mpz (fun m -> 
+    (pi_d "m'" mpz (fun m' ->
+    (pi "t1" (term (bitVec m))
+    (pi "t2" (term (bitVec m'))
+       (term (bitVec n))))))))))
+
+let concat n m m' a b = mk_app concat_s [n; m; m'; a; b]
+
+
+let extract_s = declare_get "extract"
+    (pi_d "n" mpz (fun n ->
+    (pi "i" mpz
+    (pi "j" mpz
+    (pi_d "m" mpz (fun m ->
+    (pi "t2" (term (bitVec m))
+       (term (bitVec n)))))))))
+
+let extract n i j m b = mk_app extract_s [n; i; j; m; b]
+
+
+let zero_extend_s = declare_get "zero_extend"
+    (pi_d "n" mpz (fun n ->
+    (pi "i" mpz
+    (pi_d "m" mpz (fun m ->
+    (pi "t2" (term (bitVec m))
+       (term (bitVec n))))))))
+
+let zero_extend n i m b = mk_app zero_extend_s [n; i; m; b]
+
+let sign_extend_s = declare_get "sign_extend"
+    (pi_d "n" mpz (fun n ->
+    (pi "i" mpz
+    (pi_d "m" mpz (fun m ->
+    (pi "t2" (term (bitVec m))
+       (term (bitVec n))))))))
+
+let sign_extend n i m b = mk_app sign_extend_s [n; i; m; b]
+
+
+(* arrays constructors and functions *)
+
+let array_s = declare_get "Array" (pi "s1" sort (pi "s2" sort sort))
+let array s1 s2 = mk_app array_s [s1; s2]
+let read_s = declare_get "read"
+    (pi_d "s1" sort (fun s1 ->
+    (pi_d "s2" sort (fun s2 ->
+     (term (arrow (array s1 s2) (arrow s1 s2)))))))           
+let read s1 s2 = mk_app read_s [s1; s2]
+let write_s = declare_get "write"
+    (pi_d "s1" sort (fun s1 ->
+    (pi_d "s2" sort (fun s2 ->
+     (term (arrow (array s1 s2) (arrow s1 (arrow s2 (array s1 s2)))))))))
+let write s1 s2 = mk_app write_s [s1; s2]
+let diff_s = declare_get "diff"
+    (pi_d "s1" sort (fun s1 ->
+    (pi_d "s2" sort (fun s2 ->
+     (term (arrow (array s1 s2) (arrow (array s1 s2) s1)))))))
+let diff s1 s2 = mk_app diff_s [s1; s2]
+
+(* sortcuts *)
+let apply_read s1 s2 a i =
+  apply s1 s2 (apply (array s1 s2) (arrow s1 s2) (read s1 s2) a) i
+let apply_write s1 s2 a i v =
+  apply s2 (array s1 s2)
+  (apply s1 (arrow s2 (array s1 s2))
+    (apply (array s1 s2) (arrow s1 (arrow s2 (array s1 s2))) (write s1 s2) a)
+    i) v
+let apply_diff s1 s2 a b =
+  apply (array s1 s2) s1
+    (apply (array s1 s2) (arrow (array s1 s2) s1) (diff s1 s2) a) b
+
+
+let refl_s = declare_get "refl"
+    (pi_d "s" sort (fun s ->
+    (pi_d "t" (term s) (fun t ->
+    (th_holds (eq s t t))))))
+
+let refl s t = mk_app refl_s [s; t]
+
+let cong_s = declare_get "cong"
+    (pi_d "s1" sort (fun s1 ->
+    (pi_d "s2" sort (fun s2 ->
+    (pi_d "a1" (term (arrow s1 s2)) (fun a1 ->
+    (pi_d "b1" (term (arrow s1 s2)) (fun b1 ->
+    (pi_d "a2" (term s1) (fun a2 ->
+    (pi_d "b2" (term s1) (fun b2 ->
+    (pi_d "u1" (th_holds (eq (arrow s1 s2) a1 b1)) (fun u1 ->
+    (pi_d "u2" (th_holds (eq s1 a2 b2)) (fun u2 ->
+    (th_holds (eq s2 (apply s1 s2 a1 a2) (apply s1 s2 b1 b2)))))))))))))))))))
+
+let cong s1 s2 a1 b1 a2 b2 u1 u2 =
+  mk_app cong_s [s1; s2; a1; b1; a2; b2; u1; u2]
+
+
+module MInt = Map.Make (struct
+    type t = int
+    let compare = Pervasives.compare
+  end)
+
+module STerm = Set.Make (Term)
+
+type mark_map = STerm.t MInt.t
+
+let empty_marks = MInt.empty
+
+let is_marked i m v =
+  try
+    STerm.mem v (MInt.find i m)
+  with Not_found -> false
+
+let if_marked_do i m v then_v else_v =
+  if is_marked i m v then (then_v m) else (else_v m)
+
+let markvar_with i m v =
+  let set = try MInt.find i m with Not_found -> STerm.empty in
+  MInt.add i (STerm.add v set) m
+
+
+let ifmarked m v = if_marked_do 1 m v
+let ifmarked1 m v = ifmarked m v 
+let ifmarked2 m v = if_marked_do 2 m v
+let ifmarked3 m v = if_marked_do 3 m v
+let ifmarked4 m v = if_marked_do 4 m v
+
+let markvar m v = markvar_with 1 m v
+let markvar1 m v = markvar m v
+let markvar2 m v = markvar_with 2 m v
+let markvar3 m v = markvar_with 3 m v
+let markvar4 m v = markvar_with 4 m v 
+
+
+(*******************)
+(* Side conditions *)
+(*******************)
+                
+
+let rec append c1 c2 =
+  match value c1 with
+  | Const _ when term_equal c1 cln -> c2
+  | App (f, [l; c1']) when term_equal f clc_s ->
+    clc l (append c1' c2)
+  | _ -> failwith "Match failure"
+
+
+
+(* we use marks as follows:
+   - mark 1 to record if we are supposed to remove a positive occurrence of
+     the variable.
+   - mark 2 to record if we are supposed to remove a negative occurrence of
+     the variable.
+   - mark 3 if we did indeed remove the variable positively
+   - mark 4 if we did indeed remove the variable negatively *)
+let rec simplify_clause mark_map c =
+  (* eprintf "simplify_clause[rec] %a@." print_term c; *)
+  match value c with
+  | Const _ when term_equal c cln -> cln, mark_map
+
+  | App(f, [l; c1]) when term_equal f clc_s ->
+
+    begin match value l with
+      (* Set mark 1 on v if it is not set, to indicate we should remove it.
+         After processing the rest of the clause, set mark 3 if we were already
+         supposed to remove v (so if mark 1 was set when we began).  Clear mark3
+         if we were not supposed to be removing v when we began this call. *)
+
+      | App (f, [v]) when term_equal f pos_s -> let v = deref v in
+
+        let m, mark_map = ifmarked mark_map v
+            (fun mark_map -> tt, mark_map)
+            (fun mark_map -> ff, markvar mark_map v) in
+
+        let c', mark_map = simplify_clause mark_map c1 in
+
+        begin match value m with
+          | Const _ when term_equal m tt ->
+            let mark_map = ifmarked3 mark_map v
+                (fun mark_map -> mark_map)
+                (fun mark_map -> markvar3 mark_map v) in
+            c', mark_map
+
+          | Const _ when term_equal m ff ->
+            let mark_map = ifmarked3 mark_map v
+                (fun mark_map -> markvar3 mark_map v)
+                (fun mark_map -> mark_map) in
+            let mark_map = markvar mark_map v in
+            clc l c', mark_map
+
+          | _ -> failwith "Match failure1"
+        end
+
+
+      | App (f, [v]) when term_equal f neg_s -> let v = deref v in
+
+        let m, mark_map = ifmarked2 mark_map v
+            (fun mark_map -> tt, mark_map)
+            (fun mark_map -> ff, markvar2 mark_map v) in
+
+        let c', mark_map = simplify_clause mark_map c1 in
+
+        begin match value m with
+          | Const _ when term_equal m tt ->
+            let mark_map = ifmarked4 mark_map v
+                (fun mark_map -> mark_map)
+                (fun mark_map -> markvar4 mark_map v) in
+            c', mark_map
+
+          | Const _ when term_equal m ff ->
+            let mark_map = ifmarked4 mark_map v
+                (fun mark_map -> markvar4 mark_map v)
+                (fun mark_map -> mark_map) in
+            let mark_map = markvar2 mark_map v in
+            clc l c', mark_map
+
+          | _ -> failwith "Match failure2"
+        end
+
+      | _ -> failwith "Match failure3"
+
+    end
+
+  | App(f, [c1; c2]) when term_equal f concat_cl_s ->
+    let new_c1, mark_map = simplify_clause mark_map c1 in
+    let new_c2, mark_map = simplify_clause mark_map c2 in
+    append new_c1 new_c2, mark_map
+
+  | App(f, [l; c1]) when term_equal f clr_s ->
+
+    begin match value l with
+      (* set mark 1 to indicate we should remove v, and fail if
+         mark 3 is not set after processing the rest of the clause
+         (we will set mark 3 if we remove a positive occurrence of v). *)
+
+      | App (f, [v]) when term_equal f pos_s -> let v = deref v in
+
+        let m, mark_map = ifmarked mark_map v
+            (fun mark_map -> tt, mark_map)
+            (fun mark_map -> ff, markvar mark_map v) in
+
+        let m3, mark_map = ifmarked3 mark_map v
+            (fun mark_map -> tt, markvar3 mark_map v)
+            (fun mark_map -> ff, mark_map) in
+
+        let c', mark_map = simplify_clause mark_map c1 in
+
+        let mark_map = ifmarked3 mark_map v
+            (fun mark_map ->
+               let mark_map = match value m3 with
+                 | Const _ when term_equal m3 tt -> mark_map
+                 | Const _ when term_equal m3 ff -> markvar3 mark_map v
+                 | _ -> failwith "Match failure4"
+               in
+               let mark_map = match value m with
+                 | Const _ when term_equal m tt -> mark_map
+                 | Const _ when term_equal m ff -> markvar mark_map v
+                 | _ -> failwith "Match failure5"
+               in
+               mark_map
+            )
+            (fun _ -> failwith "Match failure6")
+        in
+
+        c', mark_map
+
+      | App (f, [v]) when term_equal f neg_s -> let v = deref v in
+
+        let m2, mark_map = ifmarked2 mark_map v
+            (fun mark_map -> tt, mark_map)
+            (fun mark_map -> ff, markvar2 mark_map v) in
+
+        let m4, mark_map = ifmarked4 mark_map v
+            (fun mark_map -> tt, markvar4 mark_map v)
+            (fun mark_map -> ff, mark_map) in
+
+        let c', mark_map = simplify_clause mark_map c1 in
+
+        let mark_map = ifmarked4 mark_map v
+            (fun mark_map ->
+               let mark_map = match value m4 with
+                 | Const _ when term_equal m4 tt -> mark_map
+                 | Const _ when term_equal m4 ff -> markvar4 mark_map v
+                 | _ -> failwith "Match failure7"
+               in
+               let mark_map = match value m2 with
+                 | Const _ when term_equal m2 tt -> mark_map
+                 | Const _ when term_equal m2 ff -> markvar2 mark_map v
+                 | _ -> failwith "Match failure8"
+               in
+               mark_map
+            )
+            (fun _ -> failwith "Match failure9")
+        in
+
+        c', mark_map
+
+      | _ -> failwith "Match failure10"
+
+    end
+
+  | _ -> failwith "Match failure11"
+
+
+let simplify_clause c =
+  let c', _ = simplify_clause empty_marks c in
+  c'
+
+
+
+let () =
+  List.iter (fun (s, f) -> Hstring.H.add callbacks_table s f)
+    [
+
+      H.append,
+      (function
+        | [c1; c2] -> append c1 c2
+        | _ -> failwith "append: Wrong number of arguments");
+
+      H.simplify_clause,
+      (function
+        | [c] -> simplify_clause c
+        | _ -> failwith "simplify_clause: Wrong number of arguments");
+
+    ]
+    
+
+
+
+let mpz_sub x y = mp_add x (mp_mul (mpz_of_int (-1)) y)
+
+
+
+let rec bv_constants_are_disequal x y =
+  match value x with
+  | Const _ when term_equal x bvn -> failwith "bv_constants_are_disequal"
+  | App (f, [bx; x']) when term_equal f bvc_s ->
+    (match value y with
+     | Const _ when term_equal y bvn -> failwith "bv_constants_are_disequal"
+     | App (f, [by; y']) when term_equal f bvc_s ->
+       if term_equal bx b0 then
+         if term_equal by b0 then
+           bv_constants_are_disequal x' y'
+         else ttrue
+       else if term_equal bx b1 then
+         if term_equal by b1 then
+           bv_constants_are_disequal x' y'
+         else ttrue
+       else failwith "bv_constants_are_disequal"
+     | _ -> failwith "bv_constants_are_disequal")
+  | _ -> failwith "bv_constants_are_disequal"
+
+
+
+(* calculate the length of a bit-blasted term *)
+let rec bblt_len v =
+  (* eprintf "bblt_len %a@." print_term v; *)
+  match value v with
+  | Const _ when term_equal v bbltn -> mpz_of_int 0
+  | App (f, [b; v']) when term_equal f bbltc_s ->
+    mp_add (bblt_len v') (mpz_of_int 1)
+  | _ -> failwith "bblt_len"
+             
+
+let rec bblast_const v n =
+  if mp_isneg n then
+    match value v with
+    | Const _ when term_equal v bvn -> bbltn
+    | _ -> failwith "blast_const"
+  else
+    match value v with
+    | App (f, [b; v']) when term_equal f bvc_s ->
+      bbltc
+        (match value b with
+         | Const _ when term_equal b b0 -> tfalse
+         | Const _ when term_equal b b1 -> ttrue
+         | _ -> failwith "bblast_const")
+        (bblast_const v' (mp_add n (mpz_of_int (-1))))
+    | _ -> failwith "bblast_const"
+
+
+let rec bblast_var x n =
+  if mp_isneg n then bbltn
+  else
+    bbltc (bitof x n) (bblast_var x (mp_add n (mpz_of_int (-1))))
+
+
+let rec bblast_concat x y =
+  match value x with
+  | Const _ when term_equal x bbltn ->
+    (match value y with
+     | App (f, [by; y']) when term_equal f bbltc_s ->
+       bbltc by (bblast_concat x y')
+     | Const _ when term_equal y bbltn -> bbltn
+     | _ -> failwith "bblast_concat: wrong application")
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    bbltc bx (bblast_concat x' y)
+  | _ -> failwith "bblast_concat: wrong application"
+
+
+let rec bblast_extract_rec x i j n =
+  match value x with
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    if mp_isneg (mpz_sub (mpz_sub j n) (mpz_of_int 1)) then
+      if mp_isneg (mpz_sub (mpz_sub n i) (mpz_of_int 1)) then
+        bbltc bx (bblast_extract_rec x' i j (mpz_sub n (mpz_of_int 1)))
+      else bblast_extract_rec x' i j (mpz_sub n (mpz_of_int 1))
+    else bbltn
+  | Const _ when term_equal x bbltn -> bbltn
+  | _ -> failwith "bblast_extract_rec: wrong application"
+
+
+let bblast_extract x i j n = bblast_extract_rec x i j (mpz_sub n (mpz_of_int 1))
+
+
+let rec extend_rec x i b =
+  if mp_isneg i then x
+  else bbltc b (extend_rec x (mpz_sub i (mpz_of_int 1)) b)
+
+
+let bblast_zextend x i = extend_rec x (mpz_sub i (mpz_of_int 1)) tfalse
+
+
+let bblast_sextend x i =
+  match value x with
+  | App (f, [xb; x']) when term_equal f bbltc_s ->
+    extend_rec x (mpz_sub i (mpz_of_int 1)) xb
+  | _ -> failwith "bblast_sextend"
+
+
+let rec bblast_bvand x y =
+  (* eprintf "bblast_bvand %a %a@." print_term x print_term y; *)
+  match value x with
+  | Const _ when term_equal x bbltn ->
+    (match value y with
+     | Const _ when term_equal y bbltn -> bbltn
+     | _ -> failwith "bblast_bvand1")
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    (match value y with
+     | App (f, [by; y']) when term_equal f bbltc_s ->
+       bbltc (and_ bx by) (bblast_bvand x' y') 
+     | _ -> failwith "bblast_bvand2")
+  | _ -> failwith "bblast_bvand3"
+           
+
+let rec bblast_bvnot x =
+  match value x with
+  | Const _ when term_equal x bbltn -> bbltn
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    bbltc (not_ bx) (bblast_bvnot x')
+  | _ -> failwith "bblast_bnot"
+
+
+let rec bblast_bvor x y =
+  match value x with
+  | Const _ when term_equal x bbltn ->
+    (match value y with
+     | Const _ when term_equal y bbltn -> bbltn
+     | _ -> failwith "bblast_bvor")
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    (match value y with
+     | App (f, [by; y']) when term_equal f bbltc_s ->
+       bbltc (or_ bx by) (bblast_bvor x' y') 
+     | _ -> failwith "bblast_bvor")
+  | _ -> failwith "bblast_bvor"
+           
+
+let rec bblast_bvxor x y =
+  match value x with
+  | Const _ when term_equal x bbltn ->
+    (match value y with
+     | Const _ when term_equal y bbltn -> bbltn
+     | _ -> failwith "bblast_bvxor")
+  | App (f, [bx; x']) when term_equal f bbltc_s ->
+    (match value y with
+     | App (f, [by; y']) when term_equal f bbltc_s ->
+       bbltc (xor_ bx by) (bblast_bvxor x' y') 
+     | _ -> failwith "bblast_bvxor")
+  | _ -> failwith "bblast_bvxor"
+
+
+(*
+;; return the carry bit after adding x y
+;; FIXME: not the most efficient thing in the world
+*)
+
+let rec bblast_bvadd_carry a b carry =
+  match value a with
+  | Const _ when term_equal a bbltn ->
+    (match value b with
+     | Const _ when term_equal b bbltn -> carry
+     | _ -> failwith "bblast_bvadd_carry")
+  | App (f, [ai; a']) when term_equal f bbltc_s ->
+    (match value b with
+     | App (f, [bi; b']) when term_equal f bbltc_s ->
+     (or_ (and_ ai bi) (and_ (xor_ ai bi) (bblast_bvadd_carry a' b' carry)))
+     | _ -> failwith "bblast_bvadd_carry")
+  | _ -> failwith "bblast_bvadd_carry"
+
+
+let rec bblast_bvadd a b carry =
+  match value a with
+  | Const _ when term_equal a bbltn ->
+    (match value b with
+     | Const _ when term_equal b bbltn -> bbltn
+     | _ -> failwith "bblast_bvadd")
+  | App (f, [ai; a']) when term_equal f bbltc_s ->
+    (match value b with
+     | App (f, [bi; b']) when term_equal f bbltc_s ->
+       bbltc
+         (xor_ (xor_ ai bi) (bblast_bvadd_carry a' b' carry))
+         (bblast_bvadd a' b' carry)
+     | _ -> failwith "bblast_bvadd")
+  | _ -> failwith "bblast_bvadd"
+  
+
+let rec bblast_zero n =
+  if mp_iszero n then bbltn
+  else bbltc tfalse (bblast_zero (mp_add n (mpz_of_int (-1))))
+
+
+let bblast_bvneg x n = bblast_bvadd (bblast_bvnot x) (bblast_zero n) ttrue
+
+
+let rec reverse_help x acc =
+  match value x with
+  | Const _ when term_equal x bbltn -> acc
+  | App (f, [xi; x']) when term_equal f bbltc_s ->
+    reverse_help x' (bbltc xi acc)
+  | _ -> failwith "reverse_help"
+
+let reverseb x = reverse_help x bbltn
+
+
+let rec top_k_bits a k =
+  if mp_iszero k then bbltn
+  else match value a with
+    | App (f, [ai; a']) when term_equal f bbltc_s ->
+      bbltc ai (top_k_bits a' (mpz_sub k (mpz_of_int 1)))
+    | _ -> failwith "top_k_bits"
+
+
+let bottom_k_bits a k = reverseb (top_k_bits (reverseb a) k)
+
+
+(* assumes the least signigicant bit is at the beginning of the list *)
+let rec k_bit a k =
+  if mp_isneg k then failwith "k_bit"
+  else match value a with
+    | App (f, [ai; a']) when term_equal f bbltc_s ->
+      if mp_iszero k then ai else k_bit a' (mpz_sub k (mpz_of_int 1))
+    | _ -> failwith "k_bit"
+
+
+let rec and_with_bit a bt =
+  match value a with
+  | Const _ when term_equal a bbltn -> bbltn
+  | App (f, [ai; a']) when term_equal f bbltc_s ->
+    bbltc (and_ bt ai) (and_with_bit a' bt)
+  | _ -> failwith "add_with_bit"
+  
+
+(*
+;; a is going to be the current result
+;; carry is going to be false initially
+;; b is the and of a and b[k]
+;; res is going to be bbltn initially
+*)
+let rec mult_step_k_h a b res carry k =
+  match value a with
+  | Const _ when term_equal a bbltn ->
+    (match value b with
+     | Const _ when term_equal b bbltn -> res
+     | _ -> failwith "mult_step_k_h")
+  | App (f, [ai; a']) when term_equal f bbltc_s ->
+    (match value b with
+     | App (f, [bi; b']) when term_equal f bbltc_s ->
+       if mp_isneg (mpz_sub k (mpz_of_int 1)) then
+         let carry_out = (or_ (and_ ai bi) (and_ (xor_ ai bi) carry)) in
+         let curr = (xor_ (xor_ ai bi) carry) in
+         mult_step_k_h a' b'
+           (bbltc curr res) carry_out (mpz_sub k (mpz_of_int 1))
+       else
+         mult_step_k_h a' b (bbltc ai res) carry (mpz_sub k (mpz_of_int 1))
+     | _ -> failwith "mult_step_k_h")
+  | _ -> failwith "mult_step_k_h"
+
+
+
+(*  assumes that a, b and res have already been reversed *)
+let rec mult_step a b res n k =
+  let k' = mpz_sub n k in
+  let ak = top_k_bits a k' in
+  let b' = and_with_bit ak (k_bit b k) in
+  if mp_iszero (mpz_sub k' (mpz_of_int 1)) then
+    mult_step_k_h res b' bbltn tfalse k
+  else
+    let res' = mult_step_k_h res b' bbltn tfalse k in
+    mult_step a b (reverseb res') n (mp_add k (mpz_of_int 1))
+
+
+let bblast_bvmul a b n =
+  let ar = reverseb a in (* reverse a and b so that we can build the circuit *)
+  let br = reverseb b in (* from the least significant bit up *)
+  let res = and_with_bit ar (k_bit br (mpz_of_int 0)) in
+  if mp_iszero (mpz_sub n (mpz_of_int 1)) then res
+  else
+    (* if multiplying 1 bit numbers no need to call mult_step *)
+    mult_step ar br res n (mpz_of_int 1)
+
+  
+(*
+; bit blast  x = y
+; for x,y of size n, it will return a conjuction (x.0 = y.0 ^ ( ... ^ (x.{n-1} = y.{n-1})))
+; f is the accumulator formula that builds the equality in the right order
+*)
+let rec bblast_eq_rec x y f =
+  match value x with
+  | Const _ when term_equal x bbltn ->
+    (match value y with
+     | Const _ when term_equal x bbltn -> f
+     | _ -> failwith "bblast_eq_rec")
+  | App (ff, [fx; x']) when term_equal ff bbltc_s ->
+    (match value y with
+     | App (ff, [fy; y']) when term_equal ff bbltc_s ->
+       bblast_eq_rec x' y' (and_ (iff_ fx fy) f)
+     | _ -> failwith "bblast_eq_rec")
+  | _ -> failwith "bblast_eq_rec"
+
+
+
+let bblast_eq x y =
+  match value x with
+  | App (ff, [bx; x']) when term_equal ff bbltc_s ->
+    (match value y with
+     | App (ff, [by; y']) when term_equal ff bbltc_s ->
+       bblast_eq_rec x' y' (iff_ bx by)
+     | _ -> failwith "sc1: bblast_eq")
+  | _ -> failwith "sc2: bblast_eq"
+
+
+let rec bblast_bvult x y n =
+  match value x with
+  | App (ff, [xi; x']) when term_equal ff bbltc_s ->
+    (match value y with
+     | App (ff, [yi; y']) when term_equal ff bbltc_s ->
+       if mp_iszero n then (and_ (not_ xi) yi)
+       else (or_ (and_ (iff_ xi yi)
+                    (bblast_bvult x' y' (mp_add n (mpz_of_int (-1)))))
+               (and_ (not_ xi) yi))
+     | _ -> failwith "bblast_bvult")
+  | _ -> failwith "bblast_bvult"
+
+
+let rec bblast_bvslt x y n =
+  match value x with
+  | App (ff, [xi; x']) when term_equal ff bbltc_s ->
+    (match value y with
+     | App (ff, [yi; y']) when term_equal ff bbltc_s ->
+       if mp_iszero (mpz_sub n (mpz_of_int 1)) then (and_ xi (not_ yi))
+       else (or_ (and_ (iff_ xi yi)
+                    (bblast_bvult x' y' (mpz_sub n (mpz_of_int 2))))
+               (and_ xi (not_ yi)))
+     | _ -> failwith "bblast_bvslt")
+  | _ -> failwith "bblast_bvslt"
+
+
+let rec mk_ones n =
+  if mp_iszero n then bvn
+  else bvc b1 (mk_ones (mpz_sub n (mpz_of_int 1)))
+
+
+let rec mk_zero n =
+  if mp_iszero n then bvn
+  else bvc b0 (mk_zero (mpz_sub n (mpz_of_int 1)))
+
+
+
+
+
+(** Registering callbacks for side conditions *)
+
+
+let () =
+  List.iter (fun (s, f) -> Hstring.H.add callbacks_table s f)
+    [
+
+      H.append,
+      (function
+        | [c1; c2] -> append c1 c2
+        | _ -> failwith "append: Wrong number of arguments");
+
+      H.simplify_clause,
+      (function
+        | [c] -> simplify_clause c
+        | _ -> failwith "simplify_clause: Wrong number of arguments");
+
+      H.bv_constants_are_disequal,
+      (function
+        | [x; y] -> bv_constants_are_disequal x y
+        | _ -> failwith "bv_constants_are_disequal: Wrong number of arguments");
+
+      H.bblt_len,
+      (function
+        | [v] -> bblt_len v
+        | _ -> failwith "bblt_len: Wrong number of arguments");
+
+      H.bblast_const,
+      (function
+        | [v; n] -> bblast_const v n
+        | _ -> failwith "bblast_const: Wrong number of arguments");
+
+      H.bblast_var,
+      (function
+        | [v; n] -> bblast_var v n
+        | _ -> failwith "bblast_var: Wrong number of arguments");
+      
+      H.bblast_concat,
+      (function
+        | [x; y] -> bblast_concat x y
+        | _ -> failwith "bblast_concat: Wrong number of arguments");
+
+      H.bblast_extract,
+      (function
+        | [x; i; j; n] -> bblast_extract x i j n
+        | _ -> failwith "bblast_extract: Wrong number of arguments");
+
+      H.bblast_zextend,
+      (function
+        | [x; i] -> bblast_zextend x i
+        | _ -> failwith "bblast_zextend: Wrong number of arguments");
+
+      H.bblast_sextend,
+      (function
+        | [x; i] -> bblast_sextend x i
+        | _ -> failwith "bblast_sextend: Wrong number of arguments");
+
+      H.bblast_bvand,
+      (function
+        | [x; y] -> bblast_bvand x y
+        | _ -> failwith "bblast_bvand: Wrong number of arguments");
+
+      H.bblast_bvnot,
+      (function
+        | [x] -> bblast_bvnot x
+        | _ -> failwith "bblast_bvnot: Wrong number of arguments");
+
+      H.bblast_bvor,
+      (function
+        | [x; y] -> bblast_bvor x y
+        | _ -> failwith "bblast_bvor: Wrong number of arguments");
+
+      H.bblast_bvxor,
+      (function
+        | [x; y] -> bblast_bvxor x y
+        | _ -> failwith "bblast_bvxor: Wrong number of arguments");
+
+      H.bblast_bvadd,
+      (function
+        | [x; y; c] -> bblast_bvadd x y c
+        | _ -> failwith "bblast_bvadd: Wrong number of arguments");
+
+      H.bblast_zero,
+      (function
+        | [n] -> bblast_zero n
+        | _ -> failwith "bblast_zero: Wrong number of arguments");
+
+      H.bblast_bvneg,
+      (function
+        | [v; n] -> bblast_bvneg v n
+        | _ -> failwith "bblast_bvneg: Wrong number of arguments");
+
+      H.bblast_bvmul,
+      (function
+        | [x; y; n] -> bblast_bvmul x y n
+        | _ -> failwith "bblast_bvmul: Wrong number of arguments");
+
+      H.bblast_eq,
+      (function
+        | [x; y] -> bblast_eq x y
+        | _ -> failwith "bblast_eq: Wrong number of arguments");
+
+      H.bblast_bvult,
+      (function
+        | [x; y; n] -> bblast_bvult x y n
+        | _ -> failwith "bblast_bvult: Wrong number of arguments");
+
+      H.bblast_bvslt,
+      (function
+        | [x; y; n] -> bblast_bvslt x y n
+        | _ -> failwith "bblast_bvslt: Wrong number of arguments");
+
+    ]
diff --git a/src/lfsc/converter.ml b/src/lfsc/converter.ml
new file mode 100644
index 0000000..d586e37
--- /dev/null
+++ b/src/lfsc/converter.ml
@@ -0,0 +1,1302 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Ast
+open Builtin
+open Format
+open Translator_sig
+
+
+module Make (T : Translator_sig.S) = struct
+
+  open T
+
+  module MTerm = Map.Make (Term)
+
+
+  (** Environment for {!lem} *)
+  type env = {
+    clauses : int list;     (** Accumulated clauses *)
+    ax : bool;              (** Force use of axiomatic rules? *)
+    mpred : bool MTerm.t;   (** map for positivity of predicates in cong *)
+    assum : Hstring.t list; (** Assumptions that were not used *)
+  }
+
+
+  (** Empty environment *)
+  let empty = {
+    clauses = [];
+    ax = false;
+    mpred = MTerm.empty;
+    assum = [];
+  }
+
+
+  (** Returns the formula of which p is a proof of *)
+  let th_res p = match app_name (deref p).ttype with
+    | Some (n, [r]) when n == H.th_holds -> r
+    | _ -> assert false
+
+  
+  (** Ignore declarations at begining of proof *)
+  let rec ignore_all_decls p = match value p with
+    | Lambda (s, p) -> ignore_all_decls p
+    | _ -> p
+
+  
+  (** Ignore declarations but keep assumptions *)
+  let rec ignore_decls p = match value p with
+    | Lambda (s, pr) ->
+      (match s.sname with
+       | Name n when (Hstring.view n).[0] = 'A' -> p
+       | _ -> ignore_decls pr
+      )
+    | _ -> p
+
+  
+  (** Ignore result of preprocessing *)
+  let rec ignore_preproc p = match app_name p with
+    | Some (n, [_; _; p]) when n == H.th_let_pf ->
+      begin match value p with
+        | Lambda (_, p) -> ignore_preproc p
+        | _ -> assert false
+      end
+    | _ -> p
+
+  
+  (** Produce input clauses from the result of CVC4's pre-processing. This may
+      not match the actual inputs in the original SMT2 file but they correspond
+      to what the proof uses. *)
+  let rec produce_inputs_preproc p = match app_name p with
+    | Some (n, [_; _; p]) when n == H.th_let_pf ->
+      begin match value p with
+        | Lambda ({sname = Name h; stype}, p) ->
+          begin match app_name stype with
+            | Some (n, [formula]) when n == H.th_holds ->
+              mk_input h formula;
+              produce_inputs_preproc p
+            | _ -> assert false
+          end
+        | _ -> assert false
+      end
+    | _ -> p
+
+
+  (** Produce inputs from the assumptions *)
+  let rec produce_inputs p = match value p with
+    | Lambda ({sname = Name h; stype}, p) ->
+      begin match app_name stype with
+        | Some (n, [formula])
+          when n == H.th_holds &&
+               (match name formula with
+                | Some f when f == H.ttrue -> false | _ -> true)
+          ->
+          mk_input h formula;
+          produce_inputs p
+        | _ -> produce_inputs p
+      end
+    | _ -> p
+
+
+  let dvar_of_v t = match app_name t with
+    | Some (n, [_; v]) when n == H.a_var_bv -> v
+    | _ -> t
+
+  
+  let trust_vareq_as_alias formula = match app_name formula with
+    | Some (n, [ty; alias; t]) when n == H.eq ->
+      (match name (dvar_of_v alias) with
+      | Some n -> register_alias n t; true
+      | None -> false)
+    | _ -> false
+
+  
+  let rec admit_preproc p = match app_name p with
+    | Some (n, [_; tr; p]) when n == H.th_let_pf ->
+      begin match app_name tr with
+        | Some (n, _) when n == H.trust_f ->
+          eprintf "Warning: hole for trust_f.@."
+        | Some (rule, _) ->
+          eprintf "Warning: hole for unsupported rule %a.@." Hstring.print rule
+        | None -> eprintf "Warning: hole@."
+      end;
+      let formula = th_res tr in
+      begin match value p with
+        | Lambda ({sname = Name h}, p) ->
+          if not (trust_vareq_as_alias formula) then
+            mk_admit_preproc h formula;
+          admit_preproc p
+        | _ -> assert false
+      end
+    | _ -> p
+
+
+
+  (** Handle deferred declarations in LFSC (for extensionality rule atm.) *)
+  let rec deferred p = match app_name p with
+    | Some (n, [ty_i; ty_e; a; b; p]) when n == H.ext ->
+      begin match value p with
+        | Lambda ({sname = Name index_diff}, p) ->
+          begin match value p with
+            | Lambda ({sname = Name h}, p) ->
+              let diff_a_b = (apply_diff ty_i ty_e a b) in
+              register_alias index_diff diff_a_b;
+              let f =
+                or_ (eq (array ty_i ty_e) a b)
+                  (not_ (eq ty_e
+                           (apply_read ty_i ty_e a diff_a_b)
+                           (apply_read ty_i ty_e b diff_a_b))) in
+              let cid = mk_clause_cl Exte [f] [] in
+              register_decl_id h cid;
+              deferred p
+            | _ -> assert false
+          end
+        | _ -> assert false
+      end
+    | _ -> p
+
+
+   
+  (** Registers a propositional variable as an abstraction for a
+      formula. Proofs in SMTCoq have to be given in terms of formulas. *)
+  let rec register_prop_vars p = match app_name p with
+    | Some (n, [formula; p]) when n == H.decl_atom ->
+      begin match value p with
+        | Lambda (v, p) ->
+          let vt = (symbol_to_const v) in
+          (* eprintf "register prop var: %a@." print_term_type vt; *)
+          register_prop_abstr vt formula;
+          begin match value p with
+            | Lambda (_, p) -> register_prop_vars p
+            | _ -> assert false
+          end
+        | _ -> assert false
+      end
+    | _ -> p
+
+
+  (** Returns the name of the local assumptions made in [satlem] *)
+  let rec get_assumptions acc p = match app_name p with
+    | Some (n, [_; _; _; _; p]) when n == H.ast || n == H.asf ->
+      begin match value p with
+        | Lambda ({sname = Name n}, p) -> get_assumptions (n :: acc) p
+        | _ -> assert false
+      end
+    | _ -> acc, p
+
+
+
+  let rec rm_used' assumptions t = match name t with
+    | Some x -> List.filter (fun y -> y != x) assumptions
+    | None -> match app_name t with
+      | Some (_, l) -> List.fold_left rm_used' assumptions l
+      | None -> assumptions
+
+  (** Remove used assumptions from the environment *)
+  let rm_used env t = { env with assum = rm_used' env.assum t }
+
+
+  let rm_duplicates eq l =
+    let rec aux acc = function
+      | x :: r -> if List.exists (eq x) acc then aux acc r else aux (x :: acc) r
+      | [] -> acc in
+    aux [] (List.rev l)
+  
+  (** Create an intermediate resolution step in [satlem] with the accumulated
+      clauses. {!Reso} ignores the resulting clause so we can just give the
+      empty clause here. *)
+  let mk_inter_resolution clauses = match clauses with
+    | [] -> (* not false *)
+      mk_clause_cl Fals [not_ tfalse] []
+      (* assert false *)
+    | [id] -> id
+    | _ -> mk_clause ~reuse:false Reso [] clauses
+
+
+
+  let is_ty_Bool ty = match name ty with
+    | Some n -> n == H.tBool
+    | _ -> false
+
+
+  (** Accumulates equalities for congruence. This is useful for when [f] takes
+      multiples arguments. *)
+  let rec cong neqs env p = match app_name p with
+    | Some (n, [ty; rty; f; f'; x; y; p_f_eq_f'; r]) when n == H.cong ->
+
+      let ne = not_ (eq ty x y) in
+      let neqs, env =
+        if List.exists (Term.equal ne) neqs then neqs, env
+        else ne :: neqs, lem env r in
+
+      begin match name f, name f' with
+        | Some n, Some n' when n == n' -> neqs, env
+        | None, None -> cong neqs env p_f_eq_f'
+        | _ -> assert false
+      end
+
+    | Some (n, [_; _; _; r])
+      when n == H.symm || n == H.negsymm ->
+      cong neqs (rm_used env r) r
+
+    (* | Some (n, [t; x; y; z; r1; r2]) when n == H.trans *)
+    (* | Some (n, [t; x; z; y; r1; r2]) when n == H.negtrans || n == H.negtrans1 *)
+    (* | Some (n, [t; y; x; z; r1; r2]) when n == H.negtrans2 *)
+
+    | Some (n, [t; x1; x2; x3; r1; r2])
+      when n == H.trans || n == H.negtrans ||
+           n == H.negtrans1 || n == H.negtrans2 ->
+
+      let x, y, z =
+        if n == H.trans then x1, x2, x3
+        else if n == H.negtrans || n == H.negtrans1 then x1, x3, x2
+        else if n == H.negtrans2 then x2, x1, x3
+        else assert false
+      in
+
+      (* ignore useless transitivity *)
+      if term_equal x z then
+        match app_name x with
+        | Some (n, [t; _; _; x]) when n == H.apply ->
+          let x_x = eq t x x in
+          not_ x_x :: neqs,
+          { env with clauses = mk_clause_cl Eqre [x_x] [] :: env.clauses }
+        | _ ->
+          let x_x = eq t x x in
+          not_ x_x :: neqs,
+          { env with clauses = mk_clause_cl Eqre [x_x] [] :: env.clauses }
+      else if term_equal x y then cong neqs (rm_used env r2) r2
+      else if term_equal y z then cong neqs (rm_used env r1) r1
+      else
+        let neqs1, env1 = cong neqs (rm_used env r1) r1 in
+        cong neqs1 (rm_used env1 r2) r2
+
+    (* | Some ("refl", [_; r]) -> neqs, rm_used env r *)
+
+    | _ -> neqs, env
+      (* eprintf "something went wrong in congruence@."; *)
+      (* neqs, lem env p (\* env *\) *)
+
+
+  (** Accumulates equalities for transitivity to chain them together. *)
+  and trans neqs env p = match app_name p with
+
+    | Some (n, [ty; x; y; z; p1; p2]) when n == H.trans ->
+    (* | Some (("negtrans"|"negtrans1") as r, [ty; x; z; y; p1; p2]) *)
+    (* | Some ("negtrans2" as r, [ty; y; x; z; p1; p2]) *)
+
+      let merge = true in
+      
+      (* let clauses = lem mpred assum (lem mpred assum clauses p1) p2 in *)
+
+      (* let x_y = th_res p1 in *)
+      (* let y_z = th_res p2 in *)
+      (* let x_y = match r with "negtrans2" -> eq ty y x | _ -> eq ty x y in *)
+      (* let y_z = match r with "negtrans"|"negtrans1" -> eq ty z y | _ -> eq ty y z in *)
+      let n_x_y = not_ (eq ty x y) in
+      let n_y_z = not_ (eq ty y z) in
+
+      let neqs2, env = if merge then trans neqs env p2 else [], lem env p2 in
+      let neqs1, env = if merge then trans neqs env p1 else [], lem env p1 in
+
+      let neqs = match neqs1, neqs2 with
+        | [], [] -> [n_x_y; n_y_z]
+        | [], _ -> n_x_y :: neqs2
+        | _, [] -> neqs1 @ [n_y_z]
+        | _, _ -> neqs1 @ neqs2
+      in
+
+      (* rm_duplicates Term.equal neqs *)
+      neqs, env
+
+    | Some (n, [_; _; _; r]) when n == H.symm || n == H.negsymm ->
+      let neqs, env = trans neqs (rm_used env r) r in
+      List.rev neqs, env
+      
+    | Some (n, [_; r]) when n == H.refl -> neqs, rm_used env r
+  
+    | _ -> neqs, lem env p
+
+
+  
+
+  (** Convert the local proof of a [satlem]. We use decductive style rules when
+      possible but revert to axiomatic ones when the context forces us to. *)
+  and lem ?(toplevel=false) env p = match app_name p with
+    | Some (n, [l1; l2; x; r])
+      when (n == H.or_elim_1 || n == H.or_elim_2) &&
+        (match app_name r with
+          | Some (n, _) -> n == H.iff_elim_1 || n == H.iff_elim_2
+          | _ -> false)
+      ->
+
+      let el, rem = if n == H.or_elim_1 then l1, l2 else l2, l1 in
+      
+      let env = lem env r in
+      let env = lem env x in
+      (match env.clauses with
+       | ci1 :: ci2 :: cls ->
+         { env with clauses = mk_clause_cl Reso [rem] [ci1; ci2] :: cls }
+       | _ -> env
+      )
+
+    | Some (n, [_; _; x; r])
+      when (n == H.or_elim_1 || n == H.or_elim_2) &&
+        (match app_name r with
+          | Some (n, _) -> n == H.impl_elim ||
+                           n == H.not_and_elim ||
+                           n == H.iff_elim_1 ||
+                           n == H.iff_elim_2 ||
+                           n == H.xor_elim_1 ||
+                           n == H.xor_elim_2 ||
+                           n == H.ite_elim_1 ||
+                           n == H.ite_elim_2 ||
+                           n == H.ite_elim_3 ||
+                           n == H.not_ite_elim_1 ||
+                           n == H.not_ite_elim_2 ||
+                           n == H.not_ite_elim_3
+          | _ -> false)
+      ->
+      let env = rm_used env x in
+      let env = lem env r in
+      { env with ax = true }
+
+    | Some (n, [a; b; x; r]) when n == H.or_elim_1 || n == H.or_elim_2 ->
+      let env = rm_used env x in
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax -> mk_clause_cl Or [a; b] env.clauses :: []
+        | _ ->
+          let a_or_b = th_res r in
+          mk_clause_cl Orp [not_ a_or_b; a; b] [] :: env.clauses
+      in
+      { env with clauses; ax = true }
+
+    | Some (n, [a; b; r]) when n == H.impl_elim ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax -> mk_clause_cl Imp [not_ a; b] env.clauses :: []
+        | _ ->
+          let a_impl_b = th_res r in
+          mk_clause_cl Impp [not_ a_impl_b; not_ a; b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; r]) when n == H.xor_elim_1 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Xor2 [not_ a; not_ b] env.clauses :: []
+        | _ ->
+          let a_xor_b = xor_ a b in
+          mk_clause_cl Xorp2 [not_ a_xor_b; not_ a; not_ b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; r]) when n == H.xor_elim_2 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Xor1 [a; b] env.clauses :: []
+        | _ ->
+          let a_xor_b = xor_ a b in
+          mk_clause_cl Xorp1 [not_ a_xor_b; a; b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; c; r]) when n == H.ite_elim_1 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Ite2 [not_ a; b] env.clauses :: []
+        | _ ->
+          let ite_a_b_c = ifte_ a b c in
+          mk_clause_cl Itep2 [not_ ite_a_b_c; not_ a; b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; c; r]) when n == H.ite_elim_2 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Ite1 [a; c] env.clauses :: []
+        | _ ->
+          let ite_a_b_c = ifte_ a b c in
+          mk_clause_cl Itep1 [not_ ite_a_b_c; a; c] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; c; r]) when n == H.not_ite_elim_1 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Nite2 [not_ a; not_ b] env.clauses :: []
+        | _ ->
+          let ite_a_b_c = ifte_ a b c in
+          mk_clause_cl Iten2 [ite_a_b_c; not_ a; not_ b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; c; r]) when n == H.not_ite_elim_2 ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Nite1 [a; not_ c] env.clauses :: []
+        | _ ->
+          let ite_a_b_c = ifte_ a b c in
+          mk_clause_cl Iten1 [ite_a_b_c; a; not_ c] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; b; c; r]) when n == H.ite_elim_3 ->
+      let env = lem env r in
+      let ite_a_b_c = ifte_ a b c in
+      { env with
+        clauses =
+          mk_clause_cl Itep1 [not_ ite_a_b_c; a; c] [] ::
+          mk_clause_cl Itep2 [not_ ite_a_b_c; not_ a; b] [] ::
+          env.clauses;
+        ax = true }
+
+    | Some (n, [a; b; c; r]) when n == H.not_ite_elim_3 ->
+      let env = lem env r in
+      let ite_a_b_c = ifte_ a b c in
+      { env with
+        clauses =
+          mk_clause_cl Iten1 [ite_a_b_c; a; not_ c] [] ::
+          mk_clause_cl Iten2 [ite_a_b_c; not_ a; not_ b] [] ::
+          env.clauses;
+        ax = true }
+
+    | Some (n, [a; b; r]) when n == H.iff_elim_1 ->
+      begin match app_name r with
+        | Some (n, [a; b; r]) when n == H.not_iff_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Nequ2 [not_ a; not_ b] env.clauses :: []
+            | _ ->
+              let a_iff_b = iff_ a b in
+              mk_clause_cl Equn1 [a_iff_b; not_ a; not_ b] [] :: env.clauses
+          in
+          { env with clauses }
+        | Some (n, [a; b; r]) when n == H.not_xor_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Nxor2 [not_ a; b] env.clauses :: []
+            | _ ->
+              let a_xor_b = xor_ a b in
+              mk_clause_cl Xorn2 [a_xor_b; not_ a; b] [] :: env.clauses
+          in
+          { env with clauses }
+        | _ ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Equ1 [not_ a; b] env.clauses :: []
+            | _ ->
+              let a_iff_b = th_res r in
+              mk_clause_cl Equp2 [not_ a_iff_b; not_ a; b] [] :: env.clauses
+          in
+          { env with clauses }
+      end
+
+      | Some (n, [a; b; r]) when n == H.iff_elim_2 ->
+      begin match app_name r with
+        | Some (n, [a; b; r]) when n == H.not_iff_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Nequ1 [a; b] env.clauses :: []
+            | _ ->
+              let a_iff_b = iff_ a b in
+              mk_clause_cl Equn2 [a_iff_b; a; b] [] :: env.clauses
+          in
+          { env with clauses }
+        | Some (n, [a; b; r]) when n == H.not_xor_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Nxor1 [a; not_ b] env.clauses :: []
+            | _ ->
+              let a_xor_b = xor_ a b in
+              mk_clause_cl Xorn1 [a_xor_b; a; not_ b] [] :: env.clauses
+          in
+          { env with clauses }
+        | _ ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Equ2 [a; not_ b] env.clauses :: []
+            | _ ->
+              let a_iff_b = th_res r in
+              mk_clause_cl Equp1 [not_ a_iff_b; a; not_ b] [] :: env.clauses
+          in
+          { env with clauses }
+      end
+
+    | Some (n, [a; b; r]) when n == H.not_and_elim ->
+      let env = lem env r in
+      let clauses = match env.clauses with
+        | [_] when not env.ax ->
+          mk_clause_cl Nand [not_ a; not_ b] env.clauses :: []
+        | _ ->
+          let a_and_b = and_ a b in
+          mk_clause_cl Andn [a_and_b; not_ a; not_ b] [] :: env.clauses
+      in
+      { env with clauses }
+
+    | Some (n, [a; _; r]) when n == H.and_elim_1 ->
+      begin match app_name r with
+        | Some (n, [a; b; r]) when n == H.not_impl_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax -> mk_clause_cl Nimp1 [a] env.clauses :: []
+            | _ ->
+              let a_impl_b = impl_ a b in
+              mk_clause_cl Impn1 [a_impl_b; a] [] :: env.clauses
+          in
+          { env with clauses }
+
+        | Some (n, [a; b; r]) when n == H.not_or_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [id] when not env.ax -> mk_clause_cl Nor [not_ a] [id; 0] :: []
+            | _ ->
+              let a_or_b = or_ a b in
+              mk_clause_cl Orn [a_or_b; not_ a] [0] :: env.clauses
+          in
+          { env with clauses }
+
+        | _ ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [id] when not env.ax -> mk_clause_cl And [a] [id; 0] :: []
+            | _ ->
+              let a_and_b = th_res r in
+              mk_clause_cl Andp [not_ a_and_b; a] [0] :: env.clauses
+          in
+          { env with clauses }
+      end
+
+    | Some (n, [a; b; r]) when n == H.and_elim_2 ->
+      begin match app_name r with
+        | Some (n, [a; b; r]) when n == H.not_impl_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [_] when not env.ax ->
+              mk_clause_cl Nimp2 [not_ b] env.clauses :: []
+            | _ ->
+              let a_impl_b = impl_ a b in
+              mk_clause_cl Impn2 [a_impl_b; not_ b] [] :: env.clauses
+          in
+          { env with clauses }
+
+        | Some (n, [a; b; r]) when n == H.not_or_elim ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [id] when not env.ax -> mk_clause_cl Nor [not_ b] [id; 1] :: []
+            | _ ->
+              let a_or_b = or_ a b in
+              mk_clause_cl Orn [a_or_b; not_ b] [1] :: env.clauses
+          in
+          { env with clauses }
+
+        | _ ->
+          let env = lem env r in
+          let clauses = match env.clauses with
+            | [id] when not env.ax -> mk_clause_cl And [b] [id; 1] :: []
+            | _ ->
+              let a_and_b = th_res r in
+              mk_clause_cl Andp [not_ a_and_b; b] [1] :: env.clauses
+          in
+          { env with clauses }
+      end
+
+    (* Only handle symmetry rules when they are the only rule of the lemma *)
+      
+    | Some (n, [ty; a; b; r])
+      when n == H.symm && toplevel && name r <> None ->
+      let env = lem env r in
+      let a_b = eq ty a b in
+      let b_a = eq ty b a in
+
+      { env with
+        clauses = mk_clause_cl Eqtr [not_ a_b; b_a] [] :: env.clauses;
+        ax = true }
+
+    | Some (n, [ty; a; b; r])
+      when n == H.negsymm && toplevel && name r <> None ->
+      let env = lem env r in
+      let a_b = eq ty a b in
+      let b_a = eq ty b a in
+
+      { env with
+        clauses = mk_clause_cl Eqtr [a_b; not_ b_a] [] :: env.clauses;
+        ax = true }
+
+    (* Ignore other symmetry of equlity rules *)
+    | Some (n, [_; _; _; r]) when n == H.symm || n == H.negsymm ->
+      lem (rm_used env r) r
+
+    (* Ignore double negation *)
+    | Some (n, [_; r]) when n == H.not_not_elim || n == H.not_not_intro ->
+      lem env r
+
+    (* Should not be traversed anyway *)
+    | Some (n, [_; r]) when n == H.pred_eq_t || n == H.pred_eq_f ->
+      lem env r
+
+
+    | Some (n, [f]) when n == H.trust_f ->
+      begin match app_name f with
+        | Some (n, ty :: _)
+          when n == H.eq &&
+               (match name ty with Some i -> i == H.tInt | None -> false) ->
+          (* trust are for lia lemma if equality between integers *)
+          { env with clauses = mk_clause_cl Lage [f] [] :: env.clauses }
+        | Some (n, [x]) when n == H.not_ ->
+          begin match app_name x with
+            | Some (n, ty :: _)
+              when n == H.eq &&
+                   (match name ty with Some i -> i == H.tInt | None -> false) ->
+              (* trust are for lia lemma if disequality between integers *)
+              { env with clauses = mk_clause_cl Lage [f] [] :: env.clauses }
+            | _ -> { env with clauses = mk_clause_cl Hole [f] [] :: env.clauses }
+          end
+        | _ -> { env with clauses = mk_clause_cl Hole [f] [] :: env.clauses }
+      end
+      
+    | Some (n, [_; _; _; _; r; w])
+      when n == H.trans &&
+           (match app_name w with
+            | Some (n, _) -> n == H.pred_eq_t || n == H.pred_eq_f
+            | _ -> false)
+      ->
+      (* Remember which direction of the implication we want for congruence over
+         predicates *)
+      let env = match app_name w with
+        | Some (n, [pt; x]) when n == H.pred_eq_t ->
+          let env = rm_used env x in
+          { env with mpred = MTerm.add pt false env.mpred }
+        | Some (n, [pt; x]) when n == H.pred_eq_f ->
+          let env = rm_used env x in
+          { env with mpred = MTerm.add pt true env.mpred }
+        | _ -> assert false
+      in
+
+      lem env r
+
+
+    | Some (n, [ty; x; y; z; p1; p2])
+      when n == H.negtrans || n == H.negtrans1 ->
+
+      if term_equal x y || term_equal x z || term_equal y z then env
+      else 
+        let env = lem env p2 in
+        let env = lem env p1 in
+
+        let x_y = eq ty x y in
+        let y_z = eq ty y z in
+        let x_z = eq ty x z in
+
+        { env with
+          clauses = mk_clause_cl Eqtr [x_y; not_ y_z; not_ x_z] [] :: env.clauses;
+          ax = true }
+
+    | Some (n, [ty; x; y; z; p1; p2]) when n == H.negtrans2 ->
+
+      if term_equal x y || term_equal x z || term_equal y z then env
+      else 
+        let env = lem env p2 in
+        let env = lem env p1 in
+
+        let x_y = eq ty x y in
+        let y_z = eq ty y z in
+        let x_z = eq ty x z in
+
+        { env with
+          clauses = mk_clause_cl Eqtr [not_ x_y; y_z; not_ x_z] [] :: env.clauses;
+          ax = true }
+
+    | Some (n, [ty; x; y; z; p1; p2]) when n == H.trans ->
+    (* | Some (("negtrans"|"negtrans1"), [ty; x; z; y; p1; p2]) *)
+    (* | Some ("negtrans2", [ty; y; x; z; p1; p2]) *)
+
+      (* if Term.equal x y || Term.equal x z || Term.equal y z then env *)
+      (* else  *)
+      
+      let neqs, env = trans [] env p in
+      let x_z = eq ty x z in
+      let cl = (neqs @ [x_z]) in
+      let id = mk_clause_cl Eqtr cl [] in
+      let id = mk_clause_cl ~reuse:false Weak cl [id] in
+      { env with 
+        clauses = id :: env.clauses;
+        ax = true }
+
+    (* | Some ("trans", [ty; x; y; z; p1; p2]) ->
+
+       (* let clauses1 = lem mpred assum clauses p1 in *)
+       (* let clauses2 = lem mpred assum clauses p2 in *)
+
+       (* TODO: intermediate resolution step *)
+       let clauses = lem mpred assum (lem mpred assum clauses p1) p2 in
+
+       let x_y = th_res p1 in
+       let y_z = th_res p2 in
+       let x_z = eq ty x z in
+       let clauses = mk_clause_cl "eq_transitive" [not_ x_y; not_ y_z; x_z] [] :: clauses in
+
+
+       (* let cl1 = [th_res p1] in *)
+       (* let cl2 = [th_res p2] in *)
+       (* let clauses = [ *)
+       (*   mk_inter_resolution cl1 clauses1; *)
+       (*   mk_inter_resolution cl2 clauses2] *)
+       (* in *)
+       clauses
+    *)
+
+    (* Congruence with predicates *)
+    | Some (n, [_; rty; pp; _; x; y; _; _])
+      when n == H.cong && is_ty_Bool rty ->
+      
+      let neqs, env = cong [] env p in
+      let cptr, cpfa = match app_name (th_res p) with
+        | Some (n, [_; apx; apy]) when n == H.eq ->
+          (match MTerm.find apx env.mpred, MTerm.find apy env.mpred with
+           | true, false -> p_app apx, not_ (p_app apy)
+           | false, true -> p_app apy, not_ (p_app apx)
+           | true, true -> p_app apx, p_app apy
+           | false, false -> not_ (p_app apx), not_ (p_app apy)
+          )
+        | _ -> assert false
+      in
+      let cl = neqs @ [cpfa; cptr] in
+      { env with
+        clauses = mk_clause_cl Eqcp cl [] :: env.clauses;
+        ax = true }
+
+    (* Congruence *)
+    | Some (n, [_; _; _; _; _; _; _; _]) when n == H.cong ->
+      let neqs, env = cong [] env p in
+      let fx_fy = th_res p in
+      let cl = neqs @ [fx_fy] in
+      { env with
+        clauses = mk_clause_cl Eqco cl [] :: env.clauses;
+        ax = true }
+
+    | Some (n, [_; _]) when n == H.refl ->
+      let x_x = th_res p in
+      { env with clauses = mk_clause_cl Eqre [x_x] [] :: env.clauses }
+
+    | Some (n, [_; _; a; i; v]) when n == H.row1 ->
+      let raiwaiv = th_res p in
+      { env with clauses = mk_clause_cl Row1 [raiwaiv] [] :: env.clauses }
+
+    | Some (n, [ti; _; i; j; a; v; r]) when n == H.row ->
+      let env = lem env r in
+      let i_eq_j = eq ti i j in
+      let pr1 = th_res p in
+      { env with
+        clauses = mk_clause_cl Row2 [i_eq_j; pr1] [] :: env.clauses;
+        ax = true}
+
+    | Some (n, [ti; _; i; j; a; v; npr1]) when n == H.negativerow ->
+      let env = lem env npr1 in
+      let i_eq_j = eq ti i j in
+      let pr1 = match app_name (th_res p) with
+        | Some (n, [pr1]) when n == H.not_ -> pr1
+        | _ -> assert false
+      in
+      { env with clauses = mk_clause_cl Row2 [i_eq_j; pr1] [] :: env.clauses }
+
+    | Some (n, [_; x; y]) when n == H.bv_disequal_constants ->
+      { env with clauses = mk_clause_cl Bbdis [th_res p] [] :: env.clauses }
+  
+    | Some (rule, args) ->
+      eprintf "Warning: Introducing hole for unsupported rule %a@."
+        Hstring.print rule;
+      { env with clauses = mk_clause_cl Hole [th_res p] [] :: env.clauses }
+
+    | None ->
+
+      match name p with
+
+      | Some n when n == H.truth ->
+        { env with clauses = mk_clause_cl True [ttrue] [] :: env.clauses }
+      
+      | Some h ->
+        (* should be an input clause *)
+        (try { env with clauses = get_input_id h :: env.clauses }
+         with Not_found ->
+           { env with
+             ax = true;
+             assum = List.filter (fun a -> a <> h) env.assum }
+        )
+
+      | None -> { env with ax = true }
+
+
+  
+  (** Returns the name given to this lemma, its type and the continuation. *)
+  let result_satlem p = match value p with
+    | Lambda ({sname=Name n} as s, r) ->
+
+      begin match app_name s.stype with
+        | Some (n, [cl]) when n == H.holds -> n, cl, r
+        | _ -> assert false
+      end
+
+    | _ -> assert false
+
+
+  (** Returns the clause used in a resolution step *)
+  let clause_qr p =
+    try match name p with
+      | Some n -> get_input_id n
+      | _ -> raise Not_found
+    with Not_found -> match app_name (deref p).ttype with
+      | Some (n, [cl]) when n == H.holds ->
+        (* eprintf "get_clause id : %a@." print_term cl; *)
+        get_clause_id (to_clause cl)
+      | _ -> raise Not_found
+             
+
+  let rec reso_of_QR acc qr = match app_name qr with
+    | Some (n, [_; _; u1; u2; _]) when n == H.q || n == H.r ->
+      reso_of_QR (reso_of_QR acc u1) u2
+    | _ -> clause_qr qr :: acc
+
+  (** Returns clauses used in a linear resolution chain *)
+  let reso_of_QR qr = reso_of_QR [] qr |> List.rev
+
+
+  let rec reso_of_QR qr = match app_name qr with
+    | Some (n, [_; _; u1; u2; _]) when n == H.q || n == H.r ->
+      reso_of_QR u1 @ reso_of_QR u2
+    | _ -> [clause_qr qr]
+
+  let rec reso_of_QR depth acc qr = match app_name qr with
+    | Some (n, [_; _; u1; u2; _]) when n == H.q || n == H.r ->
+      let depth = depth + 1 in
+      reso_of_QR depth (reso_of_QR depth acc u1) u2
+    | _ -> (depth, clause_qr qr) :: acc
+
+  (** Returns clauses used in a linear resolution chain *)
+  let reso_of_QR qr =
+    reso_of_QR 0 [] qr
+    |> List.rev
+    |> List.stable_sort (fun (d1, _) (d2, _) -> d2 - d1)
+    |> List.map snd
+  
+  
+  (** convert resolution proofs of [satlem_simplify] *)
+  let satlem_simplify p = match app_name p with
+    | Some (n, [_; _; _; qr; p]) when n == H.satlem_simplify ->
+      let clauses = reso_of_QR qr in
+      let lem_name, res, p = result_satlem p in
+      let cl_res = to_clause res in
+      let id = mk_clause ~reuse:false Reso cl_res clauses in
+      register_clause_id cl_res id;
+      register_decl_id lem_name id;
+      Some id, p
+    | _ -> raise Exit
+
+  
+  let rec many_satlem_simplify lastid p =
+    try
+      let lastid, p = satlem_simplify p in
+      many_satlem_simplify lastid p
+    with Exit -> lastid, p
+
+
+  (* can be empty, returns continuation *)
+  let satlem_simplifies_c p =
+    many_satlem_simplify None p |> snd
+
+
+  (* There must be at least one, returns id of last deduced clause *)
+  let reso_of_satlem_simplify p =
+    match many_satlem_simplify None p with
+    | Some id, _ -> id
+    | _ -> assert false
+
+
+  let rec bb_trim_intro_unit env p = match app_name p with
+    | Some (n, [_; _; _; ullit; _; l])
+      when n == H.intro_assump_f || n == H.intro_assump_t ->
+      let env = rm_used env ullit in
+      (match value l with
+       | Lambda (_, p) -> bb_trim_intro_unit env p
+       | _ -> assert false)
+    | _ -> env, p
+
+  
+  let is_last_bbres p = match app_name p with
+    | Some (n, [_; _; _; _; l]) when n == H.satlem_simplify ->
+      (match value l with
+       | Lambda ({sname=Name e}, pe) ->
+         (match name pe with Some ne -> ne = e | None -> false)
+       | _ -> false)
+    | _ -> false
+
+
+  let rec bb_lem_res lastid p =
+    try
+      if is_last_bbres p then raise Exit;
+      let lastid, p = satlem_simplify p in
+      bb_lem_res lastid p
+    with Exit -> match lastid with
+      | Some id -> id
+      | None -> assert false
+
+
+  let rec bb_lem env p =
+    let env, p = bb_trim_intro_unit env p in
+    let id = bb_lem_res None p in
+    { env with clauses = id :: env.clauses }
+  
+
+
+  exception ArithLemma
+
+  (** Remove superfluous applications at the top of [satlem] and returns a list
+      of proofs whose resulting clauses need to be resolved.
+
+      @raises {!ArithLemma} if the proof is a trust statement (we assume it is
+      the case for now).  *)
+  let rec trim_junk_satlem p = match app_name p with
+    | Some (n, [p]) when n == H.clausify_false ->
+      (match name p with
+       | Some n when n == H.trust -> raise ArithLemma
+       | _ -> trim_junk_satlem p
+      )
+    | Some (n, [_; p1; p2]) when n == H.contra ->
+      trim_junk_satlem p1 @ trim_junk_satlem p2
+    | _ -> [p]
+
+  
+  (** Returns the continuation of a [satlem]. *)
+  let continuation_satlem p = match value p with
+    | Lambda ({sname=Name n}, r) -> n, r
+    | _ -> assert false
+
+
+  let is_bbr_satlem_lam p = match value p with
+    | Lambda ({sname = Name h}, _) ->
+      (try String.sub (Hstring.view h) 0 5 = "bb.cl"
+       with Invalid_argument _ -> false)
+    | _ -> false 
+  
+  let has_intro_bv p = match app_name p with
+    | Some (n, _) when n == H.intro_assump_f || n == H.intro_assump_t -> true
+    | _ -> false
+
+
+  let has_prefix p s =
+    try
+      for i = 0 to String.length p - 1 do
+        if p.[i] <> s.[i] then raise Exit
+      done;
+      true
+    with Exit | Invalid_argument _ -> false
+      
+  
+  (** Convert [satlem]. Clauses are chained together with an intermediate
+      resolution step when needed, and when CVC4 uses superfluous local
+      assumption, the clause is weakened. *)
+  let rec satlem ?(prefix_cont) p =
+    let old_p = p in
+    match app_name p with
+
+    | Some (n, [c; _; l; p]) when n == H.satlem ->
+      (* eprintf "SATLEM ---@."; *)
+      let lem_name, lem_cont = continuation_satlem p in
+      begin match prefix_cont with
+        | Some pref when not (has_prefix pref (Hstring.view lem_name)) -> old_p
+        | _ ->
+          let cl = to_clause c in
+          (try
+             let assumptions, l = get_assumptions [] l in
+             let l = trim_junk_satlem l in
+             let env = { empty with assum = assumptions } in
+             let lem =
+               if is_bbr_satlem_lam p || List.exists has_intro_bv l then bb_lem
+               else lem ~toplevel:true in
+             let env =
+               List.fold_left (fun env p ->
+                   let local_env =
+                     { env with
+                       clauses = [];
+                       ax = false;
+                       mpred = MTerm.empty;
+                     } in
+                   let local_env = lem local_env p in
+                   { env with
+                     clauses = List.rev_append local_env.clauses env.clauses;
+                     assum = local_env.assum
+                   }
+                 ) env l
+             in
+             let clauses = List.rev env.clauses in
+             let id = mk_inter_resolution clauses in
+             (* eprintf "remaining assumptions:"; *)
+             (* List.iter (eprintf "%s, ") env.assu; *)
+             (* eprintf "@."; *)
+             (* if env.assum = [] then id else *) 
+             let satlem_id = mk_clause Weak cl [id] in
+             register_clause_id cl satlem_id;
+             register_decl_id lem_name satlem_id;
+             (* eprintf "--- SATLEM@."; *)
+
+           with ArithLemma ->
+             let satlem_id = mk_clause Lage cl [] in
+             register_clause_id cl satlem_id
+
+          );
+
+          satlem ?prefix_cont lem_cont
+      end
+
+    | Some (n, [_; _; _; _; l]) when n == H.satlem_simplify ->
+      (match value l with
+       | Lambda ({sname=Name _}, r) ->
+         (match name r with
+          | Some _ -> p
+          | None -> match app_name r with
+            | Some (n, _) when n == H.satlem_simplify -> p
+            | _ ->
+              (* Intermediate satlem_simplify *)
+              (* eprintf ">>>>>> intermediate satlemsimplify@."; *)
+              snd (satlem_simplify p) |> satlem ?prefix_cont
+         )
+       | _ -> p)
+
+    | _ -> p
+
+
+  let rec bbt p = match app_name p with
+    | Some (b, [n; v; bb]) when b == H.bv_bbl_var ->
+      let res = bblast_term n (a_var_bv n v) bb in
+      Some (mk_clause_cl Bbva [res] [])
+    | Some (b, [n; bb; bv]) when b == H.bv_bbl_const ->
+      let res = bblast_term n (a_bv n bv) bb in
+      Some (mk_clause_cl Bbconst [res] [])
+    | Some (rop, [n; x; y; _; _; rb; xbb; ybb])
+      when rop == H.bv_bbl_bvand ||
+           rop == H.bv_bbl_bvor ||
+           rop == H.bv_bbl_bvxor ||
+           rop == H.bv_bbl_bvadd ||
+           rop == H.bv_bbl_bvmul ||
+           rop == H.bv_bbl_bvult ||
+           rop == H.bv_bbl_bvslt
+      ->
+      let bvop, rule =
+        if rop == H.bv_bbl_bvand then bvand, Bbop
+        else if rop == H.bv_bbl_bvor then bvor, Bbop
+        else if rop == H.bv_bbl_bvxor then bvxor, Bbop
+        else if rop == H.bv_bbl_bvadd then bvadd, Bbadd
+        else if rop == H.bv_bbl_bvmul then bvmul, Bbmul
+        else if rop == H.bv_bbl_bvult then bvult, Bbult
+        else if rop == H.bv_bbl_bvslt then bvslt, Bbslt
+        else assert false
+      in
+      let res = bblast_term n (bvop n x y) rb in
+      (match bbt xbb, bbt ybb with
+       | Some idx, Some idy ->
+         Some (mk_clause_cl rule [res] [idx; idy])
+       | _ -> assert false
+      )
+      
+    | Some (c, [n; x; _; rb; xbb]) when c == H.bv_bbl_bvnot ->
+      let res = bblast_term n (bvnot n x) rb in
+      (match bbt xbb with
+       | Some idx ->
+         Some (mk_clause_cl Bbnot [res] [idx])
+       | _ -> assert false
+      )
+    | Some (c, [n; x; _; rb; xbb]) when c == H.bv_bbl_bvneg ->
+      let res = bblast_term n (bvneg n x) rb in
+      (match bbt xbb with
+       | Some idx ->
+         Some (mk_clause_cl Bbneg [res] [idx])
+       | _ -> assert false
+      )
+        
+    | Some (c, [n; m; m'; x; y; _; _; rb; xbb; ybb])
+      when c == H.bv_bbl_concat ->
+      let res = bblast_term n (concat n m m' x y) rb in
+      (match bbt xbb, bbt ybb with
+       | Some idx, Some idy ->
+         Some (mk_clause_cl Bbconc [res] [idx; idy])
+       | _ -> assert false
+      )
+        
+    | Some (c, [n; i; j; m; x; _; rb; xbb])
+      when c == H.bv_bbl_extract ->
+      let res = bblast_term n (extract n i j m x) rb in
+      (match bbt xbb with
+       | Some idx ->
+         Some (mk_clause_cl Bbextr [res] [idx])
+       | _ -> assert false
+      )
+
+    | Some (c, [n; k; m; x; _; rb; xbb])
+      when c == H.bv_bbl_zero_extend ->
+      let res = bblast_term n (zero_extend n k m x) rb in
+      (match bbt xbb with
+       | Some idx ->
+         Some (mk_clause_cl Bbzext [res] [idx])
+       | _ -> assert false
+      )
+
+    | Some (c, [n; k; m; x; _; rb; xbb])
+      when c == H.bv_bbl_sign_extend ->
+      let res = bblast_term n (sign_extend n k m x) rb in
+      (match bbt xbb with
+       | Some idx ->
+         Some (mk_clause_cl Bbsext [res] [idx])
+       | _ -> assert false
+      )
+        
+    | None ->
+      begin match name p with
+      | Some h -> (* should be an declared clause *)
+        Some (try get_input_id h with Not_found -> assert false)
+      | None -> assert false
+      end
+      
+    | Some (rule, args) ->
+      eprintf "Warning: Introducing hole for unsupported rule %a@."
+        Hstring.print rule;
+      Some (mk_clause_cl Hole [ttype p] [])
+
+  
+
+  let rec bblast_decls p = match app_name p with
+    | Some (d, [n; b; t; bb; l]) when d == H.decl_bblast ->
+      (* let res = bblast_term n t b in *)
+      let id = match bbt bb with Some id -> id | None -> assert false in
+      begin match value l with
+        | Lambda ({sname = Name h}, p) ->
+          register_decl_id h id;
+          bblast_decls p
+        | _ -> assert false
+      end
+      
+    | Some (d, [n; b; t; a; bb; _; l]) when d == H.decl_bblast_with_alias ->
+      (* register_termalias a t; *)
+      (* begin match name a with *)
+      (*   | Some n -> register_alias n t *)
+      (*   | None -> () *)
+      (* end; *)
+      let id = match bbt bb with Some id -> id | None -> assert false in
+      begin match value l with
+        | Lambda ({sname = Name h}, p) ->
+          register_decl_id h id;
+          bblast_decls p
+        | _ -> assert false
+      end
+
+    | _ -> p
+
+
+  let bv_pred n =
+    if n == H.bv_bbl_eq then Bbeq
+    else if n == H.bv_bbl_eq_swap then Bbeq
+    else if n == H.bv_bbl_bvult then Bbult
+    else if n == H.bv_bbl_bvslt then Bbslt
+    else assert false
+
+  
+  let rec bblast_eqs p = match app_name p with
+    | Some (n, [f; pf; l]) when n == H.th_let_pf ->
+      begin match app_name pf with
+        | Some (rule_name, [_; _; _; _; _; _; a; b]) ->
+          begin match name a, name b with
+          | Some na, Some nb ->
+            let id1, id2 =
+              try get_input_id na, get_input_id nb
+              with Not_found -> assert false in
+            let clid = mk_clause_cl (bv_pred rule_name) [f] [id1; id2] in
+            begin match value l with
+              | Lambda ({sname = Name h}, p) ->
+                register_decl_id h clid;
+                bblast_eqs p
+              | _ -> assert false
+            end
+          | _ -> assert false
+          end
+
+        | _ -> assert false
+      end
+    | _ -> p
+
+  
+  (** Bit-blasting and bitvector proof conversion (returns rest of the sat
+      proof) *)
+  let bb_proof p = match app_name p with
+    | Some (n, _) when n == H.decl_bblast || n == H.decl_bblast_with_alias ->
+      p
+      |> bblast_decls
+      |> bblast_eqs
+      |> register_prop_vars
+      |> satlem ~prefix_cont:"bb."
+      |> satlem_simplifies_c
+      |> satlem
+      
+    | _ -> p
+  
+
+  (** Convert an LFSC proof (this is the entry point) *)
+  let convert p =
+    p
+      
+    (* |> ignore_all_decls *)
+    (* |> produce_inputs_preproc *)
+
+    |> ignore_decls
+    |> produce_inputs
+
+    |> deferred
+  
+    |> admit_preproc
+
+    |> register_prop_vars
+    |> satlem
+
+    |> bb_proof
+    
+    |> reso_of_satlem_simplify
+
+  
+
+  let convert_pt p =
+    eprintf "Converting LFSC proof to SMTCoq...@?";
+    let t0 = Sys.time () in
+    let r = convert p in
+    let t1 = Sys.time () in
+    eprintf " Done [%.3f s]@." (t1 -. t0);
+    r
+
+  
+
+  (** Clean global environments *)
+  let clear () =
+    Ast.clear_sc ();
+    T.clear ()
+
+
+end
diff --git a/src/lfsc/hstring.ml b/src/lfsc/hstring.ml
new file mode 100644
index 0000000..aa948e0
--- /dev/null
+++ b/src/lfsc/hstring.ml
@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Shashcons
+
+module S = 
+  Shashcons.Make_consed(struct include String 
+		       let hash = Hashtbl.hash 
+		       let equal = (=)     end)
+
+module HS = struct
+
+  type t = string Shashcons.hash_consed
+
+  let make s = S.hashcons s
+
+  let view s = s.node
+
+  let equal s1 s2 = s1.tag = s2.tag
+
+  let compare s1 s2 = compare s1.tag s2.tag
+
+  let hash s = s.tag
+
+  let empty = make ""
+
+  let rec list_assoc x = function
+    | [] -> raise Not_found
+    | (y, v) :: l -> if equal x y then v else list_assoc x l
+
+  let rec list_assoc_inv x = function
+    | [] -> raise Not_found
+    | (y, v) :: l -> if equal x v then y else list_assoc_inv x l
+
+  let rec list_mem_assoc x = function 
+    | [] -> false
+    | (y, _) :: l -> compare x y = 0 || list_mem_assoc x l
+
+  let rec list_mem x = function
+    | [] -> false
+    | y :: l -> compare x y  = 0 || list_mem x l
+
+  let compare_couple (x1,y1) (x2,y2) =
+    let c = compare x1 x2 in
+    if c <> 0 then c
+    else compare y1 y2
+
+  let rec compare_list l1 l2 =
+    match l1, l2 with
+      | [], [] -> 0
+      | [], _ -> -1
+      | _, [] -> 1
+      | x::r1, y::r2 ->
+	let c = compare x y in
+	if c <> 0 then c
+	else compare_list r1 r2
+
+  let rec list_equal l1 l2 =
+    match l1, l2 with
+      | [], [] -> true
+      | [], _ -> false
+      | _, [] -> false
+      | x::r1, y::r2 -> equal x y && list_equal r1 r2
+
+  let rec list_mem_couple c = function
+    | [] -> false
+    | d :: l -> compare_couple c d  = 0 || list_mem_couple c l
+
+  let print fmt s = 
+    Format.fprintf fmt "%s" (view s)
+
+  let rec print_list sep fmt = function
+    | [] -> ()
+    | [s] -> print fmt s
+    | s::r -> Format.fprintf fmt "%a%s%a" print s sep (print_list sep) r
+
+end
+
+include HS
+
+module H = Hashtbl.Make(HS)
+
+module HSet = Set.Make(HS)
+
+module HMap = Map.Make(HS)
+
+(* struct *)
+(*   include Hashtbl.Make(HS) *)
+
+(*   let find x h = *)
+(*     TimeHS.start (); *)
+(*     try      *)
+(*       let r = find x h in *)
+(*       TimeHS.pause (); *)
+(*       r *)
+(*     with Not_found -> TimeHS.pause (); raise Not_found *)
+(* end *)
diff --git a/src/lfsc/hstring.mli b/src/lfsc/hstring.mli
new file mode 100644
index 0000000..7132c59
--- /dev/null
+++ b/src/lfsc/hstring.mli
@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Hash-consed strings
+
+    Hash-consing is a technique to share values that are structurally
+    equal. More details on 
+    {{:http://en.wikipedia.org/wiki/Hash_consing} Wikipedia} and
+    {{:http://www.lri.fr/~filliatr/ftp/publis/hash-consing2.pdf} here}.
+
+    This module provides an easy way to use hash-consing for strings.
+*)
+
+open Shashcons 
+
+type t = string hash_consed
+(** The type of Hash-consed string *)
+
+val make : string -> t
+(** [make s] builds ans returns a hash-consed string from [s].*)
+
+val view : t -> string
+(** [view hs] returns the string corresponding to [hs].*)
+
+val equal : t -> t -> bool
+(** [equal x y] returns [true] if [x] and [y] are the same hash-consed string
+    (constant time).*)
+
+val compare : t -> t -> int
+(** [compares x y] returns [0] if [x] and [y] are equal, and is unspecified
+    otherwise but provides a total ordering on hash-consed strings.*)
+
+val hash : t -> int
+(** [hash x] returns the integer (hash) associated to [x].*)
+
+val empty : t
+(** the empty ([""]) hash-consed string.*)
+
+val list_assoc : t -> (t * 'a) list -> 'a
+(** [list_assoc x l] returns the element associated with [x] in the list of
+    pairs [l].
+    @raise Not_found if there is no value associated with [x] in the list [l].*)
+
+val list_assoc_inv : t -> ('a * t) list -> 'a
+(** [list_assoc_inv x l] returns the first element which is associated to [x]
+    in the list of pairs [l].
+    @raise Not_found if there is no value associated to [x] in the list [l].*)
+
+val list_mem_assoc : t -> (t * 'a) list -> bool
+(** Same as {! list_assoc}, but simply returns [true] if a binding exists, and
+    [false] if no bindings exist for the given key.*)
+
+val list_mem : t -> t list -> bool
+(** [list_mem x l] is [true] if and only if [x] is equal to an element of [l].*)
+
+val list_mem_couple : t * t -> (t * t) list -> bool
+(** [list_mem_couple (x,y) l] is [true] if and only if [(x,y)] is equal to an
+    element of [l].*)
+
+val compare_list : t list -> t list -> int
+(** [compare_list l1 l2] returns [0] if and only if [l1] is equal to [l2].*)
+
+val list_equal : t list -> t list -> bool
+(** [list_equal l1 l2] returns [true] if and only if [l1] is equal to [l2].*)
+
+val print : Format.formatter -> t -> unit
+(** Prints a hash-consed strings on a formatter. *)
+
+val print_list : string -> Format.formatter -> t list -> unit
+(** Prints a list of hash-consed strings on a formatter. *)
+
+module H : Hashtbl.S with type key = t
+(** Hash-tables indexed by hash-consed strings *)
+
+module HSet : Set.S with type elt = t
+(** Sets of hash-consed strings *)
+
+module HMap : Map.S with type key = t
+(** Maps indexed by hash-consed strings *)
diff --git a/src/lfsc/lfsc.ml b/src/lfsc/lfsc.ml
new file mode 100644
index 0000000..0f9fd8d
--- /dev/null
+++ b/src/lfsc/lfsc.ml
@@ -0,0 +1,506 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+open Entries
+open Declare
+open Decl_kinds
+
+open SmtMisc
+open CoqTerms
+open SmtForm
+open SmtCertif
+open SmtTrace
+open SmtAtom
+
+
+(******************************************************************************)
+(* Given a lfsc trace build the corresponding certif and theorem             *)
+(******************************************************************************)
+
+(* Instantiate Converter with translator for SMTCoq *)
+module C = Converter.Make (Tosmtcoq)
+
+exception No_proof
+
+(* Hard coded signatures *)
+let signatures =
+  let sigdir = try Sys.getenv "LFSCSIGS" with Not_found -> Sys.getcwd () in
+  ["sat.plf";
+   "smt.plf";
+   "th_base.plf";
+   "th_int.plf";
+   "th_bv.plf";
+   "th_bv_bitblast.plf";
+   "th_bv_rewrites.plf";
+   "th_arrays.plf" ]
+  |> List.map (Filename.concat sigdir)
+
+
+let process_signatures_once =
+  let don = ref false in
+  fun () ->
+    if !don then ()
+    else
+      try
+        (* don := true; *)
+        List.iter (fun f ->
+            let chan = open_in f in
+            let lexbuf = Lexing.from_channel chan in
+            LfscParser.ignore_commands LfscLexer.main lexbuf;
+            close_in chan
+          ) signatures
+      with
+      | Ast.TypingError (t1, t2) ->
+        Structures.error
+          (asprintf "@[<hov>LFSC typing error: expected %a, got %a@]@."
+             Ast.print_term t1
+             Ast.print_term t2)
+
+
+let lfsc_parse_last lb =
+  printf "Type-checking LFSC proof...@?";
+  let t0 = Sys.time () in
+  let r = LfscParser.last_command LfscLexer.main lb in
+  let t1 = Sys.time () in
+  printf " Done [%.3f s]@." (t1 -. t0);
+  r
+
+let lfsc_parse_one lb =
+  printf "Type-checking LFSC proof...@?";
+  let t0 = Sys.time () in
+  let r = LfscParser.one_command LfscLexer.main lb in
+  let t1 = Sys.time () in
+  printf " Done [%.3f s]@." (t1 -. t0);
+  r
+  
+
+let import_trace first parse lexbuf =
+  Printexc.record_backtrace true;
+  process_signatures_once ();
+  try
+    match parse lexbuf with
+
+    | Some (Ast.Check p) ->
+      (* Ast.flatten_term p; *)
+      let confl_num = C.convert_pt p in
+      (* Afterwards, the SMTCoq libraries will produce the remaining, you do
+         not have to care *)
+      let first =
+        let aux = VeritSyntax.get_clause 1 in
+        match first, aux.value with
+        | Some (root,l), Some (fl::nil) ->
+          (* Format.eprintf "Root: %a ,,,,,,\n\ *)
+          (*                 input: %a@." *)
+          (*   (Form.to_smt Atom.to_smt) l (Form.to_smt Atom.to_smt) fl; *)
+          if Form.equal l fl then
+            aux
+          else (
+            (* eprintf "ADDING Flatten rule@."; *)
+            aux.kind <- Other (ImmFlatten(root,fl));
+            SmtTrace.link root aux;
+            root
+          )
+        | _,_ -> aux in
+      let confl = VeritSyntax.get_clause confl_num in
+      SmtTrace.select confl;
+      occur confl;
+      (alloc first, confl)
+
+    | _ -> raise No_proof
+
+  with
+  | Ast.TypingError (t1, t2) ->
+    Structures.error
+      (asprintf "@[<hov>LFSC typing error: expected %a, got %a@]@."
+         Ast.print_term t1
+         Ast.print_term t2)
+
+
+
+let import_trace_from_file first filename =
+  let chan = open_in filename in
+  let lexbuf = Lexing.from_channel chan in
+  let p = import_trace first lfsc_parse_last lexbuf in
+  close_in chan;
+  p
+
+
+
+let clear_all () =
+  SmtTrace.clear ();
+  VeritSyntax.clear ();
+  C.clear ()
+
+
+let import_all fsmt fproof =
+  clear_all ();
+  let rt = SmtBtype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let roots = Smtlib2_genConstr.import_smtlib2 rt ro ra rf fsmt in
+  let (max_id, confl) = import_trace_from_file None fproof in
+  (rt, ro, ra, rf, roots, max_id, confl)
+
+
+let parse_certif t_i t_func t_atom t_form root used_root trace fsmt fproof =
+  SmtCommands.parse_certif t_i t_func t_atom t_form root used_root trace
+    (import_all fsmt fproof)
+
+let checker_debug fsmt fproof =
+  SmtCommands.checker_debug (import_all fsmt fproof)
+
+let theorem name fsmt fproof =
+  SmtCommands.theorem name (import_all fsmt fproof)
+
+let checker fsmt fproof =
+  SmtCommands.checker (import_all fsmt fproof)
+
+(* Same but print runtime *)
+let checker fsmt fproof =
+  let c = import_all fsmt fproof in
+  printf "Coq checker...@.";
+  let t0 = Sys.time () in
+  let r = SmtCommands.checker c in
+  let t1 = Sys.time () in
+  printf "Done (Coq) [%.3f s]@." (t1 -. t0);
+  r
+
+
+
+(******************************************************************************)
+(** Given a Coq formula build the proof                                       *)
+(******************************************************************************)
+
+
+(* module Form2 = struct *)
+(*   (\* Just for printing *\) *)
+
+(*   open Form *)
+
+(*   let rec to_smt atom_to_smt fmt f = *)
+(*     if is_pos f then to_smt_pform atom_to_smt fmt (pform f) *)
+(*     else fprintf fmt "(not %a)" (to_smt_pform atom_to_smt) (pform f) *)
+
+(*   and to_smt_pform atom_to_smt fmt = function *)
+(*     | Fatom a -> atom_to_smt fmt a *)
+(*     | Fapp (op,args) -> to_smt_op atom_to_smt op fmt (Array.to_list args) *)
+(*     | _ -> assert false *)
+
+(*   and to_smt_op atom_to_smt op fmt args = *)
+(*     match op, args with *)
+(*       | Ftrue, [] -> fprintf fmt "true" *)
+(*       | Ffalse, [] -> fprintf fmt "false" *)
+(*       | Fand, [x; y] -> *)
+(*         fprintf fmt "(and %a %a)" (to_smt atom_to_smt) x (to_smt atom_to_smt) y *)
+(*       | For, [x; y] -> *)
+(*         fprintf fmt "(or %a %a)" (to_smt atom_to_smt) x (to_smt atom_to_smt) y *)
+(*       | Fand, x :: rargs -> *)
+(*         fprintf fmt "(and %a %a)" (to_smt atom_to_smt) x *)
+(*           (to_smt_op atom_to_smt Fand) rargs *)
+(*       | For, x :: rargs -> *)
+(*         fprintf fmt "(or %a %a)" (to_smt atom_to_smt) x *)
+(*           (to_smt_op atom_to_smt For) rargs *)
+(*       (\* andb and orb are left-associative in Coq *\) *)
+(*       (\* | Fand, _ -> left_assoc atom_to_smt Fand fmt (List.rev args) *\) *)
+(*       (\* | For, _ -> left_assoc atom_to_smt For fmt (List.rev args) *\) *)
+(*       | Fxor, _ -> *)
+(*         fprintf fmt "(xor%a)" *)
+(*           (fun fmt -> List.iter (fprintf fmt " %a" (to_smt atom_to_smt))) args *)
+(*       | Fimp, _ -> *)
+(*         fprintf fmt "(=>%a)" *)
+(*           (fun fmt -> List.iter (fprintf fmt " %a" (to_smt atom_to_smt))) args *)
+(*       | Fiff, _ -> *)
+(*         fprintf fmt "(=%a)" *)
+(*           (fun fmt -> List.iter (fprintf fmt " %a" (to_smt atom_to_smt))) args *)
+(*       | Fite, _ -> *)
+(*         fprintf fmt "(ite%a)" *)
+(*           (fun fmt -> List.iter (fprintf fmt " %a" (to_smt atom_to_smt))) args *)
+(*       | Fnot2 _, _ -> *)
+(*         fprintf fmt "(not (not %a))" *)
+(*           (fun fmt -> List.iter (fprintf fmt " %a" (to_smt atom_to_smt))) args *)
+(*       | _ -> assert false *)
+
+(*   and left_assoc atom_to_smt op fmt args = *)
+(*     (\* args is reversed *\) *)
+(*     match op, args with *)
+(*     | Fand, [x; y] -> *)
+(*       fprintf fmt "(and %a %a)" (to_smt atom_to_smt) y (to_smt atom_to_smt) x *)
+(*     | For, [x; y] -> *)
+(*       fprintf fmt "(or %a %a)" (to_smt atom_to_smt) y (to_smt atom_to_smt) x *)
+(*     | Fand, last :: rargs -> *)
+(*       fprintf fmt "(and %a %a)" *)
+(*         (left_assoc atom_to_smt Fand) rargs (to_smt atom_to_smt) last *)
+(*     | For, last :: rargs -> *)
+(*       fprintf fmt "(or %a %a)" *)
+(*         (left_assoc atom_to_smt For) rargs (to_smt atom_to_smt) last *)
+(*     | _ -> assert false *)
+
+(* end *)
+
+
+(* module Atom2 = struct *)
+(*   (\* Just for printing *\) *)
+
+(*   open Atom *)
+  
+(*   let distrib x l = List.map (fun y -> (x,y)) l *)
+
+(*   let rec cross acc l = match l with *)
+(*     | [] | [_] -> List.rev acc *)
+(*     | x :: r -> *)
+(*       cross (List.rev_append (distrib x r) acc) r *)
+
+(*   let cross = cross [] *)
+  
+(*   let rec compute_int = function *)
+(*     | Acop c -> *)
+(*       (match c with *)
+(*        | CO_xH -> 1 *)
+(*        | CO_Z0 -> 0 *)
+(*        | CO_BV _ -> assert false) *)
+(*     | Auop (op,h) -> *)
+(*       (match op with *)
+(*        | UO_xO -> 2*(compute_hint h) *)
+(*        | UO_xI -> 2*(compute_hint h) + 1 *)
+(*        | UO_Zpos -> compute_hint h *)
+(*        | UO_Zneg -> - (compute_hint h) *)
+(*        | _ -> assert false) *)
+(*     | _ -> assert false *)
+
+(*   and compute_hint h = compute_int (atom h) *)
+
+(*   let to_smt_int fmt i = *)
+(*     let s1 = if i < 0 then "(- " else "" in *)
+(*     let s2 = if i < 0 then ")" else "" in *)
+(*     let j = if i < 0 then -i else i in *)
+(*     fprintf fmt "%s%i%s" s1 j s2 *)
+
+(*   let rec to_smt fmt h = to_smt_atom fmt (atom h) *)
+
+(*   and to_smt_atom fmt = function *)
+(*     | Acop _ as a -> to_smt_int fmt (compute_int a) *)
+(*     | Auop (UO_Zopp,h) -> *)
+(*       fprintf fmt "(- "; *)
+(*       to_smt fmt h; *)
+(*       fprintf fmt ")" *)
+(*     | Auop _ as a -> to_smt_int fmt (compute_int a) *)
+(*     | Abop (op,h1,h2) -> to_smt_bop fmt op h1 h2 *)
+(*     | Atop (op,h1,h2,h3) -> to_smt_bop fmt op h1 h2 h3 *)
+(*     | Anop (op,a) -> to_smt_nop fmt op a *)
+(*     | Aapp (op,a) -> *)
+(*       if Array.length a = 0 then ( *)
+(*         fprintf fmt "op_%i" (indexed_op_index op); *)
+(*       ) else ( *)
+(*         fprintf fmt "(op_%i" (indexed_op_index op); *)
+(*         Array.iter (fun h -> fprintf fmt " "; to_smt fmt h) a; *)
+(*         fprintf fmt ")" *)
+(*       ) *)
+
+(*   and str_op = function *)
+(*       | BO_Zplus -> "+" *)
+(*       | BO_Zminus -> "-" *)
+(*       | BO_Zmult -> "*" *)
+(*       | BO_Zlt -> "<" *)
+(*       | BO_Zle -> "<=" *)
+(*       | BO_Zge -> ">=" *)
+(*       | BO_Zgt -> ">" *)
+(*       | BO_eq _ -> "=" *)
+  
+(*   and to_smt_bop fmt op h1 h2 = *)
+(*     match op with *)
+(*     | BO_Zlt -> fprintf fmt "(not (>= %a %a)" to_smt h1 to_smt h2 *)
+(*     | BO_Zle -> fprintf fmt "(not (>= %a (+ %a 1))" to_smt h1 to_smt h2 *)
+(*     | BO_Zgt -> fprintf fmt "(>= %a (+ %a 1)" to_smt h1 to_smt h2 *)
+(*     | _ -> fprintf fmt "(%s %a %a)" (str_op op) to_smt h1 to_smt h2 *)
+
+(*   and to_smt_nop fmt op a = *)
+(*     let rec pp fmt = function *)
+(*       | [] -> assert false *)
+(*       | [x, y] -> fprintf fmt "(not (= %a %a))" to_smt x to_smt y *)
+(*       | (x, y) :: r -> *)
+(*         fprintf fmt "(and (not (= %a %a)) %a)" to_smt x to_smt y pp r *)
+(*     in *)
+(*     let pairs = cross (Array.to_list a) in *)
+(*     pp fmt pairs *)
+
+(* end *)
+
+let string_logic ro f =
+  let l = SL.union (Op.logic_ro ro) (Form.logic f) in
+  if SL.is_empty l then "QF_SAT"
+  else
+    sprintf "QF_%s%s%s%s"
+    (if SL.mem LArrays l then "A" else "")
+    (if SL.mem LUF l || SL.mem LLia l then "UF" else "")
+    (if SL.mem LBitvectors l then "BV" else "")
+    (if SL.mem LLia l then "LIA" else "")
+
+
+
+let call_cvc4 env rt ro ra rf root _ =
+  let open Smtlib2_solver in
+  let fl = snd root in
+
+  let cvc4 = create [|
+      "cvc4";
+      "--lang"; "smt2";
+      "--proof";
+      "--no-simplification"; "--fewer-preprocessing-holes";
+      "--no-bv-eq"; "--no-bv-ineq"; "--no-bv-algebraic" |] in
+
+  set_option cvc4 "print-success" true;
+  set_option cvc4 "produce-assignments" true;
+  set_option cvc4 "produce-proofs" true;
+  set_logic cvc4 (string_logic ro fl);
+
+  List.iter (fun (i,t) ->
+    let s = "Tindex_"^(string_of_int i) in
+    VeritSyntax.add_btype s (SmtBtype.Tindex t);
+    declare_sort cvc4 s 0;
+  ) (SmtBtype.to_list rt);
+  
+  List.iter (fun (i,cod,dom,op) ->
+    let s = "op_"^(string_of_int i) in
+    VeritSyntax.add_fun s op;
+    let args =
+      Array.fold_right
+        (fun t acc -> asprintf "%a" SmtBtype.to_smt t :: acc) cod [] in
+    let ret = asprintf "%a" SmtBtype.to_smt dom in
+    declare_fun cvc4 s args ret
+  ) (Op.to_list ro);
+
+  assume cvc4 (asprintf "%a" (Form.to_smt Atom.to_smt) fl);
+
+  let proof =
+    match check_sat cvc4 with
+    | Unsat ->
+      begin
+        try get_proof cvc4 (import_trace (Some root) lfsc_parse_one)
+        with
+        | Ast.CVC4Sat -> Structures.error "CVC4 returned SAT"
+        | No_proof -> Structures.error "CVC4 did not generate a proof"
+        | Failure s -> Structures.error ("Importing of proof failed: " ^ s)
+      end
+    | Sat ->
+      let smodel = get_model cvc4 in
+      Structures.error
+        ("CVC4 returned sat. Here is the model:\n\n" ^
+         SmtCommands.model_string env rt ro ra rf smodel)
+        (* (asprintf "CVC4 returned sat. Here is the model:\n%a" SExpr.print smodel) *)
+  in
+
+  quit cvc4;
+  proof
+
+
+
+let export out_channel rt ro l =
+  let fmt = formatter_of_out_channel out_channel in
+  fprintf fmt "(set-logic %s)@." (string_logic ro l);
+
+  List.iter (fun (i,t) ->
+    let s = "Tindex_"^(string_of_int i) in
+    VeritSyntax.add_btype s (SmtBtype.Tindex t);
+    fprintf fmt "(declare-sort %s 0)@." s
+  ) (SmtBtype.to_list rt);
+
+  List.iter (fun (i,cod,dom,op) ->
+    let s = "op_"^(string_of_int i) in
+    VeritSyntax.add_fun s op;
+    fprintf fmt "(declare-fun %s (" s;
+    let is_first = ref true in
+    Array.iter (fun t ->
+        if !is_first then is_first := false
+        else fprintf fmt " "; SmtBtype.to_smt fmt t
+      ) cod;
+    fprintf fmt ") %a)@." SmtBtype.to_smt dom;
+  ) (Op.to_list ro);
+
+  fprintf fmt "(assert %a)@\n(check-sat)@\n(exit)@."
+    (Form.to_smt Atom.to_smt) l
+
+
+
+let get_model_from_file filename =
+  let chan = open_in filename in
+  let lexbuf = Lexing.from_channel chan in
+  match SExprParser.sexps SExprLexer.main lexbuf with
+  | [SExpr.Atom "sat"; m] -> m
+  | _ -> Structures.error "CVC4 returned SAT but no model"
+
+
+let call_cvc4_file env rt ro ra rf root =
+  let fl = snd root in
+  let (filename, outchan) = Filename.open_temp_file "cvc4_coq" ".smt2" in
+  export outchan rt ro fl;
+  close_out outchan;
+  let bf = Filename.chop_extension filename in
+  let prooffilename = bf ^ ".lfsc" in
+
+  (* let cvc4_cmd = *)
+  (*   "cvc4 --proof --dump-proof -m --dump-model \ *)
+  (*    --no-simplification --fewer-preprocessing-holes \ *)
+  (*    --no-bv-eq --no-bv-ineq --no-bv-algebraic " *)
+  (*   ^ filename ^ " > " ^ prooffilename in *)
+  (* CVC4 crashes when asking for both models and proofs *)
+  
+  let cvc4_cmd =
+    "cvc4 --proof --dump-proof \
+     --no-simplification --fewer-preprocessing-holes \
+     --no-bv-eq --no-bv-ineq --no-bv-algebraic "
+    ^ filename ^ " > " ^ prooffilename in
+  (* let clean_cmd = "sed -i -e '1d' " ^ prooffilename in *)
+  eprintf "%s@." cvc4_cmd;
+  let t0 = Sys.time () in
+  let exit_code = Sys.command cvc4_cmd in
+  
+  let t1 = Sys.time () in
+  eprintf "CVC4 = %.5f@." (t1-.t0);
+
+  if exit_code <> 0 then
+    Structures.error ("CVC4 crashed: return code "^string_of_int exit_code);
+
+  (* ignore (Sys.command clean_cmd); *)
+
+  try import_trace_from_file (Some root) prooffilename
+  with
+  | No_proof -> Structures.error "CVC4 did not generate a proof"
+  | Failure s -> Structures.error ("Importing of proof failed: " ^ s)
+  | Ast.CVC4Sat ->
+    let smodel = get_model_from_file prooffilename in
+    Structures.error
+      ("CVC4 returned sat. Here is the model:\n\n" ^
+       SmtCommands.model_string env rt ro ra rf smodel)
+
+
+let cvc4_logic = 
+  SL.of_list [LUF; LLia; LBitvectors; LArrays]
+
+
+let tactic_gen vm_cast =
+  clear_all ();
+  let rt = SmtBtype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let ra' = VeritSyntax.ra in
+  let rf' = VeritSyntax.rf in
+  SmtCommands.tactic call_cvc4 cvc4_logic rt ro ra rf ra' rf' vm_cast [] []
+  (* let ra = VeritSyntax.ra in
+   * let rf = VeritSyntax.rf in
+   * (\* Currently, quantifiers are not handled by the cvc4 tactic: we pass
+   *    the same ra and rf twice to have everything reifed *\)
+   * SmtCommands.tactic call_cvc4 cvc4_logic rt ro ra rf ra rf vm_cast [] [] *)
+let tactic () = tactic_gen vm_cast_true
+let tactic_no_check () = tactic_gen (fun _ -> vm_cast_true_no_check)
diff --git a/src/lfsc/lfscLexer.mll b/src/lfsc/lfscLexer.mll
new file mode 100644
index 0000000..3e8d5f9
--- /dev/null
+++ b/src/lfsc/lfscLexer.mll
@@ -0,0 +1,357 @@
+{
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* This parser is adapted from Jane Street sexplib parser *)
+
+  open Printf
+  open Lexing
+  open LfscParser
+
+  let char_for_backslash = function
+    | 'n' -> '\010'
+    | 'r' -> '\013'
+    | 'b' -> '\008'
+    | 't' -> '\009'
+    | c -> c
+
+  let lf = '\010'
+
+  let dec_code c1 c2 c3 =
+    100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48)
+
+  let hex_code c1 c2 =
+    let d1 = Char.code c1 in
+    let val1 =
+      if d1 >= 97 then d1 - 87
+      else if d1 >= 65 then d1 - 55
+      else d1 - 48 in
+    let d2 = Char.code c2 in
+    let val2 =
+      if d2 >= 97 then d2 - 87
+      else if d2 >= 65 then d2 - 55
+      else d2 - 48 in
+    val1 * 16 + val2
+
+  let found_newline ({ lex_curr_p; _ } as lexbuf) diff =
+    lexbuf.lex_curr_p <-
+      {
+        lex_curr_p with
+        pos_lnum = lex_curr_p.pos_lnum + 1;
+        pos_bol = lex_curr_p.pos_cnum - diff;
+      }
+
+  (* same length computation as in [Lexing.lexeme] *)
+  let lexeme_len { lex_start_pos; lex_curr_pos; _ } = lex_curr_pos - lex_start_pos
+
+  let main_failure lexbuf msg =
+    let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_start_p lexbuf in
+    let msg =
+      sprintf
+        "Sexplib.Lexer.main: %s at line %d char %d"
+        msg pos_lnum (pos_cnum - pos_bol)
+    in
+    failwith msg
+
+  module type T = sig
+    module Quoted_string_buffer : sig
+      type t
+      val create : int -> t
+      val add_char : t -> char -> unit
+      val add_substring : t -> string -> int -> int -> unit
+      val add_lexeme : t -> lexbuf -> unit
+      val clear : t -> unit
+      val of_buffer : Buffer.t -> t
+    end
+    module Token : sig
+      type t
+      val lparen : t
+      val rparen : t
+      val lambda : t
+      val biglam : t
+      val pi : t
+      val colon : t
+      val hole : t
+      val sc : t
+      val at : t
+      val integer : string -> t
+      val ident : string -> t
+      val eof : t
+      val simple_string : string -> t
+      val hash_semi : t
+      val quoted_string : Lexing.position -> Quoted_string_buffer.t -> t
+      type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t
+      val comment : string -> main:s -> s
+      val block_comment : Lexing.position -> main:s -> s
+    end
+  end
+
+
+  (* Create and populate a hashtable *)
+  let mk_hashtbl init =
+    let tbl = List.length init |> Hashtbl.create in
+    init |> List.iter (fun (k, v) -> Hashtbl.add tbl k v) ;
+    tbl
+
+  let keywords = mk_hashtbl [
+    ("check", CHECK);
+    ("define", DEFINE);
+    ("declare", DECLARE);
+    ("type", TYPE);
+    ("kind", KIND);
+    ("mpz", MPZ);
+    ("mpq", MPQ);
+    ("program", PROGRAM);
+    ("unsat", UNSAT);
+    ("sat", SAT);
+  ]
+
+  module Make (X : T) : sig
+    val main : ?buf:Buffer.t -> Lexing.lexbuf -> X.Token.t
+  end = struct (* BEGIN FUNCTOR BODY CONTAINING GENERATED CODE *)
+    open X
+
+}
+
+let lf = '\010'
+let lf_cr = ['\010' '\013']
+let dos_newline = "\013\010"
+let blank = [' ' '\009' '\012']
+let unquoted = [^ ';' '(' ')' '"' '\\' ':' '@' '!' ] # blank # lf_cr
+let digit = ['0'-'9']
+let hexdigit = digit | ['a'-'f' 'A'-'F']
+
+let unquoted_start =
+  unquoted # ['#' '|'] | '#' unquoted # ['|'] | '|' unquoted # ['#']
+
+let integer = digit+
+let ident = ('_')* ['a'-'z' 'A'-'Z' '\'' ]['a'-'z' 'A'-'Z' '0'-'9' '\\' '_']*
+
+
+rule main buf = parse
+  | lf | dos_newline { found_newline lexbuf 0;
+                       main buf lexbuf }
+  | blank+ { main buf lexbuf }
+  | (';' (_ # lf_cr)*) as text { Token.comment text ~main buf lexbuf }
+  | '(' { Token.lparen }
+  | ')' { Token.rparen }
+  | '\\' { Token.lambda }
+  | '!' { Token.pi }
+  | '%' { Token.biglam }
+  | '_' { Token.hole }
+  | ':' { Token.colon }
+  | '^' { Token.sc }
+  | '@' { Token.at }
+  | '(' '~' (integer as i) ')' {Token.integer ("-"^i) }
+  | integer as i { Token.integer i }
+  | '"'
+      { 
+        let pos = Lexing.lexeme_start_p lexbuf in
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf pos lexbuf;
+        let tok = Token.quoted_string pos buf in
+        Quoted_string_buffer.clear buf;
+        tok
+      }
+  | "#;" { Token.hash_semi }
+  | "#|"
+      {
+        let pos = Lexing.lexeme_start_p lexbuf in
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_block_comment buf [pos] lexbuf;
+        let tok = Token.block_comment pos ~main buf lexbuf in
+        Quoted_string_buffer.clear buf;
+        tok
+      }
+  | "|#" { main_failure lexbuf "illegal end of comment" }
+  | "#" "#"+ "|" unquoted* (* unquoted_start can match ##, so ##| (which should be
+                              refused) would not not be parsed by this case if the regexp
+                              on the left was not there *)
+  | "|" "|"+ "#" unquoted*
+  | unquoted_start unquoted* ("#|" | "|#") unquoted*
+      { main_failure lexbuf "comment tokens in unquoted atom" }
+  | "#" | "|" | unquoted_start unquoted* as str { Token.simple_string str }
+  | eof { Token.eof }
+
+and scan_string buf start = parse
+  | '"' { Quoted_string_buffer.add_lexeme buf lexbuf; () }
+  | '\\' lf [' ' '\t']*
+      {
+        let len = lexeme_len lexbuf - 2 in
+        found_newline lexbuf len;
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | '\\' dos_newline [' ' '\t']*
+      {
+        let len = lexeme_len lexbuf - 3 in
+        found_newline lexbuf len;
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] as c)
+      {
+        Quoted_string_buffer.add_char buf (char_for_backslash c);
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | '\\' (digit as c1) (digit as c2) (digit as c3)
+      {
+        let v = dec_code c1 c2 c3 in
+        if v > 255 then (
+          let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_end_p lexbuf in
+          let msg =
+            sprintf
+              "Sexplib.Lexer.scan_string: \
+               illegal escape at line %d char %d: `\\%c%c%c'"
+              pos_lnum (pos_cnum - pos_bol - 3)
+              c1 c2 c3 in
+          failwith msg);
+        Quoted_string_buffer.add_char buf (Char.chr v);
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | '\\' 'x' (hexdigit as c1) (hexdigit as c2)
+      {
+        let v = hex_code c1 c2 in
+        Quoted_string_buffer.add_char buf (Char.chr v);
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | '\\' (_ as c)
+      {
+        Quoted_string_buffer.add_char buf '\\';
+        Quoted_string_buffer.add_char buf c;
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | lf
+      {
+        found_newline lexbuf 0;
+        Quoted_string_buffer.add_char buf lf;
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | ([^ '\\' '"'] # lf)+
+      {
+        let ofs = lexbuf.lex_start_pos in
+        let len = lexbuf.lex_curr_pos - ofs in
+        Quoted_string_buffer.add_substring buf lexbuf.lex_buffer ofs len;
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_string buf start lexbuf
+      }
+  | eof
+      {
+        let msg =
+          sprintf
+            "Sexplib.Lexer.scan_string: unterminated string at line %d char %d"
+            start.pos_lnum (start.pos_cnum - start.pos_bol)
+        in
+        failwith msg
+      }
+
+and scan_block_comment buf locs = parse
+  | ('#'* | '|'*) lf
+      { Quoted_string_buffer.add_lexeme buf lexbuf;
+        found_newline lexbuf 0; scan_block_comment buf locs lexbuf }
+  | (('#'* | '|'*) [^ '"' '#' '|'] # lf)+
+      { Quoted_string_buffer.add_lexeme buf lexbuf;
+        scan_block_comment buf locs lexbuf }
+  | ('#'* | '|'*) '"'
+      {
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        let cur = lexeme_end_p lexbuf in
+        let start = { cur with pos_cnum = cur.pos_cnum - 1 } in
+        scan_string buf start lexbuf;
+        scan_block_comment buf locs lexbuf
+      }
+  | '#'+ '|'
+    {
+      Quoted_string_buffer.add_lexeme buf lexbuf;
+      let cur = lexeme_end_p lexbuf in
+      let start = { cur with pos_cnum = cur.pos_cnum - 2 } in
+      scan_block_comment buf (start :: locs) lexbuf
+    }
+  | '|'+ '#'
+      {
+        Quoted_string_buffer.add_lexeme buf lexbuf;
+        match locs with
+        | [_] -> () (* the comment is finished *)
+        | _ :: (_ :: _ as t) -> scan_block_comment buf t lexbuf
+        | [] -> assert false  (* impossible *)
+      }
+  | eof
+      {
+        match locs with
+        | [] -> assert false
+        | { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } :: _ ->
+            let msg =
+              sprintf "Sexplib.Lexer.scan_block_comment: \
+                unterminated block comment at line %d char %d"
+                pos_lnum (pos_cnum - pos_bol)
+            in
+            failwith msg
+      }
+
+{ (* RESUME FUNCTOR BODY CONTAINING GENERATED CODE *)
+
+    let main ?buf =
+      let buf =
+        match buf with
+        | None -> Quoted_string_buffer.create 64
+        | Some buf ->
+          Buffer.clear buf;
+          Quoted_string_buffer.of_buffer buf
+      in
+      main buf
+
+  end (* END FUNCTOR BODY CONTAINING GENERATED CODE *)
+
+  module Vanilla =
+    Make (struct
+      module Quoted_string_buffer = struct
+        include Buffer
+        let add_lexeme _ _ = ()
+        let of_buffer b = b
+      end
+      module Token = struct
+        open LfscParser
+        type t = token
+        type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t
+        let eof = EOF
+        let lparen = LPAREN
+        let rparen = RPAREN
+        let lambda = LAMBDA
+        let pi = PI
+        let biglam =  BIGLAMBDA
+        let hole = HOLE
+        let colon = COLON
+        let sc = SC
+        let at = AT
+        let hash_semi = HASH_SEMI
+        let integer i = INT (Big_int.big_int_of_string i)
+        let ident i =
+          try Hashtbl.find keywords i with Not_found -> STRING i
+        let simple_string x =
+          try Hashtbl.find keywords x with Not_found -> STRING x
+        let quoted_string _ buf = STRING (Buffer.contents buf)
+        let block_comment _pos ~main buf lexbuf =
+          main buf lexbuf
+        let comment _text ~main buf lexbuf =
+          main buf lexbuf (* skip and continue lexing *)
+      end
+    end)
+
+
+  let main = Vanilla.main
+
+}
diff --git a/src/lfsc/lfscParser.mly b/src/lfsc/lfscParser.mly
new file mode 100644
index 0000000..26de090
--- /dev/null
+++ b/src/lfsc/lfscParser.mly
@@ -0,0 +1,347 @@
+%{
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* This parser is adapted from Jane Street sexplib parser *)
+
+open Ast
+open Lexing
+open Format
+open Builtin
+
+let parse_failure what =
+  let pos = Parsing.symbol_start_pos () in
+  let msg =
+    Printf.sprintf "Sexplib.Parser: failed to parse line %d char %d: %s"
+      pos.pos_lnum (pos.pos_cnum - pos.pos_bol) what in
+  failwith msg
+
+let scope = ref []
+
+let renamings = Hashtbl.create 21
+
+let register_rename = Hashtbl.add renamings
+
+let remove_rename = Hashtbl.remove renamings
+
+
+
+%}
+
+%token <string> STRING
+%token <Big_int.big_int> INT
+%token LPAREN RPAREN EOF HASH_SEMI
+%token LAMBDA PI BIGLAMBDA COLON
+%token CHECK DEFINE DECLARE
+%token MPQ MPZ HOLE TYPE KIND
+%token SC PROGRAM AT UNSAT SAT
+
+%start proof
+%type <Ast.proof> proof
+
+%start last_command
+%type <Ast.command option> last_command
+
+%start ignore_commands
+%type <unit> ignore_commands
+
+%start proof_print
+%type <unit> proof_print
+
+%start proof_ignore
+%type <unit> proof_ignore
+
+%start one_command
+%type <Ast.command option> one_command
+
+%start sexp
+%type <Type.t> sexp
+
+%start sexp_opt
+%type <Type.t option> sexp_opt
+
+%start sexps
+%type <Type.t list> sexps
+
+%start rev_sexps
+%type <Type.t list> rev_sexps
+
+%%
+sexp:
+| sexp_comments sexp_but_no_comment { $2 }
+| sexp_but_no_comment { $1 }
+
+sexp_but_no_comment
+  : STRING { Type.Atom $1 }
+  | LPAREN RPAREN { Type.List [] }
+  | LPAREN rev_sexps_aux RPAREN { Type.List (List.rev $2) }
+  | error { parse_failure "sexp" }
+
+sexp_comment
+  : HASH_SEMI sexp_but_no_comment { () }
+  | HASH_SEMI sexp_comments sexp_but_no_comment { () }
+
+sexp_comments
+  : sexp_comment { () }
+  | sexp_comments sexp_comment { () }
+
+sexp_opt
+  : sexp_but_no_comment { Some $1 }
+  | sexp_comments sexp_but_no_comment { Some $2 }
+  | EOF { None }
+  | sexp_comments EOF { None }
+
+rev_sexps_aux
+  : sexp_but_no_comment { [$1] }
+  | sexp_comment { [] }
+  | rev_sexps_aux sexp_but_no_comment { $2 :: $1 }
+  | rev_sexps_aux sexp_comment { $1 }
+
+rev_sexps
+  : rev_sexps_aux EOF { $1 }
+  | EOF { [] }
+
+sexps
+  : rev_sexps_aux EOF { List.rev $1 }
+  | EOF { [] }
+;
+
+
+atom_ignore:
+  | STRING {}
+  | CHECK {}
+  | DEFINE {}
+  | DECLARE {}
+  | TYPE {}
+  | KIND {}
+  | MPZ {}
+  | MPQ {}
+  | PROGRAM {}
+  | INT {}
+  | LAMBDA {}
+  | PI {}
+  | HOLE {}
+  | SC {}
+  | AT {}
+  | COLON {}
+;
+
+sexp_ignore :
+  | atom_ignore {}
+  | LPAREN ignore_sexp_list RPAREN {}
+;
+  
+ignore_sexp_list :
+  | { }
+  | sexp_ignore ignore_sexp_list { }
+;
+
+
+term_list:
+  | term { [$1]}
+  | term term_list { $1 :: $2 }
+;
+
+binding:
+  | STRING term {
+    let n = String.concat "." (List.rev ($1 :: !scope)) in
+    let s = mk_symbol n $2 in
+    register_symbol s;
+    register_rename $1 n;
+    s, $1
+  }
+;
+
+untyped_sym:
+  | STRING {
+    let s = mk_symbol $1 (mk_hole_hole ()) in
+    register_symbol s;
+    s
+  }
+;
+
+let_binding:
+  | STRING term {
+    let x = $1 in
+    let t = $2 in
+    let s = mk_symbol x t.ttype in
+    register_symbol s;
+    add_definition s.sname t;
+    s.sname
+  }
+;
+
+/*
+ignore_string_or_hole:
+  | STRING { }
+  | HOLE { }
+;
+*/
+
+term:
+  | TYPE { lfsc_type }
+  | KIND { kind }
+  | MPQ { mpq }
+  | MPZ { mpz }
+  | INT { mk_mpz $1 }
+  | STRING
+    {
+      let n = try Hashtbl.find renamings $1 with Not_found -> $1 in
+      mk_const n
+    }
+  | HOLE { mk_hole_hole () }
+  | LPAREN AT let_binding term RPAREN { remove_definition $3; $4 }
+  | LPAREN term term_list RPAREN { mk_app $2 $3 }
+  | LPAREN LAMBDA untyped_sym term RPAREN
+    { let s = $3  in
+      let t = $4 in
+      let r = mk_lambda s t in
+      remove_symbol s;
+      r
+    }
+  | LPAREN LAMBDA HOLE term RPAREN
+    { let s = mk_symbol_hole (mk_hole_hole ()) in
+      let t = $4 in
+      mk_lambda s t }
+  | LPAREN BIGLAMBDA binding term RPAREN
+    { let s, old = $3 in
+      let t = $4 in
+      let r = mk_lambda s t in
+      remove_symbol s;
+      remove_rename old;
+      r
+    }
+  | LPAREN BIGLAMBDA HOLE term term RPAREN
+    { let t = $5 in
+      let s = mk_symbol_hole $4 in
+      mk_lambda s t }
+  | LPAREN PI binding term RPAREN
+    { let s, old = $3 in
+      let t = $4 in
+      let r = mk_pi s t in
+      remove_symbol s;
+      remove_rename old;
+      r
+    }
+  | LPAREN PI HOLE term term RPAREN
+    { let s = mk_symbol_hole $4 in
+      let t = $5 in
+      mk_pi s t }
+  | LPAREN PI STRING /* ignore_string_or_hole */
+    LPAREN SC LPAREN STRING term_list RPAREN term RPAREN term RPAREN
+    {
+      add_sc $7 $8 $10 $12
+    }
+  | LPAREN COLON term term RPAREN
+    { mk_ascr $3 $4 }
+;
+
+
+  
+declare:
+  | DECLARE STRING { scope := [$2]; $2 }
+;
+
+define:
+  | DEFINE STRING { scope := [$2]; $2 }
+;
+
+declare_command:
+  | LPAREN declare term RPAREN {
+    mk_declare $2 $3;
+    scope := [];
+    Declare (Hstring.make $2, $3)
+  }
+;
+
+
+define_command:
+  | LPAREN define term RPAREN {
+    mk_define $2 $3;
+    scope := [];
+    Define (Hstring.make $2, $3) }
+;
+
+check_command:
+  | LPAREN CHECK term RPAREN {
+    mk_check $3;
+    Check $3 }
+;
+
+command:
+  | check_command { $1 }
+  | define_command { $1 }
+  | declare_command { $1 }
+;
+
+command_print:
+  | command { printf "@[<hov 1>%a@]@\n@." print_command $1 }
+  | LPAREN PROGRAM STRING ignore_sexp_list RPAREN
+    { printf "Ignored program %s\n@." $3 }
+;
+
+command_ignore:
+  | command { () }
+  | LPAREN PROGRAM STRING ignore_sexp_list RPAREN { () }
+;
+
+command_or_prog_or_unsat:
+  | command { Some $1 }
+  | SAT { raise CVC4Sat }
+  | UNSAT { None }
+  | LPAREN PROGRAM STRING ignore_sexp_list RPAREN
+    { None }
+;
+
+  
+command_list:
+  | { [] }
+  | command_or_prog_or_unsat command_list
+    { match $1 with Some c -> c :: $2 | None -> $2 }
+;
+
+command_print_list:
+  | { }
+  | command_print command_print_list { }
+;
+
+command_ignore_list:
+  | { }
+  | command_ignore command_ignore_list { }
+;
+
+proof:
+  | command_list EOF { $1 }
+;
+
+proof_print:
+  | command_print_list EOF { }
+;
+
+proof_ignore:
+  | command_ignore_list EOF { }
+;
+
+
+last_command:
+  | command_or_prog_or_unsat { $1 }
+  | command_or_prog_or_unsat last_command { $2 }
+;
+
+one_command:
+  | command_or_prog_or_unsat { $1 }
+;
+
+ignore_commands:
+  | command_or_prog_or_unsat { () }
+  | command_or_prog_or_unsat ignore_commands { () }
+;
diff --git a/src/lfsc/lfsctosmtcoq.ml b/src/lfsc/lfsctosmtcoq.ml
new file mode 100644
index 0000000..0e9371d
--- /dev/null
+++ b/src/lfsc/lfsctosmtcoq.ml
@@ -0,0 +1,159 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Ast
+open Format
+open Builtin
+open VeritPrinter
+
+let _ = Printexc.record_backtrace true
+
+
+(* Captures the output and exit status of a unix command : aux func *)
+let syscall cmd =
+  let ic, oc = Unix.open_process cmd in
+  let buf = Buffer.create 16 in
+  (try
+     while true do
+       Buffer.add_channel buf ic 1
+     done
+   with End_of_file -> ());
+  ignore(Unix.close_process (ic, oc));
+  Buffer.contents buf
+
+(* Set width of pretty printing boxes to number of columns *)
+let vt_width =
+  try
+    let scol = syscall "tput cols" in
+    let w = int_of_string (String.trim scol) in
+    set_margin w;
+    w
+  with Not_found | Failure _ -> 80
+
+
+let _ =
+  pp_set_margin std_formatter vt_width;
+  pp_set_margin err_formatter vt_width;
+  set_max_indent (get_margin () / 3)
+
+
+
+module C = Converter.Make (VeritPrinter)
+
+
+(* Hard coded signatures *)
+let signatures =
+  let sigdir = try Sys.getenv "LFSCSIGS" with Not_found -> Sys.getcwd () in
+  ["sat.plf";
+   "smt.plf";
+   "th_base.plf";
+   "th_int.plf";
+   "th_bv.plf";
+   "th_bv_bitblast.plf";
+   "th_bv_rewrites.plf";
+   "th_arrays.plf" ]
+  |> List.map (Filename.concat sigdir)
+
+
+let process_signatures () =
+  try
+    List.iter (fun f ->
+        let chan = open_in f in
+        let lexbuf = Lexing.from_channel chan in
+        LfscParser.ignore_commands LfscLexer.main lexbuf;
+        close_in chan
+      ) signatures
+  with
+  | Ast.TypingError (t1, t2) ->
+    eprintf "@[<hov>LFSC typing error: expected %a, got %a@]@."
+      Ast.print_term t1
+      Ast.print_term t2
+
+
+(** Translate to veriT proof format and print pretty LFSC proof with colors *)
+let pretty_to_verit () =
+  process_signatures ();
+  let chan =
+    try
+      let filename = Sys.argv.(1) in
+      open_in filename
+    with Invalid_argument _ -> stdin
+  in
+  let buf = Lexing.from_channel chan in
+
+  try
+    let proof = LfscParser.proof LfscLexer.main buf in
+
+    printf "LFSC proof:\n\n%a\n\n@." print_proof proof;
+
+    printf "Verit proof:\n@.";
+    
+    match List.rev proof with
+    | Check p :: _ ->
+      flatten_term p;
+      C.convert_pt p |> ignore
+    | _ -> eprintf "No proof@."; exit 1
+    
+
+  with Ast.TypingError (t1, t2) ->
+    eprintf "@[<hov>Typing error: expected %a, got %a@]@."
+      Ast.print_term t1
+      Ast.print_term t2
+
+
+(** Translate to veriT proof format *)
+let to_verit () =
+  process_signatures ();
+  let chan =
+    try
+      let filename = Sys.argv.(1) in
+      open_in filename
+    with Invalid_argument _ -> stdin
+  in
+  let buf = Lexing.from_channel chan in
+
+  eprintf "Type-checking LFSC proof.@.";
+  try
+
+    match LfscParser.last_command LfscLexer.main buf with
+    | Some (Check p) ->
+      (* eprintf "Flattening pointer structures...@."; *)
+      (* flatten_term p; *)
+      (* eprintf "Done (flatten)@."; *)
+      C.convert_pt p |> ignore
+    | _ -> eprintf "No proof@."; exit 1
+
+  with
+  | Ast.TypingError (t1, t2) as e ->
+    let backtrace = Printexc.get_backtrace () in
+    eprintf "Fatal error: %s@." (Printexc.to_string e);
+    eprintf "Backtrace:@\n%s@." backtrace;
+
+    eprintf "@[<hov>Typing error: expected %a, got %a@]@."
+      Ast.print_term t1
+      Ast.print_term t2
+  | Ast.CVC4Sat ->
+    eprintf "CVC4 returned SAT@."; exit 1
+
+
+
+let _ = to_verit ()
+
+
+
+
+(* 
+   Local Variables:
+   compile-command: "make"
+   indent-tabs-mode: nil
+   End: 
+*)
diff --git a/src/lfsc/shashcons.ml b/src/lfsc/shashcons.ml
new file mode 100644
index 0000000..a3d0f0c
--- /dev/null
+++ b/src/lfsc/shashcons.ml
@@ -0,0 +1,84 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(*s Hash tables for hash-consing. (Some code is borrowed from the ocaml
+    standard library, which is copyright 1996 INRIA.) *)
+
+module type HashedType =
+  sig
+    type t
+    val equal : t -> t -> bool
+    val hash : t -> int
+    val tag : int -> t -> t
+  end
+
+module type S =
+  sig
+    type t
+    val hashcons : t -> t
+    val iter : (t -> unit) -> unit
+    val stats : unit -> int * int * int * int * int * int
+  end
+
+module Make(H : HashedType) : (S with type t = H.t) =
+struct
+  type t = H.t
+
+  module WH = Weak.Make (H)
+
+  let next_tag = ref 0
+
+  let htable = WH.create 5003
+
+  let hashcons d =
+    let d = H.tag !next_tag d in
+    let o = WH.merge htable d in
+    if o == d then incr next_tag;
+    o
+
+  let iter f = WH.iter f htable
+
+  let stats () = WH.stats htable
+end
+
+
+type 'a hash_consed = {
+  tag : int;
+  node : 'a }
+
+module type HashedType_consed =
+  sig
+    type t
+    val equal : t -> t -> bool
+    val hash : t -> int
+  end
+
+module type S_consed =
+  sig
+    type key
+    val hashcons : key -> key hash_consed
+    val iter : (key hash_consed -> unit) -> unit
+    val stats : unit -> int * int * int * int * int * int
+  end
+
+module Make_consed(H : HashedType_consed) : (S_consed with type key = H.t) =
+struct
+  module M = Make(struct
+    type t = H.t hash_consed
+    let hash x = H.hash x.node
+    let equal x y = H.equal x.node y.node
+    let tag i x = {x with tag = i}
+  end)
+  include M
+  type key = H.t
+  let hashcons x = M.hashcons {tag = -1; node = x}
+end
diff --git a/src/lfsc/shashcons.mli b/src/lfsc/shashcons.mli
new file mode 100644
index 0000000..049ec5f
--- /dev/null
+++ b/src/lfsc/shashcons.mli
@@ -0,0 +1,93 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Hash tables for hash consing *)
+
+(*s Hash tables for hash consing.
+
+    Hash consed values are of the
+    following type [hash_consed]. The field [tag] contains a unique
+    integer (for values hash consed with the same table). The field
+    [hkey] contains the hash key of the value (without modulo) for
+    possible use in other hash tables (and internally when hash
+    consing tables are resized). The field [node] contains the value
+    itself.
+
+    Hash consing tables are using weak pointers, so that values that are no
+    more referenced from anywhere else can be erased by the GC. *)
+
+module type HashedType =
+  sig
+    type t
+    val equal : t -> t -> bool
+    val hash : t -> int
+    val tag : int -> t -> t
+  end
+
+module type S =
+  sig
+    type t
+
+    val hashcons : t -> t
+      (** [hashcons n f] hash-cons the value [n] using function [f] i.e. returns
+	  any existing value in the table equal to [n], if any;
+	  otherwise, creates a new value with function [f], stores it
+	  in the table and returns it. Function [f] is passed
+	  the node [n] as first argument and the unique id as second argument.
+      *)
+
+    val iter : (t -> unit) -> unit
+      (** [iter f] iterates [f] over all elements of the table . *)
+    val stats : unit -> int * int * int * int * int * int
+      (** Return statistics on the table.  The numbers are, in order:
+	  table length, number of entries, sum of bucket lengths,
+	  smallest bucket length, median bucket length, biggest
+	  bucket length. *)
+  end
+
+module Make(H : HashedType) : (S with type t = H.t)
+
+
+(* For simple use *)
+type 'a hash_consed = private {
+  tag : int;
+  node : 'a }
+
+module type HashedType_consed =
+  sig
+    type t
+    val equal : t -> t -> bool
+    val hash : t -> int
+  end
+
+module type S_consed =
+  sig
+    type key
+
+    val hashcons : key -> key hash_consed
+      (** [hashcons n f] hash-cons the value [n] using function [f] i.e. returns
+	  any existing value in the table equal to [n], if any;
+	  otherwise, creates a new value with function [f], stores it
+	  in the table and returns it. Function [f] is passed
+	  the node [n] as first argument and the unique id as second argument.
+      *)
+
+    val iter : (key hash_consed -> unit) -> unit
+      (** [iter f] iterates [f] over all elements of the table . *)
+    val stats : unit -> int * int * int * int * int * int
+      (** Return statistics on the table.  The numbers are, in order:
+	  table length, number of entries, sum of bucket lengths,
+	  smallest bucket length, median bucket length, biggest
+	  bucket length. *)
+  end
+
+module Make_consed(H : HashedType_consed) : (S_consed with type key = H.t)
diff --git a/src/lfsc/tests/_sat.plf b/src/lfsc/tests/_sat.plf
new file mode 100755
index 0000000..80cfd44
--- /dev/null
+++ b/src/lfsc/tests/_sat.plf
@@ -0,0 +1,95 @@
+(declare bool type)
+(declare tt bool)
+(declare ff bool)
+
+(declare var type)
+
+(declare formula type)
+(declare th_holds (! f formula type))
+
+(declare sort type)
+(declare Bool sort)				
+
+(declare term (! t sort type))
+
+(declare p_app (! x (term Bool) formula))
+                
+(declare lit type)
+(declare pos (! x var lit))
+(declare neg (! x var lit))
+
+(declare clause type)
+(declare cln clause)
+(declare clc (! x lit (! c clause clause)))
+
+; constructs for general clauses for R, Q, satlem
+
+(declare concat (! c1 clause (! c2 clause clause)))
+(declare clr (! l lit (! c clause clause)))
+
+; code to check resolutions
+
+
+;; resolution proofs
+
+(declare holds (! c clause type))
+
+(declare atom (! v var (! f formula type)))
+
+(declare decl_atom
+  (! f formula
+  (! u (! v var
+       (! a (atom v f)
+         (holds cln)))
+    (holds cln))))
+
+(declare R (! c1 clause (! c2 clause
+           (! u1 (holds c1)
+           (! u2 (holds c2)
+           (! n var
+            (holds (concat (clr (pos n) c1)
+                     (clr (neg n) c2)))))))))
+
+(declare Q (! c1 clause (! c2 clause
+           (! u1 (holds c1)
+           (! u2 (holds c2)
+           (! n var
+            (holds (concat (clr (neg n) c1)
+                     (clr (pos n) c2)))))))))
+
+(declare satlem_simplify
+                (! c1 clause
+                (! c2 clause
+                (! c3 clause
+                (! u1 (holds c1)
+                (! r (^ (simplify_clause c1) c2)
+                (! u2 (! x (holds c2) (holds c3))
+                   (holds c3))))))))
+
+
+(declare satlem
+  (! c clause
+  (! c2 clause
+  (! u (holds c)
+  (! u2 (! v (holds c) (holds c2))
+    (holds c2))))))
+
+; A little example to demonstrate simplify_clause.
+; It can handle nested clr's of both polarities,
+; and correctly cleans up marks when it leaves a
+; clr or clc scope.  Uncomment and run with
+; --show-runs to see it in action.
+;
+; (check
+;   (% v1 var
+;   (% u1 (holds (concat (clr (neg v1) (clr (pos v1) (clc (pos v1) (clr (pos v1) (clc (pos v1) (clc (neg v1) cln))))))
+;                    (clc (pos v1) (clc (pos v1) cln))))
+;    (satlem _ _ _ u1 (\ x x))))))
+
+
+
+;(check
+;   (% v1 var
+;   (% u1 (holds (clr (neg v1) (concat (clc (neg v1) cln)
+;                                      (clr (neg v1) (clc (neg v1) cln)))))
+;    (satlem _ _ _ u1 (\ x x))))))
diff --git a/src/lfsc/tests/array.smt2 b/src/lfsc/tests/array.smt2
new file mode 100644
index 0000000..82fbd71
--- /dev/null
+++ b/src/lfsc/tests/array.smt2
@@ -0,0 +1,17 @@
+(set-logic QF_ALIA)
+
+(declare-fun a () (Array Int Int))
+(declare-fun b () (Array Int Int))
+(declare-fun c () (Array Int Int))
+(declare-fun d () (Array Int Int))
+
+(assert (= c (store b 0 4)))
+
+;; (assert (= d (store (store (store a 0 3) 1 (select c 0)) 2 2)))
+
+(assert (not (= (select (store (store (store a 0 3) 1 (select c 0)) 2 2) 1) 4)))
+
+;; (assert (= c d))
+
+(check-sat)
+
diff --git a/src/lfsc/tests/array_bv3.smt2 b/src/lfsc/tests/array_bv3.smt2
new file mode 100644
index 0000000..b3f1be9
--- /dev/null
+++ b/src/lfsc/tests/array_bv3.smt2
@@ -0,0 +1,34 @@
+;; (set-logic QF_ALIA)
+(set-logic QF_AUFBVLIA)
+
+(declare-fun bv1 () (_ BitVec 10))
+(declare-fun bv2 () (_ BitVec 10))
+
+(declare-fun bv3 () (_ BitVec 10))
+(declare-fun bv4 () (_ BitVec 10))
+
+(declare-fun a () (Array (_ BitVec 10) (_ BitVec 10)))
+(declare-fun b () (Array (_ BitVec 10) (_ BitVec 10)))
+(declare-fun c () (Array (_ BitVec 10) (_ BitVec 10)))
+(declare-fun d () (Array (_ BitVec 10) (_ BitVec 10)))
+
+(assert (= #b0000000000 bv1))
+(assert (= #b0000000001 bv2))
+(assert (= #b0000000100 bv3))
+(assert (= #b1111111111 bv4))
+
+(assert
+ (= (bvmul bv4 bv3) bv3))
+
+
+
+(assert (not	
+(=> (= c (store b bv1 bv3))
+(=> (= d (store (store b bv1 bv3) bv2 bv3))
+
+(=> (= a (store d bv2 (select b bv2)))
+    
+    (= a c))))))
+
+
+(check-sat)
diff --git a/src/lfsc/tests/array_ext.smt2 b/src/lfsc/tests/array_ext.smt2
new file mode 100644
index 0000000..4f7586a
--- /dev/null
+++ b/src/lfsc/tests/array_ext.smt2
@@ -0,0 +1,27 @@
+;; (set-logic QF_ALIA)
+(set-logic QF_AUFBVLIA)
+
+(declare-fun a () (Array Int Int))
+(declare-fun b () (Array Int Int))
+(declare-fun c () (Array Int Int))
+(declare-fun d () (Array Int Int))
+
+;; (assert (= c (store b 0 4)))
+;; (assert (= d (store (store b 0 4) 1 4)))
+
+;; (assert (= a (store d 1 (select b 1))))
+
+;; (assert (not (= a c)))
+
+
+(assert (not
+(=> (= c (store b 0 4))
+(=> (= d (store (store b 0 4) 1 4))
+
+(=> (= a (store d 1 (select b 1)))
+    
+    (= a c))))))
+
+
+(check-sat)
+
diff --git a/src/lfsc/tests/array_ext2.smt2 b/src/lfsc/tests/array_ext2.smt2
new file mode 100644
index 0000000..67d2a09
--- /dev/null
+++ b/src/lfsc/tests/array_ext2.smt2
@@ -0,0 +1,31 @@
+;; (set-logic QF_ALIA)
+(set-logic QF_AUFBVLIA)
+
+(declare-fun bv1 () (_ BitVec 32))
+(declare-fun bv2 () (_ BitVec 32))
+
+(declare-fun bv3 () (_ BitVec 32))
+
+
+(declare-fun a () (Array (_ BitVec 32) (_ BitVec 32)))
+(declare-fun b () (Array (_ BitVec 32) (_ BitVec 32)))
+(declare-fun c () (Array (_ BitVec 32) (_ BitVec 32)))
+(declare-fun d () (Array (_ BitVec 32) (_ BitVec 32)))
+
+(assert (= #b00000000000000000000000000000000 bv1))
+(assert (= #b00000000000000000000000000000001 bv2))
+(assert (= #b00000000000000000000000000000100 bv3))
+
+
+
+(assert (not
+(=> (= c (store b bv1 bv3))
+(=> (= d (store (store b bv1 bv3) bv2 bv3))
+
+(=> (= a (store d bv2 (select b bv2)))
+    
+    (= a c))))))
+
+
+(check-sat)
+
diff --git a/src/lfsc/tests/array_incompleteness1.smt2 b/src/lfsc/tests/array_incompleteness1.smt2
new file mode 100644
index 0000000..76a1089
--- /dev/null
+++ b/src/lfsc/tests/array_incompleteness1.smt2
@@ -0,0 +1,19 @@
+(set-logic QF_AUFLIA)
+(set-info :source | This is based on an example in Section 6.2 of "A Decision
+Procedure for an Extensional Theory of Arrays" by Stump, Barrett, Dill, and
+Levitt. |)
+(set-info :smt-lib-version 2.0)
+(set-info :category "check")
+(set-info :status unsat)
+(set-info :notes |This benchmark is designed to require an array DP to propagate a properly entailed disjunction of equalities between shared terms.|)
+(declare-fun a () (Array Int Int))
+(declare-fun b () (Array Int Int))
+(declare-fun v () Int)
+(declare-fun w () Int)
+(declare-fun x () Int)
+(declare-fun y () Int)
+(declare-fun g ((Array Int Int)) Int)
+(declare-fun f (Int) Int)
+(assert (and (= (store a x v) b) (and (= (store a y w) b) (and (not (= (f x) (f y))) (not (= (g a) (g b)))) )))	
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv1.smt2 b/src/lfsc/tests/bv1.smt2
new file mode 100644
index 0000000..c23b151
--- /dev/null
+++ b/src/lfsc/tests/bv1.smt2
@@ -0,0 +1,5 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 2))
+(assert (not (= a a)))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv2.smt2 b/src/lfsc/tests/bv2.smt2
new file mode 100644
index 0000000..e1d582a
--- /dev/null
+++ b/src/lfsc/tests/bv2.smt2
@@ -0,0 +1,7 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 2))
+(declare-fun b () (_ BitVec 2))
+(declare-fun c () (_ BitVec 2))
+(assert (and (= c a) (and (= b a) (not (= c b)))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv3.smt2 b/src/lfsc/tests/bv3.smt2
new file mode 100644
index 0000000..b16d58c
--- /dev/null
+++ b/src/lfsc/tests/bv3.smt2
@@ -0,0 +1,6 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 2))
+(declare-fun b () (_ BitVec 2))
+(assert (and (= a b) (not (= a b))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv_add.smt2 b/src/lfsc/tests/bv_add.smt2
new file mode 100644
index 0000000..dd7586e
--- /dev/null
+++ b/src/lfsc/tests/bv_add.smt2
@@ -0,0 +1,16 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 4))
+(declare-fun b () (_ BitVec 4))
+(declare-fun c () (_ BitVec 4))
+(declare-fun d () (_ BitVec 4))
+
+(assert (= #b0010 a))
+(assert (= #b0110 b))
+(assert (= #b1000 c))
+(assert (= #b1100 d))
+
+(assert
+ (not (= (bvadd a b) c)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv_artih.smt2 b/src/lfsc/tests/bv_artih.smt2
new file mode 100644
index 0000000..a6db769
--- /dev/null
+++ b/src/lfsc/tests/bv_artih.smt2
@@ -0,0 +1,28 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 4))
+(declare-fun b () (_ BitVec 4))
+(declare-fun c () (_ BitVec 4))
+(declare-fun d () (_ BitVec 4))
+
+;; (assert (= a #b0010))
+;; (assert (= b #b0110))
+;; (assert (= c #b1000))
+;; (assert (= d #b0010))
+
+(assert (= #b0010 a))
+(assert (= #b0110 b))
+(assert (= #b1000 c))
+(assert (= #b0010 d))
+
+;; (assert (= #b1111 a))
+;; (assert (= #b1111 b))
+;; (assert (= #b1111 c))
+;; (assert (= #b1111 d))
+
+(assert
+ (not (= (bvand (bvand a b) d) d)))
+
+;; (assert
+;;  (not (= (bvadd a b) (bvadd b (bvadd a #b1111)))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv_mult.smt2 b/src/lfsc/tests/bv_mult.smt2
new file mode 100644
index 0000000..7270afa
--- /dev/null
+++ b/src/lfsc/tests/bv_mult.smt2
@@ -0,0 +1,16 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 4))
+(declare-fun b () (_ BitVec 4))
+(declare-fun c () (_ BitVec 4))
+(declare-fun d () (_ BitVec 4))
+
+(assert (= #b0010 a))
+(assert (= #b0110 b))
+(assert (= #b1000 c))
+(assert (= #b1100 d))
+
+(assert
+ (not (= (bvmul a b) d)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bv_mult10.smt2 b/src/lfsc/tests/bv_mult10.smt2
new file mode 100644
index 0000000..38b8dec
--- /dev/null
+++ b/src/lfsc/tests/bv_mult10.smt2
@@ -0,0 +1,16 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 10))
+(declare-fun b () (_ BitVec 10))
+(declare-fun c () (_ BitVec 10))
+(declare-fun d () (_ BitVec 10))
+
+(assert (= #b0000000010 a))
+(assert (= #b0000000110 b))
+(assert (= #b0000001000 c))
+(assert (= #b0000001100 d))
+
+(assert
+ (not (= (bvmul a b) d)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bvand1.smt2 b/src/lfsc/tests/bvand1.smt2
new file mode 100644
index 0000000..1d88efc
--- /dev/null
+++ b/src/lfsc/tests/bvand1.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 2))
+(declare-fun b () (_ BitVec 2))
+(declare-fun c () (_ BitVec 2))
+(assert (= a #b10))
+
+(assert (= (bvand a b) c))
+(assert (not (= (bvand (bvand a b) c) c)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bvconcat.smt2 b/src/lfsc/tests/bvconcat.smt2
new file mode 100644
index 0000000..a1021bd
--- /dev/null
+++ b/src/lfsc/tests/bvconcat.smt2
@@ -0,0 +1,15 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 4))
+(declare-fun b () (_ BitVec 5))
+(declare-fun c () (_ BitVec 9))
+
+
+(assert (= #b0010 a))
+(assert (= #b01101 b))
+(assert (= #b001001101 c))
+
+(assert
+ (not (= (concat a b) c)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bvneg0_32.smt2 b/src/lfsc/tests/bvneg0_32.smt2
new file mode 100644
index 0000000..2062cba
--- /dev/null
+++ b/src/lfsc/tests/bvneg0_32.smt2
@@ -0,0 +1,10 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 32))
+(declare-fun b () (_ BitVec 32))
+(declare-fun c () (_ BitVec 32))
+
+(assert (= c (bvneg a)))
+(assert (not (= a (bvneg c))))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bvnot32.smt2 b/src/lfsc/tests/bvnot32.smt2
new file mode 100644
index 0000000..2185266
--- /dev/null
+++ b/src/lfsc/tests/bvnot32.smt2
@@ -0,0 +1,10 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 32))
+(declare-fun b () (_ BitVec 32))
+(declare-fun c () (_ BitVec 32))
+
+(assert (= c (bvnot a)))
+(assert (not (= (bvnot c) a)))
+
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/bvult.smt2 b/src/lfsc/tests/bvult.smt2
new file mode 100644
index 0000000..5fd8cce
--- /dev/null
+++ b/src/lfsc/tests/bvult.smt2
@@ -0,0 +1,23 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 32))
+(declare-fun b () (_ BitVec 32))
+(declare-fun c () (_ BitVec 32))
+(declare-fun d () (_ BitVec 32))
+
+;; (assert (= #b01 a))
+;; (assert (= #b10 b))
+;; (assert (= #b00 c))
+;; (assert (= #b11 d))
+
+(declare-fun one () (_ BitVec 32))
+(declare-fun max () (_ BitVec 32))
+
+(assert (= one #b00000000000000000000000000000001))
+(assert (= max #b11111111111111111111111111111111))
+
+(assert (not (= a max)))
+
+(assert
+ (not (bvult a (bvadd a one))))
+
+(check-sat)
diff --git a/src/lfsc/tests/cvc4_coq40d8ed.smt2 b/src/lfsc/tests/cvc4_coq40d8ed.smt2
new file mode 100644
index 0000000..29e28b0
--- /dev/null
+++ b/src/lfsc/tests/cvc4_coq40d8ed.smt2
@@ -0,0 +1,9 @@
+(set-logic QF_UFLIA)
+(declare-fun op_4 () Int)
+(declare-fun op_1 (Int) Bool)
+(declare-fun op_0 () Int)
+(declare-fun op_2 () Int)
+(declare-fun op_3 (Int) Int)
+(assert (and (= op_2 op_4) (and (= op_0 op_4) (or (not (= (op_3 op_2) (op_3 op_0))) (and (op_1 op_2) (not (op_1 op_0)))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/cvc4tocoq b/src/lfsc/tests/cvc4tocoq
new file mode 100755
index 0000000..72251bd
--- /dev/null
+++ b/src/lfsc/tests/cvc4tocoq
@@ -0,0 +1,40 @@
+#!/bin/bash
+set -e
+
+name=${1%.*}
+DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
+
+gnudate() {
+    if hash gdate 2>/dev/null; then
+        gdate "$@"
+    else
+        date "$@"
+    fi
+}
+
+echo -n "Running CVC4... "
+T0=$(gnudate +%s.%N)
+cvc4 --proof --dump-proof --no-simplification --fewer-preprocessing-holes --no-bv-eq --no-bv-ineq --no-bv-algebraic --allow-empty-dependencies $1 > $name.lfsc
+T1=$(gnudate +%s.%N)
+CVC4TIME=$(echo "$T1 - $T0" | bc)
+echo "Done [$CVC4TIME s]"
+
+# sed -i -e '1d' $name.lfsc
+
+ cat > ${name}_lfsc.v <<EOF
+ Require Import SMTCoq Bool List.
+ Import ListNotations BVList.BITVECTOR_LIST FArray.
+ Local Open Scope list_scope.
+ Local Open Scope farray_scope.
+ Local Open Scope bv_scope.
+
+ Section File.
+   Lfsc_Checker "$name.smt2" "$name.lfsc".
+ End File.
+EOF
+
+echo "Checking LFSC proof with Coq directly."
+coqc -q -R $DIR/../.. SMTCoq ${name}_lfsc.v
+
+exit 0
+
diff --git a/src/lfsc/tests/cvc4tov b/src/lfsc/tests/cvc4tov
new file mode 100755
index 0000000..183629e
--- /dev/null
+++ b/src/lfsc/tests/cvc4tov
@@ -0,0 +1,66 @@
+#!/bin/bash
+set -e
+
+name=${1%.*}
+DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
+
+echo "Running CVC4..."
+cvc4 --proof --dump-proof --no-simplification --fewer-preprocessing-holes --no-bv-eq --no-bv-ineq --no-bv-algebraic $1 > $name.lfsc
+
+# sed -i -e '1d' $name.lfsc
+
+# echo "Convert LFSC proof to SMTCoq..."
+$DIR/../lfsctosmtcoq.native $name.lfsc | grep "^1:" -A 9999999 > $name.log
+
+echo "Creating Coq file..."
+cat > $name.v <<EOF
+Require Import SMTCoq Bool List.
+Import ListNotations BVList.BITVECTOR_LIST FArray.
+Local Open Scope list_scope.
+Local Open Scope farray_scope.
+Local Open Scope bv_scope.
+
+Section File.
+  Verit_Checker "$name.smt2" "$name.log".
+End File.
+EOF
+
+cat > ${name}_debug.v <<EOF
+Require Import SMTCoq Bool List.
+Import ListNotations BVList.BITVECTOR_LIST FArray.
+Local Open Scope list_scope.
+Local Open Scope farray_scope.
+Local Open Scope bv_scope.
+
+Section File.
+  Verit_Checker_Debug "$name.smt2" "$name.log".
+End File.
+
+(*
+Section File2.
+  Parse_certif_verit t_i t_func t_atom t_form root used_roots trace "$name.smt2" "$name.log".
+  Compute (
+      let (nclauses, t, confl) := trace in
+      let s := add_roots (S.make nclauses) root used_roots in
+      let s' := Structures.trace_fold
+        (fun s a =>
+          (@Euf_Checker.step_checker t_i t_func t_atom t_form) s a
+        ) s t in
+      let s'' := PArray.mapi (fun i c => (to_Z i, List.map to_Z c)) s' in
+      (PArray.to_list s'', to_Z confl)).
+End File2.
+*)
+EOF
+
+cat > ${name}_debug.sh <<EOF
+#!/bin/sh
+coqc -q -R $DIR/../.. SMTCoq ${name}_debug.v | grep --color -E "\[0(;\s+0)*\]| 0|"
+EOF
+
+chmod +x ${name}_debug.sh
+
+
+echo "Checking with Coq..."
+coqc -q -R $DIR/../.. SMTCoq $name.v
+
+exit 0
diff --git a/src/lfsc/tests/dead_dnd001.smt2 b/src/lfsc/tests/dead_dnd001.smt2
new file mode 100644
index 0000000..63a2800
--- /dev/null
+++ b/src/lfsc/tests/dead_dnd001.smt2
@@ -0,0 +1,168 @@
+(set-logic QF_UF)
+(set-info :status unsat)
+
+(declare-sort I 0)
+(declare-fun f (I I) I)
+(declare-fun a () I)
+(declare-fun b () I)
+(declare-fun c () I)
+
+
+
+(assert
+ (or
+  (= (f a a) a)
+  (or (= (f a a) b)
+      (= (f a a) c))
+  ))
+
+(assert
+ (or
+  (= (f a b) a)
+  (or (= (f a b) b)
+      (= (f a b) c))
+  ))
+
+(assert
+ (or
+  (= (f a c) a)
+  (or (= (f a c) b)
+      (= (f a c) c))
+  ))
+
+(assert
+ (or
+  (= (f b a) a)
+  (or (= (f b a) b)
+      (= (f b a) c))
+  ))
+
+(assert
+ (or
+  (= (f b b) a)
+  (or (= (f b b) b)
+      (= (f b b) c))
+  ))
+
+(assert
+ (or
+  (= (f b c) a)
+  (or (= (f b c) b)
+      (= (f b c) c))
+  ))
+
+
+(assert
+ (or
+  (= (f c a) a)
+  (or (= (f c a) b)
+      (= (f c a) c))
+  ))
+
+(assert
+ (or
+  (= (f c b) a)
+  (or (= (f c b) b)
+      (= (f c b) c))
+  ))
+
+(assert
+ (or
+  (= (f c c) a)
+  (or (= (f c c) b)
+      (= (f c c) c))
+  ))
+
+
+
+(assert
+ (or
+  (= (f a a) a)
+  (or (= (f b b) a)
+      (= (f c c) a))
+  ))
+
+(assert
+ (or
+  (= (f a a) b)
+  (or (= (f b b) b)
+      (= (f c c) b))
+  ))
+
+(assert
+ (or
+  (= (f a a) c)
+  (or (= (f b b) c)
+      (= (f c c) c))
+  ))
+
+
+
+(assert
+ (or
+  (= (f a a) a)
+  (or (= (f b a) b)
+      (= (f c a) c))
+  ))
+
+(assert
+ (or
+  (= (f a b) a)
+  (or (= (f b b) b)
+      (= (f c b) c))
+  ))
+
+(assert
+ (or
+  (= (f a c) a)
+  (or (= (f b c) b)
+      (= (f c c) c))
+  ))
+
+
+
+
+(assert (not (= (f a a) a)))
+(assert (not (= (f b b) b)))
+(assert (not (= (f c c) c)))                
+
+
+(assert
+ (or
+  (not (= (f a (f a a)) a))
+  (or (not (= (f a (f a b)) b))
+      (not (= (f a (f a c)) c)))
+  ))
+
+(assert
+ (or
+  (not (= (f b (f b a)) a)) 
+  (or (not (= (f b (f b b)) b))
+      (not (= (f b (f b c)) c)))
+  ))
+
+(assert
+ (or
+  (not (= (f c (f c a)) a)) 
+  (or (not (= (f c (f c b)) b))
+      (not (= (f c (f c c)) c)))
+  ))
+
+
+(assert  (not (= (f a a) (f b a))))
+(assert  (not (= (f a a) (f c a))))
+(assert  (not (= (f b a) (f c a))))
+
+(assert  (not (= (f a b) (f b b))))
+(assert  (not (= (f a b) (f c b))))
+(assert  (not (= (f b b) (f c b))))
+
+(assert  (not (= (f a c) (f b c))))
+(assert  (not (= (f a c) (f c c))))
+(assert  (not (= (f b c) (f c c))))
+
+
+
+(check-sat)
+
+(exit)
diff --git a/src/lfsc/tests/dead_dnd001_and.smt2 b/src/lfsc/tests/dead_dnd001_and.smt2
new file mode 100644
index 0000000..4d93b9e
--- /dev/null
+++ b/src/lfsc/tests/dead_dnd001_and.smt2
@@ -0,0 +1,168 @@
+(set-logic QF_UF)
+(set-info :status unsat)
+
+(declare-sort I 0)
+(declare-fun f (I I) I)
+(declare-fun a () I)
+(declare-fun b () I)
+(declare-fun c () I)
+
+
+(assert
+(and
+ (or
+  (= (f a a) a)
+  (or (= (f a a) b)
+      (= (f a a) c))
+  )
+
+(and
+ (or
+  (= (f a b) a)
+  (or (= (f a b) b)
+      (= (f a b) c))
+  )
+
+(and
+ (or
+  (= (f a c) a)
+  (or (= (f a c) b)
+      (= (f a c) c))
+  )
+
+(and
+ (or
+  (= (f b a) a)
+  (or (= (f b a) b)
+      (= (f b a) c))
+  )
+
+(and
+ (or
+  (= (f b b) a)
+  (or (= (f b b) b)
+      (= (f b b) c))
+  )
+
+(and
+ (or
+  (= (f b c) a)
+  (or (= (f b c) b)
+      (= (f b c) c))
+  )
+
+
+(and
+ (or
+  (= (f c a) a)
+  (or (= (f c a) b)
+      (= (f c a) c))
+  )
+
+(and
+ (or
+  (= (f c b) a)
+  (or (= (f c b) b)
+      (= (f c b) c))
+  )
+
+(and
+ (or
+  (= (f c c) a)
+  (or (= (f c c) b)
+      (= (f c c) c))
+  )
+
+
+
+(and
+ (or
+  (= (f a a) a)
+  (or (= (f b b) a)
+      (= (f c c) a))
+  )
+
+(and
+ (or
+  (= (f a a) b)
+  (or (= (f b b) b)
+      (= (f c c) b))
+  )
+
+(and
+ (or
+  (= (f a a) c)
+  (or (= (f b b) c)
+      (= (f c c) c))
+  )
+
+
+
+(and
+ (or
+  (= (f a a) a)
+  (or (= (f b a) b)
+      (= (f c a) c))
+  )
+
+(and
+ (or
+  (= (f a b) a)
+  (or (= (f b b) b)
+      (= (f c b) c))
+  )
+
+(and
+ (or
+  (= (f a c) a)
+  (or (= (f b c) b)
+      (= (f c c) c))
+  )
+
+
+
+
+(and (not (= (f a a) a))
+(and (not (= (f b b) b))
+(and (not (= (f c c) c))
+
+
+(and
+ (or
+  (not (= (f a (f a a)) a))
+  (or (not (= (f a (f a b)) b))
+      (not (= (f a (f a c)) c)))
+  )
+
+(and
+ (or
+  (not (= (f b (f b a)) a)) 
+  (or (not (= (f b (f b b)) b))
+      (not (= (f b (f b c)) c)))
+  )
+
+(and
+ (or
+  (not (= (f c (f c a)) a)) 
+  (or (not (= (f c (f c b)) b))
+      (not (= (f c (f c c)) c)))
+  )
+
+
+(and  (not (= (f a a) (f b a)))
+(and  (not (= (f a a) (f c a)))
+(and  (not (= (f b a) (f c a)))
+
+(and  (not (= (f a b) (f b b)))
+(and  (not (= (f a b) (f c b)))
+(and  (not (= (f b b) (f c b)))
+
+(and  (not (= (f a c) (f b c)))
+(and  (not (= (f a c) (f c c)))
+  (not (= (f b c) (f c c))))
+
+)))))))))))))))))))))))))))))
+
+(check-sat)
+
+(exit)
diff --git a/src/lfsc/tests/eq_diamond37.smt2 b/src/lfsc/tests/eq_diamond37.smt2
new file mode 100644
index 0000000..0df4535
--- /dev/null
+++ b/src/lfsc/tests/eq_diamond37.smt2
@@ -0,0 +1,162 @@
+(set-logic QF_UF)
+(set-info :source |
+Generating minimum transitivity constraints in P-time for deciding Equality Logic,
+Ofer Strichman and Mirron Rozanov,
+SMT Workshop 2005.
+
+Translator: Leonardo de Moura. |)
+(set-info :smt-lib-version 2.0)
+(set-info :category "crafted")
+(set-info :status unsat)
+(declare-sort U 0)
+(declare-fun x0 () U)
+(declare-fun y0 () U)
+(declare-fun z0 () U)
+(declare-fun x1 () U)
+(declare-fun y1 () U)
+(declare-fun z1 () U)
+(declare-fun x2 () U)
+(declare-fun y2 () U)
+(declare-fun z2 () U)
+(declare-fun x3 () U)
+(declare-fun y3 () U)
+(declare-fun z3 () U)
+(declare-fun x4 () U)
+(declare-fun y4 () U)
+(declare-fun z4 () U)
+(declare-fun x5 () U)
+(declare-fun y5 () U)
+(declare-fun z5 () U)
+(declare-fun x6 () U)
+(declare-fun y6 () U)
+(declare-fun z6 () U)
+(declare-fun x7 () U)
+(declare-fun y7 () U)
+(declare-fun z7 () U)
+(declare-fun x8 () U)
+(declare-fun y8 () U)
+(declare-fun z8 () U)
+(declare-fun x9 () U)
+(declare-fun y9 () U)
+(declare-fun z9 () U)
+(declare-fun x10 () U)
+(declare-fun y10 () U)
+(declare-fun z10 () U)
+(declare-fun x11 () U)
+(declare-fun y11 () U)
+(declare-fun z11 () U)
+(declare-fun x12 () U)
+(declare-fun y12 () U)
+(declare-fun z12 () U)
+(declare-fun x13 () U)
+(declare-fun y13 () U)
+(declare-fun z13 () U)
+(declare-fun x14 () U)
+(declare-fun y14 () U)
+(declare-fun z14 () U)
+(declare-fun x15 () U)
+(declare-fun y15 () U)
+(declare-fun z15 () U)
+(declare-fun x16 () U)
+(declare-fun y16 () U)
+(declare-fun z16 () U)
+(declare-fun x17 () U)
+(declare-fun y17 () U)
+(declare-fun z17 () U)
+(declare-fun x18 () U)
+(declare-fun y18 () U)
+(declare-fun z18 () U)
+(declare-fun x19 () U)
+(declare-fun y19 () U)
+(declare-fun z19 () U)
+(declare-fun x20 () U)
+(declare-fun y20 () U)
+(declare-fun z20 () U)
+(declare-fun x21 () U)
+(declare-fun y21 () U)
+(declare-fun z21 () U)
+(declare-fun x22 () U)
+(declare-fun y22 () U)
+(declare-fun z22 () U)
+(declare-fun x23 () U)
+(declare-fun y23 () U)
+(declare-fun z23 () U)
+(declare-fun x24 () U)
+(declare-fun y24 () U)
+(declare-fun z24 () U)
+(declare-fun x25 () U)
+(declare-fun y25 () U)
+(declare-fun z25 () U)
+(declare-fun x26 () U)
+(declare-fun y26 () U)
+(declare-fun z26 () U)
+(declare-fun x27 () U)
+(declare-fun y27 () U)
+(declare-fun z27 () U)
+(declare-fun x28 () U)
+(declare-fun y28 () U)
+(declare-fun z28 () U)
+(declare-fun x29 () U)
+(declare-fun y29 () U)
+(declare-fun z29 () U)
+(declare-fun x30 () U)
+(declare-fun y30 () U)
+(declare-fun z30 () U)
+(declare-fun x31 () U)
+(declare-fun y31 () U)
+(declare-fun z31 () U)
+(declare-fun x32 () U)
+(declare-fun y32 () U)
+(declare-fun z32 () U)
+(declare-fun x33 () U)
+(declare-fun y33 () U)
+(declare-fun z33 () U)
+(declare-fun x34 () U)
+(declare-fun y34 () U)
+(declare-fun z34 () U)
+(declare-fun x35 () U)
+(declare-fun y35 () U)
+(declare-fun z35 () U)
+(declare-fun x36 () U)
+(declare-fun y36 () U)
+(declare-fun z36 () U)
+(assert
+  (and (or (and (= x0 y0) (= y0 x1)) (and (= x0 z0) (= z0 x1)))
+  (and (or (and (= x1 y1) (= y1 x2)) (and (= x1 z1) (= z1 x2)))
+  (and (or (and (= x2 y2) (= y2 x3)) (and (= x2 z2) (= z2 x3)))
+  (and (or (and (= x3 y3) (= y3 x4)) (and (= x3 z3) (= z3 x4)))
+  (and (or (and (= x4 y4) (= y4 x5)) (and (= x4 z4) (= z4 x5)))
+  (and (or (and (= x5 y5) (= y5 x6)) (and (= x5 z5) (= z5 x6)))
+  (and (or (and (= x6 y6) (= y6 x7)) (and (= x6 z6) (= z6 x7)))
+  (and (or (and (= x7 y7) (= y7 x8)) (and (= x7 z7) (= z7 x8)))
+  (and (or (and (= x8 y8) (= y8 x9)) (and (= x8 z8) (= z8 x9)))
+  (and (or (and (= x9 y9) (= y9 x10)) (and (= x9 z9) (= z9 x10)))
+  (and (or (and (= x10 y10) (= y10 x11)) (and (= x10 z10) (= z10 x11)))
+  (and (or (and (= x11 y11) (= y11 x12)) (and (= x11 z11) (= z11 x12)))
+  (and (or (and (= x12 y12) (= y12 x13)) (and (= x12 z12) (= z12 x13)))
+  (and (or (and (= x13 y13) (= y13 x14)) (and (= x13 z13) (= z13 x14)))
+  (and (or (and (= x14 y14) (= y14 x15)) (and (= x14 z14) (= z14 x15)))
+  (and (or (and (= x15 y15) (= y15 x16)) (and (= x15 z15) (= z15 x16)))
+  (and (or (and (= x16 y16) (= y16 x17)) (and (= x16 z16) (= z16 x17)))
+  (and (or (and (= x17 y17) (= y17 x18)) (and (= x17 z17) (= z17 x18)))
+  (and (or (and (= x18 y18) (= y18 x19)) (and (= x18 z18) (= z18 x19)))
+  (and (or (and (= x19 y19) (= y19 x20)) (and (= x19 z19) (= z19 x20)))
+  (and (or (and (= x20 y20) (= y20 x21)) (and (= x20 z20) (= z20 x21)))
+  (and (or (and (= x21 y21) (= y21 x22)) (and (= x21 z21) (= z21 x22)))
+  (and (or (and (= x22 y22) (= y22 x23)) (and (= x22 z22) (= z22 x23)))
+  (and (or (and (= x23 y23) (= y23 x24)) (and (= x23 z23) (= z23 x24)))
+  (and (or (and (= x24 y24) (= y24 x25)) (and (= x24 z24) (= z24 x25)))
+  (and (or (and (= x25 y25) (= y25 x26)) (and (= x25 z25) (= z25 x26)))
+  (and (or (and (= x26 y26) (= y26 x27)) (and (= x26 z26) (= z26 x27)))
+  (and (or (and (= x27 y27) (= y27 x28)) (and (= x27 z27) (= z27 x28)))
+  (and (or (and (= x28 y28) (= y28 x29)) (and (= x28 z28) (= z28 x29)))
+  (and (or (and (= x29 y29) (= y29 x30)) (and (= x29 z29) (= z29 x30)))
+  (and (or (and (= x30 y30) (= y30 x31)) (and (= x30 z30) (= z30 x31)))
+  (and (or (and (= x31 y31) (= y31 x32)) (and (= x31 z31) (= z31 x32)))
+  (and (or (and (= x32 y32) (= y32 x33)) (and (= x32 z32) (= z32 x33)))
+  (and (or (and (= x33 y33) (= y33 x34)) (and (= x33 z33) (= z33 x34)))
+  (and (or (and (= x34 y34) (= y34 x35)) (and (= x34 z34) (= z34 x35)))
+  (and (or (and (= x35 y35) (= y35 x36)) (and (= x35 z35) (= z35 x36)))
+       (not (= x0 x36)))))))))))))))))))))))))))))))))))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/ex.smt2 b/src/lfsc/tests/ex.smt2
new file mode 100644
index 0000000..66cf015
--- /dev/null
+++ b/src/lfsc/tests/ex.smt2
@@ -0,0 +1,9 @@
+;; (set-logic QF_SAT)
+
+(declare-fun a () Bool)
+(declare-fun b () Bool)
+(declare-fun c () Bool)
+
+(assert (not (=> (and (=> a b) (=> b c)) (=> a c))))
+
+(check-sat)
diff --git a/src/lfsc/tests/exx.smt2 b/src/lfsc/tests/exx.smt2
new file mode 100644
index 0000000..351bc0c
--- /dev/null
+++ b/src/lfsc/tests/exx.smt2
@@ -0,0 +1,13 @@
+;; (set-logic QF_SAT)
+
+(declare-fun a () Bool)
+(declare-fun b () Bool)
+(declare-fun c () Bool)
+(declare-fun d () Bool)
+(declare-fun e () Bool)
+(declare-fun f () Bool)
+;; (declare-fun f (Bool Bool) Bool)
+
+(assert (not (=> (and (=> a b) (=> b c)) (=> a c))))
+
+(check-sat)
diff --git a/src/lfsc/tests/hole.smt2 b/src/lfsc/tests/hole.smt2
new file mode 100644
index 0000000..3c07466
--- /dev/null
+++ b/src/lfsc/tests/hole.smt2
@@ -0,0 +1,99 @@
+(set-logic QF_UF)
+(declare-fun a1 () Bool)
+(declare-fun a2 () Bool)
+(declare-fun a3 () Bool)
+(declare-fun a4 () Bool)
+(declare-fun a5 () Bool)
+(declare-fun a6 () Bool)
+(declare-fun a7 () Bool)
+(declare-fun a8 () Bool)
+(declare-fun a9 () Bool)
+(declare-fun a10 () Bool)
+(declare-fun a11 () Bool)
+(declare-fun a12 () Bool)
+(declare-fun a13 () Bool)
+(declare-fun a14 () Bool)
+(declare-fun a15 () Bool)
+(declare-fun a16 () Bool)
+(declare-fun a17 () Bool)
+(declare-fun a18 () Bool)
+(declare-fun a19 () Bool)
+(declare-fun a20 () Bool)
+(assert
+(and (or a1 (or a2 (or a3 a4)))
+(and (or a5 (or a6 (or a7 a8)))
+(and (or a9 (or a10 (or a11 a12)))
+(and (or a13 (or a14 (or a15 a16)))
+(and (or a17 (or a18 (or a19 a20)))
+(and (or (not a1) (not a2))
+(and (or (not a1) (not a3))
+(and (or (not a1) (not a4))
+(and (or (not a2) (not a3))
+(and (or (not a2) (not a4))
+(and (or (not a3) (not a4))
+(and (or (not a5) (not a6))
+(and (or (not a5) (not a7))
+(and (or (not a5) (not a8))
+(and (or (not a6) (not a7))
+(and (or (not a6) (not a8))
+(and (or (not a7) (not a8))
+(and (or (not a9) (not a10))
+(and (or (not a9) (not a11))
+(and (or (not a9) (not a12))
+(and (or (not a10) (not a11))
+(and (or (not a10) (not a12))
+(and (or (not a11) (not a12))
+(and (or (not a13) (not a14))
+(and (or (not a13) (not a15))
+(and (or (not a13) (not a16))
+(and (or (not a14) (not a15))
+(and (or (not a14) (not a16))
+(and (or (not a15) (not a16))
+(and (or (not a17) (not a18))
+(and (or (not a17) (not a19))
+(and (or (not a17) (not a20))
+(and (or (not a18) (not a19))
+(and (or (not a18) (not a20))
+(and (or (not a19) (not a20))
+(and (or (not a1) (not a5))
+(and (or (not a1) (not a9))
+(and (or (not a1) (not a13))
+(and (or (not a1) (not a17))
+(and (or (not a5) (not a9))
+(and (or (not a5) (not a13))
+(and (or (not a5) (not a17))
+(and (or (not a9) (not a13))
+(and (or (not a9) (not a17))
+(and (or (not a13) (not a17))
+(and (or (not a2) (not a6))
+(and (or (not a2) (not a10))
+(and (or (not a2) (not a14))
+(and (or (not a2) (not a18))
+(and (or (not a6) (not a10))
+(and (or (not a6) (not a14))
+(and (or (not a6) (not a18))
+(and (or (not a10) (not a14))
+(and (or (not a10) (not a18))
+(and (or (not a14) (not a18))
+(and (or (not a3) (not a7))
+(and (or (not a3) (not a11))
+(and (or (not a3) (not a15))
+(and (or (not a3) (not a19))
+(and (or (not a7) (not a11))
+(and (or (not a7) (not a15))
+(and (or (not a7) (not a19))
+(and (or (not a11) (not a15))
+(and (or (not a11) (not a19))
+(and (or (not a15) (not a19))
+(and (or (not a4) (not a8))
+(and (or (not a4) (not a12))
+(and (or (not a4) (not a16))
+(and (or (not a4) (not a20))
+(and (or (not a8) (not a12))
+(and (or (not a8) (not a16))
+(and (or (not a8) (not a20))
+(and (or (not a12) (not a16))
+(and (or (not a12) (not a20))
+(or (not a16) (not a20)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/lia1.smt2 b/src/lfsc/tests/lia1.smt2
new file mode 100644
index 0000000..16477e7
--- /dev/null
+++ b/src/lfsc/tests/lia1.smt2
@@ -0,0 +1,8 @@
+(set-logic QF_LIA)
+
+(declare-fun x () Int)
+(declare-fun y () Int)
+(declare-fun z () Int)
+(assert (not (=> (and (<= x 3) (or (not (>= y 8)) (not (>= z 10)))) (or (not (>= (+ x y) 11)) (not (>= (+ x z) 13))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/run.sh b/src/lfsc/tests/run.sh
new file mode 100755
index 0000000..c785e2c
--- /dev/null
+++ b/src/lfsc/tests/run.sh
@@ -0,0 +1,10 @@
+#!/bin/bash
+set -e
+find work -name "*.smt2" -exec sh -c "./wrapper_cvc4tocoq.sh {} " \;
+mv work/*.result work/results/
+mv work/*.lfsc work/lfsc/
+mv work/*.smt2 work/smt2/
+rm work/*.vo
+rm work/*.v
+rm work/*.glob
+#exit 0
diff --git a/src/lfsc/tests/sat13.smt2 b/src/lfsc/tests/sat13.smt2
new file mode 100644
index 0000000..4ca190f
--- /dev/null
+++ b/src/lfsc/tests/sat13.smt2
@@ -0,0 +1,7 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun a () U)
+(declare-fun b () U)
+(assert (and (not (not (= a b))) (not (= a b))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/sat6.smt2 b/src/lfsc/tests/sat6.smt2
new file mode 100644
index 0000000..afa2640
--- /dev/null
+++ b/src/lfsc/tests/sat6.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_UF)
+(declare-fun a () Bool)
+(declare-fun b () Bool)
+(declare-fun c () Bool)
+(declare-fun d () Bool)
+(assert (and a b))
+(assert (or c d))
+(assert (not (or c (and a (and b d)))))
+(check-sat)
+(exit)
+
diff --git a/src/lfsc/tests/sat7.smt2 b/src/lfsc/tests/sat7.smt2
new file mode 100644
index 0000000..387da5e
--- /dev/null
+++ b/src/lfsc/tests/sat7.smt2
@@ -0,0 +1,8 @@
+(set-logic QF_UF)
+(declare-fun a () Bool)
+(declare-fun b () Bool)
+(declare-fun c () Bool)
+(declare-fun d () Bool)
+(assert (and a (and b (and c (and (or (not a) (or (not b) d)) (or (not d) (not c)))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/signatures/sat.plf b/src/lfsc/tests/signatures/sat.plf
new file mode 100755
index 0000000..b95caa8
--- /dev/null
+++ b/src/lfsc/tests/signatures/sat.plf
@@ -0,0 +1,127 @@
+(declare bool type)
+(declare tt bool)
+(declare ff bool)
+
+(declare var type)
+
+(declare lit type)
+(declare pos (! x var lit))
+(declare neg (! x var lit))
+
+(declare clause type)
+(declare cln clause)
+(declare clc (! x lit (! c clause clause)))
+
+; constructs for general clauses for R, Q, satlem
+
+(declare concat_cl (! c1 clause (! c2 clause clause)))
+(declare clr (! l lit (! c clause clause)))
+
+; code to check resolutions
+
+(program append ((c1 clause) (c2 clause)) clause
+  (match c1 (cln c2) ((clc l c1') (clc l (append c1' c2)))))
+
+; we use marks as follows:
+; -- mark 1 to record if we are supposed to remove a positive occurrence of the variable.
+; -- mark 2 to record if we are supposed to remove a negative occurrence of the variable.
+; -- mark 3 if we did indeed remove the variable positively
+; -- mark 4 if we did indeed remove the variable negatively
+(program simplify_clause ((c clause)) clause
+  (match c
+    (cln cln)
+    ((clc l c1)
+      (match l
+        ; Set mark 1 on v if it is not set, to indicate we should remove it.
+        ; After processing the rest of the clause, set mark 3 if we were already
+        ; supposed to remove v (so if mark 1 was set when we began).  Clear mark3
+        ; if we were not supposed to be removing v when we began this call.
+        ((pos v)
+          (let m (ifmarked v tt (do (markvar v) ff))
+          (let c' (simplify_clause c1)
+            (match m
+              (tt (do (ifmarked3 v v (markvar3 v)) c'))
+              (ff (do (ifmarked3 v (markvar3 v) v) (markvar v) (clc l c')))))))
+        ; the same as the code for tt, but using different marks.
+        ((neg v)
+          (let m (ifmarked2 v tt (do (markvar2 v) ff))
+          (let c' (simplify_clause c1)
+            (match m
+              (tt (do (ifmarked4 v v (markvar4 v)) c'))
+              (ff (do (ifmarked4 v (markvar4 v) v) (markvar2 v) (clc l c')))))))))
+    ((concat_cl c1 c2) (append (simplify_clause c1) (simplify_clause c2)))
+    ((clr l c1)
+      (match l
+        ; set mark 1 to indicate we should remove v, and fail if
+        ; mark 3 is not set after processing the rest of the clause
+        ; (we will set mark 3 if we remove a positive occurrence of v).
+        ((pos v)
+            (let m (ifmarked v tt (do (markvar v) ff))
+            (let m3 (ifmarked3 v (do (markvar3 v) tt) ff)
+            (let c' (simplify_clause c1)
+              (ifmarked3 v (do (match m3 (tt v) (ff (markvar3 v)))
+                                (match m (tt v) (ff (markvar v))) c')
+                          (fail clause))))))
+        ; same as the tt case, but with different marks.
+        ((neg v)
+            (let m2 (ifmarked2 v tt (do (markvar2 v) ff))
+            (let m4 (ifmarked4 v (do (markvar4 v) tt) ff)
+            (let c' (simplify_clause c1)
+              (ifmarked4 v (do (match m4 (tt v) (ff (markvar4 v)))
+                                (match m2 (tt v) (ff (markvar2 v))) c')
+                          (fail clause))))))
+   ))))
+
+
+; resolution proofs
+
+(declare holds (! c clause type))
+
+(declare R (! c1 clause (! c2 clause
+           (! u1 (holds c1)
+           (! u2 (holds c2)
+           (! n var
+            (holds (concat_cl (clr (pos n) c1)
+                     (clr (neg n) c2)))))))))
+
+(declare Q (! c1 clause (! c2 clause
+           (! u1 (holds c1)
+           (! u2 (holds c2)
+           (! n var
+            (holds (concat_cl (clr (neg n) c1)
+                     (clr (pos n) c2)))))))))
+
+(declare satlem_simplify
+                (! c1 clause
+                (! c2 clause
+                (! c3 clause
+                (! u1 (holds c1)
+                (! r (^ (simplify_clause c1) c2)
+                (! u2 (! x (holds c2) (holds c3))
+                   (holds c3))))))))
+
+(declare satlem
+  (! c clause
+  (! c2 clause
+  (! u (holds c)
+  (! u2 (! v (holds c) (holds c2))
+    (holds c2))))))
+
+; A little example to demonstrate simplify_clause.
+; It can handle nested clr's of both polarities,
+; and correctly cleans up marks when it leaves a
+; clr or clc scope.  Uncomment and run with
+; --show-runs to see it in action.
+;
+; (check
+;   (% v1 var
+;   (% u1 (holds (concat_cl (clr (neg v1) (clr (pos v1) (clc (pos v1) (clr (pos v1) (clc (pos v1) (clc (neg v1) cln))))))
+;                    (clc (pos v1) (clc (pos v1) cln))))
+;    (satlem _ _ _ u1 (\ x x))))))
+
+
+;(check
+;   (% v1 var
+;   (% u1 (holds (clr (neg v1) (concat_cl (clc (neg v1) cln)
+;                                      (clr (neg v1) (clc (neg v1) cln)))))
+;    (satlem _ _ _ u1 (\ x x))))))
diff --git a/src/lfsc/tests/signatures/smt.plf b/src/lfsc/tests/signatures/smt.plf
new file mode 100755
index 0000000..fa89a45
--- /dev/null
+++ b/src/lfsc/tests/signatures/smt.plf
@@ -0,0 +1,423 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; SMT syntax and semantics (not theory-specific)
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; depends on sat.plf
+
+(declare formula type)
+(declare th_holds (! f formula type))
+
+; standard logic definitions
+(declare true formula)
+(declare false formula)
+
+(define formula_op1
+	(! f formula
+	formula))
+
+(define formula_op2
+	(! f1 formula
+	(! f2 formula
+	   formula)))
+	
+(define formula_op3
+	(! f1 formula
+	(! f2 formula
+	(! f3 formula
+	   formula))))
+	   
+(declare not formula_op1)
+(declare and formula_op2)
+(declare or formula_op2)
+(declare impl formula_op2)
+(declare iff formula_op2)
+(declare xor formula_op2)
+(declare ifte formula_op3)
+
+; terms
+(declare sort type)
+(declare term (! t sort type))	; declared terms in formula
+
+; standard definitions for =, ite, let and flet
+(declare = (! s sort
+           (! x (term s)
+           (! y (term s)
+             formula))))
+(declare ite (! s sort
+             (! f formula
+             (! t1 (term s)
+             (! t2 (term s)
+               (term s))))))
+(declare let (! s sort
+             (! t (term s)
+             (! f (! v (term s) formula)
+               formula))))
+(declare flet (! f1 formula
+              (! f2 (! v formula formula)
+                formula)))
+
+; We view applications of predicates as terms of sort "Bool".
+; Such terms can be injected as atomic formulas using "p_app".
+(declare Bool sort)				; the special sort for predicates
+(declare p_app (! x (term Bool) formula))	; propositional application of term
+
+; boolean terms
+(declare t_true (term Bool))
+(declare t_false (term Bool))
+(declare t_t_neq_f
+ (th_holds (not (= Bool t_true t_false))))
+(declare pred_eq_t
+ (! x (term Bool)
+ (! u (th_holds (p_app x))
+   (th_holds (= Bool x t_true)))))
+(declare pred_eq_f
+ (! x (term Bool)
+ (! u (th_holds (not (p_app x)))
+   (th_holds (= Bool x t_false)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; CNF Clausification
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; binding between an LF var and an (atomic) formula
+
+(declare atom (! v var (! p formula type)))
+
+; binding between two LF vars
+(declare bvatom (! sat_v var (! bv_v var type)))
+
+(declare decl_atom
+  (! f formula
+  (! u (! v var
+       (! a (atom v f)
+         (holds cln)))
+    (holds cln))))
+
+;; declare atom enhanced with mapping
+;; between SAT prop variable and BVSAT prop variable
+(declare decl_bvatom
+  (! f formula
+  (! u (! v var
+       (! bv_v var
+       (! a (atom v f)
+       (! bva (atom bv_v f)
+       (! vbv (bvatom v bv_v)
+         (holds cln))))))
+    (holds cln))))
+    
+    
+; clausify a formula directly
+(declare clausify_form
+  (! f formula
+  (! v var
+  (! a (atom v f)
+  (! u (th_holds f)
+    (holds (clc (pos v) cln)))))))
+    
+(declare clausify_form_not
+  (! f formula
+  (! v var
+  (! a (atom v f)
+  (! u (th_holds (not f))
+    (holds (clc (neg v) cln)))))))
+    
+(declare clausify_false
+  (! u (th_holds false)
+    (holds cln)))
+
+(declare th_let_pf
+  (! f formula
+  (! u (th_holds f)
+  (! u2 (! v (th_holds f) (holds cln))
+    (holds cln)))))
+
+  
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Natural deduction rules : used for CNF
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; for eager bit-blasting
+(declare iff_symm
+	(! f formula
+	   (th_holds (iff f f))))
+
+
+;; contradiction
+
+(declare contra
+  (! f formula
+  (! r1 (th_holds f)
+  (! r2 (th_holds (not f))
+    (th_holds false)))))
+
+; truth
+(declare truth (th_holds true))
+
+;; not not
+
+(declare not_not_intro
+  (! f formula
+  (! u (th_holds f)
+    (th_holds (not (not f))))))
+
+(declare not_not_elim
+  (! f formula
+  (! u (th_holds (not (not f)))
+    (th_holds f))))
+
+;; or elimination
+
+(declare or_elim_1
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (not f1))
+  (! u2 (th_holds (or f1 f2))
+    (th_holds f2))))))
+
+(declare or_elim_2
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (not f2))
+  (! u2 (th_holds (or f1 f2))
+    (th_holds f1))))))
+
+(declare not_or_elim
+  (! f1 formula
+  (! f2 formula
+  (! u2 (th_holds (not (or f1 f2)))
+    (th_holds (and (not f1) (not f2)))))))
+    
+;; and elimination
+
+(declare and_elim_1
+  (! f1 formula
+  (! f2 formula
+  (! u (th_holds (and f1 f2))
+    (th_holds f1)))))
+
+(declare and_elim_2
+  (! f1 formula
+  (! f2 formula
+  (! u (th_holds (and f1 f2))
+    (th_holds f2)))))
+
+(declare not_and_elim
+  (! f1 formula
+  (! f2 formula
+  (! u2 (th_holds (not (and f1 f2)))
+    (th_holds (or (not f1) (not f2)))))))
+    
+;; impl elimination
+
+(declare impl_intro (! f1 formula
+                    (! f2 formula
+                    (! i1 (! u (th_holds f1)
+                              (th_holds f2))
+                      (th_holds (impl f1 f2))))))
+
+(declare impl_elim
+  (! f1 formula
+  (! f2 formula
+  (! u2 (th_holds (impl f1 f2))
+    (th_holds (or (not f1) f2))))))
+
+(declare not_impl_elim
+  (! f1 formula
+  (! f2 formula
+  (! u (th_holds (not (impl f1 f2)))
+    (th_holds (and f1 (not f2)))))))
+    
+;; iff elimination
+
+(declare iff_elim_1
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (iff f1 f2))
+    (th_holds (or (not f1) f2))))))
+
+(declare iff_elim_2
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (iff f1 f2))
+    (th_holds (or f1 (not f2)))))))
+
+(declare not_iff_elim
+  (! f1 formula
+  (! f2 formula
+  (! u2 (th_holds (not (iff f1 f2)))
+    (th_holds (iff f1 (not f2)))))))
+
+; xor elimination
+
+(declare xor_elim_1
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (xor f1 f2))
+    (th_holds (or (not f1) (not f2)))))))
+
+(declare xor_elim_2
+  (! f1 formula
+  (! f2 formula
+  (! u1 (th_holds (xor f1 f2))
+    (th_holds (or f1 f2))))))
+
+(declare not_xor_elim
+  (! f1 formula
+  (! f2 formula
+  (! u2 (th_holds (not (xor f1 f2)))
+    (th_holds (iff f1 f2))))))
+
+;; ite elimination
+
+(declare ite_elim_1
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (ifte a b c))
+    (th_holds (or (not a) b)))))))
+
+(declare ite_elim_2
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (ifte a b c))
+    (th_holds (or a c)))))))
+
+(declare ite_elim_3
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (ifte a b c))
+    (th_holds (or b c)))))))
+
+(declare not_ite_elim_1
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (not (ifte a b c)))
+    (th_holds (or (not a) (not b))))))))
+
+(declare not_ite_elim_2
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (not (ifte a b c)))
+    (th_holds (or a (not c))))))))
+
+(declare not_ite_elim_3
+  (! a formula
+  (! b formula
+  (! c formula
+  (! u2 (th_holds (not (ifte a b c)))
+    (th_holds (or (not b) (not c))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; For theory lemmas
+; - make a series of assumptions and then derive a contradiction (or false)
+; - then the assumptions yield a formula like "v1 -> v2 -> ... -> vn -> false"
+; - In CNF, it becomes a clause: "~v1, ~v2, ..., ~vn"
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare ast
+  (! v var
+  (! f formula
+  (! C clause
+  (! r (atom v f)       ;this is specified
+  (! u (! o (th_holds f)
+         (holds C))
+    (holds (clc (neg v) C))))))))
+
+(declare asf
+  (! v var
+  (! f formula
+  (! C clause
+  (! r (atom v f)
+  (! u (! o (th_holds (not f))
+         (holds C))
+    (holds (clc (pos v) C))))))))
+
+;; Bitvector lemma constructors to assume
+;; the unit clause containing the assumptions
+;; it also requires the mapping between bv_v and v
+;; The resolution proof proving false will use bv_v as the definition clauses use bv_v
+;; but the Problem clauses in the main SAT solver will use v so the learned clause is in terms of v
+(declare bv_asf
+  (! v var
+  (! bv_v var
+  (! f formula
+  (! C clause
+  (! r (atom v f) ;; passed in
+  (! x (bvatom v bv_v) ; establishes the equivalence of v to bv_
+  (! u (! o (holds (clc (neg bv_v) cln)) ;; l binding to be used in proof
+         (holds C))
+    (holds (clc (pos v) C))))))))))
+    
+(declare bv_ast
+  (! v var
+  (! bv_v var	
+  (! f formula
+  (! C clause
+  (! r (atom v f)       ; this is specified
+  (! x (bvatom v bv_v) ; establishes the equivalence of v to bv_v
+  (! u (! o (holds (clc (pos bv_v) cln))
+         (holds C))
+    (holds (clc (neg v) C))))))))))
+
+
+;; Example:
+;;
+;; Given theory literals (F1....Fn), and an input formula A of the form (th_holds (or F1 (or F2 .... (or F{n-1} Fn))))).
+;;
+;; We introduce atoms (a1,...,an) to map boolean literals (v1,...,vn) top literals (F1,...,Fn).
+;; Do this at the beginning of the proof:
+;;
+;; (decl_atom F1 (\ v1 (\ a1
+;; (decl_atom F2 (\ v2 (\ a2
+;; ....
+;; (decl_atom Fn (\ vn (\ an
+;;
+;;  A is then clausified by the following proof:
+;;
+;;(satlem _ _
+;;(asf _ _ _ a1 (\ l1
+;;(asf _ _ _ a2 (\ l2
+;;...
+;;(asf _ _ _ an (\ ln
+;;(clausify_false
+;;
+;;   (contra _
+;;      (or_elim_1 _ _ l{n-1}
+;;	...
+;;      (or_elim_1 _ _ l2
+;; 	(or_elim_1 _ _ l1 A))))) ln)
+;;	
+;;))))))) (\ C
+;;
+;; We now have the free variable C, which should be the clause (v1 V ... V vn).
+;;
+;; Polarity of literals should be considered, say we have A of the form (th_holds (or (not F1) (or F2 (not F3)))).
+;; Where necessary, we use "ast" instead of "asf", introduce negations by "not_not_intro" for pattern matching, and flip
+;; the arguments of contra:
+;;
+;;(satlem _ _
+;;(ast _ _ _ a1 (\ l1
+;;(asf _ _ _ a2 (\ l2
+;;(ast _ _ _ a3 (\ l3
+;;(clausify_false
+;;
+;;   (contra _ l3
+;;      (or_elim_1 _ _ l2
+;; 	(or_elim_1 _ _ (not_not_intro l1) A))))
+;;	
+;;))))))) (\ C
+;;
+;; C should be the clause (~v1 V v2 V ~v3 )
+
+
diff --git a/src/lfsc/tests/signatures/th_arrays.plf b/src/lfsc/tests/signatures/th_arrays.plf
new file mode 100755
index 0000000..b54a4ed
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_arrays.plf
@@ -0,0 +1,63 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Theory of Arrays
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; depends on : th_base.plf
+
+; sorts
+
+(declare Array (! s1 sort (! s2 sort sort)))	; s1 is index, s2 is element
+
+; functions
+(declare write (! s1 sort
+               (! s2 sort
+                 (term (arrow (Array s1 s2)
+                       (arrow s1
+                       (arrow s2 (Array s1 s2))))))))
+
+(declare read (! s1 sort
+              (! s2 sort
+              	(term (arrow (Array s1 s2)
+               	      (arrow s1 s2))))))
+
+; inference rules
+
+; read( a[i] = b, i ) == b
+(declare row1 (! s1 sort
+              (! s2 sort
+              (! t1 (term (Array s1 s2))
+              (! t2 (term s1)
+              (! t3 (term s2)
+              	(th_holds (= _
+		(apply _ _ (apply _ _ (read s1 s2) (apply _ _ (apply _ _ (apply _ _ (write s1 s2) t1) t2) t3)) t2) t3))))))))
+
+(declare row (! s1 sort
+             (! s2 sort
+             (! t2 (term s1)
+             (! t3 (term s1)
+             (! t1 (term (Array s1 s2))
+             (! t4 (term s2)
+             (! u (th_holds (not (= _ t2 t3)))
+               (th_holds (= _ (apply _ _ (apply _ _ (read s1 s2) (apply _ _ (apply _ _ (apply _ _ (write s1 s2) t1) t2) t4)) t3)
+               		      (apply _ _ (apply _ _ (read s1 s2) t1) t3)))))))))))
+
+(declare negativerow (! s1 sort
+                     (! s2 sort
+                     (! t2 (term s1)
+                     (! t3 (term s1)
+                     (! t1 (term (Array s1 s2))
+                     (! t4 (term s2)
+		     (! u (th_holds (not (= _
+                        (apply _ _ (apply _ _ (read s1 s2) (apply _ _ (apply _ _ (apply _ _ (write s1 s2) t1) t2) t4)) t3)
+                        (apply _ _ (apply _ _ (read s1 s2) t1) t3))))
+                     (th_holds (= _ t2 t3))))))))))
+
+(declare ext (! s1 sort
+             (! s2 sort
+             (! t1 (term (Array s1 s2))
+             (! t2 (term (Array s1 s2))
+             (! u1 (! k (term s1)
+                   (! u2 (th_holds (or (= _ t1 t2) (not (= _ (apply _ _ (apply _ _ (read s1 s2) t1) k) (apply _ _ (apply _ _ (read s1 s2) t2) k)))))
+                     (holds cln)))
+               (holds cln)))))))
+\ No newline at end of file
diff --git a/src/lfsc/tests/signatures/th_base.plf b/src/lfsc/tests/signatures/th_base.plf
new file mode 100755
index 0000000..ffa8667
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_base.plf
@@ -0,0 +1,99 @@
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Theory of Equality and Congruence Closure
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; depends on : smt.plf
+
+; sorts :
+
+(declare arrow (! s1 sort (! s2 sort sort)))	; function constructor
+
+; functions :
+
+(declare apply (! s1 sort
+               (! s2 sort
+               (! t1 (term (arrow s1 s2))
+               (! t2 (term s1)
+                (term s2))))))
+
+
+; inference rules :
+
+(declare trust (th_holds false))	; temporary
+(declare trust_f (! f formula (th_holds f)))  ; temporary
+
+(declare refl
+  (! s sort
+  (! t (term s)
+    (th_holds (= s t t)))))
+
+(declare symm (! s sort
+              (! x (term s)
+              (! y (term s)
+              (! u (th_holds (= _ x y))
+                (th_holds (= _ y x)))))))
+
+(declare trans (! s sort
+               (! x (term s)
+               (! y (term s)
+               (! z (term s)
+               (! u (th_holds (= _ x y))
+               (! u (th_holds (= _ y z))
+                 (th_holds (= _ x z)))))))))
+
+(declare negsymm (! s sort
+              	 (! x (term s)
+              	 (! y (term s)
+              	 (! u (th_holds (not (= _ x y)))
+                   (th_holds (not (= _ y x))))))))
+
+(declare negtrans1 (! s sort
+                   (! x (term s)
+              	   (! y (term s)
+               	   (! z (term s)
+               	   (! u (th_holds (not (= _ x y)))
+               	   (! u (th_holds (= _ y z))
+                     (th_holds (not (= _ x z))))))))))
+
+(declare negtrans2 (! s sort
+                   (! x (term s)
+              	   (! y (term s)
+               	   (! z (term s)
+               	   (! u (th_holds (= _ x y))
+               	   (! u (th_holds (not (= _ y z)))
+                     (th_holds (not (= _ x z))))))))))
+
+(define negtrans negtrans1)
+
+
+(declare cong (! s1 sort
+              (! s2 sort
+              (! a1 (term (arrow s1 s2))
+              (! b1 (term (arrow s1 s2))
+              (! a2 (term s1)
+              (! b2 (term s1)
+              (! u1 (th_holds (= _ a1 b1))
+              (! u2 (th_holds (= _ a2 b2))
+                (th_holds (= _ (apply _ _ a1 a2) (apply _ _ b1 b2))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Examples
+
+; an example of "(p1 or p2(0)) and t1=t2(1)"
+;(! p1 (term Bool)
+;(! p2 (term (arrow Int Bool))
+;(! t1 (term Int)
+;(! t2 (term (arrow Int Int))
+;(! F (th_holds (and (or (p_app p1) (p_app (apply _ _ p2 0)))
+;                    (= _ t1 (apply _ _ t2 1))))
+;  ...
+
+; another example of "p3(a,b)"
+;(! a (term Int)
+;(! b (term Int)
+;(! p3 (term (arrow Int (arrow Int Bool)))	; arrow is right assoc.
+;(! F (th_holds (p_app (apply _ _ (apply _ _ p3 a) b))) ; apply is left assoc.
+;  ...
diff --git a/src/lfsc/tests/signatures/th_bv.plf b/src/lfsc/tests/signatures/th_bv.plf
new file mode 100644
index 0000000..0004b35
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_bv.plf
@@ -0,0 +1,192 @@
+;;;; TEMPORARY:
+
+(declare trust-bad (th_holds false))
+
+; helper stuff
+(program mpz_sub ((x mpz) (y mpz)) mpz
+	 (mp_add x (mp_mul (~1) y)))
+
+(program mp_ispos ((x mpz)) formula
+	 (mp_ifneg x false true))
+
+(program mpz_eq ((x mpz) (y mpz)) formula
+    (mp_ifzero (mpz_sub x y) true false))
+
+(program mpz_lt ((x mpz) (y mpz)) formula
+    (mp_ifneg (mpz_sub x y) true false))
+
+(program mpz_lte ((x mpz) (y mpz)) formula
+    (mp_ifneg (mpz_sub x y) true (mpz_eq x y)))
+
+(program mpz_ ((x mpz) (y mpz)) formula
+    (mp_ifzero (mpz_sub x y) true false))
+
+
+; "bitvec" is a term of type "sort"
+; (declare BitVec sort)
+(declare BitVec (! n mpz sort))
+
+; bit type
+(declare bit type)
+(declare b0 bit)
+(declare b1 bit)
+
+; bit vector type used for constants
+(declare bv type)
+(declare bvn bv)
+(declare bvc (! b bit (! v bv bv)))
+
+; calculate the length of a bitvector
+;; (program bv_len ((v bv)) mpz
+;;   (match v
+;;     (bvn 0)
+;;     ((bvc b v') (mp_add (bv_len v') 1))))
+
+
+; a bv constant term
+(declare a_bv
+	 (! n mpz
+	 (! v bv
+	    (term (BitVec n)))))
+
+(program bv_constants_are_disequal ((x bv) (y bv)) formula
+  (match x
+      (bvn (fail formula))
+      ((bvc bx x')
+        (match y
+          (bvn (fail formula))
+          ((bvc by y') (match bx
+                             (b0 (match by (b0 (bv_constants_are_disequal x' y')) (b1 (true))))
+                             (b1 (match by (b0 (true)) (b1 (bv_constants_are_disequal x' y'))))
+          ))
+      ))
+))
+
+(declare bv_disequal_constants
+	 (! n mpz
+	 (! x bv
+	 (! y bv
+	 (! c (^ (bv_constants_are_disequal x y) true)
+  	   (th_holds (not (= (BitVec n) (a_bv n x) (a_bv n y)))))))))
+
+; a bv variable
+(declare var_bv type)
+; a bv variable term
+(declare a_var_bv
+	 (! n mpz
+	 (! v var_bv
+	    (term (BitVec n)))))
+
+; bit vector binary operators
+(define bvop2
+	(! n mpz
+	(! x (term (BitVec n))
+        (! y (term (BitVec n))
+             	   (term (BitVec n))))))
+
+(declare bvand bvop2)
+(declare bvor bvop2)
+(declare bvor bvop2)
+(declare bvxor bvop2)
+(declare bvnand bvop2)
+(declare bvnor bvop2)
+(declare bvxnor bvop2)
+(declare bvmul bvop2)
+(declare bvadd bvop2)
+(declare bvsub bvop2)
+(declare bvudiv bvop2)
+(declare bvurem bvop2)
+(declare bvsdiv bvop2)
+(declare bvsrem bvop2)
+(declare bvsmod bvop2)
+(declare bvshl bvop2)
+(declare bvlshr bvop2)
+(declare bvashr bvop2)
+(declare concat bvop2)
+
+; bit vector unary operators
+(define bvop1
+	(! n mpz
+	(! x (term (BitVec n))
+             	   (term (BitVec n)))))
+
+
+(declare bvneg bvop1)
+(declare bvnot bvop1)
+(declare rotate_left  bvop1)
+(declare rotate_right bvop1)
+
+(declare bvcomp
+	 (! n mpz
+ 	 (! t1 (term (BitVec n))
+	 (! t2 (term (BitVec n))
+	    (term (BitVec 1))))))
+
+
+(declare concat
+	 (! n mpz
+	 (! m mpz
+	 (! m' mpz
+	 (! t1 (term (BitVec m))
+	 (! t2 (term (BitVec m'))
+	    (term (BitVec n))))))))
+
+;; side-condition fails in signature only??
+;;	 (! s (^ (mp_add m m') n)
+
+;; (declare repeat bvopp)
+
+(declare extract
+	 (! n mpz
+	 (! i mpz
+	 (! j mpz
+	 (! m mpz
+	 (! t2 (term (BitVec m))
+	    (term (BitVec n))))))))
+
+(declare zero_extend
+	 (! n mpz
+	 (! i mpz
+	 (! m mpz
+	 (! t2 (term (BitVec m))
+	    (term (BitVec n)))))))
+
+(declare sign_extend
+	 (! n mpz
+	 (! i mpz
+	 (! m mpz
+	 (! t2 (term (BitVec m))
+	    (term (BitVec n)))))))
+
+(declare repeat
+	 (! n mpz
+	 (! i mpz
+	 (! m mpz
+	 (! t2 (term (BitVec m))
+	    (term (BitVec n)))))))
+
+
+
+;; TODO: add checks for valid typing for these operators
+;; (! c1 (^ (mpz_lte i j)
+;; (! c2 (^ (mpz_lt i n) true)
+;; (! c3 (^ (mp_ifneg i false true) true)
+;; (! c4 (^ (mp_ifneg j false true) true)
+;; (! s (^ (mp_add (mpz_sub i j) 1) m)
+
+
+; bit vector predicates
+(define bvpred
+	(! n mpz
+	(! x (term (BitVec n))
+	(! y (term (BitVec n))
+	           formula))))
+
+(declare bvult bvpred)
+(declare bvule bvpred)
+(declare bvugt bvpred)
+(declare bvuge bvpred)
+(declare bvslt bvpred)
+(declare bvsle bvpred)
+(declare bvsgt bvpred)
+(declare bvsge bvpred)
diff --git a/src/lfsc/tests/signatures/th_bv_bitblast.plf b/src/lfsc/tests/signatures/th_bv_bitblast.plf
new file mode 100644
index 0000000..ebb412f
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_bv_bitblast.plf
@@ -0,0 +1,671 @@
+; bit blasted terms as list of formulas
+(declare bblt type)
+(declare bbltn bblt)
+(declare bbltc (! f formula (! v bblt bblt)))
+
+; calculate the length of a bit-blasted term
+(program bblt_len ((v bblt)) mpz
+  (match v
+    (bbltn 0)
+    ((bbltc b v') (mp_add (bblt_len v') 1))))
+
+
+; (bblast_term x y) means term y corresponds to bit level interpretation x
+(declare bblast_term
+	 (! n mpz
+	 (! x (term (BitVec n))
+	 (! y bblt
+	    type))))
+
+; FIXME: for unsupported bit-blast terms
+(declare trust_bblast_term
+	 (! n mpz
+	 (! x (term (BitVec n))
+	 (! y bblt
+	    (bblast_term n x y)))))
+
+
+; Binds a symbol to the bblast_term to be used later on.
+(declare decl_bblast
+	 (! n mpz
+	 (! b bblt
+	 (! t (term (BitVec n))
+	 (! bb (bblast_term n t b)
+	 (! s (^ (bblt_len b) n)
+	 (! u (! v (bblast_term n t b) (holds cln))
+		   (holds cln))))))))
+
+(declare decl_bblast_with_alias
+	 (! n mpz
+	 (! b bblt
+	 (! t (term (BitVec n))
+	 (! a (term (BitVec n))
+	 (! bb (bblast_term n t b)
+	 (! e (th_holds (= _ t a))
+	 (! s (^ (bblt_len b) n)
+	 (! u (! v (bblast_term n a b) (holds cln))
+		   (holds cln))))))))))
+
+; a predicate to represent the n^th bit of a bitvector term
+(declare bitof
+	 (! x var_bv
+	 (! n mpz formula)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;           BITBLASTING RULES
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST CONSTANT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_const ((v bv) (n mpz)) bblt
+  (mp_ifneg n (match v (bvn bbltn)
+                       (default (fail bblt)))
+              (match v ((bvc b v') (bbltc (match b (b0 false) (b1 true)) (bblast_const v' (mp_add n (~ 1)))))
+                       (default (fail bblt)))))
+
+(declare bv_bbl_const (! n mpz
+                      (! f bblt
+                      (! v bv
+                      (! c (^ (bblast_const v (mp_add n (~ 1))) f)
+                           (bblast_term n (a_bv n v) f))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST VARIABLE
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_var ((x var_bv) (n mpz)) bblt
+  (mp_ifneg n bbltn
+              (bbltc (bitof x n) (bblast_var x (mp_add n (~ 1))))))
+
+(declare bv_bbl_var (! n mpz
+                    (! x var_bv
+                    (! f bblt
+                    (! c (^ (bblast_var x (mp_add n (~ 1))) f)
+                         (bblast_term n (a_var_bv n x) f))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST CONCAT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_concat ((x bblt) (y bblt)) bblt
+  (match x
+    (bbltn (match y ((bbltc by y') (bbltc by (bblast_concat x y')))
+    	   	    (bbltn bbltn)))
+    ((bbltc bx x') (bbltc bx (bblast_concat x' y)))))
+
+(declare bv_bbl_concat (! n mpz
+	 	       (! m mpz
+		       (! m1 mpz
+                       (! x (term (BitVec m))
+		       (! y (term (BitVec m1))
+		       (! xb bblt
+		       (! yb bblt
+		       (! rb bblt
+		       (! xbb (bblast_term m x xb)
+		       (! ybb (bblast_term m1 y yb)
+                       (! c (^ (bblast_concat xb yb ) rb)
+                           (bblast_term n (concat n m m1 x y) rb)))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST EXTRACT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_extract_rec ((x bblt) (i mpz) (j mpz) (n mpz)) bblt
+  (match x
+    ((bbltc bx x') (mp_ifneg (mpz_sub (mpz_sub j n) 1)
+    	       	   	     (mp_ifneg (mpz_sub (mpz_sub n i) 1)
+			    	  	  (bbltc bx (bblast_extract_rec x' i j (mpz_sub n 1)))
+					  (bblast_extract_rec x' i j (mpz_sub n 1)))
+
+			     bbltn))
+   (bbltn bbltn)))
+
+(program bblast_extract ((x bblt) (i mpz) (j mpz) (n mpz)) bblt
+ (bblast_extract_rec x i j (mpz_sub n 1)))
+
+(declare bv_bbl_extract (! n mpz
+			(! i mpz
+			(! j mpz
+			(! m mpz
+                       	(! x (term (BitVec m))
+		       	(! xb bblt
+		       	(! rb bblt
+		       	(! xbb (bblast_term m x xb)
+			(! c ( ^ (bblast_extract xb i j m) rb)
+                           (bblast_term n (extract n i j m x) rb)))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST ZERO/SIGN EXTEND
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program extend_rec ((x bblt) (i mpz) (b formula)) bblt
+  (mp_ifneg i x
+  	    (bbltc b (extend_rec x (mpz_sub i 1) b))))
+
+(program bblast_zextend ((x bblt) (i mpz)) bblt
+ (extend_rec x (mpz_sub i 1) false))
+
+(declare bv_bbl_zero_extend (! n mpz
+			(! k mpz
+			(! m mpz
+                       	(! x (term (BitVec m))
+		       	(! xb bblt
+		       	(! rb bblt
+		       	(! xbb (bblast_term m x xb)
+			(! c ( ^ (bblast_zextend xb k m) rb)
+                           (bblast_term n (zero_extend n k m x) rb))))))))))
+
+(program bblast_sextend ((x bblt) (i mpz)) bblt
+ (match x (bbltn (fail bblt))
+ 	  ((bbltc xb x') (extend_rec x (mpz_sub i 1) xb))))
+
+(declare bv_bbl_sign_extend (! n mpz
+			(! k mpz
+			(! m mpz
+                       	(! x (term (BitVec m))
+		       	(! xb bblt
+		       	(! rb bblt
+		       	(! xbb (bblast_term m x xb)
+			(! c ( ^ (bblast_sextend xb k m) rb)
+                           (bblast_term n (sign_extend n k m x) rb))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVAND
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvand ((x bblt) (y bblt)) bblt
+  (match x
+    (bbltn (match y (bbltn bbltn) (default (fail bblt))))
+    ((bbltc bx x') (match y
+                      (bbltn (fail bblt))
+                      ((bbltc by y') (bbltc (and bx by) (bblast_bvand x' y')))))))
+
+(declare bv_bbl_bvand (! n mpz
+                      (! x (term (BitVec n))
+		      (! y (term (BitVec n))
+		      (! xb bblt
+		      (! yb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+		      (! ybb (bblast_term n y yb)
+                      (! c (^ (bblast_bvand xb yb ) rb)
+                           (bblast_term n (bvand n x y) rb)))))))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVNOT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvnot ((x bblt)) bblt
+  (match x
+    (bbltn bbltn)
+    ((bbltc bx x') (bbltc (not bx) (bblast_bvnot x')))))
+
+(declare bv_bbl_bvnot (! n mpz
+                      (! x (term (BitVec n))
+		      (! xb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+                      (! c (^ (bblast_bvnot xb ) rb)
+                           (bblast_term n (bvnot n x) rb))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVOR
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvor ((x bblt) (y bblt)) bblt
+  (match x
+    (bbltn (match y (bbltn bbltn) (default (fail bblt))))
+    ((bbltc bx x') (match y
+                      (bbltn (fail bblt))
+                      ((bbltc by y') (bbltc (or bx by) (bblast_bvor x' y')))))))
+
+(declare bv_bbl_bvor (! n mpz
+                      (! x (term (BitVec n))
+		      (! y (term (BitVec n))
+		      (! xb bblt
+		      (! yb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+		      (! ybb (bblast_term n y yb)
+                      (! c (^ (bblast_bvor xb yb ) rb)
+                           (bblast_term n (bvor n x y) rb)))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVXOR
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvxor ((x bblt) (y bblt)) bblt
+  (match x
+    (bbltn (match y (bbltn bbltn) (default (fail bblt))))
+    ((bbltc bx x') (match y
+                      (bbltn (fail bblt))
+                      ((bbltc by y') (bbltc (xor bx by) (bblast_bvxor x' y')))))))
+
+(declare bv_bbl_bvxor (! n mpz
+                      (! x (term (BitVec n))
+		      (! y (term (BitVec n))
+		      (! xb bblt
+		      (! yb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+		      (! ybb (bblast_term n y yb)
+                      (! c (^ (bblast_bvxor xb yb ) rb)
+                           (bblast_term n (bvxor n x y) rb)))))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVADD
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; return the carry bit after adding x y
+;; FIXME: not the most efficient thing in the world
+(program bblast_bvadd_carry ((a bblt) (b bblt) (carry formula)) formula
+(match a
+  ( bbltn (match b (bbltn carry) (default (fail formula))))
+  ((bbltc ai a') (match b
+  	     	   (bbltn (fail formula))
+	 	   ((bbltc bi b') (or (and ai bi) (and (xor ai bi) (bblast_bvadd_carry a' b' carry))))))))
+
+;; ripple carry adder where carry is the initial carry bit
+(program bblast_bvadd ((a bblt) (b bblt) (carry formula)) bblt
+(match a
+  ( bbltn (match b (bbltn bbltn) (default (fail bblt))))
+  ((bbltc ai a') (match b
+  	     	   (bbltn (fail bblt))
+	 	   ((bbltc bi b') (bbltc (xor (xor ai bi) (bblast_bvadd_carry a' b' carry))
+				  	 (bblast_bvadd a' b' carry)))))))
+
+
+(program reverse_help ((x bblt) (acc bblt)) bblt
+(match x
+       (bbltn acc)
+       ((bbltc xi x') (reverse_help x' (bbltc xi acc)))))
+
+
+(program reverseb ((x bblt)) bblt
+	 (reverse_help x bbltn))
+
+
+; AJR: use this version?
+;(program bblast_bvadd_2h ((a bblt) (b bblt) (carry formula)) bblt
+;(match a
+;  ( bbltn (match b (bbltn bbltn) (default (fail bblt))))
+;  ((bbltc ai a') (match b
+;       (bbltn (fail bblt))
+;	 	   ((bbltc bi b')
+;	 	     (let carry' (or (and ai bi) (and (xor ai bi) carry))
+;	 	     (bbltc (xor (xor ai bi) carry)
+;				  	    (bblast_bvadd_2h a' b' carry'))))))))
+
+;(program bblast_bvadd_2 ((a bblt) (b bblt) (carry formula)) bblt
+;(let ar (reverseb a) ;; reverse a and b so that we can build the circuit
+;(let br (reverseb b) ;; from the least significant bit up
+;(let ret (bblast_bvadd_2h ar br carry)
+;  (reverseb ret)))))
+
+(declare bv_bbl_bvadd (! n mpz
+                      (! x (term (BitVec n))
+		      (! y (term (BitVec n))
+		      (! xb bblt
+		      (! yb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+		      (! ybb (bblast_term n y yb)
+                      (! c (^ (bblast_bvadd xb yb false) rb)
+                           (bblast_term n (bvadd n x y) rb)))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVNEG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_zero ((n mpz)) bblt
+(mp_ifzero n bbltn
+	     (bbltc false (bblast_zero (mp_add n (~1))))))
+
+(program bblast_bvneg ((x bblt) (n mpz)) bblt
+  (bblast_bvadd (bblast_bvnot x) (bblast_zero n) true))
+
+
+(declare bv_bbl_bvneg (! n mpz
+                      (! x (term (BitVec n))
+		      (! xb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+                      (! c (^ (bblast_bvneg xb n) rb)
+                           (bblast_term n (bvneg n x) rb))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVMUL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; shift add multiplier
+
+;; (program concat ((a bblt) (b bblt)) bblt
+;;   (match a (bbltn b)
+;;   	   ((bbltc ai a') (bbltc ai (concat a' b)))))
+
+
+(program top_k_bits ((a bblt) (k mpz)) bblt
+  (mp_ifzero k bbltn
+  	     (match a (bbltn (fail bblt))
+	     	      ((bbltc ai a') (bbltc ai (top_k_bits a' (mpz_sub k 1)))))))
+
+(program bottom_k_bits ((a bblt) (k mpz)) bblt
+ (reverseb (top_k_bits (reverseb a) k)))
+
+;; assumes the least signigicant bit is at the beginning of the list
+(program k_bit ((a bblt) (k mpz)) formula
+(mp_ifneg k (fail formula)
+(match a (bbltn (fail formula))
+         ((bbltc ai a') (mp_ifzero k ai (k_bit a' (mpz_sub k 1)))))))
+
+(program and_with_bit ((a bblt) (bt formula)) bblt
+(match a (bbltn bbltn)
+         ((bbltc ai a') (bbltc (and bt ai) (and_with_bit a' bt)))))
+
+;; a is going to be the current result
+;; carry is going to be false initially
+;; b is the and of a and b[k]
+;; res is going to be bbltn initially
+(program mult_step_k_h ((a bblt) (b bblt) (res bblt) (carry formula) (k mpz)) bblt
+(match a
+  (bbltn (match b (bbltn res) (default (fail bblt))))
+  ((bbltc ai a')
+    (match b (bbltn (fail bblt))
+             ((bbltc bi b')
+	     (mp_ifneg (mpz_sub k 1)
+	     	         (let carry_out (or (and ai bi) (and (xor ai bi) carry))
+			 (let curr (xor (xor ai bi) carry)
+			    (mult_step_k_h a' b' (bbltc curr res) carry_out (mpz_sub k 1))))
+			 (mult_step_k_h a' b (bbltc ai res) carry (mpz_sub k 1))
+))))))
+
+;; assumes that a, b and res have already been reversed
+(program mult_step ((a bblt) (b bblt) (res bblt) (n mpz) (k mpz)) bblt
+(let k' (mpz_sub n k )
+(let ak (top_k_bits a k')
+(let b' (and_with_bit ak (k_bit b k))
+ (mp_ifzero (mpz_sub k' 1)
+   (mult_step_k_h res b' bbltn false k)
+   (let res' (mult_step_k_h res b' bbltn false k)
+   (mult_step a b (reverseb res') n (mp_add k 1))))))))
+
+
+(program bblast_bvmul ((a bblt) (b bblt) (n mpz)) bblt
+(let ar (reverseb a) ;; reverse a and b so that we can build the circuit
+(let br (reverseb b) ;; from the least significant bit up
+(let res (and_with_bit ar (k_bit br 0))
+     (mp_ifzero (mpz_sub n 1)     ;; if multiplying 1 bit numbers no need to call mult_step
+     		res
+		(mult_step ar br res n 1))))))
+
+(declare bv_bbl_bvmul (! n mpz
+                      (! x (term (BitVec n))
+		      (! y (term (BitVec n))
+		      (! xb bblt
+		      (! yb bblt
+		      (! rb bblt
+		      (! xbb (bblast_term n x xb)
+		      (! ybb (bblast_term n y yb)
+                      (! c (^ (bblast_bvmul xb yb n) rb)
+                           (bblast_term n (bvmul n x y) rb)))))))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST EQUALS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; bit blast  x = y
+; for x,y of size n, it will return a conjuction (x.0 = y.0 ^ ( ... ^ (x.{n-1} = y.{n-1})))
+; f is the accumulator formula that builds the equality in the right order
+(program bblast_eq_rec ((x bblt) (y bblt) (f formula)) formula
+  (match x
+    (bbltn (match y (bbltn f) (default (fail formula))))
+    ((bbltc fx x') (match y
+                      (bbltn (fail formula))
+                      ((bbltc fy y') (bblast_eq_rec x' y' (and (iff fx fy) f)))))
+    (default (fail formula))))
+
+(program bblast_eq ((x bblt) (y bblt)) formula
+	 (match x
+	 	((bbltc bx x') (match y ((bbltc by y') (bblast_eq_rec x' y' (iff bx by)))
+			       	      	(default (fail formula))))
+		(default (fail formula))))
+
+
+;; TODO: a temporary bypass for rewrites that we don't support yet. As soon
+;; as we do, remove this rule.
+
+(declare bv_bbl_=_false
+	 (! n mpz
+	 (! x (term (BitVec n))
+         (! y (term (BitVec n))
+         (! bx bblt
+         (! by bblt
+         (! f formula
+         (! bbx (bblast_term n x bx)
+         (! bby (bblast_term n y by)
+         (! c (^ (bblast_eq bx by) f)
+            (th_holds (iff (= (BitVec n) x y) false))))))))))))
+
+(declare bv_bbl_=
+	 (! n mpz
+	 (! x (term (BitVec n))
+         (! y (term (BitVec n))
+         (! bx bblt
+         (! by bblt
+         (! f formula
+         (! bbx (bblast_term n x bx)
+         (! bby (bblast_term n y by)
+         (! c (^ (bblast_eq bx by) f)
+            (th_holds (iff (= (BitVec n) x y) f))))))))))))
+
+(declare bv_bbl_=_swap
+	 (! n mpz
+	 (! x (term (BitVec n))
+         (! y (term (BitVec n))
+         (! bx bblt
+         (! by bblt
+         (! f formula
+         (! bbx (bblast_term n x bx)
+         (! bby (bblast_term n y by)
+         (! c (^ (bblast_eq by bx) f)
+            (th_holds (iff (= (BitVec n) x y) f))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVULT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvult ((x bblt) (y bblt) (n mpz)) formula
+(match x
+  ( bbltn (fail formula))
+  ((bbltc xi x') (match y
+  	     	   (bbltn (fail formula))
+	 	   ((bbltc yi y') (mp_ifzero n
+		                    (and (not xi) yi)
+				    (or (and (iff xi yi) (bblast_bvult x' y' (mp_add n (~1)))) (and (not xi) yi))))))))
+
+(declare bv_bbl_bvult
+	 (! n mpz
+	 (! x (term (BitVec n))
+         (! y (term (BitVec n))
+         (! bx bblt
+         (! by bblt
+         (! f formula
+         (! bbx (bblast_term n x bx)
+         (! bby (bblast_term n y by)
+         (! c (^ (bblast_bvult bx by (mp_add n (~1))) f)
+            (th_holds (iff (bvult n x y) f))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BITBLAST BVSLT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(program bblast_bvslt ((x bblt) (y bblt) (n mpz)) formula
+(match x
+  ( bbltn (fail formula))
+  ((bbltc xi x') (match y
+  	     	   (bbltn (fail formula))
+	 	   ((bbltc yi y') (mp_ifzero (mpz_sub n 1)
+		   	      	  	     (and xi (not yi))
+		   	      		     (or (and (iff xi yi)
+					     	      (bblast_bvult x' y' (mpz_sub n 2)))
+					     	 (and xi (not yi)))))))))
+
+(declare bv_bbl_bvslt
+	 (! n mpz
+	 (! x (term (BitVec n))
+         (! y (term (BitVec n))
+         (! bx bblt
+         (! by bblt
+         (! f formula
+         (! bbx (bblast_term n x bx)
+         (! bby (bblast_term n y by)
+         (! c (^ (bblast_bvslt bx by n) f)
+            (th_holds (iff (bvslt n x y) f))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;           BITBLASTING CONNECTORS
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+; bit-blasting connections
+
+(declare intro_assump_t
+	 (! f formula
+	 (! v var
+	 (! C clause
+	 (! h (th_holds f)
+	 (! a (atom v f)
+	 (! u (! unit (holds (clc (pos v) cln))
+	      	 (holds C))
+	 (holds C))))))))
+
+(declare intro_assump_f
+	 (! f formula
+	 (! v var
+	 (! C clause
+	 (! h (th_holds (not f))
+	 (! a (atom v f)
+	 (! u (! unit (holds (clc (neg v) cln))
+	      	 (holds C))
+	 (holds C))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;           REWRITE RULES
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+; rewrite rule :
+; x + y = y + x
+(declare bvadd_symm
+	 (! n mpz
+	 (! x (term (BitVec n))
+	 (! y (term (BitVec n))
+	    (th_holds (= (BitVec n) (bvadd _ x y) (bvadd _ y x)))))))
+
+;; (declare bvcrazy_rewrite
+;; 	 (! n mpz
+;; 	 (! x (term (BitVec n))
+;; 	 (! y (term (BitVec n))
+;; 	 (! xn bv_poly
+;; 	 (! yn bv_poly
+;; 	 (! hxn (bv_normalizes x xn)
+;; 	 (! hyn (bv_normalizes y yn)
+;; 	 (! s (^ (rewrite_scc xn yn) true)
+;; 	 (! u (! x (term (BitVec n)) (holds cln))
+;; 	     (holds cln)))))))))))
+
+;; 	    (th_holds (= (BitVec n) (bvadd x y) (bvadd y x)))))))
+
+
+
+; necessary?
+;; (program calc_bvand ((a bv) (b bv)) bv
+;;   (match a
+;;     (bvn (match b (bvn bvn) (default (fail bv))))
+;;     ((bvc ba a') (match b
+;;                       ((bvc bb b') (bvc (match ba (b0 b0) (b1 bb)) (calc_bvand a' b')))
+;;                       (default (fail bv))))))
+
+;; ; rewrite rule (w constants) :
+;; ; a & b = c
+;; (declare bvand_const (! c bv
+;; 		     (! a bv
+;;                      (! b bv
+;;                      (! u (^ (calc_bvand a b) c)
+;;                         (th_holds (= BitVec (bvand (a_bv a) (a_bv b)) (a_bv c))))))))
+
+
+;; making constant bit-vectors
+(program mk_ones ((n mpz)) bv
+	(mp_ifzero n bvn (bvc b1 (mk_ones (mpz_sub n 1)))))
+
+(program mk_zero ((n mpz)) bv
+	(mp_ifzero n bvn (bvc b0 (mk_ones (mpz_sub n 1)))))
+
+
+
+;; (bvxnor a b) => (bvnot (bvxor a b))
+;; (declare bvxnor_elim
+;; 	 (! n mpz
+;; 	 (! a (term (BitVec n))
+;; 	 (! b (term (BitVec n))
+;; 	 (! a' (term (BitVec n))
+;; 	 (! b' (term (BitVec n))
+;; 	 (! rwa (rw_term _ a a')
+;; 	 (! rwb (rw_term _ b b')
+;; 	 (rw_term n (bvxnor _ a b)
+;; 	 	  (bvnot _ (bvxor _ a' b')))))))))))
+
+
+
+;; ;; (bvxor a 0) => a
+;; (declare bvxor_zero
+;; 	 (! n mpz
+;; 	 (! zero_bits bv
+;; 	 (! sc (^ (mk_zero n)  zero_bits)
+;; 	 (! a (term (BitVec n))
+;; 	 (! b (term (BitVec n))
+;; 	 (! a' (term (BitVec n))
+;; 	 (! rwa (rw_term _  a a')
+;; 	 (! rwb (rw_term _ b (a_bv _ zero_bits))
+;; 	 (rw_term _  (bvxor _ a b)
+;; 	 	  a'))))))))))
+
+;; ;; (bvxor a 11) => (bvnot a)
+;; (declare bvxor_one
+;; 	 (! n mpz
+;; 	 (! one_bits bv
+;; 	 (! sc (^ (mk_ones n)  one_bits)
+;; 	 (! a (term (BitVec n))
+;; 	 (! b (term (BitVec n))
+;; 	 (! a' (term (BitVec n))
+;; 	 (! rwa (rw_term _  a a')
+;; 	 (! rwb (rw_term _  b (a_bv _ one_bits))
+;; 	 (rw_term _ (bvxor _ a b)
+;; 	 	  (bvnot _ a')))))))))))
+
+
+;; ;; (bvnot (bvnot a)) => a
+;; (declare bvnot_idemp
+;; 	 (! n mpz
+;; 	 (! a (term (BitVec n))
+;; 	 (! a' (term (BitVec n))
+;; 	 (! rwa (rw_term _  a a')
+;; 	 (rw_term _ (bvnot _ (bvnot _ a))
+;; 	 	  a'))))))
diff --git a/src/lfsc/tests/signatures/th_bv_rewrites.plf b/src/lfsc/tests/signatures/th_bv_rewrites.plf
new file mode 100644
index 0000000..4af9a09
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_bv_rewrites.plf
@@ -0,0 +1,22 @@
+;
+; Equality swap
+;
+
+(declare rr_bv_eq
+	 (! n mpz
+	 (! t1 (term (BitVec n))
+ 	 (! t2 (term (BitVec n))
+	     (th_holds (iff (= (BitVec n) t2 t1) (= (BitVec n) t1 t2)))))))
+
+;
+; Additional rules...
+;
+
+;
+; Default, if nothing else applied
+;
+
+(declare rr_bv_default
+	 (! t1 formula
+ 	 (! t2 formula
+	     (th_holds (iff t1 t2)))))
diff --git a/src/lfsc/tests/signatures/th_int.plf b/src/lfsc/tests/signatures/th_int.plf
new file mode 100644
index 0000000..9a0a2d6
--- /dev/null
+++ b/src/lfsc/tests/signatures/th_int.plf
@@ -0,0 +1,25 @@
+(declare Int sort)
+
+(define arithpred_Int (! x (term Int)
+                      (! y (term Int)
+                        formula)))
+
+(declare >_Int arithpred_Int)
+(declare >=_Int arithpred_Int)
+(declare <_Int  arithpred_Int)
+(declare <=_Int arithpred_Int)
+
+(define arithterm_Int (! x (term Int)
+		      (! y (term Int)
+		        (term Int))))
+
+(declare +_Int arithterm_Int)
+(declare -_Int arithterm_Int)
+(declare *_Int arithterm_Int)  ; is * ok to use?
+(declare /_Int arithterm_Int)  ; is / ok to use?
+
+; a constant term
+(declare a_int (! x mpz (term Int)))
+
+; unary negation
+(declare u-_Int (! t (term Int) (term Int)))
diff --git a/src/lfsc/tests/simple.smt2 b/src/lfsc/tests/simple.smt2
new file mode 100644
index 0000000..13d15cb
--- /dev/null
+++ b/src/lfsc/tests/simple.smt2
@@ -0,0 +1,16 @@
+(set-option :produce-proofs true)
+(set-logic QF_UF)
+(declare-sort U 0)
+
+(declare-fun f (U U) U)
+(declare-fun a () U)
+(declare-fun b () U)
+(declare-fun c () U)
+
+(assert (not (= (f a b) (f b b))))
+(assert (not (= (f a b) (f c b))))
+
+(assert (or (= a b) (= a c)))
+(check-sat)
+(get-proof)
+(exit)
diff --git a/src/lfsc/tests/swap1.smt2 b/src/lfsc/tests/swap1.smt2
new file mode 100644
index 0000000..7755705
--- /dev/null
+++ b/src/lfsc/tests/swap1.smt2
@@ -0,0 +1,20 @@
+(set-logic QF_AUFLIA)
+(set-info :source |
+Benchmarks used in the followin paper:
+Big proof engines as little proof engines: new results on rewrite-based satisfiability procedure
+Alessandro Armando, Maria Paola Bonacina, Silvio Ranise, Stephan Schulz. 
+PDPAR'05
+http://www.ai.dist.unige.it/pdpar05/
+
+
+|)
+(set-info :smt-lib-version 2.0)
+(set-info :category "crafted")
+(set-info :status unsat)
+(declare-fun a1 () (Array Int Int))
+(declare-fun i0 () Int)
+(declare-fun i1 () Int)
+(declare-fun sk ((Array Int Int) (Array Int Int)) Int)
+(assert (let ((?v_0 (select a1 i1))) (let ((?v_1 (store (store a1 i1 ?v_0) i1 ?v_0))) (let ((?v_3 (select ?v_1 i0)) (?v_4 (select ?v_1 i1))) (let ((?v_2 (store (store ?v_1 i0 ?v_4) i1 ?v_3)) (?v_5 (store (store ?v_1 i1 ?v_3) i0 ?v_4))) (let ((?v_6 (sk ?v_2 ?v_5))) (not (= (select ?v_2 ?v_6) (select ?v_5 ?v_6)))))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/swap3.smt2 b/src/lfsc/tests/swap3.smt2
new file mode 100644
index 0000000..cade13f
--- /dev/null
+++ b/src/lfsc/tests/swap3.smt2
@@ -0,0 +1,82 @@
+(set-logic QF_AUFLIA)
+(set-info :source |
+Benchmarks used in the followin paper:
+Big proof engines as little proof engines: new results on rewrite-based satisfiability procedure
+Alessandro Armando, Maria Paola Bonacina, Silvio Ranise, Stephan Schulz. 
+PDPAR'05
+http://www.ai.dist.unige.it/pdpar05/
+
+
+|)
+(set-info :smt-lib-version 2.0)
+(set-info :category "crafted")
+(set-info :status unsat)
+(declare-fun a_705 () (Array Int Int))
+(declare-fun a_707 () (Array Int Int))
+(declare-fun a_709 () (Array Int Int))
+(declare-fun a_711 () (Array Int Int))
+(declare-fun a_713 () (Array Int Int))
+(declare-fun a_715 () (Array Int Int))
+(declare-fun a_717 () (Array Int Int))
+(declare-fun a_719 () (Array Int Int))
+(declare-fun a_721 () (Array Int Int))
+(declare-fun a_723 () (Array Int Int))
+(declare-fun a_725 () (Array Int Int))
+(declare-fun a_727 () (Array Int Int))
+(declare-fun a_728 () (Array Int Int))
+(declare-fun a_729 () (Array Int Int))
+(declare-fun e_704 () Int)
+(declare-fun e_706 () Int)
+(declare-fun e_708 () Int)
+(declare-fun e_710 () Int)
+(declare-fun e_712 () Int)
+(declare-fun e_714 () Int)
+(declare-fun e_716 () Int)
+(declare-fun e_718 () Int)
+(declare-fun e_720 () Int)
+(declare-fun e_722 () Int)
+(declare-fun e_724 () Int)
+(declare-fun e_726 () Int)
+(declare-fun e_731 () Int)
+(declare-fun e_732 () Int)
+(declare-fun i_730 () Int)
+(declare-fun a1 () (Array Int Int))
+(declare-fun i0 () Int)
+(declare-fun i1 () Int)
+(declare-fun i2 () Int)
+(declare-fun i3 () Int)
+(declare-fun i4 () Int)
+(declare-fun i5 () Int)
+(declare-fun sk ((Array Int Int) (Array Int Int)) Int)
+(assert (= a_705 (store a1 i4 e_704)))
+(assert (= a_707 (store a_705 i2 e_706)))
+(assert (= a_709 (store a_707 i1 e_708)))
+(assert (= a_711 (store a_709 i4 e_710)))
+(assert (= a_713 (store a_711 i5 e_712)))
+(assert (= a_715 (store a_713 i3 e_714)))
+(assert (= a_717 (store a_715 i4 e_716)))
+(assert (= a_719 (store a_717 i2 e_718)))
+(assert (= a_721 (store a_719 i1 e_720)))
+(assert (= a_723 (store a_721 i0 e_722)))
+(assert (= a_725 (store a_723 i5 e_724)))
+(assert (= a_727 (store a_725 i2 e_726)))
+(assert (= a_728 (store a_723 i2 e_726)))
+(assert (= a_729 (store a_728 i5 e_724)))
+(assert (= e_704 (select a1 i2)))
+(assert (= e_706 (select a1 i4)))
+(assert (= e_708 (select a_707 i4)))
+(assert (= e_710 (select a_707 i1)))
+(assert (= e_712 (select a_711 i3)))
+(assert (= e_714 (select a_711 i5)))
+(assert (= e_716 (select a_715 i2)))
+(assert (= e_718 (select a_715 i4)))
+(assert (= e_720 (select a_719 i0)))
+(assert (= e_722 (select a_719 i1)))
+(assert (= e_724 (select a_723 i2)))
+(assert (= e_726 (select a_723 i5)))
+(assert (= e_731 (select a_727 i_730)))
+(assert (= e_732 (select a_729 i_730)))
+(assert (= i_730 (sk a_727 a_729)))
+(assert (not (= e_731 e_732)))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/tcong.smt2 b/src/lfsc/tests/tcong.smt2
new file mode 100644
index 0000000..47a3bf8
--- /dev/null
+++ b/src/lfsc/tests/tcong.smt2
@@ -0,0 +1,14 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun a () U)
+(declare-fun b () U)
+(declare-fun c () U)
+(declare-fun f (U U) U)
+
+(assert (not
+         (=> (and (= a b) (= a c))
+             (= (f a c) (f b a)))))
+
+(check-sat)
+(exit)
+
diff --git a/examples/euf.smt2 b/src/lfsc/tests/trans.smt2
index c151654..b27b52a 100644
--- a/examples/euf.smt2
+++ b/src/lfsc/tests/trans.smt2
@@ -6,6 +6,6 @@
 (declare-fun d () U)
 (declare-fun e () U)
 (declare-fun f () U)
-(assert (and (= a b) (= b c) (= c d) (= c e) (= e f) (not (= a f))))
+(assert (and (= a b) (and (= b c) (and (= c d) (and (= c e) (and (= e f) (not (= a f))))))))
 (check-sat)
 (exit)
diff --git a/src/lfsc/tests/typesafe2.smt2 b/src/lfsc/tests/typesafe2.smt2
new file mode 100644
index 0000000..8154a58
--- /dev/null
+++ b/src/lfsc/tests/typesafe2.smt2
@@ -0,0 +1,29 @@
+(set-logic QF_UF)
+(set-info :source |Benchmarks from the paper: "Extending Sledgehammer with SMT Solvers" by Jasmin Blanchette, Sascha Bohme, and Lawrence C. Paulson, CADE 2011.  Translated to SMT2 by Andrew Reynolds and Morgan Deters.|)
+(set-info :smt-lib-version 2.0)
+(set-info :category "industrial")
+(set-info :status unsat)
+(declare-sort S1 0)
+(declare-sort S2 0)
+(declare-sort S3 0)
+(declare-sort S4 0)
+(declare-sort S5 0)
+(declare-sort S6 0)
+(declare-sort S7 0)
+(declare-fun f1 () S1)
+(declare-fun f2 () S1)
+(declare-fun f3 (S2 S3 S4 S5 S6) S1)
+(declare-fun f4 () S2)
+(declare-fun f5 () S3)
+(declare-fun f6 () S4)
+(declare-fun f7 () S5)
+(declare-fun f8 (S7) S6)
+(declare-fun f9 () S7)
+(declare-fun f10 () S6)
+(assert (not (= f1 f2)))
+(assert (not (= (f3 f4 f5 f6 f7 (f8 f9)) f1)))
+(assert (= (f3 f4 f5 f6 f7 f10) f1))
+(assert (= f10 (f8 f9)))
+(assert (= (f3 f4 f5 f6 f7 f10) f1))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/typesafe3.smt2 b/src/lfsc/tests/typesafe3.smt2
new file mode 100644
index 0000000..35725de
--- /dev/null
+++ b/src/lfsc/tests/typesafe3.smt2
@@ -0,0 +1,28 @@
+(set-logic QF_UF)
+(set-info :source |Benchmarks from the paper: "Extending Sledgehammer with SMT Solvers" by Jasmin Blanchette, Sascha Bohme, and Lawrence C. Paulson, CADE 2011.  Translated to SMT2 by Andrew Reynolds and Morgan Deters.|)
+(set-info :smt-lib-version 2.0)
+(set-info :category "industrial")
+(set-info :status unsat)
+(declare-sort S1 0)
+(declare-sort S2 0)
+(declare-sort S3 0)
+(declare-sort S4 0)
+(declare-sort S5 0)
+(declare-sort S6 0)
+(declare-sort S7 0)
+(declare-fun f1 () S1)
+(declare-fun f2 () S1)
+(declare-fun f3 (S2 S3 S4 S5 S6) S1)
+(declare-fun f4 () S2)
+(declare-fun f5 () S3)
+(declare-fun f6 () S4)
+(declare-fun f7 () S5)
+(declare-fun f8 (S7) S6)
+(declare-fun f9 () S7)
+(declare-fun f10 () S6)
+(assert (not (= f1 f2)))
+(assert (not (= (f3 f4 f5 f6 f7 (f8 f9)) f1)))
+(assert (= (f3 f4 f5 f6 f7 f10) f1))
+(assert (= f10 (f8 f9)))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/uf1.smt2 b/src/lfsc/tests/uf1.smt2
new file mode 100644
index 0000000..b7c9df4
--- /dev/null
+++ b/src/lfsc/tests/uf1.smt2
@@ -0,0 +1,10 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun a () U)
+(declare-fun b () U)
+(declare-fun c () U)
+(declare-fun f (U) U)
+(declare-fun p (U) Bool)
+(assert (and (= a c) (and (= b c) (or (not (= (f a) (f b))) (and (p a) (not (p b)))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/uf2.smt2 b/src/lfsc/tests/uf2.smt2
new file mode 100644
index 0000000..9b2e47b
--- /dev/null
+++ b/src/lfsc/tests/uf2.smt2
@@ -0,0 +1,9 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun a () U)
+(declare-fun b () U)
+(declare-fun c () U)
+(declare-fun p (U) Bool)
+(assert (and (or (and (p a) (p b)) (and (p b) (p c))) (not (p b))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/uf4.smt2 b/src/lfsc/tests/uf4.smt2
new file mode 100644
index 0000000..1b9a7e1
--- /dev/null
+++ b/src/lfsc/tests/uf4.smt2
@@ -0,0 +1,9 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun x () U)
+(declare-fun y () U)
+(declare-fun z () U)
+(declare-fun f (U) U)
+(assert (and (not (= (f x) (f y))) (and (= y z) (and (= (f x) (f (f z))) (= x y)))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/uf5.smt2 b/src/lfsc/tests/uf5.smt2
new file mode 100644
index 0000000..b27b52a
--- /dev/null
+++ b/src/lfsc/tests/uf5.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun a () U)
+(declare-fun b () U)
+(declare-fun c () U)
+(declare-fun d () U)
+(declare-fun e () U)
+(declare-fun f () U)
+(assert (and (= a b) (and (= b c) (and (= c d) (and (= c e) (and (= e f) (not (= a f))))))))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/uf6.smt2 b/src/lfsc/tests/uf6.smt2
new file mode 100644
index 0000000..2fa1932
--- /dev/null
+++ b/src/lfsc/tests/uf6.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun x () U)
+(declare-fun y () U)
+(declare-fun z () U)
+(declare-fun f (U U) U)
+(assert (= x y))
+(assert (not (= (f z x) (f z y))))
+(check-sat)
+(exit)
+
diff --git a/src/lfsc/tests/uf7.smt2 b/src/lfsc/tests/uf7.smt2
new file mode 100644
index 0000000..30efa7c
--- /dev/null
+++ b/src/lfsc/tests/uf7.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_UF)
+(declare-sort U 0)
+(declare-fun x () U)
+(declare-fun y () U)
+(declare-fun z () U)
+(declare-fun P (U U) Bool)
+(assert (= x y))
+(assert (P z x))
+(assert (not (P z y)))
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/vmcai_bytes.smt2 b/src/lfsc/tests/vmcai_bytes.smt2
new file mode 100644
index 0000000..6628e37
--- /dev/null
+++ b/src/lfsc/tests/vmcai_bytes.smt2
@@ -0,0 +1,39 @@
+(set-logic QF_ABV)
+(declare-fun initialMemoryState_0x2ae2bf0 () (Array (_ BitVec 64) (_ BitVec 8)))
+(assert
+(let ((x1 (_ bv1 8)))
+(let ((x2 (_ bv0 32)))
+(let ((x3 (_ bv3221225470 64)))
+(let ((x4 (_ bv3221225468 64)))
+(let ((x5 initialMemoryState_0x2ae2bf0))
+(let ((x6 (_ bv3221225468 64)))
+(let ((x7 ((_ extract 7 0) x2)))
+(let ((x8 (store x5 x6 x7)))
+(let ((x9 (_ bv3221225469 64)))
+(let ((x10 ((_ extract 15 8) x2)))
+(let ((x11 (store x8 x9 x10)))
+(let ((x12 (_ bv3221225470 64)))
+(let ((x13 ((_ extract 23 16) x2)))
+(let ((x14 (store x11 x12 x13)))
+(let ((x15 (_ bv3221225471 64)))
+(let ((x16 ((_ extract 31 24) x2)))
+(let ((x17 (store x14 x15 x16)))
+(let ((x18 (store x17 x3 x1)))
+(let ((x19 (_ bv3221225468 64)))
+(let ((x20 (select x18 x19)))
+(let ((x21 (_ bv3221225469 64)))
+(let ((x22 (select x18 x21)))
+(let ((x23 (_ bv3221225470 64)))
+(let ((x24 (select x18 x23)))
+(let ((x25 (_ bv3221225471 64)))
+(let ((x26 (select x18 x25)))
+(let ((x27 (concat x22 x20)))
+(let ((x28 (concat x24 x27)))
+(let ((x29 (concat x26 x28)))
+(let ((dollar_x30 (not (=  x29 x2))))
+(let ((dollar_x31 (not dollar_x30)))
+dollar_x31
+)))))))))))))))))))))))))))))))
+)
+(check-sat)
+(exit)
diff --git a/src/lfsc/tests/wrapper_cvc4tocoq.sh b/src/lfsc/tests/wrapper_cvc4tocoq.sh
new file mode 100755
index 0000000..dba9bdc
--- /dev/null
+++ b/src/lfsc/tests/wrapper_cvc4tocoq.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+set -e
+OUTPUT_FOLDER=/home/burak/Desktop/smtcoq/src/lfsc/tests/results/
+CVC4TOCOQ_HOME=/home/burak/Desktop/smtcoq/src/lfsc/tests/
+
+${CVC4TOCOQ_HOME}/cvc4tocoq $1 &> $1.result
+#exit 0
+# exit'e gerek var mi emin degilim abi
+#${CVC4TOCOQ_HOME}/cvc4tocoq $1 &> ${OUTPUT_FOLDER}$1.result
diff --git a/src/lfsc/tosmtcoq.ml b/src/lfsc/tosmtcoq.ml
new file mode 100644
index 0000000..0395244
--- /dev/null
+++ b/src/lfsc/tosmtcoq.ml
@@ -0,0 +1,595 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open SmtAtom
+open SmtForm
+open SmtCertif
+open SmtTrace
+open VeritSyntax
+open Ast
+open Builtin
+open Format
+open Translator_sig
+open SmtBtype
+
+type lit = SmtAtom.Form.t
+
+type clause = lit list
+
+let lit_of_atom_form_lit rf af = lit_of_atom_form_lit rf (true, af)
+
+let show_veritproof =
+  try ignore (Sys.getenv "DONTSHOWVERIT"); false
+  with Not_found -> true
+
+
+module HS = Hstring.H
+(* module HT = Hashtbl.Make (Term) *)
+module HCl = Hashtbl
+
+module HT = struct
+  module M = Map.Make (Term)
+  let create _ = ref M.empty
+  let add h k v = h := M.add k v !h
+  let find h k = M.find k !h
+  let clear h = h := M.empty
+  let iter f h = M.iter f !h
+end
+
+
+
+let clauses_ids = HCl.create 201
+let ids_clauses = Hashtbl.create 201
+let propvars = HT.create 201
+let inputs : int HS.t = HS.create 13
+let alias_tbl = HS.create 17
+let memo_terms = HT.create 31
+(* let termalias_tbl = HT.create 17 *)
+
+let cl_cpt = ref 0
+
+
+let get_rule = function
+  | Reso -> VeritSyntax.Reso
+  | Weak -> VeritSyntax.Weak
+  | Or -> VeritSyntax.Or
+  | Orp -> VeritSyntax.Orp
+  | Imp -> VeritSyntax.Imp
+  | Impp -> VeritSyntax.Impp
+  | Nand -> VeritSyntax.Nand
+  | Andn -> VeritSyntax.Andn
+  | Nimp1 -> VeritSyntax.Nimp1
+  | Nimp2 -> VeritSyntax.Nimp2
+  | Impn1 -> VeritSyntax.Impn1
+  | Impn2 -> VeritSyntax.Impn2
+  | Nor -> VeritSyntax.Nor
+  | Orn -> VeritSyntax.Orn
+  | And -> VeritSyntax.And
+  | Andp -> VeritSyntax.Andp
+  | Equ1 -> VeritSyntax.Equ1
+  | Equ2 -> VeritSyntax.Equ2
+  | Nequ1 -> VeritSyntax.Nequ1
+  | Nequ2 -> VeritSyntax.Nequ2
+  | Equp1 -> VeritSyntax.Equp1
+  | Equp2 -> VeritSyntax.Equp2
+  | Equn1 -> VeritSyntax.Equn1
+  | Equn2 -> VeritSyntax.Equn2
+  | Xor1 -> VeritSyntax.Xor1
+  | Xor2 -> VeritSyntax.Xor2
+  | Xorp1 -> VeritSyntax.Xorp1
+  | Xorp2 -> VeritSyntax.Xorp2
+  | Xorn1 -> VeritSyntax.Xorn1
+  | Xorn2 -> VeritSyntax.Xorn2
+  | Nxor1 -> VeritSyntax.Nxor1
+  | Nxor2 -> VeritSyntax.Nxor2
+  | Itep1 -> VeritSyntax.Itep1
+  | Itep2 -> VeritSyntax.Itep2
+  | Iten1 -> VeritSyntax.Iten1
+  | Iten2 -> VeritSyntax.Iten2
+  | Ite1 -> VeritSyntax.Ite1
+  | Ite2 -> VeritSyntax.Ite2
+  | Nite1 -> VeritSyntax.Nite1
+  | Nite2 -> VeritSyntax.Nite2
+  | Eqtr -> VeritSyntax.Eqtr
+  | Eqcp -> VeritSyntax.Eqcp
+  | Eqco -> VeritSyntax.Eqco
+  | Eqre -> VeritSyntax.Eqre
+  | Lage -> VeritSyntax.Lage
+  | Flat -> VeritSyntax.Flat
+  | Hole -> VeritSyntax.Hole
+  | True -> VeritSyntax.True
+  | Fals -> VeritSyntax.Fals
+  | Bbva -> VeritSyntax.Bbva
+  | Bbconst -> VeritSyntax.Bbconst
+  | Bbeq -> VeritSyntax.Bbeq
+  | Bbdis -> VeritSyntax.Bbdis
+  | Bbop -> VeritSyntax.Bbop
+  | Bbadd -> VeritSyntax.Bbadd
+  | Bbmul -> VeritSyntax.Bbmul
+  | Bbult -> VeritSyntax.Bbult
+  | Bbslt -> VeritSyntax.Bbslt
+  | Bbshl -> VeritSyntax.Bbshl
+  | Bbshr -> VeritSyntax.Bbshr
+  | Bbnot -> VeritSyntax.Bbnot
+  | Bbneg -> VeritSyntax.Bbneg
+  | Bbconc -> VeritSyntax.Bbconc
+  | Bbextr -> VeritSyntax.Bbextr
+  | Bbzext -> VeritSyntax.Bbzext
+  | Bbsext -> VeritSyntax.Bbsext
+  | Row1 -> VeritSyntax.Row1
+  | Row2 -> VeritSyntax.Row2
+  | Exte -> VeritSyntax.Exte
+
+let string_of_rule = function
+  | Reso -> "resolution"
+  | Weak -> "weaken"
+  | Or -> "or"
+  | Orp -> "or_pos"
+  | Imp -> "implies"
+  | Impp -> "implies_pos"
+  | Nand -> "not_and"
+  | Andn -> "and_neg"
+  | Nimp1 -> "not_implies1"
+  | Nimp2 -> "not_implies2"
+  | Impn1 -> "implies_neg1"
+  | Impn2 -> "implies_neg2"
+  | Nor -> "not_or"
+  | Orn -> "or_neg"
+  | And -> "and"
+  | Andp -> "and_pos"
+  | Equ1 -> "equiv1"
+  | Equ2 -> "equiv2"
+  | Nequ1 -> "not_equiv1"
+  | Nequ2 -> "not_equiv2"
+  | Equp1 -> "equiv_pos1"
+  | Equp2 -> "equiv_pos2"
+  | Equn1 -> "equiv_neg1"
+  | Equn2 -> "equiv_neg2"
+  | Xor1 -> "xor1"
+  | Xor2 -> "xor2"
+  | Xorp1 -> "xor_pos1"
+  | Xorp2 -> "xor_pos2"
+  | Xorn1 -> "xor_neg1"
+  | Xorn2 -> "xor_neg2"
+  | Nxor1 -> "not_xor1"
+  | Nxor2 -> "not_xor2"
+  | Itep1 -> "ite_pos1"
+  | Itep2 -> "ite_pos2"
+  | Iten1 -> "ite_neg1"
+  | Iten2 -> "ite_neg2"
+  | Ite1 -> "ite1"
+  | Ite2 -> "ite2"
+  | Nite1 -> "not_ite1"
+  | Nite2 -> "not_ite2"
+  | Eqtr -> "eq_transitive"
+  | Eqcp -> "eq_congruent_pred"
+  | Eqco -> "eq_congruent"
+  | Eqre -> "eq_reflexive"
+  | Lage -> "la_generic"
+  | Flat -> "flatten"
+  | Hole -> "hole"
+  | True -> "true"
+  | Fals -> "false"
+  | Bbva -> "bbvar"
+  | Bbconst -> "bbconst"
+  | Bbeq -> "bbeq"
+  | Bbdis -> "bv_const_neq"
+  | Bbop -> "bbop"
+  | Bbadd -> "bbadd"
+  | Bbmul -> "bbmul"
+  | Bbult -> "bbult"
+  | Bbslt -> "bbslt"
+  | Bbshl -> "bbshl"
+  | Bbshr -> "bbshr"
+  | Bbnot -> "bbnot"
+  | Bbneg -> "bbneg"
+  | Bbconc -> "bbconcat"
+  | Bbextr -> "bbextract"
+  | Bbzext -> "bbzextend"
+  | Bbsext -> "bbsextend"
+  | Row1 -> "row1"
+  | Row2 -> "row2" 
+  | Exte -> "ext" 
+
+
+let bit_to_bool t = match name t with
+  | Some n when n == H.b0 -> false
+  | Some n when n == H.b1 -> true
+  | _ -> assert false
+
+let rec const_bv_aux acc t = match name t with
+  | Some n when n == H.bvn -> acc
+  | _ ->
+    match app_name t with
+    | Some (n, [b; t]) when n == H.bvc -> const_bv_aux (bit_to_bool b :: acc) t
+    | _ -> assert false
+
+let const_bv t =
+  let bv_list = const_bv_aux [] t in
+  Atom (Atom.mk_bvconst ra bv_list)
+
+
+let rec term_smtcoq_old t =
+  match value t with
+  | Const {sname=Name n} when n == H.ttrue -> Form Form.pform_true
+  | Const {sname=Name n} when n == H.tfalse -> Form Form.pform_false
+  | Const {sname=Name n} when n == H.bvn -> const_bv t
+  | Const {sname=Name n} ->
+    begin
+      try
+        term_smtcoq  (HS.find alias_tbl n)
+      with Not_found ->
+        Atom (Atom.get ra (Aapp (get_fun (Hstring.view n),[||])))
+    end
+  | Int bi -> Atom (Atom.hatom_Z_of_bigint ra bi)
+  | App _ ->
+    begin match app_name t with
+      | Some (n, [f]) when n == H.not_ ->
+        Lit (Form.neg (lit_of_atom_form_lit rf (term_smtcoq f)))
+      | Some (n, args) when n == H.and_ -> Form (Fapp (Fand, args_smtcoq args))
+      | Some (n, args) when n == H.or_ -> Form (Fapp (For, args_smtcoq args))
+      | Some (n, args) when n == H.impl_ -> Form (Fapp (Fimp, args_smtcoq args))
+      | Some (n, args) when n == H.xor_ -> Form (Fapp (Fxor, args_smtcoq args))
+      | Some (n, args) when n == H.ite || n == H.ifte_ ->
+        Form (Fapp (Fite, args_smtcoq args))
+      | Some (n, args) when n == H.iff -> Form (Fapp (Fiff, args_smtcoq args))
+      | Some (n, [_; a; b]) when n == H.eq ->
+        let h1, h2 = term_smtcoq_atom a, term_smtcoq_atom b in
+        Atom (Atom.mk_eq ra (Atom.type_of h1) h1 h2)
+      | Some (n, _) when n == H.apply -> uncurry [] t
+      | Some (n, [p]) when n == H.p_app -> term_smtcoq p
+      | Some (n, [{value = Int bi}]) when n == H.a_int ->
+        Atom (Atom.hatom_Z_of_bigint ra bi)
+      | Some (n, [ni]) when n == H.a_int ->
+        begin match app_name ni with
+          | Some (n, [{value = Int bi}]) when n == H.uminus ->
+            Atom (Atom.hatom_Z_of_bigint ra (Big_int.minus_big_int bi))
+          | _ -> assert false
+        end
+      | Some (n, [_; v]) when n == H.a_var_bv -> term_smtcoq v
+      | Some (n, _) when n == H.bvc -> const_bv t
+      | Some (n, [_; v]) when n == H.a_bv -> term_smtcoq v
+      | Some (b, [a; {value = Int n}]) when b == H.bitof ->
+         (let ha = term_smtcoq_atom a in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bitof ra s (Big_int.int_of_big_int n) ha)
+            | _ -> assert false)
+      | Some (n, [_; a; bb]) when n == H.bblast_term ->
+        Form (FbbT ((term_smtcoq_atom a), bblt_lits [] bb))
+      | Some (n, [_; a]) when n == H.bvnot ->
+         (let ha = term_smtcoq_atom a in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvnot ra s ha)
+            | _ -> assert false)
+      | Some (n, [_; a]) when n == H.bvneg ->
+         (let ha = term_smtcoq_atom a in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvneg ra s ha)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvand ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvand ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvor ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvor ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvxor ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvxor ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvadd ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvadd ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvmul ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvmult ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvult ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvult ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvslt ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvslt ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvule ->
+        (let ha = term_smtcoq_atom a in
+         let hb = term_smtcoq_atom b in
+         match Atom.type_of ha with
+         | TBV s ->
+           let a = Atom (Atom.mk_bvult ra s hb ha) in
+           Lit (Form.neg (lit_of_atom_form_lit rf a))
+         | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvsle ->
+        (let ha = term_smtcoq_atom a in
+         let hb = term_smtcoq_atom b in
+         match Atom.type_of ha with
+         | TBV s ->
+           let a = Atom (Atom.mk_bvslt ra s hb ha) in
+           Lit (Form.neg (lit_of_atom_form_lit rf a))
+         | _ -> assert false)         
+      | Some (n, [_; _; _; a; b]) when n == H.concat ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha, Atom.type_of hb with
+            | TBV s1, TBV s2 -> Atom (Atom.mk_bvconcat ra s1 s2 ha hb)
+            | _ -> assert false)
+      | Some (n, [_; {value = Int bj}; {value = Int bi}; _; a])
+        when n == H.extract ->
+        (let ha = term_smtcoq_atom a in
+         let i = Big_int.int_of_big_int bi in
+         let j = Big_int.int_of_big_int bj in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvextr ra ~s ~i ~n:(j-i+1) ha)
+            | _ -> assert false)
+      | Some (n, [_; {value = Int bi}; _; a])
+        when n == H.zero_extend ->
+        (let ha = term_smtcoq_atom a in
+         let n = Big_int.int_of_big_int bi in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvzextn ra ~s ~n ha)
+            | _ -> assert false)
+      | Some (n, [_; {value = Int bi}; _; a])
+        when n == H.sign_extend ->
+        (let ha = term_smtcoq_atom a in
+         let n = Big_int.int_of_big_int bi in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvsextn ra ~s ~n ha)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvshl ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvshl ra s ha hb)
+            | _ -> assert false)
+      | Some (n, [_; a; b]) when n == H.bvlshr ->
+         (let ha = term_smtcoq_atom a in
+          let hb = term_smtcoq_atom b in
+          match Atom.type_of ha with
+            | TBV s -> Atom (Atom.mk_bvshr ra s ha hb)
+            | _ -> assert false)
+
+      | Some (n, [a; b]) when n == H.lt_Int ->
+        Atom (Atom.mk_lt ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.le_Int ->
+        Atom (Atom.mk_le ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.gt_Int ->
+        Atom (Atom.mk_gt ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.ge_Int ->
+        Atom (Atom.mk_ge ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.plus_Int ->
+        Atom (Atom.mk_plus ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.minus_Int ->
+        Atom (Atom.mk_minus ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a; b]) when n == H.times_Int ->
+        Atom (Atom.mk_mult ra (term_smtcoq_atom a) (term_smtcoq_atom b))
+      | Some (n, [a]) when n == H.uminus_Int ->
+        Atom (Atom.mk_opp ra (term_smtcoq_atom a))
+      | Some (n, _) ->
+        Format.eprintf "\nTerm: %a\n@." print_term t;
+        failwith ("LFSC function symbol "^Hstring.view n^" not supported.")
+      | _ -> assert false
+    end
+
+  | Rat _ -> failwith ("LFSC rationals not supported")
+  | Type -> failwith ("LFSC Type not supported")
+  | Kind -> failwith ("LFSC Kind not supported")
+  | Mpz -> failwith ("LFSC mpz not supported")
+  | Mpq -> failwith ("LFSC mpq not supported")
+  | Pi _ -> failwith ("LFSC pi abstractions not supported")
+  | Lambda _ -> failwith ("LFSC lambda abstractions not supported")
+  | Hole _ -> failwith ("LFSC holes not supported")
+  | Ptr _ -> failwith ("LFSC Ptr not supported")
+  | SideCond _ -> failwith ("LFSC side conditions not supported")
+  | _ -> assert false
+
+
+and term_smtcoq t =
+  try HT.find memo_terms t
+  with Not_found ->
+    let v = term_smtcoq_old t in
+    HT.add memo_terms t v;
+    v
+
+
+and term_smtcoq_atom a = match term_smtcoq a with
+  | Atom h -> h
+  | _ ->  assert false
+
+and args_smtcoq args =
+  List.map (fun t -> lit_of_atom_form_lit rf (term_smtcoq t)) args
+  |> Array.of_list
+
+and uncurry acc t = match app_name t, acc with
+  | Some (n, [_; _; f; a]), _ when n == H.apply ->
+    uncurry (term_smtcoq_atom a :: acc) f
+  | Some (n, [_; _]) , [h1; h2] when n == H.read ->
+    (match Atom.type_of h1 with
+     | TFArray (ti,te) -> Atom (Atom.mk_select ra ti te h1 h2)
+     | _ -> assert false)
+  | Some (n, [_; _]) , [h1; h2; h3] when n == H.write ->
+    (match Atom.type_of h1 with
+     | TFArray (ti,te) -> Atom (Atom.mk_store ra ti te h1 h2 h3)
+     | _ -> assert false)
+  | Some (n, [_; _]) , [h1; h2] when n == H.diff ->
+    (match Atom.type_of h1 with
+     | TFArray (ti,te) -> Atom (Atom.mk_diffarray ra ti te h1 h2)
+     | _ -> assert false)
+  | None, _ ->
+    (match name t with
+     | Some n ->
+       let args = Array.of_list acc in
+       Atom (Atom.get ra (Aapp (get_fun (Hstring.view n), args)))
+     | _ -> assert false)
+  | _ ->
+    eprintf "uncurry fail: %a@." Ast.print_term t;
+    assert false
+
+(* Endianness dependant: LFSC big endian -> SMTCoq little endian *)
+and bblt_lits acc t = match name t with
+  | Some n when n == H.bbltn -> acc
+  | _ -> match app_name t with
+    | Some (n, [f; r]) when n == H.bbltc ->
+      bblt_lits (lit_of_atom_form_lit rf (term_smtcoq f) :: acc) r
+    | _ -> assert false
+
+
+let term_smtcoq t =
+  (* eprintf "translate term %a@." Ast.print_term t; *)
+  lit_of_atom_form_lit rf (term_smtcoq t)
+
+
+let rec clause_smtcoq acc t = match name t with
+  | Some n when n == H.cln || n == H.tfalse -> acc
+  | Some _ -> term_smtcoq t :: acc
+  | None ->
+    match app_name t with
+    | Some (n, [v]) when n == H.pos ->
+      let t = HT.find propvars (deref v) in
+      term_smtcoq t :: acc
+    | Some (n, [v]) when n == H.neg ->
+      let t = HT.find propvars (deref v) in
+      Form.neg (term_smtcoq t) :: acc
+    | Some (n, [a; cl]) when n == H.clc ->
+      clause_smtcoq (clause_smtcoq acc a) cl
+    | Some (n, [a; b]) when n == H.or_ -> clause_smtcoq (clause_smtcoq acc a) b
+    | _ -> term_smtcoq t :: acc
+
+
+let to_clause = clause_smtcoq [] 
+
+
+let print_clause fmt cl =
+  fprintf fmt "(";
+  List.iter (fprintf fmt "%a " (Form.to_smt Atom.to_smt)) cl;
+  fprintf fmt ")"
+
+
+
+type clause_res_id = NewCl of int | OldCl of int
+
+
+let register_clause_id cl id =
+  HCl.add clauses_ids cl id;
+  Hashtbl.add ids_clauses id cl
+
+
+let register_termclause_id t id =
+  register_clause_id (to_clause t) id
+
+
+let new_clause_id ?(reuse=true) cl =
+  try
+    if not reuse then raise Not_found;
+    OldCl (HCl.find clauses_ids cl)
+  with Not_found ->
+    incr cl_cpt;
+    let id = !cl_cpt in
+    register_clause_id cl id;
+    NewCl id
+
+
+let mk_clause ?(reuse=true) rule cl args =
+  match new_clause_id ~reuse cl with
+  | NewCl id ->
+    if show_veritproof then
+      eprintf "%d:(%s %a %a)@." id (string_of_rule rule)
+        print_clause cl
+        (fun fmt -> List.iter (fprintf fmt " %d")) args;
+    VeritSyntax.mk_clause (id, (get_rule rule), cl, args)
+  | OldCl id ->
+    (* Format.eprintf "old_clause %d@." id; *)
+    id
+
+
+let mk_clause_cl ?(reuse=true) rule cl args =
+  mk_clause ~reuse rule (List.map term_smtcoq cl) args
+
+
+let mk_input name formula =
+  let cl = [term_smtcoq formula] in
+  match new_clause_id cl with
+   | NewCl id ->
+     register_clause_id cl id;
+     HS.add inputs name id;
+     if show_veritproof then eprintf "%d:input  %a@." id print_clause cl;
+     VeritSyntax.mk_clause (id, VeritSyntax.Inpu, cl, []) |> ignore
+   | OldCl _ -> ()
+
+
+let mk_admit_preproc name formula =
+  let cl = [term_smtcoq formula] in
+  match new_clause_id cl with
+   | NewCl id ->
+     register_clause_id cl id;
+     HS.add inputs name id;
+     if show_veritproof then eprintf "%d:hole  %a@." id print_clause cl;
+     VeritSyntax.mk_clause (id, VeritSyntax.Hole, cl, []) |> ignore
+   | OldCl _ -> ()
+
+
+let register_prop_abstr vt formula = HT.add propvars vt formula
+
+
+let register_alias name_index t = HS.add alias_tbl name_index t
+
+
+(* let register_termalias a t = HT.add termalias_tbl a t *)
+
+
+let get_clause_id cl =
+  try HCl.find clauses_ids cl with Not_found -> assert false
+
+
+let get_input_id h = HS.find inputs h
+
+
+let register_decl name formula =
+  let cl = [term_smtcoq formula] in
+  match new_clause_id cl with
+  | NewCl id | OldCl id ->
+    (* eprintf "register decl %d@." id; *)
+    HS.add inputs name id
+
+let register_decl_id name id =
+  (* eprintf "register_decl %s : %d@." name id; *)
+  HS.add inputs name id
+
+
+
+let clear () =
+  HCl.clear clauses_ids;
+  Hashtbl.clear ids_clauses;
+  HT.clear propvars;
+  HS.clear inputs;
+  HS.clear alias_tbl;
+  HT.clear memo_terms;
+  (* HT.clear termalias_tbl; *)
+  cl_cpt := 0
+  
+
diff --git a/src/lfsc/tosmtcoq.mli b/src/lfsc/tosmtcoq.mli
new file mode 100644
index 0000000..b0d980b
--- /dev/null
+++ b/src/lfsc/tosmtcoq.mli
@@ -0,0 +1,13 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+include Translator_sig.S
diff --git a/src/lfsc/translator_sig.mli b/src/lfsc/translator_sig.mli
new file mode 100644
index 0000000..66005f3
--- /dev/null
+++ b/src/lfsc/translator_sig.mli
@@ -0,0 +1,159 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(**
+   Signature to implement to build a converter of LFSC proofs.
+   See {!Converter.Make}, {!Tosmtcoq} and {!VeritPrinter}.
+*)
+
+open Ast
+open Format
+
+
+(** The type of destination rules that are currently supported byt the
+    converter *)
+type rule =
+  | Reso
+  | Weak
+  | Or
+  | Orp
+  | Imp
+  | Impp
+  | Nand
+  | Andn
+  | Nimp1
+  | Nimp2
+  | Impn1
+  | Impn2
+  | Nor
+  | Orn
+  | And
+  | Andp
+  | Equ1
+  | Equ2
+  | Nequ1
+  | Nequ2
+  | Equp1
+  | Equp2
+  | Equn1
+  | Equn2
+  | Xor1
+  | Xor2
+  | Xorp1
+  | Xorp2
+  | Xorn1
+  | Xorn2
+  | Nxor1
+  | Nxor2
+  | Itep1
+  | Itep2
+  | Iten1
+  | Iten2
+  | Ite1
+  | Ite2
+  | Nite1
+  | Nite2
+  | Eqtr
+  | Eqcp
+  | Eqco
+  | Eqre
+  | Lage
+  | Flat
+  | Hole
+  | True
+  | Fals
+  | Bbva
+  | Bbconst
+  | Bbeq
+  | Bbdis
+  | Bbop
+  | Bbadd
+  | Bbmul
+  | Bbult
+  | Bbslt
+  | Bbshl
+  | Bbshr
+  | Bbnot
+  | Bbneg
+  | Bbconc
+  | Bbextr
+  | Bbzext
+  | Bbsext
+  | Row1
+  | Row2 
+  | Exte
+
+(** Signature for translators *)
+module type S = sig
+
+  (** The type of literal depends on the chosen tranlation, it is abstract *)
+  type lit
+
+  (** Clauses are lists of the aforementioned literals *)
+  type clause = lit list
+
+  (** Transform a term in LFSC to the chosen clause representation. (This
+      eliminates top-level dijunctions and implications.) *)
+  val to_clause : term -> clause
+
+  (** Print a clause (for debugging purposes) *)
+  val print_clause : formatter -> clause -> unit
+
+  (** Manually resgister a clause with an integer identifier *)
+  val register_clause_id : clause -> int -> unit
+
+  (** Create a new clause as the result of a rule application with a list of
+      intgeger arguments. These can be either previously defined clause
+      identifiers or an arbitrary positive integer depending on the rule.  It
+      returns the identifier of the newly created resulting clause. The
+      optional arguemnt [reuse] ([true] by default) says if we should reuse
+      clauses that were previously deduced, in this case the rule application
+      will not be created and it returns the identifier of this pre-existing
+      clause. *)
+  val mk_clause : ?reuse:bool -> rule -> clause -> int list -> int
+
+  (** Same as {!mk_clause} but with an hybrid representation for clauses. This
+      is just used to avoid creating unecessary terms for these clauses when
+      they are built by hand. *)
+  val mk_clause_cl : ?reuse:bool -> rule -> term list -> int list -> int
+
+  (** Create an input unit clause. It is given an identifier that is not
+      returned. *)
+  val mk_input : Hstring.t -> term -> unit
+
+  val mk_admit_preproc : Hstring.t -> term -> unit
+    
+  (** [register_prop_abstr v p] register the term [v] as being a propositional
+      abstraction of the term [p]. *)
+  val register_prop_abstr : term -> term -> unit
+
+  (** Returns the identifier of a previously deduced clause. *)
+  val get_clause_id : clause -> int
+
+  (** Returns the identifier of a unit input clause given its name, as
+      intoduced by the proprocessor of CVC4 in the LFSC proof. *)
+  val get_input_id : Hstring.t -> int
+
+  val register_decl : Hstring.t -> term -> unit
+
+  val register_decl_id : Hstring.t -> int -> unit
+
+  (** register an alias name for a term *)
+  val register_alias : Hstring.t -> term -> unit
+
+  (* (\** register a term as an alias for another term *\) *)
+  (* val register_termalias : term -> term -> unit *)
+
+  (** Clear and reset global tables and values. *)
+  val clear : unit -> unit
+  
+end
diff --git a/src/lfsc/type.ml b/src/lfsc/type.ml
new file mode 100644
index 0000000..7c30a2a
--- /dev/null
+++ b/src/lfsc/type.ml
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Type of S-expressions *)
+type t = Atom of string | List of t list
+
+
+let rec print fmt = function
+  | Atom s -> Format.pp_print_string fmt s
+  | List l ->
+    Format.fprintf fmt "(";
+    List.iter (Format.fprintf fmt "%a " print) l;
+    Format.fprintf fmt ")"
+
+let rec print_list fmt = function
+  | [] -> ()
+  | s :: r ->
+    Format.fprintf fmt "%a@." print s;
+    print_list fmt r
+
+let rec size = function
+  | Atom _ -> 1
+  | List l -> List.fold_left (fun acc s -> size s + acc) 0 l
+
+let rec size_list = function
+  | [] -> 0
+  | s :: r -> size s + size_list r
diff --git a/src/lfsc/veritPrinter.ml b/src/lfsc/veritPrinter.ml
new file mode 100644
index 0000000..4601587
--- /dev/null
+++ b/src/lfsc/veritPrinter.ml
@@ -0,0 +1,493 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+open Ast
+open Builtin
+open Translator_sig  
+
+
+type lit = term
+
+type clause = term list
+
+(* module HT = Hashtbl.Make (Term) *)
+
+(* module HCl = Hashtbl.Make (struct *)
+(*     type t = clause *)
+(*     let equal c1 c2 = compare_term_list c1 c2 = 0 *)
+(*     let hash = Hashtbl.hash (\* List.fold_left (fun acc t -> Term.hash t + 17*acc) 0 *\) *)
+(*   end) *)
+
+
+module HS = Hstring.H
+
+module HT = struct
+  module M = Map.Make (Term)
+  let create _ = ref M.empty
+  let add h k v = h := M.add k v !h
+  let find h k = M.find k !h
+  let clear h = h := M.empty
+  let iter f h = M.iter f !h
+end
+
+module HCl = struct
+  module M = Map.Make (struct
+      type t = clause
+      let compare c1 c2 = compare_term_list c1 c2
+    end)
+  let create _ = ref M.empty
+  let add h k v = h := M.add k v !h
+  let find h k = M.find k !h
+  let clear h = h := M.empty
+  let iter f h = M.iter f !h
+end
+
+
+let fmt = std_formatter
+
+let clauses_ids = HCl.create 201
+let ids_clauses = Hashtbl.create 201
+let propvars = HT.create 201
+let sharp_tbl = HT.create 13
+let inputs : int HS.t = HS.create 13
+let alias_tbl = HS.create 17
+(* let termalias_tbl = HT.create 17 *)
+
+let cpt = ref 0
+let cl_cpt = ref 0
+
+
+
+
+let get_rule = function
+  | Reso -> "resolution"
+  | Weak -> "weaken"
+  | Or -> "or"
+  | Orp -> "or_pos"
+  | Imp -> "implies"
+  | Impp -> "implies_pos"
+  | Nand -> "not_and"
+  | Andn -> "and_neg"
+  | Nimp1 -> "not_implies1"
+  | Nimp2 -> "not_implies2"
+  | Impn1 -> "implies_neg1"
+  | Impn2 -> "implies_neg2"
+  | Nor -> "not_or"
+  | Orn -> "or_neg"
+  | And -> "and"
+  | Andp -> "and_pos"
+  | Equ1 -> "equiv1"
+  | Equ2 -> "equiv2"
+  | Nequ1 -> "not_equiv1"
+  | Nequ2 -> "not_equiv2"
+  | Equp1 -> "equiv_pos1"
+  | Equp2 -> "equiv_pos2"
+  | Equn1 -> "equiv_neg1"
+  | Equn2 -> "equiv_neg2"
+  | Xor1 -> "xor1"
+  | Xor2 -> "xor2"
+  | Xorp1 -> "xor_pos1"
+  | Xorp2 -> "xor_pos2"
+  | Xorn1 -> "xor_neg1"
+  | Xorn2 -> "xor_neg2"
+  | Nxor1 -> "not_xor1"
+  | Nxor2 -> "not_xor2"
+  | Itep1 -> "ite_pos1"
+  | Itep2 -> "ite_pos2"
+  | Iten1 -> "ite_neg1"
+  | Iten2 -> "ite_neg2"
+  | Ite1 -> "ite1"
+  | Ite2 -> "ite2"
+  | Nite1 -> "not_ite1"
+  | Nite2 -> "not_ite2"
+  | Eqtr -> "eq_transitive"
+  | Eqcp -> "eq_congruent_pred"
+  | Eqco -> "eq_congruent"
+  | Eqre -> "eq_reflexive"
+  | Lage -> "la_generic"
+  | Flat -> "flatten"
+  | Hole -> "hole"
+  | True -> "true"
+  | Fals -> "false"
+  | Bbva -> "bbvar"
+  | Bbconst -> "bbconst"
+  | Bbeq -> "bbeq"
+  | Bbdis -> "bv_const_neq"
+  | Bbop -> "bbop"
+  | Bbadd -> "bbadd"
+  | Bbmul -> "bbmul"
+  | Bbult -> "bbult"
+  | Bbslt -> "bbslt"
+  | Bbshl -> "bbshl"
+  | Bbshr -> "bbshr"
+  | Bbnot -> "bbnot"
+  | Bbneg -> "bbneg"
+  | Bbconc -> "bbconcat"
+  | Bbextr -> "bbextract"
+  | Bbzext -> "bbzextend"
+  | Bbsext -> "bbsextend"
+  | Row1 -> "row1"
+  | Row2 -> "row2" 
+  | Exte -> "ext" 
+
+
+
+let print_sharps () =
+  HT.iter (fun t id ->
+      printf "#%d --> %a@." id Ast.print_term_type t) sharp_tbl
+
+
+let smt2_of_lfsc t =
+  if t == H.iff then "="
+  else if t == H.ifte_ then "ite"
+  else if t == H.flet then "let"
+  else if t == H.impl then "=>"
+  else if t == H.gt_Int then ">"
+  else if t == H.ge_Int then ">="
+  else if t == H.lt_Int then "<"
+  else if t == H.le_Int then "<="
+  else if t == H.plus_Int then "+"
+  else if t == H.minus_Int then "-"
+  else if t == H.times_Int then "*"
+  else if t == H.div_Int then "/" (* Maybe div? *)
+  else if t == H.uminus_Int then "-"
+  else Hstring.view t
+
+
+let new_sharp t =
+  incr cpt;
+  HT.add sharp_tbl t !cpt;
+  !cpt
+
+
+let print_bit fmt b = match name b with
+  | Some b when b == H.b0 -> fprintf fmt "0"
+  | Some b when b == H.b1 -> fprintf fmt "1"
+  | _ -> assert false
+
+let rec print_bv_const fmt t = match name t with
+  | Some b when b == H.bvn  -> ()
+  | _ -> match app_name t with
+    | Some (n, [b; t]) when n == H.bvc ->
+      fprintf fmt "%a%a" print_bit b print_bv_const t
+    | _ -> assert false
+
+let rec print_apply fmt t = match app_name t with
+  | Some (n, [_; _; f; a]) when n == H.apply ->
+    fprintf fmt "%a %a" print_apply f print_term a
+  | _ -> print_term fmt t
+  
+
+(* Endianness dependant: LFSC big endian -> SMTCoq little endian *)
+and print_bblt fmt t = match name t with
+  | Some n when n == H.bbltn -> ()
+  | _ -> match app_name t with
+    | Some (n, [f; r]) when n == H.bbltc ->
+      fprintf fmt "%a %a" print_bblt r print_term f
+    | _ -> assert false
+
+
+and print_term fmt t =
+  try HT.find sharp_tbl t |> fprintf fmt "#%d" with Not_found ->
+    match value t with
+    | Int n -> fprintf fmt "%s" (Big_int.string_of_big_int n)
+    | _ ->
+    match name t with
+    | Some n ->
+      begin
+        try
+          print_term fmt (HS.find alias_tbl n)
+        with Not_found -> pp_print_string fmt (smt2_of_lfsc n)
+      end
+    | None -> match app_name t with
+
+      | Some (n, [ty; a; b]) when n == H.eq ->
+        let eqt = match value t with App (eqt, _ ) -> eqt | _ -> assert false in
+        incr cpt;
+        let eq_b_a = mk_app eqt [ty; b; a] in
+        HT.add sharp_tbl t !cpt;
+        HT.add sharp_tbl eq_b_a !cpt;
+        (* let a, b = if compare_term a b <= 0 then a, b else b, a in *)
+        fprintf fmt "#%d:(= %a %a)" !cpt print_term a print_term b
+
+      | Some (n, [a]) when n == H.not_ -> fprintf fmt "(not %a)" print_term a
+
+      | Some (n, _) when n == H.apply ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a)" nb print_apply t
+
+      | Some (n, [a]) when n == H.p_app -> print_term fmt a
+
+      | Some (a, [{value = Int n}]) when a == H.a_int ->
+        fprintf fmt "%s" (Big_int.string_of_big_int n)
+
+      | Some (n, [_; a]) when n == H.a_var_bv -> print_term fmt a
+
+      | Some (n, [_; a]) when n == H.a_bv -> print_term fmt a
+
+      | Some (n, _) when n == H.bvc -> fprintf fmt "#b%a" print_bv_const t
+
+      | Some (op,[_; a; b])
+        when op == H.bvand ||
+             op == H.bvor ||
+             op == H.bvxor ||
+             op == H.bvadd ||
+             op == H.bvmul ||
+             op == H.bvult ||
+             op == H.bvslt ||
+             op == H.bvule ||
+             op == H.bvsle ||
+             op == H.bvshl ||
+             op == H.bvlshr ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a %a %a)" nb
+          Hstring.print op print_term a print_term b
+
+      | Some (op, [_; a]) when op == H.bvnot || op == H.bvneg ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a %a)" nb Hstring.print op print_term a
+
+      | Some (op, [_; _; _; a; b]) when op == H.concat ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a %a %a)" nb
+          Hstring.print op print_term a print_term b
+
+      | Some (op, [_; i; j; _; a]) when op == H.extract ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a %a %a %a)" nb
+          Hstring.print op print_term i print_term j print_term a
+
+      | Some (op, [_; i; _; a])
+        when op == H.zero_extend || op == H.sign_extend ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%a %a %a)" nb
+          Hstring.print op print_term i print_term a
+
+      | Some (op, [a; {value = Int n}]) when op == H.bitof ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(bitof %s %a)" nb
+          (Big_int.string_of_big_int n) print_term a
+
+      | Some (n, _) when n == H.bbltc -> fprintf fmt "[%a]" print_bblt t
+
+      | Some (n, [_; a; bb]) when n == H.bblast_term ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(bbT %a [%a])" nb print_term a print_bblt bb
+
+      | Some (n, [_; _]) when n == H.read -> fprintf fmt "select"
+      | Some (n, [_; _]) when n == H.write -> fprintf fmt "store"
+      | Some (n, [_; _]) when n == H.diff -> fprintf fmt "diff"
+
+      | Some (n, [_; c; a; b]) when n == H.ite ->
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(ite %a %a %a)" nb
+          print_term c print_term a print_term b
+
+      | Some (n, l) ->
+        let n = smt2_of_lfsc n in
+        let nb = new_sharp t in
+        fprintf fmt "#%d:(%s%a)" nb n
+          (fun fmt -> List.iter (fprintf fmt " %a" print_term)) l
+
+      | None ->
+        eprintf "Could not translate term %a@." Ast.print_term t;
+        assert false
+
+
+let print_term fmt t = print_term fmt t (* (get_real t) *)
+
+
+let rec print_clause elim_or fmt t = match name t with
+  | Some n when n == H.cln || n == H.tfalse -> ()
+  | Some n -> pp_print_string fmt (smt2_of_lfsc n)
+  | None ->
+    match app_name t with
+    | Some (n, [v]) when n == H.pos ->
+      let t = try HT.find propvars (deref v) with Not_found -> assert false in
+      fprintf fmt "%a" print_term t
+    | Some (n, [v]) when n == H.neg ->
+      let t = try HT.find propvars (deref v) with Not_found -> assert false in
+      fprintf fmt "(not %a)" print_term t
+    | Some (n, [a; cl]) when n == H.clc ->
+      fprintf fmt "%a %a" (print_clause elim_or) a (print_clause elim_or) cl
+    | Some (n, [a; b]) when n == H.or_ && elim_or ->
+      fprintf fmt "%a %a" (print_clause elim_or) a (print_clause elim_or) b
+    | _ -> fprintf fmt "%a" print_term t
+
+
+let print_clause_elim_or fmt t = fprintf fmt "(%a)" (print_clause true) t
+
+let print_clause fmt t = fprintf fmt "(%a)" (print_clause false) t
+  
+
+let rec to_clause acc t = match name t with
+  | Some n when n == H.cln || n == H.tfalse -> acc
+  | Some n -> t :: acc
+  | None ->
+    match app_name t with
+    | Some (n, [v]) when n == H.pos ->
+      let t = try HT.find propvars (deref v) with Not_found -> assert false in
+      t :: acc
+    | Some (n, [v]) when n == H.neg ->
+      let t =
+        try HT.find propvars (deref v) |> not_
+        with Not_found -> assert false in
+      t :: acc
+    | Some (n, [a; cl]) when n == H.clc ->
+      to_clause (to_clause acc a) cl
+    | Some (n, [a; b]) when n == H.or_ ->
+      to_clause (to_clause acc a) b
+    | _ -> t :: acc
+
+
+let to_clause = to_clause [] 
+
+
+let rec print_clause fmt = function
+  | [] -> ()
+  | [t] -> print_term fmt t
+  | t :: cl -> fprintf fmt "%a %a" print_term t print_clause cl
+
+let print_clause fmt = fprintf fmt "(%a)" print_clause
+
+
+let th_res p = match app_name (deref p).ttype with
+  | Some (n, [r]) when n == H.th_holds -> r
+  | _ -> assert false
+
+
+type clause_res_id = NewCl of int | OldCl of int
+
+
+let clause_mod_eqsymm cl =
+  List.fold_left (fun acc t -> match app_name t with
+      | Some (n, [ty; a; b]) when n == H.eq ->
+        let eqt = match value t with App (eqt, _ ) -> eqt | _ -> assert false in
+        let eq_b_a = mk_app eqt [ty; b; a] in
+        let acc2 = List.map (fun cl -> eq_b_a :: cl) acc in
+        let acc1 = List.map (fun cl -> t :: cl) acc in
+        List.rev_append acc2 acc1
+      | _ -> List.map (fun cl -> t :: cl) acc
+    ) [[]] cl
+
+
+      
+let rec normalize_eq_symm p = match app_name p with
+  | Some (n, [ty; a; b]) when n == H.eq && compare_term a b > 0 ->
+    let eqt = match value p with App (eqt, _ ) -> eqt | _ -> assert false in
+    mk_app eqt [ty; b; a]
+  | _ -> match p.value with
+    | App (f, args) ->
+      let nargs = List.map normalize_eq_symm args in
+      if List.for_all2 (==) args nargs then p
+      else mk_app f nargs
+    | Pi (s, x) ->
+      let x' = normalize_eq_symm x in
+      if x == x' then p else mk_pi s x'
+    | Lambda (s, x) ->
+      let x' = normalize_eq_symm x in
+      if x == x' then p else mk_lambda s x'
+    | _ -> p
+
+
+let normalize_clause = List.map normalize_eq_symm
+
+let register_clause_id cl id =
+  HCl.add clauses_ids cl id;
+  Hashtbl.add ids_clauses id cl
+
+(* let register_clause_id cl id = *)
+(*   List.iter (fun cl -> register_clause_id cl id) *)
+(*     (clause_mod_eqsymm cl) *)
+
+
+let new_clause_id ?(reuse=true) cl =
+ let cl = normalize_clause cl in
+  try
+    if not reuse then raise Not_found;
+    OldCl (HCl.find clauses_ids cl)
+  with Not_found ->
+    (* eprintf "new clause : [%a]@." (fun fmt -> List.iter (fprintf fmt "%a, " Ast.print_term)) cl; *)
+    incr cl_cpt;
+    let id = !cl_cpt in
+    register_clause_id cl id;
+    NewCl id
+
+
+let mk_clause ?(reuse=true) rule cl args =
+  match new_clause_id ~reuse cl with
+  | NewCl id ->
+    fprintf fmt "%d:(%s %a%a)@." id (get_rule rule) print_clause cl
+      (fun fmt -> List.iter (fprintf fmt " %d")) args;
+    id
+  | OldCl id -> id
+
+
+let mk_clause_cl = mk_clause
+
+
+let mk_input name formula =
+  let cl = [formula] in
+  match new_clause_id cl with
+   | NewCl id ->
+     register_clause_id cl id;
+     HS.add inputs name id;
+     fprintf fmt "%d:(input (%a))@." id print_term formula
+   | OldCl _ -> ()
+
+
+let mk_admit_preproc name formula =
+  let cl = [formula] in
+  match new_clause_id cl with
+   | NewCl id ->
+     register_clause_id cl id;
+     HS.add inputs name id;
+     fprintf fmt "%d:(hole (%a))@." id print_term formula
+   | OldCl _ -> ()
+
+
+let register_prop_abstr vt formula = HT.add propvars vt formula
+
+
+let get_clause_id cl = HCl.find clauses_ids cl
+
+
+let get_input_id h = HS.find inputs h
+
+
+let register_decl name formula =
+  let cl = [formula] in
+  match new_clause_id cl with
+  | NewCl id | OldCl id -> HS.add inputs name id
+
+
+let register_decl_id name id = HS.add inputs name id
+
+
+let register_alias name_index t = HS.add alias_tbl name_index t
+
+
+(* let register_termalias a t = HT.add termalias_tbl a t *)
+
+
+let clear () =
+  HCl.clear clauses_ids;
+  Hashtbl.clear ids_clauses;
+  HT.clear propvars;
+  HT.clear sharp_tbl;
+  HS.clear inputs;
+  HS.clear alias_tbl;
+  (* HT.clear termalias_tbl; *)
+  cl_cpt := 0;
+  cpt := 0
+  
diff --git a/src/lia/Lia.v b/src/lia/Lia.v
index dbd3b9c..cafac1b 100644
--- a/src/lia/Lia.v
+++ b/src/lia/Lia.v
@@ -1,31 +1,19 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
-Require Import Bool.
-Require Import List.
-Require Import Int63.
-Require Import PArray.
-Require Import RingMicromega.
-Require Import ZMicromega.
-Require Import Tauto.
-Require Import Psatz.
+Require Import Bool List Int63 PArray.
+Require Import Misc State SMT_terms Euf.
 
-Require Import Misc State.
-Require Import SMT_terms.
-Require Import SMTCoq.euf.Euf.
+Require Import RingMicromega ZMicromega Tauto Psatz.
 
 Local Open Scope array_scope.
 Local Open Scope int63_scope.
@@ -265,6 +253,7 @@ Section certif.
               end
             | None => None
           end
+        | Form.FbbT _ _ => None
       end.
 
   End Build_form.
@@ -365,7 +354,7 @@ Section certif.
 
   Section Proof.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -377,8 +366,11 @@ Section certif.
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
 
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
+
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
     Local Notation t_interp := (t_interp t_i t_func t_atom).
 
@@ -393,17 +385,17 @@ Section certif.
 
     Let def_t_form : default t_form = Form.Ftrue.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
     Qed.
 
     Let wf_t_form : Form.wf t_form.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto.
     Qed.
 
     Let wf_rho : Valuation.wf rho.
     Proof.
-      destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto.
+      destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto.
     Qed.
 
     Lemma build_positive_atom_aux_correct :
@@ -446,7 +438,7 @@ Section certif.
     Proof.
      intros a z.
      destruct a;simpl;try discriminate;auto.
-     destruct c;[discriminate | intros Heq;inversion Heq;trivial].
+     destruct c;[discriminate | intros Heq;inversion Heq;trivial | discriminate].
      destruct u;try discriminate;
        case_eq (build_positive i);try discriminate;
        intros p Hp Heq;inversion Heq;clear Heq;subst;
@@ -682,10 +674,10 @@ Opaque build_z_atom interp_aux.
      case a;simpl;
        try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
 
-     intros u; destruct u; intros j vm vm' pe _H_ Hlt Ht;
+     intros u; destruct u; intros jind vm vm' pe _H_ Hlt Ht;
        try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
-     generalize (Hb j vm vm').
-     destruct (build_pexpr vm j) as (vm0, pe0); intro W1.
+     generalize (Hb jind vm vm').
+     destruct (build_pexpr vm jind) as (vm0, pe0); intro W1.
      intros Heq Hwf;inversion Heq;clear Heq;subst.
      assert (W:= W1 pe0 Hlt Ht (refl_equal _) Hwf).
      decompose [and] W;clear W W1.
@@ -786,10 +778,10 @@ Transparent build_z_atom.
 Opaque build_z_atom interp_aux.
      case a;simpl;
        try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
-     intro u; destruct u; intros i vm vm' pe Ht;
+     intro u; destruct u; intros ind vm vm' pe Ht;
        try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
-     generalize (Hb i vm); clear Hb.
-     destruct (build_pexpr vm i) as (vm0,pe0); intro IH.
+     generalize (Hb ind vm); clear Hb.
+     destruct (build_pexpr vm ind) as (vm0,pe0); intro IH.
      intros Heq Hwf;inversion Heq;clear Heq;subst.
      assert (W:= IH vm' pe0 Ht (refl_equal _) Hwf).
      decompose [and] W;clear W IH.
@@ -1007,7 +999,6 @@ Transparent build_z_atom.
       destruct t0;inversion H13;clear H13;subst.
       simpl.
       apply (Z.eqb_eq (Zeval_expr (interp_vmap vm') pe1) (Zeval_expr (interp_vmap vm') pe2)).
-
     Qed.
 
     Lemma build_formula_correct :
@@ -1037,7 +1028,7 @@ Transparent build_z_atom.
 
 
     Lemma build_not2_pos_correct : forall vm f l i,
-      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l -> bounded_bformula (fst vm) (build_not2 i f) /\ (Form.interp interp_form_hatom t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (build_not2 i f)).
+      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l -> bounded_bformula (fst vm) (build_not2 i f) /\ (Form.interp interp_form_hatom interp_form_hatom_bv t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (build_not2 i f)).
     Proof.
       simpl; intros vm f l i H1 H2 H3; split; unfold build_not2.
       apply fold_ind; auto.
@@ -1050,7 +1041,7 @@ Transparent build_z_atom.
 
 
     Lemma build_not2_neg_correct : forall vm f l i,
-      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l = false -> bounded_bformula (fst vm) (N (build_not2 i f)) /\ (Form.interp interp_form_hatom t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (N (build_not2 i f))).
+      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l = false -> bounded_bformula (fst vm) (N (build_not2 i f)) /\ (Form.interp interp_form_hatom interp_form_hatom_bv t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (N (build_not2 i f))).
     Proof.
       simpl; intros vm f l i H1 H2 H3; split; unfold build_not2.
       apply fold_ind; auto.
@@ -1124,9 +1115,9 @@ Transparent build_z_atom.
             nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
             nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
           bounded_bformula (fst vm') bf /\
-          (Form.interp interp_form_hatom t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+          (Form.interp interp_form_hatom interp_form_hatom_bv t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
     Proof.
-      unfold build_hform; intros build_var Hbv [h| | |i l|l|l|l|a b|a b|a b c] vm vm' bf; try discriminate.
+      unfold build_hform; intros build_var Hbv [h| | |i l|l|l|l|a b|a b|a b c|a ls] vm vm' bf; try discriminate.
       (* Fatom *)
       case_eq (build_formula vm h); try discriminate; intros [vm0 f] Heq H1 H2; inversion H1; subst vm0; subst bf; apply build_formula_correct; auto.
       (* Ftrue *)
@@ -1259,7 +1250,7 @@ Transparent build_z_atom.
       (Var.interp rho v <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
     Proof.
       unfold build_var; apply foldi_down_cont_ind; try discriminate.
-      intros i cont _ Hlen Hrec v vm vm' bf; unfold is_true; intros H1 H2; replace (Var.interp rho v) with (Form.interp interp_form_hatom t_form (t_form.[v])).
+      intros i cont _ Hlen Hrec v vm vm' bf; unfold is_true; intros H1 H2; replace (Var.interp rho v) with (Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form.[v])).
       apply (build_hform_correct cont); auto.
       unfold Var.interp; rewrite <- wf_interp_form; auto.
     Qed.
@@ -1275,7 +1266,7 @@ Transparent build_z_atom.
         nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
         nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
       bounded_bformula (fst vm') bf /\
-      (Form.interp interp_form_hatom t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+      (Form.interp interp_form_hatom interp_form_hatom_bv t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
     Proof. apply build_hform_correct; apply build_var_correct. Qed.
 
 
@@ -1293,7 +1284,7 @@ Transparent build_z_atom.
     Proof.
       unfold build_nlit; intros l vm vm' bf; case_eq (build_form vm (t_form .[ Lit.blit (Lit.neg l)])); try discriminate.
       intros [vm1 f] Heq H1 H2; inversion H1; subst vm1; subst bf; case_eq (Lit.is_pos (Lit.neg l)); intro Heq2.
-      replace (negb (Lit.interp rho l)) with (Form.interp interp_form_hatom t_form (t_form .[ Lit.blit (Lit.neg l)])).
+      replace (negb (Lit.interp rho l)) with (Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form .[ Lit.blit (Lit.neg l)])).
       apply build_form_correct; auto.
       unfold Lit.interp; replace (Lit.is_pos l) with false.
       rewrite negb_involutive; unfold Var.interp; rewrite <- wf_interp_form; auto; rewrite Lit.blit_neg; auto.
@@ -1495,9 +1486,9 @@ Transparent build_z_atom.
      unfold C.valid;rewrite H5.
      apply ZTautoChecker_sound with c;trivial.
      apply C.interp_true.
-     destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+     destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form);trivial.
      intros _;apply C.interp_true.
-     destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+     destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form);trivial.
    Qed.
 
 
@@ -1610,3 +1601,11 @@ Transparent build_z_atom.
  End Proof.
 
 End certif.
+
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/lia/lia.ml b/src/lia/lia.ml
index e5f2fe9..adeed4e 100644
--- a/src/lia/lia.ml
+++ b/src/lia/lia.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -160,6 +156,7 @@ let rec smt_Form_to_coq_micromega_formula tbl l =
           failwith "Lia.smt_Form_to_coq_micromega_formula: wrong number of arguments for Fnot2"
         else
           smt_Form_to_coq_micromega_formula tbl l.(0)
+      | FbbT _ -> assert false
       | Fapp (Fforall _, _) -> assert false
   in
   if Form.is_pos l then v
diff --git a/src/lia/lia.mli b/src/lia/lia.mli
index 3c8e582..93361f2 100644
--- a/src/lia/lia.mli
+++ b/src/lia/lia.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val pos_of_int : int -> Structures.Micromega_plugin_Micromega.positive
 val z_of_int : int -> Structures.Micromega_plugin_Micromega.z
 type my_tbl = { tbl : (SmtAtom.hatom, int) Hashtbl.t; mutable count : int; }
diff --git a/src/smtlib2/sExpr.ml b/src/smtlib2/sExpr.ml
new file mode 100644
index 0000000..b130d45
--- /dev/null
+++ b/src/smtlib2/sExpr.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+type t = Atom of string | List of t list
+
+let rec print fmt = function
+  | Atom s -> Format.pp_print_string fmt s
+  | List l ->
+    Format.fprintf fmt "(@[<hov 2>";
+    List.iter (Format.fprintf fmt "%a " print) l;
+    Format.fprintf fmt "@])"
diff --git a/src/smtlib2/sExpr.mli b/src/smtlib2/sExpr.mli
new file mode 100644
index 0000000..26ea9fb
--- /dev/null
+++ b/src/smtlib2/sExpr.mli
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Type of S-expressions *)
+type t = Atom of string | List of t list
+
+val print : Format.formatter -> t -> unit
diff --git a/src/smtlib2/sExprLexer.mll b/src/smtlib2/sExprLexer.mll
new file mode 100644
index 0000000..6d0cd22
--- /dev/null
+++ b/src/smtlib2/sExprLexer.mll
@@ -0,0 +1,297 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* Lexer for S-expressions
+   
+   Adapted from the OCaml sexplib, which is part of the ocaml-core
+   alternative standard library for OCaml.
+
+*)
+
+{
+  (** Lexer: Lexer Specification for S-expressions *)
+
+  open Printf
+  open Lexing
+  open SExprParser
+
+  let char_for_backslash = function
+    | 'n' -> '\010'
+    | 'r' -> '\013'
+    | 'b' -> '\008'
+    | 't' -> '\009'
+    | c -> c
+
+  let lf = '\010'
+
+  let dec_code c1 c2 c3 =
+    100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48)
+
+  let hex_code c1 c2 =
+    let d1 = Char.code c1 in
+    let val1 =
+      if d1 >= 97 then d1 - 87
+      else if d1 >= 65 then d1 - 55
+      else d1 - 48 in
+    let d2 = Char.code c2 in
+    let val2 =
+      if d2 >= 97 then d2 - 87
+      else if d2 >= 65 then d2 - 55
+      else d2 - 48 in
+    val1 * 16 + val2
+
+  let found_newline ({ lex_curr_p; _ } as lexbuf) diff =
+    lexbuf.lex_curr_p <-
+      {
+        lex_curr_p with
+        pos_lnum = lex_curr_p.pos_lnum + 1;
+        pos_bol = lex_curr_p.pos_cnum - diff;
+      }
+
+  (* same length computation as in [Lexing.lexeme] *)
+  let lexeme_len { lex_start_pos; lex_curr_pos; _ } = lex_curr_pos - lex_start_pos
+
+  let main_failure lexbuf msg =
+    let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_start_p lexbuf in
+    let msg =
+      sprintf
+        "Sexplib.Lexer.main: %s at line %d char %d"
+        msg pos_lnum (pos_cnum - pos_bol)
+    in
+    failwith msg
+}
+
+let lf = '\010'
+let lf_cr = ['\010' '\013']
+let dos_newline = "\013\010"
+let blank = [' ' '\009' '\012']
+let unquoted = [^ ';' '(' ')' '"'] # blank # lf_cr
+let digit = ['0'-'9']
+let hexdigit = digit | ['a'-'f' 'A'-'F']
+
+let unquoted_start =
+  unquoted # ['#' '|'] | '#' unquoted # ['|'] | '|' unquoted # ['#']
+
+rule main buf = parse
+  | lf | dos_newline { found_newline lexbuf 0; main buf lexbuf }
+  | blank+ | ';' (_ # lf_cr)* { main buf lexbuf }
+  | '(' { LPAREN }
+  | ')' { RPAREN }
+  | '"'
+      {
+        scan_string buf (lexeme_start_p lexbuf) lexbuf;
+        let str = Buffer.contents buf in
+        Buffer.clear buf;
+        STRING str
+      }
+  | "#;" { HASH_SEMI }
+  | "#|"
+      {
+        scan_block_comment buf [lexeme_start_p lexbuf] lexbuf;
+        main buf lexbuf
+      }
+  | "|#" { main_failure lexbuf "illegal end of comment" }
+  | '|'
+    {
+      scan_quoted buf (lexeme_start_p lexbuf) lexbuf;
+      let str = Buffer.contents buf in
+      Buffer.clear buf;
+      STRING ("|"^ str ^"|")
+    }
+  | unquoted_start unquoted* ("#|" | "|#") unquoted*
+      { main_failure lexbuf "comment tokens in unquoted atom" }
+  | "#" | unquoted_start unquoted* as str { STRING str }
+  | eof { EOF }
+
+and scan_string buf start = parse
+  | '"' { () }
+  | '\\' lf [' ' '\t']*
+      {
+        found_newline lexbuf (lexeme_len lexbuf - 2);
+        scan_string buf start lexbuf
+      }
+  | '\\' dos_newline [' ' '\t']*
+      {
+        found_newline lexbuf (lexeme_len lexbuf - 3);
+        scan_string buf start lexbuf
+      }
+  | '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] as c)
+      {
+        Buffer.add_char buf (char_for_backslash c);
+        scan_string buf start lexbuf
+      }
+  | '\\' (digit as c1) (digit as c2) (digit as c3)
+      {
+        let v = dec_code c1 c2 c3 in
+        if v > 255 then (
+          let { pos_lnum; pos_bol; pos_cnum; _ } = lexeme_end_p lexbuf in
+          let msg =
+            sprintf
+              "Sexplib.Lexer.scan_string: \
+               illegal escape at line %d char %d: `\\%c%c%c'"
+              pos_lnum (pos_cnum - pos_bol - 3)
+              c1 c2 c3 in
+          failwith msg);
+        Buffer.add_char buf (Char.chr v);
+        scan_string buf start lexbuf
+      }
+  | '\\' 'x' (hexdigit as c1) (hexdigit as c2)
+      {
+        let v = hex_code c1 c2 in
+        Buffer.add_char buf (Char.chr v);
+        scan_string buf start lexbuf
+      }
+  | '\\' (_ as c)
+      {
+        Buffer.add_char buf '\\';
+        Buffer.add_char buf c;
+        scan_string buf start lexbuf
+      }
+  | lf
+      {
+        found_newline lexbuf 0;
+        Buffer.add_char buf lf;
+        scan_string buf start lexbuf
+      }
+  | ([^ '\\' '"'] # lf)+
+      {
+        Buffer.add_string buf (lexeme lexbuf);
+        scan_string buf start lexbuf
+      }
+  | eof
+      {
+        let msg =
+          sprintf
+            "Sexplib.Lexer.scan_string: unterminated string at line %d char %d"
+            start.pos_lnum (start.pos_cnum - start.pos_bol)
+        in
+        failwith msg
+      }
+
+and scan_quoted buf start = parse
+  | '|' { () }
+  | '\\' lf [' ' '\t']*
+      {
+        found_newline lexbuf (lexeme_len lexbuf - 2);
+        scan_quoted buf start lexbuf
+      }
+  | '\\' dos_newline [' ' '\t']*
+      {
+        found_newline lexbuf (lexeme_len lexbuf - 3);
+        scan_quoted buf start lexbuf
+      }
+  | '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' ' '|'] as c)
+      {
+        Buffer.add_char buf (char_for_backslash c);
+        scan_quoted buf start lexbuf
+      }
+  | '\\' (digit as c1) (digit as c2) (digit as c3)
+      {
+        let v = dec_code c1 c2 c3 in
+        if v > 255 then (
+          let { pos_lnum; pos_bol; pos_cnum; _ } = lexeme_end_p lexbuf in
+          let msg =
+            sprintf
+              "Sexplib.Lexer.scan_quoted: \
+               illegal escape at line %d char %d: `\\%c%c%c'"
+              pos_lnum (pos_cnum - pos_bol - 3)
+              c1 c2 c3 in
+          failwith msg);
+        Buffer.add_char buf (Char.chr v);
+        scan_quoted buf start lexbuf
+      }
+  | '\\' 'x' (hexdigit as c1) (hexdigit as c2)
+      {
+        let v = hex_code c1 c2 in
+        Buffer.add_char buf (Char.chr v);
+        scan_quoted buf start lexbuf
+      }
+  | '\\' (_ as c)
+      {
+        Buffer.add_char buf '\\';
+        Buffer.add_char buf c;
+        scan_quoted buf start lexbuf
+      }
+  | lf
+      {
+        found_newline lexbuf 0;
+        Buffer.add_char buf lf;
+        scan_quoted buf start lexbuf
+      }
+  | ([^ '\\' '|'] # lf)+
+      {
+        Buffer.add_string buf (lexeme lexbuf);
+        scan_quoted buf start lexbuf
+      }
+  | eof
+      {
+        let msg =
+          sprintf
+            "Sexplib.Lexer.scan_quoted: unterminated ident at line %d char %d"
+            start.pos_lnum (start.pos_cnum - start.pos_bol)
+        in
+        failwith msg
+      }
+
+and scan_block_comment buf locs = parse
+  | ('#'* | '|'*) lf
+      { found_newline lexbuf 0; scan_block_comment buf locs lexbuf }
+  | (('#'* | '|'*) [^ '"' '#' '|'] # lf)+ { scan_block_comment buf locs lexbuf }
+  | ('#'* | '|'*) '"'
+      {
+        let cur = lexeme_end_p lexbuf in
+        let start = { cur with pos_cnum = cur.pos_cnum - 1 } in
+        scan_string buf start lexbuf;
+        Buffer.clear buf;
+        scan_block_comment buf locs lexbuf
+      }
+  | '#'+ '|'
+    {
+      let cur = lexeme_end_p lexbuf in
+      let start = { cur with pos_cnum = cur.pos_cnum - 2 } in
+      scan_block_comment buf (start :: locs) lexbuf
+    }
+  | '|'+ '#'
+      {
+        match locs with
+        | [_] -> ()
+        | _ :: t -> scan_block_comment buf t lexbuf
+        | [] -> assert false  (* impossible *)
+      }
+  | eof
+      {
+        match locs with
+        | [] -> assert false
+        | { pos_lnum; pos_bol; pos_cnum; _ } :: _ ->
+            let msg =
+              sprintf "Sexplib.Lexer.scan_block_comment: \
+                unterminated block comment at line %d char %d"
+                pos_lnum (pos_cnum - pos_bol)
+            in
+            failwith msg
+      }
+
+and ruleTail acc = parse
+  | eof { acc }
+  | _* as str { ruleTail (acc ^ str) lexbuf }
+
+  
+{
+  let main ?buf =
+    let buf =
+      match buf with
+      | None -> Buffer.create 64
+      | Some buf -> Buffer.clear buf; buf
+    in
+    main buf
+}
+
diff --git a/src/smtlib2/sExprParser.mly b/src/smtlib2/sExprParser.mly
new file mode 100644
index 0000000..6e3eb77
--- /dev/null
+++ b/src/smtlib2/sExprParser.mly
@@ -0,0 +1,86 @@
+%{
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* Parser for S-expressions
+   
+   Code lightly adapted from the OCaml sexplib, which is part of the
+   ocaml-core alternative standard library for OCaml.
+
+*)
+
+  (** Parser: Grammar Specification for Parsing S-expressions *)
+
+  open Lexing
+
+  let parse_failure what =
+    let pos = symbol_start_pos () in
+    let msg =
+      Printf.sprintf "SExprParser: failed to parse line %d char %d: %s"
+        pos.pos_lnum (pos.pos_cnum - pos.pos_bol) what in
+    failwith msg
+%}
+
+%token <string> STRING
+%token LPAREN RPAREN HASH_SEMI EOF
+
+%start sexp
+%type <SExpr.t> sexp
+
+%start sexp_opt
+%type <SExpr.t option> sexp_opt
+
+%start sexps
+%type <SExpr.t list> sexps
+
+%start rev_sexps
+%type <SExpr.t list> rev_sexps
+
+%%
+
+sexp:
+| sexp_comments sexp_but_no_comment { $2 }
+| sexp_but_no_comment { $1 }
+
+sexp_but_no_comment
+  : STRING { SExpr.Atom $1 }
+  | LPAREN RPAREN { SExpr.List [] }
+  | LPAREN rev_sexps_aux RPAREN { SExpr.List (List.rev $2) }
+  | error { parse_failure "sexp" }
+
+sexp_comment
+  : HASH_SEMI sexp_but_no_comment { () }
+  | HASH_SEMI sexp_comments sexp_but_no_comment { () }
+
+sexp_comments
+  : sexp_comment { () }
+  | sexp_comments sexp_comment { () }
+
+sexp_opt
+  : sexp_but_no_comment { Some $1 }
+  | sexp_comments sexp_but_no_comment { Some $2 }
+  | EOF { None }
+  | sexp_comments EOF { None }
+
+rev_sexps_aux
+  : sexp_but_no_comment { [$1] }
+  | sexp_comment { [] }
+  | rev_sexps_aux sexp_but_no_comment { $2 :: $1 }
+  | rev_sexps_aux sexp_comment { $1 }
+
+rev_sexps
+  : rev_sexps_aux EOF { $1 }
+  | EOF { [] }
+
+sexps
+  : rev_sexps_aux EOF { List.rev $1 }
+  | EOF { [] }
diff --git a/src/smtlib2/smtlib2_ast.ml b/src/smtlib2/smtlib2_ast.ml
index cce4625..7317b60 100644
--- a/src/smtlib2/smtlib2_ast.ml
+++ b/src/smtlib2/smtlib2_ast.ml
@@ -15,6 +15,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+
 open Smtlib2_util
 
 type loc = Lexing.position * Lexing.position
@@ -187,3 +188,68 @@ let loc_varbinding = function
 let loc_couple = fst
 
 let loc_of e = loc_commands e;;
+
+
+
+let print_specconstant fmt = function
+  | SpecConstsDec (_, s)
+  | SpecConstNum (_, s)
+  | SpecConstString (_, s)
+  | SpecConstsHex (_, s)
+  | SpecConstsBinary (_, s) -> Format.pp_print_string fmt s
+
+
+let print_symbol fmt = function
+  | Symbol (_, s)
+  | SymbolWithOr (_, s) -> Format.pp_print_string fmt s
+
+
+let print_identifier fmt = function
+  | IdSymbol (_, s) -> print_symbol fmt s
+  | IdUnderscoreSymNum (_, s, (_, l)) ->
+    Format.fprintf fmt "(_ %a" print_symbol s;
+    List.iter (Format.fprintf fmt " %s") l;
+    Format.fprintf fmt ")"  
+    
+let rec print_sort fmt = function
+  | SortIdentifier (_, i) -> print_identifier fmt i
+  | SortIdSortMulti (_, i, (_, ls)) ->
+    Format.fprintf fmt "(%a" print_identifier i;
+    List.iter (Format.fprintf fmt " %a" print_sort) ls;
+    Format.fprintf fmt ")"  
+
+let print_qualidentifier fmt = function
+  | QualIdentifierId (_, i) -> print_identifier fmt i
+  | QualIdentifierAs (_, i, s) ->
+    Format.fprintf fmt "(%a as %a)"
+      print_identifier i print_sort s 
+
+let print_sortedvar fmt = function
+  | SortedVarSymSort (_, v, s) ->
+    Format.fprintf fmt "(%a %a)" print_symbol v print_sort s
+
+let rec print_varbinding fmt = function
+  | VarBindingSymTerm (_, s, t) ->
+    Format.fprintf fmt "(%a %a)" print_symbol s print_term t
+
+and print_term fmt = function
+  | TermSpecConst (_, c) -> print_specconstant fmt c
+  | TermQualIdentifier (_, i) -> print_qualidentifier fmt i
+  | TermQualIdTerm (_, i, (_, tl)) ->
+    Format.fprintf fmt "(%a" print_qualidentifier i;
+    List.iter (Format.fprintf fmt " %a" print_term) tl;
+    Format.fprintf fmt ")"  
+  | TermLetTerm (_, (_, vb), t) ->
+    Format.fprintf fmt "(let (";
+    List.iter (Format.fprintf fmt " %a" print_varbinding) vb;
+    Format.fprintf fmt ") %a)" print_term t
+  | TermForAllTerm (_, (_, sv), t) ->
+    Format.fprintf fmt "(forall (";
+    List.iter (Format.fprintf fmt " %a" print_sortedvar) sv;
+    Format.fprintf fmt ") %a)" print_term t
+  | TermExistsTerm (_, (_, sv), t) ->
+    Format.fprintf fmt "(exists (";
+    List.iter (Format.fprintf fmt " %a" print_sortedvar) sv;
+    Format.fprintf fmt ") %a)" print_term t
+  | TermExclimationPt (_, t, _) -> print_term fmt t
+
diff --git a/src/smtlib2/smtlib2_ast.mli b/src/smtlib2/smtlib2_ast.mli
index 4fb1280..3d3f126 100644
--- a/src/smtlib2/smtlib2_ast.mli
+++ b/src/smtlib2/smtlib2_ast.mli
@@ -1,3 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq, originally belong to The Alt-ergo theorem prover           *)
+(*     Copyright (C) 2006-2010                                            *)
+(*                                                                        *)
+(*     Sylvain Conchon                                                    *)
+(*     Evelyne Contejean                                                  *)
+(*     Stephane Lescuyer                                                  *)
+(*     Mohamed Iguernelala                                                *)
+(*     Alain Mebsout                                                      *)
+(*                                                                        *)
+(*     CNRS - INRIA - Universite Paris Sud                                *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 type loc = Lexing.position * Lexing.position
 type specconstant =
     SpecConstsDec of loc * string
diff --git a/src/smtlib2/smtlib2_genConstr.ml b/src/smtlib2/smtlib2_genConstr.ml
index 76dde25..692294d 100644
--- a/src/smtlib2/smtlib2_genConstr.ml
+++ b/src/smtlib2/smtlib2_genConstr.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -42,45 +38,72 @@ let identifier_of_qualidentifier = function
   | QualIdentifierId (_,id) | QualIdentifierAs (_,id,_) -> id
 
 
-let string_type s = match s with
-  | "Bool" -> Tbool
-  | "Int" -> TZ
-  | _ -> VeritSyntax.get_btype s
-
+let string_type s =
+  match s with
+  | "Bool" -> fun _ -> Tbool
+  | "Int" -> fun _ -> TZ
+  | "Array" -> (function [ti;te] -> TFArray (ti, te) | _ -> assert false)
+  | _ ->
+    try Scanf.sscanf s "BitVec_%d%!" (fun size -> fun _ -> TBV size)
+    with _ -> fun _ -> VeritSyntax.get_btype s
 
-let sort_of_string s = (string_type s, [])
+let sort_of_string s = string_type s
 
 
 let sort_of_symbol s = sort_of_string (string_of_symbol s)
 
 
+let rec bigint_binary_size acc i size =
+  let open Big_int in
+  if size = 0 then "#b" ^ String.concat "" acc
+  else
+  if eq_big_int i zero_big_int then
+    bigint_binary_size ("0" :: acc) i (size - 1)
+  else begin
+    assert (gt_big_int i zero_big_int && size > 0);
+    bigint_binary_size (string_of_big_int (and_big_int i unit_big_int) :: acc)
+      (shift_right_big_int i 1) (size - 1)
+  end
+
+let bigint_bv i size = bigint_binary_size [] i size
+
+
+exception DecimalBv of string
+
 let string_of_identifier = function
   | IdSymbol (_,s) -> (string_of_symbol s)
   | IdUnderscoreSymNum (_,s,(_,l)) ->
-    List.fold_left (fun c c' -> c^"_"^c') (string_of_symbol s) l
+    let s = string_of_symbol s in
+    let isbvdec =
+      try s.[0] = 'b' && s.[1]= 'v' with Invalid_argument _ -> false in
+    (match isbvdec, l with
+     (* rewrite bitvectors decimal constants *)
+     | true, [size] ->
+       let sbv =
+         Scanf.sscanf s "bv%s" (fun n ->
+             bigint_bv (Big_int.big_int_of_string n) (int_of_string size)) in
+       raise (DecimalBv sbv)
+     | _ -> List.fold_left (fun c c' -> c^"_"^c') s l
+    )
 
 
 let string_of_qualidentifier id = string_of_identifier (identifier_of_qualidentifier id)
 
 
 let rec sort_of_sort = function
-  | SortIdentifier (_,id) -> sort_of_string (string_of_identifier id)
+  | SortIdentifier (_,id) -> sort_of_string (string_of_identifier id) []
   | SortIdSortMulti (_,id,(_,l)) ->
-    (string_type (string_of_identifier id), List.map sort_of_sort l)
+    sort_of_string (string_of_identifier id) (List.map sort_of_sort l)
 
 
 let declare_sort rt sym =
   let s = string_of_symbol sym in
   let cons_t = declare_new_type (Names.id_of_string ("Smt_sort_"^s)) in
-  let eq_t = declare_new_variable (Names.id_of_string ("eq_"^s)) (Term.mkArrow cons_t (Term.mkArrow cons_t (Lazy.force cbool))) in
-  let x = mkName "x" in
-  let y = mkName "y" in
-  let rx = Term.mkRel 2 in
-  let ry = Term.mkRel 1 in
-  let eq_refl = Term.mkProd (x,cons_t,Term.mkProd (y,cons_t,mklApp creflect [|mklApp ceq [|cons_t;rx;ry|];mklApp (lazy eq_t) [|rx;ry|]|])) in
-  let eq_refl_v = declare_new_variable (Names.id_of_string ("eq_refl_"^s)) eq_refl in
-  let ce = mklApp cTyp_eqb [|cons_t;eq_t;eq_refl_v|] in
-  let res = declare rt cons_t ce in
+  let compdec_type = mklApp cCompDec [| cons_t |] in
+  let compdec_var =
+    declare_new_variable (Names.id_of_string ("CompDec_"^s)) compdec_type in
+  let ce = mklApp cTyp_compdec [|cons_t; compdec_var|] in
+  let res = SmtBtype.declare rt cons_t ce in
   VeritSyntax.add_btype s res;
   res
 
@@ -89,15 +112,27 @@ let declare_fun rt ro sym arg cod =
   let s = string_of_symbol sym in
   let tyl = List.map sort_of_sort arg in
   let ty = sort_of_sort cod in
-
-  let coqTy = List.fold_right (fun typ c -> Term.mkArrow (interp_to_coq rt (fst typ)) c) tyl (interp_to_coq rt (fst ty)) in
+  let coqTy = List.fold_right (fun typ c ->
+      Term.mkArrow (interp_to_coq rt typ) c)
+      tyl (interp_to_coq rt ty) in
   let cons_v = declare_new_variable (Names.id_of_string ("Smt_var_"^s)) coqTy in
-
-  let op = Op.declare ro cons_v (Array.of_list (List.map fst tyl)) (fst ty) None in
+  let op = Op.declare ro cons_v (Array.of_list tyl) ty None in
   VeritSyntax.add_fun s op;
   op
 
 
+
+let parse_smt2bv s =
+  let l = ref [] in
+  for i = 2 to String.length s - 1 do
+    match s.[i] with
+    | '0' -> l := false :: !l
+    | '1' -> l := true :: !l
+    | _ -> failwith "Not a bitvector"
+  done;
+  !l
+
+
 let make_root_specconstant ra = function
   | SpecConstsDec _ -> failwith "Smtlib2_genConstr.make_root_specconstant: decimals not implemented yet"
   | SpecConstNum (_,s) ->
@@ -110,11 +145,15 @@ let make_root_specconstant ra = function
         Atom.hatom_Z_of_bigint ra i)
   | SpecConstString _ -> failwith "Smtlib2_genConstr.make_root_specconstant: strings not implemented yet"
   | SpecConstsHex _ -> failwith "Smtlib2_genConstr.make_root_specconstant: hexadecimals not implemented yet"
-  | SpecConstsBinary _ -> failwith "Smtlib2_genConstr.make_root_specconstant: binaries not implemented yet"
+  | SpecConstsBinary (_, s) -> Atom.mk_bvconst ra (parse_smt2bv s)
+
+
 
 
 type atom_form = | Atom of SmtAtom.Atom.t | Form of SmtAtom.Form.t
 
+let startwith prefix s =
+  try Scanf.sscanf s (prefix ^^ "%_s") true with _ -> false
 
 let make_root ra rf t =
 
@@ -122,11 +161,14 @@ let make_root ra rf t =
 
   let rec make_root_term = function
     | TermSpecConst (_,c) -> Atom (make_root_specconstant ra c)
-    | TermQualIdentifier (_,id) ->
-      let v = string_of_qualidentifier id in
-      (try Hashtbl.find hlets v with
-        | Not_found ->
-          make_root_app v [])
+    | TermQualIdentifier (loc,id) ->
+      (try
+        let v = string_of_qualidentifier id in
+        (try Hashtbl.find hlets v with Not_found -> make_root_app v [])
+       with
+       | DecimalBv sbv ->
+         make_root_term (TermSpecConst (loc, SpecConstsBinary (loc, sbv)))
+      )
     | TermQualIdTerm (_,id,(_,l)) ->
       let v = string_of_qualidentifier id in
       make_root_app v l
@@ -144,43 +186,162 @@ let make_root ra rf t =
     match (v,l) with
       | "=", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' ->
-            (match Atom.type_of a' with
-              | Tbool -> Form (Form.get rf (Fapp (Fiff, [|Form.get rf (Fatom a'); Form.get rf (Fatom b')|])))
-              | ty -> Atom (Atom.mk_eq ra true ty a' b'))
-          | _, _ -> assert false)
+         | Atom a', Atom b' when Atom.type_of a' <> Tbool ->
+           Atom (Atom.mk_eq ra (Atom.type_of a') a' b')
+         | _ -> Form (Form.get rf (Fapp (Fiff, [|make_root a; make_root b|])))
+        )
       | "<", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_lt ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_lt ra a' b')
           | _, _ -> assert false)
       | "<=", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_le ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_le ra a' b')
           | _, _ -> assert false)
       | ">", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_gt ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_gt ra a' b')
           | _, _ -> assert false)
       | ">=", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_ge ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_ge ra a' b')
           | _, _ -> assert false)
       | "+", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_plus ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_plus ra a' b')
           | _, _ -> assert false)
       | "-", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_minus ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_minus ra a' b')
           | _, _ -> assert false)
       | "*", [a;b] ->
         (match make_root_term a, make_root_term b with
-          | Atom a', Atom b' -> Atom (Atom.mk_mult ra true a' b')
+          | Atom a', Atom b' -> Atom (Atom.mk_mult ra a' b')
           | _, _ -> assert false)
       | "-", [a] ->
         (match make_root_term a with
           | Atom a' -> Atom (Atom.mk_opp ra a')
           | _ -> assert false)
+      | "bvnot", [a] ->
+        (match make_root_term a with
+          | Atom a' ->
+             (match Atom.type_of a' with
+               | TBV s -> Atom (Atom.mk_bvnot ra s a')
+               | _ -> assert false)
+          | _ -> assert false)
+      | "bvneg", [a] ->
+        (match make_root_term a with
+          | Atom a' ->
+             (match Atom.type_of a' with
+               | TBV s -> Atom (Atom.mk_bvneg ra s a')
+               | _ -> assert false)
+          | _ -> assert false)
+      | "bvand", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' ->
+             (match Atom.type_of a' with
+               | TBV s -> Atom (Atom.mk_bvand ra s a' b')
+               | _ -> assert false)
+          | _, _ -> assert false)
+      | "bvor", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' ->
+             (match Atom.type_of a' with
+               | TBV s -> Atom (Atom.mk_bvor ra s a' b')
+               | _ -> assert false)
+          | _, _ -> assert false)
+      | "bvxor", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvxor ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvadd", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvadd ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvmul", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvmult ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvult", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvult ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvslt", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvslt ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvule", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom h1, Atom h2 ->
+           (match Atom.type_of h1 with
+            | TBV s ->
+              let a = Atom.mk_bvult ra s h2 h1 in
+              Form (Form.neg (Form.get rf (Fatom a)))
+            | _ -> assert false)
+         | _,_ -> assert false
+        )
+      | "bvsle", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom h1, Atom h2 ->
+           (match Atom.type_of h1 with
+            | TBV s ->
+              let a = Atom.mk_bvslt ra s h2 h1 in
+              Form (Form.neg (Form.get rf (Fatom a)))
+            | _ -> assert false)
+         | _,_ -> assert false
+        )
+      | "bvshl", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvshl ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "bvlshr", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a' with
+            | TBV s -> Atom (Atom.mk_bvshr ra s a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "concat", [a;b] ->
+        (match make_root_term a, make_root_term b with
+         | Atom a', Atom b' ->
+           (match Atom.type_of a', Atom.type_of b' with
+            | TBV s1, TBV s2 -> Atom (Atom.mk_bvconcat ra s1 s2 a' b')
+            | _ -> assert false)
+         | _, _ -> assert false)
+      | "select", [a;i] ->
+        (match make_root_term a, make_root_term i with
+         | Atom a', Atom i' ->
+           (match Atom.type_of a' with
+            | TFArray (ti, te) -> Atom (Atom.mk_select ra ti te a' i')
+            | _ -> assert false)
+         | _ -> assert false)
+
+      | "store", [a;i;v] ->
+        (match make_root_term a, make_root_term i, make_root_term v with
+         | Atom a', Atom i', Atom v' ->
+           (match Atom.type_of a' with
+            | TFArray (ti, te) -> Atom (Atom.mk_store ra ti te a' i' v')
+            | _ -> assert false)
+         | _ -> assert false)
+
       | "distinct", _ ->
         let make_h h =
           match make_root_term h with
@@ -205,10 +366,49 @@ let make_root ra rf t =
       | "ite", _ ->
         Form (Form.get rf (Fapp (Fite, Array.of_list (List.map make_root l))))
       | "not", [a] -> Form (Form.neg (make_root a))
+
+      | _, [a] when startwith "extract_" v ->
+        (try
+          Scanf.sscanf v "extract_%s@_%d" (fun s i ->
+            let j = int_of_string s in
+            (match make_root_term a with
+             | Atom a' ->
+               (match Atom.type_of a' with
+                | TBV s -> Atom (Atom.mk_bvextr ra ~s ~i ~n:(j-i+1) a')
+                | _ -> assert false)
+             | _ -> assert false)
+             )
+         with _ -> assert false)
+
+      | _, [a] when startwith "zero_extend_" v ->
+        (try
+           Scanf.sscanf v "zero_extend_%d" (fun n ->
+               (match make_root_term a with
+                | Atom a' ->
+                  (match Atom.type_of a' with
+                   | TBV s -> Atom (Atom.mk_bvzextn ra ~s ~n a')
+                   | _ -> assert false)
+                | _ -> assert false)
+             )
+         with _ -> assert false)
+
+      | _, [a] when startwith "sign_extend_" v ->
+        (try
+           Scanf.sscanf v "sign_extend_%d" (fun n ->
+               (match make_root_term a with
+                | Atom a' ->
+                  (match Atom.type_of a' with
+                   | TBV s -> Atom (Atom.mk_bvsextn ra ~s ~n a')
+                   | _ -> assert false)
+                | _ -> assert false)
+             )
+         with _ -> assert false)
+
       | _, _ ->
         let op = VeritSyntax.get_fun v in
-        let l' = List.map (fun t -> match make_root_term t with
-          | Atom h -> h | Form _ -> assert false) l in
+        let l' = List.map (fun t ->
+            match make_root_term t with
+            | Atom h -> h | Form _ -> assert false) l in
         Atom (Atom.get ra (Aapp (op, Array.of_list l')))
 
   and make_root t =
diff --git a/src/smtlib2/smtlib2_genConstr.mli b/src/smtlib2/smtlib2_genConstr.mli
index 1aa992e..40f73c7 100644
--- a/src/smtlib2/smtlib2_genConstr.mli
+++ b/src/smtlib2/smtlib2_genConstr.mli
@@ -1,32 +1,17 @@
-val pp_symbol : Smtlib2_ast.symbol -> string
-val string_of_symbol : Smtlib2_ast.symbol -> string
-val identifier_of_qualidentifier :
-  Smtlib2_ast.qualidentifier -> Smtlib2_ast.identifier
-val string_type : string -> SmtBtype.btype
-val sort_of_string : string -> SmtBtype.btype * 'a list
-val sort_of_symbol : Smtlib2_ast.symbol -> SmtBtype.btype * 'a list
-val string_of_identifier : Smtlib2_ast.identifier -> string
-val string_of_qualidentifier : Smtlib2_ast.qualidentifier -> string
-val sort_of_sort : Smtlib2_ast.sort -> (SmtBtype.btype * 'a list as 'a)
-val declare_sort :
-  SmtBtype.reify_tbl -> Smtlib2_ast.symbol -> SmtBtype.btype
-val declare_fun :
-  SmtBtype.reify_tbl ->
-  SmtAtom.Op.reify_tbl ->
-  Smtlib2_ast.symbol ->
-  Smtlib2_ast.sort list -> Smtlib2_ast.sort -> SmtAtom.indexed_op
-val make_root_specconstant :
-  SmtAtom.Atom.reify_tbl -> Smtlib2_ast.specconstant -> SmtAtom.hatom
-type atom_form = Atom of SmtAtom.Atom.t | Form of SmtAtom.Form.t
-val make_root :
-  SmtAtom.Atom.reify_tbl ->
-  SmtAtom.Form.reify -> Smtlib2_ast.term -> SmtAtom.Form.t
-val declare_commands :
-  SmtBtype.reify_tbl ->
-  SmtAtom.Op.reify_tbl ->
-  SmtAtom.Atom.reify_tbl ->
-  SmtAtom.Form.reify ->
-  SmtAtom.Form.t list -> Smtlib2_ast.command -> SmtAtom.Form.t list
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+val parse_smt2bv : string -> bool list
+val bigint_bv : Big_int.big_int -> int -> string
 val import_smtlib2 :
   SmtBtype.reify_tbl ->
   SmtAtom.Op.reify_tbl ->
diff --git a/src/smtlib2/smtlib2_lex.mll b/src/smtlib2/smtlib2_lex.mll
index f235403..2b965af 100644
--- a/src/smtlib2/smtlib2_lex.mll
+++ b/src/smtlib2/smtlib2_lex.mll
@@ -15,6 +15,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+
 {
 open Lexing
 open Smtlib2_parse
diff --git a/src/smtlib2/smtlib2_parse.mly b/src/smtlib2/smtlib2_parse.mly
index b4e02a7..d618a1a 100644
--- a/src/smtlib2/smtlib2_parse.mly
+++ b/src/smtlib2/smtlib2_parse.mly
@@ -15,6 +15,7 @@
 /*                                                                        */
 /**************************************************************************/
 
+
 %{
    open Smtlib2_ast
 
@@ -23,6 +24,8 @@
 %}
 
 %start main
+%start term
+%start sort
 
 /* general */
 %token EXCLIMATIONPT
diff --git a/src/smtlib2/smtlib2_solver.ml b/src/smtlib2/smtlib2_solver.ml
new file mode 100644
index 0000000..3ee8229
--- /dev/null
+++ b/src/smtlib2/smtlib2_solver.ml
@@ -0,0 +1,169 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Format
+  
+type result = Sat | Unsat
+
+type t = {
+  cmd : string array;
+  pid : int;
+  stdin : Unix.file_descr;
+  stdout : Unix.file_descr;
+  stderr : Unix.file_descr;
+  lexbuf : Lexing.lexbuf;
+}
+
+
+let create cmd =
+  let executable = cmd.(0) in
+
+  (* Create pipes for input, output and error output *)
+  let stdin_in, stdin_out = Unix.pipe () in
+  let stdout_in, stdout_out = Unix.pipe () in 
+  let stderr_in, stderr_out = Unix.pipe () in 
+
+  (* Create solver process *)
+  let pid = 
+    Unix.create_process 
+      executable 
+      cmd 
+      stdin_in
+      stdout_out
+      stderr_out
+  in
+
+  (* Close our end of the pipe which has been duplicated by the
+     process *)
+  Unix.close stdin_in;
+  Unix.close stdout_out; 
+  Unix.close stderr_out; 
+
+  (* Get an output channel to read from solver's stdout *)
+  let stdout_ch = Unix.in_channel_of_descr stdout_in in
+
+  let lexbuf = Lexing.from_channel stdout_ch in
+
+  (* Create the solver instance *)
+  { cmd; pid;
+    stdin = stdin_out; stdout = stdout_in; stderr = stderr_in; lexbuf }
+
+
+let kill s =
+  try
+    Unix.close s.stdin;
+    Unix.close s.stdout;
+    Unix.close s.stderr;
+    Unix.kill s.pid Sys.sigkill;
+  with _ -> ()
+
+
+let read_response { lexbuf } = 
+  SExprParser.sexp SExprLexer.main lexbuf 
+
+
+let error s sexp =
+  kill s;
+  Structures.error (asprintf "Solver error: %a." SExpr.print sexp)
+
+
+let read_success s = 
+  match SExprParser.sexp SExprLexer.main s.lexbuf with
+  | SExpr.Atom "success" -> ()
+  | r -> error s r
+
+
+let no_response _ = ()
+
+
+let read_check_result s = 
+  match SExprParser.sexp SExprLexer.main s.lexbuf with
+  | SExpr.Atom "sat" -> Sat
+  | SExpr.Atom "unsat" -> Unsat
+  | SExpr.Atom "unknown" -> Structures.error ("Solver returned uknown.")
+  | r -> error s r
+
+
+let send_command s cmd read =
+  eprintf "%s@." cmd;
+  let err_p1 = Unix.((fstat s.stderr).st_size) in
+  try
+    let in_ch = Unix.out_channel_of_descr s.stdin in
+    let fmt = formatter_of_out_channel in_ch in
+    pp_print_string fmt cmd;
+    pp_print_newline fmt ();
+    read s
+  with e ->
+    let err_p2 = Unix.((fstat s.stderr).st_size) in
+    let len = err_p2 - err_p1 in
+    (* Was something written to stderr? *)
+    if len <> 0 then begin
+      let buf = Bytes.create err_p2 in
+      Unix.read s.stderr buf 0 err_p2 |> ignore;
+      let err_msg = Bytes.sub_string buf err_p1 len in
+      Structures.error ("Solver error: "^err_msg);
+    end
+    else (kill s; raise e)
+
+
+let set_option s name b =
+  send_command s
+    (asprintf "(set-option :%s %b)" name b)
+    read_success
+
+
+let set_logic s l =
+  send_command s
+    (sprintf "(set-logic %s)" l)
+    read_success
+
+
+let declare_sort s name arity =
+  send_command s
+    (asprintf "(declare-sort %s %d)" name arity)
+    read_success
+
+
+let declare_fun s name args ret =
+  send_command s
+    (asprintf "(declare-fun %s (%a) %s)"
+       name
+       (fun fmt -> List.iter (fprintf fmt "%s ")) args
+       ret)
+    read_success
+  
+
+let assume s f =
+  send_command s
+    (sprintf "(assert %s)" f)
+    read_success
+
+
+let check_sat s =
+  send_command s "(check-sat)" read_check_result
+
+
+let get_proof s process_proof =
+  send_command s "(get-proof)" (fun s -> process_proof s.lexbuf)
+
+
+let get_model s =
+  send_command s "(get-model)" read_response
+
+
+let quit s =
+  try
+    send_command s "(exit)" read_success;
+  with Unix.Unix_error _ -> ();
+  kill s
+
+
diff --git a/src/smtlib2/smtlib2_solver.mli b/src/smtlib2/smtlib2_solver.mli
new file mode 100644
index 0000000..3a7f2fc
--- /dev/null
+++ b/src/smtlib2/smtlib2_solver.mli
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+type t
+
+type result = Sat | Unsat
+
+val create : string array -> t
+
+val send_command : t -> string -> (t -> 'a) -> 'a
+
+val set_option : t -> string -> bool -> unit
+
+val set_logic : t -> string -> unit
+
+val declare_sort : t -> string -> int -> unit
+
+val declare_fun : t -> string -> string list -> string -> unit
+
+val assume : t -> string -> unit
+
+val check_sat : t -> result
+
+val get_proof : t -> (Lexing.lexbuf -> 'a) -> 'a
+
+val get_model : t -> SExpr.t
+
+val quit : t -> unit
+
+
diff --git a/src/smtlib2/smtlib2_util.ml b/src/smtlib2/smtlib2_util.ml
index 1ce5e46..d503145 100644
--- a/src/smtlib2/smtlib2_util.ml
+++ b/src/smtlib2/smtlib2_util.ml
@@ -15,6 +15,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+
 (* auto-generated by gt *)
 
 (* no extra data from grammar file. *)
diff --git a/src/smtlib2/smtlib2_util.mli b/src/smtlib2/smtlib2_util.mli
index 8afbce3..b4e8916 100644
--- a/src/smtlib2/smtlib2_util.mli
+++ b/src/smtlib2/smtlib2_util.mli
@@ -1,3 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq, originally belong to The Alt-ergo theorem prover           *)
+(*     Copyright (C) 2006-2010                                            *)
+(*                                                                        *)
+(*     Sylvain Conchon                                                    *)
+(*     Evelyne Contejean                                                  *)
+(*     Stephane Lescuyer                                                  *)
+(*     Mohamed Iguernelala                                                *)
+(*     Alain Mebsout                                                      *)
+(*                                                                        *)
+(*     CNRS - INRIA - Universite Paris Sud                                *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 type extradata = unit
 val initial_data : unit -> unit
 val file : string ref
diff --git a/src/spl/Arithmetic.v b/src/spl/Arithmetic.v
index 8ec41ab..05c999d 100644
--- a/src/spl/Arithmetic.v
+++ b/src/spl/Arithmetic.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,8 +12,6 @@
 
 (*** Spl -- a small checker for simplifications ***)
 
-(* Add LoadPath ".." as SMTCoq. *)
-(* Add LoadPath "../lia" as SMTCoq.lia. *)
 Require Import List PArray Bool Int63 ZMicromega.
 Require Import Misc State SMT_terms.
 Require Lia.
@@ -52,7 +46,7 @@ Section Arith.
 
   Section Valid.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -60,12 +54,14 @@ Section Arith.
 
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
 
     Let wf_rho : Valuation.wf rho.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto. Qed.
 
     Hint Immediate wf_rho.
 
diff --git a/src/spl/Assumptions.v b/src/spl/Assumptions.v
index b3dee4b..b219da4 100644
--- a/src/spl/Assumptions.v
+++ b/src/spl/Assumptions.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -78,17 +74,18 @@ End Checker.
 
 Section Checker_correct.
 
-  Variable t_i : array typ_eqb.
+  Variable t_i : array SMT_classes.typ_compdec.
   Variable t_func : array (Atom.tval t_i).
   Variable t_atom : array Atom.atom.
   Variable t_form : array Form.form.
 
-  Local Notation rho := (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form).
+  Local Notation rho := (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) (Atom.interp_form_hatom_bv t_i t_func t_atom) t_form).
 
   Variable s : S.t.
   Hypothesis Hs : S.valid rho s.
   Hypothesis Ht3 : Valuation.wf
           (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom)
+                                 (Atom.interp_form_hatom_bv t_i t_func t_atom)
              t_form).
 
   Lemma interp_check_clause c1 : forall c2,
@@ -124,6 +121,7 @@ Section Checker_correct.
   Variable concl : C.t.
   Hypothesis p : interp_conseq_uf
         (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom)
+                               (Atom.interp_form_hatom_bv t_i t_func t_atom)
            t_form) prem concl.
 
   Lemma valid_check_hole: C.valid rho (check_hole s prem_id prem concl).
diff --git a/src/spl/Operators.v b/src/spl/Operators.v
index c597fe9..f0aba15 100644
--- a/src/spl/Operators.v
+++ b/src/spl/Operators.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,8 +12,6 @@
 
 (*** Spl -- a small checker for simplifications ***)
 
-(* Add LoadPath ".." as SMTCoq. *)
-(* Add LoadPath "../lia" as SMTCoq.lia. *)
 Require Import List PArray Bool Int63 ZMicromega.
 Require Import Misc State SMT_terms.
 
@@ -171,9 +165,16 @@ Section Operators.
           (get_atom a = Atom.Abop (Atom.BO_eq A) x y \/
             get_atom a = Atom.Abop (Atom.BO_eq A) y x))).
   Proof.
-    intros A dist diseq; unfold check_diseqs; rewrite andb_true_iff, PArray.forallb_spec, check_diseqs_complete_spec, length_mapi; split; intros [H1 H2]; split.
-    clear H2; intros i Hi; generalize (H1 _ Hi); rewrite get_mapi; auto; case_eq (Lit.is_pos (diseq .[ i])); try discriminate; intro Heq1; case_eq (get_form (Lit.blit (diseq .[ i]))); try discriminate; intros a Heq2; case_eq (get_atom a); try discriminate; intros [ | | | | | | |B]; try discriminate; intros h1 h2 Heq3; case_eq (Typ.eqb A B); try discriminate; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try discriminate; rewrite eqb_false_spec; intro H2; case_eq (check_in h1 dist); try discriminate; case_eq (check_in h2 dist); try discriminate; rewrite !check_in_spec; intros H3 H4 _; split; try discriminate; exists a; split; auto; exists h1, h2; repeat split; auto; rewrite <- In2_In; auto.
-    clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 H4]]; clear H2; rewrite get_mapi in H4; auto; exists i; split; auto; generalize H4; case_eq (Lit.is_pos (diseq .[ i])); intro Heq; try (intros [H|H]; discriminate); case_eq (get_form (Lit.blit (diseq .[ i]))); [intros a| | |intros a1 a2|intros a1|intros a1|intros a1|intros a1 a2|intros a1 a2|intros a1 a2 a3]; intro Heq2; try (intros [H|H]; discriminate); case_eq (get_atom a); [intros a1|intros a1 a2|intros [ | | | | | | |B] h1 h2|intros a1 a2|intros a1 a2]; intro Heq3; try (intros [H|H]; discriminate); case_eq (Typ.eqb A B); try (intros _ [H|H]; discriminate); change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try (intros _ [H|H]; discriminate); rewrite eqb_false_spec; intro H10; case (check_in h1 dist); try (intros [H|H]; discriminate); case (check_in h2 dist); try (intros [H|H]; discriminate); simpl; intro H3; split; try discriminate; exists a; split; auto; destruct H3 as [H3|H3]; inversion H3; subst; auto.
+    intros A dist diseq; unfold check_diseqs; rewrite andb_true_iff,
+     PArray.forallb_spec, check_diseqs_complete_spec, length_mapi; split; intros [H1 H2]; split.
+    clear H2; intros i Hi; generalize (H1 _ Hi); rewrite get_mapi; 
+    auto; case_eq (Lit.is_pos (diseq .[ i])); try discriminate; intro Heq1; case_eq (get_form (Lit.blit (diseq .[ i]))); 
+    try discriminate; intros a Heq2; case_eq (get_atom a); try discriminate; intros [ | | | | | | | B | | | | | | | | | | | | | ]; try discriminate; intros h1 h2 Heq3; case_eq (Typ.eqb A B); try discriminate; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try discriminate; rewrite eqb_false_spec; intro H2; case_eq (check_in h1 dist); try discriminate; case_eq (check_in h2 dist); try discriminate; rewrite !check_in_spec; intros H3 H4 _; split; try discriminate; exists a; split; auto; exists h1, h2; repeat split; auto; rewrite <- In2_In; auto.
+    clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 H4]]; clear H2; rewrite get_mapi in H4; auto; exists i; split; auto; generalize H4; 
+    
+    case_eq (Lit.is_pos (diseq .[ i])); intro Heq; try (intros [H|H]; discriminate); case_eq (get_form (Lit.blit (diseq .[ i]))); [intros a| | |intros a1 a2|intros a1|intros a1|intros a1|intros a1 a2|intros a1 a2| intros a1 a2 a3|intros a ls]; intro Heq2; try (intros [H|H]; discriminate); case_eq (get_atom a); [intros a1|intros a1 a2|intros [ | | | | | | | B | | | | | | | | | | | | | ] h1 h2|intros a1 a2|intros a1 a2 | intros a1 a2]; intro Heq3; try (intros [H|H]; discriminate); try (case_eq (Typ.eqb A B); try (intros _ [H|H]; discriminate); change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try (intros _ [H|H]; discriminate); rewrite eqb_false_spec; intro H10; case (check_in h1 dist); try (intros [H|H]; discriminate); case (check_in h2 dist); try (intros [H|H]; discriminate); simpl; intro H3; split; try discriminate; exists a; split; auto; destruct H3 as [H3|H3]; inversion H3; subst; auto).
+intros. destruct H0; now contradict H0.
+    
     clear H2; intros i Hi; rewrite get_mapi; auto; destruct (H1 _ Hi) as [H2 [a [H3 [h1 [h2 [H4 [H5 H6]]]]]]]; clear H1; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H3, H4, Typ.eqb_refl; simpl; replace (h1 == h2) with false by (case_eq (h1 == h2); auto; rewrite eqb_spec; intro H; elim H5; auto); simpl; rewrite <- In2_In, <- !check_in_spec in H6; auto; destruct H6 as [H6 H7]; rewrite H6, H7; auto.
     clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 [H3 [a [H4 [H6 H5]]]]]]; clear H2; exists i; split; auto; rewrite get_mapi; auto; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H4; assert (H7 := or_introl (In2 y x dist) Hxy); rewrite <- In2_In, <- !check_in_spec in H7; auto; destruct H7 as [H7 H8]; destruct H5 as [H5|H5]; rewrite H5, Typ.eqb_refl; [replace (x == y) with false by (case_eq (x == y); auto; rewrite eqb_spec; auto)|replace (y == x) with false by (case_eq (y == x); auto; rewrite eqb_spec; auto)]; simpl; rewrite H7, H8; auto.
   Qed.
@@ -246,14 +247,14 @@ Section Operators.
        get_atom hb = Atom.Abop (Atom.BO_eq ty) y x).
   Proof.
     intros f1 f2; unfold check_distinct_two_args; split.
-    case (get_form f1); try discriminate; intro ha; case (get_form f2); try discriminate; intro hb; case_eq (get_atom ha); try discriminate; intros [A] [ |x [ |y [ |l]]] Heq1; try discriminate; case_eq (get_atom hb); try discriminate; intros [ | | | | | | |B] x' y' Heq2; try discriminate; rewrite !andb_true_iff, orb_true_iff, !andb_true_iff; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec, !Int63Properties.eqb_spec; intros [H1 [[H2 H3]|[H2 H3]]]; subst B x' y'; exists ha, hb, A, x, y; auto.
+    case (get_form f1); try discriminate; intro ha; case (get_form f2); try discriminate; intro hb; case_eq (get_atom ha); try discriminate; intros [A] [ |x [ |y [ |l]]] Heq1; try discriminate; case_eq (get_atom hb); try discriminate; intros [ | | | | | | |B | | | | | | | | | | | | | ] x' y' Heq2; try discriminate; rewrite !andb_true_iff, orb_true_iff, !andb_true_iff; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec, !Int63Properties.eqb_spec; intros [H1 [[H2 H3]|[H2 H3]]]; subst B x' y'; exists ha, hb, A, x, y; auto.
     intros [ha [hb [A [x [y [H1 [H2 [H3 [H4|H4]]]]]]]]]; rewrite H1, H2, H3, H4, Typ.eqb_refl, !eqb_refl; auto; rewrite orb_true_r; auto.
   Qed.
 
 
   Section Valid1.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -261,8 +262,10 @@ Section Operators.
 
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
     Let wf_t_atom : Atom.wf t_atom.
     Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
@@ -271,10 +274,10 @@ Section Operators.
     Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
 
     Lemma default_t_form : default t_form = Ftrue.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[H _] _]; auto. Qed.
 
     Lemma wf_t_form : wf t_form.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[_ H] _]; auto. Qed.
 
     Local Hint Immediate wf_t_atom default_t_atom default_t_form wf_t_form.
 
@@ -354,7 +357,7 @@ Section Operators.
         | _, _ => false
       end.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -362,8 +365,10 @@ Section Operators.
 
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
     Hypothesis interp_check_var : forall x y,
       check_var x y -> Var.interp rho x = Var.interp rho y.
@@ -395,9 +400,9 @@ Section Operators.
 
     Lemma interp_check_form_aux : forall a b,
       check_form_aux a b ->
-      Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b.
+      Form.interp interp_form_hatom interp_form_hatom_bv t_form a = Form.interp interp_form_hatom interp_form_hatom_bv t_form b.
     Proof.
-      intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3]; simpl; try discriminate;auto.
+      intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3|a l1] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3|b m1]; simpl; try discriminate;auto.
       (* Atom *)
       unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a; auto.
       (* Interesting case *)
@@ -485,7 +490,7 @@ Section Operators.
 
   Section Valid.
 
-    Variables (t_i : array typ_eqb)
+    Variables (t_i : array SMT_classes.typ_compdec)
               (t_func : array (Atom.tval t_i))
               (ch_atom : Atom.check_atom t_atom)
               (ch_form : Form.check_form t_form)
@@ -493,18 +498,20 @@ Section Operators.
 
     Local Notation interp_form_hatom :=
       (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation interp_form_hatom_bv :=
+      (Atom.interp_form_hatom_bv t_i t_func t_atom).
     Local Notation rho :=
-      (Form.interp_state_var interp_form_hatom t_form).
+      (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form).
 
 
     Let wf_rho : Valuation.wf rho.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto. Qed.
 
     Let default_t_form : default t_form = Ftrue.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[H _] _]; auto. Qed.
 
     Let wf_t_form : wf t_form.
-    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed.
+    Proof. destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [[_ H] _]; auto. Qed.
 
     Local Hint Immediate wf_rho default_t_form wf_t_form.
 
@@ -522,7 +529,7 @@ Section Operators.
 
     Lemma interp_check_form : forall a b,
       check_form a b ->
-      Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b.
+      Form.interp interp_form_hatom interp_form_hatom_bv t_form a = Form.interp interp_form_hatom interp_form_hatom_bv t_form b.
     Proof. apply interp_check_form_aux, interp_check_hform; auto. Qed.
 
 
@@ -547,3 +554,11 @@ Section Operators.
   End Valid.
 
 End Operators.
+
+
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/spl/Syntactic.v b/src/spl/Syntactic.v
index 7a52694..cc34522 100644
--- a/src/spl/Syntactic.v
+++ b/src/spl/Syntactic.v
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -15,9 +11,9 @@
 
 
 (*** Spl -- a small checker for simplifications ***)
-
 Require Import List PArray Bool Int63 ZMicromega.
-Require Import Misc State SMT_terms.
+Require Import Misc State SMT_terms BVList.
+Require Lia.
 
 Local Open Scope array_scope.
 Local Open Scope int63_scope.
@@ -29,7 +25,7 @@ Section CheckAtom.
 
   Import Atom.
 
-  Variable t_i : PArray.array typ_eqb.
+  Variable t_i : PArray.array SMT_classes.typ_compdec.
   Variable t_func : PArray.array (tval t_i).
   Variable t_atom : PArray.array atom.
 
@@ -73,6 +69,8 @@ Section CheckAtom.
               Typ.eqb t1 t2 &&
               ((check_hatom a1 b1 && check_hatom a2 b2) ||
                 (check_hatom a1 b2 && check_hatom a2 b1))
+            | BO_BVand s1, BO_BVand s2
+            | BO_BVor s1, BO_BVor s2 => N.eqb s1 s2 && check_hatom a1 b1 && check_hatom a2 b2
             | _, _ => false
           end
         | Anop o1 l1, Anop o2 l2 =>
@@ -112,16 +110,62 @@ Section CheckAtom.
     Lemma check_atom_aux_correct : forall a1 a2, check_atom_aux a1 a2 ->
       interp t_i t_func t_atom a1 = interp t_i t_func t_atom a2.
     Proof.
-      intros [op1|op1 i1|op1 i1 j1|op1 li1|f1 args1]; simpl.
+      intros [op1|op1 i1|op1 i1 j1|op1 li1|op1 li1|f1 args1]; simpl.
       (* Constants *)
-      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; pose (H:=reflect_cop_eqb op1 op2); inversion H; try discriminate; subst op1; auto.
+      - intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; pose (H:=reflect_cop_eqb op1 op2); inversion H; try discriminate; subst op1; auto.
       (* Unary operators *)
-      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; try (case op1; discriminate).
+      - 
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; try (case op1; discriminate).
       case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [_ H]; rewrite (check_hatom_correct _ _ H); auto).
-      case_eq (get_atom i2); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i2), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
-      case_eq (get_atom i1); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite <- (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i1), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
-      (* Binary operators *)
-      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto).
+
+      case_eq (get_atom i2); try discriminate;
+        intros [ | | | | | | | | i0 n0 n1| n i0| n i0] i Heq H; try discriminate; simpl;
+      unfold apply_unop; rewrite (check_hatom_correct _ _ H); 
+      unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i2), Heq; simpl; 
+      unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; 
+      destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
+      case_eq (get_atom i1); try discriminate;
+        intros [ | | | | | | | | i0 n0 n1| n i0| n i0] i Heq H; try discriminate; simpl; 
+      unfold apply_unop. rewrite <- (check_hatom_correct _ _ H); 
+      unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i1), Heq; simpl; 
+      unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; 
+      destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
+
+      intros n m n1 m2. simpl. unfold is_true. rewrite !andb_true_iff, beq_nat_true_iff, N.eqb_eq. intros [[-> ->] H]. rewrite (check_hatom_correct _ _ H); auto.
+      intros n m. simpl. unfold is_true. rewrite andb_true_iff, N.eqb_eq. intros [-> H]. rewrite (check_hatom_correct _ _ H); auto.
+      intros n m. simpl. unfold is_true. rewrite andb_true_iff, N.eqb_eq. intros [-> H]. rewrite (check_hatom_correct _ _ H); auto.
+      (* bv_extr *)
+      intros i n0 n1 i0 n2 n3.
+      unfold is_true. rewrite andb_true_iff.
+      intros. destruct H as (Ha, Hb).
+      inversion Ha.
+      rewrite !andb_true_iff in H0.
+      destruct H0 as ((H0a, H0b), H0c).
+      rewrite N.eqb_eq in H0a, H0b, H0c.
+      subst.
+      rewrite (check_hatom_correct _ _ Hb); auto.
+      (* bv_zextn *)
+      intros n i n0 i0.
+      unfold is_true. rewrite andb_true_iff.
+      intros. destruct H as (Ha, Hb).
+      inversion Ha.
+      rewrite !andb_true_iff in H0.
+      destruct H0 as (H0a, H0b).
+      rewrite N.eqb_eq in H0a, H0b.
+      subst.
+      rewrite (check_hatom_correct _ _ Hb); auto.
+      (* bv_sextn *)
+      intros n i n0 i0.
+      unfold is_true. rewrite andb_true_iff.
+      intros. destruct H as (Ha, Hb).
+      inversion Ha.
+      rewrite !andb_true_iff in H0.
+      destruct H0 as (H0a, H0b).
+      rewrite N.eqb_eq in H0a, H0b.
+      subst.
+      rewrite (check_hatom_correct _ _ Hb); auto.     
+            (* Binary operators *)
+      - intros [op2|op2 i2|op2 i2 j2|op2 li2|op2 li2|f2 args2]; simpl; try discriminate; case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto).
       unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.add_comm; reflexivity.
       unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.mul_comm; reflexivity.
       unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto.
@@ -129,10 +173,18 @@ Section CheckAtom.
       unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.geb_leb; auto.
       unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto.
       intros A B; unfold is_true; rewrite andb_true_iff, orb_true_iff; change (Typ.eqb B A = true) with (is_true (Typ.eqb B A)); rewrite Typ.eqb_spec; intros [H2 [H1|H1]]; subst B; rewrite andb_true_iff in H1; destruct H1 as [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto; simpl; unfold apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v1]; destruct (interp_hatom t_i t_func t_atom i2) as [C v2]; destruct (Typ.cast B A) as [k1| ]; destruct (Typ.cast C A) as [k2| ]; auto; rewrite Typ.i_eqb_sym; auto.
+      intros s1 s2; unfold is_true; rewrite !andb_true_iff, N.eqb_eq;
+        intros [[-> H1] H2];
+        now rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2).
+      intros s1 s2; unfold is_true; rewrite !andb_true_iff, N.eqb_eq;
+        intros [[-> H1] H2];
+        now rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2).
+       (* Ternary operators *)
+     - intros. now contradict H.
       (* N-ary operators *)
-      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; destruct op1 as [t1]; destruct op2 as [t2]; unfold is_true; rewrite andb_true_iff; change (Typ.eqb t1 t2 = true) with (is_true (Typ.eqb t1 t2)); rewrite Typ.eqb_spec; intros [H1 H2]; subst t2; rewrite (list_beq_compute_interp _ _ _ H2); auto.
+      - intros [op2|op2 i2|op2 i2 j2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; destruct op1 as [t1]; destruct op2 as [t2]; unfold is_true; rewrite andb_true_iff; change (Typ.eqb t1 t2 = true) with (is_true (Typ.eqb t1 t2)); rewrite Typ.eqb_spec; intros [H1 H2]; subst t2; rewrite (list_beq_compute_interp _ _ _ H2); auto.
       (* Application *)
-      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H2 H1]; subst f2; rewrite (list_beq_correct _ _ H1); auto.
+      - intros [op2|op2 i2|op2 i2 j2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H2 H1]; subst f2; rewrite (list_beq_correct _ _ H1); auto.
     Qed.
 
   End AUX.
@@ -233,7 +285,10 @@ Section CheckAtom.
     forall h1 h2, check_neg_hatom h1 h2 ->
       interp_form_hatom t_i t_func t_atom h1 = negb (interp_form_hatom t_i t_func t_atom h2).
   Proof.
-    unfold interp_form_hatom. intros Hwt H1 H2 h1 h2 H3. unfold interp_bool. generalize (check_neg_hatom_correct Hwt H1 H2 _ _ H3). case (interp_hatom t_i t_func t_atom h1). case (interp_hatom t_i t_func t_atom h2). simpl. intros [i| | | ] v1 [j| | | ] v2; intro H; inversion H. rewrite Typ.cast_refl. auto.
+    unfold interp_form_hatom. intros Hwt H1 H2 h1 h2 H3. unfold interp_bool. generalize (check_neg_hatom_correct Hwt H1 H2 _ _ H3).
+    case (interp_hatom t_i t_func t_atom h1).
+    case (interp_hatom t_i t_func t_atom h2).
+    simpl. intros [ |i| | | | ] v1 [ |j| | | | ] v2; intro H; inversion H. rewrite Typ.cast_refl. auto.
   Qed.
 
 End CheckAtom.
@@ -344,6 +399,7 @@ Section FLATTEN.
 
   (** Correctness proofs *)
   Variable interp_atom : atom -> bool.
+  Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s.
   Hypothesis default_thf : default t_form = Ftrue.
   Hypothesis wf_thf : wf t_form.
   Hypothesis check_atom_correct :
@@ -351,10 +407,10 @@ Section FLATTEN.
   Hypothesis check_neg_atom_correct :
     forall a1 a2, check_neg_atom a1 a2 -> interp_atom a1 = negb (interp_atom a2).
 
-  Local Notation interp_var := (interp_state_var interp_atom t_form).
+  Local Notation interp_var := (interp_state_var interp_atom interp_bvatom t_form).
   Local Notation interp_lit := (Lit.interp interp_var).
 
-  Lemma interp_Fnot2 : forall i l, interp interp_atom t_form (Fnot2 i l) = interp_lit l.
+  Lemma interp_Fnot2 : forall i l, interp interp_atom interp_bvatom t_form (Fnot2 i l) = interp_lit l.
   Proof.
     intros i l;simpl;apply fold_ind;trivial.
     intros a;rewrite negb_involutive;trivial.
@@ -366,14 +422,14 @@ Section FLATTEN.
     unfold remove_not;intros l.
     case_eq (get_form (Lit.blit l));intros;trivial.
     unfold Lit.interp, Var.interp.
-    rewrite (wf_interp_form interp_atom t_form default_thf wf_thf (Lit.blit l)), H, interp_Fnot2.
+    rewrite (wf_interp_form interp_atom interp_bvatom t_form default_thf wf_thf (Lit.blit l)), H, interp_Fnot2.
     destruct(Lit.is_pos l);trivial.
     rewrite Lit.is_pos_neg, Lit.blit_neg;unfold Lit.interp;destruct (Lit.is_pos i0);trivial.
     rewrite negb_involutive;trivial.
   Qed.
 
   Lemma get_and_correct : forall l args, get_and l = Some args ->
-    interp_lit l = interp interp_atom t_form (Fand args).
+    interp_lit l = interp interp_atom interp_bvatom t_form (Fand args).
   Proof.
     unfold get_and;intros l args.
     rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l).
@@ -384,7 +440,7 @@ Section FLATTEN.
   Qed.
 
   Lemma get_or_correct : forall l args, get_or l = Some args ->
-    interp_lit l = interp interp_atom t_form (For args).
+    interp_lit l = interp interp_atom interp_bvatom t_form (For args).
   Proof.
     unfold get_or;intros l args.
     rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l).
@@ -527,3 +583,9 @@ Section FLATTEN.
   Qed.
 
 End FLATTEN.
+
+(* 
+   Local Variables:
+   coq-load-path: ((rec ".." "SMTCoq"))
+   End: 
+*)
diff --git a/src/trace/coqTerms.ml b/src/trace/coqTerms.ml
index 96d5a69..76f213b 100644
--- a/src/trace/coqTerms.ml
+++ b/src/trace/coqTerms.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,7 +12,8 @@
 
 open Coqlib
 
-let gen_constant modules constant = lazy (gen_constant_in_modules "SMT" modules constant)
+let gen_constant modules constant =
+  lazy (gen_constant_in_modules "SMT" modules constant)
 
 (* Int63 *)
 let cint = Structures.cint
@@ -25,6 +22,11 @@ let ceq63 = gen_constant Structures.int63_modules "eqb"
 (* PArray *)
 let carray = gen_constant Structures.parray_modules "array"
 
+(* nat *)
+let cnat = gen_constant init_modules "nat"
+let cO = gen_constant init_modules "O"
+let cS = gen_constant init_modules "S"
+
 (* Positive *)
 let positive_modules = [["Coq";"Numbers";"BinNums"];
                         ["Coq";"PArith";"BinPosDef";"Pos"]]
@@ -35,6 +37,16 @@ let cxO = gen_constant positive_modules "xO"
 let cxH = gen_constant positive_modules "xH"
 let ceqbP = gen_constant positive_modules "eqb"
 
+(* N *)
+let n_modules = [["Coq";"NArith";"BinNat";"N"]]
+
+let cN = gen_constant positive_modules "N"
+let cN0 = gen_constant positive_modules "N0"
+let cNpos = gen_constant positive_modules "Npos"
+
+let cof_nat = gen_constant n_modules "of_nat"
+
+
 (* Z *)
 let z_modules = [["Coq";"Numbers";"BinNums"];
                  ["Coq";"ZArith";"BinInt"];
@@ -52,7 +64,8 @@ let cltb = gen_constant z_modules "ltb"
 let cleb = gen_constant z_modules "leb"
 let cgeb = gen_constant z_modules "geb"
 let cgtb = gen_constant z_modules "gtb"
-let ceqbZ = gen_constant z_modules "eqb" 
+let ceqbZ = gen_constant z_modules "eqb"
+let cZeqbsym = gen_constant z_modules "eqb_sym"
 
 (* Booleans *)
 let bool_modules = [["Coq";"Bool";"Bool"]]
@@ -67,13 +80,14 @@ let cnegb = gen_constant init_modules "negb"
 let cimplb = gen_constant init_modules "implb"
 let ceqb = gen_constant  bool_modules "eqb"
 let cifb = gen_constant bool_modules "ifb"
+let ciff = gen_constant init_modules "iff"
 let creflect = gen_constant bool_modules "reflect"
 
 (* Lists *)
 let clist = gen_constant init_modules "list"
 let cnil = gen_constant init_modules "nil"
 let ccons = gen_constant init_modules "cons"
-
+let clength = gen_constant init_modules "length"
 
 (* Option *)
 let coption = gen_constant init_modules "option"
@@ -82,9 +96,16 @@ let cNone = gen_constant init_modules "None"
 
 (* Pairs *)
 let cpair = gen_constant init_modules "pair"
+let cprod = gen_constant init_modules "prod"
 
 (* Dependent pairs *)
 let csigT = gen_constant init_modules "sigT"
+let cprojT1 = gen_constant init_modules "projT1"
+let cprojT2 = gen_constant init_modules "projT2"
+let cprojT3 = gen_constant init_modules "projT3"
+
+let csigT2 = gen_constant init_modules "sigT2"
+let csigT_of_sigT2 = gen_constant init_modules "sigT_of_sigT2"
 
 (* Logical Operators *)
 let cnot = gen_constant init_modules "not"
@@ -93,8 +114,43 @@ let crefl_equal = gen_constant init_modules "eq_refl"
 let cconj = gen_constant init_modules "conj"
 let cand = gen_constant init_modules "and"
 
-(* SMT_terms *)
+(* Bit vectors *)
+let bv_modules = [["SMTCoq";"bva";"BVList";"BITVECTOR_LIST"]]
+let cbitvector = gen_constant bv_modules "bitvector"
+let cof_bits = gen_constant bv_modules "of_bits"
+let c_of_bits = gen_constant bv_modules "_of_bits"
+let cbitOf = gen_constant bv_modules "bitOf"
+let cbv_eq = gen_constant bv_modules "bv_eq"
+let cbv_not = gen_constant bv_modules "bv_not"
+let cbv_neg = gen_constant bv_modules "bv_neg"
+let cbv_and = gen_constant bv_modules "bv_and"
+let cbv_or = gen_constant bv_modules "bv_or"
+let cbv_xor = gen_constant bv_modules "bv_xor"
+let cbv_add = gen_constant bv_modules "bv_add"
+let cbv_mult = gen_constant bv_modules "bv_mult"
+let cbv_ult = gen_constant bv_modules "bv_ult"
+let cbv_slt = gen_constant bv_modules "bv_slt"
+let cbv_concat = gen_constant bv_modules "bv_concat"
+let cbv_extr = gen_constant bv_modules "bv_extr"
+let cbv_zextn = gen_constant bv_modules "bv_zextn"
+let cbv_sextn = gen_constant bv_modules "bv_sextn"
+let cbv_shl = gen_constant bv_modules "bv_shl"
+let cbv_shr = gen_constant bv_modules "bv_shr"
+
+
+(* Arrays *)
+let array_modules = [["SMTCoq";"array";"FArray"]]
+let cfarray = gen_constant array_modules "FArray.farray"
+let cselect = gen_constant array_modules "select"
+let cstore = gen_constant array_modules "store"
+let cdiff = gen_constant array_modules "diff"
+let cequalarray = gen_constant array_modules "FArray.equal"
+
+(* OrderedType *)
+let cOrderedTypeCompare =
+  gen_constant [["Coq";"Structures";"OrderedType"]] "Compare"
 
+(* SMT_terms *)
 let smt_modules = [ ["SMTCoq";"Misc"];
 		    ["SMTCoq";"State"];
 		    ["SMTCoq";"SMT_terms"];
@@ -104,6 +160,7 @@ let smt_modules = [ ["SMTCoq";"Misc"];
 		  ]
 
 let cState_C_t = gen_constant [["SMTCoq";"State";"C"]] "t"
+let cState_S_t = gen_constant [["SMTCoq";"State";"S"]] "t"
 
 let cdistinct = gen_constant smt_modules "distinct"
 
@@ -111,26 +168,56 @@ let ctype = gen_constant smt_modules "type"
 let cTZ = gen_constant smt_modules "TZ"
 let cTbool = gen_constant smt_modules "Tbool"
 let cTpositive = gen_constant smt_modules "Tpositive"
+let cTBV = gen_constant smt_modules "TBV"
+let cTFArray = gen_constant smt_modules "TFArray"
 let cTindex = gen_constant smt_modules "Tindex"
 
-let ctyp_eqb = gen_constant smt_modules "typ_eqb"
-let cTyp_eqb = gen_constant smt_modules "Typ_eqb"
-let cte_carrier = gen_constant smt_modules "te_carrier"
-let cte_eqb = gen_constant smt_modules "te_eqb"
-let ctyp_eqb_of_typ_eqb_param = gen_constant smt_modules "typ_eqb_of_typ_eqb_param"
-let cunit_typ_eqb = gen_constant smt_modules "unit_typ_eqb"
+let ct_i = gen_constant smt_modules "t_i"
+let cinterp_t = gen_constant smt_modules "Typ.interp"
+let cdec_interp = gen_constant smt_modules "dec_interp"
+let cord_interp = gen_constant smt_modules "ord_interp"
+let ccomp_interp = gen_constant smt_modules "comp_interp"
+let cinh_interp = gen_constant smt_modules "inh_interp"
+
+let cinterp_eqb = gen_constant smt_modules "i_eqb"
+let cinterp_eqb_eqb = gen_constant smt_modules "i_eqb_eqb"
+
+let classes_modules = [["SMTCoq";"classes";"SMT_classes"];
+                       ["SMTCoq";"classes";"SMT_classes_instances"]]
+
+let ctyp_compdec = gen_constant classes_modules "typ_compdec"
+let cTyp_compdec = gen_constant classes_modules "Typ_compdec"
+let ctyp_compdec_from = gen_constant classes_modules "typ_compdec_from"
+let cunit_typ_compdec = gen_constant classes_modules "unit_typ_compdec"
+let cte_carrier = gen_constant classes_modules "te_carrier"
+let cte_compdec = gen_constant classes_modules "te_compdec"
+let ceqb_of_compdec = gen_constant classes_modules "eqb_of_compdec"
+let cCompDec = gen_constant classes_modules "CompDec"
+
+let cbool_compdec = gen_constant classes_modules "bool_compdec"
+let cZ_compdec = gen_constant classes_modules "Z_compdec"
+let cPositive_compdec = gen_constant classes_modules "Positive_compdec"
+let cBV_compdec = gen_constant classes_modules "BV_compdec"
+let cFArray_compdec = gen_constant classes_modules "FArray_compdec"
 
 let ctval =  gen_constant smt_modules "tval"
 let cTval =  gen_constant smt_modules "Tval"
 
 let cCO_xH = gen_constant smt_modules "CO_xH"
 let cCO_Z0 = gen_constant smt_modules "CO_Z0"
+let cCO_BV = gen_constant smt_modules "CO_BV"
 
 let cUO_xO = gen_constant smt_modules "UO_xO"
 let cUO_xI = gen_constant smt_modules "UO_xI"
 let cUO_Zpos = gen_constant smt_modules "UO_Zpos"
 let cUO_Zneg = gen_constant smt_modules "UO_Zneg"
 let cUO_Zopp = gen_constant smt_modules "UO_Zopp"
+let cUO_BVbitOf = gen_constant smt_modules "UO_BVbitOf"
+let cUO_BVnot = gen_constant smt_modules "UO_BVnot"
+let cUO_BVneg = gen_constant smt_modules "UO_BVneg"
+let cUO_BVextr = gen_constant smt_modules "UO_BVextr"
+let cUO_BVzextn = gen_constant smt_modules "UO_BVzextn"
+let cUO_BVsextn = gen_constant smt_modules "UO_BVsextn"
 
 let cBO_Zplus = gen_constant smt_modules "BO_Zplus"
 let cBO_Zminus = gen_constant smt_modules "BO_Zminus"
@@ -140,6 +227,20 @@ let cBO_Zle = gen_constant smt_modules "BO_Zle"
 let cBO_Zge = gen_constant smt_modules "BO_Zge"
 let cBO_Zgt = gen_constant smt_modules "BO_Zgt"
 let cBO_eq = gen_constant smt_modules "BO_eq"
+let cBO_BVand = gen_constant smt_modules "BO_BVand"
+let cBO_BVor = gen_constant smt_modules "BO_BVor"
+let cBO_BVxor = gen_constant smt_modules "BO_BVxor"
+let cBO_BVadd = gen_constant smt_modules "BO_BVadd"
+let cBO_BVmult = gen_constant smt_modules "BO_BVmult"
+let cBO_BVult = gen_constant smt_modules "BO_BVult"
+let cBO_BVslt = gen_constant smt_modules "BO_BVslt"
+let cBO_BVconcat = gen_constant smt_modules "BO_BVconcat"
+let cBO_BVshl = gen_constant smt_modules "BO_BVshl"
+let cBO_BVshr = gen_constant smt_modules "BO_BVshr"
+let cBO_select = gen_constant smt_modules "BO_select"
+let cBO_diffarray = gen_constant smt_modules "BO_diffarray"
+
+let cTO_store = gen_constant smt_modules "TO_store"
 
 let cNO_distinct = gen_constant smt_modules "NO_distinct"
 
@@ -147,6 +248,7 @@ let catom = gen_constant smt_modules "atom"
 let cAcop = gen_constant smt_modules "Acop"
 let cAuop = gen_constant smt_modules "Auop"
 let cAbop = gen_constant smt_modules "Abop"
+let cAtop = gen_constant smt_modules "Atop"
 let cAnop = gen_constant smt_modules "Anop"
 let cAapp = gen_constant smt_modules "Aapp"
 
@@ -161,6 +263,7 @@ let cFxor = gen_constant smt_modules "Fxor"
 let cFimp = gen_constant smt_modules "Fimp"
 let cFiff = gen_constant smt_modules "Fiff"
 let cFite = gen_constant smt_modules "Fite"
+let cFbbT = gen_constant smt_modules "FbbT"
 
 let cis_true = gen_constant smt_modules "is_true"
 
@@ -172,26 +275,160 @@ let make_certif_ops modules args =
     match args with
       | Some args -> lazy (SmtMisc.mklApp (gen_constant modules c) args)
       | None -> gen_constant modules c in
- (gen_constant "step", 
-  gen_constant "Res", gen_constant "ImmFlatten", 
-  gen_constant "CTrue", gen_constant "CFalse", 
-  gen_constant "BuildDef", gen_constant "BuildDef2", 
-  gen_constant "BuildProj", 
-  gen_constant "ImmBuildProj", gen_constant"ImmBuildDef", 
+ (gen_constant "step",
+  gen_constant "Res", gen_constant "Weaken", gen_constant "ImmFlatten",
+  gen_constant "CTrue", gen_constant "CFalse",
+  gen_constant "BuildDef", gen_constant "BuildDef2",
+  gen_constant "BuildProj",
+  gen_constant "ImmBuildProj", gen_constant"ImmBuildDef",
   gen_constant"ImmBuildDef2",
-  gen_constant "EqTr", gen_constant "EqCgr", gen_constant "EqCgrP", 
-  gen_constant "LiaMicromega", gen_constant "LiaDiseq", gen_constant "SplArith", gen_constant "SplDistinctElim",
+  gen_constant "EqTr", gen_constant "EqCgr", gen_constant "EqCgrP",
+  gen_constant "LiaMicromega", gen_constant "LiaDiseq",
+  gen_constant "SplArith", gen_constant "SplDistinctElim",
+  gen_constant "BBVar", gen_constant "BBConst",
+  gen_constant "BBOp", gen_constant "BBNot", gen_constant "BBEq",
+  gen_constant "BBDiseq",
+  gen_constant "BBNeg", gen_constant "BBAdd", gen_constant "BBMul",
+  gen_constant "BBUlt", gen_constant "BBSlt", gen_constant "BBConcat",
+  gen_constant "BBExtract", gen_constant "BBZextend", gen_constant "BBSextend",
+  gen_constant "BBShl", gen_constant "BBShr",
+  gen_constant "RowEq", gen_constant "RowNeq", gen_constant "Ext",
   gen_constant "Hole", gen_constant "ForallInst")
-  
 
-(** Useful construction *)
 
-let ceq_refl_true = 
+(** Useful constructions *)
+
+let ceq_refl_true =
   lazy (SmtMisc.mklApp crefl_equal [|Lazy.force cbool;Lazy.force ctrue|])
 
 let eq_refl_true () = Lazy.force ceq_refl_true
 
-let vm_cast_true t = 
+let vm_cast_true_no_check t =
   Term.mkCast(eq_refl_true (),
-	      Term.VMcast, 
-	      SmtMisc.mklApp ceq [|Lazy.force cbool; t; Lazy.force ctrue|])
+              Term.VMcast,
+              SmtMisc.mklApp ceq [|Lazy.force cbool; t; Lazy.force ctrue|])
+
+(* This version checks convertibility right away instead of delaying it at
+   Qed. This allows to report issues to the user as soon as he/she runs one of
+   SMTCoq's tactics. *)
+let vm_cast_true env t =
+  try
+    Structures.vm_conv Reduction.CUMUL env
+      (SmtMisc.mklApp ceq
+         [|Lazy.force cbool; Lazy.force ctrue; Lazy.force ctrue|])
+      (SmtMisc.mklApp ceq [|Lazy.force cbool; t; Lazy.force ctrue|]);
+    vm_cast_true_no_check t
+  with Reduction.NotConvertible ->
+    Structures.error ("SMTCoq was not able to check the proof certificate.")
+
+
+(* Compute a nat *)
+let rec mkNat = function
+  | 0 -> Lazy.force cO
+  | i -> SmtMisc.mklApp cS [|mkNat (i-1)|]
+
+(* Compute a positive *)
+let rec mkPositive = function
+  | 1 -> Lazy.force cxH
+  | i ->
+     let c = if (i mod 2) = 0 then cxO else cxI in
+     SmtMisc.mklApp c [|mkPositive (i / 2)|]
+
+(* Compute a N *)
+let mkN = function
+  | 0 -> Lazy.force cN0
+  | i -> SmtMisc.mklApp cNpos [|mkPositive i|]
+
+(* Compute a Boolean *)
+let rec mkBool = function
+  | true -> Lazy.force ctrue
+  | false -> Lazy.force cfalse
+
+(* Compute a Boolean list *)
+let rec mk_bv_list = function
+  | [] -> SmtMisc.mklApp cnil [|Lazy.force cbool|]
+  | b :: bv ->
+    SmtMisc.mklApp ccons [|Lazy.force cbool; mkBool b; mk_bv_list bv|]
+
+
+(* Reification *)
+
+let mk_bool b =
+  let c, args = Term.decompose_app b in
+  if Term.eq_constr c (Lazy.force ctrue) then true
+  else if Term.eq_constr c (Lazy.force cfalse) then false
+  else assert false
+
+let rec mk_bool_list bs =
+  let c, args = Term.decompose_app bs in
+  if Term.eq_constr c (Lazy.force cnil) then []
+  else if Term.eq_constr c (Lazy.force ccons) then
+    match args with
+    | [_; b; bs] -> mk_bool b :: mk_bool_list bs
+    | _ -> assert false
+  else assert false
+
+let rec mk_nat n =
+  let c, args = Term.decompose_app n in
+  if Term.eq_constr c (Lazy.force cO) then
+    0
+  else if Term.eq_constr c (Lazy.force cS) then
+    match args with
+    | [n] -> (mk_nat n) + 1
+    | _ -> assert false
+  else assert false
+
+let rec mk_positive n =
+  let c, args = Term.decompose_app n in
+  if Term.eq_constr c (Lazy.force cxH) then
+    1
+  else if Term.eq_constr c (Lazy.force cxO) then
+    match args with
+    | [n] -> 2 * (mk_positive n)
+    | _ -> assert false
+  else if Term.eq_constr c (Lazy.force cxI) then
+    match args with
+    | [n] -> 2 * (mk_positive n) + 1
+    | _ -> assert false
+  else assert false
+
+
+let mk_N n =
+  let c, args = Term.decompose_app n in
+  if Term.eq_constr c (Lazy.force cN0) then
+    0
+  else if Term.eq_constr c (Lazy.force cNpos) then
+    match args with
+    | [n] -> mk_positive n
+    | _ -> assert false
+  else assert false
+
+
+let mk_Z n =
+  let c, args = Term.decompose_app n in
+  if Term.eq_constr c (Lazy.force cZ0) then 0
+  else if Term.eq_constr c (Lazy.force cZpos) then
+    match args with
+    | [n] -> mk_positive n
+    | _ -> assert false
+  else if Term.eq_constr c (Lazy.force cZneg) then
+    match args with
+    | [n] -> - mk_positive n
+    | _ -> assert false
+  else assert false
+
+
+(* size of bivectors are either N.of_nat (length l) or an N *)
+let mk_bvsize n =
+  let c, args = Term.decompose_app n in
+  if Term.eq_constr c (Lazy.force cof_nat) then
+    match args with
+    | [nl] ->
+      let c, args = Term.decompose_app nl in
+      if Term.eq_constr c (Lazy.force clength) then
+        match args with
+        | [_; l] -> List.length (mk_bool_list l)
+        | _ -> assert false
+      else assert false
+    | _ -> assert false
+  else mk_N n
diff --git a/src/trace/coqTerms.mli b/src/trace/coqTerms.mli
index 7d7fe6a..b21bef8 100644
--- a/src/trace/coqTerms.mli
+++ b/src/trace/coqTerms.mli
@@ -1,14 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val gen_constant : string list list -> string -> Term.constr lazy_t
+
+(* Int63 *)
 val cint : Term.constr lazy_t
 val ceq63 : Term.constr lazy_t
+
+(* PArray *)
 val carray : Term.constr lazy_t
-val positive_modules : string list list
+
+(* nat *)
+val cnat : Term.constr lazy_t
+val cO : Term.constr lazy_t
+val cS : Term.constr lazy_t
+
+(* Positive *)
 val cpositive : Term.constr lazy_t
 val cxI : Term.constr lazy_t
 val cxO : Term.constr lazy_t
 val cxH : Term.constr lazy_t
 val ceqbP : Term.constr lazy_t
-val z_modules : string list list
+
+(* N *)
+val cN : Term.constr lazy_t
+val cN0 : Term.constr lazy_t
+val cNpos : Term.constr lazy_t
+val cof_nat : Term.constr lazy_t
+
+(* Z *)
 val cZ : Term.constr lazy_t
 val cZ0 : Term.constr lazy_t
 val cZpos : Term.constr lazy_t
@@ -22,7 +51,8 @@ val cleb : Term.constr lazy_t
 val cgeb : Term.constr lazy_t
 val cgtb : Term.constr lazy_t
 val ceqbZ : Term.constr lazy_t
-val bool_modules : string list list
+
+(* Booleans *)
 val cbool : Term.constr lazy_t
 val ctrue : Term.constr lazy_t
 val cfalse : Term.constr lazy_t
@@ -33,43 +63,119 @@ val cnegb : Term.constr lazy_t
 val cimplb : Term.constr lazy_t
 val ceqb : Term.constr lazy_t
 val cifb : Term.constr lazy_t
+val ciff : Term.constr lazy_t
 val creflect : Term.constr lazy_t
+
+(* Lists *)
 val clist : Term.constr lazy_t
 val cnil : Term.constr lazy_t
 val ccons : Term.constr lazy_t
+val clength : Term.constr lazy_t
+
+(* Option *)
 val coption : Term.constr lazy_t
 val cSome : Term.constr lazy_t
 val cNone : Term.constr lazy_t
+
+(* Pairs *)
 val cpair : Term.constr lazy_t
+val cprod : Term.constr lazy_t
+
+(* Dependent pairs *)
 val csigT : Term.constr lazy_t
+
+(* Logical Operators *)
 val cnot : Term.constr lazy_t
 val ceq : Term.constr lazy_t
 val crefl_equal : Term.constr lazy_t
 val cconj : Term.constr lazy_t
 val cand : Term.constr lazy_t
-val smt_modules : string list list
+
+(* Bit vectors *)
+val cbitvector : Term.constr lazy_t
+val cof_bits : Term.constr lazy_t
+val cbitOf : Term.constr lazy_t
+val cbv_eq : Term.constr lazy_t
+val cbv_not : Term.constr lazy_t
+val cbv_neg : Term.constr lazy_t
+val cbv_and : Term.constr lazy_t
+val cbv_or : Term.constr lazy_t
+val cbv_xor : Term.constr lazy_t
+val cbv_add : Term.constr lazy_t
+val cbv_mult : Term.constr lazy_t
+val cbv_ult : Term.constr lazy_t
+val cbv_slt : Term.constr lazy_t
+val cbv_concat : Term.constr lazy_t
+val cbv_extr : Term.constr lazy_t
+val cbv_zextn : Term.constr lazy_t
+val cbv_sextn : Term.constr lazy_t
+val cbv_shl : Term.constr lazy_t
+val cbv_shr : Term.constr lazy_t
+
+(* Arrays *)
+val cfarray : Term.constr lazy_t
+val cselect : Term.constr lazy_t
+val cstore : Term.constr lazy_t
+val cdiff : Term.constr lazy_t
+val cequalarray : Term.constr lazy_t
+
+(* OrderedType *)
+
+(* SMT_terms *)
 val cState_C_t : Term.constr lazy_t
+val cState_S_t : Term.constr lazy_t
+
 val cdistinct : Term.constr lazy_t
+
 val ctype : Term.constr lazy_t
 val cTZ : Term.constr lazy_t
 val cTbool : Term.constr lazy_t
 val cTpositive : Term.constr lazy_t
+val cTBV : Term.constr lazy_t
+val cTFArray : Term.constr lazy_t
 val cTindex : Term.constr lazy_t
-val ctyp_eqb : Term.constr lazy_t
-val cTyp_eqb : Term.constr lazy_t
+
+val cinterp_t : Term.constr lazy_t
+val cdec_interp : Term.constr lazy_t
+val cord_interp : Term.constr lazy_t
+val ccomp_interp : Term.constr lazy_t
+val cinh_interp : Term.constr lazy_t
+
+val cinterp_eqb : Term.constr lazy_t
+
+val ctyp_compdec : Term.constr lazy_t
+val cTyp_compdec : Term.constr lazy_t
+val cunit_typ_compdec : Term.constr lazy_t
 val cte_carrier : Term.constr lazy_t
-val cte_eqb : Term.constr lazy_t
-val ctyp_eqb_of_typ_eqb_param : Term.constr lazy_t
-val cunit_typ_eqb : Term.constr lazy_t
+val cte_compdec : Term.constr lazy_t
+val ceqb_of_compdec : Term.constr lazy_t
+val cCompDec : Term.constr lazy_t
+
+val cbool_compdec : Term.constr lazy_t
+val cZ_compdec : Term.constr lazy_t
+val cPositive_compdec : Term.constr lazy_t
+val cBV_compdec : Term.constr lazy_t
+val cFArray_compdec : Term.constr lazy_t
+
 val ctval : Term.constr lazy_t
 val cTval : Term.constr lazy_t
+
 val cCO_xH : Term.constr lazy_t
 val cCO_Z0 : Term.constr lazy_t
+val cCO_BV : Term.constr lazy_t
+
 val cUO_xO : Term.constr lazy_t
 val cUO_xI : Term.constr lazy_t
 val cUO_Zpos : Term.constr lazy_t
 val cUO_Zneg : Term.constr lazy_t
 val cUO_Zopp : Term.constr lazy_t
+val cUO_BVbitOf : Term.constr lazy_t
+val cUO_BVnot : Term.constr lazy_t
+val cUO_BVneg : Term.constr lazy_t
+val cUO_BVextr : Term.constr lazy_t
+val cUO_BVzextn : Term.constr lazy_t
+val cUO_BVsextn : Term.constr lazy_t
+
 val cBO_Zplus : Term.constr lazy_t
 val cBO_Zminus : Term.constr lazy_t
 val cBO_Zmult : Term.constr lazy_t
@@ -78,13 +184,31 @@ val cBO_Zle : Term.constr lazy_t
 val cBO_Zge : Term.constr lazy_t
 val cBO_Zgt : Term.constr lazy_t
 val cBO_eq : Term.constr lazy_t
+val cBO_BVand : Term.constr lazy_t
+val cBO_BVor : Term.constr lazy_t
+val cBO_BVxor : Term.constr lazy_t
+val cBO_BVadd : Term.constr lazy_t
+val cBO_BVmult : Term.constr lazy_t
+val cBO_BVult : Term.constr lazy_t
+val cBO_BVslt : Term.constr lazy_t
+val cBO_BVconcat : Term.constr lazy_t
+val cBO_BVshl : Term.constr lazy_t
+val cBO_BVshr : Term.constr lazy_t
+val cBO_select : Term.constr lazy_t
+val cBO_diffarray : Term.constr lazy_t
+
+val cTO_store : Term.constr lazy_t
+
 val cNO_distinct : Term.constr lazy_t
+
 val catom : Term.constr lazy_t
 val cAcop : Term.constr lazy_t
 val cAuop : Term.constr lazy_t
 val cAbop : Term.constr lazy_t
+val cAtop : Term.constr lazy_t
 val cAnop : Term.constr lazy_t
 val cAapp : Term.constr lazy_t
+
 val cform : Term.constr lazy_t
 val cFatom : Term.constr lazy_t
 val cFtrue : Term.constr lazy_t
@@ -96,19 +220,43 @@ val cFxor : Term.constr lazy_t
 val cFimp : Term.constr lazy_t
 val cFiff : Term.constr lazy_t
 val cFite : Term.constr lazy_t
+val cFbbT : Term.constr lazy_t
+
 val cis_true : Term.constr lazy_t
+
 val cvalid_sat_checker : Term.constr lazy_t
 val cinterp_var_sat_checker : Term.constr lazy_t
+
 val make_certif_ops :
-  string list list ->
-  Term.constr array option ->
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t 
+           string list list ->
+           Term.constr array option ->
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
+           Term.constr lazy_t * Term.constr lazy_t
+
+(* Some constructions *)
 val ceq_refl_true : Term.constr lazy_t
 val eq_refl_true : unit -> Term.constr
-val vm_cast_true : Term.constr -> Term.constr
+val vm_cast_true_no_check : Term.constr -> Term.constr
+val vm_cast_true : Environ.env -> Term.constr -> Term.constr
+val mkNat : int -> Term.constr
+val mkN : int -> Term.constr
+val mk_bv_list : bool list -> Term.constr
+
+(* Reification *)
+val mk_bool : Term.constr -> bool
+val mk_bool_list : Term.constr -> bool list
+val mk_nat : Term.constr -> int
+val mk_N : Term.constr -> int
+val mk_bvsize : Term.constr -> int
diff --git a/src/trace/satAtom.ml b/src/trace/satAtom.ml
index f65e850..549462c 100644
--- a/src/trace/satAtom.ml
+++ b/src/trace/satAtom.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -27,6 +23,7 @@ module Atom =
     let equal a1 a2 = a1 == a2
 
     let is_bool_type a = true
+    let is_bv_type a = false
 
     type reify_tbl =
         { mutable count : int;
@@ -56,6 +53,10 @@ module Atom =
     let interp_tbl reify =
       Structures.mkArray (Lazy.force cbool, atom_tbl reify)
 
+    let logic _ = SL.empty
+
+    let to_smt = Format.pp_print_int
+    
   end
 
 module Form = SmtForm.Make(Atom)
diff --git a/src/trace/satAtom.mli b/src/trace/satAtom.mli
index 4577d42..b5fe759 100644
--- a/src/trace/satAtom.mli
+++ b/src/trace/satAtom.mli
@@ -1,52 +1,42 @@
-module Atom :
-  sig
-    type t = int
-    val index : 'a -> 'a
-    val equal : 'a -> 'a -> bool
-    val is_bool_type : 'a -> bool
-    type reify_tbl = {
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+module Atom : sig
+  type t = int
+  val index : t -> int
+
+  val equal : t -> t -> bool
+
+  val is_bool_type : t -> bool
+  val is_bv_type : t -> bool
+  val to_smt : Format.formatter -> t -> unit
+  val logic : t -> SmtMisc.logic
+
+  val is_bool_type : t -> bool
+  type reify_tbl = {
       mutable count : int;
-      tbl : (Term.constr, int) Hashtbl.t;
+      tbl : (Term.constr, t) Hashtbl.t;
     }
-    val create : unit -> reify_tbl
-    val declare : reify_tbl -> Term.constr -> int
-    val get : reify_tbl -> Term.constr -> int
-    val atom_tbl : reify_tbl -> Term.constr array
-    val interp_tbl : reify_tbl -> Term.constr
-  end
-module Form :
-  sig
-    type hatom = Atom.t
-    type t = SmtForm.Make(Atom).t
-    type pform = (hatom, t) SmtForm.gen_pform
-    val pform_true : pform
-    val pform_false : pform
-    val equal : t -> t -> bool
-    val to_lit : t -> int
-    val index : t -> int
-    val pform : t -> pform
-    val neg : t -> t
-    val is_pos : t -> bool
-    val is_neg : t -> bool
-    val to_string : ?pi:bool -> (hatom -> string) -> t -> string
-    val to_smt : (hatom -> string) -> Format.formatter -> t -> unit
-    exception NotWellTyped of pform
-    type reify = SmtForm.Make(Atom).reify
-    val create : unit -> reify
-    val clear : reify -> unit
-    val get : ?declare:bool -> reify -> pform -> t
-    val of_coq : (Term.constr -> hatom) -> reify -> Term.constr -> t
-    val hash_hform : (hatom -> hatom) -> reify -> t -> t
-    val flatten : reify -> t -> t
-    val to_coq : t -> Term.constr
-    val pform_tbl : reify -> pform array
-    val to_array : reify -> 'a -> (pform -> 'a) -> int * 'a array
-    val interp_tbl : reify -> Term.constr * Term.constr
-    val nvars : reify -> int
-    val interp_to_coq :
-      (hatom -> Term.constr) ->
-      (int, Term.constr) Hashtbl.t -> t -> Term.constr
-  end
+  val create : unit -> reify_tbl
+  val declare : reify_tbl -> Term.constr -> t
+  val get : reify_tbl -> Term.constr -> t
+  val atom_tbl : reify_tbl -> Term.constr array
+  val interp_tbl : reify_tbl -> Term.constr
+end
+
+
+module Form : SmtForm.FORM with type hatom = Atom.t
+
+
 module Trace :
   sig
     val share_value : Form.t SmtCertif.clause -> unit
diff --git a/src/trace/smtAtom.ml b/src/trace/smtAtom.ml
index 7ccaa95..6554a8f 100644
--- a/src/trace/smtAtom.ml
+++ b/src/trace/smtAtom.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,30 +12,58 @@
 
 open SmtMisc
 open CoqTerms
+open Entries
+open Declare
+open Decl_kinds
 open SmtBtype
 
+
 (** Operators *)
 
 type cop =
-  | CO_xH
-  | CO_Z0
+   | CO_xH
+   | CO_Z0
+   | CO_BV of bool list
 
 type uop =
-  | UO_xO
-  | UO_xI
-  | UO_Zpos
-  | UO_Zneg
-  | UO_Zopp
+   | UO_xO
+   | UO_xI
+   | UO_Zpos
+   | UO_Zneg
+   | UO_Zopp
+   | UO_BVbitOf of int * int
+   | UO_BVnot of int
+   | UO_BVneg of int
+   | UO_BVextr of int * int * int
+   | UO_BVzextn of int * int
+   | UO_BVsextn of int * int
 
 type bop =
-  | BO_Zplus
-  | BO_Zminus
-  | BO_Zmult
-  | BO_Zlt
-  | BO_Zle
-  | BO_Zge
-  | BO_Zgt
-  | BO_eq of btype
+   | BO_Zplus
+   | BO_Zminus
+   | BO_Zmult
+   | BO_Zlt
+   | BO_Zle
+   | BO_Zge
+   | BO_Zgt
+   | BO_eq of btype
+   | BO_BVand of int
+   | BO_BVor of int
+   | BO_BVxor of int
+   | BO_BVadd of int
+   | BO_BVmult of int
+   | BO_BVult of int
+   | BO_BVslt of int
+   | BO_BVconcat of int * int
+   | BO_BVshl of int
+   | BO_BVshr of int
+   | BO_select of btype * btype
+   | BO_diffarray of btype * btype
+
+
+type top =
+  | TO_store of btype * btype
+
 
 type nop =
   | NO_distinct of btype
@@ -55,26 +79,35 @@ type index = Index of int
 type indexed_op = index * op_def
 
 let destruct s (i, hval) = match i with
-  | Index index -> index, hval
-  | Rel_name _ -> failwith s
+    | Index index -> index, hval
+    | Rel_name _ -> failwith s
+
+let dummy_indexed_op i dom codom =
+  (i, {tparams = dom; tres = codom; op_val = Term.mkProp})
+
+let indexed_op_index i =
+  let index, _ = destruct "destruct on a Rel: called by indexed_op_index" i in
+  index
 
-let dummy_indexed_op i dom codom = i, {tparams = dom; tres = codom; op_val = Term.mkProp}
-let indexed_op_index i = let index, _ = destruct "destruct on a Rel: called by indexed_op_index" i in
-                         index
+let debruijn_indexed_op i ty =
+  (Index i, {tparams = [||]; tres = ty; op_val = Term.mkRel i})
 
 module Op =
   struct
     let c_to_coq = function
       | CO_xH -> Lazy.force cCO_xH
       | CO_Z0 -> Lazy.force cCO_Z0
+      | CO_BV bv -> mklApp cCO_BV [|mk_bv_list bv; mkN (List.length bv)|]
 
     let c_type_of = function
       | CO_xH -> Tpositive
       | CO_Z0 -> TZ
+      | CO_BV bv -> TBV (List.length bv)
 
     let interp_cop = function
       | CO_xH -> Lazy.force cxH
       | CO_Z0 -> Lazy.force cZ0
+      | CO_BV bv -> mklApp cof_bits [|mk_bv_list bv|]
 
     let u_to_coq = function
       | UO_xO -> Lazy.force cUO_xO
@@ -82,14 +115,29 @@ module Op =
       | UO_Zpos -> Lazy.force cUO_Zpos
       | UO_Zneg -> Lazy.force cUO_Zneg
       | UO_Zopp -> Lazy.force cUO_Zopp
+      | UO_BVbitOf (s, i) -> mklApp cUO_BVbitOf [|mkN s; mkNat i|]
+      | UO_BVnot s -> mklApp cUO_BVnot [|mkN s|]
+      | UO_BVneg s -> mklApp cUO_BVneg [|mkN s|]
+      | UO_BVextr (i, n, s) -> mklApp cUO_BVextr [|mkN i; mkN n; mkN s|]
+      | UO_BVzextn (s, n) -> mklApp cUO_BVzextn [|mkN s; mkN n|]
+      | UO_BVsextn (s, n) -> mklApp cUO_BVsextn [|mkN s; mkN n|]
 
     let u_type_of = function
       | UO_xO | UO_xI -> Tpositive
       | UO_Zpos | UO_Zneg | UO_Zopp -> TZ
+      | UO_BVbitOf _ -> Tbool
+      | UO_BVnot s | UO_BVneg s -> TBV s
+      | UO_BVextr (_, n, _) -> TBV n
+      | UO_BVzextn (s, n) | UO_BVsextn (s, n) -> TBV (s + n)
 
     let u_type_arg = function
       | UO_xO | UO_xI | UO_Zpos | UO_Zneg -> Tpositive
       | UO_Zopp -> TZ
+      | UO_BVbitOf (s,_) -> TBV s
+      | UO_BVnot s | UO_BVneg s -> TBV s
+      | UO_BVextr (_, _, s) -> TBV s
+      | UO_BVzextn (s, _) | UO_BVsextn (s, _) -> TBV s
+
 
     let interp_uop = function
       | UO_xO -> Lazy.force cxO
@@ -97,8 +145,17 @@ module Op =
       | UO_Zpos -> Lazy.force cZpos
       | UO_Zneg -> Lazy.force cZneg
       | UO_Zopp -> Lazy.force copp
+      | UO_BVbitOf (s,i) -> mklApp cbitOf [|mkN s; mkNat i|]
+      | UO_BVnot s -> mklApp cbv_not [|mkN s|]
+      | UO_BVneg s -> mklApp cbv_neg [|mkN s|]
+      | UO_BVextr (i, n, s) -> mklApp cbv_extr [|mkN i; mkN n; mkN s|]
+      | UO_BVzextn (s, n) -> mklApp cbv_zextn [|mkN s; mkN n|]
+      | UO_BVsextn (s, n) -> mklApp cbv_sextn [|mkN s; mkN n|]
 
     let eq_tbl = Hashtbl.create 17
+    let select_tbl = Hashtbl.create 17
+    let store_tbl = Hashtbl.create 17
+    let diffarray_tbl = Hashtbl.create 17
 
     let eq_to_coq t =
       try Hashtbl.find eq_tbl t
@@ -107,6 +164,27 @@ module Op =
 	Hashtbl.add eq_tbl t op;
 	op
 
+    let select_to_coq ti te =
+      try Hashtbl.find select_tbl (ti, te)
+      with Not_found ->
+        let op = mklApp cBO_select [|SmtBtype.to_coq ti; SmtBtype.to_coq te|] in
+        Hashtbl.add select_tbl (ti, te) op;
+        op
+
+    let store_to_coq ti te =
+      try Hashtbl.find store_tbl (ti, te)
+      with Not_found ->
+        let op = mklApp cTO_store [|SmtBtype.to_coq ti; SmtBtype.to_coq te|] in
+        Hashtbl.add store_tbl (ti, te) op;
+        op
+
+    let diffarray_to_coq ti te =
+      try Hashtbl.find diffarray_tbl (ti, te)
+      with Not_found ->
+        let op = mklApp cBO_diffarray [|SmtBtype.to_coq ti; SmtBtype.to_coq te|] in
+        Hashtbl.add diffarray_tbl (ti, te) op;
+        op
+
     let b_to_coq = function
       | BO_Zplus -> Lazy.force cBO_Zplus
       | BO_Zminus -> Lazy.force cBO_Zminus
@@ -116,23 +194,97 @@ module Op =
       | BO_Zge -> Lazy.force cBO_Zge
       | BO_Zgt -> Lazy.force cBO_Zgt
       | BO_eq t -> eq_to_coq t
+      | BO_BVand s -> mklApp cBO_BVand [|mkN s|]
+      | BO_BVor s -> mklApp cBO_BVor [|mkN s|]
+      | BO_BVxor s -> mklApp cBO_BVxor [|mkN s|]
+      | BO_BVadd s -> mklApp cBO_BVadd [|mkN s|]
+      | BO_BVmult s -> mklApp cBO_BVmult [|mkN s|]
+      | BO_BVult s -> mklApp cBO_BVult [|mkN s|]
+      | BO_BVslt s -> mklApp cBO_BVslt [|mkN s|]
+      | BO_BVconcat (s1, s2) -> mklApp cBO_BVconcat [|mkN s1; mkN s2|]
+      | BO_BVshl s -> mklApp cBO_BVshl [|mkN s|]
+      | BO_BVshr s -> mklApp cBO_BVshr [|mkN s|]
+      | BO_select (ti, te) -> select_to_coq ti te
+      | BO_diffarray (ti, te) -> diffarray_to_coq ti te
 
     let b_type_of = function
       | BO_Zplus | BO_Zminus | BO_Zmult -> TZ
-      | BO_Zlt | BO_Zle | BO_Zge | BO_Zgt | BO_eq _ -> Tbool
+      | BO_Zlt | BO_Zle | BO_Zge | BO_Zgt | BO_eq _
+      | BO_BVult _ | BO_BVslt _ -> Tbool
+      | BO_BVand s | BO_BVor s | BO_BVxor s | BO_BVadd s | BO_BVmult s
+      | BO_BVshl s | BO_BVshr s -> TBV s
+      | BO_BVconcat (s1, s2) -> TBV (s1 + s2)
+      | BO_select (_, te) -> te
+      | BO_diffarray (ti, _) -> ti
 
     let b_type_args = function
-      | BO_Zplus | BO_Zminus | BO_Zmult 
+      | BO_Zplus | BO_Zminus | BO_Zmult
       | BO_Zlt | BO_Zle | BO_Zge | BO_Zgt -> (TZ,TZ)
       | BO_eq t -> (t,t)
-
-    let interp_eq = function
+      | BO_BVand s | BO_BVor s | BO_BVxor s | BO_BVadd s | BO_BVmult s
+      | BO_BVult s | BO_BVslt s | BO_BVshl s | BO_BVshr s ->
+        (TBV s,TBV s)
+      | BO_BVconcat (s1, s2) -> (TBV s1, TBV s2)
+      | BO_select (ti, te) -> (TFArray (ti, te), ti)
+      | BO_diffarray (ti, te) -> (TFArray (ti, te), TFArray (ti, te))
+
+
+    let interp_ieq t_i t =
+      mklApp cinterp_eqb [|t_i ; SmtBtype.to_coq t|]
+
+ (*   let veval_t te =
+      let env = Global.env () in
+      let evd = Evd.from_env env in
+      let evd, ty = Typing.type_of env evd te in
+      Vnorm.cbv_vm env te ty
+
+
+    let interp_ieq_eval t_i t =
+      let te = mklApp cinterp_eqb [|t_i ; SmtBtype.to_coq t|] in
+      veval_t te
+      *)
+
+    let interp_eqarray t_i ti te =
+      mklApp cequalarray
+        SmtBtype.[|SmtBtype.interp t_i ti; SmtBtype.interp t_i te;
+                SmtBtype.ord_interp t_i ti; SmtBtype.comp_interp t_i ti;
+                SmtBtype.ord_interp t_i te; SmtBtype.comp_interp t_i te;
+                SmtBtype.inh_interp t_i te |]
+
+    let interp_select t_i ti te =
+      mklApp cselect
+        SmtBtype.[|SmtBtype.interp t_i ti; SmtBtype.interp t_i te;
+                SmtBtype.ord_interp t_i ti; SmtBtype.comp_interp t_i ti;
+                SmtBtype.inh_interp t_i te|]
+
+    let interp_diff t_i ti te =
+      mklApp cdiff
+        SmtBtype.[|SmtBtype.interp t_i ti; SmtBtype.interp t_i te;
+                SmtBtype.dec_interp t_i ti; SmtBtype.ord_interp t_i ti; SmtBtype.comp_interp t_i ti;
+                SmtBtype.dec_interp t_i te; SmtBtype.ord_interp t_i te; SmtBtype.comp_interp t_i te;
+                SmtBtype.inh_interp t_i ti; SmtBtype.inh_interp t_i te |]
+
+
+    let interp_store t_i ti te =
+      mklApp cstore
+        SmtBtype.[|SmtBtype.interp t_i ti; SmtBtype.interp t_i te;
+                SmtBtype.dec_interp t_i ti; SmtBtype.ord_interp t_i ti; SmtBtype.comp_interp t_i ti;
+                SmtBtype.ord_interp t_i te; SmtBtype.comp_interp t_i te; SmtBtype.inh_interp t_i te |]
+
+
+    let interp_eq t_i = function
       | TZ -> Lazy.force ceqbZ
       | Tbool -> Lazy.force ceqb
       | Tpositive -> Lazy.force ceqbP
-      | Tindex i -> mklApp cte_eqb [|indexed_type_hval i|]
+      | TBV s -> mklApp cbv_eq [|mkN s|]
+      | Tindex i ->
+        mklApp ceqb_of_compdec [|mklApp cte_carrier [|i.hval|];
+                                 mklApp cte_compdec [|i.hval|]|]
+      | TFArray (ti, te) -> interp_eqarray t_i ti te
+
+
 
-    let interp_bop = function
+    let interp_bop t_i = function
       | BO_Zplus -> Lazy.force cadd
       | BO_Zminus -> Lazy.force csub
       | BO_Zmult -> Lazy.force cmul
@@ -140,7 +292,32 @@ module Op =
       | BO_Zle -> Lazy.force cleb
       | BO_Zge -> Lazy.force cgeb
       | BO_Zgt -> Lazy.force cgtb
-      | BO_eq t -> interp_eq t
+      | BO_eq t -> interp_eq t_i t
+      | BO_BVand s -> mklApp cbv_and [|mkN s|]
+      | BO_BVor s -> mklApp cbv_or [|mkN s|]
+      | BO_BVxor s -> mklApp cbv_xor [|mkN s|]
+      | BO_BVadd s -> mklApp cbv_add [|mkN s|]
+      | BO_BVmult s -> mklApp cbv_mult [|mkN s|]
+      | BO_BVult s -> mklApp cbv_ult [|mkN s|]
+      | BO_BVslt s -> mklApp cbv_slt [|mkN s|]
+      | BO_BVconcat (s1,s2) -> mklApp cbv_concat [|mkN s1; mkN s2|]
+      | BO_BVshl s -> mklApp cbv_shl [|mkN s|]
+      | BO_BVshr s -> mklApp cbv_shr [|mkN s|]
+      | BO_select (ti, te) -> interp_select t_i ti te
+      | BO_diffarray (ti, te) -> interp_diff t_i ti te
+
+    let t_to_coq = function
+      | TO_store (ti, te) -> store_to_coq ti te
+
+    let t_type_of = function
+      | TO_store (ti, te) -> TFArray (ti, te)
+
+    let t_type_args = function
+      | TO_store (ti, te) -> TFArray (ti, te), ti, te
+
+    let interp_top t_i = function
+      | TO_store (ti, te) -> interp_store t_i ti te
+
 
     let n_to_coq = function
       | NO_distinct t -> mklApp cNO_distinct [|SmtBtype.to_coq t|]
@@ -151,14 +328,9 @@ module Op =
     let n_type_args = function
       | NO_distinct ty -> ty
 
-    let interp_distinct = function
-      | TZ -> Lazy.force cZ
-      | Tbool -> Lazy.force cbool
-      | Tpositive -> Lazy.force cpositive
-      | Tindex i -> mklApp cte_carrier [|indexed_type_hval i|]
-
-    let interp_nop = function
-      | NO_distinct ty -> mklApp cdistinct [|interp_distinct ty;interp_eq ty|]
+    let interp_nop t_i = function
+      | NO_distinct ty ->
+        mklApp cdistinct [|SmtBtype.interp t_i ty; interp_eq t_i ty|]
 
     let i_to_coq i = let index, _ = destruct "destruct on a Rel: called by i_to_coq" i in
                      mkInt index
@@ -206,14 +378,50 @@ module Op =
         (index, hval.tparams, hval.tres, op)::acc in
       Hashtbl.fold set reify.tbl []
 
-    let c_equal op1 op2 = op1 == op2
+    let c_equal op1 op2 = match op1, op2 with
+      | CO_BV bv1, CO_BV bv2 ->
+        (try List.for_all2 (=) bv1 bv2 with
+         | Invalid_argument _ -> false)
+      | _ -> op1 == op2
 
-    let u_equal op1 op2 = op1 == op2
+    let u_equal op1 op2 =
+      match op1,op2 with
+      | UO_xO, UO_xO
+      | UO_xI, UO_xI
+      | UO_Zpos, UO_Zpos
+      | UO_Zneg, UO_Zneg
+      | UO_Zopp, UO_Zopp -> true
+      | UO_BVbitOf (s1,i1), UO_BVbitOf (s2,i2) -> s1 == s2 && i1 == i2
+      | UO_BVnot s1, UO_BVnot s2 -> s1 == s2
+      | UO_BVneg s1, UO_BVneg s2 -> s1 == s2
+      | UO_BVextr (i1, n1, s1) , UO_BVextr (i2, n2, s2) ->
+        i1 == i2 && n1 == n2 && s1 == s2
+      | UO_BVzextn (s1, n1), UO_BVzextn (s2, n2) -> s1 == s2 && n1 == n2
+      | UO_BVsextn (s1, n1), UO_BVsextn (s2, n2) -> s1 == s2 && n1 == n2
+      | _ -> false
 
     let b_equal op1 op2 =
       match op1,op2 with
-      | BO_eq t1, BO_eq t2 -> SmtBtype.equal t1 t2
-      | _ -> op1 == op2
+        | BO_eq t1, BO_eq t2 -> SmtBtype.equal t1 t2
+        | BO_BVand n1, BO_BVand n2 -> n1 == n2
+        | BO_BVor n1, BO_BVor n2 -> n1 == n2
+        | BO_BVxor n1, BO_BVxor n2 -> n1 == n2
+        | BO_BVadd n1, BO_BVadd n2 -> n1 == n2
+        | BO_BVmult n1, BO_BVmult n2 -> n1 == n2
+        | BO_BVult n1, BO_BVult n2 -> n1 == n2
+        | BO_BVslt n1, BO_BVslt n2 -> n1 == n2
+        | BO_BVconcat (n1,m1), BO_BVconcat (n2,m2) -> n1 == n2 && m1 == m2
+        | BO_BVshl n1, BO_BVshl n2 -> n1 == n2
+        | BO_BVshr n1, BO_BVshr n2 -> n1 == n2
+        | BO_select (ti1, te1), BO_select (ti2, te2)
+        | BO_diffarray (ti1, te1), BO_diffarray (ti2, te2) ->
+          SmtBtype.equal ti1 ti2 && SmtBtype.equal te1 te2
+        | _ -> op1 == op2
+
+    let t_equal op1 op2 =
+      match op1,op2 with
+        | TO_store (ti1, te1), TO_store (ti2, te2) ->
+          SmtBtype.equal ti1 ti2 && SmtBtype.equal te1 te2
 
     let n_equal op1 op2 =
       match op1,op2 with
@@ -221,6 +429,62 @@ module Op =
 
     let i_equal (i1, _) (i2, _) = i1 = i2
 
+
+
+
+    let logic_of_cop = function
+      | CO_xH | CO_Z0 -> SL.singleton LLia
+      | CO_BV _ -> SL.singleton LBitvectors
+
+    let logic_of_uop = function
+      | UO_xO | UO_xI
+      | UO_Zpos | UO_Zneg | UO_Zopp -> SL.singleton LLia
+      | UO_BVbitOf _ | UO_BVnot _ | UO_BVneg _
+      | UO_BVextr _ | UO_BVzextn _ | UO_BVsextn _ -> SL.singleton LBitvectors
+
+    let logic_of_bop = function
+      | BO_Zplus
+      | BO_Zminus
+      | BO_Zmult
+      | BO_Zlt
+      | BO_Zle
+      | BO_Zge
+      | BO_Zgt -> SL.singleton LLia
+      | BO_eq ty -> SmtBtype.logic ty
+      | BO_BVand _
+      | BO_BVor _
+      | BO_BVxor _
+      | BO_BVadd _
+      | BO_BVmult _
+      | BO_BVult _
+      | BO_BVslt _
+      | BO_BVshl _
+      | BO_BVshr _
+      | BO_BVconcat _ -> SL.singleton LBitvectors
+      | BO_select (ti, te)
+      | BO_diffarray (ti, te) ->
+        SL.add LArrays (SL.union (SmtBtype.logic ti) (SmtBtype.logic te))
+
+
+    let logic_of_top = function
+      | TO_store (ti, te) ->
+        SL.add LArrays (SL.union (SmtBtype.logic ti) (SmtBtype.logic te))
+
+    let logic_of_nop = function
+      | NO_distinct ty -> SmtBtype.logic ty
+
+
+    let logic_of_indexed t =
+      let (_, hval) = destruct "destruct on a Rel: called by logic_of_indexed" t in
+      Array.fold_left (fun l ty ->
+         SL.union (SmtBtype.logic ty) l
+        ) (SmtBtype.logic hval.tres) hval.tparams
+
+
+    let logic_ro reify =
+      Hashtbl.fold (fun _ op -> SL.union (logic_of_indexed op))
+        reify.tbl SL.empty
+
   end
 
 
@@ -230,6 +494,7 @@ type atom =
   | Acop of cop
   | Auop of uop * hatom
   | Abop of bop * hatom * hatom
+  | Atop of top * hatom * hatom * hatom
   | Anop of nop * hatom array
   | Aapp of indexed_op * hatom array
 
@@ -271,17 +536,24 @@ module HashedAtom =
       | Acop opa, Acop opb -> Op.c_equal opa opb
       | Auop(opa,ha), Auop(opb,hb) -> Op.u_equal opa opb && ha.index == hb.index
       | Abop(opa,ha1,ha2), Abop(opb,hb1,hb2) ->
-	 Op.b_equal opa opb && ha1.index == hb1.index && ha2.index == hb2.index 
+	Op.b_equal opa opb && ha1.index == hb1.index && ha2.index == hb2.index
+      | Atop(opa,ha1,ha2,ha3), Atop(opb,hb1,hb2,hb3) ->
+	Op.t_equal opa opb && ha1.index == hb1.index &&
+         ha2.index == hb2.index && ha3.index == hb3.index
       | Anop (opa,ha), Anop (opb,hb) ->
-         let na = Array.length ha in
-         let nb = Array.length hb in
-         let i = ref (-1) in
-         Op.n_equal opa opb && na == nb && Array.fold_left (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
+        let na = Array.length ha in
+        let nb = Array.length hb in
+        let i = ref (-1) in
+        Op.n_equal opa opb && na == nb &&
+        Array.fold_left
+          (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
       | Aapp (va,ha), Aapp (vb,hb) ->
-         let na = Array.length ha in
-         let nb = Array.length hb in
-         let i = ref (-1) in
-         Op.i_equal va vb && na == nb && Array.fold_left (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
+        let na = Array.length ha in
+        let nb = Array.length hb in
+        let i = ref (-1) in
+        Op.i_equal va vb && na == nb &&
+        Array.fold_left
+          (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
       | _, _ -> false
 
     let hash = function
@@ -289,24 +561,31 @@ module HashedAtom =
       | Auop (op,h) ->
          (( (h.index lsl 3) + (Hashtbl.hash op)) lsl 3) lxor 2
       | Abop (op,h1,h2) ->
-         (((( (h1.index lsl 2) + h2.index) lsl 3) + Hashtbl.hash op) lsl 3) lxor 3
+        (((( (h1.index lsl 2) + h2.index) lsl 3) + Hashtbl.hash op) lsl 3) lxor 3
+      | Atop (op,h1,h2,h3) ->
+        (((( ((h1.index lsl 2) + h2.index) lsl 3) + h3.index) lsl 4
+          + Hashtbl.hash op) lsl 4) lxor 4
       | Anop (op, args) ->
-         let hash_args =
-           match Array.length args with
-           | 0 -> 0
-           | 1 -> args.(0).index
-           | 2 -> args.(1).index lsl 2 + args.(0).index
-           | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index in
-         (hash_args lsl 5 + (Hashtbl.hash op) lsl 3) lxor 4
+          let hash_args =
+            match Array.length args with
+            | 0 -> 0
+            | 1 -> args.(0).index
+            | 2 -> args.(1).index lsl 2 + args.(0).index
+            | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index
+          in
+          (hash_args lsl 5 + (Hashtbl.hash op) lsl 3) lxor 4
       | Aapp (op, args) ->
          let op_index = try fst (destruct "destruct on a Rel: called by hash" op) with _ -> 0 in
-         let hash_args =
-           match Array.length args with
-           | 0 -> 0
-           | 1 -> args.(0).index
-           | 2 -> args.(1).index lsl 2 + args.(0).index
-           | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index in
-         (hash_args lsl 5 + op_index lsl 3) lxor 4
+          let hash_args =
+            match Array.length args with
+            | 0 -> 0
+            | 1 -> args.(0).index
+            | 2 -> args.(1).index lsl 2 + args.(0).index
+            | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index
+          in
+          (hash_args lsl 5 + op_index lsl 3) lxor 4
+
+
 
   end
 
@@ -327,124 +606,189 @@ module Atom =
       | Acop op -> Op.c_type_of op
       | Auop (op,_) -> Op.u_type_of op
       | Abop (op,_,_) -> Op.b_type_of op
+      | Atop (op,_,_,_) -> Op.t_type_of op
       | Anop (op,_) -> Op.n_type_of op
       | Aapp (op,_) -> Op.i_type_of op
 
     let is_bool_type h = SmtBtype.equal (type_of h) Tbool
+    let is_bv_type h = match type_of h with | TBV _ -> true | _ -> false
 
 
     let rec compute_int = function
       | Acop c ->
          (match c with
           | CO_xH -> 1
-          | CO_Z0 -> 0)
+          | CO_Z0 -> 0
+          | CO_BV _ -> assert false)
       | Auop (op,h) ->
          (match op with
           | UO_xO -> 2*(compute_hint h)
           | UO_xI -> 2*(compute_hint h) + 1
           | UO_Zpos -> compute_hint h
           | UO_Zneg -> - (compute_hint h)
-          | UO_Zopp -> assert false)
+          | UO_Zopp | UO_BVbitOf _
+          | UO_BVnot _ | UO_BVneg _
+          | UO_BVextr _ | UO_BVzextn _ | UO_BVsextn _ -> assert false)
       | _ -> assert false
 
     and compute_hint h = compute_int (atom h)
 
-    let to_string_int i =
+    let to_smt_int fmt i =
       let s1 = if i < 0 then "(- " else "" in
       let s2 = if i < 0 then ")" else "" in
       let j = if i < 0 then -i else i in
-      s1 ^ string_of_int j ^ s2
-
-    let to_string ?pi:(pi=false) h =
-      let rec to_string h = 
-        (if pi then string_of_int (index h) ^":" else "")
-        ^ to_string_atom (atom h)
-
-      and to_string_atom = function
-        | Acop _ as a -> to_string_int (compute_int a)
-        | Auop (UO_Zopp,h) -> 
-           "(- " ^
-             to_string h ^
-               ")"
-        | Auop _ as a -> to_string_int (compute_int a)
-        | Abop (op,h1,h2) -> to_string_bop op h1 h2
-        | Anop (op,a) -> to_string_nop op a
-        | Aapp ((i, op), a) ->
-           let op_string = begin match i with
-                           | Index index -> "op_" ^ string_of_int index
-                           | Rel_name name -> name end
-                           ^ if pi then to_string_op op else "" in
+      Format.fprintf fmt "%s%i%s" s1 j s2
+
+
+    let rec bv_to_smt fmt = function
+      | true :: bv -> Format.fprintf fmt "%a1" bv_to_smt bv
+      | false :: bv -> Format.fprintf fmt "%a0" bv_to_smt bv
+      | [] -> ()
+
+
+    let to_smt_named ?pi:(pi=false) (fmt:Format.formatter) h =
+      let rec to_smt fmt h =
+        if pi then Format.fprintf fmt "%d:" (index h);
+        to_smt_atom (atom h)
+
+      and to_smt_atom = function
+        | Acop (CO_BV bv) -> Format.fprintf fmt "#b%a" bv_to_smt bv
+        | Acop _ as a -> to_smt_int fmt (compute_int a)
+        | Auop (UO_Zopp,h) ->
+           Format.fprintf fmt "(- ";
+           to_smt fmt h;
+           Format.fprintf fmt ")"
+        | Auop (UO_BVbitOf (_, i), h) ->
+           Format.fprintf fmt "(bitof %d %a)" i to_smt h
+        | Auop (UO_BVnot _, h) ->
+           Format.fprintf fmt "(bvnot %a)" to_smt h
+        | Auop (UO_BVneg _, h) ->
+           Format.fprintf fmt "(bvneg %a)" to_smt h
+        | Auop (UO_BVextr (i, n, _), h) ->
+           Format.fprintf fmt "((_ extract %d %d) %a)" (i+n-1) i to_smt h
+        | Auop (UO_BVzextn (_, n), h) ->
+           Format.fprintf fmt "((_ zero_extend %d) %a)" n to_smt h
+        | Auop (UO_BVsextn (_, n), h) ->
+           Format.fprintf fmt "((_ sign_extend %d) %a)" n to_smt h
+        | Auop _ as a -> to_smt_int fmt (compute_int a)
+        | Abop (op,h1,h2) -> to_smt_bop op h1 h2
+        | Atop (op,h1,h2,h3) -> to_smt_top op h1 h2 h3
+        | Anop (op,a) -> to_smt_nop op a
+        | Aapp ((i,op),a) ->
+           let op_smt () =
+             (match i with
+                | Index index -> Format.fprintf fmt "op_%i" index
+                | Rel_name name -> Format.fprintf fmt "%s" name);
+             if pi then to_smt_op op
+           in
            if Array.length a = 0 then (
-             op_string
+             op_smt ()
            ) else (
-             "(" ^ op_string ^
-               Array.fold_left (fun acc h -> acc ^ " " ^ to_string h) "" a ^
-                 ")"
+             Format.fprintf fmt "(";
+             op_smt ();
+             Array.iter (fun h -> Format.fprintf fmt " "; to_smt fmt h) a;
+             Format.fprintf fmt ")"
            )
-      and to_string_op {tparams=bta; tres=bt; op_val=t} =
-        "[(" ^ Array.fold_left (fun acc bt -> acc ^ SmtBtype.to_string bt ^ " ")
-                 " " bta ^ ") ( " ^ SmtBtype.to_string bt ^ " ) ( " ^
-          Pp.string_of_ppcmds (Printer.pr_constr t) ^ " )]"
 
-      and to_string_bop op h1 h2 =
+      and to_smt_op {tparams=bta; tres=bt; op_val=t} =
+        Format.fprintf fmt "[(";
+        Array.iter (fun bt -> SmtBtype.to_smt fmt bt; Format.fprintf fmt " ") bta;
+        Format.fprintf fmt ") ( ";
+        SmtBtype.to_smt fmt bt;
+        Format.fprintf fmt " ) ( %s )]" (Pp.string_of_ppcmds (Printer.pr_constr t))
+
+      and to_smt_bop op h1 h2 =
         let s = match op with
-          | BO_Zplus -> "+"
-          | BO_Zminus -> "-"
-          | BO_Zmult -> "*"
-          | BO_Zlt -> "<"
-          | BO_Zle -> "<="
-          | BO_Zge -> ">="
-          | BO_Zgt -> ">"
-          | BO_eq _ -> "=" in
-        "(" ^ s ^ " " ^
-          to_string h1 ^
-            " " ^
-              to_string h2 ^
-                ")"
-
-      and to_string_nop op a =
+            | BO_Zplus -> "+"
+            | BO_Zminus -> "-"
+            | BO_Zmult -> "*"
+            | BO_Zlt -> "<"
+            | BO_Zle -> "<="
+            | BO_Zge -> ">="
+            | BO_Zgt -> ">"
+            | BO_eq _ -> "="
+            | BO_BVand _ -> "bvand"
+            | BO_BVor _ -> "bvor"
+            | BO_BVxor _ -> "bvxor"
+            | BO_BVadd _ -> "bvadd"
+            | BO_BVmult _ -> "bvmul"
+            | BO_BVult _ -> "bvult"
+            | BO_BVslt _ -> "bvslt"
+            | BO_BVconcat _ -> "concat"
+            | BO_BVshl _ -> "bvshl"
+            | BO_BVshr _ -> "bvlshr"
+            | BO_select _ -> "select"
+            | BO_diffarray _ -> "diff" (* should not be used in goals *)
+        in
+        Format.fprintf fmt "(%s %a %a)" s to_smt h1 to_smt h2
+
+      and to_smt_top op h1 h2 h3=
         let s = match op with
-          | NO_distinct _ -> "distinct" in
-        "(" ^ s ^
-          Array.fold_left (fun acc h -> acc ^ " " ^ to_string h) "" a ^
-            ")" in
-      to_string h
+            | TO_store _ -> "store"
+        in
+        Format.fprintf fmt "(%s %a %a %a)" s to_smt h1 to_smt h2 to_smt h3
+
+      and to_smt_nop op a =
+        let s = match op with
+            | NO_distinct _ -> "distinct" in
+        Format.fprintf fmt "(%s" s;
+        Array.iter (fun h -> Format.fprintf fmt " "; to_smt fmt h) a;
+        Format.fprintf fmt ")"
+
+      in
+      to_smt fmt h
 
-    let to_smt fmt t = Format.fprintf fmt "%s@." (to_string t)
+    let to_smt (fmt:Format.formatter) h = to_smt_named fmt h
 
 
     exception NotWellTyped of atom
 
     let check a =
+      (* Format.eprintf "Checking %a @." to_smt_atom a; *)
       match a with
       | Acop _ -> ()
       | Auop(op,h) ->
-	 if not (SmtBtype.equal (Op.u_type_arg op) (type_of h))
-         then raise (NotWellTyped a)
+	if not (SmtBtype.equal (Op.u_type_arg op) (type_of h)) then
+	  raise (NotWellTyped a)
       | Abop(op,h1,h2) ->
-	 let (t1,t2) = Op.b_type_args op in
-	 if not (SmtBtype.equal t1 (type_of h1) && SmtBtype.equal t2 (type_of h2))
-	 then raise (NotWellTyped a)
+	let (t1,t2) = Op.b_type_args op in
+ 	if not (SmtBtype.equal t1 (type_of h1) && SmtBtype.equal t2 (type_of h2))
+        then (Format.eprintf "1. Wanted %a, got %a@.2. Wanted %a, got %a@."
+                SmtBtype.to_smt t1 SmtBtype.to_smt (type_of h1)
+                SmtBtype.to_smt t2 SmtBtype.to_smt (type_of h2);
+              raise (NotWellTyped a))
+      | Atop(op,h1,h2,h3) ->
+	let (t1,t2,t3) = Op.t_type_args op in
+        if not (SmtBtype.equal t1 (type_of h1) &&
+                SmtBtype.equal t2 (type_of h2) &&
+                SmtBtype.equal t3 (type_of h3))
+	then raise (NotWellTyped a)
       | Anop(op,ha) ->
-         let ty = Op.n_type_args op in
-         Array.iter (fun h -> if not (SmtBtype.equal ty (type_of h)) then raise (NotWellTyped a)) ha
+        let ty = Op.n_type_args op in
+        Array.iter
+          (fun h -> if not (SmtBtype.equal ty (type_of h)) then
+              raise (NotWellTyped a)) ha
       | Aapp(op,args) ->
-	 let tparams = Op.i_type_args op in
-	 Array.iteri (fun i t ->
-	     if not (SmtBtype.equal t (type_of args.(i))) then
-	       raise (NotWellTyped a)) tparams
+	let tparams = Op.i_type_args op in
+	Array.iteri (fun i t ->
+	    if not (SmtBtype.equal t (type_of args.(i))) then
+	      (Format.eprintf "Wanted %a, got %a@."
+                SmtBtype.to_smt t SmtBtype.to_smt (type_of args.(i));
+                      raise (NotWellTyped a))) tparams
 
     type reify_tbl =
       { mutable count : int;
-	        tbl : hatom HashAtom.t
+	tbl : hatom HashAtom.t
       }
 
-
     let create () =
       { count = 0;
 	tbl =  HashAtom.create 17 }
 
+    let op_coq_terms = Hashtbl.create 17
+
     let clear reify =
+      Hashtbl.clear op_coq_terms;
       reify.count <- 0;
       HashAtom.clear reify.tbl
 
@@ -461,7 +805,7 @@ module Atom =
            with Not_found -> declare reify a
       else {index = -1; hval = a}
 
-    let mk_eq reify decl ty h1 h2 =
+    let mk_eq reify ?declare:(decl=true) ty h1 h2 =
       let op = BO_eq ty in
       try
         HashAtom.find reify.tbl (Abop (op, h1, h2))
@@ -473,7 +817,7 @@ module Atom =
 
     let mk_neg reify ({index = i; hval = a} as ha) =
       try HashAtom.find reify.tbl (Auop (UO_Zopp, ha))
-      with Not_found -> 
+      with Not_found ->
         let na = match a with
           | Auop (UO_Zpos, x) -> Auop (UO_Zneg, x)
           | Auop (UO_Zneg, x) -> Auop (UO_Zpos, x)
@@ -481,20 +825,25 @@ module Atom =
         get reify na
 
     let rec hash_hatom ra' {index = _; hval = a} =
-      match a with 
+      match a with
       | Acop cop -> get ra' a
       | Auop (uop, ha) -> get ra' (Auop (uop, hash_hatom ra' ha))
       | Abop (bop, ha1, ha2) ->
          let new_ha1 = hash_hatom ra' ha1 in
          let new_ha2 = hash_hatom ra' ha2 in
          begin match bop with
-         | BO_eq ty -> mk_eq ra' true ty new_ha1 new_ha2
+         | BO_eq ty -> mk_eq ra' ~declare:true ty new_ha1 new_ha2
          | _ -> get ra' (Abop (bop, new_ha1, new_ha2)) end
+      | Atop (top, ha1, ha2, ha3) ->
+         let new_ha1 = hash_hatom ra' ha1 in
+         let new_ha2 = hash_hatom ra' ha2 in
+         let new_ha3 = hash_hatom ra' ha3 in
+         get ra' (Atop (top, new_ha1, new_ha2, new_ha3))
       | Anop _ -> assert false
       | Aapp (op, arr) -> get ra' (Aapp (op, Array.map (hash_hatom ra') arr))
-              
+
     let copy {count=c; tbl=t} = {count = c; tbl = HashAtom.copy t}
-             
+
     let print_atoms reify where =
       let oc = open_out where in
       let fmt = Format.formatter_of_out_channel oc in
@@ -513,11 +862,15 @@ module Atom =
     type coq_cst =
       | CCxH
       | CCZ0
+      | CCBV
       | CCxO
       | CCxI
       | CCZpos
       | CCZneg
       | CCZopp
+      | CCBVbitOf
+      | CCBVnot
+      | CCBVneg
       | CCZplus
       | CCZminus
       | CCZmult
@@ -525,39 +878,164 @@ module Atom =
       | CCZle
       | CCZge
       | CCZgt
+      | CCBVand
+      | CCBVor
+      | CCBVxor
+      | CCBVadd
+      | CCBVmult
+      | CCBVult
+      | CCBVslt
+      | CCBVconcat
+      | CCBVextr
+      | CCBVsextn
+      | CCBVzextn
+      | CCBVshl
+      | CCBVshr
       | CCeqb
       | CCeqbP
       | CCeqbZ
+      | CCeqbBV
+      | CCeqbA
+      | CCselect
+      | CCdiff
+      | CCstore
       | CCunknown
+      | CCunknown_deps of int
+
+
+    let logic_coq_cst = function
+      | CCxH
+      | CCZ0
+      | CCxO
+      | CCxI
+      | CCZpos
+      | CCZneg
+      | CCZopp
+      | CCZplus
+      | CCZminus
+      | CCZmult
+      | CCZlt
+      | CCZle
+      | CCZge
+      | CCZgt -> SL.singleton LLia
+
+      | CCBV
+      | CCBVbitOf
+      | CCBVnot
+      | CCBVneg
+      | CCBVand
+      | CCBVor
+      | CCBVxor
+      | CCBVadd
+      | CCBVmult
+      | CCBVult
+      | CCBVslt
+      | CCBVconcat
+      | CCBVextr
+      | CCBVsextn
+      | CCBVzextn
+      | CCBVshl
+      | CCBVshr -> SL.singleton LBitvectors
+
+      | CCselect | CCdiff | CCstore -> SL.singleton LArrays
+
+      | CCeqb -> SL.empty
+
+      (* | CCeqbP | CCeqbZ -> SL.singleton LLia *)
+      (* | CCeqbBV -> SL.singleton LBitvectors *)
+      (* | CCeqbA -> SL.singleton LArrays *)
+
+      | CCeqbP | CCeqbZ | CCeqbBV | CCeqbA
+      | CCunknown | CCunknown_deps _  -> SL.singleton LUF
+
+
+    let gobble_of_coq_cst = function
+      | CCBV
+      | CCBVbitOf
+      | CCBVnot
+      | CCBVneg
+      | CCBVand
+      | CCBVor
+      | CCBVxor
+      | CCBVadd
+      | CCBVmult
+      | CCBVult
+      | CCBVslt
+      | CCBVsextn
+      | CCBVzextn
+      | CCBVshl
+      | CCBVshr -> 1
+
+      | CCBVconcat -> 2
+      | CCBVextr -> 3
+
+      | CCselect -> 5
+      | CCdiff -> 10
+      | CCstore -> 8
+
+      | _ -> 0
+
 
     let op_tbl () =
       let tbl = Hashtbl.create 29 in
       let add (c1,c2) = Hashtbl.add tbl (Lazy.force c1) c2 in
       List.iter add
-	[ cxH,CCxH; cZ0,CCZ0;
+	[ cxH,CCxH; cZ0,CCZ0; cof_bits, CCBV;
           cxO,CCxO; cxI,CCxI; cZpos,CCZpos; cZneg,CCZneg; copp,CCZopp;
+          cbitOf, CCBVbitOf; cbv_not, CCBVnot; cbv_neg, CCBVneg;
+          cbv_extr, CCBVextr; cbv_zextn, CCBVzextn; cbv_sextn, CCBVsextn;
           cadd,CCZplus; csub,CCZminus; cmul,CCZmult; cltb,CCZlt;
-          cleb,CCZle; cgeb,CCZge; cgtb,CCZgt; ceqb,CCeqb; ceqbP,CCeqbP;
-          ceqbZ, CCeqbZ
+          cleb,CCZle; cgeb,CCZge; cgtb,CCZgt;
+          cbv_and, CCBVand; cbv_or, CCBVor; cbv_xor, CCBVxor;
+          cbv_add, CCBVadd; cbv_mult, CCBVmult;
+          cbv_ult, CCBVult; cbv_slt, CCBVslt; cbv_concat, CCBVconcat;
+          cbv_shl, CCBVshl; cbv_shr, CCBVshr;
+          ceqb,CCeqb; ceqbP,CCeqbP; ceqbZ, CCeqbZ; cbv_eq, CCeqbBV;
+          cselect, CCselect; cdiff, CCdiff;
+          cstore, CCstore;
+          cequalarray, CCeqbA;
         ];
       tbl
 
     let op_tbl = lazy (op_tbl ())
 
-    let of_coq ?hash:(h=false) rt ro reify env sigma c =
+
+    let split_list_at n l =
+      let rec aux acc n l = match n, l with
+        | 0, _ -> List.rev acc, l
+        | _, [] -> assert false
+        | _, x :: l -> aux (x :: acc) (n-1) l
+      in
+      aux [] n l
+
+
+    let get_coq_term_op =
+      Hashtbl.find op_coq_terms
+
+
+    let of_coq ?hash:(h=false) rt ro reify known_logic env sigma c =
       let op_tbl = Lazy.force op_tbl in
       let get_cst c =
-	try Hashtbl.find op_tbl c with Not_found -> CCunknown in
+	try
+          let cc = Hashtbl.find op_tbl c in
+          if SL.subset (logic_coq_cst cc) known_logic then cc
+          else CCunknown_deps (gobble_of_coq_cst cc)
+        with Not_found -> CCunknown
+      in
       let rec mk_hatom h =
         let c, args = Term.decompose_app h in
 	match get_cst c with
-        | CCxH -> mk_cop CO_xH
-        | CCZ0 -> mk_cop CO_Z0
+        | CCxH -> mk_cop CCxH args
+        | CCZ0 -> mk_cop CCZ0 args
+        | CCBV -> mk_cop CCBV args
         | CCxO -> mk_uop UO_xO args
         | CCxI -> mk_uop UO_xI args
         | CCZpos -> mk_uop UO_Zpos args
         | CCZneg -> mk_uop UO_Zneg args
         | CCZopp -> mk_uop UO_Zopp args
+        | CCBVbitOf -> mk_bvbitof args
+        | CCBVnot -> mk_bvnot args
+        | CCBVneg -> mk_bvneg args
         | CCZplus -> mk_bop BO_Zplus args
         | CCZminus -> mk_bop BO_Zminus args
         | CCZmult -> mk_bop BO_Zmult args
@@ -565,25 +1043,79 @@ module Atom =
         | CCZle -> mk_bop BO_Zle args
         | CCZge -> mk_bop BO_Zge args
         | CCZgt -> mk_bop BO_Zgt args
-        | CCeqb -> mk_teq Tbool args
-        | CCeqbP -> mk_teq Tpositive args
-        | CCeqbZ -> mk_teq TZ args
-	| CCunknown -> let ty = Retyping.get_type_of env sigma h in
-                       mk_unknown c args ty
+        | CCBVand -> mk_bop_bvand args
+        | CCBVor -> mk_bop_bvor args
+        | CCBVxor -> mk_bop_bvxor args
+        | CCBVadd -> mk_bop_bvadd args
+        | CCBVmult -> mk_bop_bvmult args
+        | CCBVult -> mk_bop_bvult args
+        | CCBVslt -> mk_bop_bvslt args
+        | CCBVconcat -> mk_bop_bvconcat args
+        | CCBVextr -> mk_bvextr args
+        | CCBVzextn -> mk_bvzextn args
+        | CCBVsextn -> mk_bvsextn args
+        | CCBVshl -> mk_bop_bvshl args
+        | CCBVshr -> mk_bop_bvshr args
+        | CCeqb -> mk_bop (BO_eq Tbool) args
+        | CCeqbP -> mk_bop (BO_eq Tpositive) args
+        | CCeqbZ -> mk_bop (BO_eq TZ) args
+        | CCeqbA -> mk_bop_farray_equal args
+        | CCeqbBV -> mk_bop_bveq args
+        | CCselect -> mk_bop_select args
+        | CCdiff -> mk_bop_diff args
+        | CCstore -> mk_top_store args
+	| CCunknown -> mk_unknown c args (Retyping.get_type_of env sigma h)
+        | CCunknown_deps gobble ->
+          mk_unknown_deps c args (Retyping.get_type_of env sigma h) gobble
+
+
+      and mk_cop op args = match op, args with
+        | CCxH, [] -> get reify (Acop CO_xH)
+        | CCZ0, [] -> get reify (Acop CO_Z0)
+        | CCBV, [bs] -> get reify (Acop (CO_BV (mk_bool_list bs)))
+        | _ -> assert false
 
-      and mk_cop op = get reify (Acop op)
 
       and mk_uop op = function
-        | [a] -> let h = mk_hatom a in get reify (Auop (op,h))
-        | _ -> failwith "unexpected number of arguments for mk_uop"
-
-      and mk_teq ty args = 
-        if h then match args with    
-        | [a1; a2] -> let h1 = mk_hatom a1 in
-                      let h2 = mk_hatom a2 in
-                      mk_eq reify true ty h1 h2
-        | _ -> failwith "unexpected number of arguments for mk_teq"
-        else mk_bop (BO_eq ty) args
+        | [a] -> let h = mk_hatom a in
+          get reify (Auop (op,h))
+        | _ -> assert false
+
+      and mk_bvbitof = function
+        | [s;n;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVbitOf (mk_bvsize s, mk_nat n), h))
+        | _ -> assert false
+
+      and mk_bvnot = function
+        | [s;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVnot (mk_bvsize s), h))
+        | _ -> assert false
+
+      and mk_bvneg = function
+        | [s;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVneg (mk_bvsize s), h))
+        | _ -> assert false
+
+      and mk_bvextr = function
+        | [i;n;s;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVextr (mk_N i, mk_N n, mk_bvsize s), h))
+        | _ -> assert false
+
+      and mk_bvzextn = function
+        | [s;n;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVzextn (mk_bvsize s, mk_N n), h))
+        | _ -> assert false
+
+      and mk_bvsextn = function
+        | [s;n;a] ->
+          let h = mk_hatom a in
+          get reify (Auop (UO_BVsextn (mk_bvsize s, mk_N n), h))
+        | _ -> assert false
 
       and mk_bop op = function
         | [a1;a2] ->
@@ -592,19 +1124,148 @@ module Atom =
            get reify (Abop (op,h1,h2))
         | _ -> failwith "unexpected number of arguments for mk_bop"
 
+      and mk_top op = function
+        | [a1;a2;a3] ->
+          let h1 = mk_hatom a1 in
+          let h2 = mk_hatom a2 in
+          let h3 = mk_hatom a3 in
+          get reify (Atop (op,h1,h2,h3))
+        | _ -> assert false
+
+      and mk_bop_bvand = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVand s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvor = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVor s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvxor = function
+        | [s;a1;a2] ->
+          let s' = mk_bvsize s in
+          mk_bop (BO_BVxor s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvadd = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVadd s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvmult = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVmult s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvult = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVult s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvslt = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVslt s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvshl = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVshl s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvshr = function
+        | [s;a1;a2] ->
+           let s' = mk_bvsize s in
+           mk_bop (BO_BVshr s') [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bvconcat = function
+        | [s1;s2;a1;a2] ->
+           mk_bop (BO_BVconcat (mk_bvsize s1, mk_bvsize s2)) [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_bveq = function
+        | [s;a1;a2] when SL.mem LBitvectors known_logic ->
+          let s' = mk_bvsize s in
+          mk_bop (BO_eq (TBV s')) [a1;a2]
+        (* We still want to interpret bv equality as uninterpreted
+           smtlib2 equality if the solver doesn't support bitvectors *)
+        | [s;a1;a2] ->
+          let ty = SmtBtype.of_coq rt known_logic (mklApp cbitvector [|s|]) in
+          mk_bop (BO_eq ty) [a1;a2]
+        | _ -> assert false
+
+      and mk_bop_select = function
+        | [ti;te;_;_;_;a;i] ->
+          let ti' = SmtBtype.of_coq rt known_logic ti in
+          let te' = SmtBtype.of_coq rt known_logic te in
+          mk_bop (BO_select (ti', te')) [a; i]
+        | _ -> assert false
+
+      and mk_bop_diff = function
+        | [ti;te;_;_;_;_;_;_;_;_;a;b] ->
+          let ti' = SmtBtype.of_coq rt known_logic ti in
+          let te' = SmtBtype.of_coq rt known_logic te in
+          mk_bop (BO_diffarray (ti', te')) [a; b]
+        | _ -> assert false
+
+      and mk_top_store = function
+        | [ti;te;_;_;_;_;_;_;a;i;e] ->
+          let ti' = SmtBtype.of_coq rt known_logic ti in
+          let te' = SmtBtype.of_coq rt known_logic te in
+          mk_top (TO_store (ti', te')) [a; i; e]
+        | _ -> assert false
+
+      and mk_bop_farray_equal = function
+        | [ti;te;_;_;_;_;_;a;b] when SL.mem LArrays known_logic ->
+          let ti' = SmtBtype.of_coq rt known_logic ti in
+          let te' = SmtBtype.of_coq rt known_logic te in
+          mk_bop (BO_eq (TFArray (ti', te'))) [a; b]
+        (* We still want to interpret array equality as uninterpreted
+           smtlib2 equality if the solver doesn't support arrays *)
+        | [ti;te;ord_ti;_;_;_;inh_te;a;b] ->
+          let ty = SmtBtype.of_coq rt known_logic
+              (mklApp cfarray [|ti; te; ord_ti; inh_te|]) in
+          mk_bop (BO_eq ty) [a;b]
+        | _ -> assert false
+
       and mk_unknown c args ty =
         let hargs = Array.of_list (List.map mk_hatom args) in
-        let op = try Op.of_coq ro c
-                 with Not_found ->
-                   let targs = Array.map type_of hargs in
-                   let tres = SmtBtype.of_coq rt ty in
-                   let os = if Term.isRel c
-                            then let i = Term.destRel c in
-                                 let n, _ = Structures.destruct_rel_decl (Environ.lookup_rel i env) in
-                                 Some (string_of_name n)
-                            else None in
-                   Op.declare ro c targs tres os in
-        get reify (Aapp (op,hargs)) in
+        let op =
+          try Op.of_coq ro c
+          with | Not_found ->
+            let targs = Array.map type_of hargs in
+            let tres = SmtBtype.of_coq rt known_logic ty in
+            let os = if Term.isRel c then
+                       let i = Term.destRel c in
+                       let n, _ = Structures.destruct_rel_decl (Environ.lookup_rel i env) in
+                       Some (string_of_name n)
+                     else
+                       None
+            in
+            Op.declare ro c targs tres os in
+        (try
+           let (i, _) = destruct "" op in
+           Hashtbl.add op_coq_terms i c (* Chantal: I think we should move it to "Not_found" (otherwise it is already in the table) *)
+         with | Failure _ -> ());
+        get reify (Aapp (op,hargs))
+
+      (* create an uninterpreted symbol for an unsupported symbol but fisrt do
+         partial application to its dependent arguments whose number is given by
+         [gobble] *)
+      and mk_unknown_deps c args ty gobble =
+        let deps, args = split_list_at gobble args in
+        let c = Term.mkApp (c, Array.of_list deps) in
+        mk_unknown c args ty
+
+      in
 
       mk_hatom c
 
@@ -616,15 +1277,21 @@ module Atom =
       | Acop op -> mklApp cAcop [|Op.c_to_coq op|]
       | Auop (op,h) -> mklApp cAuop [|Op.u_to_coq op; to_coq h|]
       | Abop (op,h1,h2) ->
-	 mklApp cAbop [|Op.b_to_coq op;to_coq h1; to_coq h2|]
+	  mklApp cAbop [|Op.b_to_coq op;to_coq h1; to_coq h2|]
+      | Atop (op,h1,h2,h3) ->
+	  mklApp cAtop [|Op.t_to_coq op;to_coq h1; to_coq h2; to_coq h3|]
       | Anop (op,ha) ->
-         let cop = Op.n_to_coq op in
-         let cargs = Array.fold_right (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|]) ha (mklApp cnil [|Lazy.force cint|]) in
-         mklApp cAnop [|cop; cargs|]
+        let cop = Op.n_to_coq op in
+        let cargs = Array.fold_right
+            (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|])
+            ha (mklApp cnil [|Lazy.force cint|]) in
+        mklApp cAnop [|cop; cargs|]
       | Aapp (op,args) ->
-         let cop = Op.i_to_coq op in
-         let cargs = Array.fold_right (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|]) args (mklApp cnil [|Lazy.force cint|]) in
-         mklApp cAapp [|cop; cargs|]
+        let cop = Op.i_to_coq op in
+        let cargs = Array.fold_right
+            (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|])
+            args (mklApp cnil [|Lazy.force cint|]) in
+        mklApp cAapp [|cop; cargs|]
 
     let dft_atom = lazy (mklApp cAcop [| Lazy.force cCO_xH |])
 
@@ -640,22 +1307,30 @@ module Atom =
 
 
     (** Producing a Coq term corresponding to the interpretation of an atom *)
-    let interp_to_coq atom_tbl a =
+    let interp_to_coq t_i atom_tbl a =
       let rec interp_atom a =
 	let l = index a in
 	try Hashtbl.find atom_tbl l
 	with Not_found ->
 	  let pc =
 	    match atom a with
-            | Acop c -> Op.interp_cop c
-            | Auop (op,h) -> Term.mkApp (Op.interp_uop op, [|interp_atom h|])
-            | Abop (op,h1,h2) -> Term.mkApp (Op.interp_bop op, [|interp_atom h1; interp_atom h2|])
-            | Anop (NO_distinct ty as op,ha) ->
-               let cop = Op.interp_nop op in
-               let typ = Op.interp_distinct ty in
-               let cargs = Array.fold_right (fun h l -> mklApp ccons [|typ; interp_atom h; l|]) ha (mklApp cnil [|typ|]) in
-               Term.mkApp (cop,[|cargs|])
-            | Aapp ((_, hval),t) -> Term.mkApp (hval.op_val, Array.map interp_atom t) in
+              | Acop c -> Op.interp_cop c
+              | Auop (op,h) -> Term.mkApp (Op.interp_uop op, [|interp_atom h|])
+              | Abop (op,h1,h2) ->
+                Term.mkApp (Op.interp_bop t_i op,
+                            [|interp_atom h1; interp_atom h2|])
+              | Atop (op,h1,h2,h3) ->
+                Term.mkApp (Op.interp_top t_i op,
+                            [|interp_atom h1; interp_atom h2; interp_atom h3|])
+              | Anop (NO_distinct ty as op,ha) ->
+                let cop = Op.interp_nop t_i op in
+                let typ = SmtBtype.interp t_i ty in
+                let cargs = Array.fold_right (fun h l ->
+                    mklApp ccons [|typ; interp_atom h; l|])
+                    ha (mklApp cnil [|typ|]) in
+                Term.mkApp (cop,[|cargs|])
+              | Aapp (op,t) ->
+                Term.mkApp ((snd op).op_val, Array.map interp_atom t) in
 	  Hashtbl.add atom_tbl l pc;
 	  pc in
       interp_atom a
@@ -663,11 +1338,13 @@ module Atom =
 
     (* Generation of atoms *)
 
-    let mk_nop op reify ?declare:(decl=true) a = get ~declare:decl reify (Anop (op,a))
+    let mk_nop ?declare:(decl=true) op reify a = get ~declare:decl reify (Anop (op,a))
+
+    let mk_binop ?declare:(decl=true) op reify h1 h2 = get ~declare:decl reify (Abop (op, h1, h2))
 
-    let mk_binop op reify decl h1 h2 = get ~declare:decl reify (Abop (op, h1, h2))
+    let mk_terop ?declare:(decl=true) op reify h1 h2 h3 = get ~declare:decl reify (Atop (op, h1, h2, h3))
 
-    let mk_unop op reify ?declare:(decl=true) h = get ~declare:decl reify (Auop (op, h))
+    let mk_unop ?declare:(decl=true) op reify h = get ~declare:decl reify (Auop (op, h))
 
     let rec hatom_pos_of_int reify i =
       if i <= 1 then
@@ -702,19 +1379,57 @@ module Atom =
         if Big_int.gt_big_int i Big_int.zero_big_int then
           mk_unop UO_Zpos reify (hatom_pos_of_bigint reify i)
         else
-          mk_unop UO_Zneg reify (hatom_pos_of_bigint reify (Big_int.minus_big_int i))
-
-    let mk_unop op reify ?declare:(decl=true) h = get ~declare:decl reify (Auop (op, h))
-
-    let mk_lt = mk_binop BO_Zlt
-    let mk_le = mk_binop BO_Zle
-    let mk_gt = mk_binop BO_Zgt
-    let mk_ge = mk_binop BO_Zge
-    let mk_plus = mk_binop BO_Zplus
-    let mk_minus = mk_binop BO_Zminus
-    let mk_mult = mk_binop BO_Zmult
-    let mk_opp = mk_unop UO_Zopp
-    let mk_distinct reify ty = mk_nop (NO_distinct ty) reify
+          mk_unop UO_Zneg reify
+            (hatom_pos_of_bigint reify (Big_int.minus_big_int i))
+
+    let mk_unop ?declare:(decl=true) op reify h = get ~declare:decl reify (Auop (op, h))
+
+    let mk_lt ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zlt ra
+    let mk_le ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zle ra
+    let mk_gt ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zgt ra
+    let mk_ge ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zge ra
+    let mk_plus ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zplus ra
+    let mk_minus ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zminus ra
+    let mk_mult ra ?declare:(decl=true) = mk_binop ~declare:decl BO_Zmult ra
+    let mk_bvand reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVand s) reify
+    let mk_bvor reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVor s) reify
+    let mk_bvxor reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVxor s) reify
+    let mk_bvadd reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVadd s) reify
+    let mk_bvmult reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVmult s) reify
+    let mk_bvult reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVult s) reify
+    let mk_bvslt reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVslt s) reify
+    let mk_bvconcat reify ?declare:(decl=true) s1 s2 = mk_binop ~declare:decl (BO_BVconcat (s1, s2)) reify
+    let mk_opp ra ?declare:(decl=true) = mk_unop ~declare:decl UO_Zopp ra
+    let mk_distinct reify ?declare:(decl=true) ty = mk_nop ~declare:decl (NO_distinct ty) reify
+    let mk_bitof reify ?declare:(decl=true) s i = mk_unop ~declare:decl (UO_BVbitOf (s, i)) reify
+    let mk_bvnot reify ?declare:(decl=true) s = mk_unop ~declare:decl (UO_BVnot s) reify
+    let mk_bvneg reify ?declare:(decl=true) s = mk_unop ~declare:decl (UO_BVneg s) reify
+    let mk_bvconst reify bool_list = get reify (Acop (CO_BV bool_list))
+    let mk_select reify ?declare:(decl=true) ti te = mk_binop ~declare:decl (BO_select (ti, te)) reify
+    let mk_diffarray reify ?declare:(decl=true) ti te = mk_binop ~declare:decl (BO_diffarray (ti, te)) reify
+    let mk_store reify ?declare:(decl=true) ti te = mk_terop ~declare:decl (TO_store (ti, te)) reify
+    let mk_bvextr reify ?declare:(decl=true) ~i ~n ~s = mk_unop ~declare:decl (UO_BVextr (i, n, s)) reify
+    let mk_bvzextn reify ?declare:(decl=true) ~s ~n = mk_unop ~declare:decl (UO_BVzextn (s, n)) reify
+    let mk_bvsextn reify ?declare:(decl=true) ~s ~n = mk_unop ~declare:decl (UO_BVsextn (s, n)) reify
+    let mk_bvshl reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVshl s) reify
+    let mk_bvshr reify ?declare:(decl=true) s = mk_binop ~declare:decl (BO_BVshr s) reify
+
+
+    let rec logic_atom = function
+      | Acop c -> Op.logic_of_cop c
+      | Auop (u, h) -> SL.union (Op.logic_of_uop u) (logic h)
+      | Abop (b, h1, h2) ->
+        SL.union (Op.logic_of_bop b) (SL.union (logic h1) (logic h2))
+      | Atop (t, h1, h2, h3) ->
+        SL.union (Op.logic_of_top t)
+          (SL.union (logic h1) (SL.union (logic h2) (logic h3)))
+      | Anop (n, ha) ->
+        Array.fold_left (fun l h -> SL.union (logic h) l) (Op.logic_of_nop n) ha
+      | Aapp (i, ha) ->
+        Array.fold_left (fun l h -> SL.union (logic h) l)
+          (Op.logic_of_indexed i) ha
+
+    and logic h = logic_atom h.hval
 
   end
 
@@ -728,9 +1443,13 @@ module Trace = SmtTrace.MakeOpt(Form)
 let mk_ftype cod dom =
   let typeb = Lazy.force ctype in
   let typea = mklApp clist [|typeb|] in
-  let a = Array.fold_right (fun bt acc -> mklApp ccons [|typeb; SmtBtype.to_coq bt; acc|]) cod (mklApp cnil [|typeb|]) in
+  let a = Array.fold_right
+      (fun bt acc -> mklApp ccons [|typeb; SmtBtype.to_coq bt; acc|])
+      cod (mklApp cnil [|typeb|]) in
   let b = SmtBtype.to_coq dom in
   mklApp cpair [|typea;typeb;a;b|]
 
-let make_t_i rt = SmtBtype.interp_tbl rt
-let make_t_func ro t_i = Op.interp_tbl (mklApp ctval [|t_i|]) (fun cod dom value -> mklApp cTval [|t_i; mk_ftype cod dom; value|]) ro
+let make_t_i = SmtBtype.make_t_i
+let make_t_func ro t_i =
+  Op.interp_tbl (mklApp ctval [|t_i|])
+    (fun cod dom value -> mklApp cTval [|t_i; mk_ftype cod dom; value|]) ro
diff --git a/src/trace/smtAtom.mli b/src/trace/smtAtom.mli
index 47734fb..a542ad6 100644
--- a/src/trace/smtAtom.mli
+++ b/src/trace/smtAtom.mli
@@ -1,34 +1,38 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
+
 open SmtBtype
 
 (** Operators *)
 
-type cop = 
+type cop =
    | CO_xH
    | CO_Z0
+   | CO_BV of bool list
 
 type uop =
    | UO_xO
    | UO_xI
-   | UO_Zpos 
+   | UO_Zpos
    | UO_Zneg
    | UO_Zopp
-
-type bop = 
+   | UO_BVbitOf of int * int
+   | UO_BVnot of int
+   | UO_BVneg of int
+   | UO_BVextr of int * int * int
+   | UO_BVzextn of int * int
+   | UO_BVsextn of int * int
+
+type bop =
    | BO_Zplus
    | BO_Zminus
    | BO_Zmult
@@ -37,21 +41,37 @@ type bop =
    | BO_Zge
    | BO_Zgt
    | BO_eq of btype
+   | BO_BVand of int
+   | BO_BVor of int
+   | BO_BVxor of int
+   | BO_BVadd of int
+   | BO_BVmult of int
+   | BO_BVult of int
+   | BO_BVslt of int
+   | BO_BVconcat of int * int
+   | BO_BVshl of int
+   | BO_BVshr of int
+   | BO_select of btype * btype
+   | BO_diffarray of btype * btype
+
+type top =
+   | TO_store of btype * btype
 
 type nop =
   | NO_distinct of btype
 
-type indexed_op
-
 type index = Index of int
            | Rel_name of string
 
+type indexed_op
+
 val dummy_indexed_op: index -> btype array -> btype -> indexed_op
 val indexed_op_index : indexed_op -> int
+val debruijn_indexed_op : int -> btype -> indexed_op
 
 module Op :
   sig
-	  
+
     type reify_tbl
 
     val create : unit -> reify_tbl
@@ -61,93 +81,117 @@ module Op :
 
     val of_coq : reify_tbl -> Term.constr -> indexed_op
 
-    val interp_tbl : Term.constr -> 
-      (btype array -> btype -> Term.constr -> Term.constr) -> 
-      reify_tbl -> Term.constr 
+    val interp_tbl : Term.constr ->
+      (btype array -> btype -> Term.constr -> Term.constr) ->
+      reify_tbl -> Term.constr
 
     val to_list : reify_tbl -> (int * (btype array) * btype * indexed_op) list
 
+    val logic_ro : reify_tbl -> SmtMisc.logic
+
   end
 
 
 (** Definition of atoms *)
 
-type hatom 
+type hatom
 
-type atom = 
+type atom =
   | Acop of cop
-  | Auop of uop * hatom 
-  | Abop of bop * hatom * hatom 
+  | Auop of uop * hatom
+  | Abop of bop * hatom * hatom
+  | Atop of top * hatom * hatom * hatom
   | Anop of nop * hatom array
   | Aapp of indexed_op * hatom array
 
 
 
-module Atom : 
-    sig 
+module Atom :
+    sig
 
       type t = hatom
 
-      val equal : hatom -> hatom -> bool
+      val equal : t -> t -> bool
 
-      val index : hatom -> int
+      val index : t -> int
 
-      val atom : hatom -> atom
- 
-      val type_of : hatom -> btype
+      val atom : t -> atom
+
+      val type_of : t -> btype
 
-      val to_string : ?pi:bool -> hatom -> string
-                               
       val to_smt : Format.formatter -> t -> unit
 
       exception NotWellTyped of atom
 
-      type reify_tbl 
+      type reify_tbl
 
       val create : unit -> reify_tbl
 
       val clear : reify_tbl -> unit
 
-      val get : ?declare:bool -> reify_tbl -> atom -> hatom
+      val get : ?declare:bool -> reify_tbl -> atom -> t
 
-      val mk_eq : reify_tbl -> bool -> btype -> hatom -> hatom -> hatom
+      val mk_neg : reify_tbl -> t -> t
 
-      val mk_neg : reify_tbl -> hatom -> hatom
-                                                                    
-      val hash_hatom : reify_tbl -> hatom -> hatom
+      val hash_hatom : reify_tbl -> t -> t
 
       (** for debugging purposes **)
 
       val copy : reify_tbl -> reify_tbl
-                                                        
+
       val print_atoms : reify_tbl -> string -> unit
-                                       
+
       (** Given a coq term, build the corresponding atom *)
       val of_coq : ?hash:bool -> SmtBtype.reify_tbl -> Op.reify_tbl ->
-        reify_tbl -> Environ.env -> Evd.evar_map -> Term.constr -> t
+        reify_tbl -> SmtMisc.logic -> Environ.env -> Evd.evar_map -> Term.constr -> t
+
+      val get_coq_term_op : int -> Term.constr
 
-      val to_coq : hatom -> Term.constr
+      val to_coq : t -> Term.constr
 
       val to_array : reify_tbl -> 'a -> (atom -> 'a) -> 'a array
 
       val interp_tbl : reify_tbl -> Term.constr
 
-      val interp_to_coq : (int, Term.constr) Hashtbl.t ->
+      val interp_to_coq : Term.constr -> (int, Term.constr) Hashtbl.t ->
 	t -> Term.constr
 
+      val logic : t -> SmtMisc.logic
+
       (* Generation of atoms *)
-      val hatom_Z_of_int : reify_tbl -> int -> hatom
-      val hatom_Z_of_bigint : reify_tbl -> Big_int.big_int -> hatom
-
-      val mk_lt : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_le : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_gt : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_ge : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_plus : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_minus : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_mult : reify_tbl -> bool -> hatom -> hatom -> hatom
-      val mk_opp : reify_tbl -> ?declare:bool -> hatom -> hatom
-      val mk_distinct : reify_tbl -> btype -> ?declare:bool -> hatom array -> hatom
+      val hatom_Z_of_int : reify_tbl -> int -> t
+      val hatom_Z_of_bigint : reify_tbl -> Big_int.big_int -> t
+      val mk_eq : reify_tbl -> ?declare:bool -> btype -> t -> t -> t
+      val mk_lt : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_le : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_gt : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_ge : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_plus : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_minus : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_mult : reify_tbl -> ?declare:bool -> t -> t -> t
+      val mk_bvand : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvor : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvxor : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvadd : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvmult : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvult : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvslt : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvconcat : reify_tbl -> ?declare:bool -> int -> int -> t -> t -> t
+      val mk_opp : reify_tbl -> ?declare:bool -> t -> t
+      val mk_distinct : reify_tbl -> ?declare:bool -> btype -> t array -> t
+      val mk_bitof : reify_tbl -> ?declare:bool -> int -> int -> t -> t
+      val mk_bvnot : reify_tbl -> ?declare:bool -> int -> t -> t
+      val mk_bvneg : reify_tbl -> ?declare:bool -> int -> t -> t
+      val mk_bvconst : reify_tbl -> bool list -> t
+      val mk_bvextr : reify_tbl -> ?declare:bool -> i:int -> n:int -> s:int -> t -> t
+      val mk_bvzextn : reify_tbl -> ?declare:bool -> s:int -> n:int -> t -> t
+      val mk_bvsextn : reify_tbl -> ?declare:bool -> s:int -> n:int -> t -> t
+      val mk_bvshl : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_bvshr : reify_tbl -> ?declare:bool -> int -> t -> t -> t
+      val mk_select : reify_tbl -> ?declare:bool -> btype -> btype -> t -> t -> t
+      val mk_diffarray : reify_tbl -> ?declare:bool -> btype -> btype -> t -> t -> t
+      val mk_store :
+        reify_tbl -> ?declare:bool -> btype -> btype -> t -> t -> t -> t
 
     end
 
diff --git a/src/trace/smtBtype.ml b/src/trace/smtBtype.ml
index f3245ea..8580ed0 100644
--- a/src/trace/smtBtype.ml
+++ b/src/trace/smtBtype.ml
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 open SmtMisc
 open CoqTerms
 
@@ -13,6 +25,8 @@ type btype =
   | TZ
   | Tbool
   | Tpositive
+  | TBV of int
+  | TFArray of btype * btype
   | Tindex of indexed_type
 
 let index_tbl = Hashtbl.create 17
@@ -26,31 +40,45 @@ let index_to_coq i =
 
 let indexed_type_of_int i =
   {index = i; hval = index_to_coq i }
-      
-let equal t1 t2 =
+
+let rec equal t1 t2 =
   match t1,t2 with
-  | Tindex i, Tindex j -> i.index == j.index
-  | _ -> t1 == t2
+    | Tindex i, Tindex j -> i.index == j.index
+    | TBV i, TBV j -> i == j
+    | TFArray (ti, te), TFArray (ti', te') -> equal ti ti' && equal te te'
+    | _ -> t1 == t2
 
-let to_coq = function
+let rec to_coq = function
   | TZ -> Lazy.force cTZ
   | Tbool -> Lazy.force cTbool
   | Tpositive -> Lazy.force cTpositive
+  | TBV n -> mklApp cTBV [|mkN n|]
   | Tindex i -> index_to_coq i.index
-
-let to_string = function
-  | TZ -> "Int"
-  | Tbool -> "Bool"
-  | Tpositive -> "Int"
-  | Tindex i -> "Tindex_" ^ string_of_int i.index
-
-let to_smt fmt b = Format.fprintf fmt "%s" (to_string b)
+  | TFArray (ti, te) ->
+     mklApp cTFArray [|to_coq ti; to_coq te|]
+
+let rec to_smt fmt = function
+  | TZ -> Format.fprintf fmt "Int"
+  | Tbool -> Format.fprintf fmt "Bool"
+  | Tpositive -> Format.fprintf fmt "Int"
+  | TBV i -> Format.fprintf fmt "(_ BitVec %i)" i
+  | Tindex i -> Format.fprintf fmt "Tindex_%i" i.index
+  | TFArray (ti, te) ->
+     Format.fprintf fmt "(Array %a %a)" to_smt ti to_smt te
+
+let rec logic = function
+  | TZ | Tpositive -> SL.singleton LLia
+  | Tbool -> SL.empty
+  | TBV _ -> SL.singleton LBitvectors
+  | Tindex _ -> SL.singleton LUF
+  | TFArray (ti, te) -> SL.add LArrays (SL.union (logic ti) (logic te))
 
 (* reify table *)
 type reify_tbl =
   { mutable count : int;
     tbl : (Term.constr, btype) Hashtbl.t;
-    mutable cuts : (Structures.names_id_t * Term.types) list
+    mutable cuts : (Structures.names_id_t * Term.types) list;
+    unsup_tbl : (btype, btype) Hashtbl.t;
   }
 
 let create () =
@@ -60,58 +88,148 @@ let create () =
   (* Hashtbl.add htbl (Lazy.force cpositive) Tpositive; *)
   { count = 0;
     tbl = htbl;
-    cuts = [] }
-
-let get_cuts reify = reify.cuts
-
-let declare reify t typ_eqb =
-  (* TODO: allows to have only typ_eqb *)
-  assert (not (Hashtbl.mem reify.tbl t));
-  let res = Tindex {index = reify.count; hval = typ_eqb} in
-  Hashtbl.add reify.tbl t res;
-  reify.count <- reify.count + 1;
-  res
+    cuts = [];
+    unsup_tbl = Hashtbl.create 17;
+  }
 
-let of_coq reify t =
-  try
-    Hashtbl.find reify.tbl t
-  with | Not_found ->
-          let n = string_of_int (List.length reify.cuts) in
-          let eq_name = Names.id_of_string ("eq"^n) in
-          let eq_var = Term.mkVar eq_name in
 
-          let eq_ty = Term.mkArrow t (Term.mkArrow t (Lazy.force cbool)) in
+(* Should we give a way to clear it? *)
+let op_coq_types = Hashtbl.create 17
+let get_coq_type_op = Hashtbl.find op_coq_types
 
-          let eq = mkName "eq" in
-          let x = mkName "x" in
-          let y = mkName "y" in
-          let req = Term.mkRel 3 in
-          let rx = Term.mkRel 2 in
-          let ry = Term.mkRel 1 in
-          let refl_ty = Term.mkLambda (eq, eq_ty, Term.mkProd (x,t,Term.mkProd (y,t,mklApp creflect [|mklApp ceq [|t;rx;ry|]; Term.mkApp (req, [|rx;ry|])|]))) in
 
-          let pair_ty = mklApp csigT [|eq_ty; refl_ty|] in
+(* let logic_of_coq reify t = logic (of_coq reify t) *)
 
-          reify.cuts <- (eq_name, pair_ty)::reify.cuts;
-          let ce = mklApp ctyp_eqb_of_typ_eqb_param [|t; eq_var|] in
-          declare reify t ce
 
 let interp_tbl reify =
-  let t = Array.make (reify.count + 1) (Lazy.force cunit_typ_eqb) in
+  let t = Array.make (reify.count + 1) (Lazy.force cunit_typ_compdec) in
   let set _ = function
     | Tindex it -> t.(it.index) <- it.hval
     | _ -> () in
   Hashtbl.iter set reify.tbl;
-  Structures.mkArray (Lazy.force ctyp_eqb, t)
+  Structures.mkArray (Lazy.force ctyp_compdec, t)
+
 
 let to_list reify =
   let set _ t acc = match t with
-    | Tindex it -> (it.index,it)::acc
-    | _ -> acc in
+      | Tindex it -> (it.index,it)::acc
+      | _ -> acc in
   Hashtbl.fold set reify.tbl []
 
-let interp_to_coq reify = function
+let make_t_i rt = interp_tbl rt
+
+
+let interp_t t_i t =
+  mklApp cinterp_t [|t_i ; to_coq t|]
+
+let dec_interp t_i t =
+  mklApp cdec_interp [|t_i ; to_coq t|]
+
+let ord_interp t_i t =
+  mklApp cord_interp [|t_i ; to_coq t|]
+
+let comp_interp t_i t =
+  mklApp ccomp_interp [|t_i ; to_coq t|]
+
+let inh_interp t_i t =
+  mklApp cinh_interp [|t_i ; to_coq t|]
+
+let rec interp t_i = function
   | TZ -> Lazy.force cZ
   | Tbool -> Lazy.force cbool
   | Tpositive -> Lazy.force cpositive
+  | TBV n -> mklApp cbitvector [|mkN n|]
   | Tindex c -> mklApp cte_carrier [|c.hval|]
+  (* | TFArray _ as t -> interp_t t_i t *)
+  | TFArray (ti,te) ->
+     mklApp cfarray [| interp t_i ti; interp t_i te;
+                       ord_interp t_i ti; inh_interp t_i te |]
+
+
+let interp_to_coq reify t = interp (make_t_i reify) t
+
+let get_cuts reify = reify.cuts
+
+let declare reify t typ_compdec =
+  (* TODO: allows to have only typ_compdec *)
+  assert (not (Hashtbl.mem reify.tbl t));
+  let res = Tindex {index = reify.count; hval = typ_compdec} in
+  Hashtbl.add reify.tbl t res;
+  reify.count <- reify.count + 1;
+  res
+
+exception Unknown_type of btype
+
+let check_known ty known_logic =
+  let l = logic ty in
+  if not (SL.subset l known_logic) then raise (Unknown_type ty)
+  else ty
+
+let rec compdec_btype reify = function
+  | Tbool -> Lazy.force cbool_compdec
+  | TZ -> Lazy.force cZ_compdec
+  | Tpositive -> Lazy.force cPositive_compdec
+  | TBV s -> mklApp cBV_compdec [|mkN s|]
+  | TFArray (ti, te) ->
+     mklApp cFArray_compdec
+       [|interp_to_coq reify ti; interp_to_coq reify te;
+         compdec_btype reify ti; compdec_btype reify te|]
+  | Tindex i ->
+     let c, args = Term.decompose_app i.hval in
+     if Term.eq_constr c (Lazy.force cTyp_compdec) then
+       match args with
+         | [_; tic] -> tic
+         | _ -> assert false
+     else assert false
+
+
+let declare_and_compdec reify t ty =
+  try Hashtbl.find reify.unsup_tbl ty
+  with Not_found ->
+    let res =
+      declare reify t (mklApp cTyp_compdec [|t; compdec_btype reify ty|])
+    in
+    Hashtbl.add reify.unsup_tbl ty res;
+    res
+
+
+let rec of_coq reify known_logic t =
+  try
+    let c, args = Term.decompose_app t in
+    if Term.eq_constr c (Lazy.force cbool) ||
+         Term.eq_constr c (Lazy.force cTbool) then Tbool
+    else if Term.eq_constr c (Lazy.force cZ) ||
+              Term.eq_constr c (Lazy.force cTZ) then
+      check_known TZ known_logic
+    else if Term.eq_constr c (Lazy.force cpositive) ||
+              Term.eq_constr c (Lazy.force cTpositive) then
+      check_known Tpositive known_logic
+    else if Term.eq_constr c (Lazy.force cbitvector) ||
+              Term.eq_constr c (Lazy.force cTBV) then
+      match args with
+        | [s] -> check_known (TBV (mk_bvsize s)) known_logic
+        | _ -> assert false
+    else if Term.eq_constr c (Lazy.force cfarray) ||
+              Term.eq_constr c (Lazy.force cTFArray) then
+      match args with
+        | ti :: te :: _ ->
+           let ty = TFArray (of_coq reify known_logic ti,
+                             of_coq reify known_logic te) in
+           check_known ty known_logic
+        | _ -> assert false
+    else
+      try Hashtbl.find reify.tbl t
+      with Not_found ->
+        let n = string_of_int (List.length reify.cuts) in
+        let compdec_name = Names.id_of_string ("CompDec"^n) in
+        let compdec_var = Term.mkVar compdec_name in
+        let compdec_type = mklApp cCompDec [| t |]in
+        reify.cuts <- (compdec_name, compdec_type) :: reify.cuts;
+        let ce = mklApp cTyp_compdec [|t; compdec_var|] in
+        let ty = declare reify t ce in
+        (match ty with Tindex h -> Hashtbl.add op_coq_types h.index t | _ -> assert false);
+        ty
+
+  with Unknown_type ty ->
+    try Hashtbl.find reify.tbl t
+    with Not_found -> declare_and_compdec reify t ty
diff --git a/src/trace/smtBtype.mli b/src/trace/smtBtype.mli
index 29e91bf..559e809 100644
--- a/src/trace/smtBtype.mli
+++ b/src/trace/smtBtype.mli
@@ -1,18 +1,64 @@
-type indexed_type
-val dummy_indexed_type : int -> indexed_type
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open SmtMisc
+
+
+type indexed_type = Term.constr gen_hashed
+
+val dummy_indexed_type: int -> indexed_type
 val indexed_type_index : indexed_type -> int
 val indexed_type_hval : indexed_type -> Term.constr
-type btype = TZ | Tbool | Tpositive | Tindex of indexed_type
-val indexed_type_of_int : int -> indexed_type
+
+type btype =
+  | TZ
+  | Tbool
+  | Tpositive
+  | TBV of int
+  | TFArray of btype * btype
+  | Tindex of indexed_type
+
+val indexed_type_of_int : int -> Term.constr SmtMisc.gen_hashed
+
 val equal : btype -> btype -> bool
+
 val to_coq : btype -> Term.constr
-val to_string : btype -> string
+
 val to_smt : Format.formatter -> btype -> unit
+
 type reify_tbl
+
 val create : unit -> reify_tbl
-val get_cuts : reify_tbl -> (Structures.names_id_t * Term.types) list
+
 val declare : reify_tbl -> Term.constr -> Term.constr -> btype
-val of_coq : reify_tbl -> Term.types -> btype
+
+val of_coq : reify_tbl -> logic -> Term.constr -> btype
+
+val get_coq_type_op : int -> Term.constr
+
 val interp_tbl : reify_tbl -> Term.constr
-val to_list : reify_tbl -> (int * indexed_type) list
-val interp_to_coq : 'a -> btype -> Term.constr
+
+val to_list : reify_tbl ->  (int * indexed_type) list
+
+val make_t_i : reify_tbl -> Term.constr
+
+val dec_interp : Term.constr -> btype -> Term.constr
+val ord_interp : Term.constr -> btype -> Term.constr
+val comp_interp : Term.constr -> btype -> Term.constr
+val inh_interp : Term.constr -> btype -> Term.constr
+val interp : Term.constr -> btype -> Term.constr
+
+val interp_to_coq : reify_tbl -> btype -> Term.constr
+
+val get_cuts : reify_tbl -> (Structures.names_id_t * Term.types) list
+
+val logic : btype -> logic
diff --git a/src/trace/smtCertif.ml b/src/trace/smtCertif.ml
index 275f6d1..b1468e4 100644
--- a/src/trace/smtCertif.ml
+++ b/src/trace/smtCertif.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -21,6 +17,11 @@ type used = int
 type clause_id  = int
 
 type 'hform rule =
+  (* Weakening *)
+  | Weaken of 'hform clause * 'hform list
+     (*  * weaken          : {a_1 ... a_n} --> {a_1 ... a_n b_1 ... b_n} *)
+
+  (* Simplification *)
   | ImmFlatten of 'hform clause * 'hform
 
   (* CNF Transformations *)
@@ -108,6 +109,114 @@ type 'hform rule =
   (* Elimination of operators *)
   | SplDistinctElim of 'hform clause * 'hform
 
+  (* Bit-blasting *)
+  | BBVar of 'hform
+  (* Bit-blasting a variable:
+
+       ----------------------- bbVar
+        bbT(x, [x0; ...; xn])
+   *)
+  | BBConst of 'hform
+  (* Bit-blasting a constant:
+
+       ----------------------- bbConst
+        bbT(#0100, [0; 0; 1; 0])
+   *)
+  | BBOp of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitwise operations: bbAnd, bbOr, ...
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a&b, [a0 /\ b0; ...; an /\ bn])
+   *)
+  | BBNot of 'hform clause * 'hform
+  (* Bit-blasting bitvector not
+           bbT(a, [a0; ...; an])
+       ------------------------------ bbNot
+        bbT(not a, [~a0 ; ...; ~an])
+   *)
+  | BBNeg of 'hform clause * 'hform
+  (* Bit-blasting bitvector negation
+           bbT(a, [a0; ...; an])
+       ------------------------------ bbNot
+        bbT(-a, [...])
+   *)
+  | BBAdd of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector addition
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a+b, [...])
+   *)
+  | BBMul of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector multiplication
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a*b, [...])
+   *)
+  | BBUlt of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector unsigned comparison
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bvult a b <-> ...
+   *)
+  | BBSlt of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector signed comparison
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bvslt a b <-> ...
+   *)
+  | BBConc of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector concatenation
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbConc
+             bbT(concat a b, [a0; ...; an; b0; ...; bn])
+   *)
+  | BBExtr of 'hform clause * 'hform
+  (* Bit-blasting bitvector extraction
+             bbT(a, [a0; ...; an])
+       ----------------------------------- bbExtr
+        bbT(extract i j a, [ai; ...; aj])
+   *)
+  | BBZextn of 'hform clause * 'hform
+  | BBSextn of 'hform clause * 'hform
+  (* Bit-blasting bitvector extensions
+
+  *)
+  | BBShl of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector shift left *)
+  | BBShr of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector shift right *)
+  | BBEq of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting equality
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbEq
+         (a = b) <-> [(a0 <-> b0) /\ ... /\ (an <-> bn)]
+   *)
+
+  | BBDiseq of 'hform
+  (* disequality over constant bitvectors
+
+       ----------------------------- bbDiseq
+         #b000010101 <> #b00000000
+   *)
+
+  | RowEq of 'hform
+  (* Read over write same index
+       ------------------------------- roweq
+         select (store a i v) i = v
+   *)
+
+  | RowNeq of 'hform list
+  (* Read over write other index
+       ------------------------------------------------- rowneq
+         i <> j -> select (store a i v) j = select a j
+   *)
+
+  | Ext of 'hform
+  (* Extensionality over arrays
+       ------------------------------------------------------- ext
+         a = b \/ select a (diff a b) <> select b (diff a b)
+   *)
+
   (* Possibility to introduce "holes" in proofs (that should be filled in Coq) *)
   | Hole of ('hform clause) list * 'hform list
   | Forall_inst of 'hform clause * 'hform
@@ -139,12 +248,26 @@ and 'hform resolution = {
 let used_clauses r =
   match r with
   | ImmBuildProj (c, _) | ImmBuildDef c | ImmBuildDef2 c
-  | ImmFlatten (c,_)  | SplArith (c,_,_) | SplDistinctElim (c,_)
-  | Forall_inst (c, _) | Qf_lemma (c, _) -> [c]
+
+  | Weaken (c,_) | ImmFlatten (c,_)
+  | SplArith (c,_,_) | SplDistinctElim (c,_)
+  | BBNot (c, _) | BBNeg (c, _) | BBExtr (c, _)
+  | BBZextn (c, _) | BBSextn (c, _) -> [c]
+
+  | BBOp (c1,c2,_) | BBAdd (c1,c2,_)
+  | BBMul (c1,c2,_) | BBConc (c1,c2,_)
+  | BBUlt (c1,c2,_) | BBSlt (c1,c2,_)
+  | BBShl (c1,c2,_) | BBShr (c1,c2,_)
+  | BBEq (c1,c2,_) -> [c1;c2]
+
   | Hole (cs, _) -> cs
+  | Forall_inst (c, _) | Qf_lemma (c, _) -> [c]
+
   | True | False | BuildDef _ | BuildDef2 _ | BuildProj _
   | EqTr _ | EqCgr _ | EqCgrP _
-  | LiaMicromega _ | LiaDiseq _ -> []
+  | LiaMicromega _ | LiaDiseq _
+  | BBVar _ | BBConst _ | BBDiseq _
+  | RowEq _ | RowNeq _ | Ext _ -> []
 
 (* For debugging certif processing purposes : <add_scertif> <select> <occur> <alloc> *)
 let to_string r =
@@ -158,27 +281,47 @@ let to_string r =
              "Res [" ^ id1 ^ "; " ^ id2 ^ rest_ids ^"]"
           | Other x -> "Other(" ^
                          begin match x with
-                         | True -> "True"
-                         | False -> "False"
-                         | BuildDef _ -> "BuildDef"
-                         | BuildDef2 _ -> "BuildDef2"
-                         | BuildProj _ -> "BuildProj"
-                         | EqTr _ -> "EqTr"
-                         | EqCgr _ -> "EqCgr"
-                         | EqCgrP _ -> "EqCgrP"
-                         | LiaMicromega _ -> "LiaMicromega"
-                         | LiaDiseq _ -> "LiaDiseq"
-                         | Qf_lemma _ -> "Qf_lemma"
-                                         
-                         | Hole _ -> "Hole"
-
-                         | ImmFlatten _ -> "ImmFlatten"
-                         | ImmBuildDef _ -> "ImmBuildDef"
-                         | ImmBuildDef2 _ -> "ImmBuildDef2"
-                         | ImmBuildProj _ -> "ImmBuildProj"
-                         | SplArith _ -> "SplArith"
-                         | SplDistinctElim _ -> "SplDistinctElim"
-                         | Forall_inst _ -> "Forall_inst"  end ^ ")"
+                           | Weaken _ -> "Weaken"
+                           | ImmFlatten _ -> "ImmFlatten"
+                           | True -> "True"
+                           | False -> "False"
+                           | BuildDef _ -> "BuildDef"
+                           | BuildDef2 _ -> "BuildDef2"
+                           | BuildProj _ -> "BuildProj"
+                           | ImmBuildDef _ -> "ImmBuildDef"
+                           | ImmBuildDef2 _ -> "ImmBuildDef2"
+                           | ImmBuildProj _ -> "ImmBuildProj"
+                           | EqTr _ -> "EqTr"
+                           | EqCgr _ -> "EqCgr"
+                           | EqCgrP _ -> "EqCgrP"
+                           | LiaMicromega _ -> "LiaMicromega"
+                           | LiaDiseq _ -> "LiaDiseq"
+                           | SplArith _ -> "SplArith"
+                           | SplDistinctElim _ -> "SplDistinctElim"
+                           | BBVar _ -> "BBVar"
+                           | BBConst _ -> "BBConst"
+                           | BBOp _ -> "BBOp"
+                           | BBNot _ -> "BBNot"
+                           | BBNeg _ -> "BBNeg"
+                           | BBAdd _ -> "BBAdd"
+                           | BBMul _ -> "BBMul"
+                           | BBUlt _ -> "BBUlt"
+                           | BBSlt _ -> "BBSlt"
+                           | BBConc _ -> "BBConc"
+                           | BBExtr _ -> "BBExtr"
+                           | BBZextn _ -> "BBZextn"
+                           | BBSextn _ -> "BBSextn"
+                           | BBShl _ -> "BBShl"
+                           | BBShr _ -> "BBShr"
+                           | BBEq _ -> "BBEq"
+                           | BBDiseq _ -> "BBDiseq"
+                           | RowEq _ -> "RowEq"
+                           | RowNeq _ -> "RowNeq"
+                           | Ext _ -> "Ext"
+                           | Hole _ -> "Hole"
+                           | Forall_inst _ -> "Forall_inst"
+                           | Qf_lemma _ -> "Qf_lemma"
+                         end ^ ")"
 
 
 
diff --git a/src/trace/smtCertif.mli b/src/trace/smtCertif.mli
index 010934a..6a145bb 100644
--- a/src/trace/smtCertif.mli
+++ b/src/trace/smtCertif.mli
@@ -1,25 +1,220 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 type used = int
 type clause_id = int
 type 'hform rule =
-    ImmFlatten of 'hform clause * 'hform
+  (* Weakening *)
+  | Weaken of 'hform clause * 'hform list
+     (*  * weaken          : {a_1 ... a_n} --> {a_1 ... a_n b_1 ... b_n} *)
+
+  (* Simplification *)
+  | ImmFlatten of 'hform clause * 'hform
+
+  (* CNF Transformations *)
   | True
+     (*  * true             : {true}
+     *)
   | False
-  | BuildDef of 'hform
-  | BuildDef2 of 'hform
+     (* * false             : {(not false)}
+     *)
+  | BuildDef of 'hform (* the first literal of the clause *)
+     (*  * and_neg          : {(and a_1 ... a_n) (not a_1) ... (not a_n)}
+         * or_pos           : {(not (or a_1 ... a_n)) a_1 ... a_n}
+         * implies_pos      : {(not (implies a b)) (not a) b}
+         * xor_pos1         : {(not (xor a b)) a b}
+         * xor_neg1         : {(xor a b) a (not b)}
+         * equiv_pos1       : {(not (iff a b)) a (not b)}
+         * equiv_neg1       : {(iff a b) (not a) (not b)}
+         * ite_pos1         : {(not (if_then_else a b c)) a c}
+         * ite_neg1         : {(if_then_else a b c) a (not c)}
+     *)
+  | BuildDef2 of 'hform (* the first literal of the clause *)
+     (* * xor_pos2          : {(not (xor a b)) (not a) (not b)}
+        * xor_neg2          : {(xor a b) (not a) b}
+        * equiv_pos2        : {(not (iff a b)) (not a) b}
+        * equiv_neg2        : {(iff a b) a b}
+        * ite_pos2          : {(not (if_then_else a b c)) (not a) b}
+        * ite_neg2          : {(if_then_else a b c) (not a) (not b)}
+
+     *)
   | BuildProj of 'hform * int
+     (*  * or_neg           : {(or a_1 ... a_n) (not a_i)}
+         * and_pos          : {(not (and a_1 ... a_n)) a_i}
+         * implies_neg1     : {(implies a b) a}
+         * implies_neg2     : {(implies a b) (not b)}
+     *)
+
+  (* Immediate CNF transformation : CNF transformation + Reso *)
   | ImmBuildDef of 'hform clause
+     (* * not_and           : {(not (and a_1 ... a_n))} --> {(not a_1) ... (not a_n)}
+        * or                : {(or a_1 ... a_n)} --> {a_1 ... a_n}
+        * implies           : {(implies a b)} --> {(not a) b}
+        * xor1              : {(xor a b)} --> {a b}
+        * not_xor1          : {(not (xor a b))} --> {a (not b)}
+        * equiv2            : {(iff a b)} --> {a (not b)}
+        * not_equiv2        : {(not (iff a b))} --> {(not a) (not b)}
+        * ite1              : {(if_then_else a b c)} --> {a c}
+        * not_ite1          : {(not (if_then_else a b c))} --> {a (not c)}
+     *)
   | ImmBuildDef2 of 'hform clause
+     (* * xor2              : {(xor a b)} --> {(not a) (not b)}
+        * not_xor2          : {(not (xor a b))} --> {(not a) b}
+        * equiv1            : {(iff a b)} --> {(not a) b}
+        * not_equiv1        : {(not (iff a b))} --> {a b}
+        * ite2              : {(if_then_else a b c)} --> {(not a) b}
+        * not_ite2          : {(not (if_then_else a b c))} --> {(not a) (not b)}
+     *)
   | ImmBuildProj of 'hform clause * int
+     (*  * and               : {(and a_1 ... a_n)} --> {a_i}
+         * not_or            : {(not (or a_1 ... a_n))} --> {(not a_i)}
+         * not_implies1      : {(not (implies a b))} --> {a}
+         * not_implies2      : {(not (implies a b))} --> {(not b)}
+     *)
+
+  (* Equality *)
   | EqTr of 'hform * 'hform list
-  | EqCgr of 'hform * 'hform option list
-  | EqCgrP of 'hform * 'hform * 'hform option list
-  | LiaMicromega of 'hform list *
-      Structures.Micromega_plugin_Certificate.Mc.zArithProof list
+    (*  * eq_reflexive     : {(= x x)}
+        * eq_transitive    : {(not (= x_1 x_2)) ... (not (= x_{n-1} x_n)) (= x_1 x_n)}
+    *)
+  | EqCgr of 'hform * ('hform option) list
+    (*  * eq_congruent     : {(not (= x_1 y_1)) ... (not (= x_n y_n))
+                                   (= (f x_1 ... x_n) (f y_1 ... y_n))}
+    *)
+  | EqCgrP of 'hform * 'hform * ('hform option) list
+    (*  * eq_congruent_pred : {(not (= x_1 y_1)) ... (not (= x_n y_n))
+                                   (not (p x_1 ... x_n)) (p y_1 ... y_n)}
+    *)
+
+  (* Linear arithmetic *)
+  | LiaMicromega of 'hform list * Structures.Micromega_plugin_Certificate.Mc.zArithProof list
   | LiaDiseq of 'hform
-  | SplArith of 'hform clause * 'hform *
-      Structures.Micromega_plugin_Certificate.Mc.zArithProof list
+
+  (* Arithmetic simplifications *)
+  | SplArith of 'hform clause * 'hform * Structures.Micromega_plugin_Certificate.Mc.zArithProof list
+
+  (* Elimination of operators *)
   | SplDistinctElim of 'hform clause * 'hform
-  | Hole of 'hform clause list * 'hform list
+
+  (* Bit-blasting *)
+  | BBVar of 'hform
+  (* Bit-blasting a variable:
+
+       ----------------------- bbVar
+        bbT(x, [x0; ...; xn])
+   *)
+  | BBConst of 'hform
+  (* Bit-blasting a constant:
+
+       ----------------------- bbConst
+        bbT(#0100, [0; 0; 1; 0])
+   *)
+  | BBOp of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitwise operations: bbAnd, bbOr, ...
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a&b, [a0 /\ b0; ...; an /\ bn])
+   *)
+  | BBNot of 'hform clause * 'hform
+  (* Bit-blasting bitvector not
+           bbT(a, [a0; ...; an])
+       ------------------------------ bbNot
+        bbT(not a, [~a0 ; ...; ~an])
+   *)
+  | BBNeg of 'hform clause * 'hform
+  (* Bit-blasting bitvector negation
+           bbT(a, [a0; ...; an])
+       ------------------------------ bbNot
+        bbT(-a, [...])
+   *)
+  | BBAdd of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector addition
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a+b, [...])
+   *)
+  | BBMul of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector multiplication
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bbT(a*b, [...])
+   *)
+  | BBUlt of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector unsigned comparison
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bvult a b <-> ...
+   *)
+  | BBSlt of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector signed comparison
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbAnd
+             bvslt a b <-> ...
+   *)
+  | BBConc of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector concatenation
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbConc
+             bbT(concat a b, [a0; ...; an; b0; ...; bn])
+   *)
+  | BBExtr of 'hform clause * 'hform
+  (* Bit-blasting bitvector extraction
+             bbT(a, [a0; ...; an])
+       ----------------------------------- bbExtr
+        bbT(extract i j a, [ai; ...; aj])
+   *)
+  | BBZextn of 'hform clause * 'hform
+  | BBSextn of 'hform clause * 'hform
+  (* Bit-blasting bitvector extensions
+
+  *)
+  | BBShl of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector shift left *)
+  | BBShr of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting bitvector shift right *)
+  | BBEq of 'hform clause * 'hform clause * 'hform
+  (* Bit-blasting equality
+        bbT(a, [a0; ...; an])      bbT(b, [b0; ...; bn])
+       -------------------------------------------------- bbEq
+         (a = b) <-> [(a0 <-> b0) /\ ... /\ (an <-> bn)]
+   *)
+
+  | BBDiseq of 'hform
+  (* disequality over constant bitvectors
+
+       ----------------------------- bbDiseq
+         #b000010101 <> #b00000000
+   *)
+
+  | RowEq of 'hform
+  (* Read over write same index
+       ------------------------------- roweq
+         select (store a i v) i = v
+   *)
+
+  | RowNeq of 'hform list
+  (* Read over write other index
+       ------------------------------------------------- rowneq
+         i <> j -> select (store a i v) j = select a j
+   *)
+
+  | Ext of 'hform
+  (* Extensionality over arrays
+       ------------------------------------------------------- ext
+         a = b \/ select a (diff a b) <> select b (diff a b)
+   *)
+
+  (* Possibility to introduce "holes" in proofs (that should be filled in Coq) *)
+  | Hole of ('hform clause) list * 'hform list
   | Forall_inst of 'hform clause * 'hform
   | Qf_lemma of 'hform clause * 'hform
 
diff --git a/src/trace/smtCnf.ml b/src/trace/smtCnf.ml
index 62a040d..0b82824 100644
--- a/src/trace/smtCnf.ml
+++ b/src/trace/smtCnf.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -79,7 +75,7 @@ module MakeCnf (Form:FORM) =
       | Immediate _ | Done -> ()
       | Todo -> 
 	  match Form.pform l with
-	  | Fatom _ -> ()
+	  | Fatom _ | FbbT _ -> ()
 
 	  | Fapp (op,args) ->
 	      match op with
@@ -179,7 +175,7 @@ module MakeCnf (Form:FORM) =
 	  set_immediate l;
 
 	  match Form.pform l with
-	  | Fatom _ -> ()
+	  | Fatom _ | FbbT _ -> ()
 
 	  | Fapp (op,args) ->
 	      match op with
diff --git a/src/trace/smtCnf.mli b/src/trace/smtCnf.mli
index 47fbd8c..1025ac4 100644
--- a/src/trace/smtCnf.mli
+++ b/src/trace/smtCnf.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 module MakeCnf :
   functor (Form : SmtForm.FORM) ->
     sig
diff --git a/src/trace/smtCommands.ml b/src/trace/smtCommands.ml
index 27b8210..58793b6 100644
--- a/src/trace/smtCommands.ml
+++ b/src/trace/smtCommands.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -38,7 +34,53 @@ let cchecker_b = gen_constant euf_checker_modules "checker_b"
 let cchecker_eq_correct =
   gen_constant euf_checker_modules "checker_eq_correct"
 let cchecker_eq = gen_constant euf_checker_modules "checker_eq"
-let cZeqbsym = gen_constant z_modules "eqb_sym"
+let csetup_checker_step_debug =
+  gen_constant euf_checker_modules "setup_checker_step_debug"
+let cchecker_step_debug = gen_constant euf_checker_modules "checker_step_debug"
+let cstep = gen_constant euf_checker_modules "step"
+let cchecker_debug = gen_constant euf_checker_modules "checker_debug"
+
+let cname_step = gen_constant euf_checker_modules "name_step"
+
+let cName_Res = gen_constant euf_checker_modules "Name_Res"
+let cName_Weaken= gen_constant euf_checker_modules "Name_Weaken"
+let cName_ImmFlatten= gen_constant euf_checker_modules "Name_ImmFlatten"
+let cName_CTrue= gen_constant euf_checker_modules "Name_CTrue"
+let cName_CFalse = gen_constant euf_checker_modules "Name_CFalse"
+let cName_BuildDef= gen_constant euf_checker_modules "Name_BuildDef"
+let cName_BuildDef2= gen_constant euf_checker_modules "Name_BuildDef2"
+let cName_BuildProj = gen_constant euf_checker_modules "Name_BuildProj"
+let cName_ImmBuildDef= gen_constant euf_checker_modules "Name_ImmBuildDef"
+let cName_ImmBuildDef2= gen_constant euf_checker_modules "Name_ImmBuildDef2"
+let cName_ImmBuildProj = gen_constant euf_checker_modules "Name_ImmBuildProj"
+let cName_EqTr = gen_constant euf_checker_modules "Name_EqTr"
+let cName_EqCgr = gen_constant euf_checker_modules "Name_EqCgr"
+let cName_EqCgrP= gen_constant euf_checker_modules "Name_EqCgrP"
+let cName_LiaMicromega = gen_constant euf_checker_modules "Name_LiaMicromega"
+let cName_LiaDiseq= gen_constant euf_checker_modules "Name_LiaDiseq"
+let cName_SplArith= gen_constant euf_checker_modules "Name_SplArith"
+let cName_SplDistinctElim = gen_constant euf_checker_modules "Name_SplDistinctElim"
+let cName_BBVar= gen_constant euf_checker_modules "Name_BBVar"
+let cName_BBConst= gen_constant euf_checker_modules "Name_BBConst"
+let cName_BBOp= gen_constant euf_checker_modules "Name_BBOp"
+let cName_BBNot= gen_constant euf_checker_modules "Name_BBNot"
+let cName_BBNeg= gen_constant euf_checker_modules "Name_BBNeg"
+let cName_BBAdd= gen_constant euf_checker_modules "Name_BBAdd"
+let cName_BBConcat= gen_constant euf_checker_modules "Name_BBConcat"
+let cName_BBMul= gen_constant euf_checker_modules "Name_BBMul"
+let cName_BBUlt= gen_constant euf_checker_modules "Name_BBUlt"
+let cName_BBSlt= gen_constant euf_checker_modules "Name_BBSlt"
+let cName_BBEq= gen_constant euf_checker_modules "Name_BBEq"
+let cName_BBDiseq= gen_constant euf_checker_modules "Name_BBDiseq"
+let cName_BBExtract= gen_constant euf_checker_modules "Name_BBExtract"
+let cName_BBZextend= gen_constant euf_checker_modules "Name_BBZextend"
+let cName_BBSextend= gen_constant euf_checker_modules "Name_BBSextend"
+let cName_BBShl= gen_constant euf_checker_modules "Name_BBShl"
+let cName_BBShr= gen_constant euf_checker_modules "Name_BBShr"
+let cName_RowEq= gen_constant euf_checker_modules "Name_RowEq"
+let cName_RowNeq= gen_constant euf_checker_modules "Name_RowNeq"
+let cName_Ext= gen_constant euf_checker_modules "Name_Ext"
+let cName_Hole= gen_constant euf_checker_modules "Name_Hole"
 
 (* Given an SMT-LIB2 file and a certif, build the corresponding objects *)
 
@@ -50,42 +92,40 @@ let compute_roots roots last_root =
 
   let rec find_root i root = function
     | [] -> assert false
-    | t::q -> if Form.equal t root then (i,q) else find_root (i+1) root q in
+    | t::q -> if Form.equal t root then i else find_root (i+1) root q in
 
-  let rec used_roots acc i roots r =
+  let rec used_roots acc r =
     if isRoot r.kind then
       match r.value with
         | Some [root] ->
-           let (j,roots') = find_root i root roots in
-           used_roots (j::acc) (j+1) roots' (next r)
+           let j = find_root 0 root roots in
+           used_roots (j::acc) (next r)
         | _ -> assert false
-    else
-      acc in
+    else acc
+  in
 
-  used_roots [] 0 roots !r
+  used_roots [] !r
 
 
-let interp_uf ta tf c =
+let interp_uf t_i ta tf c =
   let rec interp = function
     | [] -> Lazy.force cfalse
-    | [l] -> Form.interp_to_coq (Atom.interp_to_coq ta) tf l
-    | l::c -> mklApp corb [|Form.interp_to_coq (Atom.interp_to_coq ta) tf l; interp c|] in
+    | [l] -> Form.interp_to_coq (Atom.interp_to_coq t_i ta) tf l
+    | l::c -> mklApp corb [|Form.interp_to_coq (Atom.interp_to_coq t_i ta) tf l; interp c|] in
   interp c
 
-let interp_conseq_uf (prem, concl) =
+let interp_conseq_uf t_i (prem, concl) =
   let ta = Hashtbl.create 17 in
   let tf = Hashtbl.create 17 in
   let rec interp = function
-    | [] -> mklApp cis_true [|interp_uf ta tf concl|]
-    | c::prem -> Term.mkArrow (mklApp cis_true [|interp_uf ta tf c|]) (interp prem) in
+    | [] -> mklApp cis_true [|interp_uf t_i ta tf concl|]
+    | c::prem -> Term.mkArrow (mklApp cis_true [|interp_uf t_i ta tf c|]) (interp prem) in
   interp prem
 
 
 let print_assm ty =
-  let rec fix rf x = rf (fix rf) x in
-  let pr = fix Ppconstr.modular_constr_pr Pp.mt Structures.ppconstr_lsimpleconstr in
-  Printf.printf "WARNING: assuming the following hypothesis:\n%s\n\n" (Pp.string_of_ppcmds (pr (Structures.constrextern_extern_constr ty)));
-  flush stdout
+  Format.printf "WARNING: assuming the following hypothesis:\n%s\n@."
+    (string_coq_constr ty)
 
 
 let parse_certif t_i t_func t_atom t_form root used_root trace (rt, ro, ra, rf, roots, max_id, confl) =
@@ -107,7 +147,8 @@ let parse_certif t_i t_func t_atom t_form root used_root trace (rt, ro, ra, rf,
   let ct_form = Term.mkConst (declare_constant t_form (DefinitionEntry ce2, IsDefinition Definition)) in
 
   (* EMPTY LEMMA LIST *)
-  let (tres, last_root, cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) interp_conseq_uf (certif_ops (Some [|ct_i; ct_func; ct_atom; ct_form|])) confl None in
+  let (tres, last_root, cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i))
+      (interp_conseq_uf ct_i) (certif_ops (Some [|ct_i; ct_func; ct_atom; ct_form|])) confl None in
   List.iter (fun (v,ty) ->
     let _ = Structures.declare_new_variable v ty in
     print_assm ty
@@ -140,8 +181,8 @@ let parse_certif t_i t_func t_atom t_form root used_root trace (rt, ro, ra, rf,
 
 (* Given an SMT-LIB2 file and a certif, build the corresponding theorem *)
 
-let interp_roots roots =
-  let interp = Form.interp_to_coq (Atom.interp_to_coq (Hashtbl.create 17)) (Hashtbl.create 17) in
+let interp_roots t_i roots =
+  let interp = Form.interp_to_coq (Atom.interp_to_coq t_i (Hashtbl.create 17)) (Hashtbl.create 17) in
   match roots with
     | [] -> Lazy.force ctrue
     | f::roots -> List.fold_left (fun acc f -> mklApp candb [|acc; interp f|]) (interp f) roots
@@ -163,7 +204,9 @@ let theorem name (rt, ro, ra, rf, roots, max_id, confl) =
   let t_form = snd (Form.interp_tbl rf) in
 
   (* EMPTY LEMMA LIST *)
-  let (tres,last_root,cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) interp_conseq_uf (certif_ops (Some [|v 4(*t_i*); v 3(*t_func*); v 2(*t_atom*); v 1(* t_form *)|])) confl None in
+  let (tres,last_root,cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i))
+      (interp_conseq_uf t_i)
+      (certif_ops (Some [|v 4(*t_i*); v 3(*t_func*); v 2(*t_atom*); v 1(* t_form *)|])) confl None in
   List.iter (fun (v,ty) ->
     let _ = Structures.declare_new_variable v ty in
     print_assm ty
@@ -185,10 +228,10 @@ let theorem name (rt, ro, ra, rf, roots, max_id, confl) =
     List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
     Structures.mkArray (Lazy.force cint, res) in
 
-  let theorem_concl = mklApp cis_true [|mklApp cnegb [|interp_roots roots|]|] in
+  let theorem_concl = mklApp cnot [|mklApp cis_true [|interp_roots t_i roots|]|] in
   let theorem_proof_cast =
     Term.mkCast (
-        Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
+        Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
         Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1(* t_i *)|]|],
         Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
         Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
@@ -197,13 +240,13 @@ let theorem name (rt, ro, ra, rf, roots, max_id, confl) =
         Term.mkLetIn (nd, rootsCstr, mklApp carray [|Lazy.force cint|],
         mklApp cchecker_correct
                [|v 7 (*t_i*); v 6 (*t_func*); v 5 (*t_atom*); v 4 (*t_form*); v 1 (*d*); v 2 (*used_roots*); v 3 (*c*);
-	         vm_cast_true
+	         vm_cast_true_no_check
 	           (mklApp cchecker [|v 7 (*t_i*); v 6 (*t_func*); v 5 (*t_atom*); v 4 (*t_form*); v 1 (*d*); v 2 (*used_roots*); v 3 (*c*)|])|]))))))),
         Term.VMcast,
         theorem_concl)
   in
   let theorem_proof_nocast =
-        Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
+        Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
         Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1(* t_i *)|]|],
         Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
         Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
@@ -238,7 +281,9 @@ let checker (rt, ro, ra, rf, roots, max_id, confl) =
   let t_form = snd (Form.interp_tbl rf) in
 
   (* EMPTY LEMMA LIST *)
-  let (tres,last_root,cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) interp_conseq_uf (certif_ops (Some [|v 4(*t_i*); v 3(*t_func*); v 2(*t_atom*); v 1(* t_form *)|])) confl None in
+  let (tres,last_root,cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i))
+      (interp_conseq_uf t_i)
+      (certif_ops (Some [|v 4(*t_i*); v 3(*t_func*); v 2(*t_atom*); v 1(* t_form *)|])) confl None in
   List.iter (fun (v,ty) ->
     let _ = Structures.declare_new_variable v ty in
     print_assm ty
@@ -261,7 +306,7 @@ let checker (rt, ro, ra, rf, roots, max_id, confl) =
     Structures.mkArray (Lazy.force cint, res) in
 
   let tm =
-   Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
+   Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1(* t_i *)|]|],
    Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
    Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
@@ -275,10 +320,256 @@ let checker (rt, ro, ra, rf, roots, max_id, confl) =
     (if Term.eq_constr res (Lazy.force CoqTerms.ctrue) then
         "true" else "false")
 
+let count_used confl =
+  let cpt = ref 0 in
+  let rec count c =
+    incr cpt;
+    (* if c.used = 1 then incr cpt; *)
+    match c.prev with
+    | None -> !cpt
+    | Some c -> count c
+  in
+  count confl
+
+
+let checker_debug (rt, ro, ra, rf, roots, max_id, confl) =
+  let nti = mkName "t_i" in
+  let ntfunc = mkName "t_func" in
+  let ntatom = mkName "t_atom" in
+  let ntform = mkName "t_form" in
+  let nc = mkName "c" in
+  let nused_roots = mkName "used_roots" in
+  let nd = mkName "d" in
+
+  let v = Term.mkRel in
+
+  let t_i = make_t_i rt in
+  let t_func = make_t_func ro (v 1 (*t_i*)) in
+  let t_atom = Atom.interp_tbl ra in
+  let t_form = snd (Form.interp_tbl rf) in
+
+  let (tres,last_root,cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i))
+      (interp_conseq_uf t_i)
+      (certif_ops (Some [|v 4(*t_i*); v 3(*t_func*);
+                          v 2(*t_atom*); v 1(* t_form *)|])) confl None in
+  List.iter (fun (v,ty) ->
+    let _ = Structures.declare_new_variable v ty in
+    print_assm ty
+  ) cuts;
+
+  let certif =
+    mklApp cCertif [|v 4(*t_i*); v 3(*t_func*); v 2(*t_atom*); v 1(* t_form *);
+                     mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+
+  let used_roots = compute_roots roots last_root in
+  let used_rootsCstr =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    mklApp cSome [|mklApp carray [|Lazy.force cint|];
+                   Structures.mkArray (Lazy.force cint, res)|] in
+  let rootsCstr =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
+    Structures.mkArray (Lazy.force cint, res) in
+
+  let tm =
+   Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
+   Term.mkLetIn (ntfunc, t_func,
+                 mklApp carray [|mklApp ctval [|v 1(* t_i *)|]|],
+   Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
+   Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
+   Term.mkLetIn (nc, certif, mklApp ccertif [|v 4 (*t_i*); v 3 (*t_func*);
+                                              v 2 (*t_atom*); v 1 (*t_form*)|],
+   Term.mkLetIn (nused_roots, used_rootsCstr,
+                 mklApp coption [|mklApp carray [|Lazy.force cint|]|],
+   Term.mkLetIn (nd, rootsCstr, mklApp carray [|Lazy.force cint|],
+   mklApp cchecker_debug [|v 7 (*t_i*); v 6 (*t_func*); v 5 (*t_atom*);
+       v 4 (*t_form*); v 1 (*d*); v 2 (*used_roots*); v 3 (*c*)|]))))))) in
+
+  let res = Vnorm.cbv_vm (Global.env ()) tm
+      (mklApp coption
+         [|mklApp cprod
+             [|Lazy.force cnat; Lazy.force cname_step|]|]) in
+
+  match Term.decompose_app res with
+  | c, _ when Term.eq_constr c (Lazy.force cNone) ->
+    Structures.error ("Debug checker is only meant to be used for certificates \
+                       that fail to be checked by SMTCoq.")
+  | c, [_; n] when Term.eq_constr c (Lazy.force cSome) ->
+    (match Term.decompose_app n with
+     | c, [_; _; cnb; cn] when Term.eq_constr c (Lazy.force cpair) ->
+       let n = fst (Term.decompose_app cn) in
+       let name =
+         if Term.eq_constr n (Lazy.force cName_Res ) then "Res"
+         else if Term.eq_constr n (Lazy.force cName_Weaken) then "Weaken"
+         else if Term.eq_constr n (Lazy.force cName_ImmFlatten) then "ImmFlatten"
+         else if Term.eq_constr n (Lazy.force cName_CTrue) then "CTrue"
+         else if Term.eq_constr n (Lazy.force cName_CFalse ) then "CFalse"
+         else if Term.eq_constr n (Lazy.force cName_BuildDef) then "BuildDef"
+         else if Term.eq_constr n (Lazy.force cName_BuildDef2) then "BuildDef2"
+         else if Term.eq_constr n (Lazy.force cName_BuildProj ) then "BuildProj"
+         else if Term.eq_constr n (Lazy.force cName_ImmBuildDef) then "ImmBuildDef"
+         else if Term.eq_constr n (Lazy.force cName_ImmBuildDef2) then "ImmBuildDef2"
+         else if Term.eq_constr n (Lazy.force cName_ImmBuildProj ) then "ImmBuildProj"
+         else if Term.eq_constr n (Lazy.force cName_EqTr ) then "EqTr"
+         else if Term.eq_constr n (Lazy.force cName_EqCgr ) then "EqCgr"
+         else if Term.eq_constr n (Lazy.force cName_EqCgrP) then "EqCgrP"
+         else if Term.eq_constr n (Lazy.force cName_LiaMicromega ) then "LiaMicromega"
+         else if Term.eq_constr n (Lazy.force cName_LiaDiseq) then "LiaDiseq"
+         else if Term.eq_constr n (Lazy.force cName_SplArith) then "SplArith"
+         else if Term.eq_constr n (Lazy.force cName_SplDistinctElim ) then "SplDistinctElim"
+         else if Term.eq_constr n (Lazy.force cName_BBVar) then "BBVar"
+         else if Term.eq_constr n (Lazy.force cName_BBConst) then "BBConst"
+         else if Term.eq_constr n (Lazy.force cName_BBOp) then "BBOp"
+         else if Term.eq_constr n (Lazy.force cName_BBNot) then "BBNot"
+         else if Term.eq_constr n (Lazy.force cName_BBNeg) then "BBNeg"
+         else if Term.eq_constr n (Lazy.force cName_BBAdd) then "BBAdd"
+         else if Term.eq_constr n (Lazy.force cName_BBConcat) then "BBConcat"
+         else if Term.eq_constr n (Lazy.force cName_BBMul) then "BBMul"
+         else if Term.eq_constr n (Lazy.force cName_BBUlt) then "BBUlt"
+         else if Term.eq_constr n (Lazy.force cName_BBSlt) then "BBSlt"
+         else if Term.eq_constr n (Lazy.force cName_BBEq) then "BBEq"
+         else if Term.eq_constr n (Lazy.force cName_BBDiseq) then "BBDiseq"
+         else if Term.eq_constr n (Lazy.force cName_BBExtract) then "BBExtract"
+         else if Term.eq_constr n (Lazy.force cName_BBZextend) then "BBZextend"
+         else if Term.eq_constr n (Lazy.force cName_BBSextend) then "BBSextend"
+         else if Term.eq_constr n (Lazy.force cName_BBShl) then "BBShl"
+         else if Term.eq_constr n (Lazy.force cName_BBShr) then "BBShr"
+         else if Term.eq_constr n (Lazy.force cName_RowEq) then "RowEq"
+         else if Term.eq_constr n (Lazy.force cName_RowNeq) then "RowNeq"
+         else if Term.eq_constr n (Lazy.force cName_Ext) then "Ext"
+         else if Term.eq_constr n (Lazy.force cName_Hole) then "Hole"
+         else string_coq_constr n
+       in
+       let nb = mk_nat cnb + List.length roots + (confl.id + 1 - count_used confl) in
+       Structures.error ("Step number " ^ string_of_int nb ^
+                         " (" ^ name ^ ") of the certificate likely failed.")
+     | _ -> assert false
+    )
+  | _ -> assert false
+
+
+
+let rec of_coq_list cl =
+  match Term.decompose_app cl with
+  | c, _ when Term.eq_constr c (Lazy.force cnil) -> []
+  | c, [_; x; cr] when Term.eq_constr c (Lazy.force ccons) ->
+    x :: of_coq_list cr
+  | _ -> assert false
+
+
+let checker_debug_step t_i t_func t_atom t_form root used_root trace
+    (rt, ro, ra, rf, roots, max_id, confl) =
+
+  let t_i' = make_t_i rt in
+  let ce5 = Structures.mkUConst t_i' in
+  let ct_i = Term.mkConst (declare_constant t_i
+                             (DefinitionEntry ce5, IsDefinition Definition)) in
+
+  let t_func' = make_t_func ro ct_i in
+  let ce6 = Structures.mkUConst t_func' in
+  let ct_func =
+    Term.mkConst (declare_constant t_func
+                    (DefinitionEntry ce6, IsDefinition Definition)) in
+
+  let t_atom' = Atom.interp_tbl ra in
+  let ce1 = Structures.mkUConst t_atom' in
+  let ct_atom =
+    Term.mkConst (declare_constant t_atom
+                    (DefinitionEntry ce1, IsDefinition Definition)) in
+
+  let t_form' = snd (Form.interp_tbl rf) in
+  let ce2 = Structures.mkUConst t_form' in
+  let ct_form =
+    Term.mkConst (declare_constant t_form
+                    (DefinitionEntry ce2, IsDefinition Definition)) in
+
+  let (tres, last_root, cuts) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i))
+      (interp_conseq_uf ct_i)
+      (certif_ops (Some [|ct_i; ct_func; ct_atom; ct_form|])) confl None in
+  List.iter (fun (v,ty) ->
+    let _ = Structures.declare_new_variable v ty in
+    print_assm ty
+  ) cuts;
+
+  let used_roots = compute_roots roots last_root in
+  let croots =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
+    Structures.mkArray (Lazy.force cint, res) in
+  let cused_roots =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    mklApp cSome [|mklApp carray [|Lazy.force cint|];
+                   Structures.mkArray (Lazy.force cint, res)|] in
+  let ce3 = Structures.mkUConst croots in
+  let _ = declare_constant root
+      (DefinitionEntry ce3, IsDefinition Definition) in
+  let ce3' = Structures.mkUConst cused_roots in
+  let _ = declare_constant used_root
+      (DefinitionEntry ce3', IsDefinition Definition) in
+
+  let certif =
+    mklApp cCertif [|ct_i; ct_func; ct_atom; ct_form; mkInt (max_id + 1);
+                     tres;mkInt (get_pos confl)|] in
+  let ce4 = Structures.mkUConst certif in
+  let _ = declare_constant trace
+      (DefinitionEntry ce4, IsDefinition Definition) in
+
+  let setup =
+   mklApp csetup_checker_step_debug
+     [| ct_i; ct_func; ct_atom; ct_form; croots; cused_roots; certif |] in
+
+  let setup = Vnorm.cbv_vm (Global.env ()) setup
+      (mklApp cprod
+         [|Lazy.force cState_S_t;
+           mklApp clist [|mklApp cstep
+                            [|ct_i; ct_func; ct_atom; ct_form|]|]|]) in
+
+  let s, steps = match Term.decompose_app setup with
+    | c, [_; _; s; csteps] when Term.eq_constr c (Lazy.force cpair) ->
+      s, of_coq_list csteps
+    | _ -> assert false
+  in
+
+  let cpt = ref (List.length roots) in
+  let debug_step s step =
+    incr cpt;
+    Format.eprintf "%d@." !cpt;
+    let tm =
+      mklApp cchecker_step_debug
+        [| ct_i; ct_func; ct_atom; ct_form; s; step |] in
+
+    let res =
+      Vnorm.cbv_vm (Global.env ()) tm
+          (mklApp cprod [|Lazy.force cState_S_t; Lazy.force cbool|]) in
+
+    match Term.decompose_app res with
+    | c, [_; _; s; cbad] when Term.eq_constr c (Lazy.force cpair) ->
+      if not (mk_bool cbad) then s
+      else Structures.error ("Step number " ^ string_of_int !cpt ^
+                             " (" ^ string_coq_constr
+                               (fst (Term.decompose_app step)) ^ ")" ^
+                             " of the certificate likely failed." )
+    | _ -> assert false
+  in
+
+  List.fold_left debug_step s steps |> ignore;
+
+  Structures.error ("Debug checker is only meant to be used for certificates \
+                     that fail to be checked by SMTCoq.")
+
+
 
 (* Tactic *)
 
-let build_body rt ro ra rf l b (max_id, confl) find =
+let build_body rt ro ra rf l b (max_id, confl) vm_cast find =
   let nti = mkName "t_i" in
   let ntfunc = mkName "t_func" in
   let ntatom = mkName "t_atom" in
@@ -291,34 +582,49 @@ let build_body rt ro ra rf l b (max_id, confl) find =
   let t_func = Structures.lift 1 (make_t_func ro (v 0 (*t_i - 1*))) in
   let t_atom = Atom.interp_tbl ra in
   let t_form = snd (Form.interp_tbl rf) in
-  let (tres,_,cuts) = SmtTrace.to_coq Form.to_coq interp_conseq_uf (certif_ops (Some [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|])) confl find in
+  let (tres,_,cuts) = SmtTrace.to_coq Form.to_coq
+      (interp_conseq_uf t_i)
+      (certif_ops
+         (Some [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|]))
+      confl find
+  in
   let certif =
-    mklApp cCertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*); mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+    mklApp cCertif
+      [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*);
+        mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
 
-  let proof_cast =
-    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
-    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1 (*t_i*)|]|],
+  let add_lets t =
+    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
+    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1(*t_i*)|]|],
     Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
     Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, mklApp ccertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
-    mklApp cchecker_b_correct
-      [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l; b; v 1 (*certif*);
-	vm_cast_true (mklApp cchecker_b [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l; b; v 1 (*certif*)|])|])))))
+    Term.mkLetIn (nc, certif, mklApp ccertif
+             [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
+    t))))) in
+
+  let cbc =
+    add_lets
+      (mklApp cchecker_b [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*);
+                           v 2 (*t_form*); l; b; v 1 (*certif*)|])
+    |> vm_cast
   in
+
+  let proof_cast =
+    add_lets
+      (mklApp cchecker_b_correct
+         [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*);
+           l; b; v 1 (*certif*); cbc |]) in
+
   let proof_nocast =
-    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
-    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1 (*t_i*)|]|],
-    Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
-    Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, mklApp ccertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
-    mklApp cchecker_b_correct
-      [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l; b; v 1 (*certif*)|])))))
-  in
+    add_lets
+      (mklApp cchecker_b_correct
+         [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*);
+           l; b; v 1 (*certif*)|]) in
 
   (proof_cast, proof_nocast, cuts)
 
 
-let build_body_eq rt ro ra rf l1 l2 l (max_id, confl) find =
+let build_body_eq rt ro ra rf l1 l2 l (max_id, confl) vm_cast find =
   let nti = mkName "t_i" in
   let ntfunc = mkName "t_func" in
   let ntatom = mkName "t_atom" in
@@ -331,28 +637,39 @@ let build_body_eq rt ro ra rf l1 l2 l (max_id, confl) find =
   let t_func = Structures.lift 1 (make_t_func ro (v 0 (*t_i*))) in
   let t_atom = Atom.interp_tbl ra in
   let t_form = snd (Form.interp_tbl rf) in
-  let (tres,_,cuts) = SmtTrace.to_coq Form.to_coq interp_conseq_uf (certif_ops (Some [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|])) confl find in
+  let (tres,_,cuts) = SmtTrace.to_coq Form.to_coq
+      (interp_conseq_uf t_i)
+      (certif_ops (Some [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|])) confl find in
   let certif =
     mklApp cCertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*); mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
 
-  let proof_cast =
-    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
-    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1 (*t_i*)|]|],
+  let add_lets t =
+    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_compdec|],
+    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1(*t_i*)|]|],
     Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
     Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, mklApp ccertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
-    mklApp cchecker_eq_correct
-      [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l1; l2; l; v 1 (*certif*);
-	vm_cast_true (mklApp cchecker_eq [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l1; l2; l; v 1 (*certif*)|])|])))))
+    Term.mkLetIn (nc, certif, mklApp ccertif
+             [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
+    t))))) in
+
+  let ceqc =
+    add_lets
+      (mklApp cchecker_eq [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*);
+                            v 2 (*t_form*); l1; l2; l; v 1 (*certif*)|])
+      |> vm_cast
+  in
+
+  let proof_cast =
+    add_lets
+      (mklApp cchecker_eq_correct
+         [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*);
+           l1; l2; l; v 1 (*certif*); ceqc|])
   in
   let proof_nocast =
-    Term.mkLetIn (nti, t_i, mklApp carray [|Lazy.force ctyp_eqb|],
-    Term.mkLetIn (ntfunc, t_func, mklApp carray [|mklApp ctval [|v 1 (*t_i*)|]|],
-    Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
-    Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, mklApp ccertif [|v 4 (*t_i*); v 3 (*t_func*); v 2 (*t_atom*); v 1 (*t_form*)|],
-    mklApp cchecker_eq_correct
-      [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*); l1; l2; l; v 1 (*certif*)|])))))
+    add_lets
+      (mklApp cchecker_eq_correct
+         [|v 5 (*t_i*);v 4 (*t_func*);v 3 (*t_atom*); v 2 (*t_form*);
+           l1; l2; l; v 1 (*certif*)|])
   in
 
   (proof_cast, proof_nocast, cuts)
@@ -366,23 +683,23 @@ let get_arguments concl =
   | _ -> failwith ("Verit.tactic: can only deal with equality over bool")
 
 
-let make_proof call_solver rt ro rf ra' rf' l' ls_smtc=
-  let fl' = Form.flatten rf' l' in
+let make_proof call_solver env rt ro ra' rf' l' ls_smtc =
   let root = SmtTrace.mkRootV [l'] in
-  call_solver rt ro ra' rf' (Some (root, l')) (fl'::ls_smtc)
+  call_solver env rt ro ra' rf' (root,l') ls_smtc
+(* TODO: not generic anymore, the "lemma" part is currently specific to veriT *)
 
 (* <of_coq_lemma> reifies the coq lemma given, we can then easily print it in a
  .smt2 file. We need the reify tables to correctly recognize unbound variables
  of the lemma. We also need to make sure to leave unchanged the tables because
  the new objects may contain bound (by forall of the lemma) variables. *)
 exception Axiom_form_unsupported
-              
-let of_coq_lemma rt ro ra' rf' env sigma clemma =
+
+let of_coq_lemma rt ro ra' rf' env sigma solver_logic clemma =
   let rel_context, qf_lemma = Term.decompose_prod_assum clemma in
   let env_lemma = List.fold_right Environ.push_rel rel_context env in
   let forall_args =
     let fmap r = let n, t = Structures.destruct_rel_decl r in
-                 string_of_name n, SmtBtype.of_coq rt t in
+                 string_of_name n, SmtBtype.of_coq rt solver_logic t in
     List.map fmap rel_context in
   let f, args = Term.decompose_app qf_lemma in
   let core_f =
@@ -397,19 +714,20 @@ let of_coq_lemma rt ro ra' rf' env sigma clemma =
          arg1
       | _ -> raise Axiom_form_unsupported
     else raise Axiom_form_unsupported in
-  let core_smt = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' env_lemma sigma)
+  let core_smt = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' solver_logic env_lemma sigma)
                    rf' core_f in
   match forall_args with
     [] -> core_smt
   | _ -> Form.get rf' (Fapp (Fforall forall_args, [|core_smt|]))
 
-let core_tactic call_solver rt ro ra rf ra' rf' lcpl lcepl env sigma concl =
+let core_tactic call_solver solver_logic rt ro ra rf ra' rf' vm_cast lcpl lcepl env sigma concl =
   let a, b = get_arguments concl in
+
   let tlcepl = List.map (Structures.interp_constr env sigma) lcepl in
   let lcpl = lcpl @ tlcepl in
   let lcl = List.map (Retyping.get_type_of env sigma) lcpl in
 
-  let lsmt  = List.map (of_coq_lemma rt ro ra' rf' env sigma) lcl in
+  let lsmt  = List.map (of_coq_lemma rt ro ra' rf' env sigma solver_logic) lcl in
   let l_pl_ls = List.combine (List.combine lcl lcpl) lsmt in
 
   let lem_tbl : (int, Term.constr * Term.constr) Hashtbl.t =
@@ -418,7 +736,7 @@ let core_tactic call_solver rt ro ra rf ra' rf' lcpl lcepl env sigma concl =
     Hashtbl.add lem_tbl (Form.index ls) (l, pl) in
 
   List.iter new_ref l_pl_ls;
-  
+
   let find_lemma cl =
     let re_hash hf = Form.hash_hform (Atom.hash_hatom ra') rf' hf in
     match cl.value with
@@ -427,39 +745,231 @@ let core_tactic call_solver rt ro ra rf ra' rf' lcpl lcepl env sigma concl =
        begin try Hashtbl.find lem_tbl (Form.index hl)
              with Not_found ->
                let oc = open_out "/tmp/find_lemma.log" in
-               List.iter (fun u -> Printf.fprintf oc "%s\n"
-                                     (VeritSyntax.string_hform u)) lsmt;
-               Printf.fprintf oc "\n%s\n" (VeritSyntax.string_hform hl);
+               let fmt = Format.formatter_of_out_channel oc in
+               List.iter (fun u -> Format.fprintf fmt "%a\n" VeritSyntax.hform_to_smt u) lsmt;
+               Format.fprintf fmt "\n%a\n" VeritSyntax.hform_to_smt hl;
                flush oc; close_out oc; failwith "find_lemma" end
       | _ -> failwith "unexpected form of root" in
-  
+
   let (body_cast, body_nocast, cuts) =
-    if ((Term.eq_constr b (Lazy.force ctrue)) || (Term.eq_constr b (Lazy.force cfalse))) then
-      let l = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf a in
-      let l' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' env sigma) rf' a in
-      let l' = if (Term.eq_constr b (Lazy.force ctrue)) then Form.neg l' else l' in
-      let max_id_confl = make_proof call_solver rt ro rf ra' rf' l' lsmt in
-      build_body rt ro ra rf (Form.to_coq l) b max_id_confl (Some find_lemma)
+    if ((Term.eq_constr b (Lazy.force ctrue)) ||
+        (Term.eq_constr b (Lazy.force cfalse))) then
+      let l = Form.of_coq (Atom.of_coq rt ro ra solver_logic env sigma) rf a in
+      let l' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' solver_logic env sigma) rf' a in
+      let l' =
+        if (Term.eq_constr b (Lazy.force ctrue)) then Form.neg l' else l' in
+      let max_id_confl = make_proof call_solver env rt ro ra' rf' l' lsmt in
+      build_body rt ro ra rf (Form.to_coq l) b max_id_confl (vm_cast env) (Some find_lemma)
     else
-      let l1 = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf a in
-      let l2 = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf b in
+      let l1 = Form.of_coq (Atom.of_coq rt ro ra solver_logic env sigma) rf a in
+      let l2 = Form.of_coq (Atom.of_coq rt ro ra solver_logic env sigma) rf b in
       let l = Form.neg (Form.get rf (Fapp(Fiff,[|l1;l2|]))) in
-      let l1' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' env sigma) rf' a in
-      let l2' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' env sigma) rf' b in
+      let l1' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' solver_logic env sigma) rf' a in
+      let l2' = Form.of_coq (Atom.of_coq ~hash:true rt ro ra' solver_logic env sigma) rf' b in
       let l' = Form.neg (Form.get rf' (Fapp(Fiff,[|l1';l2'|]))) in
-      let max_id_confl = make_proof call_solver rt ro rf ra' rf' l' lsmt in
-      build_body_eq rt ro ra rf (Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl (Some find_lemma) in
+      let max_id_confl = make_proof call_solver env rt ro ra' rf' l' lsmt in
+      build_body_eq rt ro ra rf (Form.to_coq l1) (Form.to_coq l2)
+        (Form.to_coq l) max_id_confl (vm_cast env) (Some find_lemma) in
 
-  let cuts = SmtBtype.get_cuts rt @ cuts in
+      let cuts = (SmtBtype.get_cuts rt) @ cuts in
 
   List.fold_right (fun (eqn, eqt) tac ->
-      Structures.tclTHENLAST (Structures.assert_before (Names.Name eqn) eqt) tac)
-    cuts
+      Structures.tclTHENLAST
+        (Structures.assert_before (Names.Name eqn) eqt)
+        tac
+    ) cuts
     (Structures.tclTHEN
        (Structures.set_evars_tac body_nocast)
        (Structures.vm_cast_no_check body_cast))
 
-let tactic call_solver rt ro ra rf ra' rf' lcpl lcepl =
+
+let tactic call_solver solver_logic rt ro ra rf ra' rf' vm_cast lcpl lcepl =
   Structures.tclTHEN
     Tactics.intros
-    (Structures.mk_tactic (core_tactic call_solver rt ro ra rf ra' rf' lcpl lcepl))
+    (Structures.mk_tactic (core_tactic call_solver solver_logic rt ro ra rf ra' rf' vm_cast lcpl lcepl))
+
+
+(**********************************************)
+(* Show solver models as Coq counter-examples *)
+(**********************************************)
+
+
+open SExpr
+open Smtlib2_genConstr
+open Format
+
+
+let string_index_of_constr env i cf =
+  try
+    let s = string_coq_constr cf in
+    let nc = Environ.named_context env in
+    let nd = Environ.lookup_named (Names.id_of_string s) env in
+    let cpt = ref 0 in
+    (try List.iter (fun n -> incr cpt; if n == nd then raise Exit) nc
+     with Exit -> ());
+    s, !cpt
+  with _ -> string_coq_constr cf, -i
+
+
+let vstring_i env i =
+  let cf = SmtAtom.Atom.get_coq_term_op i in
+  if Term.isRel cf then
+    let dbi = Term.destRel cf in
+    let s =
+      Environ.lookup_rel dbi env
+      |> Structures.get_rel_dec_name
+      |> function
+      | Names.Name id -> Names.string_of_id id
+      | Names.Anonymous -> "?" in
+    s, dbi
+  else
+    string_index_of_constr env i cf
+
+
+let sstring_i env i v =
+  let tf = SmtBtype.get_coq_type_op i in
+  let (s, idx) = string_index_of_constr env i tf in
+  (s^"#"^v, idx)
+
+
+let smt2_id_to_coq_string env t_i ra rf name =
+  try
+    let l = String.split_on_char '_' name in
+    match l with
+      | ["op"; i] -> vstring_i env (int_of_string i)
+      | ["@uc"; "Tindex"; i; j] -> sstring_i env (int_of_string i) j
+      | _ -> raise Not_found
+  with _ -> (name, 0)
+
+
+let op_to_coq_string op = match op with
+  | "=" | "+" | "-" | "*" | "/" -> op
+  | "or" -> "||"
+  | "and" -> "&&"
+  | "xor" -> "xorb"
+  | "=>" -> "implb"
+  | _ -> op
+
+
+let coq_bv_string s =
+  let rec aux acc = function
+    | true :: r -> aux (acc ^ "|1") r
+    | false :: r -> aux (acc ^ "|0") r
+    | [] -> "#b" ^ acc ^ "|"
+  in
+  if String.length s < 3 ||
+     not (s.[0] = '#' && s.[1] = 'b') then failwith "not bv";
+  aux "" (parse_smt2bv s)
+
+
+let is_bvint bs =
+  try Scanf.sscanf bs "bv%s" (fun s ->
+      try ignore (Big_int.big_int_of_string s); true
+      with _ -> false)
+  with _ -> false
+
+
+let rec smt2_sexpr_to_coq_string env t_i ra rf =
+  let open SExpr in function
+  | Atom "true" -> "true"
+  | Atom "false" -> "false"
+  | Atom s ->
+    (try ignore (int_of_string s); s
+     with Failure _ ->
+     try coq_bv_string s
+     with Failure _ ->
+     try fst (smt2_id_to_coq_string env t_i ra rf s)
+     with _ -> s)
+  | List [Atom "as"; Atom "const"; _] -> "const_farray"
+  | List [Atom "as"; s; _] -> smt2_sexpr_to_coq_string env t_i ra rf s
+  | List [Atom "_"; Atom bs; Atom s] when is_bvint bs ->
+    Scanf.sscanf bs "bv%s" (fun i ->
+        coq_bv_string (bigint_bv (Big_int.big_int_of_string i)
+                         (int_of_string s)))
+  | List [Atom "-"; Atom _ as s] ->
+    sprintf "-%s"
+      (smt2_sexpr_to_coq_string env t_i ra rf s)
+  | List [Atom "-"; s] ->
+    sprintf "(- %s)"
+      (smt2_sexpr_to_coq_string env t_i ra rf s)
+  | List [Atom (("+"|"-"|"*"|"/"|"or"|"and"|"=") as op); s1; s2] ->
+    sprintf "%s %s %s"
+      (smt2_sexpr_to_coq_string env t_i ra rf s1)
+      (op_to_coq_string op)
+      (smt2_sexpr_to_coq_string env t_i ra rf s2)
+  | List [Atom (("xor"|"=>"|"") as op); s1; s2] ->
+    sprintf "(%s %s %s)"
+      (op_to_coq_string op)
+      (smt2_sexpr_to_coq_string env t_i ra rf s1)
+      (smt2_sexpr_to_coq_string env t_i ra rf s2)
+  | List [Atom "select"; a; i] ->
+    sprintf "%s[%s]"
+      (smt2_sexpr_to_coq_string env t_i ra rf a)
+      (smt2_sexpr_to_coq_string env t_i ra rf i)
+  | List [Atom "store"; a; i; v] ->
+    sprintf "%s[%s <- %s]"
+      (smt2_sexpr_to_coq_string env t_i ra rf a)
+      (smt2_sexpr_to_coq_string env t_i ra rf i)
+      (smt2_sexpr_to_coq_string env t_i ra rf v)
+  | List [Atom "ite"; c; s1; s2] ->
+    sprintf "if %s then %s else %s"
+      (smt2_sexpr_to_coq_string env t_i ra rf c)
+      (smt2_sexpr_to_coq_string env t_i ra rf s1)
+      (smt2_sexpr_to_coq_string env t_i ra rf s2)
+  | List l ->
+    sprintf "(%s)"
+      (String.concat " " (List.map (smt2_sexpr_to_coq_string env t_i ra rf) l))
+
+
+let str_contains s1 s2 =
+  let re = Str.regexp_string s2 in
+  try ignore (Str.search_forward re s1 0); true
+  with Not_found -> false
+
+let lambda_to_coq_string l s =
+  Format.sprintf "fun %s => %s"
+    (String.concat " "
+       (List.map (function
+            | List [Atom v; _] ->
+              if str_contains s v then v else "_"
+            | _ -> assert false) l))
+    s
+
+type model =
+  | Fun of ((string * int) * string)
+  | Sort
+
+let model_item env rt ro ra rf =
+  let t_i = make_t_i rt in
+  function
+  | List [Atom "define-fun"; Atom n; List []; _; expr] ->
+     Fun (smt2_id_to_coq_string env t_i ra rf n,
+           smt2_sexpr_to_coq_string env t_i ra rf expr)
+
+  | List [Atom "define-fun"; Atom n; List l; _; expr] ->
+     Fun (smt2_id_to_coq_string env t_i ra rf n,
+           lambda_to_coq_string l
+             (smt2_sexpr_to_coq_string env t_i ra rf expr))
+
+  | List [Atom "declare-sort"; Atom n; _] ->
+     Sort
+
+  | l ->
+     (* let out = open_out_gen [Open_append] 700 "/tmp/test.log" in
+      * let outf = Format.formatter_of_out_channel out in
+      * SExpr.print outf l; pp_print_flush outf ();
+      * close_out out; *)
+     Structures.error ("Could not reconstruct model")
+
+
+let model env rt ro ra rf = function
+  | List (Atom "model" :: l) ->
+     List.fold_left (fun acc m -> match model_item env rt ro ra rf m with Fun m -> m::acc | Sort -> acc) [] l
+     |> List.sort (fun ((_ ,i1), _) ((_, i2), _) -> i2 - i1)
+  | _ -> Structures.error ("No model")
+
+
+let model_string env rt ro ra rf s =
+  String.concat "\n"
+    (List.map (fun ((x, _) ,v) -> Format.sprintf "%s := %s" x v)
+       (model env rt ro ra rf s))
diff --git a/src/trace/smtCommands.mli b/src/trace/smtCommands.mli
index 6248270..d7b6ae6 100644
--- a/src/trace/smtCommands.mli
+++ b/src/trace/smtCommands.mli
@@ -1,98 +1,63 @@
-val euf_checker_modules : string list list
-val certif_ops :
-  Term.constr array option ->
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t
-val cCertif : Term.constr lazy_t
-val ccertif : Term.constr lazy_t
-val cchecker : Term.constr lazy_t
-val cchecker_correct : Term.constr lazy_t
-val cchecker_b_correct : Term.constr lazy_t
-val cchecker_b : Term.constr lazy_t
-val cchecker_eq_correct : Term.constr lazy_t
-val cchecker_eq : Term.constr lazy_t
-val compute_roots :
-  SmtAtom.Form.t list -> SmtAtom.Form.t SmtCertif.clause -> int list
-val interp_uf :
-  (int, Term.constr) Hashtbl.t ->
-  (int, Term.constr) Hashtbl.t -> SmtAtom.Form.t list -> Term.constr
-val interp_conseq_uf :
-  SmtAtom.Form.t list list * SmtAtom.Form.t list -> Term.types
-val print_assm : Term.constr -> unit
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val parse_certif :
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl * SmtAtom.Atom.reify_tbl *
-  SmtAtom.Form.reify * SmtAtom.Form.t list * int *
-  SmtAtom.Form.t SmtCertif.clause -> unit
-val interp_roots : SmtAtom.Form.t list -> Term.constr
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl *
+  SmtAtom.Atom.reify_tbl * SmtAtom.Form.reify *
+  SmtAtom.Form.t list * int * SmtAtom.Form.t SmtCertif.clause ->
+  unit
+
+val checker_debug :
+  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl *
+  SmtAtom.Atom.reify_tbl * SmtAtom.Form.reify *
+  SmtAtom.Form.t list * int * SmtAtom.Form.t SmtCertif.clause -> 'a
+
 val theorem :
-  Names.identifier ->
-  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl * SmtAtom.Atom.reify_tbl *
-  SmtAtom.Form.reify * SmtAtom.Form.t list * int *
-  SmtAtom.Form.t SmtCertif.clause -> unit
+  Structures.names_id ->
+  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl *
+  SmtAtom.Atom.reify_tbl * SmtAtom.Form.reify *
+  SmtAtom.Form.t list * int * SmtAtom.Form.t SmtCertif.clause ->
+  unit
+
 val checker :
-  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl * SmtAtom.Atom.reify_tbl *
-  SmtAtom.Form.reify * SmtAtom.Form.t list * int *
-  SmtAtom.Form.t SmtCertif.clause -> unit
-val build_body :
+  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl *
+  SmtAtom.Atom.reify_tbl * SmtAtom.Form.reify *
+  SmtAtom.Form.t list * int * SmtAtom.Form.t SmtCertif.clause ->
+  unit
+
+val tactic :
+  (Environ.env ->
+   SmtBtype.reify_tbl ->
+   SmtAtom.Op.reify_tbl ->
+   SmtAtom.Atom.reify_tbl ->
+   SmtAtom.Form.reify ->
+   (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) ->
+   SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause) ->
+  SmtMisc.logic ->
   SmtBtype.reify_tbl ->
   SmtAtom.Op.reify_tbl ->
   SmtAtom.Atom.reify_tbl ->
   SmtAtom.Form.reify ->
-  Term.constr ->
-  Term.constr ->
-  int * SmtAtom.Form.t SmtCertif.clause ->
-  (SmtAtom.Form.t SmtCertif.clause  -> Term.constr * Term.constr) option ->
-  Term.constr * Term.constr * (Names.identifier * Term.types) list
-val build_body_eq :
-  SmtBtype.reify_tbl ->
-  SmtAtom.Op.reify_tbl ->
   SmtAtom.Atom.reify_tbl ->
   SmtAtom.Form.reify ->
-  Term.constr ->
-  Term.constr ->
-  Term.constr ->
-  int * SmtAtom.Form.t SmtCertif.clause ->
-  (SmtAtom.Form.t SmtCertif.clause  -> Term.constr * Term.constr) option ->
-  Term.constr * Term.constr * (Names.identifier * Term.types) list
-val get_arguments : Term.constr -> Term.constr * Term.constr
-val make_proof :
-  (SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-   SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-   (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) option ->
-   SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause) ->
-  SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-  SmtAtom.Form.reify ->
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-  SmtAtom.Form.t -> SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause
-val core_tactic :
-  (SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-   SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-   (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) option ->
-   SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause) ->
-  SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-  Term.constr list -> Structures.constr_expr list -> 
-  Environ.env -> Evd.evar_map -> Term.constr -> Structures.tactic
-val tactic :
-  (SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-   SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-   (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) option ->
-   SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause) ->
-  SmtBtype.reify_tbl ->
-  SmtAtom.Op.reify_tbl ->
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify ->
-  Term.constr list -> Structures.constr_expr list -> Structures.tactic
+  (Environ.env -> Term.constr -> Term.constr) ->
+  Term.constr list ->
+  Structures.constr_expr list -> Structures.tactic
+
+val model_string : Environ.env -> SmtBtype.reify_tbl -> 'a -> 'b -> 'c -> SExpr.t -> string
diff --git a/src/trace/smtForm.ml b/src/trace/smtForm.ml
index d2e039b..4138e7c 100644
--- a/src/trace/smtForm.ml
+++ b/src/trace/smtForm.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -28,6 +24,9 @@ module type ATOM =
     val equal : t -> t -> bool
 
     val is_bool_type : t -> bool
+    val is_bv_type : t -> bool
+    val to_smt : Format.formatter -> t -> unit
+    val logic : t -> logic
 
   end
 
@@ -47,6 +46,7 @@ type fop =
 type ('a,'f) gen_pform =
   | Fatom of 'a
   | Fapp of fop * 'f array
+  | FbbT of 'a * 'f list
 
 
 module type FORM =
@@ -68,9 +68,11 @@ module type FORM =
     val is_pos : t -> bool
     val is_neg : t -> bool
 
-    val to_string : ?pi:bool -> (hatom -> string) -> t -> string
-    val to_smt : (hatom -> string) -> Format.formatter ->
-                 t -> unit
+    val to_smt : ?pi:bool ->
+                 (Format.formatter -> hatom -> unit) ->
+                 Format.formatter -> t -> unit
+
+    val logic : t -> logic
 
     (* Building formula from positive formula *)
     exception NotWellTyped of pform
@@ -86,6 +88,10 @@ module type FORM =
     (** Flattening of [Fand] and [For], removing of [Fnot2]  *)
     val flatten : reify -> t -> t
 
+    (** Turn n-ary [Fand] and [For] into their right-associative
+        counter-parts *)
+    val right_assoc : reify -> t -> t
+
     (** Producing Coq terms *)
 
     val to_coq : t -> Term.constr
@@ -150,39 +156,69 @@ module Make (Atom:ATOM) =
       | Pos hp -> hp.hval
       | Neg hp -> hp.hval
 
-    let rec to_string ?pi:(pi=false) atom_to_string = function
-      | Pos hp -> (if pi then string_of_int hp.index ^ ":" else "")
-                  ^ to_string_pform atom_to_string hp.hval
-      | Neg hp -> (if pi then string_of_int hp.index ^ ":" else "") ^ "(not "
-                  ^ to_string_pform atom_to_string hp.hval ^ ")"
-
-    and to_string_pform atom_to_string = function
-      | Fatom a -> atom_to_string a
-      | Fapp (op,args) -> to_string_op_args atom_to_string op args
-
-    and to_string_op_args atom_to_string op args =
-      let (s1,s2) = if Array.length args = 0 then ("","") else ("(",")") in
-      s1 ^ to_string_op op ^
-        Array.fold_left (fun acc h -> acc ^ " " ^ to_string atom_to_string h) "" args ^ s2
-
-    and to_string_op = function
-        | Ftrue -> "true"
-        | Ffalse -> "false"
-        | Fand -> "and"
-        | For -> "or"
-        | Fxor -> "xor"
-        | Fimp -> "=>"
-        | Fiff -> "="
-        | Fite -> "ite"
-        | Fnot2 _ -> ""
-        | Fforall l -> "forall (" ^
-                       to_string_args l ^
-                       ")"
-                                                                                
-    and to_string_args = function
-      | [] -> " "
-      | (s, t)::rest -> " (" ^ s ^ " " ^ SmtBtype.to_string t ^ ")"
-                        ^ to_string_args rest
+
+    let rec to_smt ?pi:(pi=false) atom_to_smt fmt = function
+      | Pos hp ->
+         if pi then Format.fprintf fmt "%s" (string_of_int hp.index ^ ":");
+         to_smt_pform atom_to_smt fmt hp.hval
+      | Neg hp ->
+         if pi then Format.fprintf fmt "%s" (string_of_int hp.index ^ ":");
+         Format.fprintf fmt "(not ";
+         to_smt_pform atom_to_smt fmt hp.hval;
+         Format.fprintf fmt ")"
+
+    and to_smt_pform atom_to_smt fmt = function
+      | Fatom a -> atom_to_smt fmt a
+      | Fapp (op,args) -> to_smt_op atom_to_smt fmt op args
+      (* This is an intermediate object of proofs, it correspond to nothing in SMT *)
+      | FbbT (a, l) ->
+        Format.fprintf fmt "(bbT %a [" atom_to_smt a;
+        let fi = ref true in
+        List.iter (fun f -> Format.fprintf fmt "%s%a"
+                      (if !fi then "" else "; ")
+                      (to_smt atom_to_smt) f; fi := false) l;
+        Format.fprintf fmt "])"
+
+    and to_smt_op atom_to_smt fmt op args =
+      let (s1,s2) = if ((Array.length args = 0) || (match op with Fnot2 _ -> true | _ -> false)) then ("","") else ("(",")") in
+      Format.fprintf fmt "%s" s1;
+      (match op with
+         | Ftrue -> Format.fprintf fmt "true"
+         | Ffalse -> Format.fprintf fmt "false"
+         | Fand -> Format.fprintf fmt "and"
+         | For -> Format.fprintf fmt "or"
+         | Fxor -> Format.fprintf fmt "xor"
+         | Fimp -> Format.fprintf fmt "=>"
+         | Fiff -> Format.fprintf fmt "="
+         | Fite -> Format.fprintf fmt "ite"
+         | Fnot2 _ -> ()
+         | Fforall l ->
+            (Format.fprintf fmt "forall (";
+             to_smt_args fmt l;
+             Format.fprintf fmt  ")")
+      );
+
+      Array.iter (fun h -> Format.fprintf fmt " "; to_smt atom_to_smt fmt h) args;
+      Format.fprintf fmt "%s" s2
+
+    and to_smt_args fmt = function
+      | [] -> Format.fprintf fmt " "
+      | (s, t)::rem ->
+         (Format.fprintf fmt " (%s " s;
+          SmtBtype.to_smt fmt t;
+          Format.fprintf fmt ")";
+          to_smt_args fmt rem)
+
+    let rec logic_pform = function
+      | Fatom a -> Atom.logic a
+      | Fapp (_, args) ->
+        Array.fold_left (fun l f ->
+            SL.union (logic f) l
+          ) SL.empty args
+      | FbbT _ -> SL.singleton LBitvectors
+
+    and logic = function
+      | Pos hp | Neg hp -> logic_pform hp.hval
 
     let dumbed_down op =
       let dumbed_down_bt = function
@@ -192,8 +228,6 @@ module Make (Atom:ATOM) =
       | Fforall l -> Fforall (List.map (fun (x, bt) -> x, dumbed_down_bt bt) l)
       | x -> x
 
-    let to_smt atom_to_string fmt f =
-      Format.fprintf fmt "%s" (to_string atom_to_string f)
 
     module HashedForm =
       struct
@@ -203,31 +237,44 @@ module Make (Atom:ATOM) =
 	let equal pf1 pf2 =
 	  match pf1, pf2 with
 	  | Fatom ha1, Fatom ha2 -> Atom.equal ha1 ha2
-	  | Fapp(op1,args1), Fapp(op2,args2) -> 
-	     dumbed_down op1 = dumbed_down op2 && 
-	       Array.length args1 == Array.length args2 &&
-	         (try
-		    for i = 0 to Array.length args1 - 1 do
-		      if not (equal args1.(i) args2.(i)) then raise Not_found
-		    done;
-		    true
-	          with Not_found -> false)
+	  | Fapp(op1,args1), Fapp(op2,args2) ->
+	     dumbed_down op1 = dumbed_down op2 &&
+	      Array.length args1 == Array.length args2 &&
+	      (try
+		for i = 0 to Array.length args1 - 1 do
+		  if not (equal args1.(i) args2.(i)) then raise Not_found
+		done;
+		true
+	      with Not_found -> false)
+          | FbbT(ha1, l1), FbbT(ha2, l2) ->
+             (try
+                Atom.equal ha1 ha2 &&
+                  List.for_all2 (fun i j -> equal i j) l1 l2
+              with | Invalid_argument _ -> false)
 	  | _, _ -> false
 
 	let hash pf =
 	  match pf with
 	  | Fatom ha1 -> Atom.index ha1 * 2
 	  | Fapp(op, args) ->
-	     let hash_args =
-	       match Array.length args with
-	       | 0 -> 0
-	       | 1 -> to_lit args.(0)
-	       | 2 -> (to_lit args.(1)) lsl 2 + to_lit args.(0)
-	       | _ ->
-		  (to_lit args.(2)) lsl 4 + (to_lit args.(1)) lsl 2 +
-		    to_lit args.(0) in
-	     (hash_args * 10 + Hashtbl.hash (dumbed_down op)) * 2 + 1
-
+	      let hash_args =
+		match Array.length args with
+		| 0 -> 0
+		| 1 -> to_lit args.(0)
+		| 2 -> (to_lit args.(1)) lsl 2 + to_lit args.(0)
+		| _ ->
+		    (to_lit args.(2)) lsl 4 + (to_lit args.(1)) lsl 2 +
+		      to_lit args.(0) in
+	      (hash_args * 10 + Hashtbl.hash (dumbed_down op)) * 2 + 1
+	  | FbbT(ha, l) ->
+	      let hash_args =
+		match l with
+		| [] -> 0
+		| [a0] -> to_lit a0
+		| [a0;a1] -> (to_lit a1) lsl 2 + to_lit a0
+		| a0::a1::a2::_ ->
+                   (to_lit a2) lsl 4 + (to_lit a1) lsl 2 + to_lit a0 in
+              (hash_args * 10 + Atom.index ha) * 2 + 1
       end
 
     module HashForm = Hashtbl.Make (HashedForm)
@@ -241,19 +288,36 @@ module Make (Atom:ATOM) =
 
     let check pf =
       match pf with
-      | Fatom ha ->  if not (Atom.is_bool_type ha) then raise (NotWellTyped pf)
+      | Fatom ha ->  if not (Atom.is_bool_type ha) then
+          raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                 NotWellTyped pf)
       | Fapp (op, args) ->
-	 match op with
+	(match op with
 	 | Ftrue | Ffalse ->
-	    if Array.length args <> 0 then raise (NotWellTyped pf)
+           if Array.length args <> 0 then
+             raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                    NotWellTyped pf)
 	 | Fnot2 _ ->
-	    if Array.length args <> 1 then raise (NotWellTyped pf)
+           if Array.length args <> 1 then
+             raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                    NotWellTyped pf)
 	 | Fand | For -> ()
 	 | Fxor | Fimp | Fiff ->
-	    if Array.length args <> 2 then raise (NotWellTyped pf)
-	 | Fite ->
-	    if Array.length args <> 3 then raise (NotWellTyped pf)
+           if Array.length args <> 2 then
+             raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                    NotWellTyped pf)
+
+          | Fite ->
+            if Array.length args <> 3 then
+              raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                     NotWellTyped pf)
+
          | Fforall l -> ()
+       )
+
+      | FbbT (ha, l) -> if not (Atom.is_bv_type ha) then
+          raise (Format.eprintf "nwt: %a" (to_smt_pform Atom.to_smt) pf;
+                 NotWellTyped pf)
 
     let declare reify pf =
       check pf;
@@ -278,7 +342,7 @@ module Make (Atom:ATOM) =
       ()
 
     let get ?declare:(decl=true) reify pf =
-      if decl then 
+      if decl then
         try HashForm.find reify.tbl pf
         with Not_found -> declare reify pf
       else Pos {index = -1; hval = pf}
@@ -324,100 +388,104 @@ module Make (Atom:ATOM) =
       let rec mk_hform h =
         let c, args = Term.decompose_app h in
         match get_cst c with
-        | CCtrue  -> get reify (Fapp(Ftrue,empty_args))
-        | CCfalse -> get reify (Fapp(Ffalse,empty_args))
-        | CCnot -> mk_fnot 1 args
-        | CCand -> mk_fand [] args
-        | CCor  -> mk_for [] args
-        | CCxor -> op2 (fun l -> Fapp(Fxor,l)) args
-        | CCiff -> op2 (fun l -> Fapp(Fiff,l)) args
-        | CCimp ->
-           (match args with
-            | [b1;b2] ->
-               let l1 = mk_hform b1 in
-               let l2 = mk_hform b2 in
-               get reify (Fapp (Fimp, [|l1;l2|]))
-            | _ -> Structures.error "SmtForm.Form.of_coq: wrong number of arguments for implb")
-        | CCifb ->
-           (* We should also be able to reify if then else *)
-           begin match args with
-           | [b1;b2;b3] ->
-              let l1 = mk_hform b1 in
-              let l2 = mk_hform b2 in
-              let l3 = mk_hform b3 in
-              get reify (Fapp (Fite, [|l1;l2;l3|]))
-           | _ -> Structures.error "SmtForm.Form.of_coq: wrong number of arguments for ifb"
-           end
-        | _ ->
-           let a = atom_of_coq h in
-           get reify (Fatom a)
+          | CCtrue  -> get reify (Fapp(Ftrue,empty_args))
+          | CCfalse -> get reify (Fapp(Ffalse,empty_args))
+          | CCnot -> mk_fnot 1 args
+          | CCand -> mk_fand [] args
+          | CCor  -> mk_for [] args
+          | CCxor -> op2 (fun l -> Fapp(Fxor,l)) args
+          | CCiff -> op2 (fun l -> Fapp(Fiff,l)) args
+          | CCimp ->
+             (match args with
+                | [b1;b2] ->
+                   let l1 = mk_hform b1 in
+                   let l2 = mk_hform b2 in
+                   get reify (Fapp (Fimp, [|l1;l2|]))
+                | _ -> Structures.error "SmtForm.Form.of_coq: wrong number of arguments for implb")
+          | CCifb ->
+             (* We should also be able to reify if then else *)
+             begin match args with
+               | [b1;b2;b3] ->
+                  let l1 = mk_hform b1 in
+                  let l2 = mk_hform b2 in
+                  let l3 = mk_hform b3 in
+                  get reify (Fapp (Fite, [|l1;l2;l3|]))
+               | _ -> Structures.error "SmtForm.Form.of_coq: wrong number of arguments for ifb"
+             end
+          | _ ->
+             let a = atom_of_coq h in
+             get reify (Fatom a)
 
       and op2 f args =
         match args with
-        | [b1;b2] ->
-           let l1 = mk_hform b1 in
-           let l2 = mk_hform b2 in
-           get reify (f [|l1; l2|])
-        | _ ->  Structures.error "SmtForm.Form.of_coq: wrong number of arguments"
+          | [b1;b2] ->
+             let l1 = mk_hform b1 in
+             let l2 = mk_hform b2 in
+             get reify (f [|l1; l2|])
+          | _ ->  Structures.error "SmtForm.Form.of_coq: wrong number of arguments"
 
       and mk_fnot i args =
         match args with
-        | [t] ->
-           let c,args = Term.decompose_app t in
-           if Term.eq_constr c (Lazy.force cnegb) then
-             mk_fnot (i+1) args
-           else
-             let q,r = i lsr 1 , i land 1 in
-             let l = mk_hform t in
-             let l = if r = 0 then l else neg l in
-             if q = 0 then l
-             else get reify (Fapp(Fnot2 q, [|l|]))
-        | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for negb"
+          | [t] ->
+             let c,args = Term.decompose_app t in
+             if Term.eq_constr c (Lazy.force cnegb) then
+               mk_fnot (i+1) args
+             else
+               let q,r = i lsr 1 , i land 1 in
+               let l = mk_hform t in
+               let l = if r = 0 then l else neg l in
+               if q = 0 then l
+               else get reify (Fapp(Fnot2 q, [|l|]))
+          | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for negb"
 
       and mk_fand acc args =
         match args with
-        | [t1;t2] ->
-           let l2 = mk_hform t2 in
-           let c, args = Term.decompose_app t1 in
-           if Term.eq_constr c (Lazy.force candb) then
-             mk_fand (l2::acc) args
-           else
-             let l1 = mk_hform t1 in
-             get reify (Fapp(Fand, Array.of_list (l1::l2::acc)))
-        | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for andb"
+          | [t1;t2] ->
+             let l2 = mk_hform t2 in
+             let c, args = Term.decompose_app t1 in
+             if Term.eq_constr c (Lazy.force candb) then
+               mk_fand (l2::acc) args
+             else
+               let l1 = mk_hform t1 in
+               get reify (Fapp(Fand, Array.of_list (l1::l2::acc)))
+          | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for andb"
 
       and mk_for acc args =
         match args with
-        | [t1;t2] ->
-           let l2 = mk_hform t2 in
-           let c, args = Term.decompose_app t1 in
-           if Term.eq_constr c (Lazy.force corb) then
-             mk_for (l2::acc) args
-           else
-             let l1 = mk_hform t1 in
-             get reify (Fapp(For, Array.of_list (l1::l2::acc)))
-        | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for orb" in
+          | [t1;t2] ->
+             let l2 = mk_hform t2 in
+             let c, args = Term.decompose_app t1 in
+             if Term.eq_constr c (Lazy.force corb) then
+               mk_for (l2::acc) args
+             else
+               let l1 = mk_hform t1 in
+               get reify (Fapp(For, Array.of_list (l1::l2::acc)))
+          | _ -> Structures.error "SmtForm.Form.mk_hform: wrong number of arguments for orb" in
 
       mk_hform c
 
+
     let hash_hform hash_hatom rf' hf =
       let rec mk_hform = function
         | Pos hp -> Pos (mk_hpform hp)
         | Neg hp -> Neg (mk_hpform hp)
       and mk_hpform {index = _; hval = hv} =
         let new_hv = match hv with
-          | Fatom a -> Fatom (hash_hatom a)
-          | Fapp (fop, arr) -> Fapp (fop, Array.map mk_hform arr) in
+            | Fatom a -> Fatom (hash_hatom a)
+            | Fapp (fop, arr) -> Fapp (fop, Array.map mk_hform arr)
+            | FbbT (a, l) -> FbbT (hash_hatom a, List.map mk_hform l)
+        in
         match get rf' new_hv with Pos x | Neg x -> x in
       mk_hform hf
 
+
     (** Flattening of Fand and For, removing of Fnot2 *)
     let set_sign f f' =
       if is_pos f then f' else neg f'
 
     let rec flatten reify f =
       match pform f with
-      | Fatom _ -> f
+      | Fatom _ | FbbT _ -> f
       | Fapp(Fnot2 _,args) -> set_sign f (flatten reify args.(0))
       | Fapp(Fand, args) -> set_sign f (flatten_and reify [] (Array.to_list args))
       | Fapp(For,args) -> set_sign f (flatten_or reify [] (Array.to_list args))
@@ -447,6 +515,21 @@ module Make (Atom:ATOM) =
 	    flatten_or reify acc args
 	 | _ -> flatten_or reify (flatten reify a :: acc) args
 
+    let rec right_assoc reify f =
+      match pform f with
+      | Fapp(Fand, args) when Array.length args > 2 ->
+        let a = args.(0) in
+        let rargs = Array.sub args 1 (Array.length args - 1) in
+        let f' = right_assoc reify (get reify (Fapp (Fand, rargs))) in
+        set_sign f (get reify (Fapp (Fand, [|a; f'|])))
+      | Fapp(For, args) when Array.length args > 2 ->
+        let a = args.(0) in
+        let rargs = Array.sub args 1 (Array.length args - 1) in
+        let f' = right_assoc reify (get reify (Fapp (For, rargs))) in
+        set_sign f (get reify (Fapp (For, [|a; f'|])))
+      | _ -> f
+
+
     (** Producing Coq terms *)
 
     let to_coq hf = let i = to_lit hf in
@@ -461,17 +544,20 @@ module Make (Atom:ATOM) =
     let pf_to_coq = function
       | Fatom a -> mklApp cFatom [|mkInt (Atom.index a)|]
       | Fapp(op,args) ->
-         match op with
-	 | Ftrue -> Lazy.force cFtrue
-	 | Ffalse -> Lazy.force cFfalse
-	 | Fand -> mklApp cFand [| args_to_coq args|]
-	 | For  -> mklApp cFor [| args_to_coq args|]
-	 | Fimp -> mklApp cFimp [| args_to_coq args|]
-	 | Fxor -> mklApp cFxor (Array.map to_coq args)
-	 | Fiff -> mklApp cFiff (Array.map to_coq args)
-	 | Fite -> mklApp cFite (Array.map to_coq args)
-	 | Fnot2 i -> mklApp cFnot2 [|mkInt i; to_coq args.(0)|]
-         | Fforall _ -> failwith "pf_to_coq on forall"
+         (match op with
+	   | Ftrue -> Lazy.force cFtrue
+	   | Ffalse -> Lazy.force cFfalse
+	   | Fand -> mklApp cFand [| args_to_coq args|]
+	   | For  -> mklApp cFor [| args_to_coq args|]
+	   | Fimp -> mklApp cFimp [| args_to_coq args|]
+	   | Fxor -> mklApp cFxor (Array.map to_coq args)
+	   | Fiff -> mklApp cFiff (Array.map to_coq args)
+	   | Fite -> mklApp cFite (Array.map to_coq args)
+	   | Fnot2 i -> mklApp cFnot2 [|mkInt i; to_coq args.(0)|]
+           | Fforall _ -> failwith "pf_to_coq on forall")
+      | FbbT(a, l) -> mklApp cFbbT
+         [|mkInt (Atom.index a);
+           List.fold_right (fun f l -> mklApp ccons [|Lazy.force cint; to_coq f; l|]) l (mklApp cnil [|Lazy.force cint|])|]
 
     let pform_tbl reify =
       let t = Array.make reify.count pform_true in
@@ -512,33 +598,40 @@ module Make (Atom:ATOM) =
 	      else
 	        let pc =
 	          match pform f with
-	          | Fatom a -> interp_atom a
-	          | Fapp(op, args) ->
-		     match op with
-		     | Ftrue -> Lazy.force ctrue
-		     | Ffalse -> Lazy.force cfalse
-		     | Fand -> interp_args candb args
-		     | For -> interp_args corb args
-		     | Fxor -> interp_args cxorb args
-		     | Fimp ->
-		        let r = ref (interp_form args.(Array.length args - 1)) in
-		        for i = Array.length args - 2 downto 0 do
-		          r := mklApp cimplb [|interp_form args.(i); !r|]
-		        done;
-		        !r
-		     | Fiff -> interp_args ceqb args
-		     | Fite ->
-		        (* TODO with if here *)
-		        mklApp cifb (Array.map interp_form args)
-		     | Fnot2 n ->
-		        let r = ref (interp_form args.(0)) in
-		        for i = 1 to n do
-                          r := mklApp cnegb [|!r|]
-                        done;
-                        !r
-                     |Fforall _ -> failwith "interp_to_coq on forall" in
+	            | Fatom a -> interp_atom a
+	            | Fapp(op, args) ->
+		       (match op with
+		          | Ftrue -> Lazy.force ctrue
+		          | Ffalse -> Lazy.force cfalse
+		          | Fand -> interp_args candb args
+		          | For -> interp_args corb args
+		          | Fxor -> interp_args cxorb args
+		          | Fimp ->
+		             let r = ref (interp_form args.(Array.length args - 1)) in
+		             for i = Array.length args - 2 downto 0 do
+		               r := mklApp cimplb [|interp_form args.(i); !r|]
+		             done;
+		             !r
+		          | Fiff -> interp_args ceqb args
+		          | Fite ->
+		             (* TODO with if here *)
+		             mklApp cifb (Array.map interp_form args)
+		          | Fnot2 n ->
+		             (let r = ref (interp_form args.(0)) in
+		              for i = 1 to n do
+                                r := mklApp cnegb [|!r|]
+                              done;
+                              !r)
+                          | Fforall _ -> failwith "interp_to_coq on forall")
+                    | FbbT(a, l) ->
+                       mklApp cbv_eq
+                         [|mkN (List.length l);
+                           interp_atom a;
+                           mklApp cof_bits [|List.fold_right (fun f l -> mklApp ccons [|Lazy.force cbool; interp_form f; l|]) l (mklApp cnil [|Lazy.force cbool|])|]|]
+                in
 	        Hashtbl.add form_tbl l pc;
-	        pc
+                pc
+
       and interp_args op args =
 	let r = ref (interp_form args.(0)) in
 	  for i = 1 to Array.length args - 1 do
diff --git a/src/trace/smtForm.mli b/src/trace/smtForm.mli
index 4ee86e2..c26e279 100644
--- a/src/trace/smtForm.mli
+++ b/src/trace/smtForm.mli
@@ -1,19 +1,17 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
+open SmtMisc
+
 module type ATOM = 
   sig 
 
@@ -23,6 +21,9 @@ module type ATOM =
     val equal : t -> t -> bool
 
     val is_bool_type : t -> bool
+    val is_bv_type : t -> bool
+    val to_smt : Format.formatter -> t -> unit
+    val logic : t -> logic
 
   end 
 
@@ -42,6 +43,7 @@ type fop =
 type ('a,'f) gen_pform = 
   | Fatom of 'a
   | Fapp of fop * 'f array
+  | FbbT of 'a * 'f list
 
 module type FORM =
   sig 
@@ -62,8 +64,11 @@ module type FORM =
       val is_pos : t -> bool
       val is_neg : t -> bool
 
-      val to_string : ?pi:bool -> (hatom -> string) -> t -> string
-      val to_smt : (hatom -> string) -> Format.formatter -> t -> unit
+      val to_smt : ?pi:bool ->
+                   (Format.formatter -> hatom -> unit) ->
+                   Format.formatter -> t -> unit
+
+      val logic : t -> logic
 
       (* Building formula from positive formula *)
       exception NotWellTyped of pform
@@ -80,6 +85,10 @@ module type FORM =
       (** Flattening of [Fand] and [For], removing of [Fnot2]  *)
       val flatten : reify -> t -> t
 
+      (** Turn n-ary [Fand] and [For] into their right-associative
+          counter-parts *)
+      val right_assoc : reify -> t -> t
+
       (** Producing Coq terms *) 
 
       val to_coq : t -> Term.constr
diff --git a/src/trace/smtMisc.ml b/src/trace/smtMisc.ml
index 58de402..f839869 100644
--- a/src/trace/smtMisc.ml
+++ b/src/trace/smtMisc.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -39,6 +35,30 @@ let mkName s =
   let id = Names.id_of_string s in
   Names.Name id
 
+
+let string_coq_constr t =
+  let rec fix rf x = rf (fix rf) x in
+  let pr = fix
+      Ppconstr.modular_constr_pr Pp.mt Structures.ppconstr_lsimpleconstr in
+  Pp.string_of_ppcmds (pr (Structures.constrextern_extern_constr t))
+
+
 let string_of_name = function
     Names.Name id -> Names.string_of_id id
   | _ -> failwith "unnamed rel"
+
+
+(** Logics *)
+
+type logic_item =
+  | LUF
+  | LLia
+  | LBitvectors
+  | LArrays
+
+module SL = Set.Make (struct
+    type t = logic_item
+    let compare = Pervasives.compare
+  end)
+
+type logic = SL.t
diff --git a/src/trace/smtMisc.mli b/src/trace/smtMisc.mli
index e5cf69f..a9de935 100644
--- a/src/trace/smtMisc.mli
+++ b/src/trace/smtMisc.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val cInt_tbl : (int, Term.constr) Hashtbl.t
 val mkInt : int -> Term.constr
 type 'a gen_hashed = { index : int; hval : 'a; }
@@ -5,4 +17,8 @@ val mklApp : Term.constr Lazy.t -> Term.constr array -> Term.constr
 val declare_new_type : Names.variable -> Term.constr
 val declare_new_variable : Names.variable -> Term.types -> Term.constr
 val mkName : string -> Names.name
+val string_coq_constr : Term.constr -> string
 val string_of_name : Names.name -> string
+type logic_item = LUF | LLia | LBitvectors | LArrays
+module SL : Set.S with type elt = logic_item
+type logic = SL.t
diff --git a/src/trace/smtTrace.ml b/src/trace/smtTrace.ml
index 9042b8b..b410f88 100644
--- a/src/trace/smtTrace.ml
+++ b/src/trace/smtTrace.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -352,11 +348,16 @@ let build_certif first_root confl =
 
 
 let to_coq to_lit interp (cstep,
-    cRes, cImmFlatten,
+    cRes, cWeaken, cImmFlatten,
     cTrue, cFalse, cBuildDef, cBuildDef2, cBuildProj,
     cImmBuildProj,cImmBuildDef,cImmBuildDef2,
     cEqTr, cEqCgr, cEqCgrP,
     cLiaMicromega, cLiaDiseq, cSplArith, cSplDistinctElim,
+    cBBVar, cBBConst, cBBOp, cBBNot, cBBEq, cBBDiseq,
+    cBBNeg, cBBAdd, cBBMul, cBBUlt, cBBSlt, cBBConc,
+    cBBExtr, cBBZextn, cBBSextn,
+    cBBShl, cBBShr,
+    cRowEq, cRowNeq, cExt,
     cHole, cForallInst) confl sf =
 
   let cuts = ref [] in
@@ -382,6 +383,12 @@ let to_coq to_lit interp (cstep,
 	mklApp cRes [|mkInt (get_pos c); Structures.mkArray (Lazy.force cint, args)|]
     | Other other ->
 	begin match other with
+        | Weaken (c',l') ->
+          let out_cl cl =
+            List.fold_right (fun f l ->
+                mklApp ccons [|Lazy.force cint; out_f f; l|])
+              cl (mklApp cnil [|Lazy.force cint|]) in
+          mklApp cWeaken [|out_c c;out_c c'; out_cl l'|]
 	| ImmFlatten (c',f) -> mklApp cImmFlatten [|out_c c;out_c c'; out_f f|]
         | True -> mklApp cTrue [|out_c c|]
 	| False -> mklApp cFalse [|out_c c|]
@@ -410,6 +417,45 @@ let to_coq to_lit interp (cstep,
           let l' = List.fold_right (fun f l -> mklApp ccons [|Lazy.force Structures.Micromega_plugin_Coq_micromega.M.coq_proofTerm; Structures.Micromega_plugin_Coq_micromega.dump_proof_term f; l|]) l (mklApp cnil [|Lazy.force Structures.Micromega_plugin_Coq_micromega.M.coq_proofTerm|]) in
           mklApp cSplArith [|out_c c; out_c orig; res'; l'|]
 	| SplDistinctElim (c',f) -> mklApp cSplDistinctElim [|out_c c;out_c c'; out_f f|]
+        | BBVar res -> mklApp cBBVar [|out_c c; out_f res|]
+        | BBConst res -> mklApp cBBConst [|out_c c; out_f res|]
+        | BBOp (c1,c2,res) ->
+          mklApp cBBOp [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBNot (c1,res) ->
+          mklApp cBBNot [|out_c c; out_c c1; out_f res|]
+        | BBNeg (c1,res) ->
+          mklApp cBBNeg [|out_c c; out_c c1; out_f res|]
+        | BBAdd (c1,c2,res) ->
+          mklApp cBBAdd [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBMul (c1,c2,res) ->
+          mklApp cBBMul [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBUlt (c1,c2,res) ->
+          mklApp cBBUlt [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBSlt (c1,c2,res) ->
+          mklApp cBBSlt [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBConc (c1,c2,res) ->
+          mklApp cBBConc [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBExtr (c1,res) ->
+          mklApp cBBExtr [|out_c c; out_c c1; out_f res|]
+        | BBZextn (c1,res) ->
+          mklApp cBBZextn [|out_c c; out_c c1; out_f res|]
+        | BBSextn (c1,res) ->
+          mklApp cBBSextn [|out_c c; out_c c1; out_f res|]
+        | BBShl (c1,c2,res) ->
+          mklApp cBBShl [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBShr (c1,c2,res) ->
+          mklApp cBBShr [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBEq (c1,c2,res) ->
+          mklApp cBBEq [|out_c c; out_c c1; out_c c2; out_f res|]
+        | BBDiseq (res) -> mklApp cBBDiseq [|out_c c; out_f res|]
+        | RowEq (res) -> mklApp cRowEq [|out_c c; out_f res|]
+        | RowNeq (cl) ->
+          let out_cl cl =
+            List.fold_right (fun f l ->
+                mklApp ccons [|Lazy.force cint; out_f f; l|])
+              cl (mklApp cnil [|Lazy.force cint|]) in
+          mklApp cRowNeq [|out_c c; out_cl cl|]
+        | Ext (res) -> mklApp cExt [|out_c c; out_f res|]
         | Hole (prem_id, concl) ->
            let prem = List.map (fun cl -> match cl.value with Some l -> l | None -> assert false) prem_id in
            let ass_name = Names.id_of_string ("ass"^(string_of_int (Hashtbl.hash concl))) in
@@ -439,32 +485,11 @@ let to_coq to_lit interp (cstep,
   let nc = ref 0 in
   while not (isRoot !r.kind) do r := prev !r; incr nc done;
   let last_root = !r in
-
-  (* let size = !nc in *)
-  (* let max = Structures.max_array_size - 1 in *)
-  (* let q,r1 = size / max, size mod max in *)
-  (* let trace =  *)
-  (*   let len = if r1 = 0 then q + 1 else q + 2 in *)
-  (*   Array.make len (Structures.mkArray (step, [|def_step|])) in *)
-  (* for j = 0 to q - 1 do *)
-  (*   let tracej = Array.make Structures.max_array_size def_step in *)
-  (*   for i = 0 to max - 1 do *)
-  (*     r := next !r; *)
-  (*     tracej.(i) <- step_to_coq !r;  *)
-  (*   done; *)
-  (*   trace.(j) <- Structures.mkArray (step, tracej) *)
-  (* done; *)
-  (* if r1 <> 0 then begin *)
-  (*   let traceq = Array.make (r1 + 1) def_step in *)
-  (*   for i = 0 to r1-1 do  *)
-  (*   r := next !r;  *)
-  (*   traceq.(i) <- step_to_coq !r;  *)
-  (*   done; *)
-  (*   trace.(q) <- Structures.mkArray (step, traceq) *)
-  (* end; *)
-  (* (Structures.mkArray (mklApp carray [|step|], trace), last_root, !cuts) *)
-  let tres = Structures.mkTrace step_to_coq next carray clist cnil ccons cpair !nc step def_step r in
-  (tres, last_root, !cuts)
+  (* Be careful, step_to_coq makes a side effect on cuts so it needs to be called first *)
+  let res =
+    Structures.mkTrace step_to_coq next carray clist cnil ccons cpair !nc step def_step r
+  in
+  (res, last_root, !cuts)
 
 
 
diff --git a/src/trace/smtTrace.mli b/src/trace/smtTrace.mli
index 57d0d42..f06ade4 100644
--- a/src/trace/smtTrace.mli
+++ b/src/trace/smtTrace.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val notUsed : int
 val clear : unit -> unit
 val next_id : unit -> SmtCertif.clause_id
@@ -37,15 +49,24 @@ val build_certif : 'a SmtCertif.clause -> 'b SmtCertif.clause -> int
 val to_coq :
   ('a -> Term.constr) ->
   ('a list list * 'a list -> Term.types) ->
-  Term.types Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
   Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
   Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
   Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
   Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
   Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
-  Term.constr Lazy.t * Term.constr Lazy.t -> 'a SmtCertif.clause ->
-  ('a SmtCertif.clause -> Term.constr * Term.constr) option ->
-  Term.constr * 'a SmtCertif.clause * (Names.identifier * Term.types) list
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t * Term.constr Lazy.t *
+  Term.constr Lazy.t * Term.constr Lazy.t ->
+  'a SmtCertif.clause ->
+  ('a SmtCertif.clause -> Term.types * Term.constr) option ->
+  Term.constr * 'a SmtCertif.clause *
+    (Names.identifier * Term.types) list
 module MakeOpt :
   functor (Form : SmtForm.FORM) ->
     sig
diff --git a/src/verit/verit.ml b/src/verit/verit.ml
index 16968cc..6406500 100644
--- a/src/verit/verit.ml
+++ b/src/verit/verit.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -38,7 +34,32 @@ exception Import_trace of int
 let get_val = function
     Some a -> a
   | None -> assert false
-                            
+
+(* For debugging certif processing : <add_scertif> <select> <occur> <alloc> *)
+let print_certif c where=
+  let r = ref c in
+  let out_channel = open_out where in
+  let fmt = Format.formatter_of_out_channel out_channel in
+  let continue = ref true in
+  while !continue do
+    let kind = to_string (!r.kind) in
+    let id = !r.id in
+    let pos = match !r.pos with
+      | None -> "None"
+      | Some p -> string_of_int p in
+    let used = !r.used in
+    Format.fprintf fmt "id:%i kind:%s pos:%s used:%i value:" id kind pos used;
+    begin match !r.value with
+    | None -> Format.fprintf fmt "None"
+    | Some l -> List.iter (fun f -> Form.to_smt Atom.to_smt fmt f;
+                                    Format.fprintf fmt " ") l end;
+    Format.fprintf fmt "\n";
+    match !r.next with
+    | None -> continue := false
+    | Some n -> r := n
+  done;
+  Format.fprintf fmt "@."; close_out out_channel
+
 let import_trace ra' rf' filename first lsmt =
   let chan = open_in filename in
   let lexbuf = Lexing.from_channel chan in
@@ -105,9 +126,17 @@ let import_all fsmt fproof =
 
 
 let parse_certif t_i t_func t_atom t_form root used_root trace fsmt fproof =
-  SmtCommands.parse_certif t_i t_func t_atom t_form root used_root trace (import_all fsmt fproof)
-let theorem name fsmt fproof = SmtCommands.theorem name (import_all fsmt fproof)
-let checker fsmt fproof = SmtCommands.checker (import_all fsmt fproof)
+  SmtCommands.parse_certif t_i t_func t_atom t_form root used_root trace
+    (import_all fsmt fproof)
+
+let checker_debug fsmt fproof =
+  SmtCommands.checker_debug (import_all fsmt fproof)
+
+let theorem name fsmt fproof =
+  SmtCommands.theorem name (import_all fsmt fproof)
+
+let checker fsmt fproof =
+  SmtCommands.checker (import_all fsmt fproof)
 
 
 
@@ -137,15 +166,17 @@ let export out_channel rt ro lsmt =
   ) (Op.to_list ro);
 
   List.iter (fun u -> Format.fprintf fmt "(assert ";
-                      Form.to_smt Atom.to_string fmt u;
+                      Form.to_smt Atom.to_smt fmt u;
                       Format.fprintf fmt ")\n") lsmt;
 
   Format.fprintf fmt "(check-sat)\n(exit)@."
 
 
-(* val call_verit : Btype.reify_tbl -> Op.reify_tbl -> Form.t -> (Form.t clause * Form.t) -> (int * Form.t clause) *)
-let call_verit rt ro ra' rf' first lsmt =
-  let filename, outchan = Filename.open_temp_file "verit_coq" ".smt2" in
+let call_verit _ rt ro ra' rf' first lsmt =
+  let (_, l') = first in
+  let fl' = Form.flatten rf' l' in
+  let lsmt = fl'::lsmt in
+  let (filename, outchan) = Filename.open_temp_file "verit_coq" ".smt2" in
   export outchan rt ro lsmt;
   close_out outchan;
   let logfilename = Filename.chop_extension filename ^ ".vtlog" in
@@ -157,8 +188,10 @@ let call_verit rt ro ra' rf' first lsmt =
   let exit_code = Sys.command command in
   let t1 = Sys.time () in
   Format.eprintf "Verit = %.5f@." (t1-.t0);
+
+  (* TODO: improve readability: remove the three nested try *)
   let win = open_in wname in
-  try 
+  try
     if exit_code <> 0 then
       failwith ("Verit.call_verit: command " ^ command ^
 	          " exited with code " ^ string_of_int exit_code);
@@ -167,13 +200,17 @@ let call_verit rt ro ra' rf' first lsmt =
         Structures.error "veriT returns 'unknown'"
     with End_of_file ->
           try
-            let res = import_trace ra' rf' logfilename first lsmt in
+            let res = import_trace ra' rf' logfilename (Some first) lsmt in
             close_in win; Sys.remove wname; res
           with
-          | VeritSyntax.Sat -> Structures.error "veriT found a counter-example"
+            | VeritSyntax.Sat -> Structures.error "veriT found a counter-example"
   with x -> close_in win; Sys.remove wname; raise x
 
-let tactic lcpl lcepl =
+
+let verit_logic =
+  SL.of_list [LUF; LLia]
+
+let tactic_gen vm_cast lcpl lcepl =
   clear_all ();
   let rt = SmtBtype.create () in
   let ro = Op.create () in
@@ -181,4 +218,6 @@ let tactic lcpl lcepl =
   let rf = VeritSyntax.rf in
   let ra' = VeritSyntax.ra' in
   let rf' = VeritSyntax.rf' in
-  SmtCommands.tactic call_verit rt ro ra rf ra' rf' lcpl lcepl
+  SmtCommands.tactic call_verit verit_logic rt ro ra rf ra' rf' vm_cast lcpl lcepl
+let tactic = tactic_gen vm_cast_true
+let tactic_no_check = tactic_gen (fun _ -> vm_cast_true_no_check)
diff --git a/src/verit/verit.mli b/src/verit/verit.mli
index 95959da..468aa1e 100644
--- a/src/verit/verit.mli
+++ b/src/verit/verit.mli
@@ -1,34 +1,23 @@
-val debug : bool
-val import_trace :
-  SmtAtom.Atom.reify_tbl -> SmtAtom.Form.reify -> string ->
-  (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) option ->
-  SmtAtom.Form.t list -> int * SmtAtom.Form.t SmtCertif.clause
-val clear_all : unit -> unit
-val import_all :
-  string ->
-  string ->
-  SmtBtype.reify_tbl * SmtAtom.Op.reify_tbl * SmtAtom.Atom.reify_tbl *
-  SmtAtom.Form.reify * SmtAtom.Form.t list * int *
-  SmtAtom.Form.t SmtCertif.clause
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val parse_certif :
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier ->
-  Names.identifier -> Names.identifier -> string -> string -> unit
-val theorem : Names.identifier -> string -> string -> unit
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id ->
+  Structures.names_id -> Structures.names_id -> Structures.names_id -> string -> string -> unit
 val checker : string -> string -> unit
-val export :
-  out_channel ->
-  SmtBtype.reify_tbl -> SmtAtom.Op.reify_tbl ->
-  SmtAtom.Form.t list -> unit
-val call_verit :
-  SmtBtype.reify_tbl ->
-  SmtAtom.Op.reify_tbl ->
-  SmtAtom.Atom.reify_tbl ->
-  SmtAtom.Form.reify ->
-  (SmtAtom.Form.t SmtCertif.clause * SmtAtom.Form.t) option ->
-  SmtAtom.Form.t list ->
-  int * SmtAtom.Form.t SmtCertif.clause
+val checker_debug : string -> string -> unit
+val theorem : Structures.names_id -> string -> string -> unit
 val tactic : Term.constr list -> Structures.constr_expr list -> Structures.tactic
+val tactic_no_check : Term.constr list -> Structures.constr_expr list -> Structures.tactic
diff --git a/src/verit/veritLexer.mll b/src/verit/veritLexer.mll
index 80fcc39..f5b88bf 100644
--- a/src/verit/veritLexer.mll
+++ b/src/verit/veritLexer.mll
@@ -1,20 +1,16 @@
+{
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
-(*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
 (**************************************************************************)
 
 
-{
   open VeritParser
   exception Eof
 
@@ -62,6 +58,7 @@
         "qnt_simplify_ax", QNTS;
         "qnt_merge_ax", QNTM;
         "resolution", RESO;
+        "weaken", WEAK;
         "and", AND;
         "not_or", NOR;
         "or", OR;
@@ -97,11 +94,62 @@
         "tmp_qnt_simplify", TPQS;
         "tmp_skolemize", TPSK;
         "subproof", SUBP;
-        "hole", HOLE ]
+        "flatten", FLAT;
+        "hole", HOLE;
+        "bbvar", BBVA;
+        "bbconst", BBCONST;
+        "bbeq", BBEQ;
+        "bv_const_neq", BBDIS;
+        "bbop", BBOP;
+        "bbnot", BBNOT;
+        "bbneg", BBNEG;
+        "bbadd", BBADD;
+        "bbmul", BBMUL;
+        "bbult", BBULT;
+        "bbslt", BBSLT;
+        "bbconcat", BBCONC;
+        "bbextract", BBEXTR;
+        "bbzextend", BBZEXT;
+        "bbsextend", BBSEXT;
+        "bbshl", BBSHL;
+        "bbshr", BBSHR;
+        "bvand", BVAND;
+        "bvor", BVOR;
+        "bvxor", BVXOR;
+        "bvadd", BVADD;
+        "bvmul", BVMUL;
+        "bvult", BVULT;
+        "bvslt", BVSLT;
+        "bvule", BVULE;
+        "bvsle", BVSLE;
+        "bvshl", BVSHL;
+        "bvlshr", BVSHR;
+        "not", NOT;
+        "xor", XOR;
+        "ite", ITE;
+        "let", LET;
+        "distinct", DIST;
+        "bbT", BBT;
+        "bitof", BITOF;
+        "bvnot", BVNOT;
+        "bvneg", BVNEG;
+        "concat", BVCONC;
+        "extract", BVEXTR;
+        "zero_extend", BVZEXT;
+        "sign_extend", BVSEXT;
+        "select", SELECT;
+        "diff", DIFF;
+        "store", STORE;
+        "row1", ROW1;
+        "row2", ROW2;
+        "ext", EXTE;
+      ]
 }
 
 
 let digit = [ '0'-'9' ]
+let bit = [ '0'-'1' ]
+let bitvector = '#' 'b' bit+
 let alpha = [ 'a'-'z' 'A' - 'Z' ]
 let blank = [' ' '\t']
 let newline = ['\n' '\r']
@@ -116,14 +164,14 @@ rule token = parse
   | newline +                  { EOL }
 
   | ":"                        { COLON }
-  | "#"                        { SHARP }
+  | "#" (int as i)             { SHARPINT (int_of_string i) }
 
   | "("                        { LPAR }
   | ")"                        { RPAR }
 
-  | "not"                      { NOT }
-  | "xor"                      { XOR }
-  | "ite"                      { ITE }
+  | "["                        { LBRACKET }
+  | "]"                        { RBRACKET }
+
   | "="                        { EQ }
   | "<"                        { LT }
   | "<="                       { LEQ }
@@ -134,22 +182,20 @@ rule token = parse
   | "~"                        { OPP }
   | "*"                        { MULT }
   | "=>"                       { IMP }
-  | "let"                      { LET }
-  | "distinct"                 { DIST }
 
   | "Formula is Satisfiable"   { SAT }
+
   | "Tindex_" (int as i)       { TINDEX (int_of_string i) }
   | "Int"     	      	       { TINT }
   | "Bool"		       { TBOOL }
-  | int                        { try INT (int_of_string (Lexing.lexeme lexbuf))
-	                         with _ -> 
-                                   BIGINT 
-                                     (Big_int.big_int_of_string 
-					(Lexing.lexeme lexbuf)) }
+  | (int as i)                 { try INT (int_of_string i)
+	                         with _ ->
+                                   BIGINT (Big_int.big_int_of_string i) }
+  | bitvector as bv            { BITV bv }
   | var                        { let v = Lexing.lexeme lexbuf in
                                  try Hashtbl.find typ_table v with
                                    | Not_found -> VAR v }
-  | bindvar                    { BINDVAR (Lexing.lexeme lexbuf) }
+  | bindvar as v               { BINDVAR v }
 
   | atvar 		       { ATVAR (Lexing.lexeme lexbuf) }
 
diff --git a/src/verit/veritParser.mly b/src/verit/veritParser.mly
index 3c675ee..65eb6b7 100644
--- a/src/verit/veritParser.mly
+++ b/src/verit/veritParser.mly
@@ -1,24 +1,33 @@
-/**************************************************************************/
-/*                                                                        */
-/*     SMTCoq                                                             */
-/*     Copyright (C) 2011 - 2016                                          */
-/*                                                                        */
-/*     Michaël Armand                                                     */
-/*     Benjamin Grégoire                                                  */
-/*     Chantal Keller                                                     */
-/*                                                                        */
-/*     Inria - École Polytechnique - Université Paris-Sud                 */
-/*                                                                        */
-/*   This file is distributed under the terms of the CeCILL-C licence     */
-/*                                                                        */
-/**************************************************************************/
+%{
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
 
 
-%{
-  open SmtBtype 
+  open SmtBtype
   open SmtAtom
   open SmtForm
   open VeritSyntax
+
+
+
+  let parse_bv s =
+    let l = ref [] in
+    for i = 2 to String.length s - 1 do
+      match s.[i] with
+      | '0' -> l := false :: !l
+      | '1' -> l := true :: !l
+      | _ -> assert false
+    done;
+    !l
+
 %}
 
 
@@ -27,16 +36,15 @@
 */
 
 %token EOL SAT
-%token COLON SHARP
-%token LPAR RPAR
-%token NOT XOR ITE EQ LT LEQ GT GEQ PLUS MINUS MULT OPP LET DIST
+%token COLON
+%token LPAR RPAR LBRACKET RBRACKET
+%token NOT XOR ITE EQ LT LEQ GT GEQ PLUS MINUS MULT OPP LET DIST BBT BITOF BVAND BVOR BVXOR BVADD BVMUL BVULT BVSLT BVULE BVSLE BVCONC BVEXTR BVZEXT BVSEXT BVNOT BVNEG SELECT STORE DIFF BVSHL BVSHR
 %token TBOOL TINT
 %token<int> TINDEX
-%token INPU DEEP TRUE FALS ANDP ANDN ORP ORN XORP1 XORP2 XORN1 XORN2 IMPP IMPN1 IMPN2 EQUP1 EQUP2 EQUN1 EQUN2 ITEP1 ITEP2 ITEN1 ITEN2 EQRE EQTR EQCO EQCP DLGE LAGE LATA DLDE LADE FINS EINS SKEA SKAA QNTS QNTM RESO AND NOR OR NAND XOR1 XOR2 NXOR1 NXOR2 IMP NIMP1 NIMP2 EQU1 EQU2 NEQU1 NEQU2 ITE1 ITE2 NITE1 NITE2 TPAL TLAP TPLE TPNE TPDE TPSA TPIE TPMA TPBR TPBE TPSC TPPP TPQT TPQS TPSK SUBP HOLE FORALL
-%token <int> INT
+%token INPU DEEP TRUE FALS ANDP ANDN ORP ORN XORP1 XORP2 XORN1 XORN2 IMPP IMPN1 IMPN2 EQUP1 EQUP2 EQUN1 EQUN2 ITEP1 ITEP2 ITEN1 ITEN2 EQRE EQTR EQCO EQCP DLGE LAGE LATA DLDE LADE FINS EINS SKEA SKAA QNTS QNTM RESO WEAK AND NOR OR NAND XOR1 XOR2 NXOR1 NXOR2 IMP NIMP1 NIMP2 EQU1 EQU2 NEQU1 NEQU2 ITE1 ITE2 NITE1 NITE2 TPAL TLAP TPLE TPNE TPDE TPSA TPIE TPMA TPBR TPBE TPSC TPPP TPQT TPQS TPSK SUBP FLAT HOLE FORALL BBVA BBCONST BBEXTR BBZEXT BBSEXT BBEQ BBDIS BBOP BBADD BBMUL BBULT BBSLT BBNOT BBNEG BBCONC ROW1 ROW2 EXTE BBSHL BBSHR
+%token <int> INT SHARPINT
 %token <Big_int.big_int> BIGINT
-%token <string> VAR BINDVAR ATVAR
-
+%token <string> VAR BINDVAR ATVAR BITV
 
 /* type de "retour" du parseur : une clause */
 %type <int> line
@@ -53,9 +61,9 @@ line:
   | SAT                                                    { raise Sat }
   | INT COLON LPAR typ clause                   RPAR EOL   { mk_clause ($1,$4,$5,[]) }
   | INT COLON LPAR typ clause clause_ids_params RPAR EOL   { mk_clause ($1,$4,$5,$6) }
-  | INT COLON LPAR TPQT LPAR SHARP INT COLON LPAR forall_decl RPAR RPAR INT RPAR EOL { add_solver $7 $10; add_ref $7 $1; mk_clause ($1, Tpqt, [], [$13]) }
-  | INT COLON LPAR FINS LPAR SHARP INT COLON LPAR OR LPAR NOT SHARP INT RPAR lit RPAR RPAR RPAR EOL
-  { mk_clause ($1, Fins, [snd $16], [get_ref $14]) }
+  | INT COLON LPAR TPQT LPAR SHARPINT COLON LPAR forall_decl RPAR RPAR INT RPAR EOL { add_solver $6 $9; add_ref $6 $1; mk_clause ($1, Tpqt, [], [$12]) }
+  | INT COLON LPAR FINS LPAR SHARPINT COLON LPAR OR LPAR NOT SHARPINT RPAR lit RPAR RPAR RPAR EOL
+  { mk_clause ($1, Fins, [snd $14], [get_ref $12]) }
 ;
 
 typ:
@@ -98,6 +106,7 @@ typ:
   | QNTS                                                   { Qnts  }
   | QNTM                                                   { Qntm  }
   | RESO                                                   { Reso  }
+  | WEAK                                                   { Weak  }
   | AND                                                    { And   }
   | NOR                                                    { Nor   }
   | OR                                                     { Or    }
@@ -131,7 +140,28 @@ typ:
   | TPQS                                                   { Tpqs  }
   | TPSK                                                   { Tpsk  }
   | SUBP                                                   { Subp  }
+  | FLAT                                                   { Flat  }
   | HOLE                                                   { Hole  }
+  | BBVA                                                   { Bbva  }
+  | BBCONST                                                { Bbconst }
+  | BBEQ                                                   { Bbeq  }
+  | BBDIS                                                  { Bbdis }
+  | BBOP                                                   { Bbop  }
+  | BBADD                                                  { Bbadd }
+  | BBMUL                                                  { Bbmul }
+  | BBULT                                                  { Bbult }
+  | BBSLT                                                  { Bbslt }
+  | BBNOT                                                  { Bbnot }
+  | BBNEG                                                  { Bbneg }
+  | BBCONC                                                 { Bbconc }
+  | BBEXTR                                                 { Bbextr }
+  | BBZEXT                                                 { Bbzext }
+  | BBSEXT                                                 { Bbsext }
+  | BBSHL                                                  { Bbshl }
+  | BBSHR                                                  { Bbshr }
+  | ROW1                                                   { Row1  }
+  | ROW2                                                   { Row2  }
+  | EXTE                                                   { Exte  }
 ;
 
 clause:
@@ -149,18 +179,19 @@ lit:   /* returns a SmtAtom.Form.t option */
   | LPAR NOT lit RPAR                                      { apply_dec Form.neg $3 }
 ;
 
-nlit:   
+nlit:
   | LPAR NOT lit RPAR                                      { apply_dec Form.neg $3 }
 ;
 
-var_atvar:   
+var_atvar:
   | VAR			                                   { $1 }
   | ATVAR			                           { $1 }
 ;
 
-name_term:   /* returns a bool * (SmtAtom.Form.pform or SmtAtom.hatom), the boolean indicates if we should declare the term or not */
-  | SHARP INT                                              { get_solver $2 }
-  | SHARP INT COLON LPAR term RPAR                         { let u = $5 in add_solver $2 u; u }
+name_term:   /* returns a bool * (SmtAtom.Form.pform or a SmtAtom.hatom), the boolean indicates if we should declare the term or not */
+  | SHARPINT                                              { get_solver $1 }
+  | SHARPINT COLON LPAR term RPAR                         { let res = $4 in add_solver $1 res; res }
+  | BITV                                                   { true, Atom (Atom.mk_bvconst ra (parse_bv $1)) }
   | TRUE                                                   { true, Form Form.pform_true }
   | FALS                                                   { true, Form Form.pform_false }
   | var_atvar						   { let x = $1 in match find_opt_qvar x with
@@ -174,7 +205,8 @@ name_term:   /* returns a bool * (SmtAtom.Form.pform or SmtAtom.hatom), the bool
 tvar:
   | TINT						   { TZ }
   | TBOOL						   { Tbool }
-  | TINDEX						   { Tindex (indexed_type_of_int $1) }
+  | TINDEX                                                 { Tindex (indexed_type_of_int $1) }
+;
 
 var_decl_list:
   | LPAR var_atvar tvar RPAR				   { add_qvar $2 $3; [$2, $3] }
@@ -197,10 +229,12 @@ term:   /* returns a bool * (SmtAtom.Form.pform or SmtAtom.hatom), the boolean i
   | XOR lit_list                                           { apply_dec (fun x -> Form (Fapp (Fxor, Array.of_list x))) (list_dec $2) }
   | ITE lit_list                                           { apply_dec (fun x -> Form (Fapp (Fite, Array.of_list x))) (list_dec $2) }
   | forall_decl                                            { $1 }
+  | BBT name_term LBRACKET lit_list RBRACKET               { let (decl, t) = $2 in let (decll, l) = list_dec $4 in (decl && decll, match t with | Atom a -> Form (FbbT (a, l)) | _ -> assert false) }
 
   /* Atoms */
   | INT                                                    { true, Atom (Atom.hatom_Z_of_int ra $1) }
   | BIGINT                                                 { true, Atom (Atom.hatom_Z_of_bigint ra $1) }
+  | BITV                                                   { true, Atom (Atom.mk_bvconst ra (parse_bv $1)) }
   | LT name_term name_term                                 { apply_bdec_atom (Atom.mk_lt ra) $2 $3 }
   | LEQ name_term name_term                                { apply_bdec_atom (Atom.mk_le ra) $2 $3 }
   | GT name_term name_term                                 { apply_bdec_atom (Atom.mk_gt ra) $2 $3 }
@@ -208,31 +242,51 @@ term:   /* returns a bool * (SmtAtom.Form.pform or SmtAtom.hatom), the boolean i
   | PLUS name_term name_term                               { apply_bdec_atom (Atom.mk_plus ra) $2 $3 }
   | MULT name_term name_term                               { apply_bdec_atom (Atom.mk_mult ra) $2 $3 }
   | MINUS name_term name_term                              { apply_bdec_atom (Atom.mk_minus ra) $2 $3}
-  | MINUS name_term                                        { apply_dec_atom (fun d a -> Atom.mk_neg ra a) $2 }
-  | OPP name_term                                          { apply_dec_atom (fun d a -> Atom.mk_opp ra ~declare:d a) $2 }
+  | MINUS name_term                                        { apply_dec_atom (fun ?declare:d a -> Atom.mk_neg ra a) $2 }
+  | OPP name_term                                          { apply_dec_atom (Atom.mk_opp ra) $2 }
   | DIST args                                              { let da, la = list_dec $2 in
     	 						     let a = Array.of_list la in
-							     da, Atom (Atom.mk_distinct ra (Atom.type_of a.(0)) ~declare:da a) }
-  | VAR                                                    {let x = $1 in match find_opt_qvar x with
-    							     | Some bt -> false, Atom (Atom.get ~declare:false ra (Aapp (dummy_indexed_op (Rel_name x) [||] bt, [||])))
-							     | None -> true, Atom (Atom.get ra (Aapp (get_fun $1, [||])))}
+                                                             da, Atom (Atom.mk_distinct ra ~declare:da (Atom.type_of a.(0)) a) }
+  | BITOF INT name_term                                    { apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bitof ra ~declare:d s $2 h | _ -> assert false) $3 }
+  | BVNOT name_term                                        { apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bvnot ra ~declare:d s h | _ -> assert false) $2 }
+  | BVAND name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvand ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVOR name_term name_term                               { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvor ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVXOR name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvxor ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVNEG name_term                                        { apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bvneg ra ~declare:d s h | _ -> assert false) $2 }
+  | BVADD name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvadd ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVMUL name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvmult ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVULT name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvult ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVSLT name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvslt ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVULE name_term name_term                              { let (decl,_) as a = apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvult ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 in (decl, Lit (Form.neg (lit_of_atom_form_lit rf a))) }
+  | BVSLE name_term name_term                              { let (decl,_) as a = apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvslt ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 in (decl, Lit (Form.neg (lit_of_atom_form_lit rf a))) }
+  | BVSHL name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvshl ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVSHR name_term name_term                              { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TBV s -> Atom.mk_bvshr ra ~declare:d s h1 h2 | _ -> assert false) $2 $3 }
+  | BVCONC name_term name_term                             { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1, Atom.type_of h2 with TBV s1, TBV s2 -> Atom.mk_bvconcat ra ~declare:d s1 s2 h1 h2 | _, _ -> assert false) $2 $3 }
+  | BVEXTR INT INT name_term                               { let j, i = $2, $3 in apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bvextr ra ~declare:d ~s ~i ~n:(j-i+1) h | _ -> assert false) $4 }
+  | BVZEXT INT name_term                                   { let n = $2 in apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bvzextn ra ~declare:d ~s ~n h | _ -> assert false) $3 }
+  | BVSEXT INT name_term                                   { let n = $2 in apply_dec_atom (fun ?declare:(d=true) h -> match Atom.type_of h with TBV s -> Atom.mk_bvsextn ra ~declare:d ~s ~n h | _ -> assert false) $3 }
+  | SELECT name_term name_term                             { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TFArray (ti, te) -> Atom.mk_select ra ~declare:d ti te h1 h2 | _ -> assert false) $2 $3 }
+  | DIFF name_term name_term                               { apply_bdec_atom (fun ?declare:(d=true) h1 h2 -> match Atom.type_of h1 with TFArray (ti, te) -> Atom.mk_diffarray ra ~declare:d ti te h1 h2 | _ -> assert false) $2 $3 }
+  | STORE name_term name_term name_term                    { apply_tdec_atom (fun ?declare:(d=true) h1 h2 h3 -> match Atom.type_of h1 with TFArray (ti, te) -> Atom.mk_store ra ~declare:d ti te h1 h2 h3 | _ -> assert false) $2 $3 $4 }
+  | VAR                                                    { let x = $1 in match find_opt_qvar x with
+    							                     | Some bt -> false, Atom (Atom.get ~declare:false ra (Aapp (dummy_indexed_op (Rel_name x) [||] bt, [||])))
+                                                                             | None -> true, Atom (Atom.get ra (Aapp (get_fun $1, [||]))) }
   | VAR args                                               { let f = $1 in let a = $2 in match find_opt_qvar f with
-    							     | Some bt -> let op = dummy_indexed_op (Rel_name f) [||] bt in
-							       	       	  false, Atom (Atom.get ~declare:false ra (Aapp (op, Array.of_list (snd (list_dec a)))))
-      							     | None -> let dl, l = list_dec $2 in
-							       	       dl, Atom (Atom.get ra ~declare:dl (Aapp (get_fun f, Array.of_list l))) }
-
+    							                                   | Some bt -> let op = dummy_indexed_op (Rel_name f) [||] bt in
+							       	       	                                false, Atom (Atom.get ~declare:false ra (Aapp (op, Array.of_list (snd (list_dec a)))))
+      							                                   | None -> let dl, l = list_dec $2 in
+                                                                                                     dl, Atom (Atom.get ra ~declare:dl (Aapp (get_fun f, Array.of_list l))) }
 
   /* Both */
-  | EQ name_term name_term                                 { let t1 = $2 in let t2 = $3 in match t1,t2 with | (decl1, Atom h1), (decl2, Atom h2) when (match Atom.type_of h1 with | SmtBtype.Tbool -> false | _ -> true) -> let decl = decl1 && decl2 in decl, Atom (Atom.mk_eq ra decl (Atom.type_of h1) h1 h2) | (decl1, t1), (decl2, t2) -> decl1 && decl2, Form (Fapp (Fiff, [|lit_of_atom_form_lit rf (decl1, t1); lit_of_atom_form_lit rf (decl2, t2)|])) }
+  | EQ name_term name_term                                 { let t1 = $2 in let t2 = $3 in match t1,t2 with | (decl1, Atom h1), (decl2, Atom h2) when (match Atom.type_of h1 with | SmtBtype.Tbool -> false | _ -> true) -> let decl = decl1 && decl2 in decl, Atom (Atom.mk_eq ra ~declare:decl (Atom.type_of h1) h1 h2) | (decl1, t1), (decl2, t2) -> decl1 && decl2, Form (Fapp (Fiff, [|lit_of_atom_form_lit rf (decl1, t1); lit_of_atom_form_lit rf (decl2, t2)|])) }
   | EQ nlit lit                                            { match $2, $3 with (decl1, t1), (decl2, t2) -> decl1 && decl2, Form (Fapp (Fiff, [|t1; t2|])) }
   | EQ name_term nlit                                      { match $2, $3 with (decl1, t1), (decl2, t2) -> decl1 && decl2, Form (Fapp (Fiff, [|lit_of_atom_form_lit rf (decl1, t1); t2|])) }
   | LET LPAR bindlist RPAR name_term                       { $3; $5 }
   | BINDVAR                                                { true, Hashtbl.find hlets $1 }
 ;
 
-blit:   
-  | name_term                                              { $1 } 
+blit:
+  | name_term                                              { $1 }
   | LPAR NOT lit RPAR                                      { apply_dec (fun l -> Lit (Form.neg l)) $3 }
 ;
 
diff --git a/src/verit/veritSyntax.ml b/src/verit/veritSyntax.ml
index a45fb63..c4427b7 100644
--- a/src/verit/veritSyntax.ml
+++ b/src/verit/veritSyntax.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -24,7 +20,8 @@ open SmtTrace
 
 exception Sat
 
-type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp | Hole
+type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | Weak | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp | Flat | Hole | Bbva | Bbconst | Bbeq | Bbdis | Bbop | Bbadd | Bbmul | Bbult | Bbslt | Bbnot | Bbneg | Bbconc | Bbextr | Bbzext | Bbsext | Bbshl | Bbshr | Row1 | Row2 | Exte
+
 
 
 (* About equality *)
@@ -194,6 +191,23 @@ let mkDistinctElim old value =
   Other (SplDistinctElim (old,find_res l1 value))
 
 
+(* Clause difference (wrt to their sets of literals) *)
+
+let clause_diff c1 c2 =
+  let r =
+    List.filter (fun t1 -> not (List.exists (SmtAtom.Form.equal t1) c2)) c1
+  in
+  Format.eprintf "[";
+  List.iter (Format.eprintf " %a ,\n" SmtAtom.(Form.to_smt Atom.to_smt)) c1;
+  Format.eprintf "] -- [";
+  List.iter (Format.eprintf " %a ,\n" SmtAtom.(Form.to_smt Atom.to_smt)) c2;
+  Format.eprintf "] ==\n [";
+  List.iter (Format.eprintf " %a ,\n" SmtAtom.(Form.to_smt Atom.to_smt)) r;
+  Format.eprintf "] @.";
+  r
+
+
+
 (* Generating clauses *)
 
 let clauses : (int,Form.t clause) Hashtbl.t = Hashtbl.create 17
@@ -211,7 +225,7 @@ let add_ref i j = Hashtbl.add ref_cl i j
 let clear_ref () = Hashtbl.clear ref_cl
 
 (* Recognizing and modifying clauses depending on a forall_inst clause. *)
-                                 
+
 let rec fins_lemma ids_params =
   match ids_params with
     [] -> raise Not_found
@@ -222,9 +236,9 @@ let rec fins_lemma ids_params =
 
 let rec find_remove_lemma lemma ids_params =
   let eq_lemma h = eq_clause lemma (get_clause h) in
-  list_find_remove eq_lemma ids_params 
+  list_find_remove eq_lemma ids_params
 
-(* Removes the lemma in a list of ids containing an instance of this lemma *)                   
+(* Removes the lemma in a list of ids containing an instance of this lemma *)
 let rec merge ids_params =
   let rest_opt = try let lemma = fins_lemma ids_params in
                      let _, rest = find_remove_lemma lemma ids_params in
@@ -235,136 +249,237 @@ let rec merge ids_params =
   | Some r -> merge r
 
 let to_add = ref []
-                     
+
 let rec mk_clause (id,typ,value,ids_params) =
   let kind =
     match typ with
-    | Tpbr ->
-       begin match ids_params with
-       | [id] ->
-          Same (get_clause id)
-       | _ -> failwith "unexpected form of tmp_betared" end
-    | Tpqt ->
-       begin match ids_params with
-       | [id] ->
-          Same (get_clause id)
-       | _ -> failwith "unexpected form of tmp_qnt_tidy" end
-    | Fins ->
-       begin match value, ids_params with
-        | [inst], [ref_th] ->
-           let cl_th = get_clause ref_th in
-           Other (Forall_inst (repr cl_th, inst))
-        | _ -> failwith "unexpected form of forall_inst" end
-    | Or ->
-       (match ids_params with
-        | [id_target] ->
-           let cl_target = get_clause id_target in
-           begin match cl_target.kind with
-           | Other (Forall_inst _) -> Same cl_target
-           | _ -> Other (ImmBuildDef cl_target) end
-        | _ -> assert false)
-    (* Resolution *)
-    | Reso ->
-       let ids_params = merge ids_params in
-       (match ids_params with
-        | cl1::cl2::q ->
-           let res = {rc1 = get_clause cl1; rc2 = get_clause cl2; rtail = List.map get_clause q} in
-           Res res
-        | [fins_id] -> Same (get_clause fins_id)
-        | [] -> assert false)
-
-    (* Roots *)
-    | Inpu -> Root
-    (* Cnf conversion *)
-    | True -> Other SmtCertif.True
-    | Fals -> Other False
-    | Andn | Orp | Impp | Xorp1 | Xorn1 | Equp1 | Equn1 | Itep1 | Iten1 ->
-       (match value with
-        | l::_ -> Other (BuildDef l)
-        | _ -> assert false)
-    | Xorp2 | Xorn2 | Equp2 | Equn2 | Itep2 | Iten2 ->
-       (match value with
-        | l::_ -> Other (BuildDef2 l)
-        | _ -> assert false)
-    | Orn | Andp ->
-       (match value,ids_params with
-        | l::_, [p] -> Other (BuildProj (l,p))
-        | _ -> assert false)
-    | Impn1 ->
-       (match value with
-        | l::_ -> Other (BuildProj (l,0))
-        | _ -> assert false)
-    | Impn2 ->
-       (match value with
-        | l::_ -> Other (BuildProj (l,1))
-        | _ -> assert false)
-    | Nand | Imp | Xor1 | Nxor1 | Equ2 | Nequ2 | Ite1 | Nite1 ->
-       (match ids_params with
-        | [id] -> Other (ImmBuildDef (get_clause id))
-        | _ -> assert false)
-    | Xor2 | Nxor2 | Equ1 | Nequ1 | Ite2 | Nite2 ->
-       (match ids_params with
-        | [id] -> Other (ImmBuildDef2 (get_clause id))
-        | _ -> assert false)
-    | And | Nor ->
-       (match ids_params with
-        | [id;p] -> Other (ImmBuildProj (get_clause id,p))
-        | _ -> assert false)
-    | Nimp1 ->
-       (match ids_params with
-        | [id] -> Other (ImmBuildProj (get_clause id,0))
-        | _ -> assert false)
-    | Nimp2 ->
-       (match ids_params with
-        | [id] -> Other (ImmBuildProj (get_clause id,1))
-        | _ -> assert false)
-    (* Equality *)
-    | Eqre -> mkTrans value
-    | Eqtr -> mkTrans value
-    | Eqco -> mkCongr value
-    | Eqcp -> mkCongrPred value
-    (* Linear integer arithmetic *)
-    | Dlge | Lage | Lata -> mkMicromega value
-    | Lade               -> mkMicromega value (* TODO: utiliser un solveur plus simple *)
-    | Dlde ->
-       (match value with
-        | l::_ -> Other (LiaDiseq l)
-        | _ -> assert false)
-    (* Simplifications *)
-    | Tpal ->
-       (match ids_params with
-        | id::_ -> Same (get_clause id)
-        | _ -> assert false)
-    | Tple ->
-       (match ids_params with
-        | id::_ -> Same (get_clause id)
-        | _ -> assert false)
-    | Tpde ->
-       (match ids_params with
-        | id::_ -> mkDistinctElim (get_clause id) value
-        | _ -> assert false)
-    | Tpsa | Tlap ->
-       (match ids_params with
-        | id::_ -> mkSplArith (get_clause id) value
-        | _ -> assert false)
-    (* Holes in proofs *)
-    | Hole -> Other (SmtCertif.Hole (List.map get_clause ids_params, value))
-    (* Not implemented *)
-    | Deep -> failwith "VeritSyntax.ml: rule deep_res not implemented yet"
-    | Eins -> failwith "VeritSyntax.ml: rule exists_inst not implemented yet"
-    | Skea -> failwith "VeritSyntax.ml: rule skolem_ex_ax not implemented yet"
-    | Skaa -> failwith "VeritSyntax.ml: rule skolem_all_ax not implemented yet"
-    | Qnts -> failwith "VeritSyntax.ml: rule qnt_simplify_ax not implemented yet"
-    | Qntm -> failwith "VeritSyntax.ml: rule qnt_merge_ax not implemented yet"
-    | Tpne -> failwith "VeritSyntax.ml: rule tmp_nary_elim not implemented yet"
-    | Tpie -> failwith "VeritSyntax.ml: rule tmp_ite_elim not implemented yet"
-    | Tpma -> failwith "VeritSyntax.ml: rule tmp_macrosubst not implemented yet"
-    | Tpbe -> failwith "VeritSyntax.ml: rule tmp_bfun_elim not implemented yet"
-    | Tpsc -> failwith "VeritSyntax.ml: rule tmp_sk_connector not implemented yet"
-    | Tppp -> failwith "VeritSyntax.ml: rule tmp_pm_process not implemented yet"
-    | Tpqs -> failwith "VeritSyntax.ml: rule tmp_qnt_simplify not implemented yet"
-    | Tpsk -> failwith "VeritSyntax.ml: rule tmp_skolemize not implemented yet"
-    | Subp -> failwith "VeritSyntax.ml: rule subproof not implemented yet"
+      (* Roots *)
+      | Inpu -> Root
+      (* Cnf conversion *)
+      | True -> Other SmtCertif.True
+      | Fals -> Other False
+      | Andn | Orp | Impp | Xorp1 | Xorn1 | Equp1 | Equn1 | Itep1 | Iten1 ->
+        (match value with
+          | l::_ -> Other (BuildDef l)
+          | _ -> assert false)
+      | Xorp2 | Xorn2 | Equp2 | Equn2 | Itep2 | Iten2 ->
+        (match value with
+          | l::_ -> Other (BuildDef2 l)
+          | _ -> assert false)
+      | Orn | Andp ->
+        (match value,ids_params with
+          | l::_, [p] -> Other (BuildProj (l,p))
+          | _ -> assert false)
+      | Impn1 ->
+        (match value with
+          | l::_ -> Other (BuildProj (l,0))
+          | _ -> assert false)
+      | Impn2 ->
+        (match value with
+          | l::_ -> Other (BuildProj (l,1))
+          | _ -> assert false)
+      | Nand | Imp | Xor1 | Nxor1 | Equ2 | Nequ2 | Ite1 | Nite1 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildDef (get_clause id))
+          | _ -> assert false)
+      | Or ->
+         (match ids_params with
+            | [id_target] ->
+               let cl_target = get_clause id_target in
+               begin match cl_target.kind with
+                 | Other (Forall_inst _) -> Same cl_target
+                 | _ -> Other (ImmBuildDef cl_target) end
+            | _ -> assert false)
+      | Xor2 | Nxor2 | Equ1 | Nequ1 | Ite2 | Nite2 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildDef2 (get_clause id))
+          | _ -> assert false)
+      | And | Nor ->
+        (match ids_params with
+          | [id;p] -> Other (ImmBuildProj (get_clause id,p))
+          | _ -> assert false)
+      | Nimp1 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildProj (get_clause id,0))
+          | _ -> assert false)
+      | Nimp2 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildProj (get_clause id,1))
+          | _ -> assert false)
+      (* Equality *)
+      | Eqre -> mkTrans value
+      | Eqtr -> mkTrans value
+      | Eqco -> mkCongr value
+      | Eqcp -> mkCongrPred value
+      (* Linear integer arithmetic *)
+      | Dlge | Lage | Lata -> mkMicromega value
+      | Lade               -> mkMicromega value (* TODO: utiliser un solveur plus simple *)
+      | Dlde ->
+        (match value with
+          | l::_ -> Other (LiaDiseq l)
+          | _ -> assert false)
+      (* Resolution *)
+      | Reso ->
+         let ids_params = merge ids_params in
+         (match ids_params with
+            | cl1::cl2::q ->
+               let res = {rc1 = get_clause cl1; rc2 = get_clause cl2; rtail = List.map get_clause q} in
+               Res res
+            | [fins_id] -> Same (get_clause fins_id)
+            | [] -> assert false)
+      (* Clause weakening *)
+      | Weak ->
+        (match ids_params with
+         | [id] -> (* Other (Weaken (get_clause id, value)) *)
+           let cid = get_clause id in
+           (match cid.value with
+           | None -> Other (Weaken (cid, value))
+           | Some c -> Other (Weaken (cid, value))
+            (* need to add c, otherwise dosen't terminate or returns false,
+               we would like instead: clause_diff value c *)
+           )
+          | _ -> assert false)
+      (* Simplifications *)
+      | Tpal ->
+        (match ids_params with
+          | id::_ -> Same (get_clause id)
+          | _ -> assert false)
+      | Tple ->
+        (match ids_params with
+          | id::_ -> Same (get_clause id)
+          | _ -> assert false)
+      | Tpde ->
+        (match ids_params with
+          | id::_ -> mkDistinctElim (get_clause id) value
+          | _ -> assert false)
+      | Tpsa | Tlap ->
+        (match ids_params with
+          | id::_ -> mkSplArith (get_clause id) value
+          | _ -> assert false)
+      | Flat ->
+        (match ids_params, value with
+         | id::_, f :: _ -> Other (ImmFlatten(get_clause id, f))
+         | _ -> assert false)
+      (* Bit blasting *)
+      | Bbva ->
+         (match value with
+           | [f] -> Other (BBVar f)
+           | _ -> assert false)
+      | Bbconst ->
+         (match value with
+           | [f] -> Other (BBConst f)
+           | _ -> assert false)
+      | Bbeq ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBEq (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbdis ->
+         (match value with
+           | [f] -> Other (BBDiseq f)
+           | __ -> assert false)
+      | Bbop ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBOp (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbadd ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBAdd (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbmul ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBMul (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbult ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBUlt (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbslt ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBSlt (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbconc ->
+         (match ids_params, value with
+           | [id1;id2], [f] ->
+             Other (BBConc (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbextr ->
+         (match ids_params, value with
+           | [id], [f] -> Other (BBExtr (get_clause id, f))
+           | _, _ -> assert false)
+      | Bbzext ->
+         (match ids_params, value with
+           | [id], [f] -> Other (BBZextn (get_clause id, f))
+           | _, _ -> assert false)
+      | Bbsext ->
+         (match ids_params, value with
+           | [id], [f] -> Other (BBSextn (get_clause id, f))
+           | _, _ -> assert false)
+      | Bbshl ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBShl (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbshr ->
+         (match ids_params, value with
+           | [id1;id2], [f] -> Other (BBShr (get_clause id1, get_clause id2, f))
+           | _, _ -> assert false)
+      | Bbnot ->
+         (match ids_params, value with
+           | [id], [f] -> Other (BBNot (get_clause id, f))
+           | _, _ -> assert false)
+      | Bbneg ->
+         (match ids_params, value with
+           | [id], [f] -> Other (BBNeg (get_clause id, f))
+           | _, _ -> assert false)
+
+      | Row1 ->
+         (match value with
+           | [f] -> Other (RowEq f)
+           | _ -> assert false)
+
+      | Exte ->
+         (match value with
+           | [f] -> Other (Ext f)
+           | _ -> assert false)
+
+      | Row2 -> Other (RowNeq value)
+
+      (* Holes in proofs *)
+      | Hole -> Other (SmtCertif.Hole (List.map get_clause ids_params, value))
+
+      (* Quantifier instanciation *)
+      | Fins ->
+         begin match value, ids_params with
+           | [inst], [ref_th] ->
+              let cl_th = get_clause ref_th in
+              Other (Forall_inst (repr cl_th, inst))
+           | _ -> failwith "unexpected form of forall_inst" end
+      | Tpbr ->
+         begin match ids_params with
+           | [id] ->
+              Same (get_clause id)
+           | _ -> failwith "unexpected form of tmp_betared" end
+      | Tpqt ->
+         begin match ids_params with
+           | [id] ->
+              Same (get_clause id)
+           | _ -> failwith "unexpected form of tmp_qnt_tidy" end
+
+      (* Not implemented *)
+      | Deep -> failwith "VeritSyntax.ml: rule deep_res not implemented yet"
+      | Eins -> failwith "VeritSyntax.ml: rule exists_inst not implemented yet"
+      | Skea -> failwith "VeritSyntax.ml: rule skolem_ex_ax not implemented yet"
+      | Skaa -> failwith "VeritSyntax.ml: rule skolem_all_ax not implemented yet"
+      | Qnts -> failwith "VeritSyntax.ml: rule qnt_simplify_ax not implemented yet"
+      | Qntm -> failwith "VeritSyntax.ml: rule qnt_merge_ax not implemented yet"
+      | Tpne -> failwith "VeritSyntax.ml: rule tmp_nary_elim not implemented yet"
+      | Tpie -> failwith "VeritSyntax.ml: rule tmp_ite_elim not implemented yet"
+      | Tpma -> failwith "VeritSyntax.ml: rule tmp_macrosubst not implemented yet"
+      | Tpbe -> failwith "VeritSyntax.ml: rule tmp_bfun_elim not implemented yet"
+      | Tpsc -> failwith "VeritSyntax.ml: rule tmp_sk_connector not implemented yet"
+      | Tppp -> failwith "VeritSyntax.ml: rule tmp_pm_process not implemented yet"
+      | Tpqs -> failwith "VeritSyntax.ml: rule tmp_qnt_simplify not implemented yet"
+      | Tpsk -> failwith "VeritSyntax.ml: rule tmp_skolemize not implemented yet"
+      | Subp -> failwith "VeritSyntax.ml: rule subproof not implemented yet"
   in
   let cl =
     (* TODO: change this into flatten when necessary *)
@@ -375,6 +490,12 @@ let rec mk_clause (id,typ,value,ids_params) =
   id
 
 
+let mk_clause cl =
+  try mk_clause cl
+  with Failure f ->
+    Structures.error ("SMTCoq was not able to check the certificate \
+                       for the following reason.\n"^f)
+
 type atom_form_lit =
   | Atom of SmtAtom.Atom.t
   | Form of SmtAtom.Form.pform
@@ -396,16 +517,23 @@ let rec list_dec = function
   | (decl_h, h) :: t ->
      let decl_t, l_t = list_dec t in
      decl_h && decl_t, h :: l_t
-    
-let apply_dec_atom f = function
-  | decl, Atom h -> decl, Atom (f decl h)
+
+let apply_dec_atom (f:?declare:bool -> SmtAtom.hatom -> SmtAtom.hatom) = function
+  | decl, Atom h -> decl, Atom (f ~declare:decl h)
   | _ -> assert false
 
-let apply_bdec_atom f o1 o2 =
+let apply_bdec_atom (f:?declare:bool -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t) o1 o2 =
   match o1, o2 with
   | (decl1, Atom h1), (decl2, Atom h2) ->
      let decl = decl1 && decl2 in
-     decl, Atom (f decl h1 h2)
+     decl, Atom (f ~declare:decl h1 h2)
+  | _ -> assert false
+
+let apply_tdec_atom (f:?declare:bool -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t) o1 o2 o3 =
+  match o1, o2, o3 with
+  | (decl1, Atom h1), (decl2, Atom h2), (decl3, Atom h3) ->
+     let decl = decl1 && decl2 && decl3 in
+     decl, Atom (f ~declare:decl h1 h2 h3)
   | _ -> assert false
 
 
@@ -428,6 +556,7 @@ let get_fun id =
   try Hashtbl.find funs id
   with | Not_found -> failwith ("VeritSyntax.get_fun : function symbol \""^id^"\" not found\n")
 let add_fun id cl = Hashtbl.add funs id cl
+let remove_fun id = Hashtbl.remove funs id
 let clear_funs () = Hashtbl.clear funs
 
 let qvar_tbl : (string, SmtBtype.btype) Hashtbl.t = Hashtbl.create 10
@@ -436,9 +565,9 @@ let find_opt_qvar s = try Some (Hashtbl.find qvar_tbl s)
 let add_qvar s bt = Hashtbl.add qvar_tbl s bt
 let clear_qvar () = Hashtbl.clear qvar_tbl
 
-let string_hform = Form.to_string ~pi:true (Atom.to_string ~pi:true )
+let hform_to_smt = Form.to_smt ~pi:true Atom.to_smt
 
-(* Finding the index of a root in <lsmt> modulo the <re_hash> function. 
+(* Finding the index of a root in <lsmt> modulo the <re_hash> function.
    This function is used by SmtTrace.order_roots *)
 let init_index lsmt re_hash =
   let form_index_init_rank : (int, int) Hashtbl.t = Hashtbl.create 20 in
@@ -453,9 +582,9 @@ let init_index lsmt re_hash =
             try find (Form.to_lit re_hf)
             with Not_found ->
               let oc = open_out "/tmp/input_not_found.log" in
-              (List.map string_hform lsmt)
-              |> List.iter (Printf.fprintf oc "%s\n");
-              Printf.fprintf oc "\n%s\n" (string_hform re_hf);
+              let fmt = Format.formatter_of_out_channel oc in
+              List.iter (fun h -> Format.fprintf fmt "%a\n" hform_to_smt h) lsmt;
+              Format.fprintf fmt "\n%a\n" hform_to_smt re_hf;
               flush oc; close_out oc;
               failwith "not found: log available"
 
@@ -469,7 +598,7 @@ let qf_to_add lr =
        (Other (Qf_lemma (r, l)), r.value, r) :: qf_lemmas t
     | _::t -> qf_lemmas t in
   qf_lemmas lr
-                       
+
 let ra = Atom.create ()
 let rf = Form.create ()
 let ra' = Atom.create ()
@@ -477,7 +606,7 @@ let rf' = Form.create ()
 
 let hlets : (string, atom_form_lit) Hashtbl.t = Hashtbl.create 17
 
-let clear_mk_clause () = 
+let clear_mk_clause () =
   to_add := [];
   clear_ref ()
 
diff --git a/src/verit/veritSyntax.mli b/src/verit/veritSyntax.mli
index 27a7ee3..fd39052 100644
--- a/src/verit/veritSyntax.mli
+++ b/src/verit/veritSyntax.mli
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -16,7 +12,7 @@
 
 exception Sat
 
-type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp | Hole
+type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | Weak | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp | Flat | Hole | Bbva | Bbconst | Bbeq | Bbdis | Bbop | Bbadd | Bbmul | Bbult | Bbslt | Bbnot | Bbneg | Bbconc | Bbextr | Bbzext | Bbsext | Bbshl | Bbshr | Row1 | Row2 | Exte
 
 val get_clause : int -> SmtAtom.Form.t SmtCertif.clause
 val add_clause : int -> SmtAtom.Form.t SmtCertif.clause -> unit
@@ -33,11 +29,14 @@ type atom_form_lit =
   | Lit of SmtAtom.Form.t
 val lit_of_atom_form_lit : SmtAtom.Form.reify -> bool * atom_form_lit -> SmtAtom.Form.t
 
-val apply_dec_atom : (bool -> SmtAtom.hatom -> SmtAtom.hatom) ->
+val apply_dec_atom : (?declare:bool -> SmtAtom.hatom -> SmtAtom.hatom) ->
                      bool * atom_form_lit -> bool * atom_form_lit
 val apply_bdec_atom :
-  (bool -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t) ->
+  (?declare:bool -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t) ->
   bool * atom_form_lit -> bool * atom_form_lit -> bool * atom_form_lit
+val apply_tdec_atom :
+  (?declare:bool -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t -> SmtAtom.Atom.t) ->
+  bool * atom_form_lit -> bool * atom_form_lit -> bool * atom_form_lit -> bool * atom_form_lit
 
 val apply_dec : ('a -> 'b) -> bool * 'a -> bool * 'b
 val list_dec : (bool * 'a) list -> bool * 'a list
@@ -51,12 +50,13 @@ val add_btype : string -> SmtBtype.btype -> unit
 
 val get_fun : string -> SmtAtom.indexed_op
 val add_fun : string -> SmtAtom.indexed_op -> unit
+val remove_fun : string -> unit
 
 val find_opt_qvar : string -> SmtBtype.btype option 
 val add_qvar : string -> SmtBtype.btype -> unit
 val clear_qvar : unit -> unit
 
-val string_hform : SmtAtom.Form.t -> string
+val hform_to_smt : Format.formatter -> SmtAtom.Form.t -> unit
 
 val init_index : SmtAtom.Form.t list -> (SmtAtom.Form.t -> SmtAtom.Form.t) ->
                  SmtAtom.Form.t -> int
diff --git a/src/versions/native/Make b/src/versions/native/Make
index 69cbbfb..63c95b2 100644
--- a/src/versions/native/Make
+++ b/src/versions/native/Make
@@ -17,14 +17,18 @@
 ##    change CMXSFILES into CMXS and add the same block for CMXA and VCMXS. ##
 ## 4) Change the "install" target: change CMOFILES into CMXFILES.     ##
 ## 5) Add to the "clean" target:                                      ##
-##    - rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml ##
+##    - rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.mli smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscLexer.ml lfsc/lfscParser.ml lfsc/lfscParser.mli trace/smtcoq.a ##
 ########################################################################
 
 
 -R . SMTCoq
 
+-I bva
+-I classes
+-I array
 -I cnf
 -I euf
+-I lfsc
 -I lia
 -I smtlib2
 -I trace
@@ -32,15 +36,17 @@
 -I zchaff
 -I versions/native
 
+
 -custom "cd ../unit-tests; make" "" "test"
 -custom "cd ../unit-tests; make zchaff" "" "ztest"
 -custom "cd ../unit-tests; make verit" "" "vtest"
+-custom "cd ../unit-tests; make lfsc" "" "lfsctest"
 
 -custom "$(CAMLLEX) $<" "%.mll" "%.ml"
 -custom "$(CAMLYACC) $<" "%.mly" "%.ml %.mli"
--custom "" "verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml" "ml"
+-custom "" "verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscParser.ml lfsc/lfscLexer.ml" "ml"
 
--custom "$(CAMLOPTLINK) $(ZFLAGS) -a -o $@ $^" "versions/native/structures.cmx trace/smtMisc.cmx trace/coqTerms.cmx trace/smtBtype.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx smtlib2/smtlib2_util.cmx smtlib2/smtlib2_ast.cmx smtlib2/smtlib2_parse.cmx smtlib2/smtlib2_lex.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx smtlib2/smtlib2_genConstr.cmx trace/smtCommands.cmx verit/verit.cmx smtcoq_plugin.cmx" "$(CMXA)"
+-custom "$(CAMLOPTLINK) $(ZFLAGS) -a -o $@ $^" "versions/native/structures.cmx trace/smtMisc.cmx trace/coqTerms.cmx trace/smtBtype.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx smtlib2/smtlib2_util.cmx smtlib2/smtlib2_ast.cmx smtlib2/smtlib2_parse.cmx smtlib2/smtlib2_lex.cmx smtlib2/sExpr.cmx smtlib2/sExprParser.cmx smtlib2/sExprLexer.cmx smtlib2/smtlib2_solver.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx lfsc/shashcons.cmx lfsc/hstring.cmx lfsc/type.cmx lfsc/ast.cmx lfsc/builtin.cmx lfsc/tosmtcoq.cmx lfsc/converter.cmx lfsc/lfscParser.cmx lfsc/lfscLexer.cmx smtlib2/smtlib2_genConstr.cmx trace/smtCommands.cmx verit/verit.cmx lfsc/lfsc.cmx smtcoq_plugin.cmx" "$(CMXA)"
 -custom "$(CAMLOPTLINK) $(ZFLAGS) -o $@ -linkall -shared $^" "$(CMXA)" "$(CMXS)"
 
 CMXA = smtcoq.cmxa
@@ -49,6 +55,15 @@ VCMXS = "versions/native/NSMTCoq_versions_native_Structures.cmxs NSMTCoq_State.c
 CAMLLEX = $(CAMLBIN)ocamllex
 CAMLYACC = $(CAMLBIN)ocamlyacc
 
+bva/BVList.v
+bva/Bva_checker.v
+
+classes/SMT_classes.v
+classes/SMT_classes_instances.v
+
+array/FArray.v
+array/Array_checker.v
+
 versions/native/Structures.v
 versions/native/structures.ml
 versions/native/structures.mli
@@ -84,6 +99,13 @@ smtlib2/smtlib2_genConstr.ml
 smtlib2/smtlib2_genConstr.mli
 smtlib2/smtlib2_util.ml
 smtlib2/smtlib2_util.mli
+smtlib2/sExprParser.ml
+smtlib2/sExprParser.mli
+smtlib2/sExprLexer.ml
+smtlib2/sExpr.ml
+smtlib2/sExpr.mli
+smtlib2/smtlib2_solver.ml
+smtlib2/smtlib2_solver.mli
 
 verit/veritParser.ml
 verit/veritParser.mli
@@ -94,6 +116,22 @@ verit/verit.mli
 verit/veritSyntax.ml
 verit/veritSyntax.mli
 
+lfsc/shashcons.mli
+lfsc/shashcons.ml
+lfsc/hstring.mli
+lfsc/hstring.ml
+lfsc/lfscParser.ml
+lfsc/lfscLexer.ml
+lfsc/type.ml
+lfsc/ast.ml
+lfsc/ast.mli
+lfsc/translator_sig.mli
+lfsc/builtin.ml
+lfsc/tosmtcoq.ml
+lfsc/tosmtcoq.mli
+lfsc/converter.ml
+lfsc/lfsc.ml
+
 zchaff/cnfParser.ml
 zchaff/cnfParser.mli
 zchaff/satParser.ml
@@ -119,6 +157,10 @@ spl/Operators.v
 Conversion_tactics.v
 Misc.v
 SMTCoq.v
+ReflectFacts.v
+PropToBool.v
+BoolToProp.v
+Tactics.v
 SMT_terms.v
 State.v
 Trace.v
diff --git a/src/versions/native/Makefile b/src/versions/native/Makefile
index 61c8c01..afc5523 100644
--- a/src/versions/native/Makefile
+++ b/src/versions/native/Makefile
@@ -45,16 +45,24 @@ OCAMLLIBS?=-I versions/native\
   -I trace\
   -I smtlib2\
   -I lia\
+  -I lfsc\
   -I euf\
-  -I cnf
+  -I cnf\
+  -I array\
+  -I classes\
+  -I bva
 COQLIBS?=-I versions/native\
   -I zchaff\
   -I verit\
   -I trace\
   -I smtlib2\
   -I lia\
+  -I lfsc\
   -I euf\
-  -I cnf -R . SMTCoq
+  -I cnf\
+  -I array\
+  -I classes\
+  -I bva -R . SMTCoq
 COQDOCLIBS?=-R . SMTCoq
 
 ##########################
@@ -137,6 +145,10 @@ endif
 VFILES:=Trace.v\
   State.v\
   SMT_terms.v\
+  Tactics.v\
+  BoolToProp.v\
+  PropToBool.v\
+  ReflectFacts.v\
   SMTCoq.v\
   Misc.v\
   Conversion_tactics.v\
@@ -147,7 +159,13 @@ VFILES:=Trace.v\
   lia/Lia.v\
   euf/Euf.v\
   cnf/Cnf.v\
-  versions/native/Structures.v
+  versions/native/Structures.v\
+  array/Array_checker.v\
+  array/FArray.v\
+  classes/SMT_classes_instances.v\
+  classes/SMT_classes.v\
+  bva/Bva_checker.v\
+  bva/BVList.v
 
 -include $(addsuffix .d,$(VFILES))
 .SECONDARY: $(addsuffix .d,$(VFILES))
@@ -170,10 +188,24 @@ MLFILES:=lia/lia.ml\
   zchaff/zchaff.ml\
   zchaff/satParser.ml\
   zchaff/cnfParser.ml\
+  lfsc/lfsc.ml\
+  lfsc/converter.ml\
+  lfsc/tosmtcoq.ml\
+  lfsc/builtin.ml\
+  lfsc/ast.ml\
+  lfsc/type.ml\
+  lfsc/lfscLexer.ml\
+  lfsc/lfscParser.ml\
+  lfsc/hstring.ml\
+  lfsc/shashcons.ml\
   verit/veritSyntax.ml\
   verit/verit.ml\
   verit/veritLexer.ml\
   verit/veritParser.ml\
+  smtlib2/smtlib2_solver.ml\
+  smtlib2/sExpr.ml\
+  smtlib2/sExprLexer.ml\
+  smtlib2/sExprParser.ml\
   smtlib2/smtlib2_util.ml\
   smtlib2/smtlib2_genConstr.ml\
   smtlib2/smtlib2_ast.ml\
@@ -199,10 +231,18 @@ MLIFILES:=lia/lia.mli\
   zchaff/zchaff.mli\
   zchaff/satParser.mli\
   zchaff/cnfParser.mli\
+  lfsc/tosmtcoq.mli\
+  lfsc/translator_sig.mli\
+  lfsc/ast.mli\
+  lfsc/hstring.mli\
+  lfsc/shashcons.mli\
   verit/veritSyntax.mli\
   verit/verit.mli\
   verit/veritLexer.mli\
   verit/veritParser.mli\
+  smtlib2/smtlib2_solver.mli\
+  smtlib2/sExpr.mli\
+  smtlib2/sExprParser.mli\
   smtlib2/smtlib2_util.mli\
   smtlib2/smtlib2_genConstr.mli\
   smtlib2/smtlib2_ast.mli\
@@ -287,10 +327,10 @@ beautify: $(VFILES:=.beautified)
 $(CMXS): $(CMXA)
 	$(CAMLOPTLINK) $(ZFLAGS) -o $@ -linkall -shared $^
 
-$(CMXA): versions/native/structures.cmx trace/smtMisc.cmx trace/coqTerms.cmx trace/smtBtype.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx smtlib2/smtlib2_util.cmx smtlib2/smtlib2_ast.cmx smtlib2/smtlib2_parse.cmx smtlib2/smtlib2_lex.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx smtlib2/smtlib2_genConstr.cmx trace/smtCommands.cmx verit/verit.cmx smtcoq_plugin.cmx
+$(CMXA): versions/native/structures.cmx trace/smtMisc.cmx trace/coqTerms.cmx trace/smtBtype.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx smtlib2/smtlib2_util.cmx smtlib2/smtlib2_ast.cmx smtlib2/smtlib2_parse.cmx smtlib2/smtlib2_lex.cmx smtlib2/sExpr.cmx smtlib2/sExprParser.cmx smtlib2/sExprLexer.cmx smtlib2/smtlib2_solver.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx lfsc/shashcons.cmx lfsc/hstring.cmx lfsc/type.cmx lfsc/ast.cmx lfsc/builtin.cmx lfsc/tosmtcoq.cmx lfsc/converter.cmx lfsc/lfscParser.cmx lfsc/lfscLexer.cmx smtlib2/smtlib2_genConstr.cmx trace/smtCommands.cmx verit/verit.cmx lfsc/lfsc.cmx smtcoq_plugin.cmx
 	$(CAMLOPTLINK) $(ZFLAGS) -a -o $@ $^
 
-ml: verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml
+ml: verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscParser.ml lfsc/lfscLexer.ml
 
 
 %.ml %.mli: %.mly
@@ -299,6 +339,9 @@ ml: verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/sm
 %.ml: %.mll
 	$(CAMLLEX) $<
 
+lfsctest: 
+	cd ../unit-tests; make lfsc
+
 vtest: 
 	cd ../unit-tests; make verit
 
@@ -374,10 +417,11 @@ clean:
 	- rm -rf $(CMXS)
 	- rm -rf $(CMXA)
 	- rm -rf ml
+	- rm -rf lfsctest
 	- rm -rf vtest
 	- rm -rf ztest
 	- rm -rf test
-	- rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml
+	- rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.mli smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscLexer.ml lfsc/lfscParser.ml lfsc/lfscParser.mli trace/smtcoq.a
 
 archclean:
 	rm -f *.cmx *.o
diff --git a/src/versions/native/Structures_native.v b/src/versions/native/Structures_native.v
index 950d7bd..856883b 100644
--- a/src/versions/native/Structures_native.v
+++ b/src/versions/native/Structures_native.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import PArray.
 
 
@@ -6,6 +18,9 @@ Section Trace.
   (* We use [array array step] to allow bigger trace *)
   Definition trace (step:Type) := array (array step).
 
+  Definition trace_to_list {step:Type} (t:trace step) : list step :=
+    PArray.fold_left (fun res a => List.app res (PArray.to_list a)) nil t.
+
   Definition trace_length {step:Type} (t:trace step) : int :=
     PArray.fold_left (fun l a => (l + (length a))%int63) 0%int63 t.
 
@@ -37,3 +52,8 @@ Section Trace.
   Admitted.
 
 End Trace.
+
+
+Definition nat_eqb := beq_nat.
+Definition nat_eqb_eq := beq_nat_true_iff.
+Definition nat_eqb_refl := NPeano.Nat.eqb_refl.
diff --git a/src/versions/native/smtcoq_plugin_native.ml4 b/src/versions/native/smtcoq_plugin_native.ml4
index f3c571c..d6954b5 100644
--- a/src/versions/native/smtcoq_plugin_native.ml4
+++ b/src/versions/native/smtcoq_plugin_native.ml4
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -47,15 +43,39 @@ VERNAC COMMAND EXTEND Vernac_verit
   [
     Verit.checker fsmt fproof
   ]
+| [ "Verit_Checker_Debug" string(fsmt) string(fproof) ] ->
+  [
+    Verit.checker_debug fsmt fproof
+  ]
 | [ "Verit_Theorem" ident(name) string(fsmt) string(fproof) ] ->
   [
     Verit.theorem name fsmt fproof
   ]
 END
 
+VERNAC COMMAND EXTEND Vernac_lfsc
+| [ "Parse_certif_lfsc"
+    ident(t_i) ident(t_func) ident(t_atom) ident(t_form) ident(root) ident(used_roots) ident(trace) string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.parse_certif t_i t_func t_atom t_form root used_roots trace fsmt fproof
+  ]
+| [ "Lfsc_Checker" string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.checker fsmt fproof
+  ]
+| [ "Lfsc_Checker_Debug" string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.checker_debug fsmt fproof
+  ]
+| [ "Lfsc_Theorem" ident(name) string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.theorem name fsmt fproof
+  ]
+END
 
 TACTIC EXTEND Tactic_zchaff
-| [ "zchaff" ] -> [ Zchaff.tactic () ]
+| [ "zchaff_bool" ] -> [ Zchaff.tactic () ]
+| [ "zchaff_bool_no_check" ] -> [ Zchaff.tactic_no_check () ]
 END
 
 let lemmas_list = ref []
@@ -67,5 +87,11 @@ END
 
 
 TACTIC EXTEND Tactic_verit
-| [ "verit_base" constr_list(lpl) ] -> [ Verit.tactic lpl !lemmas_list ]
+| [ "verit_bool_base" constr_list(lpl) ] -> [ Verit.tactic lpl !lemmas_list ]
+| [ "verit_bool_no_check_base" constr_list(lpl) ] -> [ Verit.tactic_no_check lpl !lemmas_list ]
+END
+
+TACTIC EXTEND Tactic_cvc4
+| [ "cvc4_bool" ] -> [ Lfsc.tactic () ]
+| [ "cvc4_bool_no_check" ] -> [ Lfsc.tactic_no_check () ]
 END
diff --git a/src/versions/native/structures.ml b/src/versions/native/structures.ml
index 06ca01c..c286f56 100644
--- a/src/versions/native/structures.ml
+++ b/src/versions/native/structures.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -112,11 +108,11 @@ let destruct_rel_decl (n, _, t) = n, t
 
 let interp_constr env sigma = Constrintern.interp_constr sigma env
 
-type constr_expr = Topconstr.constr_expr
-                            
 let tclTHEN = Tacticals.tclTHEN
 let tclTHENLAST = Tacticals.tclTHENLAST
 let assert_before = Tactics.assert_tac
+
+let vm_conv = Reduction.vm_conv
 let vm_cast_no_check = Tactics.vm_cast_no_check
 let mk_tactic tac gl =
   let env = Tacmach.pf_env gl in
@@ -130,6 +126,8 @@ let constrextern_extern_constr =
   let env = Global.env () in
   Constrextern.extern_constr false env
 
+let get_rel_dec_name = fun _ -> Names.Anonymous
+
 
 (* Old packaging of plugins *)
 module Micromega_plugin_Certificate = Certificate
@@ -138,5 +136,7 @@ module Micromega_plugin_Micromega = Micromega
 module Micromega_plugin_Mutils = Mutils
 
 
-(* Type of coq tactics *)
+(* Types in the Coq source code *)
 type tactic = Proof_type.tactic
+type names_id = Names.identifier
+type constr_expr = Topconstr.constr_expr
diff --git a/src/versions/native/structures.mli b/src/versions/native/structures.mli
index 7c5edfd..b4d9731 100644
--- a/src/versions/native/structures.mli
+++ b/src/versions/native/structures.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val gen_constant : string list list -> string -> Term.constr lazy_t
 val int63_modules : string list list
 val mkInt : int -> Term.constr
@@ -25,10 +37,10 @@ val pr_constr_env : Environ.env -> Term.constr -> Pp.std_ppcmds
 val lift : int -> Term.constr -> Term.constr
 val destruct_rel_decl : Term.rel_declaration -> Names.name * Term.constr
 val interp_constr : Environ.env -> Evd.evar_map -> Topconstr.constr_expr -> Term.constr
-type constr_expr = Topconstr.constr_expr
 val tclTHEN : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic
 val tclTHENLAST : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic
 val assert_before : Names.name -> Term.types -> Proof_type.tactic
+val vm_conv : Reduction.conv_pb -> Term.types Reduction.conversion_function
 val vm_cast_no_check : Term.constr -> Proof_type.tactic
 val mk_tactic :
   (Environ.env ->
@@ -37,8 +49,17 @@ val mk_tactic :
 val set_evars_tac : 'a -> Proof_type.tactic
 val ppconstr_lsimpleconstr : Ppconstr.precedence
 val constrextern_extern_constr : Term.constr -> Topconstr.constr_expr
+val get_rel_dec_name : 'a -> Names.name
+
+
+(* Old packaging of plugins *)
 module Micromega_plugin_Certificate = Certificate
 module Micromega_plugin_Coq_micromega = Coq_micromega
 module Micromega_plugin_Micromega = Micromega
 module Micromega_plugin_Mutils = Mutils
+
+
+(* Types in the Coq source code *)
 type tactic = Proof_type.tactic
+type names_id = Names.identifier
+type constr_expr = Topconstr.constr_expr
diff --git a/src/versions/standard/Array/PArray_standard.v b/src/versions/standard/Array/PArray_standard.v
index 4bf5e7a..e116339 100644
--- a/src/versions/standard/Array/PArray_standard.v
+++ b/src/versions/standard/Array/PArray_standard.v
@@ -1,14 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the PArray library of native-coq                            *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Int63/Int63Axioms_standard.v b/src/versions/standard/Int63/Int63Axioms_standard.v
index bbc353a..d4e45fc 100644
--- a/src/versions/standard/Int63/Int63Axioms_standard.v
+++ b/src/versions/standard/Int63/Int63Axioms_standard.v
@@ -1,16 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the Int31 library                                           *)
-(*         by Arnaud Spiwack and Pierre Letouzey                          *)
-(*       and the Int63 library of native-coq                              *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Int63/Int63Native_standard.v b/src/versions/standard/Int63/Int63Native_standard.v
index 9e5058a..a5a931b 100644
--- a/src/versions/standard/Int63/Int63Native_standard.v
+++ b/src/versions/standard/Int63/Int63Native_standard.v
@@ -1,16 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the Int31 library                                           *)
-(*         by Arnaud Spiwack and Pierre Letouzey                          *)
-(*       and the Int63 library of native-coq                              *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Int63/Int63Op_standard.v b/src/versions/standard/Int63/Int63Op_standard.v
index d0df921..85ea0c7 100644
--- a/src/versions/standard/Int63/Int63Op_standard.v
+++ b/src/versions/standard/Int63/Int63Op_standard.v
@@ -1,16 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the Int31 library                                           *)
-(*         by Arnaud Spiwack and Pierre Letouzey                          *)
-(*       and the Int63 library of native-coq                              *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Int63/Int63Properties_standard.v b/src/versions/standard/Int63/Int63Properties_standard.v
index 9b9649f..cb1e1f5 100644
--- a/src/versions/standard/Int63/Int63Properties_standard.v
+++ b/src/versions/standard/Int63/Int63Properties_standard.v
@@ -1,16 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the Int31 library                                           *)
-(*         by Arnaud Spiwack and Pierre Letouzey                          *)
-(*       and the Int63 library of native-coq                              *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Int63/Int63_standard.v b/src/versions/standard/Int63/Int63_standard.v
index 85ee8b7..59c6419 100644
--- a/src/versions/standard/Int63/Int63_standard.v
+++ b/src/versions/standard/Int63/Int63_standard.v
@@ -1,16 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*       from the Int31 library                                           *)
-(*         by Arnaud Spiwack and Pierre Letouzey                          *)
-(*       and the Int63 library of native-coq                              *)
-(*         by Benjamin Gregoire and Laurent Thery                         *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/versions/standard/Make b/src/versions/standard/Make
index b674ce9..ee7f119 100644
--- a/src/versions/standard/Make
+++ b/src/versions/standard/Make
@@ -12,19 +12,24 @@
 ## In the Makefile :                                                  ##
 ## 1) Suppress the "Makefile" target                                  ##
 ## 2) Change the "all" target:                                        ##
-##    remove the "test", "ztest", "vtest" and "./" dependencies       ##
+##    remove the "test", "ztest", "vtest", "lfsctest" and "./"        ##
+##    dependencies                                                    ##
 ## 3) Change the "install" and "clean" targets:                       ##
 ##    Suppress the "+" lines                                          ##
 ## 4) Add to the "clean" target:                                      ##
-##    - rm -f ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml ##
+##    - rm -f ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.mli smtlib2/sExprParser.ml smtlib2/sExprLexer.ml ##
 ########################################################################
 
 
 -R . SMTCoq
 
 -I .
+-I bva
+-I classes
+-I array
 -I cnf
 -I euf
+-I lfsc
 -I lia
 -I smtlib2
 -I trace
@@ -39,10 +44,11 @@
 -extra "test" "" "cd ../unit-tests; make" ""
 -extra "ztest" "" "cd ../unit-tests; make zchaff"
 -extra "vtest" "" "cd ../unit-tests; make verit"
+-extra "lfsctest" "" "cd ../unit-tests; make lfsc"
 
 -extra "%.ml" "%.mll" "$(CAMLLEX) $<"
 -extra "%.ml %.mli" "%.mly" "$(CAMLYACC) $<"
--extra-phony "smtcoq_plugin.mlpack.d" "verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml" ""
+-extra-phony "smtcoq_plugin.mlpack.d" "verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscParser.ml lfsc/lfscLexer.ml" ""
 
 CAMLLEX = $(CAMLBIN)ocamllex
 CAMLYACC = $(CAMLBIN)ocamlyacc
@@ -58,6 +64,15 @@ versions/standard/Structures.v
 versions/standard/structures.ml
 versions/standard/structures.mli
 
+bva/BVList.v
+bva/Bva_checker.v
+
+classes/SMT_classes.v
+classes/SMT_classes_instances.v
+
+array/FArray.v
+array/Array_checker.v
+
 trace/coqTerms.ml
 trace/coqTerms.mli
 trace/smtBtype.ml
@@ -89,6 +104,13 @@ smtlib2/smtlib2_genConstr.ml
 smtlib2/smtlib2_genConstr.mli
 smtlib2/smtlib2_util.ml
 smtlib2/smtlib2_util.mli
+smtlib2/sExpr.ml
+smtlib2/sExpr.mli
+smtlib2/smtlib2_solver.ml
+smtlib2/smtlib2_solver.mli
+smtlib2/sExprParser.ml
+smtlib2/sExprParser.mli
+smtlib2/sExprLexer.ml
 
 verit/veritParser.ml
 verit/veritParser.mli
@@ -99,6 +121,23 @@ verit/verit.mli
 verit/veritSyntax.ml
 verit/veritSyntax.mli
 
+lfsc/shashcons.mli
+lfsc/shashcons.ml
+lfsc/hstring.mli
+lfsc/hstring.ml
+lfsc/lfscParser.ml
+lfsc/lfscParser.mli
+lfsc/type.ml
+lfsc/ast.ml
+lfsc/ast.mli
+lfsc/translator_sig.mli
+lfsc/builtin.ml
+lfsc/tosmtcoq.ml
+lfsc/tosmtcoq.mli
+lfsc/converter.ml
+lfsc/lfsc.ml
+lfsc/lfscLexer.ml
+
 zchaff/cnfParser.ml
 zchaff/cnfParser.mli
 zchaff/satParser.ml
@@ -124,6 +163,10 @@ spl/Operators.v
 Conversion_tactics.v
 Misc.v
 SMTCoq.v
+ReflectFacts.v
+PropToBool.v
+BoolToProp.v
+Tactics.v
 SMT_terms.v
 State.v
 Trace.v
diff --git a/src/versions/standard/Makefile b/src/versions/standard/Makefile
index 0225e3c..f71b0c8 100644
--- a/src/versions/standard/Makefile
+++ b/src/versions/standard/Makefile
@@ -2,7 +2,7 @@
 ##  v      #                   The Coq Proof Assistant                     ##
 ## <O___,, #                INRIA - CNRS - LIX - LRI - PPS                 ##
 ##   \VV/  #                                                               ##
-##    //   #  Makefile automagically generated by coq_makefile V8.6        ##
+##    //   #  Makefile automagically generated by coq_makefile V8.6.1      ##
 #############################################################################
 
 # WARNING
@@ -55,8 +55,12 @@ vo_to_obj = $(addsuffix .o,\
 ##########################
 
 OCAMLLIBS?=-I "."\
+  -I "bva"\
+  -I "classes"\
+  -I "array"\
   -I "cnf"\
   -I "euf"\
+  -I "lfsc"\
   -I "lia"\
   -I "smtlib2"\
   -I "trace"\
@@ -69,8 +73,12 @@ OCAMLLIBS?=-I "."\
 COQLIBS?=\
   -R "." SMTCoq\
   -I "."\
+  -I "bva"\
+  -I "classes"\
+  -I "array"\
   -I "cnf"\
   -I "euf"\
+  -I "lfsc"\
   -I "lia"\
   -I "smtlib2"\
   -I "trace"\
@@ -132,6 +140,7 @@ COQSRCLIBS?=-I "$(COQLIB)kernel" \
   -I "$(COQLIB)/plugins/firstorder" \
   -I "$(COQLIB)/plugins/fourier" \
   -I "$(COQLIB)/plugins/funind" \
+  -I "$(COQLIB)/plugins/ltac" \
   -I "$(COQLIB)/plugins/micromega" \
   -I "$(COQLIB)/plugins/nsatz" \
   -I "$(COQLIB)/plugins/omega" \
@@ -188,6 +197,12 @@ VFILES:=versions/standard/Int63/Int63.v\
   versions/standard/Int63/Int63Properties.v\
   versions/standard/Array/PArray.v\
   versions/standard/Structures.v\
+  bva/BVList.v\
+  bva/Bva_checker.v\
+  classes/SMT_classes.v\
+  classes/SMT_classes_instances.v\
+  array/FArray.v\
+  array/Array_checker.v\
   cnf/Cnf.v\
   euf/Euf.v\
   lia/Lia.v\
@@ -198,6 +213,10 @@ VFILES:=versions/standard/Int63/Int63.v\
   Conversion_tactics.v\
   Misc.v\
   SMTCoq.v\
+  ReflectFacts.v\
+  PropToBool.v\
+  BoolToProp.v\
+  Tactics.v\
   SMT_terms.v\
   State.v\
   Trace.v
@@ -249,10 +268,24 @@ MLFILES:=versions/standard/structures.ml\
   smtlib2/smtlib2_ast.ml\
   smtlib2/smtlib2_genConstr.ml\
   smtlib2/smtlib2_util.ml\
+  smtlib2/sExpr.ml\
+  smtlib2/smtlib2_solver.ml\
+  smtlib2/sExprParser.ml\
+  smtlib2/sExprLexer.ml\
   verit/veritParser.ml\
   verit/veritLexer.ml\
   verit/verit.ml\
   verit/veritSyntax.ml\
+  lfsc/shashcons.ml\
+  lfsc/hstring.ml\
+  lfsc/lfscParser.ml\
+  lfsc/type.ml\
+  lfsc/ast.ml\
+  lfsc/builtin.ml\
+  lfsc/tosmtcoq.ml\
+  lfsc/converter.ml\
+  lfsc/lfsc.ml\
+  lfsc/lfscLexer.ml\
   zchaff/cnfParser.ml\
   zchaff/satParser.ml\
   zchaff/zchaff.ml\
@@ -297,10 +330,19 @@ MLIFILES:=versions/standard/structures.mli\
   smtlib2/smtlib2_ast.mli\
   smtlib2/smtlib2_genConstr.mli\
   smtlib2/smtlib2_util.mli\
+  smtlib2/sExpr.mli\
+  smtlib2/smtlib2_solver.mli\
+  smtlib2/sExprParser.mli\
   verit/veritParser.mli\
   verit/veritLexer.mli\
   verit/verit.mli\
   verit/veritSyntax.mli\
+  lfsc/shashcons.mli\
+  lfsc/hstring.mli\
+  lfsc/lfscParser.mli\
+  lfsc/ast.mli\
+  lfsc/translator_sig.mli\
+  lfsc/tosmtcoq.mli\
   zchaff/cnfParser.mli\
   zchaff/satParser.mli\
   zchaff/zchaff.mli\
@@ -397,13 +439,16 @@ ztest:
 vtest: 
 	cd ../unit-tests; make verit
 
+lfsctest: 
+	cd ../unit-tests; make lfsc
+
 %.ml: %.mll
 	$(CAMLLEX) $<
 
 %.ml %.mli: %.mly
 	$(CAMLYACC) $<
 
-smtcoq_plugin.mlpack.d: verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml
+smtcoq_plugin.mlpack.d: verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.ml smtlib2/sExprLexer.ml lfsc/lfscParser.ml lfsc/lfscLexer.ml
 
 ###################
 #                 #
@@ -504,12 +549,20 @@ uninstall: uninstall_me.sh
 	@echo "B $(COQLIB)config" >> .merlin
 	@echo "B $(COQLIB)ltac" >> .merlin
 	@echo "B $(COQLIB)engine" >> .merlin
-	@echo "B /home/valentin/smtcoq/smtcoq/src/versions/standard" >> .merlin
-	@echo "S /home/valentin/smtcoq/smtcoq/src/versions/standard" >> .merlin
+	@echo "B /home/artemis/Recherche/github.com/ckeller/smtcoq-lfsc/src/versions/standard" >> .merlin
+	@echo "S /home/artemis/Recherche/github.com/ckeller/smtcoq-lfsc/src/versions/standard" >> .merlin
+	@echo "B bva" >> .merlin
+	@echo "S bva" >> .merlin
+	@echo "B classes" >> .merlin
+	@echo "S classes" >> .merlin
+	@echo "B array" >> .merlin
+	@echo "S array" >> .merlin
 	@echo "B cnf" >> .merlin
 	@echo "S cnf" >> .merlin
 	@echo "B euf" >> .merlin
 	@echo "S euf" >> .merlin
+	@echo "B lfsc" >> .merlin
+	@echo "S lfsc" >> .merlin
 	@echo "B lia" >> .merlin
 	@echo "S lia" >> .merlin
 	@echo "B smtlib2" >> .merlin
@@ -541,10 +594,11 @@ clean::
 	- rm -rf test
 	- rm -rf ztest
 	- rm -rf vtest
-	- rm -f ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml
+	- rm -rf lfsctest
+	- rm -f ../unit-tests/*.vo ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml smtlib2/smtlib2_parse.mli smtlib2/smtlib2_parse.ml smtlib2/smtlib2_lex.ml smtlib2/sExprParser.mli smtlib2/sExprParser.ml smtlib2/sExprLexer.ml
 
 cleanall:: clean
-	rm -f $(patsubst %.v,.%.aux,$(VFILES))
+	rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux)
 
 archclean::
 	rm -f *.cmx *.o
@@ -558,6 +612,7 @@ printenv:
 	@echo 'COQLIBINSTALL =	$(COQLIBINSTALL)'
 	@echo 'COQDOCINSTALL =	$(COQDOCINSTALL)'
 
+
 ###################
 #                 #
 # Implicit rules. #
diff --git a/src/versions/standard/Structures_standard.v b/src/versions/standard/Structures_standard.v
index 04b396f..4894ebd 100644
--- a/src/versions/standard/Structures_standard.v
+++ b/src/versions/standard/Structures_standard.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Require Import Int63.
 
 Require Import List.
@@ -7,6 +19,9 @@ Section Trace.
 
   Definition trace (step:Type) := ((list step) * step)%type.
 
+  Definition trace_to_list {step:Type} (t:trace step) : list step :=
+    let (t, _) := t in t.
+
   Definition trace_length {step:Type} (t:trace step) : int :=
     let (t,_) := t in
     List.fold_left (fun i _ => (i+1)%int) t 0%int.
@@ -33,3 +48,8 @@ Section Trace.
   Admitted.
 
 End Trace.
+
+
+Definition nat_eqb := Nat.eqb.
+Definition nat_eqb_eq := Nat.eqb_eq.
+Definition nat_eqb_refl := Nat.eqb_refl.
diff --git a/src/versions/standard/g_smtcoq_standard.ml4 b/src/versions/standard/g_smtcoq_standard.ml4
index b8ea279..2cc4415 100644
--- a/src/versions/standard/g_smtcoq_standard.ml4
+++ b/src/versions/standard/g_smtcoq_standard.ml4
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -46,15 +42,39 @@ VERNAC COMMAND EXTEND Vernac_verit CLASSIFIED AS QUERY
   [
     Verit.checker fsmt fproof
   ]
+| [ "Verit_Checker_Debug" string(fsmt) string(fproof) ] ->
+  [
+    Verit.checker_debug fsmt fproof
+  ]
 | [ "Verit_Theorem" ident(name) string(fsmt) string(fproof) ] ->
   [
     Verit.theorem name fsmt fproof
   ]
 END
 
+VERNAC COMMAND EXTEND Vernac_lfsc CLASSIFIED AS QUERY
+| [ "Parse_certif_lfsc"
+    ident(t_i) ident(t_func) ident(t_atom) ident(t_form) ident(root) ident(used_roots) ident(trace) string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.parse_certif t_i t_func t_atom t_form root used_roots trace fsmt fproof
+  ]
+| [ "Lfsc_Checker" string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.checker fsmt fproof
+  ]
+| [ "Lfsc_Checker_Debug" string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.checker_debug fsmt fproof
+  ]
+| [ "Lfsc_Theorem" ident(name) string(fsmt) string(fproof) ] ->
+  [
+    Lfsc.theorem name fsmt fproof
+  ]
+END
 
 TACTIC EXTEND Tactic_zchaff
-| [ "zchaff" ] -> [ Zchaff.tactic () ]
+| [ "zchaff_bool" ] -> [ Zchaff.tactic () ]
+| [ "zchaff_bool_no_check" ] -> [ Zchaff.tactic_no_check () ]
 END
 
 let lemmas_list = ref []
@@ -66,5 +86,11 @@ END
 
 
 TACTIC EXTEND Tactic_verit
-| [ "verit_base" constr_list(lpl) ] -> [ Verit.tactic lpl !lemmas_list ]
+| [ "verit_bool_base" constr_list(lpl) ] -> [ Verit.tactic lpl !lemmas_list ]
+| [ "verit_bool_no_check_base" constr_list(lpl) ] -> [ Verit.tactic_no_check lpl !lemmas_list ]
+END
+
+TACTIC EXTEND Tactic_cvc4
+| [ "cvc4_bool" ] -> [ Lfsc.tactic () ]
+| [ "cvc4_bool_no_check" ] -> [ Lfsc.tactic_no_check () ]
 END
diff --git a/src/versions/standard/smtcoq_plugin_standard.mlpack b/src/versions/standard/smtcoq_plugin_standard.mlpack
index b316040..68ce13a 100644
--- a/src/versions/standard/smtcoq_plugin_standard.mlpack
+++ b/src/versions/standard/smtcoq_plugin_standard.mlpack
@@ -19,6 +19,10 @@ Smtlib2_util
 Smtlib2_ast
 Smtlib2_parse
 Smtlib2_lex
+SExpr
+SExprParser
+SExprLexer
+Smtlib2_solver
 
 Lia
 
@@ -26,10 +30,22 @@ VeritSyntax
 VeritParser
 VeritLexer
 
+Shashcons
+Hstring
+Type
+Ast
+Builtin
+Tosmtcoq
+Converter
+LfscParser
+LfscLexer
+
 Smtlib2_genConstr
 
 SmtCommands
 
 Verit
 
+Lfsc
+
 G_smtcoq
diff --git a/src/versions/standard/structures.ml b/src/versions/standard/structures.ml
index be63a80..3dbcad2 100644
--- a/src/versions/standard/structures.ml
+++ b/src/versions/standard/structures.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -140,17 +136,19 @@ type rel_decl = Context.Rel.Declaration.t
 let destruct_rel_decl r = Context.Rel.Declaration.get_name r,
                           Context.Rel.Declaration.get_type r
 
-type constr_expr = Constrexpr.constr_expr
-                        
 let interp_constr env sigma t = Constrintern.interp_constr env sigma t |> fst
-                        
+
 let tclTHEN = Tacticals.New.tclTHEN
 let tclTHENLAST = Tacticals.New.tclTHENLAST
 let assert_before = Tactics.assert_before
+
+let vm_conv = Vconv.vm_conv
 let vm_cast_no_check t = Tactics.vm_cast_no_check t
-(* let vm_cast_no_check t = Proofview.V82.tactic (Tactics.vm_cast_no_check t) *)
+
+(* Warning 40: this record of type Proofview.Goal.enter contains fields
+   that are not visible in the current scope: enter. *)
 let mk_tactic tac =
-  Proofview.Goal.nf_enter {enter = (fun gl ->
+  Proofview.Goal.nf_enter {Proofview.Goal.enter = (fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     let t = Proofview.Goal.concl gl in
@@ -167,6 +165,9 @@ let constrextern_extern_constr =
   let env = Global.env () in
   Constrextern.extern_constr false env (Evd.from_env env)
 
+let get_rel_dec_name = function
+  | Context.Rel.Declaration.LocalAssum (n, _) | Context.Rel.Declaration.LocalDef (n, _, _) -> n
+
 
 (* New packaging of plugins *)
 module Micromega_plugin_Certificate = Micromega_plugin.Certificate
@@ -174,5 +175,8 @@ module Micromega_plugin_Coq_micromega = Micromega_plugin.Coq_micromega
 module Micromega_plugin_Micromega = Micromega_plugin.Micromega
 module Micromega_plugin_Mutils = Micromega_plugin.Mutils
 
-(* Type of coq tactics *)
+
+(* Types in the Coq source code *)
 type tactic = unit Proofview.tactic
+type names_id = Names.Id.t
+type constr_expr = Constrexpr.constr_expr
diff --git a/src/versions/standard/structures.mli b/src/versions/standard/structures.mli
index 600503d..f7c4f91 100644
--- a/src/versions/standard/structures.mli
+++ b/src/versions/standard/structures.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val mklApp : Term.constr Lazy.t -> Term.constr array -> Term.constr
 val gen_constant : string list list -> string -> Term.constr lazy_t
 val int63_modules : string list list
@@ -39,13 +51,13 @@ val pr_constr_env : Environ.env -> Term.constr -> Pp.std_ppcmds
 val lift : int -> Constr.constr -> Constr.constr
 type rel_decl = Context.Rel.Declaration.t                                     
 val destruct_rel_decl : rel_decl -> Names.Name.t * Constr.t
-type constr_expr = Constrexpr.constr_expr
 val interp_constr : Environ.env -> Evd.evar_map -> Constrexpr.constr_expr -> Term.constr
 val tclTHEN :
   unit Proofview.tactic -> unit Proofview.tactic -> unit Proofview.tactic
 val tclTHENLAST :
   unit Proofview.tactic -> unit Proofview.tactic -> unit Proofview.tactic
 val assert_before : Names.Name.t -> Term.types -> unit Proofview.tactic
+val vm_conv : Reduction.conv_pb -> Term.types Reduction.kernel_conversion_function
 val vm_cast_no_check : Term.constr -> unit Proofview.tactic
 val mk_tactic :
   (Environ.env -> Evd.evar_map -> Term.constr -> unit Proofview.tactic) ->
@@ -53,8 +65,17 @@ val mk_tactic :
 val set_evars_tac : Term.constr -> unit Proofview.tactic
 val ppconstr_lsimpleconstr : Ppconstr.precedence
 val constrextern_extern_constr : Term.constr -> Constrexpr.constr_expr
+val get_rel_dec_name : Context.Rel.Declaration.t -> Names.Name.t
+
+
+(* New packaging of plugins *)
 module Micromega_plugin_Certificate = Micromega_plugin.Certificate
 module Micromega_plugin_Coq_micromega = Micromega_plugin.Coq_micromega
 module Micromega_plugin_Micromega = Micromega_plugin.Micromega
 module Micromega_plugin_Mutils = Micromega_plugin.Mutils
+
+
+(* Types in the Coq source code *)
 type tactic = unit Proofview.tactic
+type names_id = Names.Id.t
+type constr_expr = Constrexpr.constr_expr
diff --git a/src/zchaff/cnfParser.ml b/src/zchaff/cnfParser.ml
index c02211f..cf22136 100644
--- a/src/zchaff/cnfParser.ml
+++ b/src/zchaff/cnfParser.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/zchaff/cnfParser.mli b/src/zchaff/cnfParser.mli
index 4e2e079..586942e 100644
--- a/src/zchaff/cnfParser.mli
+++ b/src/zchaff/cnfParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val skip_comment : SatParser.lex_buff -> unit
 val parse_p_cnf : SatParser.lex_buff -> int
 val mklit : int -> SatAtom.Form.reify -> int -> SatAtom.Form.t
diff --git a/src/zchaff/satParser.ml b/src/zchaff/satParser.ml
index 7928c61..8704c7c 100644
--- a/src/zchaff/satParser.ml
+++ b/src/zchaff/satParser.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/zchaff/satParser.mli b/src/zchaff/satParser.mli
index c2fa020..871ab66 100644
--- a/src/zchaff/satParser.mli
+++ b/src/zchaff/satParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 type lex_buff = {
   buff : bytes;
   mutable curr_char : int;
diff --git a/src/zchaff/zchaff.ml b/src/zchaff/zchaff.ml
index 928dd8d..2bbb23d 100644
--- a/src/zchaff/zchaff.ml
+++ b/src/zchaff/zchaff.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
@@ -62,6 +58,8 @@ and pp_pform fmt p =
   | Fapp(op,args) ->
       Format.fprintf fmt "%s" (string_of_op op);
       Array.iter (fun a -> Format.fprintf fmt "%a " pp_form a) args
+  (* Nothing to do with ZChaff *)
+  | FbbT _ -> assert false
 
 let pp_value fmt c =
   match c.value with
@@ -228,7 +226,7 @@ let theorems interp name fdimacs ftrace =
   let certif =
    mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in
 
-  let theorem_concl = mklApp cis_true [|mklApp cnegb [|interp d first last|] |] in
+  let theorem_concl = mklApp cnot [|mklApp cis_true [|interp d first last|] |] in
   let vtype = Term.mkProd(Names.Anonymous, Lazy.force cint, Lazy.force cbool) in
   let theorem_type =
     Term.mkProd (mkName "v", vtype, theorem_concl) in
@@ -239,7 +237,7 @@ let theorems interp name fdimacs ftrace =
         Term.mkLambda (mkName "v", vtype,
         mklApp ctheorem_checker
                [| Term.mkRel 3(*d*); Term.mkRel 2(*c*);
-		  vm_cast_true
+		  vm_cast_true_no_check
 		    (mklApp cchecker [|Term.mkRel 3(*d*); Term.mkRel 2(*c*)|]);
                   Term.mkRel 1(*v*)|]))),
       Term.VMcast,
@@ -361,7 +359,7 @@ let cchecker_eq_correct =
   gen_constant cnf_checker_modules "checker_eq_correct"
 let cchecker_eq = gen_constant cnf_checker_modules "checker_eq"
 
-let build_body reify_atom reify_form l b (max_id, confl) =
+let build_body reify_atom reify_form l b (max_id, confl) vm_cast =
   let ntvar = mkName "t_var" in
   let ntform = mkName "t_form" in
   let nc = mkName "c" in
@@ -374,25 +372,27 @@ let build_body reify_atom reify_form l b (max_id, confl) =
   let vtvar = Term.mkRel 3 in
   let vtform = Term.mkRel 2 in
   let vc = Term.mkRel 1 in
-  let proof_cast =
+  let add_lets t =
     Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
     Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
     Term.mkLetIn (nc, certif, Lazy.force ccertif,
-    mklApp cchecker_b_correct
-	   [|vtvar; vtform; l; b; vc;
-	     vm_cast_true (mklApp cchecker_b [|vtform;l;b;vc|])|])))
+    t)))
+  in
+  let cbc =
+    add_lets
+      (mklApp cchecker_b [|vtform;l;b;vc|]) |> vm_cast in
+  let proof_cast =
+    add_lets
+      (mklApp cchecker_b_correct [|vtvar; vtform; l; b; vc; cbc|])
   in
   let proof_nocast =
-    Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
-    Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, Lazy.force ccertif,
-    mklApp cchecker_b_correct
-	   [|vtvar; vtform; l; b; vc|])))
+    add_lets
+      (mklApp cchecker_b_correct [|vtvar; vtform; l; b; vc|])
   in
   (proof_cast, proof_nocast)
 
 
-let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) =
+let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) vm_cast =
   let ntvar = mkName "t_var" in
   let ntform = mkName "t_form" in
   let nc = mkName "c" in
@@ -405,20 +405,20 @@ let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) =
   let vtvar = Term.mkRel 3 in
   let vtform = Term.mkRel 2 in
   let vc = Term.mkRel 1 in
-  let proof_cast =
+  let add_lets t =
     Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
     Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
     Term.mkLetIn (nc, certif, Lazy.force ccertif,
-    mklApp cchecker_eq_correct
-           [|vtvar; vtform; l1; l2; l; vc;
-	     vm_cast_true (mklApp cchecker_eq [|vtform;l1;l2;l;vc|])|])))
+    t)))
+  in
+  let ceqc = add_lets (mklApp cchecker_eq [|vtform;l1;l2;l;vc|])
+                 |> vm_cast in
+  let proof_cast =
+    add_lets
+      (mklApp cchecker_eq_correct [|vtvar; vtform; l1; l2; l; vc; ceqc|])
   in
   let proof_nocast =
-    Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
-    Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
-    Term.mkLetIn (nc, certif, Lazy.force ccertif,
-    mklApp cchecker_eq_correct
-           [|vtvar; vtform; l1; l2; l; vc|])))
+    add_lets (mklApp cchecker_eq_correct [|vtvar; vtform; l1; l2; l; vc|])
   in
   (proof_cast, proof_nocast)
 
@@ -512,6 +512,8 @@ let make_proof pform_tbl atom_tbl env reify_form l =
             let value = if ispos then " = true" else " = false" in
             acc^"  "^(Pp.string_of_ppcmds (Structures.pr_constr_env env t))^value
           | Fapp _ -> acc
+          (* Nothing to do with ZChaff *)
+          | FbbT _ -> assert false
       ) with | Invalid_argument _ -> acc (* Because cnf computation does not put the new formulas in the table... Perhaps it should? *)
     ) "zchaff found a counterexample:\n" model)
   );
@@ -520,10 +522,10 @@ let make_proof pform_tbl atom_tbl env reify_form l =
 
 (* The whole tactic *)
 
-let core_tactic env sigma t =
+let core_tactic vm_cast env sigma concl =
   SmtTrace.clear ();
 
-  let (forall_let, concl) = Term.decompose_prod_assum t in
+  let (forall_let, concl) = Term.decompose_prod_assum concl in
   let a, b = get_arguments concl in
   let reify_atom = Atom.create () in
   let reify_form = Form.create () in
@@ -534,7 +536,7 @@ let core_tactic env sigma t =
       let atom_tbl = Atom.atom_tbl reify_atom in
       let pform_tbl = Form.pform_tbl reify_form in
       let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l' in
-      build_body reify_atom reify_form (Form.to_coq l) b max_id_confl
+      build_body reify_atom reify_form (Form.to_coq l) b max_id_confl (vm_cast env)
     else
       let l1 = Form.of_coq (Atom.get reify_atom) reify_form a in
       let l2 = Form.of_coq (Atom.get reify_atom) reify_form b in
@@ -543,7 +545,7 @@ let core_tactic env sigma t =
       let pform_tbl = Form.pform_tbl reify_form in
       let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l in
       build_body_eq reify_atom reify_form
-	(Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl
+	(Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl (vm_cast env)
   in
 
   let compose_lam_assum forall_let body =
@@ -556,4 +558,5 @@ let core_tactic env sigma t =
      (Structures.vm_cast_no_check res_cast))
 
 
-let tactic () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic core_tactic)
+let tactic () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic (core_tactic vm_cast_true))
+let tactic_no_check () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic (core_tactic (fun _ -> vm_cast_true_no_check)))
diff --git a/src/zchaff/zchaff.mli b/src/zchaff/zchaff.mli
index 6a873ec..4c312fc 100644
--- a/src/zchaff/zchaff.mli
+++ b/src/zchaff/zchaff.mli
@@ -1,88 +1,18 @@
-val is_trivial : SatAtom.Form.t list -> bool
-val string_of_op : SmtForm.fop -> string
-val pp_form : Format.formatter -> SatAtom.Form.t -> unit
-val pp_sign : Format.formatter -> SatAtom.Form.t -> unit
-val pp_pform : Format.formatter -> SatAtom.Form.pform -> unit
-val pp_value : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val pp_kind : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val pp_trace : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val import_cnf :
-  string ->
-  int * SatAtom.Form.t SmtCertif.clause * SatAtom.Form.t SmtCertif.clause *
-  (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t
-val import_cnf_trace :
-  (int, 'a SmtCertif.clause) Hashtbl.t ->
-  string ->
-  SatAtom.Form.t SmtCertif.clause ->
-  'a SmtCertif.clause -> int * 'a SmtCertif.clause
-val make_roots :
-  SatAtom.Form.t SmtCertif.clause -> 'a SmtCertif.clause -> Term.constr
-val interp_roots :
-  SatAtom.Form.t SmtCertif.clause -> 'a SmtCertif.clause -> Term.constr
-val sat_checker_modules : string list list
-val parse_certif :
-  Names.identifier -> Names.identifier -> string -> string -> unit
-val cdimacs : Term.constr lazy_t
-val ctheorem_checker : Term.constr lazy_t
-val cchecker : Term.constr lazy_t
-val theorems :
-  (Term.constr ->
-   SatAtom.Form.t SmtCertif.clause ->
-   SatAtom.Form.t SmtCertif.clause -> Term.constr) ->
-  Names.identifier -> string -> string -> unit
-val theorem : Names.identifier -> string -> string -> unit
-val theorem_abs : Names.identifier -> string -> string -> unit
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+val parse_certif : Structures.names_id -> Structures.names_id -> string -> string -> unit
 val checker : string -> string -> unit
-val export_clause : Format.formatter -> SatAtom.Form.t list -> unit
-val export :
-  out_channel ->
-  int ->
-  SatAtom.Form.t SmtCertif.clause ->
-  (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t *
-  SatAtom.Form.t SmtCertif.clause
-val call_zchaff :
-  int ->
-  SatAtom.Form.t SmtCertif.clause ->
-  (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t * string * string *
-  SatAtom.Form.t SmtCertif.clause
-val cnf_checker_modules : string list list
-val certif_ops :
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
-  Term.constr lazy_t * Term.constr lazy_t
-val ccertif : Term.constr lazy_t
-val cCertif : Term.constr lazy_t
-val cchecker_b_correct : Term.constr lazy_t
-val cchecker_b : Term.constr lazy_t
-val cchecker_eq_correct : Term.constr lazy_t
-val cchecker_eq : Term.constr lazy_t
-val build_body :
-  SatAtom.Atom.reify_tbl ->
-  SatAtom.Form.reify ->
-  Term.constr ->
-  Term.constr ->
-  int * SatAtom.Form.t SmtCertif.clause -> Term.constr * Term.constr
-val build_body_eq :
-  SatAtom.Atom.reify_tbl ->
-  SatAtom.Form.reify ->
-  Term.constr ->
-  Term.constr ->
-  Term.constr ->
-  int * SatAtom.Form.t SmtCertif.clause -> Term.constr * Term.constr
-val get_arguments : Term.constr -> Term.constr * Term.constr
-exception Sat of int list
-exception Finished
-val input_int : in_channel -> int
-val check_unsat : string -> unit
-val make_proof :
-  (int, 'a) SmtForm.gen_pform array ->
-  Term.constr array ->
-  Environ.env ->
-  SatAtom.Form.reify ->
-  SatAtom.Form.t -> int * SatAtom.Form.t SmtCertif.clause
-val core_tactic : Environ.env -> 'a -> Term.types -> Structures.tactic
+val theorem : Structures.names_id -> string -> string -> unit
+val theorem_abs : Structures.names_id -> string -> string -> unit
 val tactic : unit -> Structures.tactic
+val tactic_no_check : unit -> Structures.tactic
diff --git a/src/zchaff/zchaffParser.ml b/src/zchaff/zchaffParser.ml
index fa04dc6..c4a2f62 100644
--- a/src/zchaff/zchaffParser.ml
+++ b/src/zchaff/zchaffParser.ml
@@ -1,13 +1,9 @@
 (**************************************************************************)
 (*                                                                        *)
 (*     SMTCoq                                                             *)
-(*     Copyright (C) 2011 - 2016                                          *)
+(*     Copyright (C) 2011 - 2019                                          *)
 (*                                                                        *)
-(*     Michaël Armand                                                     *)
-(*     Benjamin Grégoire                                                  *)
-(*     Chantal Keller                                                     *)
-(*                                                                        *)
-(*     Inria - École Polytechnique - Université Paris-Sud                 *)
+(*     See file "AUTHORS" for the list of authors                         *)
 (*                                                                        *)
 (*   This file is distributed under the terms of the CeCILL-C licence     *)
 (*                                                                        *)
diff --git a/src/zchaff/zchaffParser.mli b/src/zchaff/zchaffParser.mli
index a512f48..26065df 100644
--- a/src/zchaff/zchaffParser.mli
+++ b/src/zchaff/zchaffParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 val _CL : string
 val _INF : string
 val _VAR : string
diff --git a/unit-tests/Makefile b/unit-tests/Makefile
index bed1018..1ad9b57 100644
--- a/unit-tests/Makefile
+++ b/unit-tests/Makefile
@@ -10,9 +10,10 @@ COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)
 COQC?=$(COQBIN)coqc
 
 
-all: $(OBJ) Tests_zchaff.vo Tests_verit.vo
+all: zchaff verit lfsc
 zchaff: $(ZCHAFFLOG) Tests_zchaff.vo
 verit: $(VERITLOG) Tests_verit.vo
+lfsc: Tests_lfsc.vo
 logs: $(OBJ)
 
 
diff --git a/unit-tests/Tests_lfsc.v b/unit-tests/Tests_lfsc.v
new file mode 100644
index 0000000..9734fde
--- /dev/null
+++ b/unit-tests/Tests_lfsc.v
@@ -0,0 +1,700 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Add Rec LoadPath "../src" as SMTCoq.
+
+Require Import SMTCoq.
+Require Import Bool PArray Int63 List ZArith Logic.
+
+
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+
+
+Section BV.
+
+Import BVList.BITVECTOR_LIST.
+Local Open Scope bv_scope.
+
+  Goal forall (a b c: bitvector 4),
+                                 (c = (bv_and a b)) ->
+                                 ((bv_and (bv_and c a) b) = c).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (bv1 bv2 bv3: bitvector 4),
+      bv1 = #b|0|0|0|0|  /\
+      bv2 = #b|1|0|0|0|  /\
+      bv3 = #b|1|1|0|0|  ->
+      bv_ultP bv1 bv2 /\ bv_ultP bv2 bv3.
+  Proof. 
+     smt.
+  Qed.
+
+
+  Goal forall (a: bitvector 32), a = a.
+  Proof.
+    smt.
+  Qed.
+
+  (* TODO: will be ok when symmetry of equality is back for verit *)
+  (* Goal forall (bv1 bv2: bitvector 4), *)
+  (*      bv1 = bv2 <-> bv2 = bv1. *)
+  (* Proof. *)
+  (*    smt. *)
+  (* Qed. *)
+
+End BV.
+
+
+Section Arrays.
+
+  Import FArray.
+  Local Open Scope farray_scope.
+
+
+  Goal forall (a:farray Z Z) i j, i = j -> a[i] = a[j].
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z)
+         (v w x y: Z)
+         (g: farray Z Z -> Z)
+         (f: Z -> Z),
+         (a[x <- v] = b) /\ a[y <- w] = b  ->
+         (f x) = (f y) \/  (g a) = (g b).
+  Proof.
+    smt.
+  Qed.
+
+
+  (* TODO *)
+  (* Goal forall (a b c d: farray Z Z), *)
+  (*     b[0%Z <- 4] = c  -> *)
+  (*     d = b[0%Z <- 4][1%Z <- 4]  -> *)
+  (*     a = d[1%Z <- b[1%Z]]  -> *)
+  (*     a = c. *)
+  (* Proof. *)
+  (*   smt. *)
+  (* Qed. *)
+
+
+(*
+  Goal forall (a b: farray Z Z) i,
+      (select (store (store (store a i 3%Z) 1%Z (select (store b i 4) i)) 2%Z 2%Z) 1%Z) =  4.
+  Proof.
+    smt.
+    rewrite read_over_other_write; try easy.
+    rewrite read_over_same_write; try easy; try apply Z_compdec.
+    rewrite read_over_same_write; try easy; try apply Z_compdec.
+  Qed.
+*)
+
+
+End Arrays.
+
+
+Section EUF.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         y = x -> (f x) = (f y).
+  Proof.
+    smt.
+  Qed.
+
+  (* TODO: will be ok when symmetry of equality is back for verit *)
+  (* Goal forall *)
+  (*        (x y: Z) *)
+  (*        (f: Z -> Z), *)
+  (*        (f x) = (f y) -> (f y) = (f x). *)
+  (* Proof. *)
+  (*   smt. *)
+  (* Qed. *)
+
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         x + 1 = (y + 1) -> (f y) = (f x).
+  Proof.
+    smt.
+  Qed.
+
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         x = (y + 1) -> (f y) = (f (x - 1)).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         x = (y + 1) -> (f (y + 1)) = (f x).
+  Proof.
+    smt.
+  Qed.
+
+End EUF.
+
+
+Section LIA.
+
+
+  (* TODO: will be ok when symmetry of equality is back for verit *)
+  (* Goal forall (a b: Z), a = b <-> b = a. *)
+  (* Proof. *)
+  (*   smt. *)
+  (* Qed. *)
+
+  Goal forall (x y: Z), (x >= y) -> (y < x) \/ (x = y).
+  Proof. 
+    smt. 
+  Qed.
+
+
+  Goal forall (f : Z -> Z) (a:Z), ((f a) > 1) ->  ((f a) + 1) >= 2 \/((f a) = 30) .
+  Proof.
+   smt.
+  Qed.
+ 
+  Goal forall x: Z, (x = 0%Z) -> (8 >= 0).
+  Proof.
+    smt.
+   Qed.
+
+  Goal forall x: Z, ~ (x < 0%Z) -> (8 >= 0).
+  Proof. 
+    smt. 
+  Qed.
+
+  Goal forall (a b: Z), a < b -> a < (b + 1).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: Z), (a < b) -> (a + 2) < (b + 3).
+  Proof.
+    smt.
+  Qed.
+
+
+  Goal forall a b, a < b -> a < (b + 10).
+  Proof. 
+    smt.
+  Qed.
+
+
+End LIA.
+
+
+Section PR.
+
+ Local Open Scope int63_scope.
+
+(* Simple connectors *)
+
+Goal forall (a:bool), a || negb a.
+  smt.
+Qed.
+
+Goal forall a, negb (a || negb a) = false.
+  smt.
+Qed.
+
+Goal forall a, (a && negb a) = false.
+  smt.
+Qed.
+
+Goal forall a, negb (a && negb a).
+  smt.
+Qed.
+
+Goal forall a, a --> a.
+  smt.
+Qed.
+
+Goal forall a, negb (a --> a) = false.
+  smt.
+Qed.
+
+
+Goal forall a , (xorb a a) || negb (xorb a a).
+  smt.
+Qed.
+
+
+Goal forall a, (a||negb a) || negb (a||negb a).
+  smt.
+Qed.
+
+(* Polarities *)
+
+Goal forall a b, andb (orb (negb (negb a)) b) (negb (orb a b)) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b, andb (orb a b) (andb (negb a) (negb b)) = false.
+Proof.
+  smt.
+Qed.
+
+(* Multiple negations *)
+
+Goal forall a, orb a (negb (negb (negb a))) = true.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c,
+  (a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal true.
+  smt.
+Qed.
+
+Goal negb false.
+  smt.
+Qed.
+
+ 
+Goal forall a, Bool.eqb a a.
+Proof.
+  smt.
+Qed.
+
+ 
+Goal forall (a:bool), a = a.
+  smt.
+Qed.
+
+Goal (false || true) && false = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal negb true = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal false = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall x y, Bool.eqb (xorb x y) ((x && (negb y)) || ((negb x) && y)).
+Proof.
+  smt.
+Qed.
+
+
+Goal forall x y, Bool.eqb (x --> y) ((x && y) || (negb x)).
+Proof.
+  smt.
+Qed.
+
+
+Goal forall x y z, Bool.eqb (ifb x y z) ((x && y) || ((negb x) && z)).
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c, (((a && b) || (b && c)) && (negb b)) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall a, ((a || a) && (negb a)) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a, (negb (a || (negb a))) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c,
+  (a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a) = false.
+Proof.
+  smt.
+Qed.
+
+
+(** The same goal above with a, b and c are concrete terms *)
+Goal forall i j k,
+  let a := i == j in
+  let b := j == k in
+  let c := k == i in
+  (a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c d, ((a && b) && (c || d) && (negb (c || (a && b && d)))) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c d, (a && b && c && ((negb a) || (negb b) || d) && ((negb d) || (negb c))) = false.
+Proof.
+  smt.
+Qed.
+
+
+(* Pigeon hole: 4 holes, 5 pigeons *)
+Goal forall x11 x12 x13 x14 x15 x21 x22 x23 x24 x25 x31 x32 x33 x34 x35 x41 x42 x43 x44 x45, (
+  (orb (negb x11) (negb x21)) &&
+  (orb (negb x11) (negb x31)) &&
+  (orb (negb x11) (negb x41)) &&
+  (orb (negb x21) (negb x31)) &&
+  (orb (negb x21) (negb x41)) &&
+  (orb (negb x31) (negb x41)) &&
+
+  (orb (negb x12) (negb x22)) &&
+  (orb (negb x12) (negb x32)) &&
+  (orb (negb x12) (negb x42)) &&
+  (orb (negb x22) (negb x32)) &&
+  (orb (negb x22) (negb x42)) &&
+  (orb (negb x32) (negb x42)) &&
+
+  (orb (negb x13) (negb x23)) &&
+  (orb (negb x13) (negb x33)) &&
+  (orb (negb x13) (negb x43)) &&
+  (orb (negb x23) (negb x33)) &&
+  (orb (negb x23) (negb x43)) &&
+  (orb (negb x33) (negb x43)) &&
+
+  (orb (negb x14) (negb x24)) &&
+  (orb (negb x14) (negb x34)) &&
+  (orb (negb x14) (negb x44)) &&
+  (orb (negb x24) (negb x34)) &&
+  (orb (negb x24) (negb x44)) &&
+  (orb (negb x34) (negb x44)) &&
+
+  (orb (negb x15) (negb x25)) &&
+  (orb (negb x15) (negb x35)) &&
+  (orb (negb x15) (negb x45)) &&
+  (orb (negb x25) (negb x35)) &&
+  (orb (negb x25) (negb x45)) &&
+  (orb (negb x35) (negb x45)) &&
+
+
+  (orb (negb x11) (negb x12)) &&
+  (orb (negb x11) (negb x13)) &&
+  (orb (negb x11) (negb x14)) &&
+  (orb (negb x11) (negb x15)) &&
+  (orb (negb x12) (negb x13)) &&
+  (orb (negb x12) (negb x14)) &&
+  (orb (negb x12) (negb x15)) &&
+  (orb (negb x13) (negb x14)) &&
+  (orb (negb x13) (negb x15)) &&
+  (orb (negb x14) (negb x15)) &&
+
+  (orb (negb x21) (negb x22)) &&
+  (orb (negb x21) (negb x23)) &&
+  (orb (negb x21) (negb x24)) &&
+  (orb (negb x21) (negb x25)) &&
+  (orb (negb x22) (negb x23)) &&
+  (orb (negb x22) (negb x24)) &&
+  (orb (negb x22) (negb x25)) &&
+  (orb (negb x23) (negb x24)) &&
+  (orb (negb x23) (negb x25)) &&
+  (orb (negb x24) (negb x25)) &&
+
+  (orb (negb x31) (negb x32)) &&
+  (orb (negb x31) (negb x33)) &&
+  (orb (negb x31) (negb x34)) &&
+  (orb (negb x31) (negb x35)) &&
+  (orb (negb x32) (negb x33)) &&
+  (orb (negb x32) (negb x34)) &&
+  (orb (negb x32) (negb x35)) &&
+  (orb (negb x33) (negb x34)) &&
+  (orb (negb x33) (negb x35)) &&
+  (orb (negb x34) (negb x35)) &&
+
+  (orb (negb x41) (negb x42)) &&
+  (orb (negb x41) (negb x43)) &&
+  (orb (negb x41) (negb x44)) &&
+  (orb (negb x41) (negb x45)) &&
+  (orb (negb x42) (negb x43)) &&
+  (orb (negb x42) (negb x44)) &&
+  (orb (negb x42) (negb x45)) &&
+  (orb (negb x43) (negb x44)) &&
+  (orb (negb x43) (negb x45)) &&
+  (orb (negb x44) (negb x45)) &&
+
+
+  (orb (orb (orb x11 x21) x31) x41) &&
+  (orb (orb (orb x12 x22) x32) x42) &&
+  (orb (orb (orb x13 x23) x33) x43) &&
+  (orb (orb (orb x14 x24) x34) x44) &&
+  (orb (orb (orb x15 x25) x35) x45)) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c f p, ((Z.eqb a c) && (Z.eqb b c) && ((negb (Z.eqb (f a) (f b))) || ((p a) && (negb (p b))))) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall a b c (p : Z -> bool), ((((p a) && (p b)) || ((p b) && (p c))) && (negb (p b))) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall x y z f, ((Z.eqb x y) && (Z.eqb y z) && (negb (Z.eqb (f x) (f z)))) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall x y z f, ((negb (Z.eqb (f x) (f y))) && (Z.eqb y z) && (Z.eqb (f x) (f (f z))) && (Z.eqb x y)) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall a b c d e f, ((Z.eqb a b) && (Z.eqb b c) && (Z.eqb c d) && (Z.eqb c e) && (Z.eqb e f) && (negb (Z.eqb a f))) = false.
+Proof.
+  smt.
+Qed.
+
+
+
+Goal forall x y z, ((x <=? 3) && ((y <=? 7) || (z <=? 9))) -->
+  ((x + y <=? 10) || (x + z <=? 12)) = true.
+Proof.
+  smt.
+Qed.
+
+Goal forall x, (Z.eqb (x - 3) 7)  -->  (x >=? 10) = true.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall x y, (x >? y) --> (y + 1 <=? x) = true.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall x y, Bool.eqb (x <? y) (x <=? y - 1) = true.
+Proof.
+  smt.
+Qed.
+
+Goal forall x y, ((x + y <=? - (3)) && (y >=? 0) 
+        || (x <=? - (3))) && (x >=? 0) = false. 
+ Proof. 
+   smt.
+ Qed. 
+
+Goal forall x, (andb ((x - 3) <=? 7) (7 <=? (x - 3))) --> (x >=? 10) = true.
+Proof.
+  smt.
+Qed.
+
+Goal forall x, (Z.eqb (x - 3) 7) --> (10 <=? x) = true.
+Proof.
+  smt.
+Qed.
+
+
+(* More general examples *)
+Goal forall a b c, ((a || b || c) && ((negb a) || (negb b) || (negb c)) && ((negb a) || b) && ((negb b) || c) && ((negb c) || a)) = false.
+Proof.
+  smt.
+Qed.
+
+
+Goal forall (a b : Z) (P : Z -> bool) (f : Z -> Z),
+  (negb (Z.eqb (f a) b)) || (negb (P (f a))) || (P b).
+Proof.
+  smt.
+Qed.
+
+
+Goal forall b1 b2 x1 x2,
+  (ifb b1
+    (ifb b2 (Z.eqb (2*x1+1) (2*x2+1)) (Z.eqb (2*x1+1) (2*x2)))
+    (ifb b2 (Z.eqb (2*x1) (2*x2+1)) (Z.eqb (2*x1) (2*x2)))) -->
+  ((b1 --> b2) && (b2 --> b1) && (Z.eqb x1 x2)).
+Proof.
+  smt.
+Qed.
+
+
+(* With let ... in ... *)
+Goal forall b,
+  let a := b in
+  a && (negb a) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall b,
+  let a := b in
+  a || (negb a) = true.
+Proof.
+  smt.
+Qed.
+
+(* With concrete terms *)
+Goal forall i j,
+  let a := i == j in
+  a && (negb a) = false.
+Proof.
+  smt.
+Qed.
+
+Goal forall i j,
+  let a := i == j in
+  a || (negb a) = true.
+Proof.
+  smt.
+Qed.
+
+
+(* Congruence in which some premises are REFL *)
+Goal forall (f:Z -> Z -> Z) x y z,
+  (Z.eqb x y) --> (Z.eqb (f z x) (f z y)).
+Proof.
+  smt.
+Qed.
+
+Goal forall (f:Z -> Z -> Z) x y z,
+  (x = y) -> (f z x) = (f z y).
+Proof.
+  smt.
+Qed.
+
+Goal forall (P:Z -> Z -> bool) x y z,
+  (Z.eqb x y) --> ((P z x) --> (P z y)).
+Proof.
+  smt.
+Qed.
+
+
+End PR.
+
+
+Section A_BV_EUF_LIA_PR.
+  Import BVList.BITVECTOR_LIST FArray.
+
+  Local Open Scope farray_scope.
+  Local Open Scope bv_scope. 
+
+  (* TODO *)
+  (* Goal forall (bv1 bv2 : bitvector 4) *)
+  (*        (a b c d : farray (bitvector 4) Z), *)
+  (*     bv1 = #b|0|0|0|0|  -> *)
+  (*     bv2 = #b|1|0|0|0|  -> *)
+  (*     c = b[bv1 <- 4]  -> *)
+  (*     d = b[bv1 <- 4][bv2 <- 4]  -> *)
+  (*     a = d[bv2 <- b[bv2]]  -> *)
+  (*     a = c. *)
+  (* Proof. *)
+  (*   smt. *)
+  (* Qed. *)
+
+  (* TODO *)
+  (* Goal forall (bv1 bv2 : bitvector 4) *)
+  (*        (a b c d : farray (bitvector 4) Z), *)
+  (*     bv1 = #b|0|0|0|0|  /\ *)
+  (*     bv2 = #b|1|0|0|0|  /\ *)
+  (*     c = b[bv1 <- 4]  /\ *)
+  (*     d = b[bv1 <- 4][bv2 <- 4]  /\ *)
+  (*     a = d[bv2 <- b[bv2]]  -> *)
+  (*     a = c. *)
+  (* Proof. *)
+  (*   smt. *)
+  (* Qed. *)
+
+  (** the example in the CAV paper *)
+  Goal forall (a b: farray Z Z) (v w x y: Z)
+              (r s: bitvector 4)
+              (f: Z -> Z)
+              (g: farray Z Z -> Z)
+              (h: bitvector 4 -> Z),
+              a[x <- v] = b /\ a[y <- w] = b ->
+              r = s /\ h r = v /\ h s = y ->
+              v < x + 1 /\ v > x - 1 ->
+              f (h r) = f (h s) \/ g a = g b.
+  Proof.
+    smt. (** "cvc4. verit." also solves the goal *)
+  Qed.
+
+  (** the example in the FroCoS paper *)
+  Goal forall (a b: farray Z Z) (v w x y z t: Z)
+              (r s: bitvector 4)
+              (f: Z -> Z)
+              (g: farray Z Z -> Z)
+              (h: bitvector 4 -> Z),
+              a[x <- v] = b /\ a[y <- w] = b ->
+              a[z <- w] = b /\ a[t <- v] = b ->
+              r = s -> v < x + 10 /\ v > x - 5 ->
+              ~ (g a = g b) \/ f (h r) = f (h s).
+  Proof.
+    smt. (** "cvc4. verit." also solves the goal *)
+  Qed.
+
+
+  Goal forall (a b: farray (bitvector 4) Z)
+         (x y: bitvector 4)
+         (v: Z),
+      b[bv_add y x <- v] = a /\
+      b = a[bv_add x y <- v]  ->
+      a = b.
+  Proof.
+    smt.
+    (* CVC4 preprocessing hole on BV *)
+    replace (bv_add x y) with (bv_add y x)
+      by apply bv_eq_reflect, bv_add_comm.
+    verit.
+  Qed.
+
+  Goal forall (a:farray Z Z), a = a.
+  Proof.
+    smt.
+  Qed.
+
+  (* TODO: will be ok when symmetry of equality is back for verit *)
+  (* Goal forall (a b: farray Z Z), a = b <->  b = a. *)
+  (* Proof.  *)
+  (*   smt. *)
+  (* Qed. *)
+
+End A_BV_EUF_LIA_PR.
diff --git a/unit-tests/Tests_verit.v b/unit-tests/Tests_verit.v
index ba69110..cfb8f16 100644
--- a/unit-tests/Tests_verit.v
+++ b/unit-tests/Tests_verit.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Add Rec LoadPath "../src" as SMTCoq.
 
 Require Import SMTCoq.
@@ -34,8 +46,14 @@ Lemma fun_const2 :
     (forall x, g (f x) 2) -> g (f 3) 2.
 Proof.
   intros f g Hf.
-  verit_base Hf; vauto.
+  verit_bool_base Hf; vauto.
 Qed.
+(*
+Toplevel input, characters 916-942:
+ Warning: Bytecode compiler failed, falling back to standard conversion
+ [bytecode-compiler-failed,bytecode-compiler]
+*)
+
 
 (* veriT vernacular commands *)
 
@@ -143,9 +161,12 @@ Section Checker_Lia3.
   Verit_Checker "lia3.smt2" "lia3.vtlog".
 End Checker_Lia3.
 
+(* TODO: it does not go through anymore
+   Anomaly: File "trace/smtCommands.ml", line 102, characters 12-18: Assertion failed.
 Section Checker_Lia4.
   Verit_Checker "lia4.smt2" "lia4.vtlog".
 End Checker_Lia4.
+*)
 
 Section Checker_Lia5.
   Verit_Checker "lia5.smt2" "lia5.vtlog".
@@ -180,6 +201,14 @@ Section Checker_Lia5_holes.
 End Checker_Lia5_holes.
 *)
 
+Section Checker_Bv1.
+  Verit_Checker "bv1.smt2" "bv1.log".
+End Checker_Bv1.
+
+Section Checker_Bv2.
+  Verit_Checker "bv2.smt2" "bv2.log".
+End Checker_Bv2.
+
 
 Section Sat0.
   Parse_certif_verit t_i0 t_func0 t_atom0 t_form0 root0 used_roots0 trace0 "sat0.smt2" "sat0.vtlog".
@@ -301,10 +330,12 @@ Section Lia3.
   Compute @Euf_Checker.checker t_i_lia3 t_func_lia3 t_atom_lia3 t_form_lia3 root_lia3 used_roots_lia3 trace_lia3.
 End Lia3.
 
+(* TODO: it does not go through anymore
 Section Lia4.
   Parse_certif_verit t_i_lia4 t_func_lia4 t_atom_lia4 t_form_lia4 root_lia4 used_roots_lia4 trace_lia4 "lia4.smt2" "lia4.vtlog".
   Compute @Euf_Checker.checker t_i_lia4 t_func_lia4 t_atom_lia4 t_form_lia4 root_lia4 used_roots_lia4 trace_lia4.
 End Lia4.
+*)
 
 Section Lia5.
   Parse_certif_verit t_i_lia5 t_func_lia5 t_atom_lia5 t_form_lia5 root_lia5 used_roots_lia5 trace_lia5 "lia5.smt2" "lia5.vtlog".
@@ -346,6 +377,16 @@ Section Lia5_holes.
 End Lia5_holes.
 *)
 
+Section Bv1.
+  Parse_certif_verit t_i_bv1 t_func_bv1 t_atom_bv1 t_form_bv1 root_bv1 used_roots_bv1 trace_bv1 "bv1.smt2" "bv1.log".
+  Compute @Euf_Checker.checker t_i_bv1 t_func_bv1 t_atom_bv1 t_form_bv1 root_bv1 used_roots_bv1 trace_bv1.
+End Bv1.
+
+Section Bv2.
+  Parse_certif_verit t_i_bv2 t_func_bv2 t_atom_bv2 t_form_bv2 root_bv2 used_roots_bv2 trace_bv2 "bv2.smt2" "bv2.log".
+  Compute @Euf_Checker.checker t_i_bv2 t_func_bv2 t_atom_bv2 t_form_bv2 root_bv2 used_roots_bv2 trace_bv2.
+End Bv2.
+
 
 Section Theorem_Sat0.
   Time Verit_Theorem theorem_sat0 "sat0.smt2" "sat0.vtlog".
@@ -443,9 +484,11 @@ Section Theorem_Lia3.
   Time Verit_Theorem theorem_lia3 "lia3.smt2" "lia3.vtlog".
 End Theorem_Lia3.
 
+(* TODO: it does not go through anymore
 Section Theorem_Lia4.
   Time Verit_Theorem theorem_lia4 "lia4.smt2" "lia4.vtlog".
 End Theorem_Lia4.
+*)
 
 Section Theorem_Lia5.
   Time Verit_Theorem theorem_lia5 "lia5.smt2" "lia5.vtlog".
@@ -482,6 +525,14 @@ End Theorem_Lia5_holes.
 Check theorem_lia5_holes.
 *)
 
+Section Theorem_Bv1.
+  Time Verit_Theorem theorem_bv1 "bv1.smt2" "bv1.log".
+End Theorem_Bv1.
+
+Section Theorem_Bv2.
+  Time Verit_Theorem theorem_bv2 "bv2.smt2" "bv2.log".
+End Theorem_Bv2.
+
 
 (* verit tactic *)
 
@@ -939,18 +990,20 @@ Proof.
   verit.
 Qed.
 
+(* TODO: fails with native-coq: "compilation error"
 Goal forall (i j:int),
     (i == j) && (negb (i == j)) = false.
 Proof.
   verit.
-  econstructor; eexact Int63Properties.reflect_eqb.
+  exact int63_compdec.
 Qed.
 
 Goal forall i j, (i == j) || (negb (i == j)).
 Proof.
   verit.
-  econstructor; eexact Int63Properties.reflect_eqb.
+  exact int63_compdec.
 Qed.
+*)
 
 
 (* Congruence in which some premises are REFL *)
@@ -968,103 +1021,100 @@ Proof.
 Qed.
 
 
-(*
-   Local Variables:
-   coq-load-path: ((rec "../src" "SMTCoq"))
-   End:
-*)
-
-(* Some examples of using verit with lemmas. Use <verit_base H1 .. Hn; vauto>
+(* Some examples of using verit with lemmas. Use <verit_bool_base H1 .. Hn; vauto>
    to temporarily add the lemmas H1 .. Hn to the verit environment. *)
 
 Lemma taut1 :
   forall f, f 2 =? 0 -> f 2 =? 0.
-Proof. intros f p. verit_base p; vauto. Qed.
+Proof. intros f p. verit_bool_base p; vauto. Qed.
 
 Lemma taut2 :
   forall f, 0 =? f 2 -> 0 =?f 2.
-Proof. intros f p. verit_base p; vauto. Qed.
+Proof. intros f p. verit_bool_base p; vauto. Qed.
 
 Lemma taut3 :
   forall f, f 2 =? 0 -> f 3 =? 5 -> f 2 =? 0.
-Proof. intros f p1 p2. verit_base p1 p2; vauto. Qed.
+Proof. intros f p1 p2. verit_bool_base p1 p2; vauto. Qed.
 
 Lemma taut4 :
   forall f, f 3 =? 5 -> f 2 =? 0 -> f 2 =? 0.
-Proof. intros f p1 p2. verit_base p1 p2; vauto. Qed.
+Proof. intros f p1 p2. verit_bool_base p1 p2; vauto. Qed.
+
+(* Lemma test_eq_sym a b : implb (a =? b) (b =? a). *)
+(* Proof. verit. *)
 
-Lemma taut5 :
-  forall f, 0 =? f 2 -> f 2 =? 0.
-Proof. intros f p. verit_base p; vauto. Qed.
+(* Lemma taut5 : *)
+(*   forall f, 0 =? f 2 -> f 2 =? 0. *)
+(* Proof. intros f p. verit_bool_base p; vauto. Qed. *)
 
 Lemma fun_const_Z :
   forall f , (forall x, f x =? 2) ->
              f 3 =? 2.
-Proof. intros f Hf. verit_base Hf; vauto. Qed.
+Proof. intros f Hf. verit_bool_base Hf; vauto. Qed.
 
 Lemma lid (A : bool) :  A -> A.
-Proof. intro a. verit_base a; vauto. Qed.
+Proof. intro a. verit_bool_base a; vauto. Qed.
 
 Lemma lpartial_id A :
   (xorb A A) -> (xorb A A).
-Proof. intro xa. verit_base xa; vauto. Qed.
+Proof. intro xa. verit_bool_base xa; vauto. Qed.
 
 Lemma llia1 X Y Z:
   (X <=? 3) && ((Y <=? 7) || (Z <=? 9)) ->
   (X + Y <=? 10) || (X + Z <=? 12).
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma llia2 X:
   X - 3 =? 7 -> X >=? 10.
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma llia3 X Y:
   X >? Y -> Y + 1 <=? X.
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma llia6 X:
   andb ((X - 3) <=? 7) (7 <=? (X - 3)) -> X >=? 10.
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma even_odd b1 b2 x1 x2:
   (ifb b1
        (ifb b2 (2*x1+1 =? 2*x2+1) (2*x1+1 =? 2*x2))
        (ifb b2 (2*x1 =? 2*x2+1) (2*x1 =? 2*x2))) ->
   ((implb b1 b2) && (implb b2 b1) && (x1 =? x2)).
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma lcongr1 (a b : Z) (P : Z -> bool) f:
   (f a =? b) -> (P (f a)) -> P b.
-Proof. intros eqfab pfa. verit_base eqfab pfa; vauto. Qed.
+Proof. intros eqfab pfa. verit_bool_base eqfab pfa; vauto. Qed.
 
 Lemma lcongr2 (f:Z -> Z -> Z) x y z:
   x =? y -> f z x =? f z y.
-Proof. intro p. verit_base p; vauto. Qed.
+Proof. intro p. verit_bool_base p; vauto. Qed.
 
 Lemma lcongr3 (P:Z -> Z -> bool) x y z:
   x =? y -> P z x -> P z y.
-Proof. intros eqxy pzx. verit_base eqxy pzx; vauto. Qed.
+Proof. intros eqxy pzx. verit_bool_base eqxy pzx; vauto. Qed.
 
 Lemma test20 :  forall x, (forall a, a <? x) -> 0 <=? x = false.
-Proof. intros x H. verit_base H; vauto. Qed.
+Proof. intros x H. verit_bool_base H; vauto. Qed.
 
 Lemma test21 : forall x, (forall a, negb (x <=? a)) -> negb (0 <=? x).
-Proof. intros x H. verit_base H; vauto. Qed.
+Proof. intros x H. verit_bool_base H; vauto. Qed.
 
-Lemma un_menteur (a b c d : Z) dit:
-  dit a =? c ->
-  dit b =? d ->
-  (d =? a) || (b =? c) ->
-  (a =? c) || (a =? d) ->
-  (b =? c) || (b =? d) ->
-  a =? d.
-Proof. intros H1 H2 H3 H4 H5. verit_base H1 H2 H3 H4 H5; vauto. Qed.
+(* Lemma un_menteur (a b c d : Z) dit: *)
+(*   dit a =? c -> *)
+(*   dit b =? d -> *)
+(*   (d =? a) || (b =? c) -> *)
+(*   (a =? c) || (a =? d) -> *)
+(*   (b =? c) || (b =? d) -> *)
+(*   a =? d. *)
+(* Proof. intros H1 H2 H3 H4 H5. verit_bool_base H1 H2 H3 H4 H5; vauto. Qed. *)
 
 Lemma const_fun_is_eq_val_0 :
   forall f : Z -> Z,
     (forall a b, f a =? f b) ->
     forall x, f x =? f 0.
-Proof. intros f Hf. verit_base Hf; vauto. Qed.
+Proof. intros f Hf. verit_bool_base Hf; vauto. Qed.
 
 (* You can use <Add_lemmas H1 .. Hn> to permanently add the lemmas H1 .. Hn to
    the environment. If you did so in a section then, at the end of the section,
@@ -1143,7 +1193,7 @@ End mult3.
 (*   Hypothesis mult_Sx : forall x y, mult (x+1) y =? mult x y + y. *)
 
 (*   Lemma mult_1_x : forall x, mult 1 x =? x. *)
-(*   Proof. verit_base mult_0 mult_Sx. *)
+(*   Proof. verit_bool_base mult_0 mult_Sx. *)
 (*   Qed. *)
 (* End mult. *)
 
@@ -1163,8 +1213,7 @@ End implicit_transform.
 
 Section list.
   Variable Zlist : Type.
-  Hypothesis dec_Zlist :
-    {eq : Zlist -> Zlist -> bool & forall x y : Zlist, reflect (x = y) (eq x y)}.
+  Hypothesis dec_Zlist : CompDec Zlist.
   Variable nil : Zlist.
   Variable cons : Z -> Zlist -> Zlist.
   Variable inlist : Z -> Zlist -> bool.
@@ -1276,15 +1325,15 @@ Section group.
 
   Lemma unique_identity e':
     (forall z, op e' z =? z) -> e' =? e.
-  Proof. intros pe'. verit_base pe'; vauto. Qed.
+  Proof. intros pe'. verit_bool_base pe'; vauto. Qed.
 
   Lemma simplification_right x1 x2 y:
       op x1 y =? op x2 y -> x1 =? x2.
-  Proof. intro H. verit_base H; vauto. Qed.
+  Proof. intro H. verit_bool_base H; vauto. Qed.
 
   Lemma simplification_left x1 x2 y:
       op y x1 =? op y x2 -> x1 =? x2.
-  Proof. intro H. verit_base H; vauto. Qed.
+  Proof. intro H. verit_bool_base H; vauto. Qed.
 
   Clear_lemmas.
 End group.
diff --git a/unit-tests/Tests_zchaff.v b/unit-tests/Tests_zchaff.v
index 28251f8..87d6db2 100644
--- a/unit-tests/Tests_zchaff.v
+++ b/unit-tests/Tests_zchaff.v
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
 Add Rec LoadPath "../src" as SMTCoq.
 
 Require Import SMTCoq.
diff --git a/unit-tests/bv1.log b/unit-tests/bv1.log
new file mode 100644
index 0000000..fc101e2
--- /dev/null
+++ b/unit-tests/bv1.log
@@ -0,0 +1,12 @@
+1:(input ((not #1:(= a a))))
+2:(bbvar (#2:(bbT a [#7:(bitof 0 a) #8:(bitof 1 a)])))
+3:(bbeq (#3:(= #1 #4:(and #5:(= #7 #7) #6:(= #8 #8)))) 2 2)
+4:(equiv2 (#1 (not #4)) 3)
+5:(resolution ((not #4)) 1 4)
+6:(not_and ((not #5) (not #6)) 5)
+7:(equiv_neg1 (#5 (not #7)))
+8:(equiv_neg2 (#5 #7))
+9:(resolution ((not #6)) 7 8 6)
+10:(equiv_neg1 (#6 (not #8)))
+11:(equiv_neg2 (#6 #8))
+12:(resolution () 10 11 9)
diff --git a/unit-tests/bv1.smt2 b/unit-tests/bv1.smt2
new file mode 100644
index 0000000..c23b151
--- /dev/null
+++ b/unit-tests/bv1.smt2
@@ -0,0 +1,5 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 2))
+(assert (not (= a a)))
+(check-sat)
+(exit)
diff --git a/unit-tests/bv2.log b/unit-tests/bv2.log
new file mode 100644
index 0000000..5bcd227
--- /dev/null
+++ b/unit-tests/bv2.log
@@ -0,0 +1,15 @@
+1:(input ((not #1:(= a a))))
+2:(bbvar (#2:(bbT a [#7:(bitof 0 a) #8:(bitof 1 a) #9:(bitof 2 a)])))
+3:(bbeq (#3:(= #1 #4:(and #5:(= #7 #7) #6:(= #8 #8) #10:(= #9 #9)))) 2 2)
+4:(equiv2 (#1 (not #4)) 3)
+5:(resolution ((not #4)) 1 4)
+6:(not_and ((not #5) (not #6) (not #10)) 5)
+7:(equiv_neg1 (#5 (not #7)))
+8:(equiv_neg2 (#5 #7))
+9:(resolution ((not #6) (not #10)) 7 8 6)
+10:(equiv_neg1 (#6 (not #8)))
+11:(equiv_neg2 (#6 #8))
+12:(resolution ((not #10)) 10 11 9)
+13:(equiv_neg1 (#10 (not #9)))
+14:(equiv_neg2 (#10 #9))
+15:(resolution () 13 14 12)
diff --git a/unit-tests/bv2.smt2 b/unit-tests/bv2.smt2
new file mode 100644
index 0000000..49156c7
--- /dev/null
+++ b/unit-tests/bv2.smt2
@@ -0,0 +1,5 @@
+(set-logic QF_BV)
+(declare-fun a () (_ BitVec 3))
+(assert (not (= a a)))
+(check-sat)
+(exit)
diff --git a/unit-tests/demo_lfsc_bool.v b/unit-tests/demo_lfsc_bool.v
new file mode 100644
index 0000000..d89954f
--- /dev/null
+++ b/unit-tests/demo_lfsc_bool.v
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import SMTCoq.
+Require Import Bool PArray Int63 List ZArith BVList Logic.
+Import ListNotations.
+Local Open Scope list_scope.
+Local Open Scope int63_scope.
+Local Open Scope Z_scope.
+Local Open Scope bv_scope.
+
+
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+
+
+Import BVList.BITVECTOR_LIST. 
+Require Import FArray.
+
+Section BV.
+
+  Import BVList.BITVECTOR_LIST.
+
+  Local Open Scope bv_scope.
+
+  Goal forall (bv1 bv2 bv3 bv4: bitvector 4),
+      bv_eq #b|0|0|0|0| bv1 &&
+      bv_eq #b|1|0|0|0| bv2 &&
+      bv_eq #b|1|1|0|0| bv3 -->
+      bv_eq #b|1|1|1|0| bv4 -->
+      bv_ult bv1 bv2  || bv_ult bv3 bv1 --> bv_ult bv1 bv3 --> bv_ult bv1 bv4 || bv_ult bv4 bv1.
+  Proof.
+     smt.
+  Qed.
+
+  Goal forall (a: bitvector 32), bv_eq a a.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (bv1 bv2: bitvector 4),
+       (Bool.eqb (bv_eq bv1 bv2) (bv_eq bv2 bv1)).
+  Proof.
+     smt.
+  Qed.
+
+  Goal forall (bv1 bv2 bv3 bv4: bitvector 4),
+      bv_eq #b|0|0|0|0| bv1 &&
+      bv_eq #b|1|0|0|0| bv2 &&
+      bv_eq #b|1|1|0|0| bv3 -->
+      bv_eq #b|1|1|1|0| bv4 -->
+      bv_ult bv1 bv2 || bv_ult bv3 bv1 && bv_ult bv3 bv4.
+  Proof.
+     smt.
+  Qed.
+
+  Goal forall (a b c: bitvector 4),
+                                 (bv_eq c (bv_and a b))  -->
+                                 (bv_eq (bv_and (bv_and c a) b) c).
+  Proof.
+     smt.
+  Qed.
+
+End BV.
+
+Section Arrays.
+  Import BVList.BITVECTOR_LIST.
+  Import FArray.
+
+  Local Open Scope farray_scope.
+  Local Open Scope bv_scope.
+
+  Goal forall (a:farray Z Z), equal a a.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z), Bool.eqb (equal a b) (equal b a).
+  Proof. 
+    smt.
+  Qed.
+
+  Goal forall (a b: farray (bitvector 8) (bitvector 8)), Bool.eqb (equal a b) (equal b a).
+  Proof. 
+    smt.
+  Qed.
+
+  Goal forall (a b c d: farray Z Z),
+      equal b[0 <- 4] c -->
+      equal d b[0 <- 4][1 <- 4]  &&
+      equal a d[1 <- b[1]]  -->
+      equal a c.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (bv1 bv2 : bitvector 4)
+         (a b c d : farray (bitvector 4) Z),
+      bv_eq #b|0|0|0|0| bv1  -->
+      bv_eq #b|1|0|0|0| bv2  -->
+      equal c b[bv1 <- 4] -->
+      equal d b[bv1 <- 4][bv2 <- 4] -->
+      equal a d[bv2 <- b[bv2]] -->
+      equal a c.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z)
+         (v w x y: Z)
+         (g: farray Z Z -> Z)
+         (f: Z -> Z),
+         (equal a[x <- v] b) && (equal a[y <- w] b) --> (Z.eqb (f x) (f y)) || (Z.eqb (g a) (g b)).
+  Proof.
+    smt.
+  Qed.
+
+Goal forall (a b: farray Z Z) i,
+      Z.eqb (select (store (store (store a i 3%Z) 1%Z (select (store b i 4) i)) 2%Z 2%Z) 1%Z) 4.
+Proof.
+    smt.
+    rewrite read_over_other_write; try easy.
+    rewrite read_over_same_write; try easy; try apply Z_compdec.
+    rewrite read_over_same_write; try easy; try apply Z_compdec.
+Qed.
+
+End Arrays.
+
+Section UF.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         Z.eqb y x --> Z.eqb (f x) (f y).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         Z.eqb (f x) (f y) --> Z.eqb (f y) (f x).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         Z.eqb (x + 1)  (y + 1) --> Z.eqb (f y) (f x).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         Z.eqb x (y + 1) --> Z.eqb (f y) (f (x - 1)).
+  Proof.
+    smt.
+  Qed.
+
+
+Goal forall (f:Z -> Z -> Z) x y z, (Z.eqb x y) --> Z.eqb (f z x) (f z y).
+Proof.
+  smt.
+Qed.
+
+End UF.
+
+
+Section LIA.
+
+  Goal forall (a b: Z), Bool.eqb (Z.eqb a b)  (Z.eqb b a).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: Z), (Z.eqb a a) && (Z.eqb b b).
+  Proof.
+    smt.
+  Qed.
+
+
+End LIA.
+
+
+
+
+
+
diff --git a/unit-tests/demo_lfsc_prop.v b/unit-tests/demo_lfsc_prop.v
new file mode 100644
index 0000000..00acfef
--- /dev/null
+++ b/unit-tests/demo_lfsc_prop.v
@@ -0,0 +1,233 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2019                                          *)
+(*                                                                        *)
+(*     See file "AUTHORS" for the list of authors                         *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import SMTCoq.
+Require Import Bool PArray Int63 List ZArith BVList Logic.
+Import ListNotations.
+Local Open Scope list_scope.
+Local Open Scope int63_scope.
+Local Open Scope Z_scope.
+Local Open Scope bv_scope.
+
+Import BVList.BITVECTOR_LIST. 
+Require Import FArray.
+
+
+Section BV.
+
+  Import BVList.BITVECTOR_LIST.
+
+  Local Open Scope bv_scope.
+
+  (*
+  (** cvc4 preprocesses the entire goal *)
+  Goal forall (a b c: bitvector 4), 
+      bv_mult a (bv_add b c) = bv_add (bv_mult a b) (bv_mult a c).
+  *)
+
+
+  Goal forall (a b: bitvector 8), 
+      #b|1|0|0|0|0|0|0|0| = a ->
+      #b|1|0|0|0|0|0|0|0| = b -> (bv_mult a b) =  #b|0|0|0|0|0|0|0|0|.
+  Proof.
+     smt.
+  Qed.
+
+(*
+
+Goal forall (a b: bitvector 32), a = b.
+Proof. smt. Fail Qed.
+
+*)
+
+
+  Goal forall (bv1 bv2 bv3 bv4: bitvector 4),
+      #b|0|0|0|0| = bv1 /\
+      #b|1|0|0|0| = bv2 /\
+      #b|1|1|0|0| = bv3 ->
+      #b|1|1|1|0| = bv4 ->
+      bv_ultP bv1 bv2  \/ bv_ultP bv3 bv1 -> bv_ultP bv1 bv3 -> bv_ultP bv1 bv4 \/ bv_ultP bv4 bv1.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a: bitvector 32), a = a.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (bv1 bv2: bitvector 4),
+       bv1 = bv2 <-> bv2 = bv1.
+  Proof.
+     smt.
+  Qed.
+
+  Goal forall (bv1 bv2 bv3 bv4: bitvector 4),
+      bv1 = #b|0|0|0|0| /\
+      bv2 = #b|1|0|0|0| /\
+      bv3 = #b|1|1|0|0| ->
+      bv4 = #b|1|1|1|0| ->
+      bv_ultP bv1 bv2 \/ bv_ultP bv3 bv1 /\ bv_ultP bv3 bv4.
+  Proof.
+     smt.
+  Qed.
+
+  Goal forall (a b c: bitvector 4),
+                                 (c = (bv_and a b)) ->
+                                 ((bv_and (bv_and c a) b) = c).
+  Proof.
+     smt.
+  Qed.
+
+
+
+End BV.
+
+Section Arrays.
+  Import BVList.BITVECTOR_LIST.
+  Import FArray.
+
+  Local Open Scope farray_scope.
+  Local Open Scope bv_scope.
+
+  Goal forall (a:farray Z Z), a = a.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z), a = b <->  b = a.
+  Proof. 
+    smt.
+  Qed.
+
+  Goal forall (a b: farray (bitvector 8) (bitvector 8)), a = b <->  b = a.
+  Proof. 
+    smt.
+  Qed.
+
+  Goal forall (a b c d: farray Z Z),
+      b[0 <- 4] = c ->
+      d = b[0 <- 4][1 <- 4]  /\
+      a = d[1 <- b[1]]  ->
+      a = c.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (bv1 bv2 : bitvector 4)
+         (a b c d : farray (bitvector 4) Z),
+      bv1 = #b|0|0|0|0|  ->
+      bv2 = #b|1|0|0|0|  ->
+      c = b[bv1 <- 4]  ->
+      d = b[bv1 <- 4][bv2 <- 4]  ->
+      a = d[bv2 <- b[bv2]]  ->
+      a = c.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z)
+         (v w x y: Z)
+         (g: farray Z Z -> Z)
+         (f: Z -> Z),
+         (a[x <- v] = b) /\ a[y <- w] = b  ->
+         (f x) = (f y) \/  (g a) = (g b).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: farray Z Z) i,
+      a[i <- 3][1 <- b[i <- 4][i]][2 <- 2][1] = 4.
+  Proof.
+    smt.
+    rewrite read_over_other_write; [ | easy].
+    rewrite read_over_write.
+    rewrite read_over_write; auto.
+Qed.
+
+End Arrays.
+
+Section UF.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         y = x -> (f x) = (f y).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         (f x) = (f y) -> (f y) = (f x).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         x + 1 = (y + 1) -> (f y) = (f x).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall
+         (x y: Z)
+         (f: Z -> Z),
+         x = (y + 1) -> (f y) = (f (x - 1)).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (f:Z -> Z -> Z) x y z, (x = y) -> (f z x) = (f z y).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (t: Type) (p: CompDec t) (x y: t), (x = y) <-> (x = y).
+  Proof.
+    smt.
+  Qed.
+
+End UF.
+
+
+Section LIA.
+
+   Goal forall a b, a < b -> a < (b + 10).
+   Proof. 
+     smt.
+   Qed.
+
+  Goal forall (a b: Z), a = b <-> b = a.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: Z), a = a /\ b = b.
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: Z), a < b -> a < (b + 1).
+  Proof.
+    smt.
+  Qed.
+
+  Goal forall (a b: Z), (a < b) -> (a + 2 < b + 3).
+  Proof.
+    smt.
+  Qed.
+
+End LIA.
diff --git a/unit-tests/ex1.lfsc b/unit-tests/ex1.lfsc
new file mode 100644
index 0000000..d96c5be
--- /dev/null
+++ b/unit-tests/ex1.lfsc
@@ -0,0 +1,23 @@
+unsat
+(check
+ ;; Declarations
+(% a (term Bool)
+(% b (term Bool)
+(% c (term Bool)
+(% A1 (th_holds (not (impl (and (impl (p_app a) (p_app b)) (impl (p_app b) (p_app c))) (impl (p_app a) (p_app c)))))
+ ;; Proof of empty clause follows
+(: (holds cln)
+ ;; Preprocessing 
+ ;; Clauses
+(decl_atom (p_app b) (\ var3 (\ atom3
+(decl_atom (p_app a) (\ var2 (\ atom2
+(satlem _ _ (asf _ _ _ atom3 (\ lit6 (ast _ _ _ atom2 (\ lit5 (clausify_false (contra _ (or_elim_1 _ _ (not_not_intro _ lit5) (impl_elim _ _ (and_elim_1 _ _ (and_elim_1 _ _ (not_impl_elim _ _ A1))))) lit6)))))) (\ pb2
+(decl_atom (p_app c) (\ var4 (\ atom4
+(satlem _ _ (asf _ _ _ atom4 (\ lit8 (ast _ _ _ atom3 (\ lit7 (clausify_false (contra _ (or_elim_1 _ _ (not_not_intro _ lit7) (impl_elim _ _ (and_elim_2 _ _ (and_elim_1 _ _ (not_impl_elim _ _ A1))))) lit8)))))) (\ pb3
+(satlem _ _ (asf _ _ _ atom2 (\ lit4 (clausify_false (contra _ (and_elim_1 _ _ (not_impl_elim _ _ (and_elim_2 _ _ (not_impl_elim _ _ A1)))) lit4)))) (\ pb4
+(satlem _ _ (ast _ _ _ atom4 (\ lit9 (clausify_false (contra _ lit9 (and_elim_2 _ _ (not_impl_elim _ _ (and_elim_2 _ _ (not_impl_elim _ _ A1)))))))) (\ pb5
+ ;; Theory Lemmas
+(satlem_simplify _ _ _ (Q _ _ pb2 pb4 var2) (\cl6
+(satlem_simplify _ _ _ (Q _ _ pb3 cl6 var3) (\cl7
+(satlem_simplify _ _ _ (Q _ _ pb5 cl7 var4) (\empty empty)))))))))))))))))))))))))))))
+;;
diff --git a/unit-tests/ex1.smt2 b/unit-tests/ex1.smt2
new file mode 100644
index 0000000..51685ed
--- /dev/null
+++ b/unit-tests/ex1.smt2
@@ -0,0 +1,11 @@
+(set-logic QF_SAT)
+(declare-fun a () Bool)
+(declare-fun b () Bool)
+(declare-fun c () Bool)
+
+(assert (not (=> (and (=> a b) (=> b c)) (=> a c))))
+
+(check-sat)
+
+(exit)
+
diff --git a/unit-tests/large1.v b/unit-tests/large1.v
new file mode 100644
index 0000000..ee3ef55
--- /dev/null
+++ b/unit-tests/large1.v
@@ -0,0 +1,88 @@
+Require Import SMTCoq.
+
+(* For Notations *)
+Import Bool PArray Int63 List ZArith FArray BVList.BITVECTOR_LIST.
+Import ListNotations.
+Open Scope list_scope.
+Open Scope farray_scope.
+Open Scope bv_scope.
+
+Infix "-->" := implb (at level 60, right associativity) : bool_scope.
+Notation "¬ x" := (negb x) (at level 30, right associativity): bool_scope.
+
+
+
+Goal forall
+    (a1 : (farray Z Z))
+    ( e1 : Z)
+    ( e10 : Z)
+    ( e2 : Z)
+    ( e3 : Z)
+    ( e4 : Z)
+    ( e5 : Z)
+    ( e6 : Z)
+    ( e7 : Z)
+    ( e8 : Z)
+    ( e9 : Z)
+    ( i1 : Z)
+    ( i10 : Z)
+    ( i2 : Z)
+    ( i3 : Z)
+    ( i4 : Z)
+    ( i5 : Z)
+    ( i6 : Z)
+    ( i7 : Z)
+    ( i8 : Z)
+    ( i9 : Z)
+    (sk : (farray Z Z) -> (farray Z Z) -> Z),
+    
+    negb (i9 =? i10) &&
+    negb (i8 =? i10) &&
+    negb (i8 =? i9) &&
+    negb (i7 =? i10) &&
+    negb (i7 =? i9) &&
+    negb (i7 =? i8) &&
+    negb (i6 =? i10) &&
+    negb (i6 =? i9) &&
+    negb (i6 =? i8) &&
+    negb (i6 =? i7) &&
+    negb (i5 =? i10) &&
+    negb (i5 =? i9) &&
+    negb (i5 =? i8) &&
+    negb (i5 =? i7) &&
+    negb (i5 =? i6) &&
+    negb (i4 =? i10) &&
+    negb (i4 =? i9) &&
+    negb (i4 =? i8) &&
+    negb (i4 =? i7) &&
+    negb (i4 =? i6) &&
+    negb (i4 =? i5) &&
+    negb (i3 =? i10) &&
+    negb (i3 =? i9) &&
+    negb (i3 =? i8) &&
+    negb (i3 =? i7) &&
+    negb (i3 =? i6) &&
+    negb (i3 =? i5) &&
+    negb (i3 =? i4) &&
+    negb (i2 =? i10) &&
+    negb (i2 =? i9) &&
+    negb (i2 =? i8) &&
+    negb (i2 =? i7) &&
+    negb (i2 =? i6) &&
+    negb (i2 =? i5) &&
+    negb (i2 =? i4) &&
+    negb (i2 =? i3) &&
+    negb (i1 =? i10) &&
+    negb (i1 =? i9) &&
+    negb (i1 =? i8) &&
+    negb (i1 =? i7) &&
+    negb (i1 =? i6) &&
+    negb (i1 =? i5) &&
+    negb (i1 =? i4) &&
+    negb (i1 =? i3) &&
+    negb (i1 =? i2) -->
+
+    ((select (store (store (store (store (store (store (store (store (store (store a1 i1 e1) i2 e2) i3 e3) i4 e4) i5 e5) i6 e6) i7 e7) i8 e8) i9 e9) i10 e10) (sk (store (store (store (store (store (store (store (store (store (store a1 i1 e1) i2 e2) i3 e3) i4 e4) i5 e5) i6 e6) i7 e7) i8 e8) i9 e9) i10 e10) (store (store (store (store (store (store (store (store (store (store a1 i9 e9) i3 e3) i5 e5) i4 e4) i6 e6) i1 e1) i10 e10) i2 e2) i8 e8) i7 e7))) =? (select (store (store (store (store (store (store (store (store (store (store a1 i9 e9) i3 e3) i5 e5) i4 e4) i6 e6) i1 e1) i10 e10) i2 e2) i8 e8) i7 e7) (sk (store (store (store (store (store (store (store (store (store (store a1 i1 e1) i2 e2) i3 e3) i4 e4) i5 e5) i6 e6) i7 e7) i8 e8) i9 e9) i10 e10) (store (store (store (store (store (store (store (store (store (store a1 i9 e9) i3 e3) i5 e5) i4 e4) i6 e6) i1 e1) i10 e10) i2 e2) i8 e8) i7 e7)))).
+Proof.
+  Time smt.
+Qed.
diff --git a/unit-tests/sat6.smt2 b/unit-tests/sat6.smt2
index acef584..3c73489 100644
--- a/unit-tests/sat6.smt2
+++ b/unit-tests/sat6.smt2
@@ -5,6 +5,6 @@
 (declare-fun d () Bool)
 (assert (and a b))
 (assert (or c d))
-(assert (not (or c (and a b d))))
+(assert (not (or c (and a (and b d)))))
 (check-sat)
 (exit)
author	ckeller <ckeller@users.noreply.github.com>	2019-01-28 23:19:12 +0100
committer	GitHub <noreply@github.com>	2019-01-28 23:19:12 +0100
commit	7021c53d4ecf97c82ccebb6bb45f5305d8b482ea (patch)
tree	ba7537e1e813cabf9ee0d910f845c71fa5f446e7
parent	36548d6634864a131cc83ce21491c797163de305 (diff)
download	smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.tar.gz smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.zip