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, 248 insertions, 48 deletions

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 =