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

1 files changed, 265 insertions, 172 deletions

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