Merge branch 'sail2' of https://github.com/rems-project/sail into sail2

76 files changed, 4203 insertions, 4211 deletions

diff --git a/src/META b/src/META
index 80194d98..60db4555 100644
--- a/src/META
+++ b/src/META
@@ -1,6 +1,6 @@
 # META file of package sail:
 description = "Sail is a language for describing the instruction-set architecture (ISA) semantics of processors."
-requires = "linenoise lem linksem omd base64 yojson"
+requires = "linenoise lem linksem omd base64 yojson pprint"
 version = "0.8"
 archive(byte) = "libsail.cma"
 archive(native) = "libsail.cmxa"
diff --git a/src/Makefile b/src/Makefile
index a002d4f3..00475654 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -72,7 +72,11 @@ all: sail lib doc
 full: sail lib doc
 
 ast.lem: ../language/sail.ott
-	ott -sort false -generate_aux_rules true -o ast.lem -picky_multiple_parses true ../language/sail.ott
+	ott -sort false -generate_aux_rules true -o ast.lem -picky_multiple_parses true  ../language/sail.ott
+
+sail_pp.ml: ../language/sail.ott
+	ott -sort false -generate_aux_rules true  -picky_multiple_parses true -ocaml_pp sail_pp.ml ../language/sail.ott
+
 
 jib.lem: ../language/jib.ott ast.lem
 	ott -sort false -generate_aux_rules true -o jib.lem -picky_multiple_parses true ../language/jib.ott
diff --git a/src/_tags b/src/_tags
index 41b443de..ce4d0270 100644
--- a/src/_tags
+++ b/src/_tags
@@ -2,17 +2,16 @@ true: -traverse, debug, use_menhir
 <**/parser.ml>: bin_annot, annot
 <**/*.ml> and not <**/parser.ml>: bin_annot, annot
 
-<sail.{byte,native}>: package(zarith), package(linksem), package(lem), package(omd), package(base64), use_pprint
-<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(omd), package(base64), package(yojson), use_pprint
+<sail.{byte,native}>: package(zarith), package(linksem), package(lem), package(omd), package(base64), package(pprint)
+<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(omd), package(base64), package(yojson), package(pprint)
 
 <isail.ml>: package(linenoise), package(yojson)
 <elf_loader.ml>: package(linksem)
 <latex.ml>: package(omd)
-<**/*.m{l,li}>: package(lem), package(base64)
+<**/*.m{l,li}>: package(lem), package(base64), package(pprint)
 
 <gen_lib>: include
 <jib>: include
-<pprint> or <pprint/src>: include
 
 # disable partial match and unused variable warnings
 <**/*.ml>: warn_y
diff --git a/src/ast_util.ml b/src/ast_util.ml
index 065b443c..e318a423 100644
--- a/src/ast_util.ml
+++ b/src/ast_util.ml
@@ -60,7 +60,7 @@ let lvar_typ = function
   | Local (_, typ) -> typ
   | Register (_, _, typ) -> typ
   | Enum typ -> typ
-  | Unbound -> failwith "No type for unbound variable"
+  | Unbound -> Reporting.unreachable Parse_ast.Unknown __POS__ "No type for unbound variable"
 
 let no_annot = (Parse_ast.Unknown, ())
 
@@ -847,7 +847,7 @@ and string_of_typ_aux = function
   | Typ_fn (typ_args, typ_ret, eff) ->
      "(" ^ string_of_list ", " string_of_typ typ_args ^ ") -> "
      ^ string_of_typ typ_ret ^ " effect " ^ string_of_effect eff
-  | Typ_bidir (typ1, typ2) -> string_of_typ typ1 ^ " <-> " ^ string_of_typ typ2
+  | Typ_bidir (typ1, typ2, eff) -> string_of_typ typ1 ^ " <-> " ^ string_of_typ typ2 ^ " effect " ^ string_of_effect eff
   | Typ_exist (kids, nc, typ) ->
      "{" ^ string_of_list " " string_of_kinded_id kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ ^ "}"
 and string_of_typ_arg = function
@@ -1170,10 +1170,12 @@ and typ_compare (Typ_aux (t1,_)) (Typ_aux (t2,_)) =
        | 0 -> effect_compare e1 e2
        | n -> n)
      | n -> n)
-  | Typ_bidir (t1,t2), Typ_bidir (t3,t4) ->
+  | Typ_bidir (t1,t2,e1), Typ_bidir (t3,t4,e2) ->
      (match typ_compare t1 t3 with
-     | 0 -> typ_compare t2 t3
-     | n -> n)
+      | 0 -> (match typ_compare t2 t4 with
+              | 0 -> effect_compare e1 e2
+              | n -> n)
+      | n -> n)
   | Typ_tup ts1, Typ_tup ts2 -> Util.compare_list typ_compare ts1 ts2
   | Typ_exist (ks1,nc1,t1), Typ_exist (ks2,nc2,t2) ->
      (match Util.compare_list KOpt.compare ks1 ks2 with
@@ -1247,7 +1249,7 @@ let rec lexp_to_exp (LEXP_aux (lexp_aux, annot) as le) =
   | LEXP_vector_concat [] -> rewrap (E_vector [])
   | LEXP_vector_concat (lexp :: lexps) ->
      List.fold_left (fun exp lexp -> rewrap (E_vector_append (exp, lexp_to_exp lexp))) (lexp_to_exp lexp) lexps
-  | LEXP_deref exp -> rewrap (E_app (mk_id "reg_deref", [exp]))
+  | LEXP_deref exp -> rewrap (E_app (mk_id "__deref", [exp]))
 
 let is_unit_typ = function
   | Typ_aux (Typ_id u, _) -> string_of_id u = "unit"
@@ -1378,7 +1380,7 @@ and kopts_of_typ (Typ_aux (t,_)) =
   | Typ_id _ -> KOptSet.empty
   | Typ_var kid -> KOptSet.singleton (mk_kopt K_type kid)
   | Typ_fn (ts, t, _) -> List.fold_left KOptSet.union (kopts_of_typ t) (List.map kopts_of_typ ts)
-  | Typ_bidir (t1, t2) -> KOptSet.union (kopts_of_typ t1) (kopts_of_typ t2)
+  | Typ_bidir (t1, t2, _) -> KOptSet.union (kopts_of_typ t1) (kopts_of_typ t2)
   | Typ_tup ts ->
      List.fold_left (fun s t -> KOptSet.union s (kopts_of_typ t))
        KOptSet.empty ts
@@ -1438,11 +1440,11 @@ and tyvars_of_typ (Typ_aux (t,_)) =
   | Typ_id _ -> KidSet.empty
   | Typ_var kid -> KidSet.singleton kid
   | Typ_fn (ts, t, _) -> List.fold_left KidSet.union (tyvars_of_typ t) (List.map tyvars_of_typ ts)
-  | Typ_bidir (t1, t2) -> KidSet.union (tyvars_of_typ t1) (tyvars_of_typ t2)
+  | Typ_bidir (t1, t2, _) -> KidSet.union (tyvars_of_typ t1) (tyvars_of_typ t2)
   | Typ_tup ts ->
      List.fold_left (fun s t -> KidSet.union s (tyvars_of_typ t))
        KidSet.empty ts
-  | Typ_app (_,tas) -> 
+  | Typ_app (_,tas) ->
      List.fold_left (fun s ta -> KidSet.union s (tyvars_of_typ_arg ta))
        KidSet.empty tas
   | Typ_exist (kids, nc, t) ->
@@ -1661,6 +1663,41 @@ let hex_to_bin hex =
   |> List.map Sail_lib.char_of_bit
   |> (fun bits -> String.init (List.length bits) (List.nth bits))
 
+let explode s =
+  let rec exp i l = if i < 0 then l else exp (i - 1) (s.[i] :: l) in
+  exp (String.length s - 1) []
+
+let vector_string_to_bit_list (L_aux (lit, l)) =
+
+  let hexchar_to_binlist = function
+    | '0' -> ['0';'0';'0';'0']
+    | '1' -> ['0';'0';'0';'1']
+    | '2' -> ['0';'0';'1';'0']
+    | '3' -> ['0';'0';'1';'1']
+    | '4' -> ['0';'1';'0';'0']
+    | '5' -> ['0';'1';'0';'1']
+    | '6' -> ['0';'1';'1';'0']
+    | '7' -> ['0';'1';'1';'1']
+    | '8' -> ['1';'0';'0';'0']
+    | '9' -> ['1';'0';'0';'1']
+    | 'A' -> ['1';'0';'1';'0']
+    | 'B' -> ['1';'0';'1';'1']
+    | 'C' -> ['1';'1';'0';'0']
+    | 'D' -> ['1';'1';'0';'1']
+    | 'E' -> ['1';'1';'1';'0']
+    | 'F' -> ['1';'1';'1';'1']
+    | _ -> raise (Reporting.err_unreachable l __POS__ "hexchar_to_binlist given unrecognized character") in
+
+  let s_bin = match lit with
+    | L_hex s_hex -> List.flatten (List.map hexchar_to_binlist (explode (String.uppercase_ascii s_hex)))
+    | L_bin s_bin -> explode s_bin
+    | _ -> raise (Reporting.err_unreachable l __POS__ "s_bin given non vector literal") in
+
+  List.map (function '0' -> L_aux (L_zero, gen_loc l)
+                   | '1' -> L_aux (L_one, gen_loc l)
+                   | _ -> raise (Reporting.err_unreachable (gen_loc l) __POS__ "binary had non-zero or one")) s_bin
+
+
 (* Functions for working with locations *)
 
 let locate_id f (Id_aux (name, l)) = Id_aux (name, f l)
@@ -1726,7 +1763,7 @@ and locate_typ f (Typ_aux (typ_aux, l)) =
     | Typ_var kid -> Typ_var (locate_kid f kid)
     | Typ_fn (arg_typs, ret_typ, effect) ->
        Typ_fn (List.map (locate_typ f) arg_typs, locate_typ f ret_typ, locate_effect f effect)
-    | Typ_bidir (typ1, typ2) -> Typ_bidir (locate_typ f typ1, locate_typ f typ2)
+    | Typ_bidir (typ1, typ2, effect) -> Typ_bidir (locate_typ f typ1, locate_typ f typ2, locate_effect f effect)
     | Typ_tup typs -> Typ_tup (List.map (locate_typ f) typs)
     | Typ_exist (kopts, constr, typ) -> Typ_exist (List.map (locate_kinded_id f) kopts, locate_nc f constr, locate_typ f typ)
     | Typ_app (id, typ_args) -> Typ_app (locate_id f id, List.map (locate_typ_arg f) typ_args)
@@ -1945,7 +1982,7 @@ and typ_subst_aux sv subst = function
      | _ -> Typ_var kid
      end
   | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst sv subst) arg_typs, typ_subst sv subst ret_typ, effs)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst sv subst typ1, typ_subst sv subst typ2)
+  | Typ_bidir (typ1, typ2, effs) -> Typ_bidir (typ_subst sv subst typ1, typ_subst sv subst typ2, effs)
   | Typ_tup typs -> Typ_tup (List.map (typ_subst sv subst) typs)
   | Typ_app (f, args) -> Typ_app (f, List.map (typ_arg_subst sv subst) args)
   | Typ_exist (kopts, nc, typ) when KidSet.mem sv (KidSet.of_list (List.map kopt_kid kopts)) ->
@@ -2043,7 +2080,7 @@ let subst_kids_nc, subst_kids_typ, subst_kids_typ_arg =
     | Typ_var _
       -> ty
     | Typ_fn (t1,t2,e) -> re (Typ_fn (List.map (s_styp substs) t1, s_styp substs t2,e))
-    | Typ_bidir (t1, t2) -> re (Typ_bidir (s_styp substs t1, s_styp substs t2))
+    | Typ_bidir (t1,t2,e) -> re (Typ_bidir (s_styp substs t1, s_styp substs t2,e))
     | Typ_tup ts -> re (Typ_tup (List.map (s_styp substs) ts))
     | Typ_app (id,tas) -> re (Typ_app (id,List.map (s_starg substs) tas))
     | Typ_exist (kopts,nc,t) ->
diff --git a/src/ast_util.mli b/src/ast_util.mli
index f6bf1fcc..6be8ca34 100644
--- a/src/ast_util.mli
+++ b/src/ast_util.mli
@@ -472,6 +472,8 @@ val subst : id -> 'a exp -> 'a exp -> 'a exp
 
 val hex_to_bin : string -> string
 
+val vector_string_to_bit_list : lit -> lit list
+
 (** {2 Manipulating locations} *)
 
 (** locate takes an expression and recursively sets the location in
diff --git a/src/constant_fold.ml b/src/constant_fold.ml
index 7a7067ef..35417ac8 100644
--- a/src/constant_fold.ml
+++ b/src/constant_fold.ml
@@ -91,7 +91,7 @@ and exp_of_value =
 let safe_primops =
   List.fold_left
     (fun m k -> StringMap.remove k m)
-    Value.primops
+    !Value.primops
     [ "print_endline";
       "prerr_endline";
       "putchar";
@@ -191,7 +191,17 @@ let rec run frame =
 let initial_state ast env =
   Interpreter.initial_state ~registers:false ast env safe_primops
 
-let rw_exp target ok not_ok istate =
+type fixed = {
+    registers: tannot exp Bindings.t;
+    fields: tannot exp Bindings.t Bindings.t;
+  }
+
+let no_fixed = {
+    registers = Bindings.empty;
+    fields = Bindings.empty;
+  }
+
+let rw_exp fixed target ok not_ok istate =
   let evaluate e_aux annot =
     let initial_monad = Interpreter.return (E_aux (e_aux, annot)) in
     try
@@ -219,6 +229,34 @@ let rw_exp target ok not_ok istate =
     | E_app (id, args) when fold_to_unit id ->
        ok (); E_aux (E_lit (L_aux (L_unit, fst annot)), annot)
 
+    | E_id id ->
+       begin match Bindings.find_opt id fixed.registers with
+       | Some exp ->
+          ok (); exp
+       | None ->
+          E_aux (e_aux, annot)
+       end
+
+    | E_field (E_aux (E_id id, _), field) ->
+       begin match Bindings.find_opt id fixed.fields with
+       | Some fields ->
+          begin match Bindings.find_opt field fields with
+          | Some exp ->
+             ok (); exp
+          | None ->
+             E_aux (e_aux, annot)
+          end
+       | None ->
+          E_aux (e_aux, annot)
+       end
+
+    (* Short-circuit boolean operators with constants *)
+    | E_app (id, [(E_aux (E_lit (L_aux (L_false, _)), _) as false_exp); _]) when string_of_id id = "and_bool" ->
+       ok (); false_exp
+
+    | E_app (id, [(E_aux (E_lit (L_aux (L_true, _)), _) as true_exp); _]) when string_of_id id = "or_bool" ->
+       ok (); true_exp
+
     | E_app (id, args) when List.for_all is_constant args ->
        let env = env_of_annot annot in
        (* We want to fold all primitive operations, but avoid folding
@@ -252,9 +290,9 @@ let rw_exp target ok not_ok istate =
   in
   fold_exp { id_exp_alg with e_aux = (fun (e_aux, annot) -> rw_funcall e_aux annot)}
 
-let rewrite_exp_once target = rw_exp target (fun _ -> ()) (fun _ -> ())
+let rewrite_exp_once target = rw_exp no_fixed target (fun _ -> ()) (fun _ -> ())
 
-let rec rewrite_constant_function_calls' target ast =
+let rec rewrite_constant_function_calls' fixed target ast =
   let rewrite_count = ref 0 in
   let ok () = incr rewrite_count in
   let not_ok () = decr rewrite_count in
@@ -262,16 +300,78 @@ let rec rewrite_constant_function_calls' target ast =
 
   let rw_defs = {
       rewriters_base with
-      rewrite_exp = (fun _ -> rw_exp target ok not_ok istate)
+      rewrite_exp = (fun _ -> rw_exp fixed target ok not_ok istate)
     } in
   let ast = rewrite_defs_base rw_defs ast in
   (* We keep iterating until we have no more re-writes to do *)
   if !rewrite_count > 0
-  then rewrite_constant_function_calls' target ast
+  then rewrite_constant_function_calls' fixed target ast
   else ast
 
-let rewrite_constant_function_calls target ast =
+let rewrite_constant_function_calls fixed target ast =
   if !optimize_constant_fold then
-    rewrite_constant_function_calls' target ast
+    rewrite_constant_function_calls' fixed target ast
   else
     ast
+
+type to_constant =
+  | Register of id * typ * tannot exp
+  | Register_field of id * id * typ * tannot exp
+
+let () =
+  let open Interactive in
+  let open Printf in
+
+  let update_fixed fixed = function
+    | Register (id, _, exp) ->
+       { fixed with registers = Bindings.add id exp fixed.registers }
+    | Register_field (id, field, _, exp) ->
+       let prev_fields = match Bindings.find_opt id fixed.fields with Some f -> f | None -> Bindings.empty in
+       let updated_fields = Bindings.add field exp prev_fields in
+       { fixed with fields = Bindings.add id updated_fields fixed.fields }
+  in
+
+  ArgString ("target", fun target -> ArgString ("assignments", fun assignments -> Action (fun () ->
+    let assignments = Str.split (Str.regexp " +") assignments in
+    let assignments =
+      List.map (fun assignment ->
+          match String.split_on_char '=' assignment with
+          | [reg; value] ->
+             begin match String.split_on_char '.' reg with
+             | [reg; field] ->
+                let reg = mk_id reg in
+                let field = mk_id field in
+                begin match Env.lookup_id reg !env with
+                | Register (_, _, Typ_aux (Typ_id rec_id, _)) ->
+                   let (_, fields) = Env.get_record rec_id !env in
+                   let typ = match List.find_opt (fun (typ, id) -> Id.compare id field = 0) fields with
+                     | Some (typ, _) -> typ
+                     | None -> failwith (sprintf "Register %s does not have a field %s" (string_of_id reg) (string_of_id field))
+                   in
+                   let exp = Initial_check.exp_of_string value in
+                   let exp = check_exp !env exp typ in
+                   Register_field (reg, field, typ, exp)
+                | _ ->
+                   failwith (sprintf "Register %s is not defined as a record in the current environment" (string_of_id reg))
+                end
+             | _ ->
+                let reg = mk_id reg in
+                begin match Env.lookup_id reg !env with
+                | Register (_, _, typ) ->
+                   let exp = Initial_check.exp_of_string value in
+                   let exp = check_exp !env exp typ in
+                   Register (reg, typ, exp)
+                | _ ->
+                   failwith (sprintf "Register %s is not defined in the current environment" (string_of_id reg))
+                end
+             end
+          | _ -> failwith (sprintf "Could not parse '%s' as an assignment <register>=<value>" assignment)
+        ) assignments in
+    let assignments = List.fold_left update_fixed no_fixed assignments in
+
+    ast := rewrite_constant_function_calls' assignments target !ast)))
+  |> register_command
+       ~name:"fix_registers"
+       ~help:"Fix the value of specified registers, specified as a \
+              list of <register>=<value>. Can also fix a specific \
+              register field as <register>.<field>=<value>."
diff --git a/src/constant_propagation_mutrec.ml b/src/constant_propagation_mutrec.ml
index 6cc6d28c..03d8e154 100644
--- a/src/constant_propagation_mutrec.ml
+++ b/src/constant_propagation_mutrec.ml
@@ -97,7 +97,8 @@ let generate_fun_id id args =
    that will be propagated in *)
 let generate_val_spec env id args l annot =
   match Env.get_val_spec_orig id env with
-  | tq, Typ_aux (Typ_fn (arg_typs, ret_typ, eff), _) ->
+  | tq, (Typ_aux (Typ_fn (arg_typs, ret_typ, eff), _) as fn_typ) ->
+     (* Get instantiation of type variables at call site *)
      let orig_ksubst (kid, typ_arg) =
        match typ_arg with
        | A_aux ((A_nexp _ | A_bool _), _) -> (orig_kid kid, typ_arg)
@@ -110,21 +111,38 @@ let generate_val_spec env id args l annot =
        |> List.map orig_ksubst
        |> List.fold_left (fun s (v,i) -> KBindings.add v i s) KBindings.empty
      in
+     (* Apply instantiation to original function type.  Also collect the
+        type variables in the new type together their kinds for the new
+        val spec. *)
+     let kopts_of_typ env typ =
+       tyvars_of_typ typ |> KidSet.elements
+       |> List.map (fun kid -> mk_kopt (Env.get_typ_var kid env) kid)
+       |> KOptSet.of_list
+     in
      let ret_typ' = KBindings.fold typ_subst ksubsts ret_typ in
-     let arg_typs' =
-       List.map (KBindings.fold typ_subst ksubsts) arg_typs
-       |> List.map2 (fun arg typ -> if is_const_exp arg then [] else [typ]) args
-       |> List.concat
-       |> function [] -> [unit_typ] | typs -> typs
+     let (arg_typs', kopts') =
+       List.fold_right2 (fun arg typ (arg_typs', kopts') ->
+           if is_const_exp arg then
+             (arg_typs', kopts')
+           else
+             let typ' = KBindings.fold typ_subst ksubsts typ in
+             let arg_kopts = kopts_of_typ (env_of arg) typ' in
+             (typ' :: arg_typs', KOptSet.union arg_kopts kopts'))
+         args arg_typs ([], kopts_of_typ (env_of_tannot annot) ret_typ')
      in
+     let arg_typs' = if arg_typs' = [] then [unit_typ] else arg_typs' in
      let typ' = mk_typ (Typ_fn (arg_typs', ret_typ', eff)) in
-     let tyvars = tyvars_of_typ typ' in
-     let tq' =
-       quant_items tq |>
-       List.filter (fun qi -> KidSet.subset (tyvars_of_quant_item qi) tyvars) |>
-       mk_typquant
+     (* Construct new val spec *)
+     let constraints' =
+       quant_split tq |> snd
+       |> List.map (KBindings.fold constraint_subst ksubsts)
+       |> List.filter (fun nc -> KidSet.subset (tyvars_of_constraint nc) (tyvars_of_typ typ'))
+     in
+     let quant_items' =
+       List.map mk_qi_kopt (KOptSet.elements kopts') @
+       List.map mk_qi_nc constraints'
      in
-     let typschm = mk_typschm tq' typ' in
+     let typschm = mk_typschm (mk_typquant quant_items') typ' in
      mk_val_spec (VS_val_spec (typschm, generate_fun_id id args, [], false)),
      ksubsts
   | _, Typ_aux (_, l) ->
diff --git a/src/gdbmi.ml b/src/gdbmi.ml
new file mode 100644
index 00000000..faf3ac11
--- /dev/null
+++ b/src/gdbmi.ml
@@ -0,0 +1,257 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+open Printf
+open Gdbmi_types
+
+let parse_gdb_response str =
+  let lexbuf = Lexing.from_string str in
+  Gdbmi_parser.response_eof Gdbmi_lexer.token lexbuf
+
+type gdb_session = (in_channel * out_channel * in_channel) option
+
+let gdb_command = ref "gdb-multiarch"
+
+let gdb_token_counter = ref 0
+
+let gdb_token () =
+  incr gdb_token_counter;
+  !gdb_token_counter
+
+let not_connected = Reporting.err_general Parse_ast.Unknown "Not connected to gdb"
+
+let rec wait_for' regexp stdout =
+  let line = input_line stdout in
+  if Str.string_match regexp line 0 then (
+    line
+  ) else (
+    print_endline Util.(line |> dim |> clear);
+    wait_for' regexp stdout
+  )
+
+let wait_for token stdout =
+  let regexp = Str.regexp (sprintf "^%i\\^" token) in
+  wait_for' regexp stdout
+
+let wait_for_gdb stdout =
+  let regexp = Str.regexp_string "(gdb)" in
+  wait_for' regexp stdout
+
+let send_sync session cmd =
+  match session with
+  | None -> raise not_connected
+  | Some (stdout, stdin, _) ->
+     let token = gdb_token () in
+     let cmd = sprintf "%i-%s\n" token cmd in
+     print_string Util.(cmd |> yellow |> clear);
+     flush stdin;
+     output_string stdin cmd;
+     flush stdin;
+     wait_for token stdout
+
+let send_regular session cmd =
+  match session with
+  | None -> raise not_connected
+  | Some (stdout, stdin, _) ->
+     let token = gdb_token () in
+     print_endline Util.(cmd |> yellow |> clear);
+     flush stdin;
+     output_string stdin (cmd ^ "\n");
+     flush stdin;
+     ignore (wait_for_gdb stdout)
+
+let synced_registers = ref []
+
+let gdb_sync session =
+  let gdb_register_names = parse_gdb_response (send_sync session "data-list-register-names") in
+  let gdb_register_values = parse_gdb_response (send_sync session "data-list-register-values x") in
+  let names = match gdb_register_names with
+    | Result (_, "done", output) ->
+       List.assoc "register-names" output |> gdb_seq |> List.map gdb_string
+    | _ -> failwith "GDB could not get register names"
+  in
+  let values = match gdb_register_values with
+    | Result (_, "done", output) ->
+       List.assoc "register-values" output
+       |> gdb_seq
+       |> List.map gdb_assoc
+       |> List.map (List.assoc "value")
+       |> List.map gdb_string
+    | _ -> failwith "GDB could not get register names"
+  in
+  synced_registers := List.combine names values
+
+let gdb_list_registers session =
+  gdb_sync session;
+  List.iter (fun (name, value) ->
+      print_endline (sprintf "%s: %s" name value)
+    ) !synced_registers
+
+let gdb_read_mem session addr data_size =
+  let open Value in
+  let cmd = sprintf "data-read-memory %s x 1 1 %i" (Sail_lib.string_of_bits addr) (Big_int.to_int data_size) in
+  (* An example response looks something like:
+
+     7^done,addr="0x0000000040009e64",nr-bytes="4",total-bytes="4",next-row="0x0000000040009e68",
+     prev-row="0x0000000040009e60",next-page="0x0000000040009e68",prev-page="0x0000000040009e60",
+     memory=[{addr="0x0000000040009e64",data=["0x03","0xfc","0x5a","0xd3"]}]
+     *)
+  match parse_gdb_response (send_sync session cmd) with
+  | Result (_, "done", output) ->
+     List.assoc "memory" output |> gdb_seq
+     |> List.hd |> gdb_assoc
+     |> List.assoc "data" |> gdb_seq
+     |> List.rev_map (fun byte -> Sail_lib.byte_of_int (int_of_string (gdb_string byte)))
+     |> List.concat
+
+  | _ -> failwith "Unexpected response from GDB"
+
+let value_gdb_read_ram session =
+  let open Value in
+  function
+  | [addr_size; data_size; _; addr] ->
+     mk_vector (gdb_read_mem session (coerce_bv addr) (coerce_int data_size))
+
+  | _ -> failwith "gdb_read_ram"
+
+let gdb_effect_interp session state eff =
+  let open Value in
+  let open Interpreter in
+  let lstate, gstate = state in
+  match eff with
+  | Read_mem (rk, addr, len, cont) ->
+     let result = mk_vector (gdb_read_mem session (coerce_bv addr) (coerce_int len)) in
+     cont result state
+  | Read_reg (name, cont) ->
+     begin match List.assoc_opt name !synced_registers with
+     | Some value ->
+        let value = mk_vector (Sail_lib.to_bits' (64, Big_int.of_string value)) in
+        cont value state
+     | None ->
+        cont (Bindings.find (mk_id name) gstate.registers) state
+     end
+  | Write_reg (name, v, cont) ->
+     let id = mk_id name in
+     if Bindings.mem id gstate.registers then
+       let state' = (lstate, { gstate with registers = Bindings.add id v gstate.registers }) in
+       cont () state'
+     else
+       failwith ("Write of nonexistent register: " ^ name)
+  | _ ->
+     failwith "Unsupported in GDB state"
+
+let gdb_hooks session =
+  Value.add_primop "read_ram" (value_gdb_read_ram session);
+  Interpreter.set_effect_interp (gdb_effect_interp session)
+
+let () =
+  let open Interactive in
+  let session = ref None in
+
+  let gdb_start arg =
+    let stdout, stdin, stderr = Unix.open_process_full (sprintf "%s --interpreter=mi" !gdb_command) [||] in
+    session := Some (stdout, stdin, stderr);
+    wait_for_gdb stdout |> ignore;
+    if arg = "" then () else print_endline (send_sync !session arg)
+  in
+
+  let gdb_send arg =
+    if arg = "" then () else print_endline (send_sync !session arg)
+  in
+
+  register_command
+    ~name:"gdb_command"
+    ~help:"Use specified gdb. Default is gdb-multiarch. This is the \
+           correct version on Ubuntu, but other Linux distros and \
+           operating systems may differ in how they package gdb with \
+           support for multiple architectures."
+    (ArgString ("gdb", fun arg -> Action (fun () -> gdb_command := arg)));
+
+  register_command
+    ~name:"gdb_start"
+    ~help:"Start a child GDB process sending :0 as the first command, waiting for it to complete"
+    (ArgString ("command", fun cmd -> Action (fun () -> gdb_start cmd)));
+
+  (ArgString ("port", fun port -> Action (fun () ->
+    if port = "" then
+      gdb_start "target-select remote localhost:1234"
+    else
+      gdb_start ("target-select remote localhost:" ^ port)
+  ))) |> register_command
+           ~name:"gdb_qemu"
+           ~help:"Connect GDB to a remote QEMU target on localhost port :0 (default is 1234, as per -s option for QEMU)";
+
+  register_command
+    ~name:"gdb_send"
+    ~help:"Send a GDB/MI command to a child GDB process and wait for it to complete"
+    (ArgString ("command", fun cmd -> Action (fun () -> gdb_send cmd)));
+
+  register_command
+    ~name:"gdb_sync"
+    ~help:"Sync sail registers with GDB"
+    (Action (fun () -> gdb_sync !session));
+
+  register_command
+    ~name:"gdb_list_registers"
+    ~help:"Sync sail registers with GDB and list them"
+    (Action (fun () -> gdb_list_registers !session));
+
+  register_command
+    ~name:"gdb_hooks"
+    ~help:"Make reading and writing memory go via GDB"
+    (Action (fun () -> gdb_hooks !session));
+
+  (ArgString ("symbol_file", fun file -> Action (fun () ->
+    send_regular !session ("symbol-file " ^ file)
+  ))) |> register_command
+           ~name:"gdb_symbol_file"
+           ~help:"Load debugging symbols into GDB";
diff --git a/src/gdbmi_lexer.mll b/src/gdbmi_lexer.mll
new file mode 100644
index 00000000..d55ea3cb
--- /dev/null
+++ b/src/gdbmi_lexer.mll
@@ -0,0 +1,101 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+{
+
+open Gdbmi_parser
+
+let unescaped s = Scanf.sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)
+
+}
+
+let ws = [' ''\t']+
+let letter = ['a'-'z''A'-'Z''?']
+let digit = ['0'-'9']
+let hexdigit = ['0'-'9''A'-'F''a'-'f']
+let alphanum = letter|digit
+let startident = letter
+let ident = alphanum|['-']
+let escape_sequence = ('\\' ['\\''\"''\'''n''t''b''r']) | ('\\' digit digit digit) | ('\\' 'x' hexdigit hexdigit)
+
+rule token = parse
+  | ws
+    { token lexbuf }
+  | "\n"
+    { Lexing.new_line lexbuf;
+      token lexbuf }
+  | "="					{ Eq }
+  | "["                                 { Lsquare }
+  | "]"                                 { Rsquare }
+  | "{"                                 { Lcurly }
+  | "}"                                 { Rcurly }
+  | ","                                 { Comma }
+  | "^"                                 { Caret }
+  | digit+ as i                         { Num (int_of_string i) }
+  | startident ident* as i              { Id i }
+  | '"'                                 { String (string (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf) }
+  | eof                                 { Eof }
+
+and string pos b = parse
+  | ([^'"''\n''\\']*'\n' as i)          { Lexing.new_line lexbuf;
+                                          Buffer.add_string b i;
+                                          string pos b lexbuf }
+  | ([^'"''\n''\\']* as i)              { Buffer.add_string b i; string pos b lexbuf }
+  | escape_sequence as i                { Buffer.add_string b i; string pos b lexbuf }
+  | '\\' '\n' ws                        { Lexing.new_line lexbuf; string pos b lexbuf }
+  | '\\'                                { assert false (*raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
+                                            "illegal backslash escape in string"*) }
+  | '"'                                 { let s = unescaped(Buffer.contents b) in
+                                          (*try Ulib.UTF8.validate s; s
+                                          with Ulib.UTF8.Malformed_code ->
+                                            raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
+                                              "String literal is not valid utf8"))) *) s }
+  | eof                                 { assert false (*raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
+                                            "String literal not terminated")))*) }
\ No newline at end of file
diff --git a/src/gdbmi_parser.mly b/src/gdbmi_parser.mly
new file mode 100644
index 00000000..5ae5027f
--- /dev/null
+++ b/src/gdbmi_parser.mly
@@ -0,0 +1,85 @@
+/**************************************************************************/
+/*     Sail                                                               */
+/*                                                                        */
+/*  Copyright (c) 2013-2017                                               */
+/*    Kathyrn Gray                                                        */
+/*    Shaked Flur                                                         */
+/*    Stephen Kell                                                        */
+/*    Gabriel Kerneis                                                     */
+/*    Robert Norton-Wright                                                */
+/*    Christopher Pulte                                                   */
+/*    Peter Sewell                                                        */
+/*    Alasdair Armstrong                                                  */
+/*    Brian Campbell                                                      */
+/*    Thomas Bauereiss                                                    */
+/*    Anthony Fox                                                         */
+/*    Jon French                                                          */
+/*    Dominic Mulligan                                                    */
+/*    Stephen Kell                                                        */
+/*    Mark Wassell                                                        */
+/*                                                                        */
+/*  All rights reserved.                                                  */
+/*                                                                        */
+/*  This software was developed by the University of Cambridge Computer   */
+/*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  */
+/*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   */
+/*                                                                        */
+/*  Redistribution and use in source and binary forms, with or without    */
+/*  modification, are permitted provided that the following conditions    */
+/*  are met:                                                              */
+/*  1. Redistributions of source code must retain the above copyright     */
+/*     notice, this list of conditions and the following disclaimer.      */
+/*  2. Redistributions in binary form must reproduce the above copyright  */
+/*     notice, this list of conditions and the following disclaimer in    */
+/*     the documentation and/or other materials provided with the         */
+/*     distribution.                                                      */
+/*                                                                        */
+/*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    */
+/*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     */
+/*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       */
+/*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   */
+/*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          */
+/*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      */
+/*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      */
+/*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   */
+/*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    */
+/*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    */
+/*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    */
+/*  SUCH DAMAGE.                                                          */
+/**************************************************************************/
+
+%{
+
+open Gdbmi_types
+
+%}
+
+%token Eof
+%token Eq Lsquare Rsquare Lcurly Rcurly Comma Caret
+%token <string> String Id
+%token <int> Num
+
+%start response_eof
+%type <Gdbmi_types.response> response_eof
+
+%%
+
+map_elem:
+  | Id Eq output
+    { ($1, $3) }
+
+output:
+  | String
+    { String $1 }
+  | Lsquare separated_list(Comma, output) Rsquare
+    { Seq $2 }
+  | Lcurly separated_list(Comma, map_elem) Rcurly
+    { Assoc $2 }
+
+response:
+  | Num Caret Id Comma separated_list(Comma, map_elem)
+    { Result ($1, $3, $5) }
+
+response_eof:
+  | response Eof
+    { $1 }
\ No newline at end of file
diff --git a/src/gdbmi_types.ml b/src/gdbmi_types.ml
new file mode 100644
index 00000000..13877a83
--- /dev/null
+++ b/src/gdbmi_types.ml
@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+type output =
+  | Assoc of (string * output) list
+  | Seq of output list
+  | String of string
+
+let gdb_seq = function
+  | Seq xs -> xs
+  | _ -> failwith "Expected GDB sequence"
+
+let gdb_string = function
+  | String xs -> xs
+  | _ -> failwith "Expected GDB string"
+
+let gdb_assoc = function
+  | Assoc xs -> xs
+  | _ -> failwith "Expected GDB associative list"
+
+type response =
+  | Result of int * string * (string * output) list
diff --git a/src/lem_interp/sail2_instr_kinds.lem b/src/gen_lib/sail2_instr_kinds.lem
index f3cdfbc9..f3cdfbc9 100644
--- a/src/lem_interp/sail2_instr_kinds.lem
+++ b/src/gen_lib/sail2_instr_kinds.lem
diff --git a/src/gen_lib/sail2_operators_bitlists.lem b/src/gen_lib/sail2_operators_bitlists.lem
index c9892e4c..15daa545 100644
--- a/src/gen_lib/sail2_operators_bitlists.lem
+++ b/src/gen_lib/sail2_operators_bitlists.lem
@@ -38,6 +38,9 @@ let sign_extend bits len = exts_bits len bits
 val zeros : integer -> list bitU
 let zeros len = repeat [B0] len
 
+val ones : integer -> list bitU
+let ones len = repeat [B1] len
+
 val vector_truncate : list bitU -> integer -> list bitU
 let vector_truncate bs len = extz_bv len bs
 
diff --git a/src/gen_lib/sail2_values.lem b/src/gen_lib/sail2_values.lem
index f657803f..69bf0852 100644
--- a/src/gen_lib/sail2_values.lem
+++ b/src/gen_lib/sail2_values.lem
@@ -423,6 +423,26 @@ let char_of_nibble = function
   | _ -> Nothing
   end
 
+let nibble_of_char = function
+  | #'0' -> Just (B0, B0, B0, B0)
+  | #'1' -> Just (B0, B0, B0, B1)
+  | #'2' -> Just (B0, B0, B1, B0)
+  | #'3' -> Just (B0, B0, B1, B1)
+  | #'4' -> Just (B0, B1, B0, B0)
+  | #'5' -> Just (B0, B1, B0, B1)
+  | #'6' -> Just (B0, B1, B1, B0)
+  | #'7' -> Just (B0, B1, B1, B1)
+  | #'8' -> Just (B1, B0, B0, B0)
+  | #'9' -> Just (B1, B0, B0, B1)
+  | #'A' -> Just (B1, B0, B1, B0)
+  | #'B' -> Just (B1, B0, B1, B1)
+  | #'C' -> Just (B1, B1, B0, B0)
+  | #'D' -> Just (B1, B1, B0, B1)
+  | #'E' -> Just (B1, B1, B1, B0)
+  | #'F' -> Just (B1, B1, B1, B1)
+  | _ -> Nothing
+  end
+
 let rec hexstring_of_bits bs = match bs with
   | b1 :: b2 :: b3 :: b4 :: bs ->
      let n = char_of_nibble (b1, b2, b3, b4) in
@@ -436,12 +456,14 @@ let rec hexstring_of_bits bs = match bs with
   end
 declare {isabelle; hol} termination_argument hexstring_of_bits = automatic
 
-let show_bitlist bs =
+let show_bitlist_prefix c bs =
   match hexstring_of_bits bs with
-  | Just s -> toString (#'0' :: #'x' :: s)
-  | Nothing -> toString (#'0' :: #'b' :: map bitU_char bs)
+  | Just s -> toString (c :: #'x' :: s)
+  | Nothing -> toString (c :: #'b' :: map bitU_char bs)
   end
 
+let show_bitlist bs = show_bitlist_prefix #'0' bs
+
 (*** List operations *)
 
 let inline (^^) = append_list
diff --git a/src/initial_check.ml b/src/initial_check.ml
index 1aebdbc2..f808af49 100644
--- a/src/initial_check.ml
+++ b/src/initial_check.ml
@@ -153,7 +153,7 @@ let rec to_ast_typ ctx (P.ATyp_aux (aux, l)) =
          | _ -> [to_ast_typ ctx from_typ]
        in
        Typ_fn (from_typs, to_ast_typ ctx to_typ, to_ast_effects effects)
-    | P.ATyp_bidir (typ1, typ2) -> Typ_bidir (to_ast_typ ctx typ1, to_ast_typ ctx typ2)
+    | P.ATyp_bidir (typ1, typ2, effects) -> Typ_bidir (to_ast_typ ctx typ1, to_ast_typ ctx typ2, to_ast_effects effects)
     | P.ATyp_tup typs -> Typ_tup (List.map (to_ast_typ ctx) typs)
     | P.ATyp_app (P.Id_aux (P.Id "int", il), [n]) ->
        Typ_app (Id_aux (Id "atom", il), [to_ast_typ_arg ctx n K_int])
@@ -931,8 +931,8 @@ let generate_undefineds vs_ids (Defs defs) =
   in
   let undefined_tu = function
     | Tu_aux (Tu_ty_id (Typ_aux (Typ_tup typs, _), id), _) ->
-       mk_exp (E_app (id, List.map (fun _ -> mk_lit_exp L_undef) typs))
-    | Tu_aux (Tu_ty_id (typ, id), _) -> mk_exp (E_app (id, [mk_lit_exp L_undef]))
+       mk_exp (E_app (id, List.map (fun typ -> mk_exp (E_cast (typ, mk_lit_exp L_undef))) typs))
+    | Tu_aux (Tu_ty_id (typ, id), _) -> mk_exp (E_app (id, [mk_exp (E_cast (typ, mk_lit_exp L_undef))]))
   in
   let p_tup = function
     | [pat] -> pat
diff --git a/src/interactive.ml b/src/interactive.ml
index 12a1be64..2cca944c 100644
--- a/src/interactive.ml
+++ b/src/interactive.ml
@@ -48,21 +48,85 @@
 (*  SUCH DAMAGE.                                                          *)
 (**************************************************************************)
 
+open Ast
+open Ast_util
+open Printf
+
 let opt_interactive = ref false
 let opt_emacs_mode = ref false
 let opt_suppress_banner = ref false
 
 let env = ref Type_check.initial_env
 
-let ast = ref (Ast.Defs [])
+let ast = ref (Defs [])
 
 let arg str =
   ("<" ^ str ^ ">") |> Util.yellow |> Util.clear
 
 let command str =
-  (":" ^ str) |> Util.green |> Util.clear
+  str |> Util.green |> Util.clear
+
+type action =
+  | ArgString of string * (string -> action)
+  | ArgInt of string * (int -> action)
+  | Action of (unit -> unit)
 
 let commands = ref []
 
+let reflect_typ action =
+  let open Type_check in
+  let rec arg_typs = function
+    | ArgString (_, next) -> string_typ :: arg_typs (next "")
+    | ArgInt (_, next) -> int_typ :: arg_typs (next 0)
+    | Action _ -> []
+  in
+  function_typ (arg_typs action) unit_typ no_effect
+
+let generate_help name help action =
+  let rec args = function
+    | ArgString (hint, next) -> arg hint :: args (next "")
+    | ArgInt (hint, next) -> arg hint :: args (next 0)
+    | Action _ -> []
+  in
+  let args = args action in
+  let help = match String.split_on_char ':' help with
+    | [] -> assert false
+    | (prefix :: splits) ->
+       List.map (fun split ->
+           match String.split_on_char ' ' split with
+           | [] -> assert false
+           | (subst :: rest) ->
+              if Str.string_match (Str.regexp "^[0-9]+") subst 0 then
+                let num_str = Str.matched_string subst in
+                let num_end = Str.match_end () in
+                let punct = String.sub subst num_end (String.length subst - num_end) in
+                List.nth args (int_of_string num_str) ^ punct ^ " " ^ String.concat " " rest
+              else
+                command (":" ^ subst) ^ " " ^ String.concat " " rest
+         ) splits
+       |> String.concat ""
+       |> (fun rest -> prefix ^ rest)
+  in
+  sprintf "%s %s - %s" Util.(name |> green |> clear) (String.concat ", " args) help
+
+let run_action cmd argument action =
+  let args = String.split_on_char ',' argument in
+  let rec call args action =
+    match args, action with
+    | (x :: xs), ArgString (hint, next) ->
+       call xs (next (String.trim x))
+    | (x :: xs), ArgInt (hint, next) ->
+       let x = String.trim x in
+       if Str.string_match (Str.regexp "^[0-9]+$") x 0 then
+         call xs (next (int_of_string x))
+       else
+         print_endline (sprintf "%s argument %s must be an non-negative integer" (command cmd) (arg hint))
+    | _, Action act ->
+       act ()
+    | _, _ ->
+       print_endline (sprintf "Bad arguments for %s, see (%s %s)" (command cmd) (command ":help") (command cmd))
+  in
+  call args action
+  
 let register_command ~name:name ~help:help action =
   commands := (":" ^ name, (help, action)) :: !commands
diff --git a/src/interactive.mli b/src/interactive.mli
index b1df0630..933d0a46 100644
--- a/src/interactive.mli
+++ b/src/interactive.mli
@@ -62,6 +62,17 @@ val env : Env.t ref
 val arg : string -> string
 val command : string -> string
 
-val commands : (string * (string * (string -> unit))) list ref
+type action =
+  | ArgString of string * (string -> action)
+  | ArgInt of string * (int -> action)
+  | Action of (unit -> unit)
 
-val register_command : name:string -> help:string -> (string -> unit) -> unit
+val reflect_typ : action -> typ
+
+val commands : (string * (string * action)) list ref
+
+val register_command : name:string -> help:string -> action -> unit
+
+val generate_help : string -> string -> action -> string
+
+val run_action : string -> string -> action -> unit
diff --git a/src/interpreter.ml b/src/interpreter.ml
index dd322369..4c048c09 100644
--- a/src/interpreter.ml
+++ b/src/interpreter.ml
@@ -203,7 +203,6 @@ let throw v = Yield (Exception v)
 let call (f : id) (args : value list) : return_value monad =
   Yield (Call (f, args, fun v -> Pure v))
 
-
 let read_mem rk addr len : value monad =
   Yield (Read_mem (rk, addr, len, (fun v -> Pure v)))
 
@@ -286,6 +285,7 @@ let rec step (E_aux (e_aux, annot) as orig_exp) =
   match e_aux with
   | E_block [] -> wrap (E_lit (L_aux (L_unit, Parse_ast.Unknown)))
   | E_block [exp] when is_value exp -> return exp
+  | E_block [E_aux (E_block _, _) as exp] -> return exp
   | E_block (exp :: exps) when is_value exp -> wrap (E_block exps)
   | E_block (exp :: exps) ->
      step exp >>= fun exp' -> wrap (E_block (exp' :: exps))
@@ -825,7 +825,8 @@ let rec eval_frame' = function
      | Yield (Get_primop (name, cont)), _ ->
         begin
           try
-            let op = StringMap.find name gstate.primops in
+            (* If we are in the toplevel interactive interpreter allow the set of primops to be changed dynamically *)
+            let op = StringMap.find name (if !Interactive.opt_interactive then !Value.primops else gstate.primops) in
             eval_frame' (Step (out, state, cont op, stack))
           with Not_found ->
             eval_frame' (Step (out, state, fail ("No such primop: " ^ name), stack))
@@ -926,8 +927,9 @@ let default_effect_interp state eff =
          failwith ("Register write disallowed by allow_registers setting: " ^ name)
      end
 
+let effect_interp = ref default_effect_interp
 
-
+let set_effect_interp interp = effect_interp := interp
 
 let rec run_frame frame =
   match frame with
@@ -938,7 +940,7 @@ let rec run_frame frame =
   | Break frame ->
      run_frame (eval_frame frame)
   | Effect_request (out, state, stack, eff) ->
-     run_frame (default_effect_interp state eff)
+     run_frame (!effect_interp state eff)
 
 let eval_exp state exp =
   run_frame (Step (lazy "", state, return exp, []))
diff --git a/src/isail.ml b/src/isail.ml
index 1c635af0..02908321 100644
--- a/src/isail.ml
+++ b/src/isail.ml
@@ -56,6 +56,7 @@ open Interpreter
 open Pretty_print_sail
 
 module Slice = Slice
+module Gdbmi = Gdbmi
 
 type mode =
   | Evaluation of frame
@@ -108,27 +109,72 @@ let sail_logo =
   in
   List.map banner logo @ [""] @ help @ [""]
 
-let vs_ids = ref (val_spec_ids !Interactive.ast)
+let sep = "-----------------------------------------------------" |> Util.blue |> Util.clear
 
-let interactive_state = ref (initial_state ~registers:false !Interactive.ast !Interactive.env Value.primops)
+let vs_ids = ref (val_spec_ids !Interactive.ast)
 
-let sep = "-----------------------------------------------------" |> Util.blue |> Util.clear
+let interactive_state = ref (initial_state ~registers:false !Interactive.ast !Interactive.env !Value.primops)
 
+(* We can't set up the elf commands in elf_loader.ml because it's used
+   by Sail OCaml emulators at runtime, so set them up here. *)
 let () =
   let open Interactive in
   let open Elf_loader in
-  let open Printf in
 
-  register_command ~name:"elf" ~help:(sprintf ":elf %s - Load an elf file" (arg "file")) load_elf;
+  ArgString ("file", fun file -> Action (fun () -> load_elf file))
+  |> register_command ~name:"elf" ~help:"Load an elf file";
+
+  ArgString ("addr", fun addr_s -> ArgString ("file", fun filename -> Action (fun () ->
+    let addr = Big_int.of_string addr_s in
+    load_binary addr filename
+  ))) |> register_command ~name:"bin" ~help:"Load a raw binary file at :0. Use :elf to load an ELF"
 
-  (fun iarg ->
-    match Util.split_on_char ' ' iarg with
-    | [addr_s; filename] ->
-       let addr = Big_int.of_string addr_s in
-       load_binary addr filename
-    | _ ->
-       printf "Invalid argument for :bin, expected %s %s" (arg "addr") (arg "file")
-  ) |> register_command ~name:"bin" ~help:(sprintf ":bin %s %s - Load a binary file at a given address" (arg "addr") (arg "file"))
+(* This is a feature that lets us take interpreter commands like :foo
+   x, y and turn the into functions that can be called by sail as
+   foo(x, y), which lets us use sail to script itself. The
+   sail_scripting_primops_once variable ensures we only add the
+   commands to the interpreter primops list once, although we may have
+   to reset the AST and env changes when we :load and :unload
+   files by calling this function multiple times. *)
+let sail_scripting_primops_once = ref true
+
+let setup_sail_scripting () =
+  let open Interactive in
+
+  let sail_command_name cmd = "sail_" ^ String.sub cmd 1 (String.length cmd - 1) in
+
+  let val_specs =
+    List.map (fun (cmd, (_, action)) ->
+        let name = sail_command_name cmd in
+        let typschm = mk_typschm (mk_typquant []) (reflect_typ action) in
+        mk_val_spec (VS_val_spec (typschm, mk_id name, [("_", name)], false))
+      ) !commands in
+  let val_specs, env' = Type_check.check !env (Defs val_specs) in
+  ast := append_ast !ast val_specs;
+  env := env';
+
+  if !sail_scripting_primops_once then (
+    List.iter (fun (cmd, (help, action)) ->
+        let open Value in
+        let name = sail_command_name cmd in
+        let impl values =
+          let rec call values action =
+            match values, action with
+            | (v :: vs), ArgString (_, next) ->
+               call vs (next (coerce_string v))
+            | (v :: vs), ArgInt (_, next) ->
+               call vs (next (Big_int.to_int (coerce_int v)))
+            | _, Action act ->
+               act (); V_unit
+            | _, _ ->
+               failwith help
+          in
+          call values action
+        in
+        Value.add_primop name impl
+      ) !commands;
+    sail_scripting_primops_once := false
+  )
 
 let print_program () =
   match !current_mode with
@@ -169,7 +215,7 @@ let rec run () =
        | Effect_request (out, state, stack, eff) ->
           begin
             try
-              current_mode := Evaluation (Interpreter.default_effect_interp state eff)
+              current_mode := Evaluation (!Interpreter.effect_interp state eff)
             with
             | Failure str -> print_endline str; current_mode := Normal
           end;
@@ -204,7 +250,7 @@ let rec run_steps n =
        | Effect_request (out, state, stack, eff) ->
           begin
             try
-              current_mode := Evaluation (Interpreter.default_effect_interp state eff)
+              current_mode := Evaluation (!Interpreter.effect_interp state eff)
             with
             | Failure str -> print_endline str; current_mode := Normal
           end;
@@ -282,7 +328,7 @@ let help =
              (color green ":commands") (color green ":help") (color yellow "<command>")
   | cmd ->
      match List.assoc_opt cmd !Interactive.commands with
-     | Some (help, _) -> help
+     | Some (help_message, action) -> Interactive.generate_help cmd help_message action
      | None ->
         sprintf "Either invalid command passed to help, or no documentation for %s. Try %s."
                 (color green cmd) (color green ":help :help")
@@ -347,7 +393,7 @@ let load_session upto file =
   | Some upto_file when Filename.basename upto_file = file -> None
   | Some upto_file ->
      let (_, ast, env) =
-       load_files ~check:true !Interactive.env [Filename.concat (Filename.dirname upto_file) file]
+       Process_file.load_files ~check:true options !Interactive.env [Filename.concat (Filename.dirname upto_file) file]
      in
      Interactive.ast := append_ast !Interactive.ast ast;
      Interactive.env := env;
@@ -463,15 +509,15 @@ let handle_input' input =
         begin match cmd with
         | ":l" | ":load" ->
            let files = Util.split_on_char ' ' arg in
-           let (_, ast, env) = load_files !Interactive.env files in
+           let (_, ast, env) = Process_file.load_files options !Interactive.env files in
            Interactive.ast := append_ast !Interactive.ast ast;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
            Interactive.env := env;
            vs_ids := val_spec_ids !Interactive.ast
         | ":u" | ":unload" ->
            Interactive.ast := Ast.Defs [];
            Interactive.env := Type_check.initial_env;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
            vs_ids := val_spec_ids !Interactive.ast;
            (* See initial_check.mli for an explanation of why we need this. *)
            Initial_check.have_undefined_builtins := false;
@@ -493,7 +539,7 @@ let handle_input' input =
               let ast, env = Type_check.check !Interactive.env (Defs [DEF_val (mk_letbind (mk_pat (P_id (mk_id v))) exp)]) in
               Interactive.ast := append_ast !Interactive.ast ast;
               Interactive.env := env;
-              interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+              interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
            | _ -> print_endline "Invalid arguments for :let"
            end
         | ":def" ->
@@ -501,7 +547,7 @@ let handle_input' input =
            let ast, env = Type_check.check !Interactive.env ast in
            Interactive.ast := append_ast !Interactive.ast ast;
            Interactive.env := env;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
         | ":list_rewrites" ->
            let print_rewrite (name, rw) =
              print_endline (name ^ " " ^ Util.(String.concat " " (describe_rewrite rw) |> yellow |> clear))
@@ -537,17 +583,17 @@ let handle_input' input =
            let new_ast, new_env = Process_file.rewrite_ast_target arg !Interactive.env !Interactive.ast in
            Interactive.ast := new_ast;
            Interactive.env := new_env;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops
         | ":prover_regstate" ->
            let env, ast = prover_regstate (Some arg) !Interactive.ast !Interactive.env in
            Interactive.env := env;
            Interactive.ast := ast;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops
         | ":recheck" ->
            let ast, env = Type_check.check Type_check.initial_env !Interactive.ast in
            Interactive.env := env;
            Interactive.ast := ast;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
            vs_ids := val_spec_ids !Interactive.ast
         | ":recheck_types" ->
            let ast, env = Type_check.check Type_check.initial_env !Interactive.ast in
@@ -555,14 +601,14 @@ let handle_input' input =
            Interactive.ast := ast;
            vs_ids := val_spec_ids !Interactive.ast
         | ":compile" ->
-           let out_name = match !opt_file_out with
+           let out_name = match !Process_file.opt_file_out with
              | None -> "out.sail"
              | Some f -> f ^ ".sail"
            in
            target (Some arg) out_name !Interactive.ast !Interactive.env
         | _ ->
            match List.assoc_opt cmd !Interactive.commands with
-           | Some (_, action) -> action arg
+           | Some (_, action) -> Interactive.run_action cmd arg action
            | None -> unrecognised_command cmd
         end
      | Expression str ->
@@ -582,9 +628,9 @@ let handle_input' input =
            begin
              try
                load_into_session arg;
-               let (_, ast, env) = load_files ~check:true !Interactive.env [arg] in
+               let (_, ast, env) = Process_file.load_files ~check:true options !Interactive.env [arg] in
                Interactive.ast := append_ast !Interactive.ast ast;
-               interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+               interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
                Interactive.env := env;
                vs_ids := val_spec_ids !Interactive.ast;
                print_endline ("(message \"Checked " ^ arg ^ " done\")\n");
@@ -595,7 +641,7 @@ let handle_input' input =
         | ":unload" ->
            Interactive.ast := Ast.Defs [];
            Interactive.env := Type_check.initial_env;
-           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           interactive_state := initial_state !Interactive.ast !Interactive.env !Value.primops;
            vs_ids := val_spec_ids !Interactive.ast;
            Initial_check.have_undefined_builtins := false;
            Process_file.clear_symbols ()
@@ -670,7 +716,7 @@ let handle_input' input =
            begin
              try
                interactive_state := state;
-               current_mode := Evaluation (Interpreter.default_effect_interp state eff);
+               current_mode := Evaluation (!Interpreter.effect_interp state eff);
                print_program ()
              with
              | Failure str -> print_endline str; current_mode := Normal
@@ -774,28 +820,26 @@ let () =
     );
 
   (* Read the script file if it is set with the -is option, and excute them *)
-  begin
-    match !opt_interactive_script with
-    | None -> ()
-    | Some file ->
-       let chan = open_in file in
-       try
-         while true do
-           let line = input_line chan in
-           handle_input line;
-         done;
-       with
-       | End_of_file -> ()
+  begin match !opt_interactive_script with
+  | None -> ()
+  | Some file ->
+     let chan = open_in file in
+     try
+       while true do
+         let line = input_line chan in
+         handle_input line;
+       done;
+     with
+     | End_of_file -> ()
   end;
 
   LNoise.history_load ~filename:"sail_history" |> ignore;
   LNoise.history_set ~max_length:100 |> ignore;
 
-  if !Interactive.opt_interactive then
-    begin
-      if not !Interactive.opt_emacs_mode then
-        List.iter print_endline sail_logo
-      else (current_mode := Emacs; Util.opt_colors := false);
-      user_input handle_input
-    end
-  else ()
+  if !Interactive.opt_interactive then (
+    if not !Interactive.opt_emacs_mode then
+      List.iter print_endline sail_logo
+    else (current_mode := Emacs; Util.opt_colors := false);
+    setup_sail_scripting ();
+    user_input handle_input
+  )
diff --git a/src/jib/c_backend.ml b/src/jib/c_backend.ml
index 98ee5bc1..2b144d35 100644
--- a/src/jib/c_backend.ml
+++ b/src/jib/c_backend.ml
@@ -100,7 +100,9 @@ let zencode_uid (id, ctyps) =
   match ctyps with
   | [] -> Util.zencode_string (string_of_id id)
   | _ -> Util.zencode_string (string_of_id id ^ "#" ^ Util.string_of_list "_" string_of_ctyp ctyps)
-                              
+
+let ctor_bindings = List.fold_left (fun map (id, ctyp) -> UBindings.add id ctyp map) UBindings.empty
+
 (**************************************************************************)
 (* 2. Converting sail types to C types                                    *)
 (**************************************************************************)
@@ -108,90 +110,9 @@ let zencode_uid (id, ctyps) =
 let max_int n = Big_int.pred (Big_int.pow_int_positive 2 (n - 1))
 let min_int n = Big_int.negate (Big_int.pow_int_positive 2 (n - 1))
 
-(** Convert a sail type into a C-type. This function can be quite
-   slow, because it uses ctx.local_env and SMT to analyse the Sail
-   types and attempts to fit them into the smallest possible C
-   types, provided ctx.optimize_smt is true (default) **)
-let rec ctyp_of_typ ctx typ =
-  let Typ_aux (typ_aux, l) as typ = Env.expand_synonyms ctx.tc_env typ in
-  match typ_aux with
-  | Typ_id id when string_of_id id = "bit"    -> CT_bit
-  | Typ_id id when string_of_id id = "bool"   -> CT_bool
-  | Typ_id id when string_of_id id = "int"    -> CT_lint
-  | Typ_id id when string_of_id id = "nat"    -> CT_lint
-  | Typ_id id when string_of_id id = "unit"   -> CT_unit
-  | Typ_id id when string_of_id id = "string" -> CT_string
-  | Typ_id id when string_of_id id = "real"   -> CT_real
-
-  | Typ_app (id, _) when string_of_id id = "atom_bool" -> CT_bool
-
-  | Typ_app (id, args) when string_of_id id = "itself" ->
-     ctyp_of_typ ctx (Typ_aux (Typ_app (mk_id "atom", args), l))
-  | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" || string_of_id id = "implicit" ->
-     begin match destruct_range Env.empty typ with
-     | None -> assert false (* Checked if range type in guard *)
-     | Some (kids, constr, n, m) ->
-        let ctx = { ctx with local_env = add_existential Parse_ast.Unknown (List.map (mk_kopt K_int) kids) constr ctx.local_env }in
-        match nexp_simp n, nexp_simp m with
-        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
-             when Big_int.less_equal (min_int 64) n && Big_int.less_equal m (max_int 64) ->
-           CT_fint 64
-        | n, m ->
-           if prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) then
-             CT_fint 64
-           else
-             CT_lint
-     end
-
-  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
-     CT_list (ctyp_of_typ ctx typ)
-
-  (* When converting a sail bitvector type into C, we have three options in order of efficiency:
-     - If the length is obviously static and smaller than 64, use the fixed bits type (aka uint64_t), fbits.
-     - If the length is less than 64, then use a small bits type, sbits.
-     - If the length may be larger than 64, use a large bits type lbits. *)
-  | Typ_app (id, [A_aux (A_nexp n, _);
-                  A_aux (A_order ord, _)])
-       when string_of_id id = "bitvector" ->
-     let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
-     begin match nexp_simp n with
-     | Nexp_aux (Nexp_constant n, _) when Big_int.less_equal n (Big_int.of_int 64) -> CT_fbits (Big_int.to_int n, direction)
-     | n when prove __POS__ ctx.local_env (nc_lteq n (nint 64)) -> CT_sbits (64, direction)
-     | _ -> CT_lbits direction
-     end
-
-  | Typ_app (id, [A_aux (A_nexp n, _);
-                  A_aux (A_order ord, _);
-                  A_aux (A_typ typ, _)])
-       when string_of_id id = "vector" ->
-     let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
-     CT_vector (direction, ctyp_of_typ ctx typ)
-
-  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "register" ->
-     CT_ref (ctyp_of_typ ctx typ)
-
-  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records  -> CT_struct (id, Bindings.find id ctx.records |> UBindings.bindings)
-  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.variants -> CT_variant (id, Bindings.find id ctx.variants |> UBindings.bindings)
-  | Typ_id id when Bindings.mem id ctx.enums -> CT_enum (id, Bindings.find id ctx.enums |> IdSet.elements)
-
-  | Typ_tup typs -> CT_tup (List.map (ctyp_of_typ ctx) typs)
-
-  | Typ_exist _ ->
-     (* Use Type_check.destruct_exist when optimising with SMT, to
-        ensure that we don't cause any type variable clashes in
-        local_env, and that we can optimize the existential based upon
-        it's constraints. *)
-     begin match destruct_exist (Env.expand_synonyms ctx.local_env typ) with
-     | Some (kids, nc, typ) ->
-        let env = add_existential l kids nc ctx.local_env in
-        ctyp_of_typ { ctx with local_env = env } typ
-     | None -> raise (Reporting.err_unreachable l __POS__ "Existential cannot be destructured!")
-     end
-
-  | Typ_var kid -> CT_poly
-
-  | _ -> c_error ~loc:l ("No C type for type " ^ string_of_typ typ)
-
+(** This function is used to split types into those we allocate on the
+   stack, versus those which need to live on the heap, or otherwise
+   require some additional memory management *)
 let rec is_stack_ctyp ctyp = match ctyp with
   | CT_fbits _ | CT_sbits _ | CT_bit | CT_unit | CT_bool | CT_enum _ -> true
   | CT_fint n -> n <= 64
@@ -199,7 +120,7 @@ let rec is_stack_ctyp ctyp = match ctyp with
   | CT_lint -> false
   | CT_lbits _ when !optimize_fixed_bits -> true
   | CT_lbits _ -> false
-  | CT_real | CT_string | CT_list _ | CT_vector _ -> false
+  | CT_real | CT_string | CT_list _ | CT_vector _ | CT_fvector _ -> false
   | CT_struct (_, fields) -> List.for_all (fun (_, ctyp) -> is_stack_ctyp ctyp) fields
   | CT_variant (_, ctors) -> false (* List.for_all (fun (_, ctyp) -> is_stack_ctyp ctyp) ctors *) (* FIXME *)
   | CT_tup ctyps -> List.for_all is_stack_ctyp ctyps
@@ -207,346 +128,442 @@ let rec is_stack_ctyp ctyp = match ctyp with
   | CT_poly -> true
   | CT_constant n -> Big_int.less_equal (min_int 64) n && Big_int.greater_equal n (max_int 64)
 
-let is_stack_typ ctx typ = is_stack_ctyp (ctyp_of_typ ctx typ)
-
-let is_fbits_typ ctx typ =
-  match ctyp_of_typ ctx typ with
-  | CT_fbits _ -> true
-  | _ -> false
-
-let is_sbits_typ ctx typ =
-  match ctyp_of_typ ctx typ with
-  | CT_sbits _ -> true
-  | _ -> false
-
-let ctor_bindings = List.fold_left (fun map (id, ctyp) -> UBindings.add id ctyp map) UBindings.empty
-
-(**************************************************************************)
-(* 3. Optimization of primitives and literals                             *)
-(**************************************************************************)
-
-let hex_char =
-  let open Sail2_values in
-  function
-  | '0' -> [B0; B0; B0; B0]
-  | '1' -> [B0; B0; B0; B1]
-  | '2' -> [B0; B0; B1; B0]
-  | '3' -> [B0; B0; B1; B1]
-  | '4' -> [B0; B1; B0; B0]
-  | '5' -> [B0; B1; B0; B1]
-  | '6' -> [B0; B1; B1; B0]
-  | '7' -> [B0; B1; B1; B1]
-  | '8' -> [B1; B0; B0; B0]
-  | '9' -> [B1; B0; B0; B1]
-  | 'A' | 'a' -> [B1; B0; B1; B0]
-  | 'B' | 'b' -> [B1; B0; B1; B1]
-  | 'C' | 'c' -> [B1; B1; B0; B0]
-  | 'D' | 'd' -> [B1; B1; B0; B1]
-  | 'E' | 'e' -> [B1; B1; B1; B0]
-  | 'F' | 'f' -> [B1; B1; B1; B1]
-  | _ -> failwith "Invalid hex character"
-
-let literal_to_fragment (L_aux (l_aux, _) as lit) =
-  match l_aux with
-  | L_num n when Big_int.less_equal (min_int 64) n && Big_int.less_equal n (max_int 64) ->
-     Some (V_lit (VL_int n, CT_fint 64))
-  | L_hex str when String.length str <= 16 ->
-     let padding = 16 - String.length str in
-     let padding = Util.list_init padding (fun _ -> Sail2_values.B0) in
-     let content = Util.string_to_list str |> List.map hex_char |> List.concat in
-     Some (V_lit (VL_bits (padding @ content, true), CT_fbits (String.length str * 4, true)))
-  | L_unit -> Some (V_lit (VL_unit, CT_unit))
-  | L_true -> Some (V_lit (VL_bool true, CT_bool))
-  | L_false -> Some (V_lit (VL_bool false, CT_bool))
-  | _ -> None
-
-let c_literals ctx =
-  let rec c_literal env l = function
-    | AV_lit (lit, typ) as v when is_stack_ctyp (ctyp_of_typ { ctx with local_env = env } typ) ->
-       begin
-         match literal_to_fragment lit with
-         | Some cval -> AV_cval (cval, typ)
-         | None -> v
-       end
-    | AV_tuple avals -> AV_tuple (List.map (c_literal env l) avals)
-    | v -> v
-  in
-  map_aval c_literal
-
-let rec is_bitvector = function
-  | [] -> true
-  | AV_lit (L_aux (L_zero, _), _) :: avals -> is_bitvector avals
-  | AV_lit (L_aux (L_one, _), _) :: avals -> is_bitvector avals
-  | _ :: _ -> false
-
-let rec value_of_aval_bit = function
-  | AV_lit (L_aux (L_zero, _), _) -> Sail2_values.B0
-  | AV_lit (L_aux (L_one, _), _) -> Sail2_values.B1
-  | _ -> assert false
-
-(** Used to make sure the -Ofixed_int and -Ofixed_bits don't interfere
-   with assumptions made about optimizations in the common case. *)
-let rec never_optimize = function
-  | CT_lbits _ | CT_lint -> true
-  | _ -> false
-
-let rec c_aval ctx = function
-  | AV_lit (lit, typ) as v ->
-     begin
-       match literal_to_fragment lit with
-       | Some cval -> AV_cval (cval, typ)
-       | None -> v
-     end
-  | AV_cval (cval, typ) -> AV_cval (cval, typ)
-  (* An id can be converted to a C fragment if it's type can be
-     stack-allocated. *)
-  | AV_id (id, lvar) as v ->
-     begin
-       match lvar with
-       | Local (_, typ) ->
-          let ctyp = ctyp_of_typ ctx typ in
-          if is_stack_ctyp ctyp && not (never_optimize ctyp) then
-            begin
-              try
-                (* We need to check that id's type hasn't changed due to flow typing *)
-                let _, ctyp' = Bindings.find id ctx.locals in
-                if ctyp_equal ctyp ctyp' then
-                  AV_cval (V_id (name id, ctyp), typ)
-                else
-                  (* id's type changed due to flow
-                     typing, so it's really still heap allocated!  *)
-                  v
-              with
-                (* Hack: Assuming global letbindings don't change from flow typing... *)
-                Not_found -> AV_cval (V_id (name id, ctyp), typ)
-            end
-          else
-            v
-       | Register (_, _, typ) ->
-          let ctyp = ctyp_of_typ ctx typ in
-          if is_stack_ctyp ctyp && not (never_optimize ctyp) then
-            AV_cval (V_id (name id, ctyp), typ)
-          else
-            v
-       | _ -> v
-     end
-  | AV_vector (v, typ) when is_bitvector v && List.length v <= 64 ->
-     let bitstring = VL_bits (List.map value_of_aval_bit v, true) in
-     AV_cval (V_lit (bitstring, CT_fbits (List.length v, true)), typ)
-  | AV_tuple avals -> AV_tuple (List.map (c_aval ctx) avals)
-  | aval -> aval
-
-let c_fragment = function
-  | AV_cval (cval, _) -> cval
-  | _ -> assert false
-
 let v_mask_lower i = V_lit (VL_bits (Util.list_init i (fun _ -> Sail2_values.B1), true), CT_fbits (i, true))
 
-(* Map over all the functions in an aexp. *)
-let rec analyze_functions ctx f (AE_aux (aexp, env, l)) =
-  let ctx = { ctx with local_env = env } in
-  let aexp = match aexp with
-    | AE_app (id, vs, typ) -> f ctx id vs typ
+module C_config : Config = struct
 
-    | AE_cast (aexp, typ) -> AE_cast (analyze_functions ctx f aexp, typ)
+(** Convert a sail type into a C-type. This function can be quite
+   slow, because it uses ctx.local_env and SMT to analyse the Sail
+   types and attempts to fit them into the smallest possible C
+   types, provided ctx.optimize_smt is true (default) **)
+  let rec convert_typ ctx typ =
+    let Typ_aux (typ_aux, l) as typ = Env.expand_synonyms ctx.tc_env typ in
+    match typ_aux with
+    | Typ_id id when string_of_id id = "bit"    -> CT_bit
+    | Typ_id id when string_of_id id = "bool"   -> CT_bool
+    | Typ_id id when string_of_id id = "int"    -> CT_lint
+    | Typ_id id when string_of_id id = "nat"    -> CT_lint
+    | Typ_id id when string_of_id id = "unit"   -> CT_unit
+    | Typ_id id when string_of_id id = "string" -> CT_string
+    | Typ_id id when string_of_id id = "real"   -> CT_real
+
+    | Typ_app (id, _) when string_of_id id = "atom_bool" -> CT_bool
+
+    | Typ_app (id, args) when string_of_id id = "itself" ->
+       convert_typ ctx (Typ_aux (Typ_app (mk_id "atom", args), l))
+    | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" || string_of_id id = "implicit" ->
+       begin match destruct_range Env.empty typ with
+       | None -> assert false (* Checked if range type in guard *)
+       | Some (kids, constr, n, m) ->
+          let ctx = { ctx with local_env = add_existential Parse_ast.Unknown (List.map (mk_kopt K_int) kids) constr ctx.local_env }in
+          match nexp_simp n, nexp_simp m with
+          | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+               when Big_int.less_equal (min_int 64) n && Big_int.less_equal m (max_int 64) ->
+             CT_fint 64
+          | n, m ->
+             if prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) then
+               CT_fint 64
+             else
+               CT_lint
+       end
 
-    | AE_assign (id, typ, aexp) -> AE_assign (id, typ, analyze_functions ctx f aexp)
+    | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
+       CT_list (convert_typ ctx typ)
+
+    (* When converting a sail bitvector type into C, we have three options in order of efficiency:
+       - If the length is obviously static and smaller than 64, use the fixed bits type (aka uint64_t), fbits.
+       - If the length is less than 64, then use a small bits type, sbits.
+       - If the length may be larger than 64, use a large bits type lbits. *)
+    | Typ_app (id, [A_aux (A_nexp n, _);
+                    A_aux (A_order ord, _)])
+         when string_of_id id = "bitvector" ->
+       let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
+       begin match nexp_simp n with
+       | Nexp_aux (Nexp_constant n, _) when Big_int.less_equal n (Big_int.of_int 64) -> CT_fbits (Big_int.to_int n, direction)
+       | n when prove __POS__ ctx.local_env (nc_lteq n (nint 64)) -> CT_sbits (64, direction)
+       | _ -> CT_lbits direction
+       end
 
-    | AE_write_ref (id, typ, aexp) -> AE_write_ref (id, typ, analyze_functions ctx f aexp)
+    | Typ_app (id, [A_aux (A_nexp n, _);
+                    A_aux (A_order ord, _);
+                    A_aux (A_typ typ, _)])
+         when string_of_id id = "vector" ->
+       let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
+       CT_vector (direction, convert_typ ctx typ)
+
+    | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "register" ->
+       CT_ref (convert_typ ctx typ)
+
+    | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records  -> CT_struct (id, Bindings.find id ctx.records |> UBindings.bindings)
+    | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.variants -> CT_variant (id, Bindings.find id ctx.variants |> UBindings.bindings)
+    | Typ_id id when Bindings.mem id ctx.enums -> CT_enum (id, Bindings.find id ctx.enums |> IdSet.elements)
+
+    | Typ_tup typs -> CT_tup (List.map (convert_typ ctx) typs)
+
+    | Typ_exist _ ->
+       (* Use Type_check.destruct_exist when optimising with SMT, to
+          ensure that we don't cause any type variable clashes in
+          local_env, and that we can optimize the existential based
+          upon it's constraints. *)
+       begin match destruct_exist (Env.expand_synonyms ctx.local_env typ) with
+       | Some (kids, nc, typ) ->
+          let env = add_existential l kids nc ctx.local_env in
+          convert_typ { ctx with local_env = env } typ
+       | None -> raise (Reporting.err_unreachable l __POS__ "Existential cannot be destructured!")
+       end
 
-    | AE_short_circuit (op, aval, aexp) -> AE_short_circuit (op, aval, analyze_functions ctx f aexp)
+    | Typ_var kid -> CT_poly
 
-    | AE_let (mut, id, typ1, aexp1, (AE_aux (_, env2, _) as aexp2), typ2) ->
-       let aexp1 = analyze_functions ctx f aexp1 in
-       (* Use aexp2's environment because it will contain constraints for id *)
-       let ctyp1 = ctyp_of_typ { ctx with local_env = env2 } typ1 in
-       let ctx = { ctx with locals = Bindings.add id (mut, ctyp1) ctx.locals } in
-       AE_let (mut, id, typ1, aexp1, analyze_functions ctx f aexp2, typ2)
+    | _ -> c_error ~loc:l ("No C type for type " ^ string_of_typ typ)
 
-    | AE_block (aexps, aexp, typ) -> AE_block (List.map (analyze_functions ctx f) aexps, analyze_functions ctx f aexp, typ)
+  let is_stack_typ ctx typ = is_stack_ctyp (convert_typ ctx typ)
 
-    | AE_if (aval, aexp1, aexp2, typ) ->
-       AE_if (aval, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2, typ)
+  let is_fbits_typ ctx typ =
+    match convert_typ ctx typ with
+    | CT_fbits _ -> true
+    | _ -> false
 
-    | AE_loop (loop_typ, aexp1, aexp2) -> AE_loop (loop_typ, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2)
+  let is_sbits_typ ctx typ =
+    match convert_typ ctx typ with
+    | CT_sbits _ -> true
+    | _ -> false
 
-    | AE_for (id, aexp1, aexp2, aexp3, order, aexp4) ->
-       let aexp1 = analyze_functions ctx f aexp1 in
-       let aexp2 = analyze_functions ctx f aexp2 in
-       let aexp3 = analyze_functions ctx f aexp3 in
-       let aexp4 = analyze_functions ctx f aexp4 in
-       (* Currently we assume that loop indexes are always safe to put into an int64 *)
-       let ctx = { ctx with locals = Bindings.add id (Immutable, CT_fint 64) ctx.locals } in
-       AE_for (id, aexp1, aexp2, aexp3, order, aexp4)
+  (**************************************************************************)
+  (* 3. Optimization of primitives and literals                             *)
+  (**************************************************************************)
+
+  let hex_char =
+    let open Sail2_values in
+    function
+    | '0' -> [B0; B0; B0; B0]
+    | '1' -> [B0; B0; B0; B1]
+    | '2' -> [B0; B0; B1; B0]
+    | '3' -> [B0; B0; B1; B1]
+    | '4' -> [B0; B1; B0; B0]
+    | '5' -> [B0; B1; B0; B1]
+    | '6' -> [B0; B1; B1; B0]
+    | '7' -> [B0; B1; B1; B1]
+    | '8' -> [B1; B0; B0; B0]
+    | '9' -> [B1; B0; B0; B1]
+    | 'A' | 'a' -> [B1; B0; B1; B0]
+    | 'B' | 'b' -> [B1; B0; B1; B1]
+    | 'C' | 'c' -> [B1; B1; B0; B0]
+    | 'D' | 'd' -> [B1; B1; B0; B1]
+    | 'E' | 'e' -> [B1; B1; B1; B0]
+    | 'F' | 'f' -> [B1; B1; B1; B1]
+    | _ -> failwith "Invalid hex character"
+
+  let literal_to_fragment (L_aux (l_aux, _) as lit) =
+    match l_aux with
+    | L_num n when Big_int.less_equal (min_int 64) n && Big_int.less_equal n (max_int 64) ->
+       Some (V_lit (VL_int n, CT_fint 64))
+    | L_hex str when String.length str <= 16 ->
+       let padding = 16 - String.length str in
+       let padding = Util.list_init padding (fun _ -> Sail2_values.B0) in
+       let content = Util.string_to_list str |> List.map hex_char |> List.concat in
+       Some (V_lit (VL_bits (padding @ content, true), CT_fbits (String.length str * 4, true)))
+    | L_unit -> Some (V_lit (VL_unit, CT_unit))
+    | L_true -> Some (V_lit (VL_bool true, CT_bool))
+    | L_false -> Some (V_lit (VL_bool false, CT_bool))
+    | _ -> None
+
+  let c_literals ctx =
+    let rec c_literal env l = function
+      | AV_lit (lit, typ) as v when is_stack_ctyp (convert_typ { ctx with local_env = env } typ) ->
+         begin
+           match literal_to_fragment lit with
+           | Some cval -> AV_cval (cval, typ)
+           | None -> v
+         end
+      | AV_tuple avals -> AV_tuple (List.map (c_literal env l) avals)
+      | v -> v
+    in
+    map_aval c_literal
+
+  let rec is_bitvector = function
+    | [] -> true
+    | AV_lit (L_aux (L_zero, _), _) :: avals -> is_bitvector avals
+    | AV_lit (L_aux (L_one, _), _) :: avals -> is_bitvector avals
+    | _ :: _ -> false
+
+  let rec value_of_aval_bit = function
+    | AV_lit (L_aux (L_zero, _), _) -> Sail2_values.B0
+    | AV_lit (L_aux (L_one, _), _) -> Sail2_values.B1
+    | _ -> assert false
+
+  (** Used to make sure the -Ofixed_int and -Ofixed_bits don't
+     interfere with assumptions made about optimizations in the common
+     case. *)
+  let rec never_optimize = function
+    | CT_lbits _ | CT_lint -> true
+    | _ -> false
 
-    | AE_case (aval, cases, typ) ->
-       let analyze_case (AP_aux (_, env, _) as pat, aexp1, aexp2) =
-         let pat_bindings = Bindings.bindings (apat_types pat) in
-         let ctx = { ctx with local_env = env } in
-         let ctx =
-           List.fold_left (fun ctx (id, typ) -> { ctx with locals = Bindings.add id (Immutable, ctyp_of_typ ctx typ) ctx.locals }) ctx pat_bindings
+  let rec c_aval ctx = function
+    | AV_lit (lit, typ) as v ->
+       begin
+         match literal_to_fragment lit with
+         | Some cval -> AV_cval (cval, typ)
+         | None -> v
+       end
+    | AV_cval (cval, typ) -> AV_cval (cval, typ)
+    (* An id can be converted to a C fragment if it's type can be
+     stack-allocated. *)
+    | AV_id (id, lvar) as v ->
+       begin
+         match lvar with
+         | Local (_, typ) ->
+            let ctyp = convert_typ ctx typ in
+            if is_stack_ctyp ctyp && not (never_optimize ctyp) then
+              begin
+                try
+                  (* We need to check that id's type hasn't changed due to flow typing *)
+                  let _, ctyp' = Bindings.find id ctx.locals in
+                  if ctyp_equal ctyp ctyp' then
+                    AV_cval (V_id (name id, ctyp), typ)
+                  else
+                    (* id's type changed due to flow typing, so it's
+                       really still heap allocated!  *)
+                    v
+                with
+                  (* Hack: Assuming global letbindings don't change from flow typing... *)
+                  Not_found -> AV_cval (V_id (name id, ctyp), typ)
+              end
+            else
+              v
+         | Register (_, _, typ) ->
+            let ctyp = convert_typ ctx typ in
+            if is_stack_ctyp ctyp && not (never_optimize ctyp) then
+              AV_cval (V_id (name id, ctyp), typ)
+            else
+              v
+         | _ -> v
+       end
+    | AV_vector (v, typ) when is_bitvector v && List.length v <= 64 ->
+       let bitstring = VL_bits (List.map value_of_aval_bit v, true) in
+       AV_cval (V_lit (bitstring, CT_fbits (List.length v, true)), typ)
+    | AV_tuple avals -> AV_tuple (List.map (c_aval ctx) avals)
+    | aval -> aval
+
+  let c_fragment = function
+    | AV_cval (cval, _) -> cval
+    | _ -> assert false
+
+  (* Map over all the functions in an aexp. *)
+  let rec analyze_functions ctx f (AE_aux (aexp, env, l)) =
+    let ctx = { ctx with local_env = env } in
+    let aexp = match aexp with
+      | AE_app (id, vs, typ) -> f ctx id vs typ
+
+      | AE_cast (aexp, typ) -> AE_cast (analyze_functions ctx f aexp, typ)
+
+      | AE_assign (id, typ, aexp) -> AE_assign (id, typ, analyze_functions ctx f aexp)
+
+      | AE_write_ref (id, typ, aexp) -> AE_write_ref (id, typ, analyze_functions ctx f aexp)
+
+      | AE_short_circuit (op, aval, aexp) -> AE_short_circuit (op, aval, analyze_functions ctx f aexp)
+
+      | AE_let (mut, id, typ1, aexp1, (AE_aux (_, env2, _) as aexp2), typ2) ->
+         let aexp1 = analyze_functions ctx f aexp1 in
+         (* Use aexp2's environment because it will contain constraints for id *)
+         let ctyp1 = convert_typ { ctx with local_env = env2 } typ1 in
+         let ctx = { ctx with locals = Bindings.add id (mut, ctyp1) ctx.locals } in
+         AE_let (mut, id, typ1, aexp1, analyze_functions ctx f aexp2, typ2)
+
+      | AE_block (aexps, aexp, typ) -> AE_block (List.map (analyze_functions ctx f) aexps, analyze_functions ctx f aexp, typ)
+
+      | AE_if (aval, aexp1, aexp2, typ) ->
+         AE_if (aval, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2, typ)
+
+      | AE_loop (loop_typ, aexp1, aexp2) -> AE_loop (loop_typ, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2)
+
+      | AE_for (id, aexp1, aexp2, aexp3, order, aexp4) ->
+         let aexp1 = analyze_functions ctx f aexp1 in
+         let aexp2 = analyze_functions ctx f aexp2 in
+         let aexp3 = analyze_functions ctx f aexp3 in
+         let aexp4 = analyze_functions ctx f aexp4 in
+         (* Currently we assume that loop indexes are always safe to put into an int64 *)
+         let ctx = { ctx with locals = Bindings.add id (Immutable, CT_fint 64) ctx.locals } in
+         AE_for (id, aexp1, aexp2, aexp3, order, aexp4)
+
+      | AE_case (aval, cases, typ) ->
+         let analyze_case (AP_aux (_, env, _) as pat, aexp1, aexp2) =
+           let pat_bindings = Bindings.bindings (apat_types pat) in
+           let ctx = { ctx with local_env = env } in
+           let ctx =
+             List.fold_left (fun ctx (id, typ) -> { ctx with locals = Bindings.add id (Immutable, convert_typ ctx typ) ctx.locals }) ctx pat_bindings
+           in
+           pat, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2
          in
-         pat, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2
-       in
-       AE_case (aval, List.map analyze_case cases, typ)
+         AE_case (aval, List.map analyze_case cases, typ)
 
-    | AE_try (aexp, cases, typ) ->
-       AE_try (analyze_functions ctx f aexp, List.map (fun (pat, aexp1, aexp2) -> pat, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2) cases, typ)
+      | AE_try (aexp, cases, typ) ->
+         AE_try (analyze_functions ctx f aexp, List.map (fun (pat, aexp1, aexp2) -> pat, analyze_functions ctx f aexp1, analyze_functions ctx f aexp2) cases, typ)
 
-    | AE_field _ | AE_record_update _ | AE_val _ | AE_return _ | AE_throw _ as v -> v
-  in
-  AE_aux (aexp, env, l)
+      | AE_field _ | AE_record_update _ | AE_val _ | AE_return _ | AE_throw _ as v -> v
+    in
+    AE_aux (aexp, env, l)
 
-let analyze_primop' ctx id args typ =
-  let no_change = AE_app (id, args, typ) in
-  let args = List.map (c_aval ctx) args in
-  let extern = if Env.is_extern id ctx.tc_env "c" then Env.get_extern id ctx.tc_env "c" else failwith "Not extern" in
+  let analyze_primop' ctx id args typ =
+    let no_change = AE_app (id, args, typ) in
+    let args = List.map (c_aval ctx) args in
+    let extern = if Env.is_extern id ctx.tc_env "c" then Env.get_extern id ctx.tc_env "c" else failwith "Not extern" in
 
-  let v_one = V_lit (VL_int (Big_int.of_int 1), CT_fint 64) in
-  let v_int n = V_lit (VL_int (Big_int.of_int n), CT_fint 64) in
+    let v_one = V_lit (VL_int (Big_int.of_int 1), CT_fint 64) in
+    let v_int n = V_lit (VL_int (Big_int.of_int n), CT_fint 64) in
 
-  match extern, args with
-  | "eq_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     begin match cval_ctyp v1 with
-     | CT_fbits _ | CT_sbits _ ->
+    match extern, args with
+    | "eq_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       begin match cval_ctyp v1 with
+       | CT_fbits _ | CT_sbits _ ->
         AE_val (AV_cval (V_call (Eq, [v1; v2]), typ))
-     | _ -> no_change
-     end
+       | _ -> no_change
+       end
 
-  | "neq_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     begin match cval_ctyp v1 with
-     | CT_fbits _ | CT_sbits _ ->
-        AE_val (AV_cval (V_call (Neq, [v1; v2]), typ))
-     | _ -> no_change
-     end
+    | "neq_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       begin match cval_ctyp v1 with
+       | CT_fbits _ | CT_sbits _ ->
+          AE_val (AV_cval (V_call (Neq, [v1; v2]), typ))
+       | _ -> no_change
+       end
 
-  | "eq_int", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Eq, [v1; v2]), typ))
+    | "eq_int", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Eq, [v1; v2]), typ))
 
-  | "eq_bit", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Eq, [v1; v2]), typ))
+    | "eq_bit", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Eq, [v1; v2]), typ))
 
-  | "zeros", [_] ->
-     begin match destruct_vector ctx.tc_env typ with
-     | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
-          when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-        let n = Big_int.to_int n in
-        AE_val (AV_cval (V_lit (VL_bits (Util.list_init n (fun _ -> Sail2_values.B0), true), CT_fbits (n, true)), typ))
-     | _ -> no_change
-     end
+    | "zeros", [_] ->
+       begin match destruct_vector ctx.tc_env typ with
+       | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
+            when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
+          let n = Big_int.to_int n in
+          AE_val (AV_cval (V_lit (VL_bits (Util.list_init n (fun _ -> Sail2_values.B0), true), CT_fbits (n, true)), typ))
+       | _ -> no_change
+       end
 
-  | "zero_extend", [AV_cval (v, _); _] ->
-     begin match destruct_vector ctx.tc_env typ with
-     | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
-          when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-        AE_val (AV_cval (V_call (Zero_extend (Big_int.to_int n), [v]), typ))
-     | _ -> no_change
-     end
+    | "zero_extend", [AV_cval (v, _); _] ->
+       begin match destruct_vector ctx.tc_env typ with
+       | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
+            when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
+          AE_val (AV_cval (V_call (Zero_extend (Big_int.to_int n), [v]), typ))
+       | _ -> no_change
+       end
 
-  | "sign_extend", [AV_cval (v, _); _] ->
-     begin match destruct_vector ctx.tc_env typ with
-     | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
-          when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-        AE_val (AV_cval (V_call (Sign_extend (Big_int.to_int n), [v]), typ))
-     | _ -> no_change
-     end
+    | "sign_extend", [AV_cval (v, _); _] ->
+       begin match destruct_vector ctx.tc_env typ with
+       | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
+            when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
+          AE_val (AV_cval (V_call (Sign_extend (Big_int.to_int n), [v]), typ))
+       | _ -> no_change
+       end
 
-  | "lteq", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Ilteq, [v1; v2]), typ))
-  | "gteq", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Igteq, [v1; v2]), typ))
-  | "lt", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Ilt, [v1; v2]), typ))
-  | "gt", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     AE_val (AV_cval (V_call (Igt, [v1; v2]), typ))
-
-  | "append", [AV_cval (v1, _); AV_cval (v2, _)] ->
-     begin match ctyp_of_typ ctx typ with
-     | CT_fbits _ | CT_sbits _ ->
-        AE_val (AV_cval (V_call (Concat, [v1; v2]), typ))
-     | _ -> no_change
-     end
+    | "lteq", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Ilteq, [v1; v2]), typ))
+    | "gteq", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Igteq, [v1; v2]), typ))
+    | "lt", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Ilt, [v1; v2]), typ))
+    | "gt", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       AE_val (AV_cval (V_call (Igt, [v1; v2]), typ))
+
+    | "append", [AV_cval (v1, _); AV_cval (v2, _)] ->
+       begin match convert_typ ctx typ with
+       | CT_fbits _ | CT_sbits _ ->
+          AE_val (AV_cval (V_call (Concat, [v1; v2]), typ))
+       | _ -> no_change
+       end
 
-  | "not_bits", [AV_cval (v, _)] ->
-     AE_val (AV_cval (V_call (Bvnot, [v]), typ))
+    | "not_bits", [AV_cval (v, _)] ->
+       AE_val (AV_cval (V_call (Bvnot, [v]), typ))
 
-  | "add_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     AE_val (AV_cval (V_call (Bvadd, [v1; v2]), typ))
+    | "add_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       AE_val (AV_cval (V_call (Bvadd, [v1; v2]), typ))
 
-  | "sub_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     AE_val (AV_cval (V_call (Bvsub, [v1; v2]), typ))
+    | "sub_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       AE_val (AV_cval (V_call (Bvsub, [v1; v2]), typ))
 
-  | "and_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     AE_val (AV_cval (V_call (Bvand, [v1; v2]), typ))
+    | "and_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       AE_val (AV_cval (V_call (Bvand, [v1; v2]), typ))
 
-  | "or_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     AE_val (AV_cval (V_call (Bvor, [v1; v2]), typ))
+    | "or_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       AE_val (AV_cval (V_call (Bvor, [v1; v2]), typ))
 
-  | "xor_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
-     AE_val (AV_cval (V_call (Bvxor, [v1; v2]), typ))
+    | "xor_bits", [AV_cval (v1, _); AV_cval (v2, _)] when ctyp_equal (cval_ctyp v1) (cval_ctyp v2) ->
+       AE_val (AV_cval (V_call (Bvxor, [v1; v2]), typ))
 
-  | "vector_subrange", [AV_cval (vec, _); AV_cval (f, _); AV_cval (t, _)] ->
-     begin match ctyp_of_typ ctx typ with
-     | CT_fbits (n, true) ->
-        AE_val (AV_cval (V_call (Slice n, [vec; t]), typ))
-     | _ -> no_change
-     end
+    | "vector_subrange", [AV_cval (vec, _); AV_cval (f, _); AV_cval (t, _)] ->
+       begin match convert_typ ctx typ with
+       | CT_fbits (n, true) ->
+          AE_val (AV_cval (V_call (Slice n, [vec; t]), typ))
+       | _ -> no_change
+       end
 
-  | "slice", [AV_cval (vec, _); AV_cval (start, _); AV_cval (len, _)] ->
-     begin match ctyp_of_typ ctx typ with
-     | CT_fbits (n, _) ->
-        AE_val (AV_cval (V_call (Slice n, [vec; start]), typ))
-     | CT_sbits (64, _) ->
-        AE_val (AV_cval (V_call (Sslice 64, [vec; start; len]), typ))
-     | _ -> no_change
-     end
+    | "slice", [AV_cval (vec, _); AV_cval (start, _); AV_cval (len, _)] ->
+       begin match convert_typ ctx typ with
+       | CT_fbits (n, _) ->
+          AE_val (AV_cval (V_call (Slice n, [vec; start]), typ))
+       | CT_sbits (64, _) ->
+          AE_val (AV_cval (V_call (Sslice 64, [vec; start; len]), typ))
+       | _ -> no_change
+       end
 
-  | "vector_access", [AV_cval (vec, _); AV_cval (n, _)] ->
-     AE_val (AV_cval (V_call (Bvaccess, [vec; n]), typ))
+    | "vector_access", [AV_cval (vec, _); AV_cval (n, _)] ->
+       AE_val (AV_cval (V_call (Bvaccess, [vec; n]), typ))
 
-  | "add_int", [AV_cval (op1, _); AV_cval (op2, _)] ->
-     begin match destruct_range Env.empty typ with
-     | None -> no_change
-     | Some (kids, constr, n, m) ->
-        match nexp_simp n, nexp_simp m with
-        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+    | "add_int", [AV_cval (op1, _); AV_cval (op2, _)] ->
+       begin match destruct_range Env.empty typ with
+       | None -> no_change
+       | Some (kids, constr, n, m) ->
+          match nexp_simp n, nexp_simp m with
+          | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
                when Big_int.less_equal (min_int 64) n && Big_int.less_equal m (max_int 64) ->
-           AE_val (AV_cval (V_call (Iadd, [op1; op2]), typ))
-        | n, m when prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) ->
-           AE_val (AV_cval (V_call (Iadd, [op1; op2]), typ))
-        | _ -> no_change
-     end
+             AE_val (AV_cval (V_call (Iadd, [op1; op2]), typ))
+          | n, m when prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) ->
+             AE_val (AV_cval (V_call (Iadd, [op1; op2]), typ))
+          | _ -> no_change
+       end
 
-  | "replicate_bits", [AV_cval (vec, vtyp); _] ->
-     begin match destruct_vector ctx.tc_env typ, destruct_vector ctx.tc_env vtyp with
-     | Some (Nexp_aux (Nexp_constant n, _), _, _), Some (Nexp_aux (Nexp_constant m, _), _, _)
-          when Big_int.less_equal n (Big_int.of_int 64) ->
-        let times = Big_int.div n m in
-        if Big_int.equal (Big_int.mul m times) n then
-          AE_val (AV_cval (V_call (Replicate (Big_int.to_int times), [vec]), typ))
-        else
+    | "replicate_bits", [AV_cval (vec, vtyp); _] ->
+       begin match destruct_vector ctx.tc_env typ, destruct_vector ctx.tc_env vtyp with
+       | Some (Nexp_aux (Nexp_constant n, _), _, _), Some (Nexp_aux (Nexp_constant m, _), _, _)
+            when Big_int.less_equal n (Big_int.of_int 64) ->
+          let times = Big_int.div n m in
+          if Big_int.equal (Big_int.mul m times) n then
+            AE_val (AV_cval (V_call (Replicate (Big_int.to_int times), [vec]), typ))
+          else
+            no_change
+       | _, _ ->
           no_change
-     | _, _ ->
-        no_change
-     end
-
-  | "undefined_bit", _ ->
-     AE_val (AV_cval (V_lit (VL_bit Sail2_values.B0, CT_bit), typ))
+       end
 
-  | "undefined_bool", _ ->
-     AE_val (AV_cval (V_lit (VL_bool false, CT_bool), typ))
+    | "undefined_bit", _ ->
+       AE_val (AV_cval (V_lit (VL_bit Sail2_values.B0, CT_bit), typ))
 
-  | _, _ ->
-     no_change
+    | "undefined_bool", _ ->
+       AE_val (AV_cval (V_lit (VL_bool false, CT_bool), typ))
 
-let analyze_primop ctx id args typ =
-  let no_change = AE_app (id, args, typ) in
-  if !optimize_primops then
-    try analyze_primop' ctx id args typ with
-    | Failure str ->
+    | _, _ ->
        no_change
-  else
-    no_change
+
+  let analyze_primop ctx id args typ =
+    let no_change = AE_app (id, args, typ) in
+    if !optimize_primops then
+      try analyze_primop' ctx id args typ with
+      | Failure str ->
+         no_change
+    else
+      no_change
+
+  let optimize_anf ctx aexp =
+    analyze_functions ctx analyze_primop (c_literals ctx aexp)
+
+
+  let unroll_loops () = None
+  let specialize_calls = false
+  let ignore_64 = false
+  let struct_value = false
+  let use_real = false
+end
 
 (** Functions that have heap-allocated return types are implemented by
    passing a pointer a location where the return value should be
@@ -571,9 +588,9 @@ let fix_early_heap_return ret ret_ctyp instrs =
        before
        @ [iblock (rewrite_return instrs)]
        @ rewrite_return after
-    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), _) :: after ->
+    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (_, l)) :: after ->
        before
-       @ [iif cval (rewrite_return then_instrs) (rewrite_return else_instrs) ctyp]
+       @ [iif l cval (rewrite_return then_instrs) (rewrite_return else_instrs) ctyp]
        @ rewrite_return after
     | before, I_aux (I_funcall (CL_id (Return _, ctyp), extern, fid, args), aux) :: after ->
        before
@@ -608,9 +625,9 @@ let fix_early_stack_return ret ret_ctyp instrs =
        before
        @ [iblock (rewrite_return instrs)]
        @ rewrite_return after
-    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), _) :: after ->
+    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (_, l)) :: after ->
        before
-       @ [iif cval (rewrite_return then_instrs) (rewrite_return else_instrs) ctyp]
+       @ [iif l cval (rewrite_return then_instrs) (rewrite_return else_instrs) ctyp]
        @ rewrite_return after
     | before, I_aux (I_funcall (CL_id (Return _, ctyp), extern, fid, args), aux) :: after ->
        before
@@ -631,7 +648,7 @@ let fix_early_stack_return ret ret_ctyp instrs =
   rewrite_return instrs
 
 let rec insert_heap_returns ret_ctyps = function
-  | (CDEF_spec (id, _, ret_ctyp) as cdef) :: cdefs ->
+  | (CDEF_spec (id, _, _, ret_ctyp) as cdef) :: cdefs ->
      cdef :: insert_heap_returns (Bindings.add id ret_ctyp ret_ctyps) cdefs
 
   | CDEF_fundef (id, None, args, body) :: cdefs ->
@@ -1022,7 +1039,7 @@ let optimize recursive_functions cdefs =
 
 let sgen_id id = Util.zencode_string (string_of_id id)
 let sgen_uid uid = zencode_uid uid
-let sgen_name id = string_of_name id
+let sgen_name id = string_of_name ~deref_current_exception:true ~zencode:true id
 let codegen_id id = string (sgen_id id)
 let codegen_uid id = string (sgen_uid id)
 
@@ -1033,7 +1050,7 @@ let sgen_function_id id =
 let sgen_function_uid uid =
   let str = zencode_uid uid in
   !opt_prefix ^ String.sub str 1 (String.length str - 1)
-  
+
 let codegen_function_id id = string (sgen_function_id id)
 
 let rec sgen_ctyp = function
@@ -1052,6 +1069,7 @@ let rec sgen_ctyp = function
   | CT_variant (id, _) -> "struct " ^ sgen_id id
   | CT_list _ as l -> Util.zencode_string (string_of_ctyp l)
   | CT_vector _ as v -> Util.zencode_string (string_of_ctyp v)
+  | CT_fvector (_, ord, typ) -> sgen_ctyp (CT_vector (ord, typ))
   | CT_string -> "sail_string"
   | CT_real -> "real"
   | CT_ref ctyp -> sgen_ctyp ctyp ^ "*"
@@ -1073,6 +1091,7 @@ let rec sgen_ctyp_name = function
   | CT_variant (id, _) -> sgen_id id
   | CT_list _ as l -> Util.zencode_string (string_of_ctyp l)
   | CT_vector _ as v -> Util.zencode_string (string_of_ctyp v)
+  | CT_fvector (_, ord, typ) -> sgen_ctyp_name (CT_vector (ord, typ))
   | CT_string -> "sail_string"
   | CT_real -> "real"
   | CT_ref ctyp -> "ref_" ^ sgen_ctyp_name ctyp
@@ -1094,24 +1113,27 @@ let sgen_mask n =
   else
     failwith "Tried to create a mask literal for a vector greater than 64 bits."
 
-let sgen_value = function
+let rec sgen_value = function
   | VL_bits ([], _) -> "UINT64_C(0)"
   | VL_bits (bs, true) -> "UINT64_C(" ^ Sail2_values.show_bitlist bs ^ ")"
   | VL_bits (bs, false) -> "UINT64_C(" ^ Sail2_values.show_bitlist (List.rev bs) ^ ")"
   | VL_int i -> Big_int.to_string i ^ "l"
   | VL_bool true -> "true"
   | VL_bool false -> "false"
-  | VL_null -> "NULL"
   | VL_unit -> "UNIT"
   | VL_bit Sail2_values.B0 -> "UINT64_C(0)"
   | VL_bit Sail2_values.B1 -> "UINT64_C(1)"
   | VL_bit Sail2_values.BU -> failwith "Undefined bit found in value"
   | VL_real str -> str
   | VL_string str -> "\"" ^ str ^ "\""
-  
+  | VL_empty_list -> "NULL"
+  | VL_enum element -> Util.zencode_string element
+  | VL_ref r -> "&" ^ Util.zencode_string r
+  | VL_undefined ->
+     Reporting.unreachable Parse_ast.Unknown __POS__ "Cannot generate C value for an undefined literal"
+
 let rec sgen_cval = function
-  | V_id (id, ctyp) -> string_of_name id
-  | V_ref (id, _) -> "&" ^ string_of_name id
+  | V_id (id, ctyp) -> sgen_name id
   | V_lit (vl, ctyp) -> sgen_value vl
   | V_call (op, cvals) -> sgen_call op cvals
   | V_field (f, field) ->
@@ -1133,8 +1155,6 @@ let rec sgen_cval = function
 and sgen_call op cvals =
   let open Printf in
   match op, cvals with
-  | Bit_to_bool, [v] ->
-     sprintf "((bool) %s)" (sgen_cval v)
   | Bnot, [v] -> "!(" ^ sgen_cval v ^ ")"
   | List_hd, [v] ->
      sprintf "(%s).hd" ("*" ^ sgen_cval v)
@@ -1306,6 +1326,7 @@ let sgen_cval_param cval =
 let rec sgen_clexp = function
   | CL_id (Have_exception _, _) -> "have_exception"
   | CL_id (Current_exception _, _) -> "current_exception"
+  | CL_id (Throw_location _, _) -> "throw_location"
   | CL_id (Return _, _) -> assert false
   | CL_id (Name (id, _), _) -> "&" ^ sgen_id id
   | CL_field (clexp, field) -> "&((" ^ sgen_clexp clexp ^ ")->" ^ zencode_uid field ^ ")"
@@ -1317,6 +1338,7 @@ let rec sgen_clexp = function
 let rec sgen_clexp_pure = function
   | CL_id (Have_exception _, _) -> "have_exception"
   | CL_id (Current_exception _, _) -> "current_exception"
+  | CL_id (Throw_location _, _) -> "throw_location"
   | CL_id (Return _, _) -> assert false
   | CL_id (Name (id, _), _) -> sgen_id id
   | CL_field (clexp, field) -> sgen_clexp_pure clexp ^ "." ^ zencode_uid field
@@ -1400,21 +1422,26 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
      ^^ jump 2 2 (separate_map hardline (codegen_instr fid ctx) instrs) ^^ hardline
      ^^ string "  }"
 
-  | I_funcall (x, extern, f, args) ->
+  | I_funcall (x, special_extern, f, args) ->
      let c_args = Util.string_of_list ", " sgen_cval args in
      let ctyp = clexp_ctyp x in
-     let is_extern = Env.is_extern (fst f) ctx.tc_env "c" || extern in
+     let is_extern = Env.is_extern (fst f) ctx.tc_env "c" || special_extern in
      let fname =
-       if Env.is_extern (fst f) ctx.tc_env "c" then
-         Env.get_extern (fst f) ctx.tc_env "c"
-       else if extern then
+       if special_extern then
          string_of_id (fst f)
+       else if Env.is_extern (fst f) ctx.tc_env "c" then
+         Env.get_extern (fst f) ctx.tc_env "c"
        else
          sgen_function_uid f
      in
      let fname =
        match fname, ctyp with
        | "internal_pick", _ -> Printf.sprintf "pick_%s" (sgen_ctyp_name ctyp)
+       | "cons", _ ->
+          begin match snd f with
+          | [ctyp] -> Util.zencode_string ("cons#" ^ string_of_ctyp ctyp)
+          | _ -> c_error "cons without specified type"
+          end
        | "eq_anything", _ ->
           begin match args with
           | cval :: _ -> Printf.sprintf "eq_%s" (sgen_ctyp_name (cval_ctyp cval))
@@ -1765,6 +1792,8 @@ let codegen_type_def ctx = function
           ^^ string "struct zexception *current_exception = NULL;"
           ^^ hardline
           ^^ string "bool have_exception = false;"
+          ^^ hardline
+          ^^ string "sail_string *throw_location = NULL;"
         else
           empty
 
@@ -1994,7 +2023,7 @@ let codegen_def' ctx = function
      string (Printf.sprintf "// register %s" (string_of_id id)) ^^ hardline
      ^^ string (Printf.sprintf "%s %s;" (sgen_ctyp ctyp) (sgen_id id))
 
-  | CDEF_spec (id, arg_ctyps, ret_ctyp) ->
+  | CDEF_spec (id, _, arg_ctyps, ret_ctyp) ->
      let static = if !opt_static then "static " else "" in
      if Env.is_extern id ctx.tc_env "c" then
        empty
@@ -2009,7 +2038,7 @@ let codegen_def' ctx = function
        | None ->
           c_error ~loc:(id_loc id) ("No valspec found for " ^ string_of_id id)
      in
- 
+
      (* Check that the function has the correct arity at this point. *)
      if List.length arg_ctyps <> List.length args then
        c_error ~loc:(id_loc id) ("function arguments "
@@ -2095,7 +2124,7 @@ type c_gen_typ =
 let rec ctyp_dependencies = function
   | CT_tup ctyps -> List.concat (List.map ctyp_dependencies ctyps) @ [CTG_tup ctyps]
   | CT_list ctyp -> ctyp_dependencies ctyp @ [CTG_list ctyp]
-  | CT_vector (direction, ctyp) -> ctyp_dependencies ctyp @ [CTG_vector (direction, ctyp)]
+  | CT_vector (direction, ctyp) | CT_fvector (_, direction, ctyp) -> ctyp_dependencies ctyp @ [CTG_vector (direction, ctyp)]
   | CT_ref ctyp -> ctyp_dependencies ctyp
   | CT_struct (_, ctors) -> List.concat (List.map (fun (_, ctyp) -> ctyp_dependencies ctyp) ctors)
   | CT_variant (_, ctors) -> List.concat (List.map (fun (_, ctyp) -> ctyp_dependencies ctyp) ctors)
@@ -2169,20 +2198,17 @@ let rec get_recursive_functions (Defs defs) =
   | [] -> IdSet.empty
 
 let jib_of_ast env ast =
-  let ctx =
-    initial_ctx
-      ~convert_typ:ctyp_of_typ
-      ~optimize_anf:(fun ctx aexp -> analyze_functions ctx analyze_primop (c_literals ctx aexp))
-      env
-  in
-  Jib_compile.compile_ast ctx ast
+  let module Jibc = Make(C_config) in
+  let ctx = initial_ctx (add_special_functions env) in
+  Jibc.compile_ast ctx ast
 
 let compile_ast env output_chan c_includes ast =
   try
     let recursive_functions = Spec_analysis.top_sort_defs ast |> get_recursive_functions in
 
     let cdefs, ctx = jib_of_ast env ast in
-    Jib_interactive.ir := cdefs;
+    let cdefs', _ = Jib_optimize.remove_tuples cdefs ctx in
+    Jib_interactive.ir := cdefs';
     let cdefs = insert_heap_returns Bindings.empty cdefs in
     let cdefs = optimize recursive_functions cdefs in
 
@@ -2199,10 +2225,15 @@ let compile_ast env output_chan c_includes ast =
     let exn_boilerplate =
       if not (Bindings.mem (mk_id "exception") ctx.variants) then ([], []) else
         ([ "  current_exception = sail_malloc(sizeof(struct zexception));";
-           "  CREATE(zexception)(current_exception);" ],
-         [ "  KILL(zexception)(current_exception);";
+           "  CREATE(zexception)(current_exception);";
+           "  throw_location = sail_malloc(sizeof(sail_string));";
+           "  CREATE(sail_string)(throw_location);" ],
+         [ "  if (have_exception) {fprintf(stderr, \"Exiting due to uncaught exception: %s\\n\", *throw_location);}";
+           "  KILL(zexception)(current_exception);";
            "  sail_free(current_exception);";
-           "  if (have_exception) {fprintf(stderr, \"Exiting due to uncaught exception\\n\"); exit(EXIT_FAILURE);}" ])
+           "  KILL(sail_string)(throw_location);";
+           "  sail_free(throw_location);";
+           "  if (have_exception) {exit(EXIT_FAILURE);}" ])
     in
 
     let letbind_initializers =
diff --git a/src/jib/c_backend.mli b/src/jib/c_backend.mli
index 2f748fd7..e627ebd8 100644
--- a/src/jib/c_backend.mli
+++ b/src/jib/c_backend.mli
@@ -106,8 +106,5 @@ val optimize_alias : bool ref
 val optimize_fixed_int : bool ref
 val optimize_fixed_bits : bool ref
 
-(** Convert a typ to a IR ctyp *)
-val ctyp_of_typ : Jib_compile.ctx -> Ast.typ -> ctyp
-
 val jib_of_ast : Env.t -> tannot Ast.defs -> cdef list * Jib_compile.ctx
 val compile_ast : Env.t -> out_channel -> string list -> tannot Ast.defs -> unit
diff --git a/src/jib/jib_compile.ml b/src/jib/jib_compile.ml
index 0efac940..4282ae30 100644
--- a/src/jib/jib_compile.ml
+++ b/src/jib/jib_compile.ml
@@ -58,6 +58,7 @@ open Value2
 open Anf
 
 let opt_memo_cache = ref false
+let opt_track_throw = ref true
 
 let optimize_aarch64_fast_struct = ref false
 
@@ -151,38 +152,38 @@ type ctx =
     enums : IdSet.t Bindings.t;
     variants : (ctyp UBindings.t) Bindings.t;
     valspecs : (ctyp list * ctyp) Bindings.t;
-    tc_env : Env.t;
     local_env : Env.t;
+    tc_env : Env.t;
     locals : (mut * ctyp) Bindings.t;
     letbinds : int list;
     no_raw : bool;
-    convert_typ : ctx -> typ -> ctyp;
-    optimize_anf : ctx -> typ aexp -> typ aexp;
-    specialize_calls : bool;
-    ignore_64 : bool;
-    struct_value : bool;
-    use_real : bool;
   }
 
-let initial_ctx ~convert_typ:convert_typ ~optimize_anf:optimize_anf env =
+let initial_ctx env =
   { records = Bindings.empty;
     enums = Bindings.empty;
     variants = Bindings.empty;
     valspecs = Bindings.empty;
-    tc_env = env;
     local_env = env;
+    tc_env = env;
     locals = Bindings.empty;
     letbinds = [];
     no_raw = false;
-    convert_typ = convert_typ;
-    optimize_anf = optimize_anf;
-    specialize_calls = false;
-    ignore_64 = false;
-    struct_value = false;
-    use_real = false;
   }
 
-let ctyp_of_typ ctx typ = ctx.convert_typ ctx typ
+module type Config = sig
+  val convert_typ : ctx -> typ -> ctyp
+  val optimize_anf : ctx -> typ aexp -> typ aexp
+  val unroll_loops : unit -> int option
+  val specialize_calls : bool
+  val ignore_64 : bool
+  val struct_value : bool
+  val use_real : bool
+end
+
+module Make(C: Config) = struct
+
+let ctyp_of_typ ctx typ = C.convert_typ ctx typ
 
 let rec chunkify n xs =
   match Util.take n xs, Util.drop n xs with
@@ -210,12 +211,12 @@ let rec compile_aval l ctx = function
      end
 
   | AV_ref (id, typ) ->
-     [], V_ref (name id, ctyp_of_typ ctx (lvar_typ typ)), []
+     [], V_lit (VL_ref (string_of_id id), CT_ref (ctyp_of_typ ctx (lvar_typ typ))), []
 
   | AV_lit (L_aux (L_string str, _), typ) ->
      [], V_lit ((VL_string (String.escaped str)), ctyp_of_typ ctx typ), []
 
-  | AV_lit (L_aux (L_num n, _), typ) when ctx.ignore_64 ->
+  | AV_lit (L_aux (L_num n, _), typ) when C.ignore_64 ->
      [], V_lit ((VL_int n), ctyp_of_typ ctx typ), []
 
   | AV_lit (L_aux (L_num n, _), typ) when Big_int.less_equal (min_int 64) n && Big_int.less_equal n (max_int 64) ->
@@ -237,7 +238,7 @@ let rec compile_aval l ctx = function
   | AV_lit (L_aux (L_false, _), _) -> [], V_lit (VL_bool false, CT_bool), []
 
   | AV_lit (L_aux (L_real str, _), _) ->
-     if ctx.use_real then
+     if C.use_real then
        [], V_lit (VL_real str, CT_real), []
      else
        let gs = ngensym () in
@@ -247,6 +248,10 @@ let rec compile_aval l ctx = function
 
   | AV_lit (L_aux (L_unit, _), _) -> [], V_lit (VL_unit, CT_unit), []
 
+  | AV_lit (L_aux (L_undef, _), typ) ->
+     let ctyp = ctyp_of_typ ctx typ in
+     [], V_lit (VL_undefined, ctyp), []
+
   | AV_lit (L_aux (_, l) as lit, _) ->
      raise (Reporting.err_general l ("Encountered unexpected literal " ^ string_of_lit lit ^ " when converting ANF represention into IR"))
 
@@ -264,7 +269,7 @@ let rec compile_aval l ctx = function
      [iclear tup_ctyp gs]
      @ cleanup
 
-  | AV_record (fields, typ) when ctx.struct_value ->
+  | AV_record (fields, typ) when C.struct_value ->
      let ctyp = ctyp_of_typ ctx typ in
      let gs = ngensym () in
      let compile_fields (id, aval) =
@@ -309,7 +314,7 @@ let rec compile_aval l ctx = function
      end
 
   (* Convert a small bitvector to a uint64_t literal. *)
-  | AV_vector (avals, typ) when is_bitvector avals && (List.length avals <= 64 || ctx.ignore_64) ->
+  | AV_vector (avals, typ) when is_bitvector avals && (List.length avals <= 64 || C.ignore_64) ->
      begin
        let bitstring = List.map value_of_aval_bit avals in
        let len = List.length avals in
@@ -358,11 +363,14 @@ let rec compile_aval l ctx = function
        | V_lit (VL_bit Sail2_values.B1, _) ->
           [icopy l (CL_id (gs, ctyp)) (V_call (Bvor, [V_id (gs, ctyp); V_lit (mask i, ctyp)]))]
        | _ ->
-          (* FIXME: Make this work in C *)
-          setup @ [iif (V_call (Bit_to_bool, [cval])) [icopy l (CL_id (gs, ctyp)) (V_call (Bvor, [V_id (gs, ctyp); V_lit (mask i, ctyp)]))] [] CT_unit] @ cleanup
+          setup
+          @ [iextern (CL_id (gs, ctyp))
+                     (mk_id "update_fbits", [])
+                     [V_id (gs, ctyp); V_lit (VL_int (Big_int.of_int i), CT_fint 64); cval]]
+          @ cleanup
      in
      [idecl ctyp gs;
-      icopy l (CL_id (gs, ctyp)) (V_lit (VL_bits (Util.list_init 64 (fun _ -> Sail2_values.B0), direction), ctyp))]
+      icopy l (CL_id (gs, ctyp)) (V_lit (VL_bits (Util.list_init len (fun _ -> Sail2_values.B0), direction), ctyp))]
      @ List.concat (List.mapi aval_mask (List.rev avals)),
      V_id (gs, ctyp),
      []
@@ -403,7 +411,7 @@ let rec compile_aval l ctx = function
      let gs = ngensym () in
      let mk_cons aval =
        let setup, cval, cleanup = compile_aval l ctx aval in
-       setup @ [ifuncall (CL_id (gs, CT_list ctyp)) (mk_id ("cons#" ^ string_of_ctyp ctyp), []) [cval; V_id (gs, CT_list ctyp)]] @ cleanup
+       setup @ [iextern (CL_id (gs, CT_list ctyp)) (mk_id "cons", [ctyp]) [cval; V_id (gs, CT_list ctyp)]] @ cleanup
      in
      [idecl (CT_list ctyp) gs]
      @ List.concat (List.map mk_cons (List.rev avals)),
@@ -420,7 +428,7 @@ let optimize_call l ctx clexp id args arg_ctyps ret_ctyp =
           let have_ctyp = cval_ctyp cval in
           if is_polymorphic ctyp then
             V_poly (cval, have_ctyp)
-          else if ctx.specialize_calls || ctyp_equal ctyp have_ctyp then
+          else if C.specialize_calls || ctyp_equal ctyp have_ctyp then
             cval
           else
             let gs = ngensym () in
@@ -429,7 +437,7 @@ let optimize_call l ctx clexp id args arg_ctyps ret_ctyp =
             V_id (gs, ctyp))
         arg_ctyps args
     in
-    if ctx.specialize_calls || ctyp_equal (clexp_ctyp clexp) ret_ctyp then
+    if C.specialize_calls || ctyp_equal (clexp_ctyp clexp) ret_ctyp then
       !setup @ [ifuncall clexp id cast_args] @ !cleanup
     else
       let gs = ngensym () in
@@ -440,7 +448,7 @@ let optimize_call l ctx clexp id args arg_ctyps ret_ctyp =
          iclear ret_ctyp gs]
       @ !cleanup
   in
-  if not ctx.specialize_calls && Env.is_extern (fst id) ctx.tc_env "c" then
+  if not C.specialize_calls && Env.is_extern (fst id) ctx.tc_env "c" then
     let extern = Env.get_extern (fst id) ctx.tc_env "c" in
     begin match extern, List.map cval_ctyp args, clexp_ctyp clexp with
     | "slice", [CT_fbits _; CT_lint; _], CT_fbits (n, _) ->
@@ -506,7 +514,7 @@ let rec compile_match ctx (AP_aux (apat_aux, env, l)) cval case_label =
   let ctyp = cval_ctyp cval in
   match apat_aux with
   | AP_id (pid, _) when Env.is_union_constructor pid ctx.tc_env ->
-     [ijump (V_ctor_kind (cval, pid, [], cval_ctyp cval)) case_label],
+     [ijump l (V_ctor_kind (cval, pid, [], cval_ctyp cval)) case_label],
      [],
      ctx
 
@@ -517,7 +525,7 @@ let rec compile_match ctx (AP_aux (apat_aux, env, l)) cval case_label =
   | AP_id (pid, _) when is_ct_enum ctyp ->
      begin match Env.lookup_id pid ctx.tc_env with
      | Unbound -> [idecl ctyp (name pid); icopy l (CL_id (name pid, ctyp)) cval], [], ctx
-     | _ -> [ijump (V_call (Neq, [V_id (name pid, ctyp); cval])) case_label], [], ctx
+     | _ -> [ijump l (V_call (Neq, [V_id (name pid, ctyp); cval])) case_label], [], ctx
      end
 
   | AP_id (pid, typ) ->
@@ -562,7 +570,7 @@ let rec compile_match ctx (AP_aux (apat_aux, env, l)) cval case_label =
             [], ctor_ctyp
         in
         let instrs, cleanup, ctx = compile_match ctx apat (V_ctor_unwrap (ctor, cval, unifiers, ctor_ctyp)) case_label in
-        [ijump (V_ctor_kind (cval, ctor, unifiers, pat_ctyp)) case_label]
+        [ijump l (V_ctor_kind (cval, ctor, unifiers, pat_ctyp)) case_label]
         @ instrs,
         cleanup,
         ctx
@@ -581,12 +589,12 @@ let rec compile_match ctx (AP_aux (apat_aux, env, l)) cval case_label =
      | CT_list ctyp ->
         let hd_setup, hd_cleanup, ctx = compile_match ctx hd_apat (V_call (List_hd, [cval])) case_label in
         let tl_setup, tl_cleanup, ctx = compile_match ctx tl_apat (V_call (List_tl, [cval])) case_label in
-        [ijump (V_call (Eq, [cval; V_lit (VL_null, CT_list ctyp)])) case_label] @ hd_setup @ tl_setup, tl_cleanup @ hd_cleanup, ctx
+        [ijump l (V_call (Eq, [cval; V_lit (VL_empty_list, CT_list ctyp)])) case_label] @ hd_setup @ tl_setup, tl_cleanup @ hd_cleanup, ctx
      | _ ->
         raise (Reporting.err_general l "Tried to pattern match cons on non list type")
      end
 
-  | AP_nil _ -> [ijump (V_call (Neq, [cval; V_lit (VL_null, ctyp)])) case_label], [], ctx
+  | AP_nil _ -> [ijump l (V_call (Neq, [cval; V_lit (VL_empty_list, ctyp)])) case_label], [], ctx
 
 let unit_cval = V_lit (VL_unit, CT_unit)
 
@@ -633,7 +641,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
          destructure
          @ (if not trivial_guard then
               guard_setup @ [idecl CT_bool gs; guard_call (CL_id (gs, CT_bool))] @ guard_cleanup
-              @ [iif (V_call (Bnot, [V_id (gs, CT_bool)])) (destructure_cleanup @ [igoto case_label]) [] CT_unit]
+              @ [iif l (V_call (Bnot, [V_id (gs, CT_bool)])) (destructure_cleanup @ [igoto case_label]) [] CT_unit]
             else [])
          @ body_setup @ [body_call (CL_id (case_return_id, ctyp))] @ body_cleanup @ destructure_cleanup
          @ [igoto finish_match_label]
@@ -674,7 +682,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
          destructure @ [icomment "end destructuring"]
          @ (if not trivial_guard then
               guard_setup @ [idecl CT_bool gs; guard_call (CL_id (gs, CT_bool))] @ guard_cleanup
-              @ [ijump (V_call (Bnot, [V_id (gs, CT_bool)])) try_label]
+              @ [ijump l (V_call (Bnot, [V_id (gs, CT_bool)])) try_label]
               @ [icomment "end guard"]
             else [])
          @ body_setup @ [body_call (CL_id (try_return_id, ctyp))] @ body_cleanup @ destructure_cleanup
@@ -685,7 +693,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      assert (ctyp_equal ctyp (ctyp_of_typ ctx typ));
      [idecl ctyp try_return_id;
       itry_block (aexp_setup @ [aexp_call (CL_id (try_return_id, ctyp))] @ aexp_cleanup);
-      ijump (V_call (Bnot, [V_id (have_exception, CT_bool)])) handled_exception_label]
+      ijump l (V_call (Bnot, [V_id (have_exception, CT_bool)])) handled_exception_label]
      @ List.concat (List.map compile_case cases)
      @ [igoto fallthrough_label;
         ilabel handled_exception_label;
@@ -707,7 +715,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
        in
        let setup, cval, cleanup = compile_aval l ctx aval in
        setup,
-       (fun clexp -> iif cval
+       (fun clexp -> iif l cval
                          (compile_branch then_aexp clexp)
                          (compile_branch else_aexp clexp)
                          if_ctyp),
@@ -742,7 +750,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      let gs = ngensym () in
      left_setup
      @ [ idecl CT_bool gs;
-         iif cval
+         iif l cval
              (right_setup @ [call (CL_id (gs, CT_bool))] @ right_cleanup)
              [icopy l (CL_id (gs, CT_bool)) (V_lit (VL_bool false, CT_bool))]
              CT_bool ]
@@ -755,7 +763,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      let gs = ngensym () in
      left_setup
      @ [ idecl CT_bool gs;
-         iif cval
+         iif l cval
              [icopy l (CL_id (gs, CT_bool)) (V_lit (VL_bool true, CT_bool))]
              (right_setup @ [call (CL_id (gs, CT_bool))] @ right_cleanup)
              CT_bool ]
@@ -813,7 +821,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      @ [iblock (cond_setup
                 @ [cond_call (CL_id (gs, CT_bool))]
                 @ cond_cleanup
-                @ [ijump loop_test loop_end_label]
+                @ [ijump l loop_test loop_end_label]
                 @ body_setup
                 @ [body_call (CL_id (unit_gs, CT_unit))]
                 @ body_cleanup
@@ -838,7 +846,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
                 @ cond_setup
                 @ [cond_call (CL_id (gs, CT_bool))]
                 @ cond_cleanup
-                @ [ijump loop_test loop_end_label]
+                @ [ijump l loop_test loop_end_label]
                 @ [igoto loop_start_label])]
      @ [ilabel loop_end_label],
      (fun clexp -> icopy l clexp unit_cval),
@@ -869,7 +877,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
   | AE_throw (aval, typ) ->
      (* Cleanup info will be handled by fix_exceptions *)
      let throw_setup, cval, _ = compile_aval l ctx aval in
-     throw_setup @ [ithrow cval],
+     throw_setup @ [ithrow l cval],
      (fun clexp -> icomment "unreachable after throw"),
      []
 
@@ -927,21 +935,29 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
 
      let loop_var = name loop_var in
 
+     let loop_body prefix continue =
+       prefix
+       @ [iblock ([ijump l (V_call ((if is_inc then Igt else Ilt), [V_id (loop_var, CT_fint 64); V_id (to_gs, CT_fint 64)])) loop_end_label]
+                  @ body_setup
+                  @ [body_call (CL_id (body_gs, CT_unit))]
+                  @ body_cleanup
+                  @ [icopy l (CL_id (loop_var, (CT_fint 64)))
+                       (V_call ((if is_inc then Iadd else Isub), [V_id (loop_var, CT_fint 64); V_id (step_gs, CT_fint 64)]))]
+                  @ continue ())]
+     in
+     (* We can either generate an actual loop body for C, or unroll the body for SMT *)
+     let actual = loop_body [ilabel loop_start_label] (fun () -> [igoto loop_start_label]) in
+     let rec unroll max n = loop_body [] (fun () -> if n < max then unroll max (n + 1) else [imatch_failure ()]) in
+     let body = match C.unroll_loops () with Some times -> unroll times 0 | None -> actual in
+
      variable_init from_gs from_setup from_call from_cleanup
      @ variable_init to_gs to_setup to_call to_cleanup
      @ variable_init step_gs step_setup step_call step_cleanup
      @ [iblock ([idecl (CT_fint 64) loop_var;
                  icopy l (CL_id (loop_var, (CT_fint 64))) (V_id (from_gs, CT_fint 64));
-                 idecl CT_unit body_gs;
-                 iblock ([ilabel loop_start_label]
-                         @ [ijump (V_call ((if is_inc then Igt else Ilt), [V_id (loop_var, CT_fint 64); V_id (to_gs, CT_fint 64)])) loop_end_label]
-                         @ body_setup
-                         @ [body_call (CL_id (body_gs, CT_unit))]
-                         @ body_cleanup
-                         @ [icopy l (CL_id (loop_var, (CT_fint 64)))
-                                  (V_call ((if is_inc then Iadd else Isub), [V_id (loop_var, CT_fint 64); V_id (step_gs, CT_fint 64)]))]
-                         @ [igoto loop_start_label]);
-                 ilabel loop_end_label])],
+                 idecl CT_unit body_gs]
+                @ body
+                @ [ilabel loop_end_label])],
      (fun clexp -> icopy l clexp unit_cval),
      []
 
@@ -1032,19 +1048,23 @@ let fix_exception_block ?return:(return=None) ctx instrs =
        before
        @ [iblock (rewrite_exception (historic @ before) instrs)]
        @ rewrite_exception (historic @ before) after
-    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), _) :: after ->
+    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (_, l)) :: after ->
        let historic = historic @ before in
        before
-       @ [iif cval (rewrite_exception historic then_instrs) (rewrite_exception historic else_instrs) ctyp]
+       @ [iif l cval (rewrite_exception historic then_instrs) (rewrite_exception historic else_instrs) ctyp]
        @ rewrite_exception historic after
     | before, I_aux (I_throw cval, (_, l)) :: after ->
        before
        @ [icopy l (CL_id (current_exception, cval_ctyp cval)) cval;
           icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool true, CT_bool))]
+       @ (if !opt_track_throw then
+            let loc_string = Reporting.short_loc_to_string l in
+            [icopy l (CL_id (throw_location, CT_string)) (V_lit (VL_string loc_string, CT_string))]
+          else [])
        @ generate_cleanup (historic @ before)
        @ [igoto end_block_label]
        @ rewrite_exception (historic @ before) after
-    | before, (I_aux (I_funcall (x, _, f, args), _) as funcall) :: after ->
+    | before, (I_aux (I_funcall (x, _, f, args), (_, l)) as funcall) :: after ->
        let effects = match Env.get_val_spec (fst f) ctx.tc_env with
          | _, Typ_aux (Typ_fn (_, _, effects), _) -> effects
          | exception (Type_error _) -> no_effect (* nullary union constructor, so no val spec *)
@@ -1053,7 +1073,7 @@ let fix_exception_block ?return:(return=None) ctx instrs =
        if has_effect effects BE_escape then
          before
          @ [funcall;
-            iif (V_id (have_exception, CT_bool)) (generate_cleanup (historic @ before) @ [igoto end_block_label]) [] CT_unit]
+            iif l (V_id (have_exception, CT_bool)) (generate_cleanup (historic @ before) @ [igoto end_block_label]) [] CT_unit]
          @ rewrite_exception (historic @ before) after
        else
          before @ funcall :: rewrite_exception (historic @ before) after
@@ -1147,10 +1167,10 @@ let fix_early_return ret instrs =
        before
        @ [iblock (rewrite_return (historic @ before) instrs)]
        @ rewrite_return (historic @ before) after
-    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), _) :: after ->
+    | before, I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (_, l)) :: after ->
        let historic = historic @ before in
        before
-       @ [iif cval (rewrite_return historic then_instrs) (rewrite_return historic else_instrs) ctyp]
+       @ [iif l cval (rewrite_return historic then_instrs) (rewrite_return historic else_instrs) ctyp]
        @ rewrite_return historic after
     | before, I_aux (I_return cval, (_, l)) :: after ->
        let cleanup_label = label "cleanup_" in
@@ -1211,7 +1231,7 @@ let compile_funcl ctx id pat guard exp =
 
   let guard_instrs = match guard with
     | Some guard ->
-       let guard_aexp = ctx.optimize_anf ctx (no_shadow (pat_ids pat) (anf guard)) in
+       let guard_aexp = C.optimize_anf ctx (no_shadow (pat_ids pat) (anf guard)) in
        let guard_setup, guard_call, guard_cleanup = compile_aexp ctx guard_aexp in
        let guard_label = label "guard_" in
        let gs = ngensym () in
@@ -1220,7 +1240,7 @@ let compile_funcl ctx id pat guard exp =
             @ guard_setup
             @ [guard_call (CL_id (gs, CT_bool))]
             @ guard_cleanup
-            @ [ijump (V_id (gs, CT_bool)) guard_label;
+            @ [ijump (id_loc id) (V_id (gs, CT_bool)) guard_label;
                imatch_failure ();
                ilabel guard_label]
        )]
@@ -1228,7 +1248,7 @@ let compile_funcl ctx id pat guard exp =
   in
 
   (* Optimize and compile the expression to ANF. *)
-  let aexp = ctx.optimize_anf ctx (no_shadow (pat_ids pat) (anf exp)) in
+  let aexp = C.optimize_anf ctx (no_shadow (pat_ids pat) (anf exp)) in
 
   let setup, call, cleanup = compile_aexp ctx aexp in
   let destructure, destructure_cleanup =
@@ -1280,7 +1300,7 @@ and compile_def' n total ctx = function
   | DEF_reg_dec (DEC_aux (DEC_reg (_, _, typ, id), _)) ->
      [CDEF_reg_dec (id, ctyp_of_typ ctx typ, [])], ctx
   | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), _)) ->
-     let aexp = ctx.optimize_anf ctx (no_shadow IdSet.empty (anf exp)) in
+     let aexp = C.optimize_anf ctx (no_shadow IdSet.empty (anf exp)) in
      let setup, call, cleanup = compile_aexp ctx aexp in
      let instrs = setup @ [call (CL_id (name id, ctyp_of_typ ctx typ))] @ cleanup in
      [CDEF_reg_dec (id, ctyp_of_typ ctx typ, instrs)], ctx
@@ -1290,13 +1310,19 @@ and compile_def' n total ctx = function
 
   | DEF_spec (VS_aux (VS_val_spec (_, id, _, _), _)) ->
      let quant, Typ_aux (fn_typ, _) = Env.get_val_spec id ctx.tc_env in
+     let extern =
+       if Env.is_extern id ctx.tc_env "c" then
+         Some (Env.get_extern id ctx.tc_env "c")
+       else
+         None
+     in
      let arg_typs, ret_typ = match fn_typ with
        | Typ_fn (arg_typs, ret_typ, _) -> arg_typs, ret_typ
        | _ -> assert false
      in
      let ctx' = { ctx with local_env = add_typquant (id_loc id) quant ctx.local_env } in
      let arg_ctyps, ret_ctyp = List.map (ctyp_of_typ ctx') arg_typs, ctyp_of_typ ctx' ret_typ in
-     [CDEF_spec (id, arg_ctyps, ret_ctyp)],
+     [CDEF_spec (id, extern, arg_ctyps, ret_ctyp)],
      { ctx with valspecs = Bindings.add id (arg_ctyps, ret_ctyp) ctx.valspecs }
 
   | DEF_fundef (FD_aux (FD_function (_, _, _, [FCL_aux (FCL_Funcl (id, Pat_aux (Pat_exp (pat, exp), _)), _)]), _)) ->
@@ -1323,7 +1349,7 @@ and compile_def' n total ctx = function
 
   | DEF_val (LB_aux (LB_val (pat, exp), _)) ->
      let ctyp = ctyp_of_typ ctx (typ_of_pat pat) in
-     let aexp = ctx.optimize_anf ctx (no_shadow IdSet.empty (anf exp)) in
+     let aexp = C.optimize_anf ctx (no_shadow IdSet.empty (anf exp)) in
      let setup, call, cleanup = compile_aexp ctx aexp in
      let apat = anf_pat ~global:true pat in
      let gs = ngensym () in
@@ -1544,12 +1570,6 @@ let sort_ctype_defs cdefs =
   ctype_defs @ cdefs
 
 let compile_ast ctx (Defs defs) =
-  let assert_vs = Initial_check.extern_of_string (mk_id "sail_assert") "(bool, string) -> unit" in
-  let exit_vs = Initial_check.extern_of_string (mk_id "sail_exit") "unit -> unit" in
-  let cons_vs = Initial_check.extern_of_string (mk_id "sail_cons") "forall ('a : Type). ('a, list('a)) -> list('a)" in
-
-  let ctx = { ctx with tc_env = snd (Type_error.check ctx.tc_env (Defs [assert_vs; exit_vs; cons_vs])) } in
-
   if !opt_memo_cache then
     (try
        if Sys.is_directory "_sbuild" then
@@ -1568,3 +1588,12 @@ let compile_ast ctx (Defs defs) =
   let cdefs, ctx = specialize_variants ctx [] cdefs in
   let cdefs = sort_ctype_defs cdefs in
   cdefs, ctx
+
+end
+
+let add_special_functions env =
+  let assert_vs = Initial_check.extern_of_string (mk_id "sail_assert") "(bool, string) -> unit" in
+  let exit_vs = Initial_check.extern_of_string (mk_id "sail_exit") "unit -> unit" in
+  let cons_vs = Initial_check.extern_of_string (mk_id "sail_cons") "forall ('a : Type). ('a, list('a)) -> list('a)" in
+
+  snd (Type_error.check env (Defs [assert_vs; exit_vs; cons_vs]))
diff --git a/src/jib/jib_compile.mli b/src/jib/jib_compile.mli
index 273e9e03..9014d8f7 100644
--- a/src/jib/jib_compile.mli
+++ b/src/jib/jib_compile.mli
@@ -58,53 +58,69 @@ open Type_check
 
 (** This forces all integer struct fields to be represented as
    int64_t. Specifically intended for the various TLB structs in the
-   ARM v8.5 spec. *)
+   ARM v8.5 spec. It is unsound in general. *)
 val optimize_aarch64_fast_struct : bool ref
 
+(** If true (default) track the location of the last exception thrown,
+   useful for debugging C but we want to turn it off for SMT generation
+   where we can't use strings *)
+val opt_track_throw : bool ref
+ 
 (** {2 Jib context} *)
 
-(** Context for compiling Sail to Jib. We need to pass a (global)
-   typechecking environment given by checking the full AST. We have to
-   provide a conversion function from Sail types into Jib types, as
-   well as a function that optimizes ANF expressions (which can just
-   be the identity function) *)
+(** Dynamic context for compiling Sail to Jib. We need to pass a
+   (global) typechecking environment given by checking the full
+   AST. *)
 type ctx =
   { records : (ctyp Jib_util.UBindings.t) Bindings.t;
     enums : IdSet.t Bindings.t;
     variants : (ctyp Jib_util.UBindings.t) Bindings.t;
     valspecs : (ctyp list * ctyp) Bindings.t;
-    tc_env : Env.t;
     local_env : Env.t;
+    tc_env : Env.t;
     locals : (mut * ctyp) Bindings.t;
     letbinds : int list;
     no_raw : bool;
-    convert_typ : ctx -> typ -> ctyp;
-    optimize_anf : ctx -> typ aexp -> typ aexp;
-    (** If false (default), function arguments must match the function
-       type exactly. If true, they can be more specific. *)
-    specialize_calls : bool;
-    (** If false (default), will ensure that fixed size bitvectors are
-       specifically less that 64-bits. If true this restriction will
-       be ignored. *)
-    ignore_64 : bool;
-    (** If false (default) we won't generate any V_struct values *)
-    struct_value : bool;
-    (** Allow real literals *)
-    use_real : bool;
   }
 
-val initial_ctx :
-  convert_typ:(ctx -> typ -> ctyp) ->
-  optimize_anf:(ctx -> typ aexp -> typ aexp) ->
-  Env.t ->
-  ctx
+val initial_ctx : Env.t -> ctx
 
 (** {2 Compilation functions} *)
 
-(** Compile a Sail definition into a Jib definition. The first two
-   arguments are is the current definition number and the total number
-   of definitions, and can be used to drive a progress bar (see
-   Util.progress). *)
-val compile_def : int -> int -> ctx -> tannot def -> cdef list * ctx
+(** The Config module specifies static configuration for compiling
+   Sail into Jib.  We have to provide a conversion function from Sail
+   types into Jib types, as well as a function that optimizes ANF
+   expressions (which can just be the identity function) *)
+module type Config = sig
+  val convert_typ : ctx -> typ -> ctyp
+  val optimize_anf : ctx -> typ aexp -> typ aexp
+  (** Unroll all for loops a bounded number of times. Used for SMT
+       generation. *)
+  val unroll_loops : unit -> int option
+  (** If false, function arguments must match the function
+       type exactly. If true, they can be more specific. *)
+  val specialize_calls : bool
+  (** If false, will ensure that fixed size bitvectors are
+       specifically less that 64-bits. If true this restriction will
+       be ignored. *)
+  val ignore_64 : bool
+  (** If false we won't generate any V_struct values *)
+  val struct_value : bool
+  (** Allow real literals *)
+  val use_real : bool
+end
+
+module Make(C: Config) : sig
+  (** Compile a Sail definition into a Jib definition. The first two
+       arguments are is the current definition number and the total
+       number of definitions, and can be used to drive a progress bar
+       (see Util.progress). *)
+  val compile_def : int -> int -> ctx -> tannot def -> cdef list * ctx
+
+  val compile_ast : ctx -> tannot defs -> cdef list * ctx
+end
 
-val compile_ast : ctx -> tannot defs -> cdef list * ctx
+(** Adds some special functions to the environment that are used to
+   convert several Sail language features, these are sail_assert,
+   sail_exit, and sail_cons. *)
+val add_special_functions : Env.t -> Env.t
diff --git a/src/jib/jib_ir.ml b/src/jib/jib_ir.ml
index c5f2b20a..4bf726aa 100644
--- a/src/jib/jib_ir.ml
+++ b/src/jib/jib_ir.ml
@@ -69,7 +69,9 @@ let string_of_name =
      "return" ^ ssa_num n
   | Current_exception n ->
      "current_exception" ^ ssa_num n
-
+  | Throw_location n ->
+     "throw_location" ^ ssa_num n
+    
 let rec string_of_clexp = function
   | CL_id (id, ctyp) -> string_of_name id
   | CL_field (clexp, field) -> string_of_clexp clexp ^ "." ^ string_of_uid field
@@ -107,7 +109,9 @@ module Ir_formatter = struct
       | I_label label ->
          C.output_label_instr buf label_map label
       | I_jump (cval, label) ->
-         add_instr n buf indent (C.keyword "jump" ^ " " ^ C.value cval ^ " " ^ C.string_of_label (StringMap.find label label_map))
+         add_instr n buf indent (C.keyword "jump" ^ " " ^ C.value cval ^ " "
+                                 ^ C.keyword "goto" ^ " " ^ C.string_of_label (StringMap.find label label_map)
+                                 ^ " ` \"" ^ Reporting.short_loc_to_string l ^ "\"")
       | I_goto label ->
          add_instr n buf indent (C.keyword "goto" ^ " " ^ C.string_of_label (StringMap.find label label_map))
       | I_match_failure ->
@@ -151,8 +155,10 @@ module Ir_formatter = struct
     let output_def buf = function
       | CDEF_reg_dec (id, ctyp, _) ->
          Buffer.add_string buf (sprintf "%s %s : %s" (C.keyword "register") (zencode_id id) (C.typ ctyp))
-      | CDEF_spec (id, ctyps, ctyp) ->
+      | CDEF_spec (id, None, ctyps, ctyp) ->
          Buffer.add_string buf (sprintf "%s %s : (%s) ->  %s" (C.keyword "val") (zencode_id id) (Util.string_of_list ", " C.typ ctyps) (C.typ ctyp));
+      | CDEF_spec (id, Some extern, ctyps, ctyp) ->
+         Buffer.add_string buf (sprintf "%s %s = \"%s\" : (%s) ->  %s" (C.keyword "val") (zencode_id id) extern (Util.string_of_list ", " C.typ ctyps) (C.typ ctyp));
       | CDEF_fundef (id, ret, args, instrs) ->
          let instrs = C.modify_instrs instrs in
          let label_map = C.make_label_map instrs in
@@ -244,10 +250,10 @@ let () =
   let open Interactive in
   let open Jib_interactive in
 
-  (fun arg ->
+  ArgString ("(val|register)? identifier", fun arg -> Action (fun () ->
     let is_def id = function
       | CDEF_fundef (id', _, _, _) -> Id.compare id id' = 0
-      | CDEF_spec (id', _, _) -> Id.compare id (prepend_id "val " id') = 0
+      | CDEF_spec (id', _, _, _) -> Id.compare id (prepend_id "val " id') = 0
       | CDEF_reg_dec (id', _, _) -> Id.compare id (prepend_id "register " id') = 0
       | _ -> false
     in
@@ -258,12 +264,12 @@ let () =
        let buf = Buffer.create 256 in
        with_colors (fun () -> Flat_ir_formatter.output_def buf cdef);
        print_endline (Buffer.contents buf)
-  ) |> Interactive.(register_command ~name:"ir" ~help:(sprintf ":ir %s - Print the ir representation of a toplevel definition" (arg "(val|register)? identifier")));
+  )) |> Interactive.register_command ~name:"ir" ~help:"Print the ir representation of a toplevel definition";
 
-  (fun file ->
+  ArgString ("file", fun file -> Action (fun () ->
     let buf = Buffer.create 256 in
     let out_chan = open_out file in
     Flat_ir_formatter.output_defs buf !ir;
     output_string out_chan (Buffer.contents buf);
     close_out out_chan
-  ) |> Interactive.(register_command ~name:"dump_ir" ~help:(sprintf ":dump_ir %s - Dump the ir to a file" (arg "file")))
+  )) |> Interactive.register_command ~name:"dump_ir" ~help:"Dump the ir to a file"
diff --git a/src/jib/jib_optimize.ml b/src/jib/jib_optimize.ml
index 323f3cd0..e0f3bf0d 100644
--- a/src/jib/jib_optimize.ml
+++ b/src/jib/jib_optimize.ml
@@ -102,10 +102,10 @@ let rec flatten_instrs = function
   | I_aux ((I_block block | I_try_block block), _) :: instrs ->
      flatten_instrs block @ flatten_instrs instrs
 
-  | I_aux (I_if (cval, then_instrs, else_instrs, _), _) :: instrs ->
+  | I_aux (I_if (cval, then_instrs, else_instrs, _), (_, l)) :: instrs ->
      let then_label = label "then_" in
      let endif_label = label "endif_" in
-     [ijump cval then_label]
+     [ijump l cval then_label]
      @ flatten_instrs else_instrs
      @ [igoto endif_label]
      @ [ilabel then_label]
@@ -153,7 +153,7 @@ let unique_per_function_ids cdefs =
     | CDEF_reg_dec (id, ctyp, instrs) -> CDEF_reg_dec (id, ctyp, unique_instrs i instrs)
     | CDEF_type ctd -> CDEF_type ctd
     | CDEF_let (n, bindings, instrs) -> CDEF_let (n, bindings, unique_instrs i instrs)
-    | CDEF_spec (id, ctyps, ctyp) -> CDEF_spec (id, ctyps, ctyp)
+    | CDEF_spec (id, extern, ctyps, ctyp) -> CDEF_spec (id, extern, ctyps, ctyp)
     | CDEF_fundef (id, heap_return, args, instrs) -> CDEF_fundef (id, heap_return, args, unique_instrs i instrs)
     | CDEF_startup (id, instrs) -> CDEF_startup (id, unique_instrs i instrs)
     | CDEF_finish (id, instrs) -> CDEF_finish (id, unique_instrs i instrs)
@@ -162,7 +162,6 @@ let unique_per_function_ids cdefs =
 
 let rec cval_subst id subst = function
   | V_id (id', ctyp) -> if Name.compare id id' = 0 then subst else V_id (id', ctyp)
-  | V_ref (reg_id, ctyp) -> V_ref (reg_id, ctyp)
   | V_lit (vl, ctyp) -> V_lit (vl, ctyp)
   | V_call (op, cvals) -> V_call (op, List.map (cval_subst id subst) cvals)
   | V_field (cval, field) -> V_field (cval_subst id subst cval, field)
@@ -174,7 +173,6 @@ let rec cval_subst id subst = function
 
 let rec cval_map_id f = function
   | V_id (id, ctyp) -> V_id (f id, ctyp)
-  | V_ref (id, ctyp) -> V_ref (f id, ctyp)
   | V_lit (vl, ctyp) -> V_lit (vl, ctyp)
   | V_call (call, cvals) -> V_call (call, List.map (cval_map_id f) cvals)
   | V_field (cval, field) -> V_field (cval_map_id f cval, field)
@@ -249,6 +247,7 @@ let ssa_name i = function
   | Name (id, _) -> Name (id, i)
   | Have_exception _ -> Have_exception i
   | Current_exception _ -> Current_exception i
+  | Throw_location _ -> Throw_location i
   | Return _ -> Return i
 
 let inline cdefs should_inline instrs =
@@ -347,6 +346,15 @@ let rec remove_pointless_goto = function
      instr :: remove_pointless_goto instrs
   | [] -> []
 
+let rec remove_pointless_exit = function
+  | I_aux (I_end id, aux) :: I_aux (I_end _, _) :: instrs  ->
+     I_aux (I_end id, aux) :: remove_pointless_exit instrs
+  | I_aux (I_end id, aux) :: I_aux (I_undefined _, _) :: instrs  ->
+     I_aux (I_end id, aux) :: remove_pointless_exit instrs
+  | instr :: instrs ->
+     instr :: remove_pointless_exit instrs
+  | [] -> []
+
 module StringSet = Set.Make(String)
 
 let rec get_used_labels set = function
@@ -364,7 +372,6 @@ let remove_unused_labels instrs =
   in
   go [] instrs
 
-
 let remove_dead_after_goto instrs =
   let rec go acc = function
     | (I_aux (I_goto _, _) as instr) :: instrs -> go_dead (instr :: acc) instrs
@@ -379,7 +386,7 @@ let remove_dead_after_goto instrs =
 
 let rec remove_dead_code instrs =
   let instrs' =
-    instrs |> remove_unused_labels |> remove_pointless_goto |> remove_dead_after_goto
+    instrs |> remove_unused_labels |> remove_pointless_goto |> remove_dead_after_goto |> remove_pointless_exit
   in
   if List.length instrs' < List.length instrs then
     remove_dead_code instrs'
@@ -398,7 +405,7 @@ let remove_tuples cdefs ctx =
        CTSet.add ctyp (List.fold_left CTSet.union CTSet.empty (List.map all_tuples ctyps))
     | CT_struct (_, id_ctyps) | CT_variant (_, id_ctyps) ->
        List.fold_left (fun cts (_, ctyp) -> CTSet.union (all_tuples ctyp) cts) CTSet.empty id_ctyps
-    | CT_list ctyp | CT_vector (_, ctyp) | CT_ref ctyp ->
+    | CT_list ctyp | CT_vector (_, ctyp) | CT_fvector (_, _, ctyp) | CT_ref ctyp ->
        all_tuples ctyp
     | CT_lint | CT_fint _ | CT_lbits _ | CT_sbits _ | CT_fbits _ | CT_constant _
       | CT_unit | CT_bool | CT_real | CT_bit | CT_poly | CT_string | CT_enum _ ->
@@ -409,7 +416,7 @@ let remove_tuples cdefs ctx =
        1 + List.fold_left (fun d ctyp -> max d (tuple_depth ctyp)) 0 ctyps
     | CT_struct (_, id_ctyps) | CT_variant (_, id_ctyps) ->
        List.fold_left (fun d (_, ctyp) -> max (tuple_depth ctyp) d) 0 id_ctyps
-    | CT_list ctyp | CT_vector (_, ctyp) | CT_ref ctyp ->
+    | CT_list ctyp | CT_vector (_, ctyp) | CT_fvector (_, _, ctyp) | CT_ref ctyp ->
        tuple_depth ctyp
     | CT_lint | CT_fint _ | CT_lbits _ | CT_sbits _ | CT_fbits _ | CT_constant _
       | CT_unit | CT_bool | CT_real | CT_bit | CT_poly | CT_string | CT_enum _ ->
@@ -426,6 +433,7 @@ let remove_tuples cdefs ctx =
        CT_variant (id, List.map (fun (id, ctyp) -> id, fix_tuples ctyp) id_ctyps)
     | CT_list ctyp -> CT_list (fix_tuples ctyp)
     | CT_vector (d, ctyp) -> CT_vector (d, fix_tuples ctyp)
+    | CT_fvector (n, d, ctyp) -> CT_fvector (n, d, fix_tuples ctyp)
     | CT_ref ctyp -> CT_ref (fix_tuples ctyp)
     | (CT_lint | CT_fint _ | CT_lbits _ | CT_sbits _ | CT_fbits _ | CT_constant _
        | CT_unit | CT_bool | CT_real | CT_bit | CT_poly | CT_string | CT_enum _) as ctyp ->
@@ -433,7 +441,6 @@ let remove_tuples cdefs ctx =
   in
   let rec fix_cval = function
     | V_id (id, ctyp) -> V_id (id, ctyp)
-    | V_ref (id, ctyp) -> V_ref (id, ctyp)
     | V_lit (vl, ctyp) -> V_lit (vl, ctyp)
     | V_ctor_kind (cval, id, unifiers, ctyp) ->
        V_ctor_kind (fix_cval cval, id, unifiers, ctyp)
diff --git a/src/jib/jib_smt.ml b/src/jib/jib_smt.ml
index fbaf8d3f..81b876a4 100644
--- a/src/jib/jib_smt.ml
+++ b/src/jib/jib_smt.ml
@@ -73,6 +73,8 @@ let opt_debug_graphs = ref false
 
 let opt_propagate_vars = ref false
 
+let opt_unroll_limit = ref 10
+
 module EventMap = Map.Make(Event)
 
 (* Note that we have to use x : ty ref rather than mutable x : ty, to
@@ -89,6 +91,8 @@ type ctx = {
     pragma_l : Ast.l;
     arg_stack : (int * string) Stack.t;
     ast : Type_check.tannot defs;
+    shared : ctyp Bindings.t;
+    preserved : IdSet.t;
     events : smt_exp Stack.t EventMap.t ref;
     node : int;
     pathcond : smt_exp Lazy.t;
@@ -114,6 +118,8 @@ let initial_ctx () = {
     pragma_l = Parse_ast.Unknown;
     arg_stack = Stack.create ();
     ast = Defs [];
+    shared = Bindings.empty;
+    preserved = IdSet.empty;
     events = ref EventMap.empty;
     node = -1;
     pathcond = lazy (Bool_lit true);
@@ -129,6 +135,19 @@ let event_stack ctx ev =
      ctx.events := EventMap.add ev stack !(ctx.events);
      stack
 
+let add_event ctx ev smt =
+  let stack = event_stack ctx ev in
+  Stack.push (Fn ("and", [Lazy.force ctx.pathcond; smt])) stack
+
+let add_pathcond_event ctx ev =
+  Stack.push (Lazy.force ctx.pathcond) (event_stack ctx ev)
+
+let overflow_check ctx smt =
+  if not !opt_ignore_overflow then (
+    Reporting.warn "Overflow check in generated SMT for" ctx.pragma_l "";
+    add_event ctx Overflow smt
+  )
+
 let lbits_size ctx = Util.power 2 ctx.lbits_index
 
 let vector_index = ref 5
@@ -179,6 +198,8 @@ let rec smt_ctyp ctx = function
      | _ -> failwith ("No registers with ctyp: " ^ string_of_ctyp ctyp)
      end
   | CT_list _ -> raise (Reporting.err_todo ctx.pragma_l "Lists not yet supported in SMT generation")
+  | CT_fvector _ ->
+     Reporting.unreachable ctx.pragma_l __POS__ "Found CT_fvector in SMT property"
   | CT_poly ->
      Reporting.unreachable ctx.pragma_l __POS__ "Found polymorphic type in SMT property"
 
@@ -188,21 +209,17 @@ let rec smt_ctyp ctx = function
    don't have a very good way to get the binary representation of
    either an ocaml integer or a big integer. *)
 let bvpint sz x =
+  let open Sail2_values in
   if Big_int.less_equal Big_int.zero x && Big_int.less_equal x (Big_int.of_int max_int) then (
-    let open Sail_lib in
     let x = Big_int.to_int x in
-    if sz mod 4 = 0 then
-      let hex = Printf.sprintf "%X" x in
-      let padding = String.make (sz / 4 - String.length hex) '0' in
-      Hex (padding ^ hex)
-    else
-      let bin = Printf.sprintf "%X" x |> list_of_string |> List.map hex_char |> List.concat in
-      let _, bin = Util.take_drop (function B0 -> true | B1 -> false) bin in
-      let bin = String.concat "" (List.map string_of_bit bin) in
-      let padding = String.make (sz - String.length bin) '0' in
-      Bin (padding ^ bin)
+    match Printf.sprintf "%X" x |> Util.string_to_list |> List.map nibble_of_char |> Util.option_all with
+    | Some nibbles ->
+       let bin = List.map (fun (a, b, c, d) -> [a; b; c; d]) nibbles |> List.concat in
+       let _, bin = Util.take_drop (function B0 -> true | _ -> false) bin in
+       let padding = List.init (sz - List.length bin) (fun _ -> B0) in
+       Bitvec_lit (padding @ bin)
+    | None -> assert false
   ) else if Big_int.greater x (Big_int.of_int max_int) then (
-    let open Sail_lib in
     let y = ref x in
     let bin = ref [] in
     while (not (Big_int.equal !y Big_int.zero)) do
@@ -210,14 +227,13 @@ let bvpint sz x =
       bin := (if Big_int.equal m Big_int.zero then B0 else B1) :: !bin;
       y := q
     done;
-    let bin = String.concat "" (List.map string_of_bit !bin) in
-    let padding_size = sz - String.length bin in
+    let padding_size = sz - List.length !bin in
     if padding_size < 0 then
       raise (Reporting.err_general Parse_ast.Unknown
                (Printf.sprintf "Could not create a %d-bit integer with value %s.\nTry increasing the maximum integer size"
                   sz (Big_int.to_string x)));
-    let padding = String.make (sz - String.length bin) '0' in
-    Bin (padding ^ bin)
+    let padding = List.init padding_size (fun _ -> B0) in
+    Bitvec_lit (padding @ !bin)
   ) else failwith "Invalid bvpint"
 
 let bvint sz x =
@@ -226,22 +242,68 @@ let bvint sz x =
   else
     bvpint sz x
 
+(** [force_size ctx n m exp] takes a smt expression assumed to be a
+   integer (signed bitvector) of length m and forces it to be length n
+   by either sign extending it or truncating it as required *)
+let force_size ?checked:(checked=true) ctx n m smt =
+  if n = m then
+    smt
+  else if n > m then
+    SignExtend (n - m, smt)
+  else
+    let check =
+      (* If the top bit of the truncated number is one *)
+      Ite (Fn ("=", [Extract (n - 1, n - 1, smt); Bitvec_lit [Sail2_values.B1]]),
+           (* Then we have an overflow, unless all bits we truncated were also one *)
+           Fn ("not", [Fn ("=", [Extract (m - 1, n, smt); bvones (m - n)])]),
+           (* Otherwise, all the top bits must be zero *)
+           Fn ("not", [Fn ("=", [Extract (m - 1, n, smt); bvzero (m - n)])]))
+    in
+    if checked then overflow_check ctx check else ();
+    Extract (n - 1, 0, smt)
+
+(** [unsigned_size ctx n m exp] is much like force_size, but it
+   assumes that the bitvector is unsigned *)
+let unsigned_size ?checked:(checked=true) ctx n m smt =
+  if n = m then
+    smt
+  else if n > m then
+    Fn ("concat", [bvzero (n - m); smt])
+  else
+    Extract (n - 1, 0, smt)
+
+let smt_conversion ctx from_ctyp to_ctyp x =
+  match from_ctyp, to_ctyp with
+  | _, _ when ctyp_equal from_ctyp to_ctyp -> x
+  | CT_constant c, CT_fint sz ->
+     bvint sz c
+  | CT_constant c, CT_lint ->
+     bvint ctx.lint_size c
+  | CT_fint sz, CT_lint ->
+     force_size ctx ctx.lint_size sz x
+  | CT_lint, CT_fint sz ->
+     force_size ctx sz ctx.lint_size x
+  | CT_lbits _, CT_fbits (n, _) ->
+     unsigned_size ctx n (lbits_size ctx) (Fn ("contents", [x]))
+  | CT_fbits (n, _), CT_lbits _ ->
+     Fn ("Bits", [bvint ctx.lbits_index (Big_int.of_int n); unsigned_size ctx (lbits_size ctx) n x])
+
+  | _, _ -> failwith (Printf.sprintf "Cannot perform conversion from %s to %s" (string_of_ctyp from_ctyp) (string_of_ctyp to_ctyp))
+
 (* Translate Jib literals into SMT *)
-let smt_value ctx vl ctyp =
+let rec smt_value ctx vl ctyp =
   let open Value2 in
   match vl, ctyp with
-  | VL_bits (bs, true), CT_fbits (n, _) ->
-     (* FIXME: Output the correct number of bits in Jib_compile *)
-     begin match Sail2_values.hexstring_of_bits (List.rev (Util.take n (List.rev bs))) with
-     | Some s -> Hex (Xstring.implode s)
-     | None -> Bin (Xstring.implode (List.map Sail2_values.bitU_char (List.rev (Util.take n (List.rev bs)))))
-     end
+  | VL_bits (bv, true), CT_fbits (n, _) ->
+     unsigned_size ctx n (List.length bv) (Bitvec_lit bv)
+  | VL_bits (bv, true), CT_lbits _ ->
+     let sz = List.length bv in
+     Fn ("Bits", [bvint ctx.lbits_index (Big_int.of_int sz); unsigned_size ctx (lbits_size ctx) sz (Bitvec_lit bv)])
   | VL_bool b, _ -> Bool_lit b
   | VL_int n, CT_constant m -> bvint (required_width n) n
   | VL_int n, CT_fint sz -> bvint sz n
   | VL_int n, CT_lint -> bvint ctx.lint_size n
-  | VL_bit Sail2_values.B0, CT_bit -> Bin "0"
-  | VL_bit Sail2_values.B1, CT_bit -> Bin "1"
+  | VL_bit b, CT_bit -> Bitvec_lit [b]
   | VL_unit, _ -> Enum "unit"
   | VL_string str, _ ->
      ctx.use_string := true;
@@ -252,7 +314,21 @@ let smt_value ctx vl ctyp =
        Fn ("-", [Real_lit (String.sub str 1 (String.length str - 1))])
      else
        Real_lit str
-  | vl, _ -> failwith ("Cannot translate literal to SMT: " ^ string_of_value vl)
+  | VL_enum str, _ -> Enum (Util.zencode_string str)
+  | VL_ref reg_name, _ ->
+     let id = mk_id reg_name in
+     let rmap = CTMap.filter (fun ctyp regs -> List.exists (fun reg -> Id.compare reg id = 0) regs) ctx.register_map in
+     assert (CTMap.cardinal rmap = 1);
+     begin match CTMap.min_binding_opt rmap with
+     | Some (ctyp, regs) ->
+        begin match Util.list_index (fun reg -> Id.compare reg id = 0) regs with
+        | Some i ->
+           bvint (required_width (Big_int.of_int (List.length regs))) (Big_int.of_int i)
+        | None -> assert false
+        end
+     | _ -> assert false
+     end
+  | _ -> failwith ("Cannot translate literal to SMT: " ^ string_of_value vl ^ " : " ^ string_of_ctyp ctyp)
 
 let rec smt_cval ctx cval =
   match cval_ctyp cval with
@@ -264,6 +340,7 @@ let rec smt_cval ctx cval =
      | V_id (Name (id, _) as ssa_id, _) ->
         begin match Type_check.Env.lookup_id id ctx.tc_env with
         | Enum _ -> Enum (zencode_id id)
+        | _ when Bindings.mem id ctx.shared -> Shared (zencode_id id)
         | _ -> Var (zencode_name ssa_id)
         end
      | V_id (ssa_id, _) -> Var (zencode_name ssa_id)
@@ -271,8 +348,6 @@ let rec smt_cval ctx cval =
         Fn ("not", [Fn ("=", [smt_cval ctx cval1; smt_cval ctx cval2])])
      | V_call (Bvor, [cval1; cval2]) ->
         Fn ("bvor", [smt_cval ctx cval1; smt_cval ctx cval2])
-     | V_call (Bit_to_bool, [cval]) ->
-        Fn ("=", [smt_cval ctx cval; Bin "1"])
      | V_call (Eq, [cval1; cval2]) ->
         Fn ("=", [smt_cval ctx cval1; smt_cval ctx cval2])
      | V_call (Bnot, [cval]) ->
@@ -281,14 +356,18 @@ let rec smt_cval ctx cval =
         smt_conj (List.map (smt_cval ctx) cvals)
      | V_call (Bor, cvals) ->
         smt_disj (List.map (smt_cval ctx) cvals)
+     | V_call (Igt, [cval1; cval2]) ->
+        Fn ("bvsgt", [smt_cval ctx cval1; smt_cval ctx cval2])
+     | V_call (Iadd, [cval1; cval2]) ->
+        Fn ("bvadd", [smt_cval ctx cval1; smt_cval ctx cval2])
      | V_ctor_kind (union, ctor_id, unifiers, _) ->
         Fn ("not", [Tester (zencode_uid (ctor_id, unifiers), smt_cval ctx union)])
      | V_ctor_unwrap (ctor_id, union, unifiers, _) ->
         Fn ("un" ^ zencode_uid (ctor_id, unifiers), [smt_cval ctx union])
-     | V_field (union, field) ->
-        begin match cval_ctyp union with
+     | V_field (record, field) ->
+        begin match cval_ctyp record with
         | CT_struct (struct_id, _) ->
-           Fn (zencode_upper_id struct_id ^ "_" ^ zencode_uid field, [smt_cval ctx union])
+           Field (zencode_upper_id struct_id ^ "_" ^ zencode_uid field, smt_cval ctx record)
         | _ -> failwith "Field for non-struct type"
         end
      | V_struct (fields, ctyp) ->
@@ -297,43 +376,18 @@ let rec smt_cval ctx cval =
            let set_field (field, cval) =
              match Util.assoc_compare_opt UId.compare field field_ctyps with
              | None -> failwith "Field type not found"
-             | Some ctyp when ctyp_equal (cval_ctyp cval) ctyp ->
-                smt_cval ctx cval
-             | _ -> failwith "Type mismatch when generating struct for SMT"
+             | Some ctyp ->
+                zencode_upper_id struct_id ^ "_" ^ zencode_uid field,
+                smt_conversion ctx (cval_ctyp cval) ctyp (smt_cval ctx cval)
            in
-           Fn (zencode_upper_id struct_id, List.map set_field fields)
+           Struct (zencode_upper_id struct_id, List.map set_field fields)
         | _ -> failwith "Struct does not have struct type"
         end
      | V_tuple_member (frag, len, n) ->
         ctx.tuple_sizes := IntSet.add len !(ctx.tuple_sizes);
         Fn (Printf.sprintf "tup_%d_%d" len n, [smt_cval ctx frag])
-     | V_ref (Name (id, _), _) ->
-        let rmap = CTMap.filter (fun ctyp regs -> List.exists (fun reg -> Id.compare reg id = 0) regs) ctx.register_map in
-        assert (CTMap.cardinal rmap = 1);
-        begin match CTMap.min_binding_opt rmap with
-        | Some (ctyp, regs) ->
-           begin match Util.list_index (fun reg -> Id.compare reg id = 0) regs with
-           | Some i ->
-              bvint (required_width (Big_int.of_int (List.length regs))) (Big_int.of_int i)
-           | None -> assert false
-           end
-        | _ -> assert false
-        end
      | cval -> failwith ("Unrecognised cval " ^ string_of_cval cval)
 
-let add_event ctx ev smt =
-  let stack = event_stack ctx ev in
-  Stack.push (Fn ("=>", [Lazy.force ctx.pathcond; smt])) stack
-
-let add_pathcond_event ctx ev =
-  Stack.push (Lazy.force ctx.pathcond) (event_stack ctx ev)
-
-let overflow_check ctx smt =
-  if not !opt_ignore_overflow then (
-    Reporting.warn "Overflow check in generated SMT for" ctx.pragma_l "";
-    add_event ctx Overflow smt
-  )
-
 (**************************************************************************)
 (* 1. Generating SMT for Sail builtins                                    *)
 (**************************************************************************)
@@ -342,8 +396,8 @@ let builtin_type_error ctx fn cvals =
   let args = Util.string_of_list ", " (fun cval -> string_of_ctyp (cval_ctyp cval)) cvals in
   function
   | Some ret_ctyp ->
-     raise (Reporting.err_todo ctx.pragma_l
-       (Printf.sprintf "%s : (%s) -> %s" fn args (string_of_ctyp ret_ctyp)))
+     let message = Printf.sprintf "%s : (%s) -> %s" fn args (string_of_ctyp ret_ctyp) in
+     raise (Reporting.err_todo ctx.pragma_l message)
   | None ->
      raise (Reporting.err_todo ctx.pragma_l (Printf.sprintf "%s : (%s)" fn args))
 
@@ -385,36 +439,6 @@ let builtin_gteq = builtin_int_comparison "bvsge" Big_int.greater_equal
 
 (* ***** Arithmetic operations: lib/arith.sail ***** *)
 
-(** [force_size ctx n m exp] takes a smt expression assumed to be a
-   integer (signed bitvector) of length m and forces it to be length n
-   by either sign extending it or truncating it as required *)
-let force_size ?checked:(checked=true) ctx n m smt =
-  if n = m then
-    smt
-  else if n > m then
-    SignExtend (n - m, smt)
-  else
-    let check =
-      (* If the top bit of the truncated number is one *)
-      Ite (Fn ("=", [Extract (n - 1, n - 1, smt); Bin "1"]),
-           (* Then we have an overflow, unless all bits we truncated were also one *)
-           Fn ("not", [Fn ("=", [Extract (m - 1, n, smt); bvones (m - n)])]),
-           (* Otherwise, all the top bits must be zero *)
-           Fn ("not", [Fn ("=", [Extract (m - 1, n, smt); bvzero (m - n)])]))
-    in
-    if checked then overflow_check ctx check else ();
-    Extract (n - 1, 0, smt)
-
-(** [unsigned_size ctx n m exp] is much like force_size, but it
-   assumes that the bitvector is unsigned *)
-let unsigned_size ?checked:(checked=true) ctx n m smt =
-  if n = m then
-    smt
-  else if n > m then
-    Fn ("concat", [bvzero (n - m); smt])
-  else
-    Extract (n - 1, 0, smt)
-
 let int_size ctx = function
   | CT_constant n -> required_width n
   | CT_fint sz -> sz
@@ -457,8 +481,9 @@ let builtin_negate_int ctx v ret_ctyp =
   | CT_constant c, _ ->
      bvint (int_size ctx ret_ctyp) (Big_int.negate c)
   | ctyp, _ ->
+     let open Sail2_values in
      let smt = force_size ctx (int_size ctx ret_ctyp) (int_size ctx ctyp) (smt_cval ctx v) in
-     overflow_check ctx (Fn ("=", [smt; Bin ("1" ^ String.make (int_size ctx ret_ctyp - 1) '0')]));
+     overflow_check ctx (Fn ("=", [smt; Bitvec_lit (B1 :: List.init (int_size ctx ret_ctyp - 1) (fun _ -> B0))]));
      Fn ("bvneg", [smt])
 
 let builtin_shift_int fn big_int_fn ctx v1 v2 ret_ctyp =
@@ -494,7 +519,7 @@ let builtin_abs_int ctx v ret_ctyp =
   | ctyp, _ ->
      let sz = int_size ctx ctyp in
      let smt = smt_cval ctx v in
-     Ite (Fn ("=", [Extract (sz - 1, sz -1, smt); Bin "1"]),
+     Ite (Fn ("=", [Extract (sz - 1, sz -1, smt); Bitvec_lit [Sail2_values.B1]]),
           force_size ctx (int_size ctx ret_ctyp) sz (Fn ("bvneg", [smt])),
           force_size ctx (int_size ctx ret_ctyp) sz smt)
 
@@ -531,6 +556,25 @@ let builtin_min_int ctx v1 v2 ret_ctyp =
           smt1,
           smt2)
 
+let builtin_min_int ctx v1 v2 ret_ctyp =
+  match cval_ctyp v1, cval_ctyp v2 with
+  | CT_constant n, CT_constant m ->
+     bvint (int_size ctx ret_ctyp) (min n m)
+
+  | ctyp1, ctyp2 ->
+     let ret_sz = int_size ctx ret_ctyp in
+     let smt1 = force_size ctx ret_sz (int_size ctx ctyp1) (smt_cval ctx v1) in
+     let smt2 = force_size ctx ret_sz (int_size ctx ctyp2) (smt_cval ctx v2) in
+     Ite (Fn ("bvslt", [smt1; smt2]),
+          smt1,
+          smt2)
+
+let builtin_tdiv_int =
+  builtin_arith "bvudiv" (Sail2_values.tdiv_int) (fun x -> x)
+
+let builtin_tmod_int =
+  builtin_arith "bvurem" (Sail2_values.tmod_int) (fun x -> x)
+  
 let bvmask ctx len =
   let all_ones = bvones (lbits_size ctx) in
   let shift = Fn ("concat", [bvzero (lbits_size ctx - ctx.lbits_index); len]) in
@@ -623,7 +667,7 @@ let builtin_sign_extend ctx vbits vlen ret_ctyp =
      smt_cval ctx vbits
   | CT_fbits (n, _), CT_fbits (m, _) ->
      let bv = smt_cval ctx vbits in
-     let top_bit_one = Fn ("=", [Extract (n - 1, n - 1, bv); Bin "1"]) in
+     let top_bit_one = Fn ("=", [Extract (n - 1, n - 1, bv); Bitvec_lit [Sail2_values.B1]]) in
      Ite (top_bit_one, Fn ("concat", [bvones (m - n); bv]), Fn ("concat", [bvzero (m - n); bv]))
 
   | _ -> builtin_type_error ctx "sign_extend" [vbits; vlen] (Some ret_ctyp)
@@ -658,14 +702,14 @@ let builtin_not_bits ctx v ret_ctyp =
   | _, _ -> builtin_type_error ctx "not_bits" [v] (Some ret_ctyp)
 
 let builtin_bitwise fn ctx v1 v2 ret_ctyp =
-  match cval_ctyp v1, cval_ctyp v2 with
-  | CT_fbits (n, _), CT_fbits (m, _) ->
-     assert (n = m);
+  match cval_ctyp v1, cval_ctyp v2, ret_ctyp with
+  | CT_fbits (n, _), CT_fbits (m, _), CT_fbits (o, _) ->
+     assert (n = m && m = o);
      let smt1 = smt_cval ctx v1 in
      let smt2 = smt_cval ctx v2 in
      Fn (fn, [smt1; smt2])
 
-  | CT_lbits _, CT_lbits _ ->
+  | CT_lbits _, CT_lbits _, CT_lbits _ ->
      let smt1 = smt_cval ctx v1 in
      let smt2 = smt_cval ctx v2 in
      Fn ("Bits", [Fn ("len", [smt1]); Fn (fn, [Fn ("contents", [smt1]); Fn ("contents", [smt2])])])
@@ -674,6 +718,7 @@ let builtin_bitwise fn ctx v1 v2 ret_ctyp =
 
 let builtin_and_bits = builtin_bitwise "bvand"
 let builtin_or_bits = builtin_bitwise "bvor"
+let builtin_xor_bits = builtin_bitwise "bvxor"
 
 let builtin_append ctx v1 v2 ret_ctyp =
   match cval_ctyp v1, cval_ctyp v2, ret_ctyp with
@@ -743,19 +788,29 @@ let builtin_length ctx v ret_ctyp =
   | _, _ -> builtin_type_error ctx "length" [v] (Some ret_ctyp)
 
 let builtin_vector_subrange ctx vec i j ret_ctyp =
-  match cval_ctyp vec, cval_ctyp i, cval_ctyp j with
-  | CT_fbits (n, _), CT_constant i, CT_constant j ->
+  match cval_ctyp vec, cval_ctyp i, cval_ctyp j, ret_ctyp with
+  | CT_fbits (n, _), CT_constant i, CT_constant j, CT_fbits _ ->
      Extract (Big_int.to_int i, Big_int.to_int j, smt_cval ctx vec)
 
-  | CT_lbits _, CT_constant i, CT_constant j ->
+  | CT_lbits _, CT_constant i, CT_constant j, CT_fbits _ ->
      Extract (Big_int.to_int i, Big_int.to_int j, Fn ("contents", [smt_cval ctx vec]))
 
+  | CT_fbits (n, _), i_ctyp, CT_constant j, CT_lbits _ when Big_int.equal j Big_int.zero ->
+     let len = force_size ~checked:false ctx ctx.lbits_index (int_size ctx i_ctyp) (smt_cval ctx i) in
+     Fn ("Bits", [len; Fn ("bvand", [bvmask ctx len; unsigned_size ctx (lbits_size ctx) n (smt_cval ctx vec)])])
+
   | _ -> builtin_type_error ctx "vector_subrange" [vec; i; j] (Some ret_ctyp)
 
 let builtin_vector_access ctx vec i ret_ctyp =
   match cval_ctyp vec, cval_ctyp i, ret_ctyp with
   | CT_fbits (n, _), CT_constant i, CT_bit ->
      Extract (Big_int.to_int i, Big_int.to_int i, smt_cval ctx vec)
+  | CT_lbits _, CT_constant i, CT_bit ->
+     Extract (Big_int.to_int i, Big_int.to_int i, Fn ("contents", [smt_cval ctx vec]))
+
+  | CT_lbits _, i_ctyp, CT_bit ->
+     let shift = force_size ~checked:false ctx (lbits_size ctx) (int_size ctx i_ctyp) (smt_cval ctx i) in
+     Extract (0, 0, Fn ("bvlshr", [Fn ("contents", [smt_cval ctx vec]); shift]))
 
   | CT_vector _, CT_constant i, _ ->
      Fn ("select", [smt_cval ctx vec; bvint !vector_index i])
@@ -787,6 +842,21 @@ let builtin_vector_update ctx vec i x ret_ctyp =
 
   | _ -> builtin_type_error ctx "vector_update" [vec; i; x] (Some ret_ctyp)
 
+let builtin_vector_update_subrange ctx vec i j x ret_ctyp =
+  match cval_ctyp vec, cval_ctyp i, cval_ctyp j, cval_ctyp x, ret_ctyp with
+  | CT_fbits (n, _), CT_constant i, CT_constant j, CT_fbits (sz, _), CT_fbits (m, _) when n - 1 > Big_int.to_int i && Big_int.to_int j >= 0 ->
+     assert (n = m);
+     let top = Extract (n - 1, Big_int.to_int i + 1, smt_cval ctx vec) in
+     let bot = Extract (Big_int.to_int j - 1, 0, smt_cval ctx vec) in
+     Fn ("concat", [top; Fn ("concat", [smt_cval ctx x; bot])])
+
+  | CT_fbits (n, _), CT_constant i, CT_constant j, CT_fbits (sz, _), CT_fbits (m, _) when n - 1 = Big_int.to_int i && Big_int.to_int j >= 0 ->
+     assert (n = m);
+     let bot = Extract (Big_int.to_int j - 1, 0, smt_cval ctx vec) in
+     Fn ("concat", [smt_cval ctx x; bot])
+
+  | _ -> builtin_type_error ctx "vector_update_subrange" [vec; i; j; x] (Some ret_ctyp)
+
 let builtin_unsigned ctx v ret_ctyp =
   match cval_ctyp v, ret_ctyp with
   | CT_fbits (n, _), CT_fint m when m > n ->
@@ -800,6 +870,9 @@ let builtin_unsigned ctx v ret_ctyp =
        let smt = smt_cval ctx v in
        Fn ("concat", [bvzero (ctx.lint_size - n); smt])
 
+  | CT_lbits _, CT_lint ->
+     Extract (ctx.lint_size - 1, 0, Fn ("contents", [smt_cval ctx v]))
+
   | ctyp, _ -> builtin_type_error ctx "unsigned" [v] (Some ret_ctyp)
 
 let builtin_signed ctx v ret_ctyp =
@@ -810,6 +883,9 @@ let builtin_signed ctx v ret_ctyp =
   | CT_fbits (n, _), CT_lint ->
      SignExtend(ctx.lint_size - n, smt_cval ctx v)
 
+  | CT_lbits _, CT_lint ->
+     Extract (ctx.lint_size - 1, 0, Fn ("contents", [smt_cval ctx v]))
+    
   | ctyp, _ -> builtin_type_error ctx "signed" [v] (Some ret_ctyp)
 
 let builtin_add_bits ctx v1 v2 ret_ctyp =
@@ -818,6 +894,11 @@ let builtin_add_bits ctx v1 v2 ret_ctyp =
      assert (n = m && m = o);
      Fn ("bvadd", [smt_cval ctx v1; smt_cval ctx v2])
 
+  | CT_lbits _, CT_lbits _, CT_lbits _ ->
+     let smt1 = smt_cval ctx v1 in
+     let smt2 = smt_cval ctx v2 in
+     Fn ("Bits", [Fn ("len", [smt1]); Fn ("bvadd", [Fn ("contents", [smt1]); Fn ("contents", [smt2])])])
+     
   | _ -> builtin_type_error ctx "add_bits" [v1; v2] (Some ret_ctyp)
 
 let builtin_sub_bits ctx v1 v2 ret_ctyp =
@@ -866,6 +947,13 @@ let builtin_replicate_bits ctx v1 v2 ret_ctyp =
      let c = m / n in
      Fn ("concat", List.init c (fun _ -> smt))
 
+  | CT_fbits (n, _), v2_ctyp, CT_lbits _ ->
+     let times = (lbits_size ctx / n) + 1 in
+     let len = force_size ~checked:false ctx ctx.lbits_index (int_size ctx v2_ctyp) (smt_cval ctx v2) in
+     let smt1 = smt_cval ctx v1 in
+     let contents = Extract (lbits_size ctx - 1, 0, Fn ("concat", List.init times (fun _ -> smt1))) in
+     Fn ("Bits", [len; Fn ("bvand", [bvmask ctx len; contents])])
+
   | _ -> builtin_type_error ctx "replicate_bits" [v1; v2] (Some ret_ctyp)
 
 let builtin_sail_truncate ctx v1 v2 ret_ctyp =
@@ -928,13 +1016,18 @@ let builtin_get_slice_int ctx v1 v2 v3 ret_ctyp =
      in
      Extract ((start + len) - 1, start, smt)
 
+  | CT_lint, CT_lint, CT_constant start, CT_lbits _ when Big_int.equal start Big_int.zero ->
+     let len = Extract (ctx.lbits_index - 1, 0, smt_cval ctx v1) in
+     let contents = unsigned_size ~checked:false ctx (lbits_size ctx) ctx.lint_size (smt_cval ctx v2) in
+     Fn ("Bits", [len; Fn ("bvand", [bvmask ctx len; contents])])
+
   | _ -> builtin_type_error ctx "get_slice_int" [v1; v2; v3] (Some ret_ctyp)
 
 let builtin_count_leading_zeros ctx v ret_ctyp =
   let ret_sz = int_size ctx ret_ctyp in
   let rec lzcnt sz smt =
     if sz == 1 then
-      Ite (Fn ("=", [Extract (0, 0, smt); Bin "0"]),
+      Ite (Fn ("=", [Extract (0, 0, smt); Bitvec_lit [Sail2_values.B0]]),
            bvint ret_sz (Big_int.of_int 1),
            bvint ret_sz (Big_int.zero))
     else (
@@ -1050,6 +1143,8 @@ let smt_builtin ctx name args ret_ctyp =
   | "max_int", [v1; v2], _ -> builtin_max_int ctx v1 v2 ret_ctyp
   | "min_int", [v1; v2], _ -> builtin_min_int ctx v1 v2 ret_ctyp
 
+  | "ediv_int", [v1; v2], _ -> builtin_tdiv_int ctx v1 v2 ret_ctyp
+
   (* All signed and unsigned bitvector comparisons *)
   | "slt_bits", [v1; v2], CT_bool -> builtin_compare_bits "bvslt" ctx v1 v2 ret_ctyp
   | "ult_bits", [v1; v2], CT_bool -> builtin_compare_bits "bvult" ctx v1 v2 ret_ctyp
@@ -1072,8 +1167,9 @@ let smt_builtin ctx name args ret_ctyp =
   | "sail_truncateLSB", [v1; v2], _ -> builtin_sail_truncateLSB ctx v1 v2 ret_ctyp
   | "shiftl", [v1; v2], _ -> builtin_shift "bvshl" ctx v1 v2 ret_ctyp
   | "shiftr", [v1; v2], _ -> builtin_shift "bvlshr" ctx v1 v2 ret_ctyp
-  | "or_bits", [v1; v2], _ -> builtin_or_bits ctx v1 v2 ret_ctyp
   | "and_bits", [v1; v2], _ -> builtin_and_bits ctx v1 v2 ret_ctyp
+  | "or_bits", [v1; v2], _ -> builtin_or_bits ctx v1 v2 ret_ctyp
+  | "xor_bits", [v1; v2], _ -> builtin_xor_bits ctx v1 v2 ret_ctyp
   | "not_bits", [v], _ -> builtin_not_bits ctx v ret_ctyp
   | "add_bits", [v1; v2], _ -> builtin_add_bits ctx v1 v2 ret_ctyp
   | "add_bits_int", [v1; v2], _ -> builtin_add_bits_int ctx v1 v2 ret_ctyp
@@ -1084,6 +1180,7 @@ let smt_builtin ctx name args ret_ctyp =
   | "vector_access", [v1; v2], ret_ctyp -> builtin_vector_access ctx v1 v2 ret_ctyp
   | "vector_subrange", [v1; v2; v3], ret_ctyp -> builtin_vector_subrange ctx v1 v2 v3 ret_ctyp
   | "vector_update", [v1; v2; v3], ret_ctyp -> builtin_vector_update ctx v1 v2 v3 ret_ctyp
+  | "vector_update_subrange", [v1; v2; v3; v4], ret_ctyp -> builtin_vector_update_subrange ctx v1 v2 v3 v4 ret_ctyp
   | "sail_unsigned", [v], ret_ctyp -> builtin_unsigned ctx v ret_ctyp
   | "sail_signed", [v], ret_ctyp -> builtin_signed ctx v ret_ctyp
   | "replicate_bits", [v1; v2], ret_ctyp -> builtin_replicate_bits ctx v1 v2 ret_ctyp
@@ -1110,16 +1207,30 @@ let smt_builtin ctx name args ret_ctyp =
   | "lteq_real", [v1; v2], CT_bool -> ctx.use_real := true; Fn ("<=", [smt_cval ctx v1; smt_cval ctx v2])
   | "gteq_real", [v1; v2], CT_bool -> ctx.use_real := true; Fn (">=", [smt_cval ctx v1; smt_cval ctx v2])
 
-  | _ -> failwith ("Unknown builtin " ^ name ^ " " ^ Util.string_of_list ", " string_of_ctyp (List.map cval_ctyp args) ^ " -> " ^ string_of_ctyp ret_ctyp)
+  | _ ->
+     Reporting.unreachable ctx.pragma_l __POS__ ("Unknown builtin " ^ name ^ " " ^ Util.string_of_list ", " string_of_ctyp (List.map cval_ctyp args) ^ " -> " ^ string_of_ctyp ret_ctyp)
+
+let loc_doc = function
+  | Parse_ast.Documented (str, l) -> str
+  | _ -> "UNKNOWN"
 
 (* Memory reads and writes as defined in lib/regfp.sail *)
 let writes = ref (-1)
 
-let builtin_write_mem ctx wk addr_size addr data_size data =
+let builtin_write_mem l ctx wk addr_size addr data_size data =
   incr writes;
   let name = "W" ^ string_of_int !writes in
-  [Write_mem (name, ctx.node, Lazy.force ctx.pathcond, smt_cval ctx wk,
-              smt_cval ctx addr, smt_ctyp ctx (cval_ctyp addr), smt_cval ctx data, smt_ctyp ctx (cval_ctyp data))],
+  [Write_mem {
+       name = name;
+       node = ctx.node;
+       active = Lazy.force ctx.pathcond;
+       kind = smt_cval ctx wk;
+       addr = smt_cval ctx addr;
+       addr_type = smt_ctyp ctx (cval_ctyp addr);
+       data = smt_cval ctx data;
+       data_type = smt_ctyp ctx (cval_ctyp data);
+       doc = loc_doc l
+  }],
   Var (name ^ "_ret")
 
 let ea_writes = ref (-1)
@@ -1133,11 +1244,19 @@ let builtin_write_mem_ea ctx wk addr_size addr data_size =
 
 let reads = ref (-1)
 
-let builtin_read_mem ctx rk addr_size addr data_size ret_ctyp =
+let builtin_read_mem l ctx rk addr_size addr data_size ret_ctyp =
   incr reads;
   let name = "R" ^ string_of_int !reads in
-  [Read_mem (name, ctx.node, Lazy.force ctx.pathcond, smt_ctyp ctx ret_ctyp, smt_cval ctx rk,
-             smt_cval ctx addr, smt_ctyp ctx (cval_ctyp addr))],
+  [Read_mem {
+       name = name;
+       node = ctx.node;
+       active = Lazy.force ctx.pathcond;
+       ret_type = smt_ctyp ctx ret_ctyp;
+       kind = smt_cval ctx rk;
+       addr = smt_cval ctx addr;
+       addr_type = smt_ctyp ctx (cval_ctyp addr);
+       doc = loc_doc l
+  }],
   Read_res name
 
 let excl_results = ref (-1)
@@ -1150,26 +1269,51 @@ let builtin_excl_res ctx =
 
 let barriers = ref (-1)
 
-let builtin_barrier ctx bk =
+let builtin_barrier l ctx bk =
   incr barriers;
   let name = "B" ^ string_of_int !barriers in
-  [Barrier (name, ctx.node, Lazy.force ctx.pathcond, smt_cval ctx bk)],
+  [Barrier {
+       name = name;
+       node = ctx.node;
+       active = Lazy.force ctx.pathcond;
+       kind = smt_cval ctx bk;
+       doc = loc_doc l
+  }],
   Enum "unit"
 
-let rec smt_conversion ctx from_ctyp to_ctyp x =
-  match from_ctyp, to_ctyp with
-  | _, _ when ctyp_equal from_ctyp to_ctyp -> x
-  | CT_constant c, CT_fint sz ->
-     bvint sz c
-  | CT_constant c, CT_lint ->
-     bvint ctx.lint_size c
-  | CT_fint sz, CT_lint ->
-     force_size ctx ctx.lint_size sz x
-  | CT_lbits _, CT_fbits (n, _) ->
-     unsigned_size ctx n (lbits_size ctx) (Fn ("contents", [x]))
-  | _, _ -> failwith (Printf.sprintf "Cannot perform conversion from %s to %s" (string_of_ctyp from_ctyp) (string_of_ctyp to_ctyp))
+let cache_maintenances = ref (-1)
+
+let builtin_cache_maintenance l ctx cmk addr_size addr =
+  incr cache_maintenances;
+  let name = "M" ^ string_of_int !cache_maintenances in
+  [Cache_maintenance {
+       name = name;
+       node = ctx.node;
+       active = Lazy.force ctx.pathcond;
+       kind = smt_cval ctx cmk;
+       addr = smt_cval ctx addr;
+       addr_type = smt_ctyp ctx (cval_ctyp addr);
+       doc = loc_doc l
+  }],
+  Enum "unit"
+
+let branch_announces = ref (-1)
+
+let builtin_branch_announce l ctx addr_size addr =
+  incr branch_announces;
+  let name = "C" ^ string_of_int !branch_announces in
+  [Branch_announce {
+       name = name;
+       node = ctx.node;
+       active = Lazy.force ctx.pathcond;
+       addr = smt_cval ctx addr;
+       addr_type = smt_ctyp ctx (cval_ctyp addr);
+       doc = loc_doc l
+  }],
+  Enum "unit"
 
 let define_const ctx id ctyp exp = Define_const (zencode_name id, smt_ctyp ctx ctyp, exp)
+let preserve_const ctx id ctyp exp = Preserve_const (string_of_id id, smt_ctyp ctx ctyp, exp)
 let declare_const ctx id ctyp = Declare_const (zencode_name id, smt_ctyp ctx ctyp)
 
 let smt_ctype_def ctx = function
@@ -1205,143 +1349,144 @@ let rec generate_reg_decs ctx inits = function
 let max_int n = Big_int.pred (Big_int.pow_int_positive 2 (n - 1))
 let min_int n = Big_int.negate (Big_int.pow_int_positive 2 (n - 1))
 
-(** Convert a sail type into a C-type. This function can be quite
-   slow, because it uses ctx.local_env and SMT to analyse the Sail
-   types and attempts to fit them into the smallest possible C
-   types, provided ctx.optimize_smt is true (default) **)
-let rec ctyp_of_typ ctx typ =
-  let open Ast in
-  let open Type_check in
-  let open Jib_compile in
-  let Typ_aux (typ_aux, l) as typ = Env.expand_synonyms ctx.tc_env typ in
-  match typ_aux with
-  | Typ_id id when string_of_id id = "bit"    -> CT_bit
-  | Typ_id id when string_of_id id = "bool"   -> CT_bool
-  | Typ_id id when string_of_id id = "int"    -> CT_lint
-  | Typ_id id when string_of_id id = "nat"    -> CT_lint
-  | Typ_id id when string_of_id id = "unit"   -> CT_unit
-  | Typ_id id when string_of_id id = "string" -> CT_string
-  | Typ_id id when string_of_id id = "real"   -> CT_real
-
-  | Typ_app (id, _) when string_of_id id = "atom_bool" -> CT_bool
-
-  | Typ_app (id, args) when string_of_id id = "itself" ->
-     ctyp_of_typ ctx (Typ_aux (Typ_app (mk_id "atom", args), l))
-  | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" || string_of_id id = "implicit" ->
-     begin match destruct_range Env.empty typ with
-     | None -> assert false (* Checked if range type in guard *)
-     | Some (kids, constr, n, m) ->
-        let ctx = { ctx with local_env = add_existential Parse_ast.Unknown (List.map (mk_kopt K_int) kids) constr ctx.local_env } in
-        match nexp_simp n, nexp_simp m with
-        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
-             when n = m ->
-           CT_constant n
-        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
-             when Big_int.less_equal (min_int 64) n && Big_int.less_equal m (max_int 64) ->
-           CT_fint 64
-        | n, m ->
-           if prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) then
+module SMT_config : Jib_compile.Config = struct
+  open Jib_compile
+
+  (** Convert a sail type into a C-type. This function can be quite
+     slow, because it uses ctx.local_env and SMT to analyse the Sail
+     types and attempts to fit them into the smallest possible C
+     types, provided ctx.optimize_smt is true (default) **)
+  let rec convert_typ ctx typ =
+    let open Ast in
+    let open Type_check in
+    let Typ_aux (typ_aux, l) as typ = Env.expand_synonyms ctx.tc_env typ in
+    match typ_aux with
+    | Typ_id id when string_of_id id = "bit"    -> CT_bit
+    | Typ_id id when string_of_id id = "bool"   -> CT_bool
+    | Typ_id id when string_of_id id = "int"    -> CT_lint
+    | Typ_id id when string_of_id id = "nat"    -> CT_lint
+    | Typ_id id when string_of_id id = "unit"   -> CT_unit
+    | Typ_id id when string_of_id id = "string" -> CT_string
+    | Typ_id id when string_of_id id = "real"   -> CT_real
+
+    | Typ_app (id, _) when string_of_id id = "atom_bool" -> CT_bool
+
+    | Typ_app (id, args) when string_of_id id = "itself" ->
+       convert_typ ctx (Typ_aux (Typ_app (mk_id "atom", args), l))
+    | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" || string_of_id id = "implicit" ->
+       begin match destruct_range Env.empty typ with
+       | None -> assert false (* Checked if range type in guard *)
+       | Some (kids, constr, n, m) ->
+          let ctx = { ctx with local_env = add_existential Parse_ast.Unknown (List.map (mk_kopt K_int) kids) constr ctx.local_env } in
+          match nexp_simp n, nexp_simp m with
+          | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+               when n = m ->
+             CT_constant n
+          | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+               when Big_int.less_equal (min_int 64) n && Big_int.less_equal m (max_int 64) ->
              CT_fint 64
-           else
-             CT_lint
-     end
-
-  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
-     CT_list (ctyp_of_typ ctx typ)
-
-  (* Note that we have to use lbits for zero-length bitvectors because they are not allowed by SMTLIB *)
-  | Typ_app (id, [A_aux (A_nexp n, _); A_aux (A_order ord, _)])
-       when string_of_id id = "bitvector"  ->
-     let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
-     begin match nexp_simp n with
-     | Nexp_aux (Nexp_constant n, _) when Big_int.equal n Big_int.zero -> CT_lbits direction
-     | Nexp_aux (Nexp_constant n, _) -> CT_fbits (Big_int.to_int n, direction)
-     | _ -> CT_lbits direction
-     end
-
-  | Typ_app (id, [A_aux (A_nexp n, _);
-                  A_aux (A_order ord, _);
-                  A_aux (A_typ typ, _)])
-       when string_of_id id = "vector" ->
-     let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
-     CT_vector (direction, ctyp_of_typ ctx typ)
-
-  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "register" ->
-     CT_ref (ctyp_of_typ ctx typ)
-
-  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records  -> CT_struct (id, Bindings.find id ctx.records |> UBindings.bindings)
-  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.variants -> CT_variant (id, Bindings.find id ctx.variants |> UBindings.bindings)
-  | Typ_id id when Bindings.mem id ctx.enums -> CT_enum (id, Bindings.find id ctx.enums |> IdSet.elements)
-
-  | Typ_tup typs -> CT_tup (List.map (ctyp_of_typ ctx) typs)
-
-  | Typ_exist _ ->
-     (* Use Type_check.destruct_exist when optimising with SMT, to
-        ensure that we don't cause any type variable clashes in
-        local_env, and that we can optimize the existential based upon
-        it's constraints. *)
-     begin match destruct_exist (Env.expand_synonyms ctx.local_env typ) with
-     | Some (kids, nc, typ) ->
-        let env = add_existential l kids nc ctx.local_env in
-        ctyp_of_typ { ctx with local_env = env } typ
-     | None -> raise (Reporting.err_unreachable l __POS__ "Existential cannot be destructured!")
-     end
-
-  | Typ_var kid -> CT_poly
-
-  | _ -> raise (Reporting.err_unreachable l __POS__ ("No SMT type for type " ^ string_of_typ typ))
+          | n, m ->
+             if prove __POS__ ctx.local_env (nc_lteq (nconstant (min_int 64)) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant (max_int 64))) then
+               CT_fint 64
+             else
+               CT_lint
+       end
 
-(**************************************************************************)
-(* 3. Optimization of primitives and literals                             *)
-(**************************************************************************)
+    | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
+       CT_list (convert_typ ctx typ)
+
+    (* Note that we have to use lbits for zero-length bitvectors because they are not allowed by SMTLIB *)
+    | Typ_app (id, [A_aux (A_nexp n, _); A_aux (A_order ord, _)])
+         when string_of_id id = "bitvector"  ->
+       let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
+       begin match nexp_simp n with
+       | Nexp_aux (Nexp_constant n, _) when Big_int.equal n Big_int.zero -> CT_lbits direction
+       | Nexp_aux (Nexp_constant n, _) -> CT_fbits (Big_int.to_int n, direction)
+       | _ -> CT_lbits direction
+       end
 
-let hex_char =
-  let open Sail2_values in
-  function
-  | '0' -> [B0; B0; B0; B0]
-  | '1' -> [B0; B0; B0; B1]
-  | '2' -> [B0; B0; B1; B0]
-  | '3' -> [B0; B0; B1; B1]
-  | '4' -> [B0; B1; B0; B0]
-  | '5' -> [B0; B1; B0; B1]
-  | '6' -> [B0; B1; B1; B0]
-  | '7' -> [B0; B1; B1; B1]
-  | '8' -> [B1; B0; B0; B0]
-  | '9' -> [B1; B0; B0; B1]
-  | 'A' | 'a' -> [B1; B0; B1; B0]
-  | 'B' | 'b' -> [B1; B0; B1; B1]
-  | 'C' | 'c' -> [B1; B1; B0; B0]
-  | 'D' | 'd' -> [B1; B1; B0; B1]
-  | 'E' | 'e' -> [B1; B1; B1; B0]
-  | 'F' | 'f' -> [B1; B1; B1; B1]
-  | _ -> failwith "Invalid hex character"
-
-let literal_to_cval (L_aux (l_aux, _) as lit) =
-  match l_aux with
-  | L_num n -> Some (V_lit (VL_int n, CT_constant n))
-  | L_hex str when String.length str <= 16 ->
-     let content = Util.string_to_list str |> List.map hex_char |> List.concat in
-     Some (V_lit (VL_bits (content, true), CT_fbits (String.length str * 4, true)))
-  | L_unit -> Some (V_lit (VL_unit, CT_unit))
-  | L_true -> Some (V_lit (VL_bool true, CT_bool))
-  | L_false -> Some (V_lit (VL_bool false, CT_bool))
-  | _ -> None
-
-let c_literals ctx =
-  let rec c_literal env l = function
-    | AV_lit (lit, typ) as v ->
-       begin match literal_to_cval lit with
-       | Some cval -> AV_cval (cval, typ)
-       | None -> v
+    | Typ_app (id, [A_aux (A_nexp n, _);
+                    A_aux (A_order ord, _);
+                    A_aux (A_typ typ, _)])
+         when string_of_id id = "vector" ->
+       let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
+       CT_vector (direction, convert_typ ctx typ)
+
+    | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "register" ->
+       CT_ref (convert_typ ctx typ)
+
+    | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records  -> CT_struct (id, Bindings.find id ctx.records |> UBindings.bindings)
+    | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.variants -> CT_variant (id, Bindings.find id ctx.variants |> UBindings.bindings)
+    | Typ_id id when Bindings.mem id ctx.enums -> CT_enum (id, Bindings.find id ctx.enums |> IdSet.elements)
+
+    | Typ_tup typs -> CT_tup (List.map (convert_typ ctx) typs)
+
+    | Typ_exist _ ->
+       (* Use Type_check.destruct_exist when optimising with SMT, to
+          ensure that we don't cause any type variable clashes in
+          local_env, and that we can optimize the existential based
+          upon it's constraints. *)
+       begin match destruct_exist (Env.expand_synonyms ctx.local_env typ) with
+       | Some (kids, nc, typ) ->
+          let env = add_existential l kids nc ctx.local_env in
+          convert_typ { ctx with local_env = env } typ
+       | None -> raise (Reporting.err_unreachable l __POS__ "Existential cannot be destructured!")
        end
-    | AV_tuple avals -> AV_tuple (List.map (c_literal env l) avals)
-    | v -> v
-  in
-  map_aval c_literal
 
-let unroll_foreach ctx = function
+    | Typ_var kid -> CT_poly
+
+    | _ -> raise (Reporting.err_unreachable l __POS__ ("No SMT type for type " ^ string_of_typ typ))
+
+  let hex_char =
+    let open Sail2_values in
+    function
+    | '0' -> [B0; B0; B0; B0]
+    | '1' -> [B0; B0; B0; B1]
+    | '2' -> [B0; B0; B1; B0]
+    | '3' -> [B0; B0; B1; B1]
+    | '4' -> [B0; B1; B0; B0]
+    | '5' -> [B0; B1; B0; B1]
+    | '6' -> [B0; B1; B1; B0]
+    | '7' -> [B0; B1; B1; B1]
+    | '8' -> [B1; B0; B0; B0]
+    | '9' -> [B1; B0; B0; B1]
+    | 'A' | 'a' -> [B1; B0; B1; B0]
+    | 'B' | 'b' -> [B1; B0; B1; B1]
+    | 'C' | 'c' -> [B1; B1; B0; B0]
+    | 'D' | 'd' -> [B1; B1; B0; B1]
+    | 'E' | 'e' -> [B1; B1; B1; B0]
+    | 'F' | 'f' -> [B1; B1; B1; B1]
+    | _ -> failwith "Invalid hex character"
+
+  let literal_to_cval (L_aux (l_aux, _) as lit) =
+    match l_aux with
+    | L_num n -> Some (V_lit (VL_int n, CT_constant n))
+    | L_hex str when String.length str <= 16 ->
+       let content = Util.string_to_list str |> List.map hex_char |> List.concat in
+       Some (V_lit (VL_bits (content, true), CT_fbits (String.length str * 4, true)))
+    | L_unit -> Some (V_lit (VL_unit, CT_unit))
+    | L_true -> Some (V_lit (VL_bool true, CT_bool))
+    | L_false -> Some (V_lit (VL_bool false, CT_bool))
+    | _ -> None
+
+  let c_literals ctx =
+    let rec c_literal env l = function
+      | AV_lit (lit, typ) as v ->
+         begin match literal_to_cval lit with
+         | Some cval -> AV_cval (cval, typ)
+         | None -> v
+         end
+      | AV_tuple avals -> AV_tuple (List.map (c_literal env l) avals)
+      | v -> v
+    in
+    map_aval c_literal
+
+(* If we know the loop variables exactly (especially after
+   specialization), we can unroll the exact number of times required,
+   and omit any comparisons. *)
+let unroll_static_foreach ctx = function
   | AE_aux (AE_for (id, from_aexp, to_aexp, by_aexp, order, body), env, l) as aexp ->
-     begin match ctyp_of_typ ctx (aexp_typ from_aexp), ctyp_of_typ ctx (aexp_typ to_aexp), ctyp_of_typ ctx (aexp_typ by_aexp), order with
+     begin match convert_typ ctx (aexp_typ from_aexp), convert_typ ctx (aexp_typ to_aexp), convert_typ ctx (aexp_typ by_aexp), order with
      | CT_constant f, CT_constant t, CT_constant b, Ord_aux (Ord_inc, _) ->
         let i = ref f in
         let unrolled = ref [] in
@@ -1360,6 +1505,19 @@ let unroll_foreach ctx = function
      end
   | aexp -> aexp
 
+  let optimize_anf ctx aexp =
+    aexp
+    |> c_literals ctx
+    |> fold_aexp (unroll_static_foreach ctx)
+
+  let specialize_calls = true
+  let ignore_64 = true
+  let unroll_loops () = Some !opt_unroll_limit
+  let struct_value = true
+  let use_real = true
+end
+
+
 (**************************************************************************)
 (* 3. Generating SMT                                                      *)
 (**************************************************************************)
@@ -1414,7 +1572,7 @@ let smt_ssanode ctx cfg preds =
          pis ids None
      in
      match mux with
-     | None -> []
+     | None -> assert false
      | Some mux ->
         [Define_const (zencode_name id, smt_ctyp ctx ctyp, mux)]
 
@@ -1492,7 +1650,7 @@ let rec rmw_write = function
   | CL_id _ -> assert false
   | CL_tuple (clexp, _) -> rmw_write clexp
   | CL_field (clexp, _) -> rmw_write clexp
-  | clexp -> assert false
+  | clexp -> failwith "Could not understand l-expression"
 
 let rmw_read = function
   | CL_rmw (read, _, _) -> zencode_name read
@@ -1522,7 +1680,7 @@ let rmw_modify smt = function
           if UId.compare field field' = 0 then
             smt
           else
-            Fn (zencode_upper_id struct_id ^ "_" ^ zencode_uid field', [Var (rmw_read clexp)])
+            Field (zencode_upper_id struct_id ^ "_" ^ zencode_uid field', Var (rmw_read clexp))
         in
         Fn (zencode_upper_id struct_id, List.map set_field fields)
      | _ ->
@@ -1564,7 +1722,7 @@ let smt_instr ctx =
        else if name = "platform_write_mem" then
          begin match args with
          | [wk; addr_size; addr; data_size; data] ->
-            let mem_event, var = builtin_write_mem ctx wk addr_size addr data_size data in
+            let mem_event, var = builtin_write_mem l ctx wk addr_size addr data_size data in
             mem_event @ [define_const ctx id ret_ctyp var]
          | _ ->
             Reporting.unreachable l __POS__ "Bad arguments for __write_mem"
@@ -1580,7 +1738,7 @@ let smt_instr ctx =
        else if name = "platform_read_mem" then
          begin match args with
          | [rk; addr_size; addr; data_size] ->
-            let mem_event, var = builtin_read_mem ctx rk addr_size addr data_size ret_ctyp in
+            let mem_event, var = builtin_read_mem l ctx rk addr_size addr data_size ret_ctyp in
             mem_event @ [define_const ctx id ret_ctyp var]
          | _ ->
             Reporting.unreachable l __POS__ "Bad arguments for __read_mem"
@@ -1588,7 +1746,23 @@ let smt_instr ctx =
        else if name = "platform_barrier" then
          begin match args with
          | [bk] ->
-            let mem_event, var = builtin_barrier ctx bk in
+            let mem_event, var = builtin_barrier l ctx bk in
+            mem_event @ [define_const ctx id ret_ctyp var]
+         | _ ->
+            Reporting.unreachable l __POS__ "Bad arguments for __barrier"
+         end
+       else if name = "platform_cache_maintenance" then
+         begin match args with
+         | [cmk; addr_size; addr] ->
+            let mem_event, var = builtin_cache_maintenance l ctx cmk addr_size addr in
+            mem_event @ [define_const ctx id ret_ctyp var]
+         | _ ->
+            Reporting.unreachable l __POS__ "Bad arguments for __barrier"
+         end
+       else if name = "platform_branch_announce" then
+         begin match args with
+         | [addr_size; addr] ->
+            let mem_event, var = builtin_branch_announce l ctx addr_size addr in
             mem_event @ [define_const ctx id ret_ctyp var]
          | _ ->
             Reporting.unreachable l __POS__ "Bad arguments for __barrier"
@@ -1601,9 +1775,20 @@ let smt_instr ctx =
          | _ ->
             Reporting.unreachable l __POS__ "Bad arguments for __excl_res"
          end
+       else if name = "sail_exit" then
+         (add_event ctx Assertion (Bool_lit false); [])
+       else if name = "sail_assert" then
+         begin match args with
+         | [assertion; _] ->
+            let smt = smt_cval ctx assertion in
+            add_event ctx Assertion (Fn ("not", [smt]));
+            []
+         | _ ->
+            Reporting.unreachable l __POS__ "Bad arguments for assertion"
+         end
        else
          let value = smt_builtin ctx name args ret_ctyp in
-         [define_const ctx id ret_ctyp value]
+         [define_const ctx id ret_ctyp (Syntactic (value, List.map (smt_cval ctx) args))]
      else if extern && string_of_id (fst function_id) = "internal_vector_init" then
        [declare_const ctx id ret_ctyp]
      else if extern && string_of_id (fst function_id) = "internal_vector_update" then
@@ -1615,15 +1800,6 @@ let smt_instr ctx =
        | _ ->
           Reporting.unreachable l __POS__ "Bad arguments for internal_vector_update"
        end
-     else if string_of_id (fst function_id) = "sail_assert" then
-       begin match args with
-       | [assertion; _] ->
-          let smt = smt_cval ctx assertion in
-          add_event ctx Assertion smt;
-          []
-       | _ ->
-          Reporting.unreachable l __POS__ "Bad arguments for assertion"
-       end
      else if string_of_id (fst function_id) = "sail_assume" then
        begin match args with
        | [assumption] ->
@@ -1643,8 +1819,14 @@ let smt_instr ctx =
      Reporting.unreachable l __POS__ "Register reference write should be re-written by now"
 
   | I_aux (I_init (ctyp, id, cval), _) | I_aux (I_copy (CL_id (id, ctyp), cval), _) ->
-     [define_const ctx id ctyp
-        (smt_conversion ctx (cval_ctyp cval) ctyp (smt_cval ctx cval))]
+     begin match id with
+     | Name (id, _) when IdSet.mem id ctx.preserved ->
+        [preserve_const ctx id ctyp
+           (smt_conversion ctx (cval_ctyp cval) ctyp (smt_cval ctx cval))]
+     | _ ->
+        [define_const ctx id ctyp
+           (smt_conversion ctx (cval_ctyp cval) ctyp (smt_cval ctx cval))]
+     end
 
   | I_aux (I_copy (clexp, cval), _) ->
      let smt = smt_cval ctx cval in
@@ -1721,13 +1903,19 @@ module Make_optimizer(S : Sequence) = struct
          | Some n -> Hashtbl.replace uses var (n + 1)
          | None -> Hashtbl.add uses var 1
          end
-      | Enum _ | Read_res _ | Hex _ | Bin _ | Bool_lit _ | String_lit _ | Real_lit _ -> ()
+      | Syntactic (exp, _) -> uses_in_exp exp
+      | Shared _ | Enum _ | Read_res _ | Bitvec_lit _ | Bool_lit _ | String_lit _ | Real_lit _ -> ()
       | Fn (_, exps) | Ctor (_, exps) ->
          List.iter uses_in_exp exps
+      | Field (_, exp) ->
+         uses_in_exp exp
+      | Struct (_, fields) ->
+         List.iter (fun (_, exp) -> uses_in_exp exp) fields
       | Ite (cond, t, e) ->
          uses_in_exp cond; uses_in_exp t; uses_in_exp e
       | Extract (_, _, exp) | Tester (_, exp) | SignExtend (_, exp) ->
          uses_in_exp exp
+      | Forall _ -> assert false
     in
 
     let remove_unused () = function
@@ -1737,6 +1925,11 @@ module Make_optimizer(S : Sequence) = struct
          | Some _ ->
             Stack.push def stack'
          end
+      | Declare_fun _ as def ->
+         Stack.push def stack'
+      | Preserve_const (_, _, exp) as def ->
+         uses_in_exp exp;
+         Stack.push def stack'
       | Define_const (var, _, exp) as def ->
          begin match Hashtbl.find_opt uses var with
          | None -> ()
@@ -1746,17 +1939,23 @@ module Make_optimizer(S : Sequence) = struct
          end
       | (Declare_datatypes _ | Declare_tuple _) as def ->
          Stack.push def stack'
-      | Write_mem (_, _, active, wk, addr, _, data, _) as def ->
-         uses_in_exp active; uses_in_exp wk; uses_in_exp addr; uses_in_exp data;
+      | Write_mem w as def ->
+         uses_in_exp w.active; uses_in_exp w.kind; uses_in_exp w.addr; uses_in_exp w.data;
          Stack.push def stack'
       | Write_mem_ea (_, _, active, wk, addr, _, data_size, _) as def ->
          uses_in_exp active; uses_in_exp wk; uses_in_exp addr; uses_in_exp data_size;
          Stack.push def stack'
-      | Read_mem (_, _, active, _, rk, addr, _) as def ->
-         uses_in_exp active; uses_in_exp rk; uses_in_exp addr;
+      | Read_mem r as def ->
+         uses_in_exp r.active; uses_in_exp r.kind; uses_in_exp r.addr;
+         Stack.push def stack'
+      | Barrier b as def ->
+         uses_in_exp b.active; uses_in_exp b.kind;
          Stack.push def stack'
-      | Barrier (_, _, active, bk) as def ->
-         uses_in_exp active; uses_in_exp bk;
+      | Cache_maintenance m as def ->
+         uses_in_exp m.active; uses_in_exp m.kind; uses_in_exp m.addr;
+         Stack.push def stack'
+      | Branch_announce c as def ->
+         uses_in_exp c.active; uses_in_exp c.addr;
          Stack.push def stack'
       | Excl_res (_, _, active) as def ->
          uses_in_exp active;
@@ -1775,10 +1974,14 @@ module Make_optimizer(S : Sequence) = struct
     let constant_propagate = function
       | Declare_const _ as def ->
          S.add def seq
+      | Declare_fun _ as def ->
+         S.add def seq
+      | Preserve_const (var, typ, exp) ->
+         S.add (Preserve_const (var, typ, simp_smt_exp vars kinds exp)) seq
       | Define_const (var, typ, exp) ->
          let exp = simp_smt_exp vars kinds exp in
          begin match Hashtbl.find_opt uses var, simp_smt_exp vars kinds exp with
-         | _, (Bin _ | Bool_lit _) ->
+         | _, (Bitvec_lit _ | Bool_lit _) ->
             Hashtbl.add vars var exp
          | _, Var _ when !opt_propagate_vars ->
             Hashtbl.add vars var exp
@@ -1791,20 +1994,30 @@ module Make_optimizer(S : Sequence) = struct
             S.add (Define_const (var, typ, exp)) seq
          | None, _ -> assert false
          end
-      | Write_mem (name, node, active, wk, addr, addr_ty, data, data_ty) ->
-         S.add (Write_mem (name, node, simp_smt_exp vars kinds active, simp_smt_exp vars kinds wk,
-                           simp_smt_exp vars kinds addr, addr_ty, simp_smt_exp vars kinds data, data_ty))
+      | Write_mem w ->
+         S.add (Write_mem { w with active = simp_smt_exp vars kinds w.active;
+                                   kind = simp_smt_exp vars kinds w.kind;
+                                   addr = simp_smt_exp vars kinds w.addr;
+                                   data = simp_smt_exp vars kinds w.data })
                seq
       | Write_mem_ea (name, node, active, wk, addr, addr_ty, data_size, data_size_ty) ->
          S.add (Write_mem_ea (name, node, simp_smt_exp vars kinds active, simp_smt_exp vars kinds wk,
                               simp_smt_exp vars kinds addr, addr_ty, simp_smt_exp vars kinds data_size, data_size_ty))
                seq
-      | Read_mem (name, node, active, typ, rk, addr, addr_typ) ->
-         S.add (Read_mem (name, node, simp_smt_exp vars kinds active, typ, simp_smt_exp vars kinds rk,
-                          simp_smt_exp vars kinds addr, addr_typ))
+      | Read_mem r ->
+         S.add (Read_mem { r with active = simp_smt_exp vars kinds r.active;
+                                  kind = simp_smt_exp vars kinds r.kind;
+                                  addr = simp_smt_exp vars kinds r.addr })
                seq
-      | Barrier (name, node, active, bk) ->
-         S.add (Barrier (name, node, simp_smt_exp vars kinds active, simp_smt_exp vars kinds bk)) seq
+      | Barrier b ->
+         S.add (Barrier { b with active = simp_smt_exp vars kinds b.active; kind = simp_smt_exp vars kinds b.kind }) seq
+      | Cache_maintenance m ->
+         S.add (Cache_maintenance { m with active = simp_smt_exp vars kinds m.active;
+                                           kind = simp_smt_exp vars kinds m.kind;
+                                           addr = simp_smt_exp vars kinds m.addr })
+               seq
+      | Branch_announce c ->
+         S.add (Branch_announce { c with active = simp_smt_exp vars kinds c.active; addr = simp_smt_exp vars kinds c.addr }) seq
       | Excl_res (name, node, active) ->
          S.add (Excl_res (name, node, simp_smt_exp vars kinds active)) seq
       | Assert exp ->
@@ -1843,6 +2056,26 @@ let smt_header ctx cdefs =
    register if it is. We also do a similar thing for *r = x
 *)
 let expand_reg_deref env register_map = function
+  | I_aux (I_funcall (CL_addr (CL_id (id, ctyp)), false, function_id, args), (_, l)) ->
+     begin match ctyp with
+     | CT_ref reg_ctyp ->
+        begin match CTMap.find_opt reg_ctyp register_map with
+        | Some regs ->
+           let end_label = label "end_reg_write_" in
+           let try_reg r =
+             let next_label = label "next_reg_write_" in
+             [ijump l (V_call (Neq, [V_lit (VL_ref (string_of_id r), reg_ctyp); V_id (id, ctyp)])) next_label;
+              ifuncall (CL_id (name r, reg_ctyp)) function_id args;
+              igoto end_label;
+              ilabel next_label]
+           in
+           iblock (List.concat (List.map try_reg regs) @ [ilabel end_label])
+        | None ->
+           raise (Reporting.err_general l ("Could not find any registers with type " ^ string_of_ctyp reg_ctyp))
+        end
+     | _ ->
+        raise (Reporting.err_general l "Register reference assignment must take a register reference as an argument")
+     end
   | I_aux (I_funcall (clexp, false, function_id, [reg_ref]), (_, l)) as instr ->
      let open Type_check in
      begin match (if Env.is_extern (fst function_id) env "smt" then Some (Env.get_extern (fst function_id) env "smt") else None) with
@@ -1855,7 +2088,7 @@ let expand_reg_deref env register_map = function
               let end_label = label "end_reg_deref_" in
               let try_reg r =
                 let next_label = label "next_reg_deref_" in
-                [ijump (V_call (Neq, [V_ref (name r, reg_ctyp); reg_ref])) next_label;
+                [ijump l (V_call (Neq, [V_lit (VL_ref (string_of_id r), reg_ctyp); reg_ref])) next_label;
                  icopy l clexp (V_id (name r, reg_ctyp));
                  igoto end_label;
                  ilabel next_label]
@@ -1877,7 +2110,7 @@ let expand_reg_deref env register_map = function
            let end_label = label "end_reg_write_" in
            let try_reg r =
              let next_label = label "next_reg_write_" in
-             [ijump (V_call (Neq, [V_ref (name r, reg_ctyp); V_id (id, ctyp)])) next_label;
+             [ijump l (V_call (Neq, [V_lit (VL_ref (string_of_id r), reg_ctyp); V_id (id, ctyp)])) next_label;
               icopy l (CL_id (name r, reg_ctyp)) cval;
               igoto end_label;
               ilabel next_label]
@@ -1927,7 +2160,7 @@ let smt_instr_list name ctx all_cdefs instrs =
     dump_graph name cfg;
 
   List.iter (fun n ->
-      begin match get_vertex cfg n with
+      match get_vertex cfg n with
       | None -> ()
       | Some ((ssa_elems, cfnode), preds, succs) ->
          let muxers =
@@ -1937,13 +2170,12 @@ let smt_instr_list name ctx all_cdefs instrs =
          let basic_block = smt_cfnode all_cdefs ctx ssa_elems cfnode in
          push_smt_defs stack muxers;
          push_smt_defs stack basic_block
-      end
     ) visit_order;
 
-  stack, cfg
+  stack, start, cfg
 
 let smt_cdef props lets name_file ctx all_cdefs = function
-  | CDEF_spec (function_id, arg_ctyps, ret_ctyp) when Bindings.mem function_id props ->
+  | CDEF_spec (function_id, _, arg_ctyps, ret_ctyp) when Bindings.mem function_id props ->
      begin match find_function [] function_id all_cdefs with
      | intervening_lets, Some (None, args, instrs) ->
         let prop_type, prop_args, pragma_l, vs = Bindings.find function_id props in
@@ -1967,7 +2199,7 @@ let smt_cdef props lets name_file ctx all_cdefs = function
           |> remove_pointless_goto
         in
 
-        let stack, _ = smt_instr_list (string_of_id function_id) ctx all_cdefs instrs in
+        let stack, _, _ = smt_instr_list (string_of_id function_id) ctx all_cdefs instrs in
 
         let query = smt_query ctx pragma.query in
         push_smt_defs stack [Assert (Fn ("not", [query]))];
@@ -2038,25 +2270,20 @@ let rec build_register_map rmap = function
   | [] -> rmap
 
 let compile env ast =
-  let cdefs =
-    let open Jib_compile in
-    let ctx =
-      initial_ctx
-        ~convert_typ:ctyp_of_typ
-        ~optimize_anf:(fun ctx aexp -> fold_aexp (unroll_foreach ctx) (c_literals ctx aexp))
-        env
-    in
+  let cdefs, jib_ctx =
+    let module Jibc = Jib_compile.Make(SMT_config) in
+    let ctx = Jib_compile.(initial_ctx (add_special_functions env)) in
     let t = Profile.start () in
-    let cdefs, ctx = compile_ast { ctx with specialize_calls = true; ignore_64 = true; struct_value = true; use_real = true } ast in
+    let cdefs, ctx = Jibc.compile_ast ctx ast in
     Profile.finish "Compiling to Jib IR" t;
-    cdefs
+    cdefs, ctx
   in
   let cdefs = Jib_optimize.unique_per_function_ids cdefs in
   let rmap = build_register_map CTMap.empty cdefs in
-  cdefs, { (initial_ctx ()) with tc_env = env; register_map = rmap; ast = ast }
+  cdefs, jib_ctx, { (initial_ctx ()) with tc_env = jib_ctx.tc_env; register_map = rmap; ast = ast }
 
 let serialize_smt_model file env ast =
-  let cdefs, ctx = compile env ast in
+  let cdefs, _, ctx = compile env ast in
   let out_chan = open_out file in
   Marshal.to_channel out_chan cdefs [];
   Marshal.to_channel out_chan (Type_check.Env.set_prover None ctx.tc_env) [];
@@ -2073,7 +2300,7 @@ let deserialize_smt_model file =
 
 let generate_smt props name_file env ast =
   try
-    let cdefs, ctx = compile env ast in
+    let cdefs, _, ctx = compile env ast in
     smt_cdefs props [] name_file ctx cdefs cdefs
   with
   | Type_check.Type_error (_, l, err) ->
diff --git a/src/jib/jib_smt.mli b/src/jib/jib_smt.mli
index cdaf7e39..616877e4 100644
--- a/src/jib/jib_smt.mli
+++ b/src/jib/jib_smt.mli
@@ -73,44 +73,57 @@ val opt_default_lbits_index : int ref
 val opt_default_vector_index : int ref
 
 type ctx = {
-    (** Arbitrary-precision bitvectors are represented as a (BitVec lbits_index, BitVec (2 ^ lbits_index)) pair. *)
     lbits_index : int;
-    (** The size we use for integers where we don't know how large they are statically. *)
+    (** Arbitrary-precision bitvectors are represented as a (BitVec lbits_index, BitVec (2 ^ lbits_index)) pair. *)
     lint_size : int;
+    (** The size we use for integers where we don't know how large they are statically. *)
+    vector_index : int;
     (** A generic vector, vector('a) becomes Array (BitVec vector_index) 'a.
        We need to take care that vector_index is large enough for all generic vectors. *)
-    vector_index : int;
-    (** A map from each ctyp to a list of registers of that ctyp *)
     register_map : id list CTMap.t;
-    (** A set to keep track of all the tuple sizes we need to generate types for *)
+    (** A map from each ctyp to a list of registers of that ctyp *)
     tuple_sizes : IntSet.t ref;
-    (** tc_env is the global type-checking environment *)
+    (** A set to keep track of all the tuple sizes we need to generate types for *)
     tc_env : Type_check.Env.t;
+    (** tc_env is the global type-checking environment *)
+    pragma_l : Ast.l;
     (** A location, usually the $counterexample or $property we are
        generating the SMT for. Used for error messages. *)
-    pragma_l : Ast.l;
-    (** Used internally to keep track of function argument names *)
     arg_stack : (int * string) Stack.t;
-    (** The fully type-checked ast *)
+    (** Used internally to keep track of function argument names *)
     ast : Type_check.tannot defs;
+    (** The fully type-checked ast *)
+    shared : ctyp Bindings.t;
+    (** Shared variables. These variables do not get renamed by
+       Smtlib.suffix_variables_def, and their SSA number is
+       omitted. They should therefore only ever be read and never
+       written. Used by sail-axiomatic for symbolic values in the
+       initial litmus state. *)
+    preserved : IdSet.t;
+    (** icopy instructions to an id in preserved will generated a
+       define-const (by using Smtlib.Preserved_const) that will not be
+       simplified away or renamed. It will also not get a SSA
+       number. Such variables can therefore only ever be written to
+       once, and never read. They are used by sail-axiomatic to
+       extract information from the generated SMT. *)
+    events : smt_exp Stack.t EventMap.t ref;
     (** For every event type we have a stack of boolean SMT
        expressions for each occurance of that event. See
        src/property.ml for the event types *)
-    events : smt_exp Stack.t EventMap.t ref;
+    node : int;
+    pathcond : smt_exp Lazy.t;
     (** When generating SMT for an instruction pathcond will contain
        the global path conditional of the containing block/node in the
        control flow graph *)
-    node : int;
-    pathcond : smt_exp Lazy.t;
+    use_string : bool ref;
+    use_real : bool ref
     (** Set if we need to use strings or real numbers in the generated
        SMT, which then requires set-logic ALL or similar depending on
        the solver *)
-    use_string : bool ref;
-    use_real : bool ref
   }
 
 (** Compile an AST into Jib suitable for SMT generation, and initialise a context. *)
-val compile : Type_check.Env.t -> Type_check.tannot defs -> cdef list * ctx
+val compile : Type_check.Env.t -> Type_check.tannot defs -> cdef list * Jib_compile.ctx * ctx
 
 (* TODO: Currently we internally use mutable stacks and queues to
    avoid any issues with stack overflows caused by some non
@@ -122,7 +135,7 @@ val smt_header : ctx -> cdef list -> smt_def list
 
 val smt_query : ctx -> Property.query -> smt_exp
 
-val smt_instr_list : string -> ctx -> cdef list -> instr list -> smt_def Stack.t * (ssa_elem list * cf_node) Jib_ssa.array_graph
+val smt_instr_list : string -> ctx -> cdef list -> instr list -> smt_def Stack.t * int * (ssa_elem list * cf_node) Jib_ssa.array_graph
 
 module type Sequence = sig
   type 'a t
diff --git a/src/jib/jib_smt_fuzz.ml b/src/jib/jib_smt_fuzz.ml
index 846d0178..58665bde 100644
--- a/src/jib/jib_smt_fuzz.ml
+++ b/src/jib/jib_smt_fuzz.ml
@@ -152,13 +152,13 @@ let rec run frame =
 exception Skip_iteration of string;;
 
 let fuzz_cdef ctx all_cdefs = function
-  | CDEF_spec (id, arg_ctyps, ret_ctyp) when not (string_of_id id = "and_bool" || string_of_id id = "or_bool") ->
+  | CDEF_spec (id, _, arg_ctyps, ret_ctyp) when not (string_of_id id = "and_bool" || string_of_id id = "or_bool") ->
      let open Type_check in
      let open Interpreter in
      if Env.is_extern id ctx.tc_env "smt" then (
        let extern = Env.get_extern id ctx.tc_env "smt" in
        let typq, (Typ_aux (aux, _) as typ) = Env.get_val_spec id ctx.tc_env in
-       let istate = initial_state ctx.ast ctx.tc_env Value.primops in
+       let istate = initial_state ctx.ast ctx.tc_env !Value.primops in
        let header = smt_header ctx all_cdefs in
        prerr_endline (Util.("Fuzz: " |> cyan |> clear) ^ string_of_id id ^ " = \"" ^ extern ^ "\" : " ^ string_of_typ typ);
 
@@ -192,7 +192,7 @@ let fuzz_cdef ctx all_cdefs = function
                    @ [iend ()]
                  in
                  let smt_defs =
-                   try fst (smt_instr_list extern ctx all_cdefs jib) with
+                   try (fun (x, _, _) -> x) (smt_instr_list extern ctx all_cdefs jib) with
                    | _ ->
                       raise (Skip_iteration ("SMT error for: " ^ Util.string_of_list ", " string_of_exp (List.map fst values)))
                  in
@@ -253,6 +253,6 @@ let fuzz_cdef ctx all_cdefs = function
 let fuzz seed env ast =
   Random.init seed;
 
-  let cdefs, ctx = compile env ast in
+  let cdefs, _, ctx = compile env ast in
 
   List.iter (fuzz_cdef ctx cdefs) cdefs
diff --git a/src/jib/jib_ssa.ml b/src/jib/jib_ssa.ml
index 9c405a48..fe3238a4 100644
--- a/src/jib/jib_ssa.ml
+++ b/src/jib/jib_ssa.ml
@@ -504,6 +504,7 @@ let rename_variables graph root children =
     | Name (id, _) -> Name (id, i)
     | Have_exception _ -> Have_exception i
     | Current_exception _ -> Current_exception i
+    | Throw_location _ -> Throw_location i
     | Return _ -> Return i
   in
 
@@ -524,9 +525,6 @@ let rename_variables graph root children =
     | V_id (id, ctyp) ->
        let i = top_stack id in
        V_id (ssa_name i id, ctyp)
-    | V_ref (id, ctyp) ->
-       let i = top_stack id in
-       V_ref (ssa_name i id, ctyp)
     | V_lit (vl, ctyp) -> V_lit (vl, ctyp)
     | V_call (id, fs) -> V_call (id, List.map fold_cval fs)
     | V_field (f, field) -> V_field (fold_cval f, field)
diff --git a/src/jib/jib_util.ml b/src/jib/jib_util.ml
index 13438208..9b06c7be 100644
--- a/src/jib/jib_util.ml
+++ b/src/jib/jib_util.ml
@@ -83,7 +83,7 @@ let ireset ?loc:(l=Parse_ast.Unknown) ctyp id =
 let iinit ?loc:(l=Parse_ast.Unknown) ctyp id cval =
   I_aux (I_init (ctyp, id, cval), (instr_number (), l))
 
-let iif ?loc:(l=Parse_ast.Unknown) cval then_instrs else_instrs ctyp =
+let iif l cval then_instrs else_instrs ctyp =
   I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (instr_number (), l))
 
 let ifuncall ?loc:(l=Parse_ast.Unknown) clexp id cvals =
@@ -113,7 +113,7 @@ let iblock ?loc:(l=Parse_ast.Unknown) instrs =
 let itry_block ?loc:(l=Parse_ast.Unknown) instrs =
   I_aux (I_try_block instrs, (instr_number (), l))
 
-let ithrow ?loc:(l=Parse_ast.Unknown) cval =
+let ithrow l cval =
   I_aux (I_throw cval, (instr_number (), l))
 
 let icomment ?loc:(l=Parse_ast.Unknown) str =
@@ -134,7 +134,7 @@ let imatch_failure ?loc:(l=Parse_ast.Unknown) () =
 let iraw ?loc:(l=Parse_ast.Unknown) str =
   I_aux (I_raw str, (instr_number (), l))
 
-let ijump ?loc:(l=Parse_ast.Unknown) cval label =
+let ijump l cval label =
   I_aux (I_jump (cval, label), (instr_number (), l))
 
 module Name = struct
@@ -153,6 +153,8 @@ module Name = struct
     | _, Have_exception _ -> -1
     | Current_exception _, _ -> 1
     | _, Current_exception _ -> -1
+    | Throw_location _, _ -> 1
+    | _, Throw_location _ -> -1
 end
 
 module NameSet = Set.Make(Name)
@@ -160,6 +162,7 @@ module NameMap = Map.Make(Name)
 
 let current_exception = Current_exception (-1)
 let have_exception = Have_exception (-1)
+let throw_location = Throw_location (-1)
 let return = Return (-1)
 
 let name id = Name (id, -1)
@@ -167,8 +170,6 @@ let name id = Name (id, -1)
 let rec cval_rename from_id to_id = function
   | V_id (id, ctyp) when Name.compare id from_id = 0 -> V_id (to_id, ctyp)
   | V_id (id, ctyp) -> V_id (id, ctyp)
-  | V_ref (id, ctyp) when Name.compare id from_id = 0 -> V_ref (to_id, ctyp)
-  | V_ref (id, ctyp) -> V_ref (id, ctyp)
   | V_lit (vl, ctyp) -> V_lit (vl, ctyp)
   | V_call (call, cvals) -> V_call (call, List.map (cval_rename from_id to_id) cvals)
   | V_field (f, field) -> V_field (cval_rename from_id to_id f, field)
@@ -257,8 +258,7 @@ let rec instr_rename from_id to_id (I_aux (instr, aux)) =
 (* 1. Instruction pretty printer                                          *)
 (**************************************************************************)
 
-
-let string_of_name ?deref_current_exception:(dce=true) ?zencode:(zencode=true) =
+let string_of_name ?deref_current_exception:(dce=false) ?zencode:(zencode=true) =
   let ssa_num n = if n = -1 then "" else ("/" ^ string_of_int n) in
   function
   | Name (id, n) ->
@@ -271,6 +271,8 @@ let string_of_name ?deref_current_exception:(dce=true) ?zencode:(zencode=true) =
      "(*current_exception)" ^ ssa_num n
   | Current_exception n ->
      "current_exception" ^ ssa_num n
+  | Throw_location n ->
+     "throw_location" ^ ssa_num n
 
 let string_of_op = function
   | Bnot -> "@not"
@@ -278,7 +280,6 @@ let string_of_op = function
   | Bor -> "@or"
   | List_hd -> "@hd"
   | List_tl -> "@tl"
-  | Bit_to_bool -> "@bit_to_bool"
   | Eq -> "@eq"
   | Neq -> "@neq"
   | Bvnot -> "@bvnot"
@@ -309,9 +310,9 @@ let string_of_op = function
 let rec string_of_ctyp = function
   | CT_lint -> "%i"
   | CT_fint n -> "%i" ^ string_of_int n
-  | CT_lbits _ -> "%lb"
-  | CT_sbits (n, _) -> "%sb" ^ string_of_int n
-  | CT_fbits (n, _) -> "%fb" ^ string_of_int n
+  | CT_lbits _ -> "%bv"
+  | CT_sbits (n, _) -> "%sbv" ^ string_of_int n
+  | CT_fbits (n, _) -> "%bv" ^ string_of_int n
   | CT_constant n -> Big_int.to_string n
   | CT_bit -> "%bit"
   | CT_unit -> "%unit"
@@ -323,6 +324,7 @@ let rec string_of_ctyp = function
   | CT_enum (id, _) -> "%enum " ^ Util.zencode_string (string_of_id id)
   | CT_variant (id, _) -> "%union " ^ Util.zencode_string (string_of_id id)
   | CT_vector (_, ctyp) -> "%vec(" ^ string_of_ctyp ctyp ^ ")"
+  | CT_fvector (n, _, ctyp) -> "%fvec(" ^ string_of_int n ^ ", " ^ string_of_ctyp ctyp ^ ")"
   | CT_list ctyp -> "%list(" ^ string_of_ctyp ctyp ^ ")"
   | CT_ref ctyp -> "&(" ^ string_of_ctyp ctyp ^ ")"
   | CT_poly -> "*"
@@ -352,24 +354,27 @@ and full_string_of_ctyp = function
   | CT_ref ctyp -> "ref(" ^ full_string_of_ctyp ctyp ^ ")"
   | ctyp -> string_of_ctyp ctyp
 
-let string_of_value = function
-  | VL_bits ([], _) -> "empty"
+let rec string_of_value = function
+  | VL_bits ([], _) -> "UINT64_C(0)"
   | VL_bits (bs, true) -> Sail2_values.show_bitlist bs
   | VL_bits (bs, false) -> Sail2_values.show_bitlist (List.rev bs)
   | VL_int i -> Big_int.to_string i
   | VL_bool true -> "true"
   | VL_bool false -> "false"
-  | VL_null -> "NULL"
   | VL_unit -> "()"
   | VL_bit Sail2_values.B0 -> "bitzero"
   | VL_bit Sail2_values.B1 -> "bitone"
-  | VL_bit Sail2_values.BU -> "bitundef"
+  | VL_bit Sail2_values.BU -> failwith "Undefined bit found in value"
   | VL_real str -> str
   | VL_string str -> "\"" ^ str ^ "\""
+  | VL_empty_list -> "NULL"
+  | VL_enum element -> Util.zencode_string element
+  | VL_ref r -> "&" ^ Util.zencode_string r
+  | VL_undefined -> "undefined"
 
 let rec string_of_cval = function
   | V_id (id, ctyp) -> string_of_name id
-  | V_ref (id, _) -> "&" ^ string_of_name id
+  | V_lit (VL_undefined, ctyp) -> string_of_value VL_undefined ^ " : " ^ string_of_ctyp ctyp
   | V_lit (vl, ctyp) -> string_of_value vl
   | V_call (op, cvals) ->
      Printf.sprintf "%s(%s)" (string_of_op op) (Util.string_of_list ", " string_of_cval cvals)
@@ -377,16 +382,10 @@ let rec string_of_cval = function
      Printf.sprintf "%s.%s" (string_of_cval f) (string_of_uid field)
   | V_tuple_member (f, _, n) ->
      Printf.sprintf "%s.ztup%d" (string_of_cval f) n
-  | V_ctor_kind (f, ctor, [], _) ->
-     string_of_cval f ^ " is " ^ Util.zencode_string (string_of_id ctor)
   | V_ctor_kind (f, ctor, unifiers, _) ->
-     string_of_cval f ^ " is " ^ Util.zencode_string (string_of_id ctor ^ "_" ^ Util.string_of_list "_" string_of_ctyp unifiers)
-  | V_ctor_unwrap (ctor, f, [], _) ->
-     Printf.sprintf "%s as %s" (string_of_cval f) (string_of_id ctor)
+     string_of_cval f ^ " is " ^ string_of_uid (ctor, unifiers)
   | V_ctor_unwrap (ctor, f, unifiers, _) ->
-     Printf.sprintf "%s as %s"
-       (string_of_cval f)
-       (Util.zencode_string (string_of_id ctor ^ "_" ^ Util.string_of_list "_" string_of_ctyp unifiers))
+     string_of_cval f ^ " as " ^ string_of_uid (ctor, unifiers)
   | V_struct (fields, _) ->
      Printf.sprintf "{%s}"
        (Util.string_of_list ", " (fun (field, cval) -> string_of_uid field ^ " = " ^ string_of_cval cval) fields)
@@ -398,6 +397,7 @@ let rec map_ctyp f = function
   | CT_tup ctyps -> f (CT_tup (List.map (map_ctyp f) ctyps))
   | CT_ref ctyp -> f (CT_ref (map_ctyp f ctyp))
   | CT_vector (direction, ctyp) -> f (CT_vector (direction, map_ctyp f ctyp))
+  | CT_fvector (n, direction, ctyp) -> f (CT_fvector (n, direction, map_ctyp f ctyp))
   | CT_list ctyp -> f (CT_list (map_ctyp f ctyp))
   | CT_struct (id, ctors) ->
      f (CT_struct (id, List.map (fun ((id, ctyps), ctyp) -> (id, List.map (map_ctyp f) ctyps), map_ctyp f ctyp) ctors))
@@ -423,6 +423,7 @@ let rec ctyp_equal ctyp1 ctyp2 =
   | CT_string, CT_string -> true
   | CT_real, CT_real -> true
   | CT_vector (d1, ctyp1), CT_vector (d2, ctyp2) -> d1 = d2 && ctyp_equal ctyp1 ctyp2
+  | CT_fvector (n1, d1, ctyp1), CT_fvector (n2, d2, ctyp2) -> n1 = n2 && d1 = d2 && ctyp_equal ctyp1 ctyp2
   | CT_list ctyp1, CT_list ctyp2 -> ctyp_equal ctyp1 ctyp2
   | CT_ref ctyp1, CT_ref ctyp2 -> ctyp_equal ctyp1 ctyp2
   | CT_poly, CT_poly -> true
@@ -492,6 +493,11 @@ let rec ctyp_compare ctyp1 ctyp2 =
   | CT_vector _, _ -> 1
   | _, CT_vector _ -> -1
 
+  | CT_fvector (n1, d1, ctyp1), CT_fvector (n2, d2, ctyp2) ->
+     lex_ord (compare n1 n2) (lex_ord (ctyp_compare ctyp1 ctyp2) (compare d1 d2))
+  | CT_fvector _, _ -> 1
+  | _, CT_fvector _ -> -1
+
   | ctyp1, ctyp2 -> String.compare (full_string_of_ctyp ctyp1) (full_string_of_ctyp ctyp2)
 
 module CT = struct
@@ -564,6 +570,7 @@ let rec ctyp_suprema = function
   | CT_struct (id, ctors) -> CT_struct (id, ctors)
   | CT_variant (id, ctors) -> CT_variant (id, ctors)
   | CT_vector (d, ctyp) -> CT_vector (d, ctyp_suprema ctyp)
+  | CT_fvector (n, d, ctyp) -> CT_fvector (n, d, ctyp_suprema ctyp)
   | CT_list ctyp -> CT_list (ctyp_suprema ctyp)
   | CT_ref ctyp -> CT_ref (ctyp_suprema ctyp)
   | CT_poly -> CT_poly
@@ -573,7 +580,7 @@ let rec ctyp_ids = function
   | CT_struct (id, ctors) | CT_variant (id, ctors) ->
      IdSet.add id (List.fold_left (fun ids (_, ctyp) -> IdSet.union (ctyp_ids ctyp) ids) IdSet.empty ctors)
   | CT_tup ctyps -> List.fold_left (fun ids ctyp -> IdSet.union (ctyp_ids ctyp) ids) IdSet.empty ctyps
-  | CT_vector (_, ctyp) | CT_list ctyp | CT_ref ctyp -> ctyp_ids ctyp
+  | CT_vector (_, ctyp) | CT_fvector (_, _, ctyp) | CT_list ctyp | CT_ref ctyp -> ctyp_ids ctyp
   | CT_lint | CT_fint _ | CT_constant _ | CT_lbits _ | CT_fbits _ | CT_sbits _ | CT_unit
     | CT_bool | CT_real | CT_bit | CT_string | CT_poly -> IdSet.empty
 
@@ -588,11 +595,11 @@ let rec is_polymorphic = function
   | CT_tup ctyps -> List.exists is_polymorphic ctyps
   | CT_enum _ -> false
   | CT_struct (_, ctors) | CT_variant (_, ctors) -> List.exists (fun (_, ctyp) -> is_polymorphic ctyp) ctors
-  | CT_vector (_, ctyp) | CT_list ctyp | CT_ref ctyp -> is_polymorphic ctyp
+  | CT_fvector (_, _, ctyp) | CT_vector (_, ctyp) | CT_list ctyp | CT_ref ctyp -> is_polymorphic ctyp
   | CT_poly -> true
 
 let rec cval_deps = function
-  | V_id (id, _) | V_ref (id, _) -> NameSet.singleton id
+  | V_id (id, _) -> NameSet.singleton id
   | V_lit _ -> NameSet.empty
   | V_field (cval, _) | V_poly (cval, _) | V_tuple_member (cval, _, _) -> cval_deps cval
   | V_call (_, cvals) -> List.fold_left NameSet.union NameSet.empty (List.map cval_deps cvals)
@@ -666,7 +673,6 @@ let rec map_clexp_ctyp f = function
 
 let rec map_cval_ctyp f = function
   | V_id (id, ctyp) -> V_id (id, f ctyp)
-  | V_ref (id, ctyp) -> V_ref (id, f ctyp)
   | V_lit (vl, ctyp) -> V_lit (vl, f ctyp)
   | V_ctor_kind (cval, id, unifiers, ctyp) ->
      V_ctor_kind (map_cval_ctyp f cval, id, List.map f unifiers, f ctyp)
@@ -734,7 +740,7 @@ let rec concatmap_instr f (I_aux (instr, aux)) =
        I_try_block (List.concat (List.map (concatmap_instr f) instrs))
   in
   f (I_aux (instr, aux))
-  
+
 (** Iterate over each instruction within an instruction, bottom-up *)
 let rec iter_instr f (I_aux (instr, aux)) =
   match instr with
@@ -754,7 +760,7 @@ let cdef_map_instr f = function
   | CDEF_fundef (id, heap_return, args, instrs) -> CDEF_fundef (id, heap_return, args, List.map (map_instr f) instrs)
   | CDEF_startup (id, instrs) -> CDEF_startup (id, List.map (map_instr f) instrs)
   | CDEF_finish (id, instrs) -> CDEF_finish (id, List.map (map_instr f) instrs)
-  | CDEF_spec (id, ctyps, ctyp) -> CDEF_spec (id, ctyps, ctyp)
+  | CDEF_spec (id, extern, ctyps, ctyp) -> CDEF_spec (id, extern, ctyps, ctyp)
   | CDEF_type tdef -> CDEF_type tdef
 
 (** Map over each instruction in a cdef using concatmap_instr *)
@@ -769,7 +775,7 @@ let cdef_concatmap_instr f = function
      CDEF_startup (id, List.concat (List.map (concatmap_instr f) instrs))
   | CDEF_finish (id, instrs) ->
      CDEF_finish (id, List.concat (List.map (concatmap_instr f) instrs))
-  | CDEF_spec (id, ctyps, ctyp) -> CDEF_spec (id, ctyps, ctyp)
+  | CDEF_spec (id, extern, ctyps, ctyp) -> CDEF_spec (id, extern, ctyps, ctyp)
   | CDEF_type tdef -> CDEF_type tdef
 
 let ctype_def_map_ctyp f = function
@@ -784,7 +790,7 @@ let cdef_map_ctyp f = function
   | CDEF_fundef (id, heap_return, args, instrs) -> CDEF_fundef (id, heap_return, args, List.map (map_instr_ctyp f) instrs)
   | CDEF_startup (id, instrs) -> CDEF_startup (id, List.map (map_instr_ctyp f) instrs)
   | CDEF_finish (id, instrs) -> CDEF_finish (id, List.map (map_instr_ctyp f) instrs)
-  | CDEF_spec (id, ctyps, ctyp) -> CDEF_spec (id, List.map f ctyps, f ctyp)
+  | CDEF_spec (id, extern, ctyps, ctyp) -> CDEF_spec (id, extern, List.map f ctyps, f ctyp)
   | CDEF_type tdef -> CDEF_type (ctype_def_map_ctyp f tdef)
 
 (* Map over all sequences of instructions contained within an instruction *)
@@ -838,7 +844,6 @@ let label str =
 
 let rec infer_call op vs =
   match op, vs with
-  | Bit_to_bool, _ -> CT_bool
   | Bnot, _ -> CT_bool
   | Band, _ -> CT_bool
   | Bor, _ -> CT_bool
@@ -900,7 +905,6 @@ let rec infer_call op vs =
 
 and cval_ctyp = function
   | V_id (_, ctyp) -> ctyp
-  | V_ref (_, ctyp) -> CT_ref ctyp
   | V_lit (vl, ctyp) -> ctyp
   | V_ctor_kind _ -> CT_bool
   | V_ctor_unwrap (ctor, cval, unifiers, ctyp) -> ctyp
@@ -984,7 +988,7 @@ let ctype_def_ctyps = function
 let cdef_ctyps = function
   | CDEF_reg_dec (_, ctyp, instrs) ->
      CTSet.add ctyp (instrs_ctyps instrs)
-  | CDEF_spec (_, ctyps, ctyp) ->
+  | CDEF_spec (_, _, ctyps, ctyp) ->
      CTSet.add ctyp (List.fold_left (fun m ctyp -> CTSet.add ctyp m) CTSet.empty ctyps)
   | CDEF_fundef (_, _, _, instrs) | CDEF_startup (_, instrs) | CDEF_finish (_, instrs) ->
      instrs_ctyps instrs
diff --git a/src/libsail.mllib b/src/libsail.mllib
index 2d1f568f..f05809bb 100644
--- a/src/libsail.mllib
+++ b/src/libsail.mllib
@@ -14,13 +14,14 @@ Graph
 Initial_check
 Interactive
 Interpreter
-Isail
 Jib
 Jib_compile
 Jib_optimize
 Jib_ssa
 Jib_smt
 Jib_util
+Jib_interactive
+Jib_ir
 Latex
 Lexer
 Manifest
@@ -32,11 +33,6 @@ Parse_ast
 Parser
 Parser_combinators
 Pattern_completeness
-PPrint
-PPrintCombinators
-PPrintEngine
-PPrintRenderer
-PPrintOCaml
 Pretty_print
 Pretty_print_common
 Pretty_print_coq
@@ -48,7 +44,6 @@ Property
 Reporting
 Rewriter
 Rewrites
-Sail
 Sail2_values
 Sail_lib
 Scattered
diff --git a/src/monomorphise.ml b/src/monomorphise.ml
index 5168d16a..e328cce1 100644
--- a/src/monomorphise.ml
+++ b/src/monomorphise.ml
@@ -219,7 +219,7 @@ let rec contains_exist (Typ_aux (ty,l)) =
   | Typ_var _
     -> false
   | Typ_fn (t1,t2,_) -> List.exists contains_exist t1 || contains_exist t2
-  | Typ_bidir (t1, t2) -> contains_exist t1 || contains_exist t2
+  | Typ_bidir (t1, t2, _) -> contains_exist t1 || contains_exist t2
   | Typ_tup ts -> List.exists contains_exist ts
   | Typ_app (_,args) -> List.exists contains_exist_arg args
   | Typ_exist _ -> true
@@ -252,12 +252,11 @@ let rec size_nvars_nexp (Nexp_aux (ne,_)) =
 let split_src_type all_errors env id ty (TypQ_aux (q,ql)) =
   let cannot l msg default =
     let open Reporting in
-    let error = Err_general (l, msg) in
     match all_errors with
-    | None -> raise (Fatal_error error)
+    | None -> raise (err_general l msg)
     | Some flag -> begin
         flag := false;
-        print_error error;
+        print_err l "Error" msg;
         default
       end
   in
@@ -659,14 +658,12 @@ let split_defs target all_errors splits env defs =
     let renew_id (Id_aux (id,l)) = Id_aux (id,new_l) in
     let cannot msg =
       let open Reporting in
-      let error =
-        Err_general (pat_l,
-                     ("Cannot split type " ^ string_of_typ typ ^ " for variable " ^ v ^ ": " ^ msg))
-      in if all_errors
+      let error_msg = "Cannot split type " ^ string_of_typ typ ^ " for variable " ^ v ^ ": " ^ msg in
+      if all_errors
         then (no_errors_happened := false;
-              print_error error;
+              print_err pat_l "" error_msg;
               [P_aux (P_id var,(pat_l,annot)),[],[],KBindings.empty])
-        else raise (Fatal_error error)
+        else raise (err_general pat_l error_msg)
     in
     match ty with
     | Typ_id (Id_aux (Id "bool",_)) | Typ_app (Id_aux (Id "atom_bool", _), [_]) ->
@@ -951,13 +948,11 @@ let split_defs target all_errors splits env defs =
       let size = List.length lst in
       if size > size_set_limit then
         let open Reporting in
-        let error =
-          Err_general (l, "Case split is too large (" ^ string_of_int size ^
-            " > limit " ^ string_of_int size_set_limit ^ ")")
-        in if all_errors
-          then (no_errors_happened := false;
-                print_error error; false)
-          else raise (Fatal_error error)
+        let error_msg = "Case split is too large (" ^ string_of_int size ^ " > limit " ^ string_of_int size_set_limit ^ ")" in
+        if all_errors
+        then (no_errors_happened := false;
+              print_err l "" error_msg; false)
+        else raise (err_general l error_msg)
       else true
     in
 
@@ -1927,9 +1922,7 @@ let refine_dependency env (E_aux (e,(l,annot)) as exp) pexps =
           with
           | Some pats ->
              if l = Parse_ast.Unknown then
-               (Reporting.print_error
-                  (Reporting.Err_general
-                     (l, "No location for pattern match: " ^ string_of_exp exp));
+               (Reporting.print_err l "" ("No location for pattern match: " ^ string_of_exp exp);
                 None)
              else
                Some (Have (ArgSplits.singleton (id,loc) (Partial (pats,l)),
@@ -3270,15 +3263,15 @@ let ids_in_exp exp =
       lEXP_cast = (fun (_,id) -> IdSet.singleton id)
     } exp
 
-let make_bitvector_env_casts env quant_kids (kid,i) exp =
-  let mk_cast var typ exp = (make_bitvector_cast_let "bitvector_cast_in" env env quant_kids typ (subst_kids_typ (KBindings.singleton kid (nconstant i)) typ)) var exp in
+let make_bitvector_env_casts top_env env quant_kids insts exp =
+  let mk_cast var typ exp = (make_bitvector_cast_let "bitvector_cast_in" env top_env quant_kids typ (subst_kids_typ insts typ)) var exp in
   let mk_assign_in var typ =
-    make_bitvector_cast_assign "bitvector_cast_in" env env quant_kids typ
-      (subst_kids_typ (KBindings.singleton kid (nconstant i)) typ) var
+    make_bitvector_cast_assign "bitvector_cast_in" env top_env quant_kids typ
+      (subst_kids_typ insts typ) var
   in
   let mk_assign_out var typ =
-    make_bitvector_cast_assign "bitvector_cast_out" env env quant_kids
-      (subst_kids_typ (KBindings.singleton kid (nconstant i)) typ) typ var
+    make_bitvector_cast_assign "bitvector_cast_out" top_env env quant_kids
+      (subst_kids_typ insts typ) typ var
   in
   let locals = Env.get_locals env in
   let used_ids = ids_in_exp exp in
@@ -3412,13 +3405,13 @@ let add_bitvector_casts (Defs defs) =
                   (* We used to just substitute kid, but fill_in_type also catches other kids defined by it *)
                   let src_typ = fill_in_type (Env.add_constraint (nc_eq (nvar kid) (nconstant i)) env) result_typ in
                   make_bitvector_cast_exp "bitvector_cast_out" env quant_kids src_typ result_typ
-                    (make_bitvector_env_casts env quant_kids (kid,i) body)
+                    (make_bitvector_env_casts env (env_of body) quant_kids (KBindings.singleton kid (nconstant i)) body)
                | P_aux (P_id var,_), Some guard ->
                   (match extract_value_from_guard var guard with
                   | Some i ->
                      let src_typ = fill_in_type (Env.add_constraint (nc_eq (nvar kid) (nconstant i)) env) result_typ in
                      make_bitvector_cast_exp "bitvector_cast_out" env quant_kids src_typ result_typ
-                       (make_bitvector_env_casts env quant_kids (kid,i) body)
+                       (make_bitvector_env_casts env (env_of body) quant_kids (KBindings.singleton kid (nconstant i)) body)
                   | None -> body)
                | _ ->
                   body
@@ -3432,10 +3425,9 @@ let add_bitvector_casts (Defs defs) =
          let env = env_of_annot ann in
          let result_typ = Env.base_typ_of env (typ_of_annot ann) in
          let insts = extract e1 in
-         let e2' = List.fold_left (fun body inst ->
-           make_bitvector_env_casts env quant_kids inst body) e2 insts in
          let insts = List.fold_left (fun insts (kid,i) ->
            KBindings.add kid (nconstant i) insts) KBindings.empty insts in
+         let e2' = make_bitvector_env_casts env (env_of e2) quant_kids insts e2 in
          let src_typ = subst_kids_typ insts result_typ in
          let e2' = make_bitvector_cast_exp "bitvector_cast_out" env quant_kids src_typ result_typ e2' in
          (* Ask the type checker if only one value remains for any of kids in
@@ -3444,13 +3436,10 @@ let add_bitvector_casts (Defs defs) =
          let insts3 = KBindings.fold (fun kid _ i3 ->
                           match Type_check.solve_unique env3 (nvar kid) with
                           | None -> i3
-                          | Some c -> (kid, c)::i3)
-                        insts []
+                          | Some c -> KBindings.add kid (nconstant c) i3)
+                        insts KBindings.empty
          in
-         let e3' = List.fold_left (fun body inst ->
-           make_bitvector_env_casts env quant_kids inst body) e3 insts3 in
-         let insts3 = List.fold_left (fun insts (kid,i) ->
-           KBindings.add kid (nconstant i) insts) KBindings.empty insts3 in
+         let e3' = make_bitvector_env_casts env (env_of e3) quant_kids insts3 e3 in
          let src_typ3 = subst_kids_typ insts3 result_typ in
          let e3' = make_bitvector_cast_exp "bitvector_cast_out" env quant_kids src_typ3 result_typ e3' in
          E_aux (E_if (e1,e2',e3'), ann)
@@ -3469,10 +3458,9 @@ let add_bitvector_casts (Defs defs) =
                  let t' = aux t in
                  let et = E_aux (E_block t',ann) in
                  let env = env_of h in
-                 let et = List.fold_left (fun body inst ->
-                              make_bitvector_env_casts env quant_kids inst body) et insts in
                  let insts = List.fold_left (fun insts (kid,i) ->
                                  KBindings.add kid (nconstant i) insts) KBindings.empty insts in
+                 let et = make_bitvector_env_casts env (env_of et) quant_kids insts et in
                  let src_typ = subst_kids_typ insts result_typ in
                  let et = make_bitvector_cast_exp "bitvector_cast_out" env quant_kids src_typ result_typ et in
 
@@ -3542,10 +3530,10 @@ let replace_nexp_in_typ env typ orig new_nexp =
        let f1 = List.exists fst arg' in
        let f2, res = aux res in
        f1 || f2, Typ_aux (Typ_fn (List.map snd arg', res, eff),l)
-    | Typ_bidir (t1, t2) ->
+    | Typ_bidir (t1, t2, eff) ->
        let f1, t1 = aux t1 in
        let f2, t2 = aux t2 in
-       f1 || f2, Typ_aux (Typ_bidir (t1, t2), l)
+       f1 || f2, Typ_aux (Typ_bidir (t1, t2, eff), l)
     | Typ_tup typs ->
        let fs, typs = List.split (List.map aux typs) in
        List.exists (fun x -> x) fs, Typ_aux (Typ_tup typs,l)
diff --git a/src/myocamlbuild.ml b/src/myocamlbuild.ml
index ae45857d..1949d66a 100644
--- a/src/myocamlbuild.ml
+++ b/src/myocamlbuild.ml
@@ -82,7 +82,6 @@ dispatch begin function
     (* Bisect_ppx_plugin.handle_coverage (); *)
 
     (* ocaml_lib "lem_interp/interp"; *)
-    ocaml_lib ~extern:false ~dir:"pprint/src" ~tag_name:"use_pprint" "pprint/src/PPrintLib";
 
     rule "lem -> ml"
     ~prod: "%.ml"
diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml
index 8899695f..98a43ebc 100644
--- a/src/ocaml_backend.ml
+++ b/src/ocaml_backend.ml
@@ -118,7 +118,7 @@ let rec ocaml_string_typ (Typ_aux (typ_aux, l)) arg =
      parens (separate space [string "fun"; parens (separate (comma ^^ space) args); string "->"; body])
      ^^ space ^^ arg
   | Typ_fn (typ1, typ2, _) -> string "\"FN\""
-  | Typ_bidir (t1, t2) -> string "\"BIDIR\""
+  | Typ_bidir (t1, t2, _) -> string "\"BIDIR\""
   | Typ_var kid -> string "\"VAR\""
   | Typ_exist _ -> assert false
   | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
@@ -144,7 +144,7 @@ let rec ocaml_typ ctx (Typ_aux (typ_aux, l)) =
   | Typ_app (id, typs) -> parens (separate_map (string ", ") (ocaml_typ_arg ctx) typs) ^^ space ^^ ocaml_typ_id ctx id
   | Typ_tup typs -> parens (separate_map (string " * ") (ocaml_typ ctx) typs)
   | Typ_fn (typs, typ, _) -> separate space [ocaml_typ ctx (Typ_aux (Typ_tup typs, l)); string "->"; ocaml_typ ctx typ]
-  | Typ_bidir (t1, t2) -> raise (Reporting.err_general l "Ocaml doesn't support bidir types")
+  | Typ_bidir _ -> raise (Reporting.err_general l "Ocaml doesn't support bidir types")
   | Typ_var kid -> zencode_kid kid
   | Typ_exist _ -> assert false
   | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
diff --git a/src/parse_ast.ml b/src/parse_ast.ml
index 3147b7f4..6cb3f84d 100644
--- a/src/parse_ast.ml
+++ b/src/parse_ast.ml
@@ -154,12 +154,12 @@ atyp_aux =  (* expressions of all kinds, to be translated to types, nats, orders
  | ATyp_minus of atyp * atyp (* subtraction *)
  | ATyp_exp of atyp (* exponential *)
  | ATyp_neg of atyp (* Internal (but not M as I want a datatype constructor) negative nexp *)
- | ATyp_inc (* increasing (little-endian) *)
- | ATyp_dec (* decreasing (big-endian) *)
+ | ATyp_inc (* increasing *)
+ | ATyp_dec (* decreasing *)
  | ATyp_default_ord (* default order for increasing or decreasing signficant bits *)
  | ATyp_set of (base_effect) list (* effect set *)
- | ATyp_fn of atyp * atyp * atyp (* Function type (first-order only in user code), last atyp is an effect *)
- | ATyp_bidir of atyp * atyp (* Function type (first-order only in user code), last atyp is an effect *)
+ | ATyp_fn of atyp * atyp * atyp (* Function type, last atyp is an effect *)
+ | ATyp_bidir of atyp * atyp * atyp (* Mapping type, last atyp is an effect *)
  | ATyp_wild
  | ATyp_tup of (atyp) list (* Tuple type *)
  | ATyp_app of id * (atyp) list (* type constructor application *)
diff --git a/src/parser.mly b/src/parser.mly
index 0b09468c..6a579b7a 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -657,9 +657,13 @@ typschm:
   | Forall typquant Dot typ MinusGt typ Effect effect_set
     { (fun s e -> mk_typschm $2 (mk_typ (ATyp_fn ($4, $6, $8)) s e) s e) $startpos $endpos }
   | typ Bidir typ
-    { (fun s e -> mk_typschm mk_typqn (mk_typ (ATyp_bidir ($1, $3)) s e) s e) $startpos $endpos }
+    { (fun s e -> mk_typschm mk_typqn (mk_typ (ATyp_bidir ($1, $3, mk_typ (ATyp_set []) s e)) s e) s e) $startpos $endpos }
   | Forall typquant Dot typ Bidir typ
-    { (fun s e -> mk_typschm $2 (mk_typ (ATyp_bidir ($4, $6)) s e) s e) $startpos $endpos }
+    { (fun s e -> mk_typschm $2 (mk_typ (ATyp_bidir ($4, $6, mk_typ (ATyp_set []) s e)) s e) s e) $startpos $endpos }
+  | typ Bidir typ Effect effect_set
+    { (fun s e -> mk_typschm mk_typqn (mk_typ (ATyp_bidir ($1, $3, $5)) s e) s e) $startpos $endpos }
+  | Forall typquant Dot typ Bidir typ Effect effect_set
+    { (fun s e -> mk_typschm $2 (mk_typ (ATyp_bidir ($4, $6, $8)) s e) s e) $startpos $endpos }
 
 typschm_eof:
   | typschm Eof
diff --git a/src/pprint/AUTHORS b/src/pprint/AUTHORS
deleted file mode 100644
index 6060ac93..00000000
--- a/src/pprint/AUTHORS
+++ /dev/null
@@ -1,3 +0,0 @@
-PPrint was written by François Pottier and Nicolas Pouillard, with
-contributions by Yann Régis-Gianas, Gabriel Scherer,  and Jonathan
-Protzenko.
diff --git a/src/pprint/CHANGES b/src/pprint/CHANGES
deleted file mode 100644
index 69747a41..00000000
--- a/src/pprint/CHANGES
+++ /dev/null
@@ -1,27 +0,0 @@
-2014/04/11
-Changed the behavior of [align], which was not consistent with its documentation.
-[align] now sets the indentation level to the current column. In particular, this
-means that [align (align d)] is equivalent to [align d], which was not the case
-previously. Thanks to Dmitry Grebeniuk for reporting this issue.
-
-2014/04/03
-The library is now extensible (in principle). A [custom] document constructor
-allows the user to define her own documents, as long as they fit the manner
-in which the current rendering engine works.
-
-The [compact] rendering engine is now tail-recursive too.
-
-2014/03/21
-Minor optimisation in the smart constructor [group].
-
-2014/03/13
-New (simpler) pretty-printing engine. The representation of documents in
-memory is slightly larger; document construction is perhaps slightly slower,
-while rendering is significantly faster. (Construction dominates rendering.)
-The rendering speed is now guaranteed to be independent of the width
-parameter. The price to pay for this simplification is that the primitive
-document constructors [column] and [nesting] are no longer supported. The
-API is otherwise unchanged.
-
-2013/01/31
-First official release of PPrint.
diff --git a/src/pprint/LICENSE b/src/pprint/LICENSE
deleted file mode 100644
index d6eb151e..00000000
--- a/src/pprint/LICENSE
+++ /dev/null
@@ -1,517 +0,0 @@
-
-CeCILL-C FREE SOFTWARE LICENSE AGREEMENT
-
-
-    Notice
-
-This Agreement is a Free Software license agreement that is the result
-of discussions between its authors in order to ensure compliance with
-the two main principles guiding its drafting:
-
-    * firstly, compliance with the principles governing the distribution
-      of Free Software: access to source code, broad rights granted to
-      users,
-    * secondly, the election of a governing law, French law, with which
-      it is conformant, both as regards the law of torts and
-      intellectual property law, and the protection that it offers to
-      both authors and holders of the economic rights over software.
-
-The authors of the CeCILL-C (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
-license are:
-
-Commissariat à l'Energie Atomique - CEA, a public scientific, technical
-and industrial research establishment, having its principal place of
-business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
-
-Centre National de la Recherche Scientifique - CNRS, a public scientific
-and technological establishment, having its principal place of business
-at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
-
-Institut National de Recherche en Informatique et en Automatique -
-INRIA, a public scientific and technological establishment, having its
-principal place of business at Domaine de Voluceau, Rocquencourt, BP
-105, 78153 Le Chesnay cedex, France.
-
-
-    Preamble
-
-The purpose of this Free Software license agreement is to grant users
-the right to modify and re-use the software governed by this license.
-
-The exercising of this right is conditional upon the obligation to make
-available to the community the modifications made to the source code of
-the software so as to contribute to its evolution.
-
-In consideration of access to the source code and the rights to copy,
-modify and redistribute granted by the license, users are provided only
-with a limited warranty and the software's author, the holder of the
-economic rights, and the successive licensors only have limited liability.
-
-In this respect, the risks associated with loading, using, modifying
-and/or developing or reproducing the software by the user are brought to
-the user's attention, given its Free Software status, which may make it
-complicated to use, with the result that its use is reserved for
-developers and experienced professionals having in-depth computer
-knowledge. Users are therefore encouraged to load and test the
-suitability of the software as regards their requirements in conditions
-enabling the security of their systems and/or data to be ensured and,
-more generally, to use and operate it in the same conditions of
-security. This Agreement may be freely reproduced and published,
-provided it is not altered, and that no provisions are either added or
-removed herefrom.
-
-This Agreement may apply to any or all software for which the holder of
-the economic rights decides to submit the use thereof to its provisions.
-
-
-    Article 1 - DEFINITIONS
-
-For the purpose of this Agreement, when the following expressions
-commence with a capital letter, they shall have the following meaning:
-
-Agreement: means this license agreement, and its possible subsequent
-versions and annexes.
-
-Software: means the software in its Object Code and/or Source Code form
-and, where applicable, its documentation, "as is" when the Licensee
-accepts the Agreement.
-
-Initial Software: means the Software in its Source Code and possibly its
-Object Code form and, where applicable, its documentation, "as is" when
-it is first distributed under the terms and conditions of the Agreement.
-
-Modified Software: means the Software modified by at least one
-Integrated Contribution.
-
-Source Code: means all the Software's instructions and program lines to
-which access is required so as to modify the Software.
-
-Object Code: means the binary files originating from the compilation of
-the Source Code.
-
-Holder: means the holder(s) of the economic rights over the Initial
-Software.
-
-Licensee: means the Software user(s) having accepted the Agreement.
-
-Contributor: means a Licensee having made at least one Integrated
-Contribution.
-
-Licensor: means the Holder, or any other individual or legal entity, who
-distributes the Software under the Agreement.
-
-Integrated Contribution: means any or all modifications, corrections,
-translations, adaptations and/or new functions integrated into the
-Source Code by any or all Contributors.
-
-Related Module: means a set of sources files including their
-documentation that, without modification to the Source Code, enables
-supplementary functions or services in addition to those offered by the
-Software.
-
-Derivative Software: means any combination of the Software, modified or
-not, and of a Related Module.
-
-Parties: mean both the Licensee and the Licensor.
-
-These expressions may be used both in singular and plural form.
-
-
-    Article 2 - PURPOSE
-
-The purpose of the Agreement is the grant by the Licensor to the
-Licensee of a non-exclusive, transferable and worldwide license for the
-Software as set forth in Article 5 hereinafter for the whole term of the
-protection granted by the rights over said Software. 
-
-
-    Article 3 - ACCEPTANCE
-
-3.1 The Licensee shall be deemed as having accepted the terms and
-conditions of this Agreement upon the occurrence of the first of the
-following events:
-
-    * (i) loading the Software by any or all means, notably, by
-      downloading from a remote server, or by loading from a physical
-      medium;
-    * (ii) the first time the Licensee exercises any of the rights
-      granted hereunder.
-
-3.2 One copy of the Agreement, containing a notice relating to the
-characteristics of the Software, to the limited warranty, and to the
-fact that its use is restricted to experienced users has been provided
-to the Licensee prior to its acceptance as set forth in Article 3.1
-hereinabove, and the Licensee hereby acknowledges that it has read and
-understood it.
-
-
-    Article 4 - EFFECTIVE DATE AND TERM
-
-
-      4.1 EFFECTIVE DATE
-
-The Agreement shall become effective on the date when it is accepted by
-the Licensee as set forth in Article 3.1.
-
-
-      4.2 TERM
-
-The Agreement shall remain in force for the entire legal term of
-protection of the economic rights over the Software.
-
-
-    Article 5 - SCOPE OF RIGHTS GRANTED
-
-The Licensor hereby grants to the Licensee, who accepts, the following
-rights over the Software for any or all use, and for the term of the
-Agreement, on the basis of the terms and conditions set forth hereinafter.
-
-Besides, if the Licensor owns or comes to own one or more patents
-protecting all or part of the functions of the Software or of its
-components, the Licensor undertakes not to enforce the rights granted by
-these patents against successive Licensees using, exploiting or
-modifying the Software. If these patents are transferred, the Licensor
-undertakes to have the transferees subscribe to the obligations set
-forth in this paragraph.
-
-
-      5.1 RIGHT OF USE
-
-The Licensee is authorized to use the Software, without any limitation
-as to its fields of application, with it being hereinafter specified
-that this comprises:
-
-   1. permanent or temporary reproduction of all or part of the Software
-      by any or all means and in any or all form.
-
-   2. loading, displaying, running, or storing the Software on any or
-      all medium.
-
-   3. entitlement to observe, study or test its operation so as to
-      determine the ideas and principles behind any or all constituent
-      elements of said Software. This shall apply when the Licensee
-      carries out any or all loading, displaying, running, transmission
-      or storage operation as regards the Software, that it is entitled
-      to carry out hereunder.
-
-
-      5.2 RIGHT OF MODIFICATION
-
-The right of modification includes the right to translate, adapt,
-arrange, or make any or all modifications to the Software, and the right
-to reproduce the resulting software. It includes, in particular, the
-right to create a Derivative Software.
-
-The Licensee is authorized to make any or all modification to the
-Software provided that it includes an explicit notice that it is the
-author of said modification and indicates the date of the creation thereof.
-
-
-      5.3 RIGHT OF DISTRIBUTION
-
-In particular, the right of distribution includes the right to publish,
-transmit and communicate the Software to the general public on any or
-all medium, and by any or all means, and the right to market, either in
-consideration of a fee, or free of charge, one or more copies of the
-Software by any means.
-
-The Licensee is further authorized to distribute copies of the modified
-or unmodified Software to third parties according to the terms and
-conditions set forth hereinafter.
-
-
-        5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
-
-The Licensee is authorized to distribute true copies of the Software in
-Source Code or Object Code form, provided that said distribution
-complies with all the provisions of the Agreement and is accompanied by:
-
-   1. a copy of the Agreement,
-
-   2. a notice relating to the limitation of both the Licensor's
-      warranty and liability as set forth in Articles 8 and 9,
-
-and that, in the event that only the Object Code of the Software is
-redistributed, the Licensee allows effective access to the full Source
-Code of the Software at a minimum during the entire period of its
-distribution of the Software, it being understood that the additional
-cost of acquiring the Source Code shall not exceed the cost of
-transferring the data.
-
-
-        5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
-
-When the Licensee makes an Integrated Contribution to the Software, the
-terms and conditions for the distribution of the resulting Modified
-Software become subject to all the provisions of this Agreement.
-
-The Licensee is authorized to distribute the Modified Software, in
-source code or object code form, provided that said distribution
-complies with all the provisions of the Agreement and is accompanied by:
-
-   1. a copy of the Agreement,
-
-   2. a notice relating to the limitation of both the Licensor's
-      warranty and liability as set forth in Articles 8 and 9,
-
-and that, in the event that only the object code of the Modified
-Software is redistributed, the Licensee allows effective access to the
-full source code of the Modified Software at a minimum during the entire
-period of its distribution of the Modified Software, it being understood
-that the additional cost of acquiring the source code shall not exceed
-the cost of transferring the data.
-
-
-        5.3.3 DISTRIBUTION OF DERIVATIVE SOFTWARE
-
-When the Licensee creates Derivative Software, this Derivative Software
-may be distributed under a license agreement other than this Agreement,
-subject to compliance with the requirement to include a notice
-concerning the rights over the Software as defined in Article 6.4.
-In the event the creation of the Derivative Software required modification 
-of the Source Code, the Licensee undertakes that:
-
-   1. the resulting Modified Software will be governed by this Agreement,
-   2. the Integrated Contributions in the resulting Modified Software
-      will be clearly identified and documented,
-   3. the Licensee will allow effective access to the source code of the
-      Modified Software, at a minimum during the entire period of
-      distribution of the Derivative Software, such that such
-      modifications may be carried over in a subsequent version of the
-      Software; it being understood that the additional cost of
-      purchasing the source code of the Modified Software shall not
-      exceed the cost of transferring the data.
-
-
-        5.3.4 COMPATIBILITY WITH THE CeCILL LICENSE
-
-When a Modified Software contains an Integrated Contribution subject to
-the CeCILL license agreement, or when a Derivative Software contains a
-Related Module subject to the CeCILL license agreement, the provisions
-set forth in the third item of Article 6.4 are optional.
-
-
-    Article 6 - INTELLECTUAL PROPERTY
-
-
-      6.1 OVER THE INITIAL SOFTWARE
-
-The Holder owns the economic rights over the Initial Software. Any or
-all use of the Initial Software is subject to compliance with the terms
-and conditions under which the Holder has elected to distribute its work
-and no one shall be entitled to modify the terms and conditions for the
-distribution of said Initial Software.
-
-The Holder undertakes that the Initial Software will remain ruled at
-least by this Agreement, for the duration set forth in Article 4.2.
-
-
-      6.2 OVER THE INTEGRATED CONTRIBUTIONS
-
-The Licensee who develops an Integrated Contribution is the owner of the
-intellectual property rights over this Contribution as defined by
-applicable law.
-
-
-      6.3 OVER THE RELATED MODULES
-
-The Licensee who develops a Related Module is the owner of the
-intellectual property rights over this Related Module as defined by
-applicable law and is free to choose the type of agreement that shall
-govern its distribution under the conditions defined in Article 5.3.3.
-
-
-      6.4 NOTICE OF RIGHTS
-
-The Licensee expressly undertakes:
-
-   1. not to remove, or modify, in any manner, the intellectual property
-      notices attached to the Software;
-
-   2. to reproduce said notices, in an identical manner, in the copies
-      of the Software modified or not;
-
-   3. to ensure that use of the Software, its intellectual property
-      notices and the fact that it is governed by the Agreement is
-      indicated in a text that is easily accessible, specifically from
-      the interface of any Derivative Software.
-
-The Licensee undertakes not to directly or indirectly infringe the
-intellectual property rights of the Holder and/or Contributors on the
-Software and to take, where applicable, vis-à-vis its staff, any and all
-measures required to ensure respect of said intellectual property rights
-of the Holder and/or Contributors.
-
-
-    Article 7 - RELATED SERVICES
-
-7.1 Under no circumstances shall the Agreement oblige the Licensor to
-provide technical assistance or maintenance services for the Software.
-
-However, the Licensor is entitled to offer this type of services. The
-terms and conditions of such technical assistance, and/or such
-maintenance, shall be set forth in a separate instrument. Only the
-Licensor offering said maintenance and/or technical assistance services
-shall incur liability therefor.
-
-7.2 Similarly, any Licensor is entitled to offer to its licensees, under
-its sole responsibility, a warranty, that shall only be binding upon
-itself, for the redistribution of the Software and/or the Modified
-Software, under terms and conditions that it is free to decide. Said
-warranty, and the financial terms and conditions of its application,
-shall be subject of a separate instrument executed between the Licensor
-and the Licensee.
-
-
-    Article 8 - LIABILITY
-
-8.1 Subject to the provisions of Article 8.2, the Licensee shall be
-entitled to claim compensation for any direct loss it may have suffered
-from the Software as a result of a fault on the part of the relevant
-Licensor, subject to providing evidence thereof.
-
-8.2 The Licensor's liability is limited to the commitments made under
-this Agreement and shall not be incurred as a result of in particular:
-(i) loss due the Licensee's total or partial failure to fulfill its
-obligations, (ii) direct or consequential loss that is suffered by the
-Licensee due to the use or performance of the Software, and (iii) more
-generally, any consequential loss. In particular the Parties expressly
-agree that any or all pecuniary or business loss (i.e. loss of data,
-loss of profits, operating loss, loss of customers or orders,
-opportunity cost, any disturbance to business activities) or any or all
-legal proceedings instituted against the Licensee by a third party,
-shall constitute consequential loss and shall not provide entitlement to
-any or all compensation from the Licensor.
-
-
-    Article 9 - WARRANTY
-
-9.1 The Licensee acknowledges that the scientific and technical
-state-of-the-art when the Software was distributed did not enable all
-possible uses to be tested and verified, nor for the presence of
-possible defects to be detected. In this respect, the Licensee's
-attention has been drawn to the risks associated with loading, using,
-modifying and/or developing and reproducing the Software which are
-reserved for experienced users.
-
-The Licensee shall be responsible for verifying, by any or all means,
-the suitability of the product for its requirements, its good working
-order, and for ensuring that it shall not cause damage to either persons
-or properties.
-
-9.2 The Licensor hereby represents, in good faith, that it is entitled
-to grant all the rights over the Software (including in particular the
-rights set forth in Article 5).
-
-9.3 The Licensee acknowledges that the Software is supplied "as is" by
-the Licensor without any other express or tacit warranty, other than
-that provided for in Article 9.2 and, in particular, without any warranty
-as to its commercial value, its secured, safe, innovative or relevant
-nature.
-
-Specifically, the Licensor does not warrant that the Software is free
-from any error, that it will operate without interruption, that it will
-be compatible with the Licensee's own equipment and software
-configuration, nor that it will meet the Licensee's requirements.
-
-9.4 The Licensor does not either expressly or tacitly warrant that the
-Software does not infringe any third party intellectual property right
-relating to a patent, software or any other property right. Therefore,
-the Licensor disclaims any and all liability towards the Licensee
-arising out of any or all proceedings for infringement that may be
-instituted in respect of the use, modification and redistribution of the
-Software. Nevertheless, should such proceedings be instituted against
-the Licensee, the Licensor shall provide it with technical and legal
-assistance for its defense. Such technical and legal assistance shall be
-decided on a case-by-case basis between the relevant Licensor and the
-Licensee pursuant to a memorandum of understanding. The Licensor
-disclaims any and all liability as regards the Licensee's use of the
-name of the Software. No warranty is given as regards the existence of
-prior rights over the name of the Software or as regards the existence
-of a trademark.
-
-
-    Article 10 - TERMINATION
-
-10.1 In the event of a breach by the Licensee of its obligations
-hereunder, the Licensor may automatically terminate this Agreement
-thirty (30) days after notice has been sent to the Licensee and has
-remained ineffective.
-
-10.2 A Licensee whose Agreement is terminated shall no longer be
-authorized to use, modify or distribute the Software. However, any
-licenses that it may have granted prior to termination of the Agreement
-shall remain valid subject to their having been granted in compliance
-with the terms and conditions hereof.
-
-
-    Article 11 - MISCELLANEOUS
-
-
-      11.1 EXCUSABLE EVENTS
-
-Neither Party shall be liable for any or all delay, or failure to
-perform the Agreement, that may be attributable to an event of force
-majeure, an act of God or an outside cause, such as defective
-functioning or interruptions of the electricity or telecommunications
-networks, network paralysis following a virus attack, intervention by
-government authorities, natural disasters, water damage, earthquakes,
-fire, explosions, strikes and labor unrest, war, etc.
-
-11.2 Any failure by either Party, on one or more occasions, to invoke
-one or more of the provisions hereof, shall under no circumstances be
-interpreted as being a waiver by the interested Party of its right to
-invoke said provision(s) subsequently.
-
-11.3 The Agreement cancels and replaces any or all previous agreements,
-whether written or oral, between the Parties and having the same
-purpose, and constitutes the entirety of the agreement between said
-Parties concerning said purpose. No supplement or modification to the
-terms and conditions hereof shall be effective as between the Parties
-unless it is made in writing and signed by their duly authorized
-representatives.
-
-11.4 In the event that one or more of the provisions hereof were to
-conflict with a current or future applicable act or legislative text,
-said act or legislative text shall prevail, and the Parties shall make
-the necessary amendments so as to comply with said act or legislative
-text. All other provisions shall remain effective. Similarly, invalidity
-of a provision of the Agreement, for any reason whatsoever, shall not
-cause the Agreement as a whole to be invalid.
-
-
-      11.5 LANGUAGE
-
-The Agreement is drafted in both French and English and both versions
-are deemed authentic.
-
-
-    Article 12 - NEW VERSIONS OF THE AGREEMENT
-
-12.1 Any person is authorized to duplicate and distribute copies of this
-Agreement.
-
-12.2 So as to ensure coherence, the wording of this Agreement is
-protected and may only be modified by the authors of the License, who
-reserve the right to periodically publish updates or new versions of the
-Agreement, each with a separate number. These subsequent versions may
-address new issues encountered by Free Software.
-
-12.3 Any Software distributed under a given version of the Agreement may
-only be subsequently distributed under the same version of the Agreement
-or a subsequent version.
-
-
-    Article 13 - GOVERNING LAW AND JURISDICTION
-
-13.1 The Agreement is governed by French law. The Parties agree to
-endeavor to seek an amicable solution to any disagreements or disputes
-that may arise during the performance of the Agreement.
-
-13.2 Failing an amicable solution within two (2) months as from their
-occurrence, and unless emergency proceedings are necessary, the
-disagreements or disputes shall be referred to the Paris Courts having
-jurisdiction, by the more diligent Party.
-
-
-Version 1.0 dated 2006-09-05.
diff --git a/src/pprint/README b/src/pprint/README
deleted file mode 100644
index 7146250a..00000000
--- a/src/pprint/README
+++ /dev/null
@@ -1,13 +0,0 @@
-This is an adaptation of Daan Leijen's "PPrint" library, which itself is based
-on the ideas developed by Philip Wadler in "A Prettier Printer". For more
-information about Wadler's and Leijen's work, please consult the following
-references:
-
-   http://www.cs.uu.nl/~daan/pprint.html
-   http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf
-
-To install PPrint, type "make -C src install". ocamlfind is required.
-
-The documentation for PPrint is built by "make doc" and is found in the
-file doc/index.html.
-
diff --git a/src/pprint/src/META b/src/pprint/src/META
deleted file mode 100755
index 4a966166..00000000
--- a/src/pprint/src/META
+++ /dev/null
@@ -1,5 +0,0 @@
-requires = ""
-description = "The PPrint pretty-printing library"
-archive(byte) = "PPrintLib.cma"
-archive(native) = "PPrintLib.cmxa"
-version = "20171003"
diff --git a/src/pprint/src/Makefile b/src/pprint/src/Makefile
deleted file mode 100644
index 3bfa12df..00000000
--- a/src/pprint/src/Makefile
+++ /dev/null
@@ -1,46 +0,0 @@
-.PHONY: all install uninstall reinstall clean doc test bench
-
-OCAMLBUILD := ocamlbuild -use-ocamlfind -classic-display
-OCAMLFIND  := ocamlfind
-DOCDIR     := doc
-MAIN       := PPrintTest
-TO_BUILD   := PPrintLib.cma PPrintLib.cmxa
-
-all:
-	$(OCAMLBUILD) $(TO_BUILD)
-
-install: all
-	$(OCAMLFIND) install pprint META \
-		$(patsubst %,_build/%,$(TO_BUILD)) \
-		_build/PPrintLib.a _build/*.cmx _build/*.cmi
-
-# [make uninstall] attempts to uninstall, but succeeds even if uninstallation
-# fails (probably because the package was not installed in the first place).
-uninstall:
-	ocamlfind remove pprint || true
-
-reinstall: uninstall
-	@ $(MAKE) install
-
-clean:
-	rm -f *~
-	rm -rf doc
-	$(OCAMLBUILD) -clean
-
-doc: all
-	@rm -rf $(DOCDIR)
-	@mkdir $(DOCDIR)
-	ocamlfind ocamldoc \
-	  -html \
-	  -I _build \
-	  -d $(DOCDIR) \
-	  -charset utf8 \
-	  PPrintRenderer.ml PPrintEngine.mli PPrintCombinators.mli PPrintOCaml.mli PPrint.ml
-
-test: all
-	$(OCAMLBUILD) $(MAIN).native
-	./$(MAIN).native
-
-bench: all
-	$(OCAMLBUILD) -tag use_unix PPrintBench.native
-	time ./PPrintBench.native
diff --git a/src/pprint/src/PPrint.ml b/src/pprint/src/PPrint.ml
deleted file mode 100644
index 46d732b1..00000000
--- a/src/pprint/src/PPrint.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** A package of all of the above. *)
-
-include PPrintEngine
-include PPrintCombinators
-module OCaml = PPrintOCaml
diff --git a/src/pprint/src/PPrintCombinators.ml b/src/pprint/src/PPrintCombinators.ml
deleted file mode 100644
index 70499878..00000000
--- a/src/pprint/src/PPrintCombinators.ml
+++ /dev/null
@@ -1,311 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-open PPrintEngine
-
-(* ------------------------------------------------------------------------- *)
-
-(* Predefined single-character documents. *)
-
-let lparen          = char '('
-let rparen          = char ')'
-let langle          = char '<'
-let rangle          = char '>'
-let lbrace          = char '{'
-let rbrace          = char '}'
-let lbracket        = char '['
-let rbracket        = char ']'
-let squote          = char '\''
-let dquote          = char '"'
-let bquote          = char '`'
-let semi            = char ';'
-let colon           = char ':'
-let comma           = char ','
-let space           = char ' '
-let dot             = char '.'
-let sharp           = char '#'
-let slash           = char '/'
-let backslash       = char '\\'
-let equals          = char '='
-let qmark           = char '?'
-let tilde           = char '~'
-let at              = char '@'
-let percent         = char '%'
-let dollar          = char '$'
-let caret           = char '^'
-let ampersand       = char '&'
-let star            = char '*'
-let plus            = char '+'
-let minus           = char '-'
-let underscore      = char '_'
-let bang            = char '!'
-let bar             = char '|'
-
-(* ------------------------------------------------------------------------- *)
-
-(* Repetition. *)
-
-let twice doc =
-  doc ^^ doc
-
-let repeat n doc =
-  let rec loop n doc accu =
-    if n = 0 then
-      accu
-    else
-      loop (n - 1) doc (doc ^^ accu)
-  in
-  loop n doc empty
-
-(* ------------------------------------------------------------------------- *)
-
-(* Delimiters. *)
-
-let precede   l x   = l ^^ x
-let terminate r x   = x ^^ r
-let enclose l r x   = l ^^ x ^^ r
-
-let squotes         = enclose squote squote
-let dquotes         = enclose dquote dquote
-let bquotes         = enclose bquote bquote
-let braces          = enclose lbrace rbrace
-let parens          = enclose lparen rparen
-let angles          = enclose langle rangle
-let brackets        = enclose lbracket rbracket
-
-(* ------------------------------------------------------------------------- *)
-
-(* Some functions on lists. *)
-
-(* A variant of [fold_left] that keeps track of the element index. *)
-
-let foldli (f : int -> 'b -> 'a -> 'b) (accu : 'b) (xs : 'a list) : 'b =
-  let r = ref 0 in
-  List.fold_left (fun accu x ->
-    let i = !r in
-    r := i + 1;
-    f i accu x
-  ) accu xs
-
-(* ------------------------------------------------------------------------- *)
-
-(* Working with lists of documents. *)
-
-let concat docs =
-  (* We take advantage of the fact that [^^] operates in constant
-     time, regardless of the size of its arguments. The document
-     that is constructed is essentially a reversed list (i.e., a
-     tree that is biased towards the left). This is not a problem;
-     when pretty-printing this document, the engine will descend
-     along the left branch, pushing the nodes onto its stack as
-     it goes down, effectively reversing the list again. *)
-  List.fold_left (^^) empty docs
-
-let separate sep docs =
-  foldli (fun i accu doc ->
-    if i = 0 then
-      doc
-    else
-      accu ^^ sep ^^ doc
-  ) empty docs
-
-let concat_map f xs =
-  List.fold_left (fun accu x ->
-    accu ^^ f x
-  ) empty xs
-
-let separate_map sep f xs =
-  foldli (fun i accu x ->
-    if i = 0 then
-      f x
-    else
-      accu ^^ sep ^^ f x
-  ) empty xs
-
-let separate2 sep last_sep docs =
-  let n = List.length docs in
-  foldli (fun i accu doc ->
-    if i = 0 then
-      doc
-    else
-      accu ^^ (if i < n - 1 then sep else last_sep) ^^ doc
-  ) empty docs
-
-let optional f = function
-  | None ->
-      empty
-  | Some x ->
-      f x
-
-(* ------------------------------------------------------------------------- *)
-
-(* Text. *)
-
-(* This variant of [String.index_from] returns an option. *)
-
-let index_from s i c =
-  try
-    Some (String.index_from s i c)
-  with Not_found ->
-    None
-
-(* [lines s] chops the string [s] into a list of lines, which are turned
-   into documents. *)
-
-let lines s =
-  let rec chop accu i =
-    match index_from s i '\n' with
-    | Some j ->
-        let accu = substring s i (j - i) :: accu in
-	chop accu (j + 1)
-    | None ->
-        substring s i (String.length s - i) :: accu
-  in
-  List.rev (chop [] 0)
-
-let arbitrary_string s =
-  separate (break 1) (lines s)
-
-(* [split ok s] splits the string [s] at every occurrence of a character
-   that satisfies the predicate [ok]. The substrings thus obtained are
-   turned into documents, and a list of documents is returned. No information
-   is lost: the concatenation of the documents yields the original string.
-   This code is not UTF-8 aware. *)
-
-let split ok s =
-  let n = String.length s in
-  let rec index_from i =
-    if i = n then
-      None
-    else if ok s.[i] then
-      Some i
-    else
-      index_from (i + 1)
-  in
-  let rec chop accu i =
-    match index_from i with
-    | Some j ->
-        let accu = substring s i (j - i) :: accu in
-	let accu = char s.[j] :: accu in
-	chop accu (j + 1)
-    | None ->
-        substring s i (String.length s - i) :: accu
-  in
-  List.rev (chop [] 0)
-
-(* [words s] chops the string [s] into a list of words, which are turned
-   into documents. *)
-
-let words s =
-  let n = String.length s in
-  (* A two-state finite automaton. *)
-  (* In this state, we have skipped at least one blank character. *)
-  let rec skipping accu i = 
-    if i = n then
-      (* There was whitespace at the end. Drop it. *)
-      accu
-    else match s.[i] with
-    | ' '
-    | '\t'
-    | '\n'
-    | '\r' ->
-        (* Skip more whitespace. *)
-	skipping accu (i + 1)
-    | _ ->
-        (* Begin a new word. *)
-	word accu i (i + 1)
-  (* In this state, we have skipped at least one non-blank character. *)
-  and word accu i j =
-    if j = n then
-      (* Final word. *)
-      substring s i (j - i) :: accu
-    else match s.[j] with
-    | ' '
-    | '\t'
-    | '\n'
-    | '\r' ->
-        (* A new word has been identified. *)
-        let accu = substring s i (j - i) :: accu in	
-	skipping accu (j + 1)
-    | _ ->
-        (* Continue inside the current word. *)
-	word accu i (j + 1)
-  in
-  List.rev (skipping [] 0)
-
-let flow_map sep f docs =
-  foldli (fun i accu doc ->
-    if i = 0 then
-      f doc
-    else
-      accu ^^
-      (* This idiom allows beginning a new line if [doc] does not
-	 fit on the current line. *)
-      group (sep ^^ f doc)
-  ) empty docs  
-
-let flow sep docs =
-  flow_map sep (fun x -> x) docs
-
-let url s =
-  flow (break 0) (split (function '/' | '.' -> true | _ -> false) s)
-
-(* ------------------------------------------------------------------------- *)
-
-(* Alignment and indentation. *)
-
-let hang i d =
-  align (nest i d)
-
-let ( !^ ) = string
-
-let ( ^/^ ) x y =
-  x ^^ break 1 ^^ y
-
-let prefix n b x y =
-  group (x ^^ nest n (break b ^^ y))
-
-let (^//^) =
-  prefix 2 1
-
-let jump n b y =
-  group (nest n (break b ^^ y))
-
-(* Deprecated.
-let ( ^@^  ) x y = group (x ^/^ y)
-let ( ^@@^ ) x y = group (nest 2 (x ^/^ y))
-*)
-
-let infix n b op x y =
-  prefix n b (x ^^ blank b ^^ op) y
-
-let surround n b opening contents closing =
-  group (opening ^^ nest n (       break b  ^^ contents) ^^        break b ^^ closing )
-
-let soft_surround n b opening contents closing =
-  group (opening ^^ nest n (group (break b) ^^ contents) ^^ group (break b ^^ closing))
-
-let surround_separate n b void opening sep closing docs =
-  match docs with
-  | [] ->
-      void
-  | _ :: _ ->
-      surround n b opening (separate sep docs) closing
-
-let surround_separate_map n b void opening sep closing f xs =
-  match xs with
-  | [] ->
-      void
-  | _ :: _ ->
-      surround n b opening (separate_map sep f xs) closing
-
diff --git a/src/pprint/src/PPrintCombinators.mli b/src/pprint/src/PPrintCombinators.mli
deleted file mode 100644
index c538cb35..00000000
--- a/src/pprint/src/PPrintCombinators.mli
+++ /dev/null
@@ -1,236 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-open PPrintEngine
-
-(** A set of high-level combinators for building documents. *)
-
-(** {1 Single characters} *)
-
-(** The following constant documents consist of a single character. *)
-
-val lparen: document
-val rparen: document
-val langle: document
-val rangle: document
-val lbrace: document
-val rbrace: document
-val lbracket: document
-val rbracket: document
-val squote: document
-val dquote: document
-val bquote: document
-val semi: document
-val colon: document
-val comma: document
-val space: document
-val dot: document
-val sharp: document
-val slash: document
-val backslash: document
-val equals: document
-val qmark: document
-val tilde: document
-val at: document
-val percent: document
-val dollar: document
-val caret: document
-val ampersand: document
-val star: document
-val plus: document
-val minus: document
-val underscore: document
-val bang: document
-val bar: document
-
-(** {1 Delimiters} *)
-
-(** [precede l x] is [l ^^ x]. *)
-val precede: document -> document -> document
-
-(** [terminate r x] is [x ^^ r]. *)
-val terminate: document -> document -> document
-
-(** [enclose l r x] is [l ^^ x ^^ r]. *)
-val enclose: document -> document -> document -> document
-
-(** The following combinators enclose a document within a pair of delimiters.
-    They are partial applications of [enclose]. No whitespace or line break is
-    introduced. *)
-
-val squotes: document -> document
-val dquotes: document -> document
-val bquotes: document -> document
-val braces: document -> document
-val parens: document -> document
-val angles: document -> document
-val brackets: document -> document
-
-(** {1 Repetition} *)
-
-(** [twice doc] is the document obtained by concatenating two copies of
-    the document [doc]. *)
-val twice: document -> document
-
-(** [repeat n doc] is the document obtained by concatenating [n] copies of
-    the document [doc]. *)
-val repeat: int -> document -> document
-
-(** {1 Lists and options} *)
-
-(** [concat docs] is the concatenation of the documents in the list [docs]. *)
-val concat: document list -> document
-
-(** [separate sep docs] is the concatenation of the documents in the list
-    [docs]. The separator [sep] is inserted between every two adjacent
-    documents. *)
-val separate: document -> document list -> document
-
-(** [concat_map f xs] is equivalent to [concat (List.map f xs)]. *)
-val concat_map: ('a -> document) -> 'a list -> document
-
-(** [separate_map sep f xs] is equivalent to [separate sep (List.map f xs)]. *)
-val separate_map: document -> ('a -> document) -> 'a list -> document
-
-(** [separate2 sep last_sep docs] is the concatenation of the documents in the
-    list [docs]. The separator [sep] is inserted between every two adjacent
-    documents, except between the last two documents, where the separator
-    [last_sep] is used instead. *)
-val separate2: document -> document -> document list -> document
-
-(** [optional f None] is the empty document. [optional f (Some x)] is
-    the document [f x]. *)
-val optional: ('a -> document) -> 'a option -> document
-
-(** {1 Text} *)
-
-(** [lines s] is the list of documents obtained by splitting [s] at newline
-    characters, and turning each line into a document via [substring]. This
-    code is not UTF-8 aware. *)
-val lines: string -> document list
-
-(** [arbitrary_string s] is equivalent to [separate (break 1) (lines s)].
-    It is analogous to [string s], but is valid even if the string [s]
-    contains newline characters. *)
-val arbitrary_string: string -> document
-
-(** [words s] is the list of documents obtained by splitting [s] at whitespace
-    characters, and turning each word into a document via [substring]. All
-    whitespace is discarded. This code is not UTF-8 aware. *)
-val words: string -> document list
-
-(** [split ok s] splits the string [s] before and after every occurrence of a
-    character that satisfies the predicate [ok]. The substrings thus obtained
-    are turned into documents, and a list of documents is returned. No
-    information is lost: the concatenation of the documents yields the
-    original string. This code is not UTF-8 aware. *)
-val split: (char -> bool) -> string -> document list
-
-(** [flow sep docs] separates the documents in the list [docs] with the
-    separator [sep] and arranges for a new line to begin whenever a document
-    does not fit on the current line. This is useful for typesetting
-    free-flowing, ragged-right text. A typical choice of [sep] is [break b],
-    where [b] is the number of spaces that must be inserted between two
-    consecutive words (when displayed on the same line). *)
-val flow: document -> document list -> document
-
-(** [flow_map sep f docs] is equivalent to [flow sep (List.map f docs)]. *)
-val flow_map: document -> ('a -> document) -> 'a list -> document
-
-(** [url s] is a possible way of displaying the URL [s]. A potential line
-    break is inserted immediately before and immediately after every slash
-    and dot character. *)
-val url: string -> document
-
-(** {1 Alignment and indentation} *)
-
-(* [hang n doc] is analogous to [align], but additionally indents
-   all lines, except the first one, by [n]. Thus, the text in the
-   box forms a hanging indent. *)
-val hang: int -> document -> document
-
-(** [prefix n b left right] has the following flat layout: {[
-left right
-]}
-and the following non-flat layout:
-{[
-left
-  right
-]}
-The parameter [n] controls the nesting of [right] (when not flat).
-The parameter [b] controls the number of spaces between [left] and [right]
-(when flat).
- *)
-val prefix: int -> int -> document -> document -> document
-
-(** [jump n b right] is equivalent to [prefix n b empty right]. *)
-val jump: int -> int -> document -> document
-
-(** [infix n b middle left right] has the following flat layout: {[
-left middle right
-]}
-and the following non-flat layout: {[
-left middle
-  right
-]}
-The parameter [n] controls the nesting of [right] (when not flat).
-The parameter [b] controls the number of spaces between [left] and [middle]
-(always) and between [middle] and [right] (when flat).
-*)
-val infix: int -> int -> document -> document -> document -> document
-
-(** [surround n b opening contents closing] has the following flat layout: {[
-opening contents closing
-]}
-and the following non-flat layout: {[
-opening
-  contents
-closing
-]}
-The parameter [n] controls the nesting of [contents] (when not flat).
-The parameter [b] controls the number of spaces between [opening] and [contents]
-and between [contents] and [closing] (when flat).
-*)
-val surround: int -> int -> document -> document -> document -> document
-
-(** [soft_surround] is analogous to [surround], but involves more than one
-    group, so it offers possibilities other than the completely flat layout
-    (where [opening], [contents], and [closing] appear on a single line) and
-    the completely developed layout (where [opening], [contents], and
-    [closing] appear on separate lines). It tries to place the beginning of
-    [contents] on the same line as [opening], and to place [closing] on the
-    same line as the end of [contents], if possible.
-*)
-val soft_surround: int -> int -> document -> document -> document -> document
-
-(** [surround_separate n b void opening sep closing docs] is equivalent to
-    [surround n b opening (separate sep docs) closing], except when the
-    list [docs] is empty, in which case it reduces to [void]. *)
-val surround_separate: int -> int -> document -> document -> document -> document -> document list -> document
-
-(** [surround_separate_map n b void opening sep closing f xs] is equivalent to
-    [surround_separate n b void opening sep closing (List.map f xs)]. *)
-val surround_separate_map: int -> int -> document -> document -> document -> document -> ('a -> document) -> 'a list -> document
-
-(** {1 Short-hands} *)
-
-(** [!^s] is a short-hand for [string s]. *)
-val ( !^ ) : string -> document
-
-(** [x ^/^ y] separates [x] and [y] with a breakable space.
-    It is a short-hand for [x ^^ break 1 ^^ y]. *)
-val ( ^/^ ) : document -> document -> document
-
-(** [x ^//^ y] is a short-hand for [prefix 2 1 x y]. *)
-val ( ^//^ ) : document -> document -> document
-
diff --git a/src/pprint/src/PPrintEngine.ml b/src/pprint/src/PPrintEngine.ml
deleted file mode 100644
index 2a78363d..00000000
--- a/src/pprint/src/PPrintEngine.ml
+++ /dev/null
@@ -1,642 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* ------------------------------------------------------------------------- *)
-
-(* A type of integers with infinity. *)
-
-type requirement =
-    int (* with infinity *)
-
-(* Infinity is encoded as [max_int]. *)
-
-let infinity : requirement =
-  max_int
-
-(* Addition of integers with infinity. *)
-
-let (++) (x : requirement) (y : requirement) : requirement =
-  if x = infinity || y = infinity then
-    infinity
-  else
-    x + y
-
-(* Comparison between an integer with infinity and a normal integer. *)
-
-let (<==) (x : requirement) (y : int) =
-  x <= y
-
-(* ------------------------------------------------------------------------- *)
-
-(* A uniform interface for output channels. *)
-
-class type output = object
-
-  (** [char c] sends the character [c] to the output channel. *)
-  method char: char -> unit
-
-  (** [substring s ofs len] sends the substring of [s] delimited by the
-      offset [ofs] and the length [len] to the output channel. *)
-  method substring: string -> int (* offset *) -> int (* length *) -> unit
-
-end
-
-(* Three kinds of output channels are wrapped so as to satisfy the above
-   interface: OCaml output channels, OCaml memory buffers, and OCaml
-   formatters. *)
-
-class channel_output channel = object
-  method char = output_char channel
-  method substring = output_substring channel
-    (* We used to use [output], but, as of OCaml 4.02 and with -safe-string
-       enabled, the type of [output] has changed: this function now expects
-       an argument of type [bytes]. The new function [output_substring] must
-       be used instead. Furthermore, as of OCaml 4.06, -safe-string is enabled
-       by default. In summary, we require OCaml 4.02, use [output_substring],
-       and enable -safe-string. *)
-end
-
-class buffer_output buffer = object
-  method char = Buffer.add_char buffer
-  method substring = Buffer.add_substring buffer
-end
-
-class formatter_output fmt = object
-  method char = Format.pp_print_char fmt
-  method substring = fst (Format.pp_get_formatter_output_functions fmt ())
-end
-
-(* ------------------------------------------------------------------------- *)
-
-(** The rendering engine maintains the following internal state. Its structure
-    is subject to change in future versions of the library. Nevertheless, it is
-    exposed to the user who wishes to define custom documents. *)
-
-type state = {
-
-    width: int;
-    (** The line width. This parameter is fixed throughout the execution of
-        the renderer. *)
-
-    ribbon: int;
-    (** The ribbon width. This parameter is fixed throughout the execution of
-        the renderer. *)
-
-    mutable last_indent: int;
-    (** The number of blanks that were printed at the beginning of the current
-        line. This field is updated (only) by the function [emit_hardline]. It
-        is used (only) to determine whether the ribbon width constraint is
-        respected. *)
-
-    mutable column: int;
-    (** The current column. This field must be updated whenever something is
-        sent to the output channel. It is used (only) to determine whether the
-        width constraint is respected. *)
-
-  }
-
-(* ------------------------------------------------------------------------- *)
-
-(* [initial rfrac width] creates a fresh initial state. *)
-
-let initial rfrac width = {
-  width = width;
-  ribbon = max 0 (min width (truncate (float_of_int width *. rfrac)));
-  last_indent = 0;
-  column = 0
-}
-
-(* ------------------------------------------------------------------------- *)
-
-(** A custom document is defined by implementing the following methods. *)
-
-class type custom = object
-
-  (** A custom document must publish the width (i.e., the number of columns)
-      that it would like to occupy if it is printed on a single line (that is,
-      in flattening mode). The special value [infinity] means that this
-      document cannot be printed on a single line; this value causes any
-      groups that contain this document to be dissolved. This method should
-      in principle work in constant time. *)
-  method requirement: requirement
-
-  (** The method [pretty] is used by the main rendering algorithm. It has
-      access to the output channel and to the algorithm's internal state, as
-      described above. In addition, it receives the current indentation level
-      and the current flattening mode (on or off). If flattening mode is on,
-      then the document must be printed on a single line, in a manner that is
-      consistent with the requirement that was published ahead of time. If
-      flattening mode is off, then there is no such obligation. The state must
-      be updated in a manner that is consistent with what is sent to the
-      output channel. *)
-  method pretty: output -> state -> int -> bool -> unit
-
-  (** The method [compact] is used by the compact rendering algorithm. It has
-      access to the output channel only. *)
-  method compact: output -> unit
-
-end
-
-(* ------------------------------------------------------------------------- *)
-
-(* Here is the algebraic data type of documents. It is analogous to Daan
-   Leijen's version, but the binary constructor [Union] is replaced with
-   the unary constructor [Group], and the constant [Line] is replaced with
-   more general constructions, namely [IfFlat], which provides alternative
-   forms depending on the current flattening mode, and [HardLine], which
-   represents a newline character, and causes a failure in flattening mode. *)
-
-type document =
-
-  (* [Empty] is the empty document. *)
-
-  | Empty
-
-  (* [Char c] is a document that consists of the single character [c]. We
-     enforce the invariant that [c] is not a newline character. *)
-
-  | Char of char
-
-  (* [String s] is a document that consists of just the string [s]. We
-     assume, but do not check, that this string does not contain a newline
-     character. [String] is a special case of [FancyString], which takes up
-     less space in memory. *)
-
-  | String of string
-
-  (* [FancyString (s, ofs, len, apparent_length)] is a (portion of a) string
-     that may contain fancy characters: color escape characters, UTF-8 or
-     multi-byte characters, etc. Thus, the apparent length (which corresponds
-     to what will be visible on screen) differs from the length (which is a
-     number of bytes, and is reported by [String.length]). We assume, but do
-     not check, that fancystrings do not contain a newline character. *)
-
-  | FancyString of string * int * int * int
-
-  (* [Blank n] is a document that consists of [n] blank characters. *)
-
-  | Blank of int
-
-    (* When in flattening mode, [IfFlat (d1, d2)] turns into the document
-       [d1]. When not in flattening mode, it turns into the document [d2]. *)
-
-  | IfFlat of document * document
-
-  (* When in flattening mode, [HardLine] causes a failure, which requires
-     backtracking all the way until the stack is empty. When not in flattening
-     mode, it represents a newline character, followed with an appropriate
-     number of indentation. A common way of using [HardLine] is to only use it
-     directly within the right branch of an [IfFlat] construct. *)
-
-  | HardLine
-
-  (* The following constructors store their space requirement. This is the
-     document's apparent length, if printed in flattening mode. This
-     information is computed in a bottom-up manner when the document is
-     constructed. *)
-
-  (* In other words, the space requirement is the number of columns that the
-     document needs in order to fit on a single line. We express this value in
-     the set of `integers extended with infinity', and use the value
-     [infinity] to indicate that the document cannot be printed on a single
-     line. *)
-
-  (* Storing this information at [Group] nodes is crucial, as it allows us to
-     avoid backtracking and buffering. *)
-
-  (* Storing this information at other nodes allows the function [requirement]
-     to operate in constant time. This means that the bottom-up computation of
-     requirements takes linear time. *)
-
-  (* [Cat (req, doc1, doc2)] is the concatenation of the documents [doc1] and
-     [doc2]. The space requirement [req] is the sum of the requirements of
-     [doc1] and [doc2]. *)
-
-  | Cat of requirement * document * document
-
-  (* [Nest (req, j, doc)] is the document [doc], in which the indentation
-     level has been increased by [j], that is, in which [j] blanks have been
-     inserted after every newline character. The space requirement [req] is
-     the same as the requirement of [doc]. *)
-
-  | Nest of requirement * int * document
-
-  (* [Group (req, doc)] represents an alternative: it is either a flattened
-     form of [doc], in which occurrences of [Group] disappear and occurrences
-     of [IfFlat] resolve to their left branch, or [doc] itself. The space
-     requirement [req] is the same as the requirement of [doc]. *)
-
-  | Group of requirement * document
-
-  (* [Align (req, doc)] increases the indentation level to reach the current
-     column.  Thus, the document [doc] is rendered within a box whose upper
-     left corner is the current position. The space requirement [req] is the
-     same as the requirement of [doc]. *)
-
-  | Align of requirement * document
-
-  (* [Custom (req, f)] is a document whose appearance is user-defined. *)
-
-  | Custom of custom
-
-(* ------------------------------------------------------------------------- *)
-
-(* Retrieving or computing the space requirement of a document. *)
-
-let rec requirement = function
-  | Empty ->
-      0
-  | Char _ ->
-      1
-  | String s ->
-      String.length s
-  | FancyString (_, _, _, len)
-  | Blank len ->
-      len
-  | IfFlat (doc1, _) ->
-      (* In flattening mode, the requirement of [ifflat x y] is just the
-         requirement of its flat version, [x]. *)
-      (* The smart constructor [ifflat] ensures that [IfFlat] is never nested
-         in the left-hand side of [IfFlat], so this recursive call is not a
-         problem; the function [requirement] has constant time complexity. *)
-      requirement doc1
-  | HardLine ->
-      (* A hard line cannot be printed in flattening mode. *)
-      infinity
-  | Cat (req, _, _)
-  | Nest (req, _, _)
-  | Group (req, _)
-  | Align (req, _) ->
-      (* These nodes store their requirement -- which is computed when the
-         node is constructed -- so as to allow us to answer in constant time
-         here. *)
-      req
-  | Custom c ->
-      c#requirement
-
-(* ------------------------------------------------------------------------- *)
-
-(* The above algebraic data type is not exposed to the user. Instead, we
-   expose the following functions. These functions construct a raw document
-   and compute its requirement, so as to obtain a document. *)
-
-let empty =
-  Empty
-
-let char c =
-  assert (c <> '\n');
-  Char c
-
-let space =
-  char ' '
-
-let string s =
-  String s
-
-let fancysubstring s ofs len apparent_length =
-  if len = 0 then
-    empty
-  else
-    FancyString (s, ofs, len, apparent_length)
-
-let substring s ofs len =
-  fancysubstring s ofs len len
-
-let fancystring s apparent_length =
-  fancysubstring s 0 (String.length s) apparent_length
-
-(* The following function was stolen from [Batteries]. *)
-let utf8_length s =
-  let rec length_aux s c i =
-    if i >= String.length s then c else
-    let n = Char.code (String.unsafe_get s i) in
-    let k =
-      if n < 0x80 then 1 else
-      if n < 0xe0 then 2 else
-      if n < 0xf0 then 3 else 4
-    in
-    length_aux s (c + 1) (i + k)
-  in
-  length_aux s 0 0
-
-let utf8string s =
-  fancystring s (utf8_length s)
-
-let hardline =
-  HardLine
-
-let blank n =
-  match n with
-  | 0 ->
-      empty
-  | 1 ->
-      space
-  | _ ->
-      Blank n
-
-let ifflat doc1 doc2 =
-  (* Avoid nesting [IfFlat] in the left-hand side of [IfFlat], as this
-     is redundant. *)
-  match doc1 with
-  | IfFlat (doc1, _)
-  | doc1 ->
-      IfFlat (doc1, doc2)
-
-let internal_break i =
-  ifflat (blank i) hardline
-
-let break0 =
-  internal_break 0
-
-let break1 =
-  internal_break 1
-
-let break i =
-  match i with
-  | 0 ->
-      break0
-  | 1 ->
-      break1
-  | _ ->
-      internal_break i
-
-let (^^) x y =
-  match x, y with
-  | Empty, _ ->
-      y
-  | _, Empty ->
-      x
-  | _, _ ->
-      Cat (requirement x ++ requirement y, x, y)
-
-let nest i x =
-  assert (i >= 0);
-  Nest (requirement x, i, x)
-
-let group x =
-  let req = requirement x in
-  (* Minor optimisation: an infinite requirement dissolves a group. *)
-  if req = infinity then
-    x
-  else
-    Group (req, x)
-
-let align x =
-  Align (requirement x, x)
-
-let custom c =
-  (* Sanity check. *)
-  assert (c#requirement >= 0);
-  Custom c
-
-(* ------------------------------------------------------------------------- *)
-
-(* Printing blank space (indentation characters). *)
-
-let blank_length =
-  80
-
-let blank_buffer =
-  String.make blank_length ' '
-
-let rec blanks output n =
-  if n <= 0 then
-    ()
-  else if n <= blank_length then
-    output#substring blank_buffer 0 n
-  else begin
-    output#substring blank_buffer 0 blank_length;
-    blanks output (n - blank_length)
-  end
-
-(* ------------------------------------------------------------------------- *)
-
-(* This function expresses the following invariant: if we are in flattening
-   mode, then we must be within bounds, i.e. the width and ribbon width
-   constraints must be respected. *)
-
-let ok state flatten : bool =
-  not flatten ||
-  state.column <= state.width && state.column <= state.last_indent + state.ribbon
-
-(* ------------------------------------------------------------------------- *)
-
-(* The pretty rendering engine. *)
-
-(* The renderer is supposed to behave exactly like Daan Leijen's, although its
-   implementation is quite radically different, and simpler. Our documents are
-   constructed eagerly, as opposed to lazily. This means that we pay a large
-   space overhead, but in return, we get the ability of computing information
-   bottom-up, as described above, which allows to render documents without
-   backtracking or buffering. *)
-
-(* The [state] record is never copied; it is just threaded through. In
-   addition to it, the parameters [indent] and [flatten] influence the
-   manner in which the document is rendered. *)
-
-(* The code is written in tail-recursive style, so as to avoid running out of
-   stack space if the document is very deep. Its explicit continuation can be
-   viewed as a sequence of pending calls to [pretty]. *)
-
-type cont =
-  | KNil
-  | KCons of int * bool * document * cont
-
-let rec pretty
-  (output : output)
-  (state : state)
-  (indent : int)
-  (flatten : bool)
-  (doc : document)
-  (cont : cont)
-: unit =
-  match doc with
-
-  | Empty ->
-      continue output state cont
-
-  | Char c ->
-      output#char c;
-      state.column <- state.column + 1;
-      (* assert (ok state flatten); *)
-      continue output state cont
-
-  | String s ->
-      let len = String.length s in
-      output#substring s 0 len;
-      state.column <- state.column + len;
-      (* assert (ok state flatten); *)
-      continue output state cont
-
-  | FancyString (s, ofs, len, apparent_length) ->
-      output#substring s ofs len;
-      state.column <- state.column + apparent_length;
-      (* assert (ok state flatten); *)
-      continue output state cont
-
-  | Blank n ->
-      blanks output n;
-      state.column <- state.column + n;
-      (* assert (ok state flatten); *)
-      continue output state cont
-
-  | HardLine ->
-      (* We cannot be in flattening mode, because a hard line has an [infinity]
-         requirement, and we attempt to render a group in flattening mode only
-         if this group's requirement is met. *)
-      assert (not flatten);
-      (* Emit a hardline. *)
-      output#char '\n';
-      blanks output indent;
-      state.column <- indent;
-      state.last_indent <- indent;
-      (* Continue. *)
-      continue output state cont
-
-  | IfFlat (doc1, doc2) ->
-      (* Pick an appropriate sub-document, based on the current flattening
-         mode. *)
-      pretty output state indent flatten (if flatten then doc1 else doc2) cont
-
-  | Cat (_, doc1, doc2) ->
-      (* Push the second document onto the continuation. *)
-      pretty output state indent flatten doc1 (KCons (indent, flatten, doc2, cont))
-
-  | Nest (_, j, doc) ->
-      pretty output state (indent + j) flatten doc cont
-
-  | Group (req, doc) ->
-      (* If we already are in flattening mode, stay in flattening mode; we
-         are committed to it. If we are not already in flattening mode, we
-         have a choice of entering flattening mode. We enter this mode only
-         if we know that this group fits on this line without violating the
-         width or ribbon width constraints. Thus, we never backtrack. *)
-      let flatten =
-        flatten ||
-        let column = state.column ++ req in
-        column <== state.width && column <== state.last_indent + state.ribbon
-      in
-      pretty output state indent flatten doc cont
-
-  | Align (_, doc) ->
-      (* The effect of this combinator is to set [indent] to [state.column].
-         Usually [indent] is equal to [state.last_indent], hence setting it
-         to [state.column] increases it. However, if [nest] has been used
-         since the current line began, then this could cause [indent] to
-         decrease. *)
-      (* assert (state.column > state.last_indent); *)
-      pretty output state state.column flatten doc cont
-
-  | Custom c ->
-      (* Invoke the document's custom rendering function. *)
-      c#pretty output state indent flatten;
-      (* Sanity check. *)
-      assert (ok state flatten);
-      (* Continue. *)
-      continue output state cont
-
-and continue output state = function
-  | KNil ->
-      ()
-  | KCons (indent, flatten, doc, cont) ->
-      pretty output state indent flatten doc cont
-
-(* Publish a version of [pretty] that does not take an explicit continuation.
-   This function may be used by authors of custom documents. We do not expose
-   the internal [pretty] -- the one that takes a continuation -- because we
-   wish to simplify the user's life. The price to pay is that calls that go
-   through a custom document cannot be tail calls. *)
-
-let pretty output state indent flatten doc =
-  pretty output state indent flatten doc KNil
-
-(* ------------------------------------------------------------------------- *)
-
-(* The compact rendering algorithm. *)
-
-let rec compact output doc cont =
-  match doc with
-  | Empty ->
-      continue output cont
-  | Char c ->
-      output#char c;
-      continue output cont
-  | String s ->
-      let len = String.length s in
-      output#substring s 0 len;
-      continue output cont
-  | FancyString (s, ofs, len, apparent_length) ->
-      output#substring s ofs len;
-      continue output cont
-  | Blank n ->
-      blanks output n;
-      continue output cont
-  | HardLine ->
-      output#char '\n';
-      continue output cont
-  | Cat (_, doc1, doc2) ->
-      compact output doc1 (doc2 :: cont)
-  | IfFlat (doc, _)
-  | Nest (_, _, doc)
-  | Group (_, doc)
-  | Align (_, doc) ->
-      compact output doc cont
-  | Custom c ->
-      (* Invoke the document's custom rendering function. *)
-      c#compact output;
-      continue output cont
-
-and continue output cont =
-  match cont with
-  | [] ->
-      ()
-  | doc :: cont ->
-      compact output doc cont
-
-let compact output doc =
-  compact output doc []
-
-(* ------------------------------------------------------------------------- *)
-
-(* We now instantiate the renderers for the three kinds of output channels. *)
-
-(* This is just boilerplate. *)
-
-module MakeRenderer (X : sig
-  type channel
-  val output: channel -> output
-end) = struct
-  type channel = X.channel
-  type dummy = document
-  type document = dummy
-  let pretty rfrac width channel doc = pretty (X.output channel) (initial rfrac width) 0 false doc
-  let compact channel doc = compact (X.output channel) doc
-end
-
-module ToChannel =
-  MakeRenderer(struct
-    type channel = out_channel
-    let output = new channel_output
-  end)
-
-module ToBuffer =
-  MakeRenderer(struct
-    type channel = Buffer.t
-    let output = new buffer_output
-  end)
-
-module ToFormatter =
-  MakeRenderer(struct
-    type channel = Format.formatter
-    let output = new formatter_output
-  end)
diff --git a/src/pprint/src/PPrintEngine.mli b/src/pprint/src/PPrintEngine.mli
deleted file mode 100644
index eda61a6c..00000000
--- a/src/pprint/src/PPrintEngine.mli
+++ /dev/null
@@ -1,226 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** A pretty-printing engine and a set of basic document combinators. *)
-
-(** {1 Building documents} *)
-
-(** Documents must be built in memory before they are rendered. This may seem
-    costly, but it is a simple approach, and works well. *)
-
-(** The following operations form a set of basic (low-level) combinators for
-    building documents. On top of these combinators, higher-level combinators
-    can be defined: see {!PPrintCombinators}. *)
-
-(** This is the abstract type of documents. *)
-type document
-
-(** The following basic (low-level) combinators allow constructing documents. *)
-
-(** [empty] is the empty document. *)
-val empty: document
-
-(** [char c] is a document that consists of the single character [c]. This
-    character must not be a newline. *)
-val char: char -> document
-
-(** [string s] is a document that consists of the string [s]. This string must
-    not contain a newline. *)
-val string: string -> document
-
-(** [substring s ofs len] is a document that consists of the portion of the
-    string [s] delimited by the offset [ofs] and the length [len]. This
-    portion must not contain a newline. *)
-val substring: string -> int -> int -> document
-
-(** [fancystring s apparent_length] is a document that consists of the string
-    [s]. This string must not contain a newline. The string may contain fancy
-    characters: color escape characters, UTF-8 or multi-byte characters,
-    etc. Thus, its apparent length (which measures how many columns the text
-    will take up on screen) differs from its length in bytes. *)
-val fancystring: string -> int -> document
-
-(** [fancysubstring s ofs len apparent_length] is a document that consists of
-    the portion of the string [s] delimited by the offset [ofs] and the length
-    [len]. This portion must contain a newline. The string may contain fancy
-    characters. *)
-val fancysubstring : string -> int -> int -> int -> document
-
-(** [utf8string s] is a document that consists of the UTF-8-encoded string [s].
-    This string must not contain a newline. *)
-val utf8string: string -> document
-
-(** [hardline] is a forced newline document. This document forces all enclosing
-    groups to be printed in non-flattening mode. In other words, any enclosing
-    groups are dissolved. *)
-val hardline: document
-
-(** [blank n] is a document that consists of [n] blank characters. *)
-val blank: int -> document
-
-(** [break n] is a document which consists of either [n] blank characters,
-    when forced to display on a single line, or a single newline character,
-    otherwise. Note that there is no choice at this point: choices are encoded
-    by the [group] combinator. *)
-val break: int -> document
-
-(** [doc1 ^^ doc2] is the concatenation of the documents [doc1] and [doc2]. *)
-val (^^): document -> document -> document
-
-(** [nest j doc] is the document [doc], in which the indentation level has
-    been increased by [j], that is, in which [j] blanks have been inserted
-    after every newline character. Read this again: indentation is inserted
-    after every newline character. No indentation is inserted at the beginning
-    of the document. *)
-val nest: int -> document -> document
-
-(** [group doc] encodes a choice. If possible, then the entire document [group
-    doc] is rendered on a single line. Otherwise, the group is dissolved, and
-    [doc] is rendered. There might be further groups within [doc], whose
-    presence will lead to further choices being explored. *)
-val group: document -> document
-
-(** [ifflat doc1 doc2] is rendered as [doc1] if part of a group that can be
-    successfully flattened, and is rendered as [doc2] otherwise. Use this
-    operation with caution. Because the pretty-printer is free to choose
-    between [doc1] and [doc2], these documents should be semantically
-    equivalent. *)
-val ifflat: document -> document -> document
-
-(** [align doc] is the document [doc], in which the indentation level has been
-    set to the current column. Thus, [doc] is rendered within a box whose
-    upper left corner is the current position. *)
-val align: document -> document
-
-(** {1 Rendering documents} *)
-
-(** This renderer sends its output into an output channel. *)
-module ToChannel : PPrintRenderer.RENDERER
-  with type channel = out_channel
-   and type document = document
-
-(** This renderer sends its output into a memory buffer. *)
-module ToBuffer : PPrintRenderer.RENDERER
-  with type channel = Buffer.t
-   and type document = document
-
-(** This renderer sends its output into a formatter channel. *)
-module ToFormatter : PPrintRenderer.RENDERER
-  with type channel = Format.formatter
-   and type document = document
-
-(** {1 Defining custom documents} *)
-
-(** A width requirement is expressed as an integer, where the value [max_int]
-    is reserved and represents infinity. *)
-
-type requirement = int
-val infinity : requirement
-
-(** An output channel is represented abstractly as an object equipped with
-    methods for displaying one character and for displaying a substring. *)
-
-class type output = object
-
-  (** [char c] sends the character [c] to the output channel. *)
-  method char: char -> unit
-
-  (** [substring s ofs len] sends the substring of [s] delimited by the
-      offset [ofs] and the length [len] to the output channel. *)
-  method substring: string -> int (* offset *) -> int (* length *) -> unit
-
-end
-
-(** The rendering engine maintains the following internal state. Its structure
-    is subject to change in future versions of the library. Nevertheless, it is
-    exposed to the user who wishes to define custom documents. *)
-
-type state = {
-
-    width: int;
-    (** The line width. This parameter is fixed throughout the execution of
-        the renderer. *)
-
-    ribbon: int;
-    (** The ribbon width. This parameter is fixed throughout the execution of
-        the renderer. *)
-
-    mutable last_indent: int;
-    (** The number of blanks that were printed at the beginning of the current
-        line. This field is updated (only) by the function [emit_hardline]. It
-        is used (only) to determine whether the ribbon width constraint is
-        respected. *)
-
-    mutable column: int;
-    (** The current column. This field must be updated whenever something is
-        sent to the output channel. It is used (only) to determine whether the
-        width constraint is respected. *)
-
-  }
-
-(** A custom document is defined by implementing the following methods. *)
-
-class type custom = object
-
-  (** A custom document must publish the width (i.e., the number of columns)
-      that it would like to occupy if it is printed on a single line (that is,
-      in flattening mode). The special value [infinity] means that this
-      document cannot be printed on a single line; this value causes any
-      groups that contain this document to be dissolved. This method should
-      in principle work in constant time. *)
-  method requirement: requirement
-
-  (** The method [pretty] is used by the main rendering algorithm. It has
-      access to the output channel and to the algorithm's internal state, as
-      described above. In addition, it receives the current indentation level
-      and the current flattening mode (on or off). If flattening mode is on,
-      then the document must be printed on a single line, in a manner that is
-      consistent with the requirement that was published ahead of time. If
-      flattening mode is off, then there is no such obligation. The state must
-      be updated in a manner that is consistent with what is sent to the
-      output channel. *)
-  method pretty: output -> state -> int -> bool -> unit
-
-  (** The method [compact] is used by the compact rendering algorithm. It has
-      access to the output channel only. *)
-  method compact: output -> unit
-
-end
-
-(** The function [custom] constructs a custom document. In other words, it
-    converts an object of type [custom] to a document. *)
-val custom: custom -> document
-
-(** The key functions of the library are exposed, in the hope that they may be
-    useful to authors of custom (leaf and non-leaf) documents. In the case of
-    a leaf document, they can help perform certain basic functions; for
-    instance, applying the function [pretty] to the document [hardline] is a
-    simple way of printing a hardline, while respecting the indentation
-    parameters and updating the state in a correct manner. Similarly, applying
-    [pretty] to the document [blank n] is a simple way of printing [n] spaces.
-    In the case of a non-leaf document (i.e., one which contains
-    sub-documents), these functions are essential: they allow computing the
-    width requirement of a sub-document and displaying a sub-document. *)
-
-(** [requirement doc] computes the width requirement of the document [doc].
-    It works in constant time. *)
-val requirement: document -> requirement
-
-(** [pretty output state indent flatten doc] prints the document [doc]. See
-    the documentation of the method [pretty]. *)
-val pretty: output -> state -> int -> bool -> document -> unit
-
-(** [compact output doc] prints the document [doc]. See the documentation of
-    the method [compact]. *)
-val compact: output -> document -> unit
-
diff --git a/src/pprint/src/PPrintLib.mllib b/src/pprint/src/PPrintLib.mllib
deleted file mode 100644
index e5de6978..00000000
--- a/src/pprint/src/PPrintLib.mllib
+++ /dev/null
@@ -1,5 +0,0 @@
-PPrint
-PPrintCombinators
-PPrintEngine
-PPrintOCaml
-PPrintRenderer
diff --git a/src/pprint/src/PPrintOCaml.ml b/src/pprint/src/PPrintOCaml.ml
deleted file mode 100644
index bee5f2a3..00000000
--- a/src/pprint/src/PPrintOCaml.ml
+++ /dev/null
@@ -1,158 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-open Printf
-open PPrintEngine
-open PPrintCombinators
-
-type constructor = string
-type type_name = string
-type record_field = string
-type tag = int
-
-(* ------------------------------------------------------------------------- *)
-
-(* This internal [sprintf]-like function produces a document. We use [string],
-   as opposed to [arbitrary_string], because the strings that we produce will
-   never contain a newline character. *)
-
-let dsprintf format = 
-  ksprintf string format
-
-(* ------------------------------------------------------------------------- *)
-
-(* Nicolas prefers using this code as opposed to just [sprintf "%g"] or
-   [sprintf "%f"]. The latter print [inf] and [-inf], whereas OCaml
-   understands [infinity] and [neg_infinity]. [sprintf "%g"] does not add a
-   trailing dot when the number happens to be an integral number.  [sprintf
-   "%F"] seems to lose precision and ignores the precision modifier. *)
-
-let valid_float_lexeme (s : string) : string =
-  let l = String.length s in
-  let rec loop i =
-    if i >= l then
-      (* If we reach the end of the string and have found only characters in
-	 the set '0' .. '9' and '-', then this string will be considered as an
-	 integer literal by OCaml. Adding a trailing dot makes it a float
-	 literal. *)
-      s ^ "."
-    else
-      match s.[i] with
-      | '0' .. '9' | '-' -> loop (i + 1)
-      | _ -> s
-  in loop 0
-
-(* This function constructs a string representation of a floating point
-   number. This representation is supposed to be accepted by OCaml as a
-   valid floating point literal. *)
-
-let float_representation (f : float) : string =
-  match classify_float f with
-  | FP_nan ->
-    "nan"
-  | FP_infinite ->
-      if f < 0.0 then "neg_infinity" else "infinity"
-  | _ ->
-      (* Try increasing precisions and validate. *)
-      let s = sprintf "%.12g" f in
-      if f = float_of_string s then valid_float_lexeme s else
-      let s = sprintf "%.15g" f in
-      if f = float_of_string s then valid_float_lexeme s else
-      sprintf "%.18g" f
-
-(* ------------------------------------------------------------------------- *)
-
-(* A few constants and combinators, used below. *)
-
-let some =
-  string "Some"
-
-let none =
-  string "None"
-
-let lbracketbar =
-  string "[|"
-
-let rbracketbar =
-  string "|]"
-
-let seq1 opening separator closing =
-  surround_separate 2 0 (opening ^^ closing) opening (separator ^^ break 1) closing
-
-let seq2 opening separator closing =
-  surround_separate_map 2 1 (opening ^^ closing) opening (separator ^^ break 1) closing
-
-(* ------------------------------------------------------------------------- *)
-
-(* The following functions are printers for many types of OCaml values. *)
-
-(* There is no protection against cyclic values. *)
-
-type representation =
-    document
-
-let tuple =
-  seq1 lparen comma rparen
-
-let variant _ cons _ args =
-  match args with
-  | [] ->
-      !^cons
-  | _ :: _ ->
-      !^cons ^^ tuple args
-
-let record _ fields =
-  seq2 lbrace semi rbrace (fun (k, v) -> infix 2 1 equals !^k v) fields
-
-let option f = function
-  | None ->
-      none
-  | Some x ->
-      some ^^ tuple [f x]
-
-let list f xs =
-  seq2 lbracket semi rbracket f xs
-
-let array f xs =
-  seq2 lbracketbar semi rbracketbar f (Array.to_list xs)
-
-let ref f x =
-  record "ref" ["contents", f !x]
-
-let float f =
-  string (float_representation f)
-
-let int =
-  dsprintf "%d"
-
-let int32 =
-  dsprintf "%ld"
-
-let int64 =
-  dsprintf "%Ld"
-
-let nativeint =
-  dsprintf "%nd"
-
-let char =
-  dsprintf "%C"
-
-let bool =
-  dsprintf "%B"
-
-let string =
-  dsprintf "%S"
-
-let unknown tyname _ =
-  dsprintf "<abstr:%s>" tyname
-
diff --git a/src/pprint/src/PPrintOCaml.mli b/src/pprint/src/PPrintOCaml.mli
deleted file mode 100644
index 119bca23..00000000
--- a/src/pprint/src/PPrintOCaml.mli
+++ /dev/null
@@ -1,90 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** A set of functions that construct representations of OCaml values. *)
-
-(** The string representations produced by these functions are supposed to be
-    accepted by the OCaml parser as valid values. *)
-
-(** The signature of this module is compatible with that expected by
-    the [camlp4] generator [Camlp4RepresentationGenerator]. *)
-
-(** These functions do {i not} distinguish between mutable and immutable
-    values. They do {i not} recognize sharing, and do {i not} incorporate a
-    protection against cyclic values. *)
-
-type constructor = string
-type type_name = string
-type record_field = string
-type tag = int
-
-(** A representation of a value is a [PPrint] document. *)
-type representation =
-    PPrintEngine.document
-
-(** [variant _ dc _ args] is a description of a constructed value whose data
-    constructor is [dc] and whose arguments are [args]. The other two
-    parameters are presently unused. *)
-val variant : type_name -> constructor -> tag -> representation list -> representation
-
-(** [record _ fields] is a description of a record value whose fields are
-    [fields]. The other parameter is presently unused. *)
-val record : type_name -> (record_field * representation) list -> representation
-
-(** [tuple args] is a description of a tuple value whose components are [args]. *)
-val tuple : representation list -> representation
-
-(** [string s] is a representation of the string [s]. *)
-val string : string -> representation
-
-(** [int i] is a representation of the integer [i]. *)
-val int : int -> representation
-
-(** [int32 i] is a representation of the 32-bit integer [i]. *)
-val int32 : int32 -> representation
-
-(** [int64 i] is a representation of the 64-bit integer [i]. *)
-val int64 : int64 -> representation
-
-(** [nativeint i] is a representation of the native integer [i]. *)
-val nativeint : nativeint -> representation
-
-(** [float f] is a representation of the floating-point number [f]. *)
-val float : float -> representation
-
-(** [char c] is a representation of the character [c]. *)
-val char : char -> representation
-
-(** [bool b] is a representation of the Boolenan value [b]. *)
-val bool : bool -> representation
-
-(** [option f o] is a representation of the option [o], where the
-    representation of the element, if present, is computed by the function
-    [f]. *)
-val option : ('a -> representation) -> 'a option -> representation
-
-(** [list f xs] is a representation of the list [xs], where the representation
-    of each element is computed by the function [f]. *)
-val list : ('a -> representation) -> 'a list -> representation
-
-(** [array f xs] is a representation of the array [xs], where the
-    representation of each element is computed by the function [f]. *)
-val array : ('a -> representation) -> 'a array -> representation
-
-(** [ref r] is a representation of the reference [r], where the
-    representation of the content is computed by the function [f]. *)
-val ref : ('a -> representation) -> 'a ref -> representation
-
-(** [unknown t _] is a representation of an unknown value of type [t]. *)
-val unknown : type_name -> 'a -> representation
-
diff --git a/src/pprint/src/PPrintRenderer.ml b/src/pprint/src/PPrintRenderer.ml
deleted file mode 100644
index 3449d6c3..00000000
--- a/src/pprint/src/PPrintRenderer.ml
+++ /dev/null
@@ -1,37 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** A common signature for the multiple document renderers proposed by {!PPrintEngine}. *)
-
-module type RENDERER = sig
-  
-  (** Output channels. *)
-  type channel
-
-  (** Documents. *)
-  type document
-
-  (** [pretty rfrac width channel document] pretty-prints the document
-      [document] into the output channel [channel]. The parameter [width] is
-      the maximum number of characters per line. The parameter [rfrac] is the
-      ribbon width, a fraction relative to [width]. The ribbon width is the
-      maximum number of non-indentation characters per line. *)
-  val pretty: float -> int -> channel -> document -> unit
-
-  (** [compact channel document] prints the document [document] to the output
-      channel [channel]. No indentation is used. All newline instructions are
-      respected, that is, no groups are flattened. *)
-  val compact: channel -> document -> unit
-
-end
-
diff --git a/src/pprint/src/PPrintTest.ml b/src/pprint/src/PPrintTest.ml
deleted file mode 100644
index 37444127..00000000
--- a/src/pprint/src/PPrintTest.ml
+++ /dev/null
@@ -1,64 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  PPrint                                                                *)
-(*                                                                        *)
-(*  François Pottier, Inria Paris                                         *)
-(*  Nicolas Pouillard                                                     *)
-(*                                                                        *)
-(*  Copyright 2007-2017 Inria. All rights reserved. This file is          *)
-(*  distributed under the terms of the GNU Library General Public         *)
-(*  License, with an exception, as described in the file LICENSE.         *)
-(*                                                                        *)
-(**************************************************************************)
-
-open PPrint
-
-(* This is a test file. It is not, strictly speaking, part of the library. *)
-
-let paragraph (s : string) =
-  flow (break 1) (words s)
-
-let document =
-  prefix 2 1
-    (string "TITLE:")
-    (string "PPrint")
-  ^^
-  hardline
-  ^^
-  prefix 2 1
-    (string "AUTHORS:")
-    (utf8string "François Pottier and Nicolas Pouillard")
-  ^^
-  hardline
-  ^^
-  prefix 2 1
-    (string "ABSTRACT:")
-    (
-      paragraph "This is an adaptation of Daan Leijen's \"PPrint\" library,
-        which itself is based on the ideas developed by Philip Wadler in
-        \"A Prettier Printer\". For more information about Wadler's and Leijen's work,
-        please consult the following references:"
-      ^^
-      nest 2 (
-	twice (break 1)
-	^^
-	separate_map (break 1) (fun s -> nest 2 (url s)) [
-	  "http://www.cs.uu.nl/~daan/pprint.html";
-	  "http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf";
-	]
-      )
-      ^^
-      twice (break 1)
-      ^^
-      paragraph "To install PPrint, type \"make -C src install\". ocamlfind is required."
-      ^^
-      twice (break 1)
-      ^^
-      paragraph "The documentation for PPrint is built by \"make doc\" and is found in the file doc/index.html."
-    )
-  ^^
-  hardline
-
-let () =
-  ToChannel.pretty 0.5 80 stdout document;
-  flush stdout
diff --git a/src/pretty_print_coq.ml b/src/pretty_print_coq.ml
index 3a37d9ff..17dba718 100644
--- a/src/pretty_print_coq.ml
+++ b/src/pretty_print_coq.ml
@@ -93,7 +93,7 @@ type context = {
   kid_renames : kid KBindings.t; (* Plain tyvar -> tyvar renames,
                                     used to avoid variable/type variable name clashes *)
   (* Note that as well as these kid renames, we also attempt to replace entire
-     n_constraints with equivalent variables in doc_nc_prop and doc_nc_exp. *)
+     n_constraints with equivalent variables in doc_nc_exp. *)
   kid_id_renames : (id option) KBindings.t; (* tyvar -> argument renames *)
   kid_id_renames_rev : kid Bindings.t; (* reverse of kid_id_renames *)
   bound_nvars : KidSet.t;
@@ -388,16 +388,12 @@ match nc1, nc2 with
 | _,_ -> mk_nc (NC_app (mk_id "iff",[arg_bool nc1; arg_bool nc2]))
 
 (* n_constraint functions are currently just Z3 functions *)
-let doc_nc_fn_prop id =
-  match string_of_id id with
-  | "not" -> string "not"
-  | _ -> doc_id_type id
-
-(* n_constraint functions are currently just Z3 functions *)
-let doc_nc_fn id =
-  match string_of_id id with
-  | "not" -> string "negb"
-  | s -> string s
+let doc_nc_fn (Id_aux (id,_) as full_id) =
+  match id with
+  | Id "not" -> string "negb"
+  | Operator "-->" -> string "implb"
+  | Id "iff" -> string "Bool.eqb"
+  | _ -> doc_id full_id
 
 let merge_kid_count = KBindings.union (fun _ m n -> Some (m+n))
 
@@ -622,7 +618,7 @@ let rec doc_typ_fns ctx env =
          | Bool_boring -> string "bool"
          | Bool_complex (_,_,atom_nc) -> (* simplify won't introduce new kopts *)
             let var = mk_kid "_bool" in (* TODO collision avoid *)
-            let nc = nice_iff (nc_var var) atom_nc in
+            let nc = nice_iff atom_nc (nc_var var) in
             braces (separate space
                       [doc_var ctx var; colon; string "bool";
                        ampersand;
@@ -676,7 +672,7 @@ let rec doc_typ_fns ctx env =
              let length_constraint_pp =
                if KidSet.is_empty (KidSet.inter kid_set (nexp_frees m))
                then None
-               else Some (separate space [len_pp; doc_var ctx var; equals; doc_nexp ctx m])
+               else Some (separate space [len_pp; doc_var ctx var; string "=?"; doc_nexp ctx m])
              in
              braces (separate space
                        [doc_var ctx var; colon; tpp;
@@ -694,7 +690,7 @@ let rec doc_typ_fns ctx env =
              let length_constraint_pp =
                if KidSet.is_empty (KidSet.inter kid_set (nexp_frees m))
                then None
-               else Some (separate space [len_pp; doc_var ctx var; equals; doc_nexp ctx m])
+               else Some (separate space [len_pp; doc_var ctx var; string "=?"; doc_nexp ctx m])
              in
              braces (separate space
                        [doc_var ctx var; colon; tpp;
@@ -705,7 +701,7 @@ let rec doc_typ_fns ctx env =
              | Bool_boring -> string "bool"
              | Bool_complex (kopts,nc,atom_nc) ->
                 let var = mk_kid "_bool" in (* TODO collision avoid *)
-                let nc = nice_and (nice_iff (nc_var var) atom_nc) nc in
+                let nc = nice_and (nice_iff atom_nc (nc_var var)) nc in
                 braces (separate space
                           [doc_var ctx var; colon; string "bool";
                            ampersand;
@@ -773,94 +769,26 @@ let rec doc_typ_fns ctx env =
       | A_typ t -> app_typ true t
       | A_nexp n -> doc_nexp ctx n
       | A_order o -> empty
-      | A_bool nc -> doc_nc_prop ~prop_vars ~top:false ctx env nc
+      | A_bool nc -> parens (doc_nc_exp ctx env nc)
   in typ', atomic_typ, doc_typ_arg
 and doc_typ ctx env = let f,_,_ = doc_typ_fns ctx env in f
 and doc_atomic_typ ctx env = let _,f,_ = doc_typ_fns ctx env in f
 and doc_typ_arg ctx env = let _,_,f = doc_typ_fns ctx env in f
 
-and doc_arithfact ?(prop_vars=false) ctxt env ?(exists = []) ?extra nc =
-  let prop = doc_nc_prop ~prop_vars ctxt env nc in
+and doc_arithfact ctxt env ?(exists = []) ?extra nc =
+  let prop = doc_nc_exp ctxt env nc in
   let prop = match extra with
     | None -> prop
-    | Some pp -> separate space [pp; string "/\\"; parens prop]
-  in
-  let prop =
-    match exists with
-    | [] -> prop
-    | _ -> separate space ([string "exists"]@(List.map (doc_var ctxt) exists)@[comma; prop])
+    | Some pp -> separate space [parens pp; string "&&"; parens prop]
   in
-  string "ArithFact" ^^ space ^^ parens prop
-
-(* Follows Coq precedence levels *)
-and doc_nc_prop ?(top = true) ?(prop_vars = false) ctx env nc =
-  let locals = Env.get_locals env |> Bindings.bindings in
-  let nc = Env.expand_constraint_synonyms env nc in
-  let doc_nc_var varpp =
-    if prop_vars then varpp else doc_op equals varpp (string "true")
-  in
-  let nc_id_map =
-    List.fold_left
-      (fun m (v,(_,Typ_aux (typ,_))) ->
-        match typ with
-        | Typ_app (id, [A_aux (A_bool nc,_)]) when string_of_id id = "atom_bool" ->
-           (flatten_nc nc, v)::m
-        | _ -> m) [] locals
-  in
-  let rec newnc f nc =
-    let ncs = flatten_nc nc in
-    let candidates =
-      Util.map_filter (fun (ncs',id) -> Util.option_map (fun x -> x,id) (list_contains NC.compare ncs ncs')) nc_id_map
-    in
-    match List.sort (fun (l,_) (l',_) -> compare l l') candidates with
-    | ([],id)::_ -> parens (doc_nc_var (doc_id id))
-    | ((h::t),id)::_ -> parens (doc_op (string "/\\") (parens (doc_nc_var (doc_id id))) (l80 (List.fold_left nc_and h t)))
-    | [] -> f nc
-  and l85 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_or (nc1, nc2) -> doc_op (string "\\/") (newnc l80 nc1) (newnc l85 nc2)
-  | _ -> l80 nc_full
-  and l80 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_and (nc1, nc2) -> doc_op (string "/\\") (newnc l70 nc1) (newnc l80 nc2)
-  | _ -> l70 nc_full
-  and l70 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_equal (ne1, ne2) -> doc_op equals (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_var kid -> doc_nc_var (doc_nexp ctx (nvar kid))
-  | NC_bounded_ge (ne1, ne2) -> doc_op (string ">=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_bounded_gt (ne1, ne2) -> doc_op (string ">") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_bounded_le (ne1, ne2) -> doc_op (string "<=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_bounded_lt (ne1, ne2) -> doc_op (string "<") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_not_equal (ne1, ne2) -> doc_op (string "<>") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | _ -> l10 nc_full
-  and l10 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_set (kid, is) ->
-     separate space [string "In"; doc_var ctx kid;
-                     brackets (separate (string "; ")
-                                 (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
-  | NC_app (f,args) -> separate space (doc_nc_fn_prop f::List.map (doc_typ_arg ~prop_vars ctx env) args)
-  | _ -> l0 nc_full
-  and l0 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_true -> string "True"
-  | NC_false -> string "False"
-  | NC_set _
-  | NC_app _
-  | NC_var _
-  | NC_or _
-  | NC_and _
-  | NC_equal _
-  | NC_bounded_ge _
-  | NC_bounded_gt _
-  | NC_bounded_le _
-  | NC_bounded_lt _
-  | NC_not_equal _ -> parens (l85 nc_full)
-  in if top then newnc l85 nc else newnc l0 nc
+  let prop = prop in
+  match exists with
+  | [] -> string "ArithFact" ^^ space ^^ parens prop
+  | _ -> string "ArithFactP" ^^ space ^^
+           parens (separate space ([string "exists"]@(List.map (doc_var ctxt) exists)@[comma; prop; equals; string "true"]))
 
 (* Follows Coq precedence levels *)
-let rec doc_nc_exp ctx env nc =
+and doc_nc_exp ctx env nc =
   let locals = Env.get_locals env |> Bindings.bindings in
   let nc = Env.expand_constraint_synonyms env nc in
   let nc_id_map =
@@ -871,6 +799,9 @@ let rec doc_nc_exp ctx env nc =
            (flatten_nc nc, v)::m
         | _ -> m) [] locals
   in
+  (* Look for variables in the environment which exactly express the nc, and use
+     them instead.  As well as often being shorter, this avoids unbound type
+     variables added by Sail's type checker. *)
   let rec newnc f nc =
     let ncs = flatten_nc nc in
     let candidates =
@@ -903,10 +834,16 @@ let rec doc_nc_exp ctx env nc =
        separate space [string "member_Z_list"; doc_var ctx kid;
                        brackets (separate (string "; ")
                                    (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
+    | NC_app (f,args) -> separate space (doc_nc_fn f::List.map doc_typ_arg_exp args)
+    | _ -> l0 nc_full
+  and l0 (NC_aux (nc,_) as nc_full) =
+    match nc with
     | NC_true -> string "true"
     | NC_false -> string "false"
-    | NC_app (f,args) -> separate space (doc_nc_fn f::List.map (doc_typ_arg_exp ctx env) args)
     | NC_var kid -> doc_nexp ctx (nvar kid)
+    | NC_not_equal _
+    | NC_set _
+    | NC_app _
     | NC_equal _
     | NC_bounded_ge _
     | NC_bounded_gt _
@@ -914,13 +851,13 @@ let rec doc_nc_exp ctx env nc =
     | NC_bounded_lt _
     | NC_or _
     | NC_and _ -> parens (l70 nc_full)
-  in newnc l70 nc
-and doc_typ_arg_exp ctx env (A_aux (arg,l)) =
-  match arg with
-  | A_nexp nexp -> doc_nexp ctx nexp
-  | A_bool nc -> doc_nc_exp ctx env nc
-  | A_order _ | A_typ _ ->
+  and doc_typ_arg_exp (A_aux (arg,l)) =
+    match arg with
+    | A_nexp nexp -> doc_nexp ctx nexp
+    | A_bool nc -> newnc l0 nc
+    | A_order _ | A_typ _ ->
        raise (Reporting.err_unreachable l __POS__ "Tried to pass Type or Order kind to SMT function")
+  in newnc l70 nc
 
 (* Check for variables in types that would be pretty-printed and are not
    bound in the val spec of the function. *)
@@ -971,8 +908,9 @@ let doc_lit (L_aux(lit,l)) =
      let s = Big_int.to_string i in
      let ipp = utf8string s in
      if Big_int.less i Big_int.zero then parens ipp else ipp
-  | L_hex n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0x" ^ n) ^ ")" (*shouldn't happen*)*)
-  | L_bin n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0b" ^ n) ^ ")" (*shouldn't happen*)*)
+  (* Not a typo, the bbv hex notation uses the letter O *)
+  | L_hex n -> utf8string ("Ox\"" ^ n ^ "\"")
+  | L_bin n -> utf8string ("'b\"" ^ n ^ "\"")
   | L_undef ->
      utf8string "(Fail \"undefined value of unsupported type\")"
   | L_string s -> utf8string ("\"" ^ (coq_escape_string s) ^ "\"")
@@ -1024,7 +962,7 @@ let doc_quant_item_constr ?(prop_vars=false) ctx env delimit (QI_aux (qi,_)) =
   match qi with
   | QI_id  _ -> None
   | QI_constant _ -> None
-  | QI_constraint nc -> Some (bquote ^^ braces (doc_arithfact ~prop_vars ctx env nc))
+  | QI_constraint nc -> Some (bquote ^^ braces (doc_arithfact ctx env nc))
 
 (* At the moment these are all anonymous - when used we rely on Coq to fill
    them in. *)
@@ -1187,8 +1125,9 @@ let rec doc_pat ctxt apat_needed exists_as_pairs (P_aux (p,(l,annot)) as pat, ty
          | _::_::_, [Typ_aux (Typ_tup typs,_)] -> typs
          | _,_ -> arg_typs
        in
-       let ppp = doc_unop (doc_id_ctor id)
-         (parens (separate_map comma (doc_pat ctxt true true) (List.combine pats arg_typs))) in
+       let pats_pp = separate_map comma (doc_pat ctxt true true) (List.combine pats arg_typs) in
+       let pats_pp = match pats with [_] -> pats_pp | _ -> parens pats_pp in
+       let ppp = doc_unop (doc_id_ctor id) pats_pp in
        if apat_needed then parens ppp else ppp
      end
      | P_app(id, []) -> doc_id_ctor id
@@ -1877,7 +1816,11 @@ let doc_exp, doc_let =
           in
           let epp =
             if is_ctor
-            then group (hang 2 (call ^^ break 1 ^^ parens (flow (comma ^^ break 1) (List.map2 (doc_arg false) args arg_typs))))
+            then
+              let argspp = match args, arg_typs with
+                | [arg], [arg_typ] -> doc_arg true arg arg_typ
+                | _, _ -> parens (flow (comma ^^ break 1) (List.map2 (doc_arg false) args arg_typs))
+              in group (hang 2 (call ^^ break 1 ^^ argspp))
             else
               let argspp = List.map2 (doc_arg true) args arg_typs in
               let all =
@@ -2333,7 +2276,8 @@ let doc_exp, doc_let =
         "unsupported internal expression encountered while pretty-printing")
   and if_exp ctxt (elseif : bool) c t e =
     let if_pp = string (if elseif then "else if" else "if") in
-    let c_pp = top_exp ctxt true c in
+    let use_sumbool = condition_produces_constraint ctxt c in
+    let c_pp = top_exp ctxt use_sumbool c in
     let t_pp = top_exp ctxt false t in
     let else_pp = match e with
       | E_aux (E_if (c', t', e'), _)
@@ -2347,8 +2291,8 @@ let doc_exp, doc_let =
     in
     (prefix 2 1
       (soft_surround 2 1 if_pp
-         ((if condition_produces_constraint ctxt c then string "sumbool_of_bool" ^^ space else empty)
-          ^^ parens c_pp) (string "then"))
+         (if use_sumbool then string "sumbool_of_bool" ^/^ c_pp else c_pp)
+         (string "then"))
       t_pp) ^^
     break 1 ^^
     else_pp
@@ -2366,7 +2310,9 @@ let doc_exp, doc_let =
        prefix 2 1
               (separate space [string "let"; doc_id id; colon; doc_typ ctxt (env_of e) typ; coloneq])
               (top_exp ctxt false e)
-    | LB_val(P_aux (P_typ (typ,P_aux (P_id id,_)),_),e)
+    | (LB_val(P_aux (P_typ (_,P_aux (P_id id,_)),_),e)
+       | LB_val(P_aux (P_var (P_aux (P_id id,_),_),_), e)
+       | LB_val(P_aux (P_typ (_,P_aux (P_var (P_aux (P_id id,_),_),_)),_), e))
       when (* is auto decomposed *)
            not (is_enum (env_of e) id) ->
        prefix 2 1
@@ -2515,9 +2461,9 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) =
      let idpp = doc_id_type id in
      doc_op coloneq
        (separate space [string "Definition"; idpp;
-                        doc_typquant_items ~prop_vars:true empty_ctxt Env.empty parens typq;
-                        colon; string "Prop"])
-       (doc_nc_prop ~prop_vars:true empty_ctxt Env.empty nc) ^^ dot ^^ hardline ^^
+                        doc_typquant_items empty_ctxt Env.empty parens typq;
+                        colon; string "bool"])
+       (doc_nc_exp empty_ctxt Env.empty nc) ^^ dot ^^ hardline ^^
      separate space [string "Hint Unfold"; idpp; colon; string "sail."] ^^
      twice hardline
   | TD_abbrev _ -> empty (* TODO? *)
@@ -2538,24 +2484,31 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) =
         mk_typ (Typ_app (id, targs))
       | TypQ_aux (TypQ_no_forall, _) -> mk_id_typ id in
     let fs_doc = group (separate_map (break 1) f_pp fs) in
+    let type_id_pp = doc_id_type id in
+    let match_parameters =
+      let (kopts,_) = quant_split typq in
+      match kopts with
+      | [] -> empty
+      | _ -> space ^^ separate_map space (fun _ -> underscore) kopts
+    in
     let doc_update_field (_,fid) =
       let idpp = fname fid in
-      let otherfield (_,fid') =
-        if Id.compare fid fid' == 0 then None else
-          let idpp = fname fid' in
-          Some (separate space [idpp; string ":="; idpp; string "r"])
+      let pp_field alt i (_,fid') =
+        if Id.compare fid fid' == 0 then string alt else
+          let id = "f" ^ string_of_int i in
+          string id
       in
       match fs with
       | [_] ->
          string "Notation \"{[ r 'with' '" ^^ idpp ^^ string "' := e ]}\" :=" ^//^
            string "{| " ^^ idpp ^^ string " := e |} (only parsing)."
       | _   ->
-         string "Notation \"{[ r 'with' '" ^^ idpp ^^ string "' := e ]}\" := {|" ^//^
-           idpp ^^ string " := e;" ^/^ separate (semi ^^ break 1) (Util.map_filter otherfield fs) ^/^
-             string "|}" ^^ dot
+         string "Notation \"{[ r 'with' '" ^^ idpp ^^ string "' := e ]}\" :=" ^//^
+           string "match r with Build_" ^^ type_id_pp ^^ match_parameters ^^ space ^^ separate space (List.mapi (pp_field "_") fs) ^^ string " =>" ^//^
+           string "Build_" ^^ type_id_pp ^^ match_parameters ^^ space ^^ separate space (List.mapi (pp_field "e") fs) ^//^
+             string "end" ^^ dot
     in
     let updates_pp = separate hardline (List.map doc_update_field fs) in
-    let id_pp = doc_id_type id in
     let numfields = List.length fs in
     let intros_pp s =
       string " intros [" ^^
@@ -2564,8 +2517,8 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) =
     in
     let eq_pp =
       if IdSet.mem id generic_eq_types then
-        string "Instance Decidable_eq_" ^^ id_pp ^^ space ^^ colon ^/^
-        string "forall (x y : " ^^ id_pp ^^ string "), Decidable (x = y)." ^^
+        string "Instance Decidable_eq_" ^^ type_id_pp ^^ space ^^ colon ^/^
+        string "forall (x y : " ^^ type_id_pp ^^ string "), Decidable (x = y)." ^^
         hardline ^^ intros_pp "x" ^^ intros_pp "y" ^^
         separate hardline (list_init numfields
                              (fun n ->
@@ -2576,9 +2529,9 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) =
         string "Defined." ^^ twice hardline
       else empty
     in
-    let reset_implicits_pp = doc_reset_implicits id_pp typq in
+    let reset_implicits_pp = doc_reset_implicits type_id_pp typq in
     doc_op coloneq
-           (separate space [string "Record"; id_pp; doc_typquant_items empty_ctxt Env.empty braces typq])
+           (separate space [string "Record"; type_id_pp; doc_typquant_items empty_ctxt Env.empty braces typq])
            ((*doc_typquant typq*) (braces (space ^^ align fs_doc ^^ space))) ^^
       dot ^^ hardline ^^ reset_implicits_pp ^^ hardline ^^ eq_pp ^^ updates_pp ^^
         twice hardline
@@ -2743,7 +2696,7 @@ let rec atom_constraint ctxt (pat, typ) =
            None
      | _ ->
         Some (bquote ^^ braces (string "ArithFact" ^^ space ^^
-                                  parens (doc_op equals (doc_id id) (doc_nexp ctxt nexp)))))
+                                  parens (doc_op (string "=?") (doc_id id) (doc_nexp ctxt nexp)))))
   | P_aux (P_typ (_,p),_), _ -> atom_constraint ctxt (p, typ)
   | _ -> None
 
@@ -3205,7 +3158,7 @@ let doc_axiom_typschm typ_env l (tqs,typ) =
           let v = fresh_var () in
           parens (v ^^ string " : Z") ^/^
             bquote ^^ braces (string "ArithFact " ^^
-                                parens (v ^^ string " = " ^^ string (Big_int.to_string n)))
+                                parens (v ^^ string " =? " ^^ string (Big_int.to_string n)))
        | _ ->
           match Type_check.destruct_atom_bool typ_env typ with
           | Some (NC_aux (NC_var kid,_)) when KidSet.mem kid args ->
@@ -3377,6 +3330,7 @@ try
         hardline;
         string "Open Scope string."; hardline;
         string "Open Scope bool."; hardline;
+        string "Open Scope Z."; hardline;
         hardline;
         hardline;
         separate empty (List.map doc_def defs);
diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml
index d399ec29..993934f5 100644
--- a/src/pretty_print_lem.ml
+++ b/src/pretty_print_lem.ml
@@ -415,22 +415,24 @@ let doc_tannot_lem ctxt env eff typ =
 let min_int32 = Big_int.of_int64 (Int64.of_int32 Int32.min_int)
 let max_int32 = Big_int.of_int64 (Int64.of_int32 Int32.max_int)
 
-let doc_lit_lem (L_aux(lit,l)) =
+let rec doc_lit_lem (L_aux(lit,l)) =
   match lit with
   | L_unit  -> utf8string "()"
   | L_zero  -> utf8string "B0"
   | L_one   -> utf8string "B1"
   | L_false -> utf8string "false"
   | L_true  -> utf8string "true"
-  | L_num i when Big_int.less_equal min_int32 i && Big_int.less_equal i max_int32 ->
+  | L_num i ->
      let ipp = Big_int.to_string i in
      utf8string (
        if Big_int.less i Big_int.zero then "((0"^ipp^"):ii)"
        else "("^ipp^":ii)")
-  | L_num i ->
-     utf8string (Printf.sprintf "(integerOfString \"%s\")" (Big_int.to_string i))
-  | L_hex n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0x" ^ n) ^ ")" (*shouldn't happen*)*)
-  | L_bin n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0b" ^ n) ^ ")" (*shouldn't happen*)*)
+  | L_hex n when !opt_mwords -> utf8string ("0x" ^ n)
+  | L_bin n when !opt_mwords -> utf8string ("0b" ^ n)
+  | L_hex _ | L_bin _ ->
+     vector_string_to_bit_list (L_aux(lit,l))
+     |> flow_map (semi ^^ break 0) doc_lit_lem
+     |> group |> align |> brackets
   | L_undef ->
      utf8string "(return (failwith \"undefined value of unsupported type\"))"
   | L_string s -> utf8string ("\"" ^ (String.escaped s) ^ "\"")
@@ -872,8 +874,14 @@ let doc_exp_lem, doc_let_lem =
        else if Env.is_register id env && is_regtyp (typ_of full_exp) env then doc_id_lem (append_id id "_ref")
        else if is_ctor env id then doc_id_lem_ctor id
        else doc_id_lem id
-    | E_lit lit -> doc_lit_lem lit
-    | E_cast(typ,e) -> expV aexp_needed e
+    | E_lit lit ->
+       let env = env_of full_exp in
+       let typ = Env.expand_synonyms env (typ_of full_exp) in
+       let eff = effect_of full_exp in
+       if typ_needs_printed typ
+       then parens (doc_lit_lem lit ^^ doc_tannot_lem ctxt env (effectful eff) typ)
+       else doc_lit_lem lit
+    | E_cast (typ,e) -> expV aexp_needed e (*parens (expN e ^^ doc_tannot_lem ctxt (env_of full_exp) (effectful (effect_of full_exp)) typ)*)
     | E_tuple exps ->
        parens (align (group (separate_map (comma ^^ break 1) expN exps)))
     | E_record fexps ->
diff --git a/src/pretty_print_sail.ml b/src/pretty_print_sail.ml
index b3675263..7e98f4e3 100644
--- a/src/pretty_print_sail.ml
+++ b/src/pretty_print_sail.ml
@@ -170,6 +170,8 @@ let rec doc_nc nc =
   in
   atomic_nc (constraint_simp nc)
 
+and doc_effects effs = braces (separate (comma ^^ space) (List.map (fun be -> string (string_of_base_effect be)) effs))
+
 and doc_typ ?(simple=false) (Typ_aux (typ_aux, l)) =
   match typ_aux with
   | Typ_id id -> doc_id id
@@ -194,13 +196,14 @@ and doc_typ ?(simple=false) (Typ_aux (typ_aux, l)) =
   | Typ_fn (typs, typ, Effect_aux (Effect_set [], _)) ->
      separate space [doc_arg_typs typs; string "->"; doc_typ typ]
   | Typ_fn (typs, typ, Effect_aux (Effect_set effs, _)) ->
-     let ocaml_eff = braces (separate (comma ^^ space) (List.map (fun be -> string (string_of_base_effect be)) effs)) in
      if simple then
        separate space [doc_arg_typs typs; string "->"; doc_typ ~simple:simple typ]
      else
-       separate space [doc_arg_typs typs; string "->"; doc_typ typ; string "effect"; ocaml_eff]
-  | Typ_bidir (typ1, typ2) ->
+       separate space [doc_arg_typs typs; string "->"; doc_typ typ; string "effect"; doc_effects effs]
+  | Typ_bidir (typ1, typ2, Effect_aux (Effect_set [], _)) ->
      separate space [doc_typ typ1; string "<->"; doc_typ typ2]
+  | Typ_bidir (typ1, typ2, Effect_aux (Effect_set effs, _)) ->
+     separate space [doc_typ typ1; string "<->"; doc_typ typ2; string "effect"; doc_effects effs]
   | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
 and doc_typ_arg (A_aux (ta_aux, _)) =
   match ta_aux with
@@ -502,7 +505,11 @@ and doc_atomic_exp (E_aux (e_aux, _) as exp) =
      brackets (separate space [doc_exp exp1; string "with"; doc_atomic_exp exp2; equals; doc_exp exp3])
   | E_vector_update_subrange (exp1, exp2, exp3, exp4) ->
      brackets (separate space [doc_exp exp1; string "with"; doc_atomic_exp exp2; string ".."; doc_atomic_exp exp3; equals; doc_exp exp4])
-  | E_internal_value v -> string (Value.string_of_value v (* |> Util.green |> Util.clear *))
+  | E_internal_value v ->
+     if !Interactive.opt_interactive then
+       string (Value.string_of_value v |> Util.green |> Util.clear)
+     else
+       string (Value.string_of_value v)
   | _ -> parens (doc_exp exp)
 and doc_fexps fexps =
   separate_map (comma ^^ space) doc_fexp fexps
@@ -623,6 +630,12 @@ let doc_field (typ, id) =
 
 let doc_union (Tu_aux (Tu_ty_id (typ, id), l)) = separate space [doc_id id; colon; doc_typ typ]
 
+let rec doc_index_range (BF_aux (ir, _)) =
+  match ir with
+  | BF_single i -> doc_nexp i
+  | BF_range (i, j) -> doc_nexp i ^^ string ".." ^^ doc_nexp j
+  | BF_concat (i, j) -> doc_index_range i ^^ comma ^^ space ^^ doc_index_range j
+
 let doc_typ_arg_kind sep (A_aux (aux, _)) =
   match aux with
   | A_nexp _ -> space ^^ string sep ^^ space ^^string "Int"
@@ -651,7 +664,10 @@ let doc_typdef (TD_aux(td,_)) = match td with
   | TD_variant (id, TypQ_aux (TypQ_tq qs, _), unions, _) ->
      separate space [string "union"; doc_id id; doc_param_quants qs; equals;
                      surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_union unions) rbrace]
-  | TD_bitfield _ -> string "BITFIELD" (* should be rewritten *)
+  | TD_bitfield (id, typ, fields) ->
+     let doc_field (id, range) = separate space [doc_id id; colon; doc_index_range range] in
+     doc_op equals (separate space [string "bitfield"; doc_id id; colon; doc_typ typ])
+                   (surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_field fields) rbrace)
 
 let doc_spec ?comment:(comment=false) (VS_aux (v, annot)) =
   let doc_extern ext =
diff --git a/src/process_file.ml b/src/process_file.ml
index eeb7c0d7..d2a86595 100644
--- a/src/process_file.ml
+++ b/src/process_file.ml
@@ -56,6 +56,8 @@ let opt_isa_output_dir = ref None
 let opt_coq_output_dir = ref None
 let opt_alt_modules_coq = ref ([]:string list)
 let opt_alt_modules2_coq = ref ([]:string list)
+let opt_memo_z3 = ref false
+let opt_file_out : string option ref = ref None
 
 type out_type =
   | Lem_out of string list
@@ -71,7 +73,6 @@ let get_lexbuf f =
   lexbuf, in_chan
 
 let parse_file ?loc:(l=Parse_ast.Unknown) (f : string) : Parse_ast.defs =
-  let open Reporting in
   try
     let lexbuf, in_chan = get_lexbuf f in
     begin
@@ -82,12 +83,12 @@ let parse_file ?loc:(l=Parse_ast.Unknown) (f : string) : Parse_ast.defs =
       | Parser.Error ->
          let pos = Lexing.lexeme_start_p lexbuf in
          let tok = Lexing.lexeme lexbuf in
-         raise (Fatal_error (Err_syntax (pos, "current token: " ^ tok)))
-      | Lexer.LexError(s,p) ->
-         raise (Fatal_error (Err_lex (p, s)))
+         raise (Reporting.err_syntax pos ("current token: " ^ tok))
+      | Lexer.LexError (s, p) ->
+         raise (Reporting.err_lex p s)
     end
   with
-  | Sys_error err -> raise (err_general l err)
+  | Sys_error err -> raise (Reporting.err_general l err)
 
 (* Simple preprocessor features for conditional file loading *)
 module StringSet = Set.Make(String)
@@ -239,12 +240,6 @@ let rec preprocess opts = function
 
 let preprocess_ast opts (Parse_ast.Defs defs) = Parse_ast.Defs (preprocess opts defs)
 
-let load_file_no_check opts order f = Initial_check.process_ast (preprocess_ast opts (parse_file f))
-
-let load_file opts order env f =
-  let ast = Initial_check.process_ast (preprocess_ast opts (parse_file f)) in
-  Type_error.check env ast
-
 let opt_just_check = ref false
 let opt_ddump_tc_ast = ref false
 let opt_ddump_rewrite_ast = ref None
@@ -257,6 +252,33 @@ let check_ast (env : Type_check.Env.t) (defs : unit Ast.defs) : Type_check.tanno
   let () = if !opt_just_check then exit 0 else () in
   (ast, env)
 
+let load_files ?check:(check=false) options type_envs files =
+  if !opt_memo_z3 then Constraint.load_digests () else ();
+
+  let t = Profile.start () in
+  let parsed = List.map (fun f -> (f, parse_file f)) files in
+  let ast =
+    List.fold_right (fun (_, Parse_ast.Defs ast_nodes) (Parse_ast.Defs later_nodes)
+                     -> Parse_ast.Defs (ast_nodes@later_nodes)) parsed (Parse_ast.Defs []) in
+  let ast = preprocess_ast options ast in
+  let ast = Initial_check.process_ast ~generate:(not check) ast in
+  (* The separate loop measures declarations would be awkward to type check, so
+     move them into the definitions beforehand. *)
+  let ast = Rewrites.move_loop_measures ast in
+  Profile.finish "parsing" t;
+
+  let t = Profile.start () in
+  let (ast, type_envs) = check_ast type_envs ast in
+  Profile.finish "type checking" t;
+
+  if !opt_memo_z3 then Constraint.save_digests () else ();
+
+  let out_name = match !opt_file_out with
+    | None when parsed = [] -> "out.sail"
+    | None -> fst (List.hd parsed)
+    | Some f -> f ^ ".sail" in
+
+  (out_name, ast, type_envs)
 
 let open_output_with_check opt_dir file_name =
   let (temp_file_name, o) = Filename.open_temp_file "ll_temp" "" in
@@ -349,12 +371,12 @@ let output_coq opt_dir filename alt_modules alt_modules2 libs defs =
     (match alt_modules with
     | [] -> base_imports_default
     | _ -> Str.split (Str.regexp "[ \t]+") (String.concat " " alt_modules)
-    ) in  
+    ) in
   let alt_modules2_imports =
     (match alt_modules2 with
     | [] -> []
     | _ -> Str.split (Str.regexp "[ \t]+") (String.concat " " alt_modules2)
-    ) in  
+    ) in
   let ((ot,_,_,_) as ext_ot) =
     open_output_with_check_unformatted opt_dir (filename ^ "_types" ^ ".v") in
   let ((o,_,_,_) as ext_o) =
@@ -414,3 +436,10 @@ let rewrite_ast_initial env = rewrite env [("initial", fun env defs -> Rewriter.
 let rewrite_ast_target tgt env = rewrite env (Rewrites.rewrite_defs_target tgt)
 
 let rewrite_ast_check env = rewrite env Rewrites.rewrite_defs_check
+
+let descatter type_envs ast =
+  let ast = Scattered.descatter ast in
+  let ast, type_envs = rewrite_ast_initial type_envs ast in
+  (* Recheck after descattering so that the internal type environments
+     always have complete variant types *)
+  Type_error.check Type_check.initial_env ast
diff --git a/src/process_file.mli b/src/process_file.mli
index fa0aeb31..d1fa2cb8 100644
--- a/src/process_file.mli
+++ b/src/process_file.mli
@@ -61,9 +61,8 @@ val rewrite_ast_initial : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type
 val rewrite_ast_target : string -> Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t
 val rewrite_ast_check : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t
 
-val load_file_no_check : (Arg.key * Arg.spec * Arg.doc) list -> Ast.order -> string -> unit Ast.defs
-val load_file : (Arg.key * Arg.spec * Arg.doc) list -> Ast.order -> Type_check.Env.t -> string -> Type_check.tannot Ast.defs * Type_check.Env.t
-
+val opt_file_out : string option ref
+val opt_memo_z3 : bool ref
 val opt_just_check : bool ref
 val opt_ddump_tc_ast : bool ref
 val opt_ddump_rewrite_ast : ((string * int) option) ref
@@ -90,3 +89,7 @@ val output :
     files existed before. If it is set to [false] and an output file already exists,
     the output file is only updated, if its content really changes. *)
 val always_replace_files : bool ref
+
+val load_files : ?check:bool -> (Arg.key * Arg.spec * Arg.doc) list -> Type_check.Env.t -> string list -> (string * Type_check.tannot Ast.defs * Type_check.Env.t)
+
+val descatter : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t
diff --git a/src/property.ml b/src/property.ml
index 955e755d..83594f4f 100644
--- a/src/property.ml
+++ b/src/property.ml
@@ -132,7 +132,7 @@ type query =
    | Q_or of query list
 
 let default_query =
-  Q_or [Q_and [Q_all Assertion; Q_all Return; Q_not (Q_exist Match)]; Q_exist Overflow; Q_not (Q_all Assumption)]
+  Q_or [Q_and [Q_not (Q_exist Assertion); Q_all Return; Q_not (Q_exist Match)]; Q_exist Overflow; Q_not (Q_all Assumption)]
 
 module Event = struct
   type t = event
diff --git a/src/reporting.ml b/src/reporting.ml
index e89ce396..d5e3003c 100644
--- a/src/reporting.ml
+++ b/src/reporting.ml
@@ -132,19 +132,19 @@ let print_err l m1 m2 =
 
 type error =
   | Err_general of Parse_ast.l * string
-  | Err_unreachable of Parse_ast.l * (string * int * int * int) * string
+  | Err_unreachable of Parse_ast.l * (string * int * int * int) * Printexc.raw_backtrace * string
   | Err_todo of Parse_ast.l * string
   | Err_syntax of Lexing.position * string
   | Err_syntax_loc of Parse_ast.l * string
   | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
 
-let issues = "\n\nPlease report this as an issue on GitHub at https://github.com/rems-project/sail/issues"
+let issues = "\nPlease report this as an issue on GitHub at https://github.com/rems-project/sail/issues"
 
 let dest_err = function
   | Err_general (l, m) -> ("Error", Loc l, m)
-  | Err_unreachable (l, (file, line, _, _), m) ->
-     (Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line, Loc l, m ^ issues)
+  | Err_unreachable (l, (file, line, _, _), backtrace, m) ->
+     (Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line, Loc l, m ^ "\n\n" ^ Printexc.raw_backtrace_to_string backtrace ^ issues)
   | Err_todo (l, m) -> ("Todo", Loc l, m)
   | Err_syntax (p, m) -> ("Syntax error", Pos p, m)
   | Err_syntax_loc (l, m) -> ("Syntax error", Loc l, m)
@@ -155,10 +155,14 @@ exception Fatal_error of error
 
 (* Abbreviations for the very common cases *)
 let err_todo l m = Fatal_error (Err_todo (l, m))
-let err_unreachable l ocaml_pos m = Fatal_error (Err_unreachable (l, ocaml_pos, m))
+let err_unreachable l ocaml_pos m =
+  let backtrace = Printexc.get_callstack 10 in
+  Fatal_error (Err_unreachable (l, ocaml_pos, backtrace, m))
 let err_general l m = Fatal_error (Err_general (l, m))
-let err_typ l m = Fatal_error (Err_type (l,m))
+let err_typ l m = Fatal_error (Err_type (l, m))
+let err_syntax p m = Fatal_error (Err_syntax (p, m))
 let err_syntax_loc l m = Fatal_error (Err_syntax_loc (l, m))
+let err_lex p m = Fatal_error (Err_lex (p, m))
 
 let unreachable l pos msg =
   raise (err_unreachable l pos msg)
diff --git a/src/reporting.mli b/src/reporting.mli
index 0bdff5ca..e0744c66 100644
--- a/src/reporting.mli
+++ b/src/reporting.mli
@@ -74,8 +74,7 @@ val simp_loc : Ast.l -> (Lexing.position * Lexing.position) option
 val short_loc_to_string : Parse_ast.l -> string
 
 (** [print_err fatal print_loc_source l head mes] prints an error / warning message to
-    std-err. It starts with printing location information stored in [l]
-    It then prints "head: mes". If [fatal] is set, the program exists with error-code 1 afterwards.
+    std-err.
 *)
 val print_err : Parse_ast.l -> string -> string -> unit
 
@@ -83,13 +82,13 @@ val print_err : Parse_ast.l -> string -> string -> unit
 
 (** Errors stop execution and print a message; they typically have a location and message.
 *)
-type error =
+type error = private
   (** General errors, used for multi purpose. If you are unsure, use this one. *)
   | Err_general of Parse_ast.l * string
 
   (** Unreachable errors should never be thrown. It means that some
       code was excuted that the programmer thought of as unreachable *)
-  | Err_unreachable of Parse_ast.l * (string * int * int * int) * string
+  | Err_unreachable of Parse_ast.l * (string * int * int * int) * Printexc.raw_backtrace * string
 
   (** [Err_todo] indicates that some feature is unimplemented; it should be built using [err_todo]. *)
   | Err_todo of Parse_ast.l * string
@@ -101,20 +100,13 @@ type error =
 
 exception Fatal_error of error
 
-(** [err_todo l m] is an abreviatiation for [Fatal_error (Err_todo (l, m))] *)
 val err_todo : Parse_ast.l -> string -> exn
-
-(** [err_general l m] is an abreviatiation for [Fatal_error (Err_general (b, l, m))] *)
 val err_general : Parse_ast.l -> string -> exn
-
-(** [err_unreachable l __POS__ m] is an abreviatiation for [Fatal_error (Err_unreachable (l, __POS__, m))] *)
 val err_unreachable : Parse_ast.l -> (string * int * int * int) -> string -> exn
-
-(** [err_typ l m] is an abreviatiation for [Fatal_error (Err_type (l, m))] *)
 val err_typ : Parse_ast.l -> string -> exn
-
-(** [err_syntax_loc] is an abbreviation for [Fatal_error (Err_syntax_loc (l, m))] *)
+val err_syntax : Lexing.position -> string -> exn
 val err_syntax_loc : Parse_ast.l -> string -> exn
+val err_lex : Lexing.position -> string -> exn
 
 val unreachable : Parse_ast.l -> (string * int * int * int) -> string -> 'a
 
diff --git a/src/rewrites.ml b/src/rewrites.ml
index ad0ed836..863f8115 100644
--- a/src/rewrites.ml
+++ b/src/rewrites.ml
@@ -145,40 +145,6 @@ let lexp_is_effectful (LEXP_aux (_, (_, annot))) = match destruct_tannot annot w
   | Some (_, _, eff) -> effectful_effs eff
   | _ -> false
 
-let explode s =
-  let rec exp i l = if i < 0 then l else exp (i - 1) (s.[i] :: l) in
-  exp (String.length s - 1) []
-
-let vector_string_to_bit_list l lit =
-
-  let hexchar_to_binlist = function
-    | '0' -> ['0';'0';'0';'0']
-    | '1' -> ['0';'0';'0';'1']
-    | '2' -> ['0';'0';'1';'0']
-    | '3' -> ['0';'0';'1';'1']
-    | '4' -> ['0';'1';'0';'0']
-    | '5' -> ['0';'1';'0';'1']
-    | '6' -> ['0';'1';'1';'0']
-    | '7' -> ['0';'1';'1';'1']
-    | '8' -> ['1';'0';'0';'0']
-    | '9' -> ['1';'0';'0';'1']
-    | 'A' -> ['1';'0';'1';'0']
-    | 'B' -> ['1';'0';'1';'1']
-    | 'C' -> ['1';'1';'0';'0']
-    | 'D' -> ['1';'1';'0';'1']
-    | 'E' -> ['1';'1';'1';'0']
-    | 'F' -> ['1';'1';'1';'1']
-    | _ -> raise (Reporting.err_unreachable l __POS__ "hexchar_to_binlist given unrecognized character") in
-
-  let s_bin = match lit with
-    | L_hex s_hex -> List.flatten (List.map hexchar_to_binlist (explode (String.uppercase_ascii s_hex)))
-    | L_bin s_bin -> explode s_bin
-    | _ -> raise (Reporting.err_unreachable l __POS__ "s_bin given non vector literal") in
-
-  List.map (function '0' -> L_aux (L_zero, gen_loc l)
-                   | '1' -> L_aux (L_one, gen_loc l)
-                   | _ -> raise (Reporting.err_unreachable (gen_loc l) __POS__ "binary had non-zero or one")) s_bin
-
 let find_used_vars exp =
   (* Overapproximates the set of used identifiers, but for the use cases below
      this is acceptable. *)
@@ -291,39 +257,26 @@ let rewrite_defs_nexp_ids, rewrite_typ_nexp_ids =
        DEF_spec (VS_aux (VS_val_spec (typschm, id, exts, b), a))
     | DEF_type (TD_aux (TD_abbrev (id, typq, typ_arg), a)) ->
        DEF_type (TD_aux (TD_abbrev (id, typq, rewrite_typ_arg env typ_arg), a))
+    | DEF_type (TD_aux (TD_record (id, typq, fields, b), a)) ->
+       let fields' = List.map (fun (t, id) -> (rewrite_typ env t, id)) fields in
+       DEF_type (TD_aux (TD_record (id, typq, fields', b), a))
+    | DEF_type (TD_aux (TD_variant (id, typq, constrs, b), a)) ->
+       let constrs' =
+         List.map (fun (Tu_aux (Tu_ty_id (t, id), l)) ->
+                        Tu_aux (Tu_ty_id (rewrite_typ env t, id), l))
+                  constrs
+       in
+       DEF_type (TD_aux (TD_variant (id, typq, constrs', b), a))
     | d -> Rewriter.rewrite_def rewriters d
   in
 
   (fun env defs -> rewrite_defs_base { rewriters_base with
-    rewrite_exp = (fun _ -> map_exp_annot rewrite_annot); rewrite_def = rewrite_def env
+    rewrite_exp = (fun _ -> map_exp_annot rewrite_annot);
+    rewrite_def = rewrite_def env
     } defs),
   rewrite_typ
 
 
-let rewrite_bitvector_exps env defs =
-  let e_aux = function
-    | (E_vector es, ((l, tannot) as a)) when not (is_empty_tannot tannot) ->
-       let env = env_of_annot (l, tannot) in
-       let typ = typ_of_annot (l, tannot) in
-       let eff = effect_of_annot tannot in
-       if is_bitvector_typ typ then
-         try
-           let len = mk_lit_exp (L_num (Big_int.of_int (List.length es))) in
-           let es = mk_exp (E_list (List.map strip_exp es)) in
-           let exp = mk_exp (E_app (mk_id "bitvector_of_bitlist", [len; es])) in
-           check_exp env exp typ
-         with
-         | _ -> E_aux (E_vector es, a)
-       else
-         E_aux (E_vector es, a)
-    | (e_aux, a) -> E_aux (e_aux, a)
-  in
-  let rewrite_exp _ = fold_exp { id_exp_alg with e_aux = e_aux } in
-  if IdSet.mem (mk_id "bitvector_of_bitlist") (val_spec_ids defs) then
-    rewrite_defs_base { rewriters_base with rewrite_exp = rewrite_exp } defs
-  else defs
-
-
 let rewrite_defs_remove_assert defs =
   let e_assert ((E_aux (eaux, (l, _)) as exp), str) = match eaux with
     | E_constraint _ ->
@@ -1263,7 +1216,7 @@ let rewrite_defs_vector_string_pats_to_bit_list env =
     match pat with
     | P_lit (L_aux (lit, l) as l_aux) ->
        begin match lit with
-       | L_hex _ | L_bin _ -> P_aux (P_vector (List.map (fun p -> P_aux (P_lit p, (l, mk_tannot env bit_typ no_effect))) (vector_string_to_bit_list l lit)), annot)
+       | L_hex _ | L_bin _ -> P_aux (P_vector (List.map (fun p -> P_aux (P_lit p, (l, mk_tannot env bit_typ no_effect))) (vector_string_to_bit_list l_aux)), annot)
        | lit -> P_aux (P_lit l_aux, annot)
        end
     | pat -> (P_aux (pat, annot))
@@ -1273,7 +1226,7 @@ let rewrite_defs_vector_string_pats_to_bit_list env =
     match exp with
     | E_lit (L_aux (lit, l) as l_aux) ->
        begin match lit with
-       | L_hex _ | L_bin _ -> E_aux (E_vector (List.map (fun e -> E_aux (E_lit e, (l, mk_tannot env bit_typ no_effect))) (vector_string_to_bit_list l lit)), annot)
+       | L_hex _ | L_bin _ -> E_aux (E_vector (List.map (fun e -> E_aux (E_lit e, (l, mk_tannot env bit_typ no_effect))) (vector_string_to_bit_list l_aux)), annot)
        | lit -> E_aux (E_lit l_aux, annot)
        end
     | exp -> (E_aux (exp, annot))
@@ -1287,6 +1240,39 @@ let rewrite_defs_vector_string_pats_to_bit_list env =
   in
   rewrite_defs_base { rewriters_base with rewrite_pat = rewrite_pat; rewrite_exp = rewrite_exp }
 
+let rewrite_bit_lists_to_lits env =
+  (* TODO Make all rewriting passes support bitvector literals instead of
+     converting back and forth *)
+  let open Sail2_values in
+  let bit_of_lit = function
+    | L_aux (L_zero, _) -> Some B0
+    | L_aux (L_one, _)  -> Some B1
+    | _ -> None
+  in
+  let bit_of_exp = function E_aux (E_lit lit, _) -> bit_of_lit lit | _ -> None in
+  let string_of_chars cs = String.concat "" (List.map (String.make 1) cs) in
+  let lit_of_bits bits = match hexstring_of_bits bits with
+    | Some h -> L_hex (string_of_chars h)
+    | None -> L_bin (string_of_chars (List.map bitU_char bits))
+  in
+  let e_aux (e, (l, annot)) =
+    let rewrap e = E_aux (e, (l, annot)) in
+    try
+      let env = env_of_annot (l, annot) in
+      let typ = typ_of_annot (l, annot) in
+      match e with
+      | E_vector es when is_bitvector_typ typ ->
+         (match just_list (List.map bit_of_exp es) with
+          | Some bits ->
+             check_exp env (mk_exp (E_cast (typ, mk_lit_exp (lit_of_bits bits)))) typ
+          | None -> rewrap e)
+      | E_cast (typ', E_aux (E_cast (_, e'), _)) -> rewrap (E_cast (typ', e'))
+      | _ -> rewrap e
+    with _ -> rewrap e
+  in
+  let rewrite_exp rw = fold_exp { id_exp_alg with e_aux = e_aux; } in
+  rewrite_defs_base { rewriters_base with rewrite_exp = rewrite_exp }
+
 (* Remove pattern guards by rewriting them to if-expressions within the
    pattern expression. *)
 let rewrite_exp_guarded_pats rewriters (E_aux (exp,(l,annot)) as full_exp) =
@@ -2030,7 +2016,7 @@ let rewrite_simple_types env (Defs defs) =
   let rec simple_lit (L_aux (lit_aux, l) as lit) =
     match lit_aux with
     | L_bin _ | L_hex _ ->
-       E_list (List.map (fun b -> E_aux (E_lit b, simple_annot l bit_typ)) (vector_string_to_bit_list l lit_aux))
+       E_list (List.map (fun b -> E_aux (E_lit b, simple_annot l bit_typ)) (vector_string_to_bit_list lit))
     | _ -> E_lit lit
   in
   let simple_def = function
@@ -3147,7 +3133,7 @@ let rewrite_defs_mapping_patterns env =
        let x = Env.get_val_spec mapping_id env in
 
        let typ1, typ2 = match x with
-         | (_, Typ_aux(Typ_bidir(typ1, typ2), _)) -> typ1, typ2
+         | (_, Typ_aux(Typ_bidir(typ1, typ2, _), _)) -> typ1, typ2
          | (_, typ) -> raise (Reporting.err_unreachable (fst p_annot) __POS__ ("Must be bi-directional mapping: " ^ string_of_typ typ))
        in
 
@@ -3950,6 +3936,54 @@ let rewrite_defs_realise_mappings _ (Defs defs) =
           [realise_single_mpexp (append_placeholder mpexp) (mk_exp (E_app ((mk_id "Some"), [mk_exp (E_tuple [exp; exp_of_mpat strlen])])))]
       end
   in
+  let realise_val_spec = function
+    | (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (typq, Typ_aux (Typ_bidir (typ1, typ2, eff), l)), _), id, _, _), ((_, (tannot:tannot)) as annot))) ->
+      let forwards_id = mk_id (string_of_id id ^ "_forwards") in
+      let forwards_matches_id = mk_id (string_of_id id ^ "_forwards_matches") in
+      let backwards_id = mk_id (string_of_id id ^ "_backwards") in
+      let backwards_matches_id = mk_id (string_of_id id ^ "_backwards_matches") in
+
+      let env = env_of_annot annot in
+      let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, eff), l) in
+      let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, eff), l) in
+      let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, eff), l) in
+      let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, eff), l) in
+
+      let forwards_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_typ, forwards_id, [], false), (Parse_ast.Unknown,())) in
+      let backwards_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_typ, backwards_id, [], false), (Parse_ast.Unknown,())) in
+      let forwards_matches_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_matches_typ, forwards_matches_id, [], false), (Parse_ast.Unknown,())) in
+      let backwards_matches_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_matches_typ, backwards_matches_id, [], false), (Parse_ast.Unknown,())) in
+
+      let forwards_spec, env = Type_check.check_val_spec env forwards_spec in
+      let backwards_spec, env = Type_check.check_val_spec env backwards_spec in
+      let forwards_matches_spec, env = Type_check.check_val_spec env forwards_matches_spec in
+      let backwards_matches_spec, env = Type_check.check_val_spec env backwards_matches_spec in
+
+      let prefix_id = mk_id (string_of_id id ^ "_matches_prefix") in
+      let string_defs =
+        begin if subtype_check env typ1 string_typ && subtype_check env string_typ typ1 then
+                let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+                let forwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
+                let forwards_prefix_spec, env = Type_check.check_val_spec env forwards_prefix_spec in
+                forwards_prefix_spec
+              else
+                if subtype_check env typ2 string_typ && subtype_check env string_typ typ2 then
+                  let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+                  let backwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
+                  let backwards_prefix_spec, env = Type_check.check_val_spec env backwards_prefix_spec in
+                  backwards_prefix_spec
+                else
+                  []
+        end
+      in
+
+        forwards_spec
+      @ backwards_spec
+      @ forwards_matches_spec
+      @ backwards_matches_spec
+      @ string_defs
+    | vs -> [DEF_spec vs]
+  in
   let realise_mapdef (MD_aux (MD_mapping (id, _, mapcls), ((l, (tannot:tannot)) as annot))) =
     let forwards_id = mk_id (string_of_id id ^ "_forwards") in
     let forwards_matches_id = mk_id (string_of_id id ^ "_forwards_matches") in
@@ -3964,24 +3998,14 @@ let rewrite_defs_realise_mappings _ (Defs defs) =
       | _ -> raise (Reporting.err_unreachable l __POS__ "mapping with no clauses?")
     in
     let (typq, bidir_typ) = Env.get_val_spec id env in
-    let (typ1, typ2, l) = match bidir_typ with
-      | Typ_aux (Typ_bidir (typ1, typ2), l) -> typ1, typ2, l
+    let (typ1, typ2, eff, l) = match bidir_typ with
+      | Typ_aux (Typ_bidir (typ1, typ2, eff), l) -> typ1, typ2, eff, l
       | _ -> raise (Reporting.err_unreachable l __POS__ "non-bidir type of mapping?")
     in
-    let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, no_effect), l) in
-    let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, no_effect), l) in
-    let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, no_effect), l) in
-    let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, no_effect), l) in
-
-    let forwards_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_typ, forwards_id, [], false), (Parse_ast.Unknown,())) in
-    let backwards_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_typ, backwards_id, [], false), (Parse_ast.Unknown,())) in
-    let forwards_matches_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_matches_typ, forwards_matches_id, [], false), (Parse_ast.Unknown,())) in
-    let backwards_matches_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_matches_typ, backwards_matches_id, [], false), (Parse_ast.Unknown,())) in
-
-    let forwards_spec, env = Type_check.check_val_spec env forwards_spec in
-    let backwards_spec, env = Type_check.check_val_spec env backwards_spec in
-    let forwards_matches_spec, env = Type_check.check_val_spec env forwards_matches_spec in
-    let backwards_matches_spec, env = Type_check.check_val_spec env backwards_matches_spec in
+    let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, eff), l) in
+    let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, eff), l) in
+    let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, eff), l) in
+    let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, eff), l) in
 
     let no_tannot = (Typ_annot_opt_aux (Typ_annot_opt_none, Parse_ast.Unknown)) in
     let forwards_match = mk_exp (E_case (arg_exp, ((List.map (fun mapcl -> strip_mapcl mapcl |> realise_mapcl true forwards_id) mapcls) |> List.flatten))) in
@@ -4010,40 +4034,34 @@ let rewrite_defs_realise_mappings _ (Defs defs) =
     let string_defs =
       begin if subtype_check env typ1 string_typ && subtype_check env string_typ typ1 then
               let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
-              let forwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
-              let forwards_prefix_spec, env = Type_check.check_val_spec env forwards_prefix_spec in
               let forwards_prefix_match = mk_exp (E_case (arg_exp, ((List.map (fun mapcl -> strip_mapcl mapcl |> realise_prefix_mapcl true prefix_id) mapcls) |> List.flatten) @ [prefix_wildcard])) in
               let forwards_prefix_fun = (FD_aux (FD_function (non_rec, no_tannot, effect_none, [mk_funcl prefix_id arg_pat forwards_prefix_match]), (l, ()))) in
               typ_debug (lazy (Printf.sprintf "forwards prefix matches for mapping %s: %s\n%!" (string_of_id id) (Pretty_print_sail.doc_fundef forwards_prefix_fun |> Pretty_print_sail.to_string)));
               let forwards_prefix_fun, _ = Type_check.check_fundef env forwards_prefix_fun in
-              forwards_prefix_spec @ forwards_prefix_fun
+              forwards_prefix_fun
             else
               if subtype_check env typ2 string_typ && subtype_check env string_typ typ2 then
                 let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
-                let backwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
-                let backwards_prefix_spec, env = Type_check.check_val_spec env backwards_prefix_spec in
                 let backwards_prefix_match = mk_exp (E_case (arg_exp, ((List.map (fun mapcl -> strip_mapcl mapcl |> realise_prefix_mapcl false prefix_id) mapcls) |> List.flatten) @ [prefix_wildcard])) in
                 let backwards_prefix_fun = (FD_aux (FD_function (non_rec, no_tannot, effect_none, [mk_funcl prefix_id arg_pat backwards_prefix_match]), (l, ()))) in
                 typ_debug (lazy (Printf.sprintf "backwards prefix matches for mapping %s: %s\n%!" (string_of_id id) (Pretty_print_sail.doc_fundef backwards_prefix_fun |> Pretty_print_sail.to_string)));
                 let backwards_prefix_fun, _ = Type_check.check_fundef env backwards_prefix_fun in
-                backwards_prefix_spec @ backwards_prefix_fun
+                backwards_prefix_fun
               else
                 []
       end
     in
+    let has_def id = IdSet.mem id (ids_of_defs (Defs defs)) in
 
-      forwards_spec
-    @ forwards_fun
-    @ backwards_spec
-    @ backwards_fun
-    @ forwards_matches_spec
-    @ forwards_matches_fun
-    @ backwards_matches_spec
-    @ backwards_matches_fun
-    @ string_defs
+    (if has_def forwards_id then [] else forwards_fun)
+    @ (if has_def backwards_id then [] else backwards_fun)
+    @ (if has_def forwards_matches_id then [] else forwards_matches_fun)
+    @ (if has_def backwards_matches_id then [] else backwards_matches_fun)
+    @ (if has_def prefix_id then [] else string_defs)
   in
   let rewrite_def def =
     match def with
+    | DEF_spec spec -> realise_val_spec spec
     | DEF_mapdef mdef -> realise_mapdef mdef
     | d -> [d]
   in
@@ -4653,13 +4671,30 @@ let recheck_defs_without_effects env defs =
   let () = opt_no_effects := old in
   result
 
-let remove_mapping_valspecs env (Defs defs) =
-  let allowed_def def =
-    match def with
-    | DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (_, Typ_aux (Typ_bidir _, _)), _), _, _, _), _)) -> false
-    | _ -> true
+(* In realise_mappings we may have duplicated a user-supplied val spec, which
+   causes problems for some targets. Keep the first one, except use the externs
+   from the last one, as subsequent redefinitions override earlier ones. *)
+let remove_duplicate_valspecs env (Defs defs) =
+  let last_externs =
+    List.fold_left
+      (fun last_externs def ->
+        match def with
+        | DEF_spec (VS_aux (VS_val_spec (_, id, externs, _), _)) ->
+            Bindings.add id externs last_externs
+        | _ -> last_externs) Bindings.empty defs
   in
-  Defs (List.filter allowed_def defs)
+  let (_, rev_defs) =
+    List.fold_left
+      (fun (set, defs) def ->
+        match def with
+        | DEF_spec (VS_aux (VS_val_spec (typschm, id, _, cast), l)) ->
+            if IdSet.mem id set then (set, defs)
+            else
+              let externs = Bindings.find id last_externs in
+              let vs = VS_aux (VS_val_spec (typschm, id, externs, cast), l) in
+              (IdSet.add id set, (DEF_spec vs)::defs)
+        | _ -> (set, def::defs)) (IdSet.empty, []) defs
+  in Defs (List.rev rev_defs)
 
 
 (* Move loop termination measures into loop AST nodes.  This is used before
@@ -4807,7 +4842,7 @@ let all_rewrites = [
     ("recheck_defs_without_effects", Checking_rewriter recheck_defs_without_effects);
     ("optimize_recheck_defs", Basic_rewriter (fun _ -> Optimize.recheck));
     ("realise_mappings", Basic_rewriter rewrite_defs_realise_mappings);
-    ("remove_mapping_valspecs", Basic_rewriter remove_mapping_valspecs);
+    ("remove_duplicate_valspecs", Basic_rewriter remove_duplicate_valspecs);
     ("toplevel_string_append", Basic_rewriter rewrite_defs_toplevel_string_append);
     ("pat_string_append", Basic_rewriter rewrite_defs_pat_string_append);
     ("mapping_builtins", Basic_rewriter rewrite_defs_mapping_patterns);
@@ -4831,7 +4866,7 @@ let all_rewrites = [
     ("remove_bitvector_pats", Basic_rewriter rewrite_defs_remove_bitvector_pats);
     ("remove_numeral_pats", Basic_rewriter rewrite_defs_remove_numeral_pats);
     ("guarded_pats", Basic_rewriter rewrite_defs_guarded_pats);
-    ("bitvector_exps", Basic_rewriter rewrite_bitvector_exps);
+    ("bit_lists_to_lits", Basic_rewriter rewrite_bit_lists_to_lits);
     ("exp_lift_assign", Basic_rewriter rewrite_defs_exp_lift_assign);
     ("early_return", Basic_rewriter rewrite_defs_early_return);
     ("nexp_ids", Basic_rewriter rewrite_defs_nexp_ids);
@@ -4850,14 +4885,14 @@ let all_rewrites = [
     ("simple_types", Basic_rewriter rewrite_simple_types);
     ("overload_cast", Basic_rewriter rewrite_overload_cast);
     ("top_sort_defs", Basic_rewriter (fun _ -> top_sort_defs));
-    ("constant_fold", String_rewriter (fun target -> Basic_rewriter (fun _ -> Constant_fold.rewrite_constant_function_calls target)));
+    ("constant_fold", String_rewriter (fun target -> Basic_rewriter (fun _ -> Constant_fold.(rewrite_constant_function_calls no_fixed target))));
     ("split", String_rewriter (fun str -> Basic_rewriter (rewrite_split_fun_ctor_pats str)));
     ("properties", Basic_rewriter (fun _ -> Property.rewrite));
   ]
 
 let rewrites_lem = [
     ("realise_mappings", []);
-    ("remove_mapping_valspecs", []);
+    ("remove_duplicate_valspecs", []);
     ("toplevel_string_append", []);
     ("pat_string_append", []);
     ("mapping_builtins", []);
@@ -4881,7 +4916,6 @@ let rewrites_lem = [
     ("remove_numeral_pats", []);
     ("pattern_literals", [Literal_arg "lem"]);
     ("guarded_pats", []);
-    ("bitvector_exps", []);
     (* ("register_ref_writes", rewrite_register_ref_writes); *)
     ("nexp_ids", []);
     ("fix_val_specs", []);
@@ -4902,12 +4936,13 @@ let rewrites_lem = [
     ("remove_superfluous_letbinds", []);
     ("remove_superfluous_returns", []);
     ("merge_function_clauses", []);
+    ("bit_lists_to_lits", []);
     ("recheck_defs", [])
   ]
 
 let rewrites_coq = [
     ("realise_mappings", []);
-    ("remove_mapping_valspecs", []);
+    ("remove_duplicate_valspecs", []);
     ("toplevel_string_append", []);
     ("pat_string_append", []);
     ("mapping_builtins", []);
@@ -4923,7 +4958,6 @@ let rewrites_coq = [
     ("remove_numeral_pats", []);
     ("pattern_literals", [Literal_arg "lem"]);
     ("guarded_pats", []);
-    ("bitvector_exps", []);
     (* ("register_ref_writes", rewrite_register_ref_writes); *)
     ("nexp_ids", []);
     ("fix_val_specs", []);
@@ -4953,6 +4987,7 @@ let rewrites_coq = [
     ("internal_lets", []);
     ("remove_superfluous_letbinds", []);
     ("remove_superfluous_returns", []);
+    ("bit_lists_to_lits", []);
     ("recheck_defs", [])
   ]
 
diff --git a/src/sail.ml b/src/sail.ml
index e792e652..ea642470 100644
--- a/src/sail.ml
+++ b/src/sail.ml
@@ -53,12 +53,10 @@ open Process_file
 module Big_int = Nat_big_num
 
 let lib = ref ([] : string list)
-let opt_file_out : string option ref = ref None
 let opt_interactive_script : string option ref = ref None
 let opt_print_version = ref false
 let opt_target = ref None
 let opt_tofrominterp_output_dir : string option ref = ref None
-let opt_memo_z3 = ref false
 let opt_sanity = ref false
 let opt_includes_c = ref ([]:string list)
 let opt_specialize_c = ref false
@@ -110,6 +108,9 @@ let options = Arg.align ([
     " output an OCaml translated version of the input");
   ( "-ocaml-nobuild",
     Arg.Set Ocaml_backend.opt_ocaml_nobuild,
+    "");
+  ( "-ocaml_nobuild",
+    Arg.Set Ocaml_backend.opt_ocaml_nobuild,
     " do not build generated OCaml");
   ( "-ocaml_trace",
     Arg.Tuple [set_target "ocaml"; Arg.Set Initial_check.opt_undefined_gen; Arg.Set Ocaml_backend.opt_trace_ocaml],
@@ -119,6 +120,9 @@ let options = Arg.align ([
     " set a custom directory to build generated OCaml");
   ( "-ocaml-coverage",
     Arg.Set Ocaml_backend.opt_ocaml_coverage,
+    "");
+  ( "-ocaml_coverage",
+    Arg.Set Ocaml_backend.opt_ocaml_coverage,
     " build OCaml with bisect_ppx coverage reporting (requires opam packages bisect_ppx-ocamlbuild and bisect_ppx).");
   ( "-ocaml_generators",
     Arg.String (fun s -> opt_ocaml_generators := s::!opt_ocaml_generators),
@@ -145,10 +149,10 @@ let options = Arg.align ([
     set_target "ir",
     " print intermediate representation");
   ( "-smt",
-    set_target "smt",
+    Arg.Tuple [set_target "smt"; Arg.Clear Jib_compile.opt_track_throw],
     " print SMT translated version of input");
   ( "-smt_auto",
-    Arg.Tuple [set_target "smt"; Arg.Set Jib_smt.opt_auto],
+    Arg.Tuple [set_target "smt"; Arg.Clear Jib_compile.opt_track_throw; Arg.Set Jib_smt.opt_auto],
     " generate SMT and automatically call the solver (implies -smt)");
   ( "-smt_ignore_overflow",
     Arg.Set Jib_smt.opt_ignore_overflow,
@@ -301,9 +305,15 @@ let options = Arg.align ([
   ( "-undefined_gen",
     Arg.Set Initial_check.opt_undefined_gen,
     " generate undefined_type functions for types in the specification");
+  ( "-grouped_regstate",
+    Arg.Set State.opt_type_grouped_regstate,
+    " group registers with same type together in generated register state record");
   ( "-enum_casts",
     Arg.Set Initial_check.opt_enum_casts,
     " allow enumerations to be automatically casted to numeric range types");
+  ( "-new_bitfields",
+    Arg.Set Type_check.opt_new_bitfields,
+    " use new bitfield syntax");
   ( "-non_lexical_flow",
     Arg.Set Nl_flow.opt_nl_flow,
     " allow non-lexical flow typing");
@@ -397,43 +407,6 @@ let _ =
       opt_file_arguments := (!opt_file_arguments) @ [s])
     usage_msg
 
-let load_files ?check:(check=false) type_envs files =
-  if !opt_memo_z3 then Constraint.load_digests () else ();
-
-  let t = Profile.start () in
-  let parsed = List.map (fun f -> (f, parse_file f)) files in
-  let ast =
-    List.fold_right (fun (_, Parse_ast.Defs ast_nodes) (Parse_ast.Defs later_nodes)
-                     -> Parse_ast.Defs (ast_nodes@later_nodes)) parsed (Parse_ast.Defs []) in
-  let ast = Process_file.preprocess_ast options ast in
-  let ast = Initial_check.process_ast ~generate:(not check) ast in
-  (* The separate loop measures declarations would be awkward to type check, so
-     move them into the definitions beforehand. *)
-  let ast = Rewrites.move_loop_measures ast in
-  Profile.finish "parsing" t;
-
-  let t = Profile.start () in
-  let (ast, type_envs) = check_ast type_envs ast in
-  Profile.finish "type checking" t;
-
-  if !opt_memo_z3 then Constraint.save_digests () else ();
-
-  if check then
-    ("out.sail", ast, type_envs)
-  else
-    let ast = Scattered.descatter ast in
-    let ast, type_envs = rewrite_ast_initial type_envs ast in
-    (* Recheck after descattering so that the internal type environments always
-       have complete variant types *)
-    let ast, type_envs = Type_error.check Type_check.initial_env ast in
-
-    let out_name = match !opt_file_out with
-      | None when parsed = [] -> "out.sail"
-      | None -> fst (List.hd parsed)
-      | Some f -> f ^ ".sail" in
-
-    (out_name, ast, type_envs)
-
 let prover_regstate tgt ast type_envs =
   match tgt with
   | Some "coq" ->
@@ -513,7 +486,7 @@ let target name out_name ast type_envs =
   | Some "smt" when !opt_smt_serialize ->
      let ast_smt, type_envs = Specialize.(specialize typ_ord_specialization type_envs ast) in
      let ast_smt, type_envs = Specialize.(specialize_passes 2 int_specialization_with_externs type_envs ast_smt) in
-     let jib, ctx = Jib_smt.compile type_envs ast_smt in
+     let jib, _, ctx = Jib_smt.compile type_envs ast_smt in
      let name_file =
        match !opt_file_out with
        | Some f -> f ^ ".smt_model"
@@ -576,7 +549,8 @@ let main () =
     print_endline version
   else
     begin
-      let out_name, ast, type_envs = load_files Type_check.initial_env !opt_file_arguments in
+      let out_name, ast, type_envs = load_files options Type_check.initial_env !opt_file_arguments in
+      let ast, type_envs = descatter type_envs ast in
       let ast, type_envs =
         List.fold_right (fun file (ast,_) -> Splice.splice ast file)
           (!opt_splice) (ast, type_envs)
diff --git a/src/sail_lib.ml b/src/sail_lib.ml
index 164bcefa..03994657 100644
--- a/src/sail_lib.ml
+++ b/src/sail_lib.ml
@@ -17,6 +17,14 @@ let opt_trace = ref false
 let trace_depth = ref 0
 let random = ref false
 
+
+let opt_cycle_limit = ref 0
+let cycle_count = ref 0
+
+let cycle_limit_reached () = 
+  cycle_count := !cycle_count + 1;
+  !opt_cycle_limit != 0 && !cycle_count >= !opt_cycle_limit
+
 let sail_call (type t) (f : _ -> t) =
   let module M =
     struct exception Return of t end
@@ -274,9 +282,7 @@ let rec replicate_bits (bits, n) =
 
 let identity x = x
 
-
-
-(* 
+(*
 Returns list of n bits of integer m starting from offset o >= 0 (bits numbered from least significant). 
 Uses twos-complement representation for m<0 and pads most significant bits in sign-extended way. 
 Most significant bit is head of returned list.
@@ -529,7 +535,7 @@ let fast_read_ram (data_size, addr) =
   !vector
 
 let tag_ram = (ref Mem.empty : (bool Mem.t) ref);;
-  
+
 let write_tag_bool (addr, tag) =
   let addri = uint addr in
   tag_ram := Mem.add addri tag !tag_ram
@@ -551,7 +557,6 @@ let lor_int (n, m) = Big_int.bitwise_or n m
 let land_int (n, m) = Big_int.bitwise_and n m
 let lxor_int (n, m) = Big_int.bitwise_xor n m
 
-
 let debug (str1, n, str2, v) = prerr_endline (str1 ^ Big_int.to_string n ^ str2 ^ string_of_bits v)
 
 let eq_string (str1, str2) = String.compare str1 str2 == 0
diff --git a/src/sail_pp.ml b/src/sail_pp.ml
new file mode 100644
index 00000000..30f93a3e
--- /dev/null
+++ b/src/sail_pp.ml
@@ -0,0 +1,904 @@
+(* generated by Ott 0.30 from: ../language/sail.ott *)
+open PPrintEngine
+open PPrintCombinators
+open 
+
+let rec pp_raw_l_default 
+
+and pp_raw_id_aux x = match x with
+| Id_aux_aux(Id(x),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Id" ^^ string "(" ^^  string "\"" ^^ string x ^^ string "\"" ^^ string ")"
+| Id_aux_aux(Operator(x),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Operator" ^^ string "(" ^^  string "\"" ^^ string x ^^ string "\"" ^^ string ")"
+
+and pp_raw_id x = match x with
+| Id_aux(id_aux,l) -> string "Id_aux" ^^ string "(" ^^ pp_raw_id_aux id_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_kid_aux x = match x with
+| Kid_aux_aux(Var(x),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Var" ^^ string "(" ^^  string "\"" ^^ string x ^^ string "\"" ^^ string ")"
+
+and pp_raw_kid x = match x with
+| Kid_aux(kid_aux,l) -> string "Kid_aux" ^^ string "(" ^^ pp_raw_kid_aux kid_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_kind_aux x = match x with
+| K_aux(K_type,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "K_type"
+| K_aux(K_int,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "K_int"
+| K_aux(K_order,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "K_order"
+| K_aux(K_bool,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "K_bool"
+
+and pp_raw_kind x = match x with
+| K_aux(kind_aux,l) -> string "K_aux" ^^ string "(" ^^ pp_raw_kind_aux kind_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_nexp_aux x = match x with
+| Nexp_aux(Nexp_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| Nexp_aux(Nexp_var(kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_var" ^^ string "(" ^^ pp_raw_kid kid ^^ string ")"
+| Nexp_aux(Nexp_constant(num),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_constant" ^^ string "(" ^^  string "\"" ^^ string num ^^ string "\"" ^^ string ")"
+| Nexp_aux(Nexp_app(id,nexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (nexp0) -> string "(" ^^ pp_raw_nexp nexp0 ^^ string ")") nexp0) ^^ string "]" ^^ string ")"
+| Nexp_aux(Nexp_times(nexp1,nexp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_times" ^^ string "(" ^^ pp_raw_nexp nexp1 ^^ string "," ^^ pp_raw_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_sum(nexp1,nexp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_sum" ^^ string "(" ^^ pp_raw_nexp nexp1 ^^ string "," ^^ pp_raw_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_minus(nexp1,nexp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_minus" ^^ string "(" ^^ pp_raw_nexp nexp1 ^^ string "," ^^ pp_raw_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_exp(nexp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_exp" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string ")"
+| Nexp_aux(Nexp_neg(nexp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Nexp_neg" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string ")"
+
+and pp_raw_nexp x = match x with
+| Nexp_aux(nexp_aux,l) -> string "Nexp_aux" ^^ string "(" ^^ pp_raw_nexp_aux nexp_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_order_aux x = match x with
+| Ord_aux(Ord_var(kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Ord_var" ^^ string "(" ^^ pp_raw_kid kid ^^ string ")"
+| Ord_aux(Ord_inc,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Ord_inc"
+| Ord_aux(Ord_dec,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Ord_dec"
+
+and pp_raw_order x = match x with
+| Ord_aux(order_aux,l) -> string "Ord_aux" ^^ string "(" ^^ pp_raw_order_aux order_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_base_effect_aux x = match x with
+| BE_aux(BE_rreg,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_rreg"
+| BE_aux(BE_wreg,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_wreg"
+| BE_aux(BE_rmem,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_rmem"
+| BE_aux(BE_rmemt,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_rmemt"
+| BE_aux(BE_wmem,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_wmem"
+| BE_aux(BE_eamem,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_eamem"
+| BE_aux(BE_exmem,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_exmem"
+| BE_aux(BE_wmv,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_wmv"
+| BE_aux(BE_wmvt,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_wmvt"
+| BE_aux(BE_barr,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_barr"
+| BE_aux(BE_depend,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_depend"
+| BE_aux(BE_undef,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_undef"
+| BE_aux(BE_unspec,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_unspec"
+| BE_aux(BE_nondet,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_nondet"
+| BE_aux(BE_escape,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_escape"
+| BE_aux(BE_config,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BE_config"
+
+and pp_raw_base_effect x = match x with
+| BE_aux(base_effect_aux,l) -> string "BE_aux" ^^ string "(" ^^ pp_raw_base_effect_aux base_effect_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_effect_aux x = match x with
+| Effect_aux(Effect_set(base_effect0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Effect_set" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (base_effect0) -> string "(" ^^ pp_raw_base_effect base_effect0 ^^ string ")") base_effect0) ^^ string "]" ^^ string ")"
+
+and pp_raw_effect x = match x with
+| Effect_aux(effect_aux,l) -> string "Effect_aux" ^^ string "(" ^^ pp_raw_effect_aux effect_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_typ_aux x = match x with
+| Typ_aux(Typ_internal_unknown,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_internal_unknown"
+| Typ_aux(Typ_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| Typ_aux(Typ_var(kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_var" ^^ string "(" ^^ pp_raw_kid kid ^^ string ")"
+| Typ_aux(Typ_fn(typ0,typ2,effect),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_fn" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (typ0) -> string "(" ^^ pp_raw_typ typ0 ^^ string ")") typ0) ^^ string "]" ^^ string "," ^^ pp_raw_typ typ2 ^^ string "," ^^ pp_raw_effect effect ^^ string ")"
+| Typ_aux(Typ_bidir(typ1,typ2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_bidir" ^^ string "(" ^^ pp_raw_typ typ1 ^^ string "," ^^ pp_raw_typ typ2 ^^ string ")"
+| Typ_aux(Typ_tup(typ0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_tup" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (typ0) -> string "(" ^^ pp_raw_typ typ0 ^^ string ")") typ0) ^^ string "]" ^^ string ")"
+| Typ_aux(Typ_app(id,typ_arg0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (typ_arg0) -> string "(" ^^ pp_raw_typ_arg typ_arg0 ^^ string ")") typ_arg0) ^^ string "]" ^^ string ")"
+| Typ_aux(Typ_exist(kinded_id0,n_constraint,typ),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_exist" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (kinded_id0) -> string "(" ^^ pp_raw_kinded_id kinded_id0 ^^ string ")") kinded_id0) ^^ string "]" ^^ string "," ^^ pp_raw_n_constraint n_constraint ^^ string "," ^^ pp_raw_typ typ ^^ string ")"
+
+and pp_raw_typ x = match x with
+| Typ_aux(typ_aux,l) -> string "Typ_aux" ^^ string "(" ^^ pp_raw_typ_aux typ_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_typ_arg_aux x = match x with
+| A_aux(A_nexp(nexp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "A_nexp" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string ")"
+| A_aux(A_typ(typ),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "A_typ" ^^ string "(" ^^ pp_raw_typ typ ^^ string ")"
+| A_aux(A_order(order),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "A_order" ^^ string "(" ^^ pp_raw_order order ^^ string ")"
+| A_aux(A_bool(n_constraint),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "A_bool" ^^ string "(" ^^ pp_raw_n_constraint n_constraint ^^ string ")"
+
+and pp_raw_typ_arg x = match x with
+| A_aux(typ_arg_aux,l) -> string "A_aux" ^^ string "(" ^^ pp_raw_typ_arg_aux typ_arg_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_n_constraint_aux x = match x with
+| NC_aux(NC_equal(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_equal" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_ge(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_bounded_ge" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_gt(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_bounded_gt" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_le(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_bounded_le" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_lt(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_bounded_lt" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_not_equal(nexp,nexp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_not_equal" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string "," ^^ pp_raw_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_set(kid,num0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_set" ^^ string "(" ^^ pp_raw_kid kid ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (num0) -> string "(" ^^  string "\"" ^^ string num0 ^^ string "\"" ^^ string ")") num0) ^^ string "]" ^^ string ")"
+| NC_aux(NC_or(n_constraint,n_constraint_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_or" ^^ string "(" ^^ pp_raw_n_constraint n_constraint ^^ string "," ^^ pp_raw_n_constraint n_constraint_prime ^^ string ")"
+| NC_aux(NC_and(n_constraint,n_constraint_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_and" ^^ string "(" ^^ pp_raw_n_constraint n_constraint ^^ string "," ^^ pp_raw_n_constraint n_constraint_prime ^^ string ")"
+| NC_aux(NC_app(id,typ_arg0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (typ_arg0) -> string "(" ^^ pp_raw_typ_arg typ_arg0 ^^ string ")") typ_arg0) ^^ string "]" ^^ string ")"
+| NC_aux(NC_var(kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_var" ^^ string "(" ^^ pp_raw_kid kid ^^ string ")"
+| NC_aux(NC_true,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_true"
+| NC_aux(NC_false,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "NC_false"
+
+and pp_raw_n_constraint x = match x with
+| NC_aux(n_constraint_aux,l) -> string "NC_aux" ^^ string "(" ^^ pp_raw_n_constraint_aux n_constraint_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_kinded_id_aux x = match x with
+| KOpt_aux(KOpt_kind(kind,kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "KOpt_kind" ^^ string "(" ^^ pp_raw_kind kind ^^ string "," ^^ pp_raw_kid kid ^^ string ")"
+
+and pp_raw_kinded_id x = match x with
+| KOpt_aux(kinded_id_aux,l) -> string "KOpt_aux" ^^ string "(" ^^ pp_raw_kinded_id_aux kinded_id_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_quant_item_aux x = match x with
+| QI_aux(QI_id(kinded_id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "QI_id" ^^ string "(" ^^ pp_raw_kinded_id kinded_id ^^ string ")"
+| QI_aux(QI_constraint(n_constraint),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "QI_constraint" ^^ string "(" ^^ pp_raw_n_constraint n_constraint ^^ string ")"
+| QI_aux(QI_constant(kinded_id0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "QI_constant" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (kinded_id0) -> string "(" ^^ pp_raw_kinded_id kinded_id0 ^^ string ")") kinded_id0) ^^ string "]" ^^ string ")"
+
+and pp_raw_quant_item x = match x with
+| QI_aux(quant_item_aux,l) -> string "QI_aux" ^^ string "(" ^^ pp_raw_quant_item_aux quant_item_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_typquant_aux x = match x with
+| TypQ_aux(TypQ_tq(quant_item0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TypQ_tq" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (quant_item0) -> string "(" ^^ pp_raw_quant_item quant_item0 ^^ string ")") quant_item0) ^^ string "]" ^^ string ")"
+| TypQ_aux(TypQ_no_forall,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TypQ_no_forall"
+
+and pp_raw_typquant x = match x with
+| TypQ_aux(typquant_aux,l) -> string "TypQ_aux" ^^ string "(" ^^ pp_raw_typquant_aux typquant_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_typschm_aux x = match x with
+| TypSchm_aux(TypSchm_ts(typquant,typ),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TypSchm_ts" ^^ string "(" ^^ pp_raw_typquant typquant ^^ string "," ^^ pp_raw_typ typ ^^ string ")"
+
+and pp_raw_typschm x = match x with
+| TypSchm_aux(typschm_aux,l) -> string "TypSchm_aux" ^^ string "(" ^^ pp_raw_typschm_aux typschm_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_type_def x = match x with
+| TD_aux(type_def_aux) -> string "TD_aux" ^^ string "(" ^^ pp_raw_type_def_aux type_def_aux ^^ string ")"
+
+and pp_raw_type_def_aux x = match x with
+| TD_abbrev(id,typquant,typ_arg) -> string "TD_abbrev" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typquant typquant ^^ string "," ^^ pp_raw_typ_arg typ_arg ^^ string ")"
+| TD_record(id,typquant,typ0_id0,semi_opt) -> string "TD_record" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typquant typquant ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (typ0,id0) -> string "(" ^^ pp_raw_typ typ0 ^^ string "," ^^ pp_raw_id id0 ^^ string ")") typ0_id0) ^^ string "]" ^^ string "," ^^ pp_raw_semi_opt semi_opt ^^ string ")"
+| TD_variant(id,typquant,type_union0,semi_opt) -> string "TD_variant" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typquant typquant ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (type_union0) -> string "(" ^^ pp_raw_type_union type_union0 ^^ string ")") type_union0) ^^ string "]" ^^ string "," ^^ pp_raw_semi_opt semi_opt ^^ string ")"
+| TD_enum(id,id0,semi_opt) -> string "TD_enum" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (id0) -> string "(" ^^ pp_raw_id id0 ^^ string ")") id0) ^^ string "]" ^^ string "," ^^ pp_raw_semi_opt semi_opt ^^ string ")"
+| TD_bitfield(id,typ,id0_index_range0) -> string "TD_bitfield" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typ typ ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (id0,index_range0) -> string "(" ^^ pp_raw_id id0 ^^ string "," ^^ pp_raw_index_range index_range0 ^^ string ")") id0_index_range0) ^^ string "]" ^^ string ")"
+
+and pp_raw_type_union_aux x = match x with
+| Tu_aux(Tu_ty_id(typ,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Tu_ty_id" ^^ string "(" ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_id id ^^ string ")"
+
+and pp_raw_type_union x = match x with
+| Tu_aux(type_union_aux,l) -> string "Tu_aux" ^^ string "(" ^^ pp_raw_type_union_aux type_union_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_index_range_aux x = match x with
+| BF_aux(BF_single(nexp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BF_single" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string ")"
+| BF_aux(BF_range(nexp1,nexp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BF_range" ^^ string "(" ^^ pp_raw_nexp nexp1 ^^ string "," ^^ pp_raw_nexp nexp2 ^^ string ")"
+| BF_aux(BF_concat(index_range1,index_range2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "BF_concat" ^^ string "(" ^^ pp_raw_index_range index_range1 ^^ string "," ^^ pp_raw_index_range index_range2 ^^ string ")"
+
+and pp_raw_index_range x = match x with
+| BF_aux(index_range_aux,l) -> string "BF_aux" ^^ string "(" ^^ pp_raw_index_range_aux index_range_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_lit_aux x = match x with
+| L_aux(L_unit,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_unit"
+| L_aux(L_zero,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_zero"
+| L_aux(L_one,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_one"
+| L_aux(L_true,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_true"
+| L_aux(L_false,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_false"
+| L_aux(L_num(num),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_num" ^^ string "(" ^^  string "\"" ^^ string num ^^ string "\"" ^^ string ")"
+| L_aux(L_hex(hex),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_hex" ^^ string "(" ^^  string "\"" ^^ string hex ^^ string "\"" ^^ string ")"
+| L_aux(L_bin(bin),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_bin" ^^ string "(" ^^  string "\"" ^^ string bin ^^ string "\"" ^^ string ")"
+| L_aux(L_string(string),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_string" ^^ string "(" ^^  string "\"" ^^ string string ^^ string "\"" ^^ string ")"
+| L_aux(L_undef,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_undef"
+| L_aux(L_real(real),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "L_real" ^^ string "(" ^^  string "\"" ^^ string real ^^ string "\"" ^^ string ")"
+
+and pp_raw_lit x = match x with
+| L_aux(lit_aux,l) -> string "L_aux" ^^ string "(" ^^ pp_raw_lit_aux lit_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_semi_opt_default 
+
+and pp_raw_typ_pat_aux x = match x with
+| TP_aux(TP_wild,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TP_wild"
+| TP_aux(TP_var(kid),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TP_var" ^^ string "(" ^^ pp_raw_kid kid ^^ string ")"
+| TP_aux(TP_app(id,typ_pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "TP_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (typ_pat0) -> string "(" ^^ pp_raw_typ_pat typ_pat0 ^^ string ")") typ_pat0) ^^ string "]" ^^ string ")"
+
+and pp_raw_typ_pat x = match x with
+| TP_aux(typ_pat_aux,l) -> string "TP_aux" ^^ string "(" ^^ pp_raw_typ_pat_aux typ_pat_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_pat_aux x = match x with
+| P_aux(P_lit(lit),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_lit" ^^ string "(" ^^ pp_raw_lit lit ^^ string ")"
+| P_aux(P_wild,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_wild"
+| P_aux(P_or(pat1,pat2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_or" ^^ string "(" ^^ pp_raw_pat pat1 ^^ string "," ^^ pp_raw_pat pat2 ^^ string ")"
+| P_aux(P_not(pat),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_not" ^^ string "(" ^^ pp_raw_pat pat ^^ string ")"
+| P_aux(P_as(pat,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_as" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| P_aux(P_typ(typ,pat),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_typ" ^^ string "(" ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_pat pat ^^ string ")"
+| P_aux(P_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| P_aux(P_var(pat,typ_pat),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_var" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_typ_pat typ_pat ^^ string ")"
+| P_aux(P_app(id,pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+| P_aux(P_vector(pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_vector" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+| P_aux(P_vector_concat(pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_vector_concat" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+| P_aux(P_tup(pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_tup" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+| P_aux(P_list(pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_list" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+| P_aux(P_cons(pat1,pat2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_cons" ^^ string "(" ^^ pp_raw_pat pat1 ^^ string "," ^^ pp_raw_pat pat2 ^^ string ")"
+| P_aux(P_string_append(pat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "P_string_append" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (pat0) -> string "(" ^^ pp_raw_pat pat0 ^^ string ")") pat0) ^^ string "]" ^^ string ")"
+
+and pp_raw_pat x = match x with
+| P_aux(pat_aux,annot) -> string "P_aux" ^^ string "(" ^^ pp_raw_pat_aux pat_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_loop_default 
+
+and pp_raw_internal_loop_measure_aux x = match x with
+| Measure_aux(Measure_none,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Measure_none"
+| Measure_aux(Measure_some(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Measure_some" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_internal_loop_measure x = match x with
+| Measure_aux(internal_loop_measure_aux,l) -> string "Measure_aux" ^^ string "(" ^^ pp_raw_internal_loop_measure_aux internal_loop_measure_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_exp_aux x = match x with
+| E_aux(E_block(exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_block" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| E_aux(E_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| E_aux(E_lit(lit),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_lit" ^^ string "(" ^^ pp_raw_lit lit ^^ string ")"
+| E_aux(E_cast(typ,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_cast" ^^ string "(" ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_app(id,exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| E_aux(E_app_infix(exp1,id,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_app_infix" ^^ string "(" ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_id id ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_tuple(exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_tuple" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| E_aux(E_if(exp1,exp2,exp3),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_if" ^^ string "(" ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string "," ^^ pp_raw_exp exp3 ^^ string ")"
+| E_aux(E_loop(loop,internal_loop_measure,exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_loop" ^^ string "(" ^^ pp_raw_loop loop ^^ string "," ^^ pp_raw_internal_loop_measure internal_loop_measure ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_for(id,exp1,exp2,exp3,order,exp4),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_for" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string "," ^^ pp_raw_exp exp3 ^^ string "," ^^ pp_raw_order order ^^ string "," ^^ pp_raw_exp exp4 ^^ string ")"
+| E_aux(E_vector(exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| E_aux(E_vector_access(exp,exp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector_access" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp_prime ^^ string ")"
+| E_aux(E_vector_subrange(exp,exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector_subrange" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_vector_update(exp,exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector_update" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_vector_update_subrange(exp,exp1,exp2,exp3),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector_update_subrange" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string "," ^^ pp_raw_exp exp3 ^^ string ")"
+| E_aux(E_vector_append(exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_vector_append" ^^ string "(" ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_list(exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_list" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| E_aux(E_cons(exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_cons" ^^ string "(" ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| E_aux(E_record(fexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_record" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (fexp0) -> string "(" ^^ pp_raw_fexp fexp0 ^^ string ")") fexp0) ^^ string "]" ^^ string ")"
+| E_aux(E_record_update(exp,fexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_record_update" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (fexp0) -> string "(" ^^ pp_raw_fexp fexp0 ^^ string ")") fexp0) ^^ string "]" ^^ string ")"
+| E_aux(E_field(exp,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_field" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| E_aux(E_case(exp,pexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_case" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (pexp0) -> string "(" ^^ pp_raw_pexp pexp0 ^^ string ")") pexp0) ^^ string "]" ^^ string ")"
+| E_aux(E_let(letbind,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_let" ^^ string "(" ^^ pp_raw_letbind letbind ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_assign(lexp,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_assign" ^^ string "(" ^^ pp_raw_lexp lexp ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_sizeof(nexp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_sizeof" ^^ string "(" ^^ pp_raw_nexp nexp ^^ string ")"
+| E_aux(E_return(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_return" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_exit(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_exit" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_ref(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_ref" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| E_aux(E_throw(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_throw" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_try(exp,pexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_try" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (pexp0) -> string "(" ^^ pp_raw_pexp pexp0 ^^ string ")") pexp0) ^^ string "]" ^^ string ")"
+| E_aux(E_assert(exp,exp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_assert" ^^ string "(" ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp_prime ^^ string ")"
+| E_aux(E_var(lexp,exp,exp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_var" ^^ string "(" ^^ pp_raw_lexp lexp ^^ string "," ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp_prime ^^ string ")"
+| E_aux(E_internal_plet(pat,exp,exp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_internal_plet" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp_prime ^^ string ")"
+| E_aux(E_internal_return(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_internal_return" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+| E_aux(E_internal_value(value),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_internal_value" ^^ string "(" ^^  string "\"" ^^ string value ^^ string "\"" ^^ string ")"
+| E_aux(E_constraint(n_constraint),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "E_constraint" ^^ string "(" ^^ pp_raw_n_constraint n_constraint ^^ string ")"
+
+and pp_raw_exp x = match x with
+| E_aux(exp_aux,annot) -> string "E_aux" ^^ string "(" ^^ pp_raw_exp_aux exp_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_lexp_aux x = match x with
+| LEXP_aux(LEXP_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| LEXP_aux(LEXP_deref(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_deref" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+| LEXP_aux(LEXP_memory(id,exp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_memory" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (exp0) -> string "(" ^^ pp_raw_exp exp0 ^^ string ")") exp0) ^^ string "]" ^^ string ")"
+| LEXP_aux(LEXP_cast(typ,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_cast" ^^ string "(" ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| LEXP_aux(LEXP_tup(lexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_tup" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (lexp0) -> string "(" ^^ pp_raw_lexp lexp0 ^^ string ")") lexp0) ^^ string "]" ^^ string ")"
+| LEXP_aux(LEXP_vector_concat(lexp0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_vector_concat" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (lexp0) -> string "(" ^^ pp_raw_lexp lexp0 ^^ string ")") lexp0) ^^ string "]" ^^ string ")"
+| LEXP_aux(LEXP_vector(lexp,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_vector" ^^ string "(" ^^ pp_raw_lexp lexp ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| LEXP_aux(LEXP_vector_range(lexp,exp1,exp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_vector_range" ^^ string "(" ^^ pp_raw_lexp lexp ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp2 ^^ string ")"
+| LEXP_aux(LEXP_field(lexp,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LEXP_field" ^^ string "(" ^^ pp_raw_lexp lexp ^^ string "," ^^ pp_raw_id id ^^ string ")"
+
+and pp_raw_lexp x = match x with
+| LEXP_aux(lexp_aux,annot) -> string "LEXP_aux" ^^ string "(" ^^ pp_raw_lexp_aux lexp_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_fexp_aux x = match x with
+| FE_aux(FE_Fexp(id,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "FE_Fexp" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_fexp x = match x with
+| FE_aux(fexp_aux,annot) -> string "FE_aux" ^^ string "(" ^^ pp_raw_fexp_aux fexp_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_opt_default_aux x = match x with
+| Def_val_aux(Def_val_empty,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Def_val_empty"
+| Def_val_aux(Def_val_dec(exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Def_val_dec" ^^ string "(" ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_opt_default x = match x with
+| Def_val_aux(opt_default_aux,annot) -> string "Def_val_aux" ^^ string "(" ^^ pp_raw_opt_default_aux opt_default_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_pexp_aux x = match x with
+| Pat_aux(Pat_exp(pat,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Pat_exp" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| Pat_aux(Pat_when(pat,exp1,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Pat_when" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_pexp x = match x with
+| Pat_aux(pexp_aux,annot) -> string "Pat_aux" ^^ string "(" ^^ pp_raw_pexp_aux pexp_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_tannot_opt_aux x = match x with
+| Typ_annot_opt_aux(Typ_annot_opt_none,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_annot_opt_none"
+| Typ_annot_opt_aux(Typ_annot_opt_some(typquant,typ),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Typ_annot_opt_some" ^^ string "(" ^^ pp_raw_typquant typquant ^^ string "," ^^ pp_raw_typ typ ^^ string ")"
+
+and pp_raw_tannot_opt x = match x with
+| Typ_annot_opt_aux(tannot_opt_aux,l) -> string "Typ_annot_opt_aux" ^^ string "(" ^^ pp_raw_tannot_opt_aux tannot_opt_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_rec_opt_aux x = match x with
+| Rec_aux(Rec_nonrec,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Rec_nonrec"
+| Rec_aux(Rec_rec,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Rec_rec"
+| Rec_aux(Rec_measure(pat,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Rec_measure" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_rec_opt x = match x with
+| Rec_aux(rec_opt_aux,l) -> string "Rec_aux" ^^ string "(" ^^ pp_raw_rec_opt_aux rec_opt_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_effect_opt_aux x = match x with
+| Effect_opt_aux(Effect_opt_none,ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Effect_opt_none"
+| Effect_opt_aux(Effect_opt_effect(effect),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "Effect_opt_effect" ^^ string "(" ^^ pp_raw_effect effect ^^ string ")"
+
+and pp_raw_effect_opt x = match x with
+| Effect_opt_aux(effect_opt_aux,l) -> string "Effect_opt_aux" ^^ string "(" ^^ pp_raw_effect_opt_aux effect_opt_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_pexp_funcl x = match x with
+| Pat_funcl_exp(pat,exp) -> string "Pat_funcl_exp" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| Pat_funcl_when(pat,exp1,exp) -> string "Pat_funcl_when" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp1 ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_funcl_aux x = match x with
+| FCL_aux(FCL_Funcl(id,pexp_funcl),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "FCL_Funcl" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_pexp_funcl pexp_funcl ^^ string ")"
+
+and pp_raw_funcl x = match x with
+| FCL_aux(funcl_aux,annot) -> string "FCL_aux" ^^ string "(" ^^ pp_raw_funcl_aux funcl_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_fundef_aux x = match x with
+| FD_aux(FD_function(rec_opt,tannot_opt,effect_opt,funcl0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "FD_function" ^^ string "(" ^^ pp_raw_rec_opt rec_opt ^^ string "," ^^ pp_raw_tannot_opt tannot_opt ^^ string "," ^^ pp_raw_effect_opt effect_opt ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (funcl0) -> string "(" ^^ pp_raw_funcl funcl0 ^^ string ")") funcl0) ^^ string "]" ^^ string ")"
+
+and pp_raw_fundef x = match x with
+| FD_aux(fundef_aux,annot) -> string "FD_aux" ^^ string "(" ^^ pp_raw_fundef_aux fundef_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_mpat_aux x = match x with
+| MP_aux(MP_lit(lit),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_lit" ^^ string "(" ^^ pp_raw_lit lit ^^ string ")"
+| MP_aux(MP_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+| MP_aux(MP_app(id,mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_app" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_vector(mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_vector" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_vector_concat(mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_vector_concat" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_tup(mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_tup" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_list(mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_list" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_cons(mpat1,mpat2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_cons" ^^ string "(" ^^ pp_raw_mpat mpat1 ^^ string "," ^^ pp_raw_mpat mpat2 ^^ string ")"
+| MP_aux(MP_string_append(mpat0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_string_append" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (mpat0) -> string "(" ^^ pp_raw_mpat mpat0 ^^ string ")") mpat0) ^^ string "]" ^^ string ")"
+| MP_aux(MP_typ(mpat,typ),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_typ" ^^ string "(" ^^ pp_raw_mpat mpat ^^ string "," ^^ pp_raw_typ typ ^^ string ")"
+| MP_aux(MP_as(mpat,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MP_as" ^^ string "(" ^^ pp_raw_mpat mpat ^^ string "," ^^ pp_raw_id id ^^ string ")"
+
+and pp_raw_mpat x = match x with
+| MP_aux(mpat_aux,annot) -> string "MP_aux" ^^ string "(" ^^ pp_raw_mpat_aux mpat_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_mpexp_aux x = match x with
+| MPat_aux(MPat_pat(mpat),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MPat_pat" ^^ string "(" ^^ pp_raw_mpat mpat ^^ string ")"
+| MPat_aux(MPat_when(mpat,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MPat_when" ^^ string "(" ^^ pp_raw_mpat mpat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_mpexp x = match x with
+| MPat_aux(mpexp_aux,annot) -> string "MPat_aux" ^^ string "(" ^^ pp_raw_mpexp_aux mpexp_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_mapcl_aux x = match x with
+| MCL_aux(MCL_bidir(mpexp1,mpexp2),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MCL_bidir" ^^ string "(" ^^ pp_raw_mpexp mpexp1 ^^ string "," ^^ pp_raw_mpexp mpexp2 ^^ string ")"
+| MCL_aux(MCL_forwards(mpexp,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MCL_forwards" ^^ string "(" ^^ pp_raw_mpexp mpexp ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| MCL_aux(MCL_backwards(mpexp,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MCL_backwards" ^^ string "(" ^^ pp_raw_mpexp mpexp ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_mapcl x = match x with
+| MCL_aux(mapcl_aux,annot) -> string "MCL_aux" ^^ string "(" ^^ pp_raw_mapcl_aux mapcl_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_mapdef_aux x = match x with
+| MD_aux(MD_mapping(id,tannot_opt,mapcl0),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "MD_mapping" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_tannot_opt tannot_opt ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (mapcl0) -> string "(" ^^ pp_raw_mapcl mapcl0 ^^ string ")") mapcl0) ^^ string "]" ^^ string ")"
+
+and pp_raw_mapdef x = match x with
+| MD_aux(mapdef_aux,annot) -> string "MD_aux" ^^ string "(" ^^ pp_raw_mapdef_aux mapdef_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_letbind_aux x = match x with
+| LB_aux(LB_val(pat,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "LB_val" ^^ string "(" ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_letbind x = match x with
+| LB_aux(letbind_aux,annot) -> string "LB_aux" ^^ string "(" ^^ pp_raw_letbind_aux letbind_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_val_spec x = match x with
+| VS_aux(val_spec_aux) -> string "VS_aux" ^^ string "(" ^^ pp_raw_val_spec_aux val_spec_aux ^^ string ")"
+
+and pp_raw_val_spec_aux x = match x with
+
+and pp_raw_default_spec_aux x = match x with
+| DT_aux(DT_order(order),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "DT_order" ^^ string "(" ^^ pp_raw_order order ^^ string ")"
+
+and pp_raw_default_spec x = match x with
+| DT_aux(default_spec_aux,l) -> string "DT_aux" ^^ string "(" ^^ pp_raw_default_spec_aux default_spec_aux ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_scattered_def_aux x = match x with
+| SD_aux(SD_function(rec_opt,tannot_opt,effect_opt,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_function" ^^ string "(" ^^ pp_raw_rec_opt rec_opt ^^ string "," ^^ pp_raw_tannot_opt tannot_opt ^^ string "," ^^ pp_raw_effect_opt effect_opt ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| SD_aux(SD_funcl(funcl),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_funcl" ^^ string "(" ^^ pp_raw_funcl funcl ^^ string ")"
+| SD_aux(SD_variant(id,typquant),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_variant" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typquant typquant ^^ string ")"
+| SD_aux(SD_unioncl(id,type_union),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_unioncl" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_type_union type_union ^^ string ")"
+| SD_aux(SD_mapping(id,tannot_opt),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_mapping" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_tannot_opt tannot_opt ^^ string ")"
+| SD_aux(SD_mapcl(id,mapcl),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_mapcl" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_mapcl mapcl ^^ string ")"
+| SD_aux(SD_end(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "SD_end" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+
+and pp_raw_scattered_def x = match x with
+| SD_aux(scattered_def_aux,annot) -> string "SD_aux" ^^ string "(" ^^ pp_raw_scattered_def_aux scattered_def_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_reg_id_aux x = match x with
+| RI_aux(RI_id(id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "RI_id" ^^ string "(" ^^ pp_raw_id id ^^ string ")"
+
+and pp_raw_reg_id x = match x with
+| RI_aux(reg_id_aux,annot) -> string "RI_aux" ^^ string "(" ^^ pp_raw_reg_id_aux reg_id_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_alias_spec_aux x = match x with
+| AL_aux(AL_subreg(reg_id,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "AL_subreg" ^^ string "(" ^^ pp_raw_reg_id reg_id ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| AL_aux(AL_bit(reg_id,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "AL_bit" ^^ string "(" ^^ pp_raw_reg_id reg_id ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| AL_aux(AL_slice(reg_id,exp,exp_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "AL_slice" ^^ string "(" ^^ pp_raw_reg_id reg_id ^^ string "," ^^ pp_raw_exp exp ^^ string "," ^^ pp_raw_exp exp_prime ^^ string ")"
+| AL_aux(AL_concat(reg_id,reg_id_prime),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "AL_concat" ^^ string "(" ^^ pp_raw_reg_id reg_id ^^ string "," ^^ pp_raw_reg_id reg_id_prime ^^ string ")"
+
+and pp_raw_alias_spec x = match x with
+| AL_aux(alias_spec_aux,annot) -> string "AL_aux" ^^ string "(" ^^ pp_raw_alias_spec_aux alias_spec_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_dec_spec_aux x = match x with
+| DEC_aux(DEC_reg(effect,effect_prime,typ,id),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "DEC_reg" ^^ string "(" ^^ pp_raw_effect effect ^^ string "," ^^ pp_raw_effect effect_prime ^^ string "," ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| DEC_aux(DEC_config(id,typ,exp),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "DEC_config" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| DEC_aux(DEC_alias(id,alias_spec),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "DEC_alias" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_alias_spec alias_spec ^^ string ")"
+| DEC_aux(DEC_typ_alias(typ,id,alias_spec),ott_menhir_loc) ->  string "[" ^^ string (pp_raw_l ott_menhir_loc) ^^ string "]" ^^ string "DEC_typ_alias" ^^ string "(" ^^ pp_raw_typ typ ^^ string "," ^^ pp_raw_id id ^^ string "," ^^ pp_raw_alias_spec alias_spec ^^ string ")"
+
+and pp_raw_dec_spec x = match x with
+| DEC_aux(dec_spec_aux,annot) -> string "DEC_aux" ^^ string "(" ^^ pp_raw_dec_spec_aux dec_spec_aux ^^ string "," ^^ pp_raw_annot annot ^^ string ")"
+
+and pp_raw_prec x = match x with
+| Infix -> string "Infix"
+| InfixL -> string "InfixL"
+| InfixR -> string "InfixR"
+
+and pp_raw_loop_measure x = match x with
+| Loop(loop,exp) -> string "Loop" ^^ string "(" ^^ pp_raw_loop loop ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+
+and pp_raw_def x = match x with
+| DEF_type(type_def) -> string "DEF_type" ^^ string "(" ^^ pp_raw_type_def type_def ^^ string ")"
+| DEF_fundef(fundef) -> string "DEF_fundef" ^^ string "(" ^^ pp_raw_fundef fundef ^^ string ")"
+| DEF_mapdef(mapdef) -> string "DEF_mapdef" ^^ string "(" ^^ pp_raw_mapdef mapdef ^^ string ")"
+| DEF_val(letbind) -> string "DEF_val" ^^ string "(" ^^ pp_raw_letbind letbind ^^ string ")"
+| DEF_spec(val_spec) -> string "DEF_spec" ^^ string "(" ^^ pp_raw_val_spec val_spec ^^ string ")"
+| DEF_fixity(prec,num,id) -> string "DEF_fixity" ^^ string "(" ^^ pp_raw_prec prec ^^ string "," ^^  string "\"" ^^ string num ^^ string "\"" ^^ string "," ^^ pp_raw_id id ^^ string ")"
+| DEF_overload(id,id0) -> string "DEF_overload" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (id0) -> string "(" ^^ pp_raw_id id0 ^^ string ")") id0) ^^ string "]" ^^ string ")"
+| DEF_default(default_spec) -> string "DEF_default" ^^ string "(" ^^ pp_raw_default_spec default_spec ^^ string ")"
+| DEF_scattered(scattered_def) -> string "DEF_scattered" ^^ string "(" ^^ pp_raw_scattered_def scattered_def ^^ string ")"
+| DEF_measure(id,pat,exp) -> string "DEF_measure" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ pp_raw_pat pat ^^ string "," ^^ pp_raw_exp exp ^^ string ")"
+| DEF_loop_measures(id,loop_measure0) -> string "DEF_loop_measures" ^^ string "(" ^^ pp_raw_id id ^^ string "," ^^ string "[" ^^ separate  (string ";") (List.map (function (loop_measure0) -> string "(" ^^ pp_raw_loop_measure loop_measure0 ^^ string ")") loop_measure0) ^^ string "]" ^^ string ")"
+| DEF_reg_dec(dec_spec) -> string "DEF_reg_dec" ^^ string "(" ^^ pp_raw_dec_spec dec_spec ^^ string ")"
+| DEF_internal_mutrec(fundef0) -> string "DEF_internal_mutrec" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (fundef0) -> string "(" ^^ pp_raw_fundef fundef0 ^^ string ")") fundef0) ^^ string "]" ^^ string ")"
+| DEF_pragma(string1,string2,l) -> string "DEF_pragma" ^^ string "(" ^^  string "\"" ^^ string string1 ^^ string "\"" ^^ string "," ^^  string "\"" ^^ string string2 ^^ string "\"" ^^ string "," ^^ pp_raw_l l ^^ string ")"
+
+and pp_raw_defs x = match x with
+| Defs(def0) -> string "Defs" ^^ string "(" ^^ string "[" ^^ separate  (string ";") (List.map (function (def0) -> string "(" ^^ pp_raw_def def0 ^^ string ")") def0) ^^ string "]" ^^ string ")"
+
+
+let rec pp_l_default 
+
+and pp_id_aux x = match x with
+| Id_aux_aux(Id(x),ott_menhir_loc) -> string x
+| Id_aux_aux(Operator(x),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ string "operator" ^^ string " " ^^ string x ^^ string " " ^^ string ")" ^^ string ")"
+
+and pp_id x = match x with
+| Id_aux(id_aux,l) -> string "(" ^^ pp_id_aux id_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_kid_aux x = match x with
+| Kid_aux_aux(Var(x),ott_menhir_loc) -> string "(" ^^ string "'" ^^ string " " ^^ string x ^^ string ")"
+
+and pp_kid x = match x with
+| Kid_aux(kid_aux,l) -> string "(" ^^ pp_kid_aux kid_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_kind_aux x = match x with
+| K_aux(K_type,ott_menhir_loc) -> string "Type"
+| K_aux(K_int,ott_menhir_loc) -> string "Int"
+| K_aux(K_order,ott_menhir_loc) -> string "Order"
+| K_aux(K_bool,ott_menhir_loc) -> string "Bool"
+
+and pp_kind x = match x with
+| K_aux(kind_aux,l) -> string "(" ^^ pp_kind_aux kind_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_nexp_aux x = match x with
+| Nexp_aux(Nexp_id(id),ott_menhir_loc) -> pp_id id
+| Nexp_aux(Nexp_var(kid),ott_menhir_loc) -> pp_kid kid
+| Nexp_aux(Nexp_constant(num),ott_menhir_loc) -> string num
+| Nexp_aux(Nexp_app(id,nexp0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (nexp0) -> pp_nexp nexp0) nexp0) ^^ string " " ^^ string ")" ^^ string ")"
+| Nexp_aux(Nexp_times(nexp1,nexp2),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp1 ^^ string " " ^^ string "*" ^^ string " " ^^ pp_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_sum(nexp1,nexp2),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp1 ^^ string " " ^^ string "+" ^^ string " " ^^ pp_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_minus(nexp1,nexp2),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp1 ^^ string " " ^^ string "-" ^^ string " " ^^ pp_nexp nexp2 ^^ string ")"
+| Nexp_aux(Nexp_exp(nexp),ott_menhir_loc) -> string "(" ^^ string "2" ^^ string " " ^^ string "^" ^^ string " " ^^ pp_nexp nexp ^^ string ")"
+| Nexp_aux(Nexp_neg(nexp),ott_menhir_loc) -> string "(" ^^ string "-" ^^ string " " ^^ pp_nexp nexp ^^ string ")"
+
+and pp_nexp x = match x with
+| Nexp_aux(nexp_aux,l) -> string "(" ^^ pp_nexp_aux nexp_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_order_aux x = match x with
+| Ord_aux(Ord_var(kid),ott_menhir_loc) -> pp_kid kid
+| Ord_aux(Ord_inc,ott_menhir_loc) -> string "inc"
+| Ord_aux(Ord_dec,ott_menhir_loc) -> string "dec"
+
+and pp_order x = match x with
+| Ord_aux(order_aux,l) -> string "(" ^^ pp_order_aux order_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_base_effect_aux x = match x with
+| BE_aux(BE_rreg,ott_menhir_loc) -> string "rreg"
+| BE_aux(BE_wreg,ott_menhir_loc) -> string "wreg"
+| BE_aux(BE_rmem,ott_menhir_loc) -> string "rmem"
+| BE_aux(BE_rmemt,ott_menhir_loc) -> string "rmemt"
+| BE_aux(BE_wmem,ott_menhir_loc) -> string "wmem"
+| BE_aux(BE_eamem,ott_menhir_loc) -> string "wmea"
+| BE_aux(BE_exmem,ott_menhir_loc) -> string "exmem"
+| BE_aux(BE_wmv,ott_menhir_loc) -> string "wmv"
+| BE_aux(BE_wmvt,ott_menhir_loc) -> string "wmvt"
+| BE_aux(BE_barr,ott_menhir_loc) -> string "barr"
+| BE_aux(BE_depend,ott_menhir_loc) -> string "depend"
+| BE_aux(BE_undef,ott_menhir_loc) -> string "undef"
+| BE_aux(BE_unspec,ott_menhir_loc) -> string "unspec"
+| BE_aux(BE_nondet,ott_menhir_loc) -> string "nondet"
+| BE_aux(BE_escape,ott_menhir_loc) -> string "escape"
+| BE_aux(BE_config,ott_menhir_loc) -> string "config"
+
+and pp_base_effect x = match x with
+| BE_aux(base_effect_aux,l) -> string "(" ^^ pp_base_effect_aux base_effect_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_effect_aux x = match x with
+| Effect_aux(Effect_set(base_effect0),ott_menhir_loc) -> string "(" ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (base_effect0) -> pp_base_effect base_effect0) base_effect0) ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_effect x = match x with
+| Effect_aux(effect_aux,l) -> string "(" ^^ pp_effect_aux effect_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_typ_aux x = match x with
+| Typ_aux(Typ_internal_unknown,ott_menhir_loc) -> string ""
+| Typ_aux(Typ_id(id),ott_menhir_loc) -> pp_id id
+| Typ_aux(Typ_var(kid),ott_menhir_loc) -> pp_kid kid
+| Typ_aux(Typ_fn(typ0,typ2,effect),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (typ0) -> pp_typ typ0) typ0) ^^ string " " ^^ string ")" ^^ string " " ^^ string "->" ^^ string " " ^^ pp_typ typ2 ^^ string " " ^^ string "effectkw" ^^ string " " ^^ pp_effect effect ^^ string ")"
+| Typ_aux(Typ_bidir(typ1,typ2),ott_menhir_loc) -> string "(" ^^ pp_typ typ1 ^^ string " " ^^ string "<->" ^^ string " " ^^ pp_typ typ2 ^^ string ")"
+| Typ_aux(Typ_tup(typ0),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (typ0) -> pp_typ typ0) typ0) ^^ string " " ^^ string ")" ^^ string ")"
+| Typ_aux(Typ_app(id,typ_arg0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (typ_arg0) -> pp_typ_arg typ_arg0) typ_arg0) ^^ string " " ^^ string ")" ^^ string ")"
+| Typ_aux(Typ_exist(kinded_id0,n_constraint,typ),ott_menhir_loc) -> string "(" ^^ string "{" ^^ string " " ^^ separate (string " ") (List.map (function (kinded_id0) -> pp_kinded_id kinded_id0) kinded_id0) ^^ string " " ^^ string "," ^^ string " " ^^ pp_n_constraint n_constraint ^^ string " " ^^ string "." ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_typ x = match x with
+| Typ_aux(typ_aux,l) -> string "(" ^^ pp_typ_aux typ_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_typ_arg_aux x = match x with
+| A_aux(A_nexp(nexp),ott_menhir_loc) -> pp_nexp nexp
+| A_aux(A_typ(typ),ott_menhir_loc) -> pp_typ typ
+| A_aux(A_order(order),ott_menhir_loc) -> pp_order order
+| A_aux(A_bool(n_constraint),ott_menhir_loc) -> pp_n_constraint n_constraint
+
+and pp_typ_arg x = match x with
+| A_aux(typ_arg_aux,l) -> string "(" ^^ pp_typ_arg_aux typ_arg_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_n_constraint_aux x = match x with
+| NC_aux(NC_equal(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string "==" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_ge(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string ">=" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_gt(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string ">" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_le(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string "<=" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_bounded_lt(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string "<" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_not_equal(nexp,nexp_prime),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp ^^ string " " ^^ string "!=" ^^ string " " ^^ pp_nexp nexp_prime ^^ string ")"
+| NC_aux(NC_set(kid,num0),ott_menhir_loc) -> string "(" ^^ pp_kid kid ^^ string " " ^^ string "IN" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (num0) -> string num0) num0) ^^ string " " ^^ string "}" ^^ string ")"
+| NC_aux(NC_or(n_constraint,n_constraint_prime),ott_menhir_loc) -> string "(" ^^ pp_n_constraint n_constraint ^^ string " " ^^ string "&" ^^ string " " ^^ pp_n_constraint n_constraint_prime ^^ string ")"
+| NC_aux(NC_and(n_constraint,n_constraint_prime),ott_menhir_loc) -> string "(" ^^ pp_n_constraint n_constraint ^^ string " " ^^ string "|" ^^ string " " ^^ pp_n_constraint n_constraint_prime ^^ string ")"
+| NC_aux(NC_app(id,typ_arg0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (typ_arg0) -> pp_typ_arg typ_arg0) typ_arg0) ^^ string " " ^^ string ")" ^^ string ")"
+| NC_aux(NC_var(kid),ott_menhir_loc) -> pp_kid kid
+| NC_aux(NC_true,ott_menhir_loc) -> string "true"
+| NC_aux(NC_false,ott_menhir_loc) -> string "false"
+
+and pp_n_constraint x = match x with
+| NC_aux(n_constraint_aux,l) -> string "(" ^^ pp_n_constraint_aux n_constraint_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_kinded_id_aux x = match x with
+| KOpt_aux(KOpt_kind(kind,kid),ott_menhir_loc) -> string "(" ^^ pp_kind kind ^^ string " " ^^ pp_kid kid ^^ string ")"
+
+and pp_kinded_id x = match x with
+| KOpt_aux(kinded_id_aux,l) -> string "(" ^^ pp_kinded_id_aux kinded_id_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_quant_item_aux x = match x with
+| QI_aux(QI_id(kinded_id),ott_menhir_loc) -> pp_kinded_id kinded_id
+| QI_aux(QI_constraint(n_constraint),ott_menhir_loc) -> pp_n_constraint n_constraint
+| QI_aux(QI_constant(kinded_id0),ott_menhir_loc) -> separate (string " ") (List.map (function (kinded_id0) -> pp_kinded_id kinded_id0) kinded_id0)
+
+and pp_quant_item x = match x with
+| QI_aux(quant_item_aux,l) -> string "(" ^^ pp_quant_item_aux quant_item_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_typquant_aux x = match x with
+| TypQ_aux(TypQ_tq(quant_item0),ott_menhir_loc) -> string "(" ^^ string "forall" ^^ string " " ^^ separate (string ",") (List.map (function (quant_item0) -> pp_quant_item quant_item0) quant_item0) ^^ string " " ^^ string "." ^^ string ")"
+| TypQ_aux(TypQ_no_forall,ott_menhir_loc) -> string ""
+
+and pp_typquant x = match x with
+| TypQ_aux(typquant_aux,l) -> string "(" ^^ pp_typquant_aux typquant_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_typschm_aux x = match x with
+| TypSchm_aux(TypSchm_ts(typquant,typ),ott_menhir_loc) -> string "(" ^^ pp_typquant typquant ^^ string " " ^^ pp_typ typ ^^ string ")"
+
+and pp_typschm x = match x with
+| TypSchm_aux(typschm_aux,l) -> string "(" ^^ pp_typschm_aux typschm_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_type_def x = match x with
+| TD_aux(type_def_aux) -> pp_type_def_aux type_def_aux
+
+and pp_type_def_aux x = match x with
+| TD_abbrev(id,typquant,typ_arg) -> string "(" ^^ string "type" ^^ string " " ^^ pp_id id ^^ string " " ^^ pp_typquant typquant ^^ string " " ^^ string "=" ^^ string " " ^^ pp_typ_arg typ_arg ^^ string ")"
+| TD_record(id,typquant,typ0_id0,semi_opt) -> string "(" ^^ string "typedef" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ string "const" ^^ string " " ^^ string "struct" ^^ string " " ^^ pp_typquant typquant ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ";") (List.map (function (typ0,id0) -> pp_typ typ0 ^^ string " " ^^ pp_id id0) typ0_id0) ^^ string " " ^^ pp_semi_opt semi_opt ^^ string " " ^^ string "}" ^^ string ")"
+| TD_variant(id,typquant,type_union0,semi_opt) -> string "(" ^^ string "typedef" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ string "const" ^^ string " " ^^ string "union" ^^ string " " ^^ pp_typquant typquant ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ";") (List.map (function (type_union0) -> pp_type_union type_union0) type_union0) ^^ string " " ^^ pp_semi_opt semi_opt ^^ string " " ^^ string "}" ^^ string ")"
+| TD_enum(id,id0,semi_opt) -> string "(" ^^ string "typedef" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ string "enumerate" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ";") (List.map (function (id0) -> pp_id id0) id0) ^^ string " " ^^ pp_semi_opt semi_opt ^^ string " " ^^ string "}" ^^ string ")"
+| TD_bitfield(id,typ,id0_index_range0) -> string "(" ^^ string "bitfield" ^^ string " " ^^ pp_id id ^^ string " " ^^ string ":" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string "=" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (id0,index_range0) -> pp_id id0 ^^ string " " ^^ string ":" ^^ string " " ^^ pp_index_range index_range0) id0_index_range0) ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_type_union_aux x = match x with
+| Tu_aux(Tu_ty_id(typ,id),ott_menhir_loc) -> string "(" ^^ pp_typ typ ^^ string " " ^^ pp_id id ^^ string ")"
+
+and pp_type_union x = match x with
+| Tu_aux(type_union_aux,l) -> string "(" ^^ pp_type_union_aux type_union_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_index_range_aux x = match x with
+| BF_aux(BF_single(nexp),ott_menhir_loc) -> pp_nexp nexp
+| BF_aux(BF_range(nexp1,nexp2),ott_menhir_loc) -> string "(" ^^ pp_nexp nexp1 ^^ string " " ^^ string ".." ^^ string " " ^^ pp_nexp nexp2 ^^ string ")"
+| BF_aux(BF_concat(index_range1,index_range2),ott_menhir_loc) -> string "(" ^^ pp_index_range index_range1 ^^ string " " ^^ string "," ^^ string " " ^^ pp_index_range index_range2 ^^ string ")"
+
+and pp_index_range x = match x with
+| BF_aux(index_range_aux,l) -> string "(" ^^ pp_index_range_aux index_range_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_lit_aux x = match x with
+| L_aux(L_unit,ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ string ")" ^^ string ")"
+| L_aux(L_zero,ott_menhir_loc) -> string "bitzero"
+| L_aux(L_one,ott_menhir_loc) -> string "bitone"
+| L_aux(L_true,ott_menhir_loc) -> string "true"
+| L_aux(L_false,ott_menhir_loc) -> string "false"
+| L_aux(L_num(num),ott_menhir_loc) -> string num
+| L_aux(L_hex(hex),ott_menhir_loc) -> string hex
+| L_aux(L_bin(bin),ott_menhir_loc) -> string bin
+| L_aux(L_string(string),ott_menhir_loc) -> string string
+| L_aux(L_undef,ott_menhir_loc) -> string "undefined"
+| L_aux(L_real(real),ott_menhir_loc) -> string real
+
+and pp_lit x = match x with
+| L_aux(lit_aux,l) -> string "(" ^^ pp_lit_aux lit_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_semi_opt_default 
+
+and pp_typ_pat_aux x = match x with
+| TP_aux(TP_wild,ott_menhir_loc) -> string "_"
+| TP_aux(TP_var(kid),ott_menhir_loc) -> pp_kid kid
+| TP_aux(TP_app(id,typ_pat0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (typ_pat0) -> pp_typ_pat typ_pat0) typ_pat0) ^^ string " " ^^ string ")" ^^ string ")"
+
+and pp_typ_pat x = match x with
+| TP_aux(typ_pat_aux,l) -> string "(" ^^ pp_typ_pat_aux typ_pat_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_pat_aux x = match x with
+| P_aux(P_lit(lit),ott_menhir_loc) -> pp_lit lit
+| P_aux(P_wild,ott_menhir_loc) -> string "_"
+| P_aux(P_or(pat1,pat2),ott_menhir_loc) -> string "(" ^^ pp_pat pat1 ^^ string " " ^^ string "|" ^^ string " " ^^ pp_pat pat2 ^^ string ")"
+| P_aux(P_not(pat),ott_menhir_loc) -> string "(" ^^ string "~" ^^ string " " ^^ pp_pat pat ^^ string ")"
+| P_aux(P_as(pat,id),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "as" ^^ string " " ^^ pp_id id ^^ string " " ^^ string ")" ^^ string ")"
+| P_aux(P_typ(typ,pat),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string ")" ^^ string " " ^^ pp_pat pat ^^ string ")"
+| P_aux(P_id(id),ott_menhir_loc) -> pp_id id
+| P_aux(P_var(pat,typ_pat),ott_menhir_loc) -> string "(" ^^ pp_pat pat ^^ string " " ^^ pp_typ_pat typ_pat ^^ string ")"
+| P_aux(P_app(id,pat0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (pat0) -> pp_pat pat0) pat0) ^^ string " " ^^ string ")" ^^ string ")"
+| P_aux(P_vector(pat0),ott_menhir_loc) -> string "(" ^^ string "[" ^^ string " " ^^ separate (string ",") (List.map (function (pat0) -> pp_pat pat0) pat0) ^^ string " " ^^ string "]" ^^ string ")"
+| P_aux(P_vector_concat(pat0),ott_menhir_loc) -> separate (string "@") (List.map (function (pat0) -> pp_pat pat0) pat0)
+| P_aux(P_tup(pat0),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (pat0) -> pp_pat pat0) pat0) ^^ string " " ^^ string ")" ^^ string ")"
+| P_aux(P_list(pat0),ott_menhir_loc) -> string "(" ^^ string "[||" ^^ string " " ^^ separate (string ",") (List.map (function (pat0) -> pp_pat pat0) pat0) ^^ string " " ^^ string "||]" ^^ string ")"
+| P_aux(P_cons(pat1,pat2),ott_menhir_loc) -> string "(" ^^ pp_pat pat1 ^^ string " " ^^ string "::" ^^ string " " ^^ pp_pat pat2 ^^ string ")"
+| P_aux(P_string_append(pat0),ott_menhir_loc) -> separate (string "^^") (List.map (function (pat0) -> pp_pat pat0) pat0)
+
+and pp_pat x = match x with
+| P_aux(pat_aux,annot) -> string "(" ^^ pp_pat_aux pat_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_loop_default 
+
+and pp_internal_loop_measure_aux x = match x with
+| Measure_aux(Measure_none,ott_menhir_loc) -> string ""
+| Measure_aux(Measure_some(exp),ott_menhir_loc) -> string "(" ^^ string "termination_measure" ^^ string " " ^^ string "{" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_internal_loop_measure x = match x with
+| Measure_aux(internal_loop_measure_aux,l) -> string "(" ^^ pp_internal_loop_measure_aux internal_loop_measure_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_exp_aux x = match x with
+| E_aux(E_block(exp0),ott_menhir_loc) -> string "(" ^^ string "{" ^^ string " " ^^ separate (string ";") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string "}" ^^ string ")"
+| E_aux(E_id(id),ott_menhir_loc) -> pp_id id
+| E_aux(E_lit(lit),ott_menhir_loc) -> pp_lit lit
+| E_aux(E_cast(typ,exp),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string ")" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_app(id,exp0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string ")" ^^ string ")"
+| E_aux(E_app_infix(exp1,id,exp2),ott_menhir_loc) -> string "(" ^^ pp_exp exp1 ^^ string " " ^^ pp_id id ^^ string " " ^^ pp_exp exp2 ^^ string ")"
+| E_aux(E_tuple(exp0),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string ")" ^^ string ")"
+| E_aux(E_if(exp1,exp2,exp3),ott_menhir_loc) -> string "(" ^^ string "if" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string "then" ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "else" ^^ string " " ^^ pp_exp exp3 ^^ string ")"
+| E_aux(E_loop(loop,internal_loop_measure,exp1,exp2),ott_menhir_loc) -> string "(" ^^ pp_loop loop ^^ string " " ^^ pp_internal_loop_measure internal_loop_measure ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ pp_exp exp2 ^^ string ")"
+| E_aux(E_for(id,exp1,exp2,exp3,order,exp4),ott_menhir_loc) -> string "(" ^^ string "foreach" ^^ string " " ^^ string "(" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "from" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string "to" ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "by" ^^ string " " ^^ pp_exp exp3 ^^ string " " ^^ string "in" ^^ string " " ^^ pp_order order ^^ string " " ^^ string ")" ^^ string " " ^^ pp_exp exp4 ^^ string ")"
+| E_aux(E_vector(exp0),ott_menhir_loc) -> string "(" ^^ string "[" ^^ string " " ^^ separate (string ",") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string "]" ^^ string ")"
+| E_aux(E_vector_access(exp,exp_prime),ott_menhir_loc) -> string "(" ^^ pp_exp exp ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp_prime ^^ string " " ^^ string "]" ^^ string ")"
+| E_aux(E_vector_subrange(exp,exp1,exp2),ott_menhir_loc) -> string "(" ^^ pp_exp exp ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string ".." ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "]" ^^ string ")"
+| E_aux(E_vector_update(exp,exp1,exp2),ott_menhir_loc) -> string "(" ^^ string "[" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "with" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "]" ^^ string ")"
+| E_aux(E_vector_update_subrange(exp,exp1,exp2,exp3),ott_menhir_loc) -> string "(" ^^ string "[" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "with" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string ".." ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp3 ^^ string " " ^^ string "]" ^^ string ")"
+| E_aux(E_vector_append(exp1,exp2),ott_menhir_loc) -> string "(" ^^ pp_exp exp1 ^^ string " " ^^ string "@" ^^ string " " ^^ pp_exp exp2 ^^ string ")"
+| E_aux(E_list(exp0),ott_menhir_loc) -> string "(" ^^ string "[|" ^^ string " " ^^ separate (string ",") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string "|]" ^^ string ")"
+| E_aux(E_cons(exp1,exp2),ott_menhir_loc) -> string "(" ^^ pp_exp exp1 ^^ string " " ^^ string "::" ^^ string " " ^^ pp_exp exp2 ^^ string ")"
+| E_aux(E_record(fexp0),ott_menhir_loc) -> string "(" ^^ string "struct" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (fexp0) -> pp_fexp fexp0) fexp0) ^^ string " " ^^ string "}" ^^ string ")"
+| E_aux(E_record_update(exp,fexp0),ott_menhir_loc) -> string "(" ^^ string "{" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "with" ^^ string " " ^^ separate (string ",") (List.map (function (fexp0) -> pp_fexp fexp0) fexp0) ^^ string " " ^^ string "}" ^^ string ")"
+| E_aux(E_field(exp,id),ott_menhir_loc) -> string "(" ^^ pp_exp exp ^^ string " " ^^ string "." ^^ string " " ^^ pp_id id ^^ string ")"
+| E_aux(E_case(exp,pexp0),ott_menhir_loc) -> string "(" ^^ string "match" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (pexp0) -> pp_pexp pexp0) pexp0) ^^ string " " ^^ string "}" ^^ string ")"
+| E_aux(E_let(letbind,exp),ott_menhir_loc) -> string "(" ^^ pp_letbind letbind ^^ string " " ^^ string "in" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_assign(lexp,exp),ott_menhir_loc) -> string "(" ^^ pp_lexp lexp ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_sizeof(nexp),ott_menhir_loc) -> string "(" ^^ string "sizeof" ^^ string " " ^^ pp_nexp nexp ^^ string ")"
+| E_aux(E_return(exp),ott_menhir_loc) -> string "(" ^^ string "return" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_exit(exp),ott_menhir_loc) -> string "(" ^^ string "exit" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_ref(id),ott_menhir_loc) -> string "(" ^^ string "ref" ^^ string " " ^^ pp_id id ^^ string ")"
+| E_aux(E_throw(exp),ott_menhir_loc) -> string "(" ^^ string "throw" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| E_aux(E_try(exp,pexp0),ott_menhir_loc) -> string "(" ^^ string "try" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "catch" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (pexp0) -> pp_pexp pexp0) pexp0) ^^ string " " ^^ string "}" ^^ string ")"
+| E_aux(E_assert(exp,exp_prime),ott_menhir_loc) -> string "(" ^^ string "assert" ^^ string " " ^^ string "(" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "," ^^ string " " ^^ pp_exp exp_prime ^^ string " " ^^ string ")" ^^ string ")"
+| E_aux(E_var(lexp,exp,exp_prime),ott_menhir_loc) -> string "(" ^^ string "var" ^^ string " " ^^ pp_lexp lexp ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "in" ^^ string " " ^^ pp_exp exp_prime ^^ string ")"
+| E_aux(E_internal_plet(pat,exp,exp_prime),ott_menhir_loc) -> string "(" ^^ string "let" ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "in" ^^ string " " ^^ pp_exp exp_prime ^^ string ")"
+| E_aux(E_internal_return(exp),ott_menhir_loc) -> string "(" ^^ string "return_int" ^^ string " " ^^ string "(" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string ")" ^^ string ")"
+| E_aux(E_internal_value(value),ott_menhir_loc) -> string value
+| E_aux(E_constraint(n_constraint),ott_menhir_loc) -> string "(" ^^ string "constraint" ^^ string " " ^^ pp_n_constraint n_constraint ^^ string ")"
+
+and pp_exp x = match x with
+| E_aux(exp_aux,annot) -> string "(" ^^ pp_exp_aux exp_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_lexp_aux x = match x with
+| LEXP_aux(LEXP_id(id),ott_menhir_loc) -> pp_id id
+| LEXP_aux(LEXP_deref(exp),ott_menhir_loc) -> string "(" ^^ string "deref" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| LEXP_aux(LEXP_memory(id,exp0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (exp0) -> pp_exp exp0) exp0) ^^ string " " ^^ string ")" ^^ string ")"
+| LEXP_aux(LEXP_cast(typ,id),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string ")" ^^ string " " ^^ pp_id id ^^ string ")"
+| LEXP_aux(LEXP_tup(lexp0),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (lexp0) -> pp_lexp lexp0) lexp0) ^^ string " " ^^ string ")" ^^ string ")"
+| LEXP_aux(LEXP_vector_concat(lexp0),ott_menhir_loc) -> separate (string "@") (List.map (function (lexp0) -> pp_lexp lexp0) lexp0)
+| LEXP_aux(LEXP_vector(lexp,exp),ott_menhir_loc) -> string "(" ^^ pp_lexp lexp ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "]" ^^ string ")"
+| LEXP_aux(LEXP_vector_range(lexp,exp1,exp2),ott_menhir_loc) -> string "(" ^^ pp_lexp lexp ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string ".." ^^ string " " ^^ pp_exp exp2 ^^ string " " ^^ string "]" ^^ string ")"
+| LEXP_aux(LEXP_field(lexp,id),ott_menhir_loc) -> string "(" ^^ pp_lexp lexp ^^ string " " ^^ string "." ^^ string " " ^^ pp_id id ^^ string ")"
+
+and pp_lexp x = match x with
+| LEXP_aux(lexp_aux,annot) -> string "(" ^^ pp_lexp_aux lexp_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_fexp_aux x = match x with
+| FE_aux(FE_Fexp(id,exp),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_fexp x = match x with
+| FE_aux(fexp_aux,annot) -> string "(" ^^ pp_fexp_aux fexp_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_opt_default_aux x = match x with
+| Def_val_aux(Def_val_empty,ott_menhir_loc) -> string ""
+| Def_val_aux(Def_val_dec(exp),ott_menhir_loc) -> string "(" ^^ string ";" ^^ string " " ^^ string "default" ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_opt_default x = match x with
+| Def_val_aux(opt_default_aux,annot) -> string "(" ^^ pp_opt_default_aux opt_default_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_pexp_aux x = match x with
+| Pat_aux(Pat_exp(pat,exp),ott_menhir_loc) -> string "(" ^^ pp_pat pat ^^ string " " ^^ string "->" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| Pat_aux(Pat_when(pat,exp1,exp),ott_menhir_loc) -> string "(" ^^ pp_pat pat ^^ string " " ^^ string "when" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string "->" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_pexp x = match x with
+| Pat_aux(pexp_aux,annot) -> string "(" ^^ pp_pexp_aux pexp_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_tannot_opt_aux x = match x with
+| Typ_annot_opt_aux(Typ_annot_opt_none,ott_menhir_loc) -> string ""
+| Typ_annot_opt_aux(Typ_annot_opt_some(typquant,typ),ott_menhir_loc) -> string "(" ^^ pp_typquant typquant ^^ string " " ^^ pp_typ typ ^^ string ")"
+
+and pp_tannot_opt x = match x with
+| Typ_annot_opt_aux(tannot_opt_aux,l) -> string "(" ^^ pp_tannot_opt_aux tannot_opt_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_rec_opt_aux x = match x with
+| Rec_aux(Rec_nonrec,ott_menhir_loc) -> string ""
+| Rec_aux(Rec_rec,ott_menhir_loc) -> string "rec"
+| Rec_aux(Rec_measure(pat,exp),ott_menhir_loc) -> string "(" ^^ string "{" ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "->" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_rec_opt x = match x with
+| Rec_aux(rec_opt_aux,l) -> string "(" ^^ pp_rec_opt_aux rec_opt_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_effect_opt_aux x = match x with
+| Effect_opt_aux(Effect_opt_none,ott_menhir_loc) -> string ""
+| Effect_opt_aux(Effect_opt_effect(effect),ott_menhir_loc) -> string "(" ^^ string "effectkw" ^^ string " " ^^ pp_effect effect ^^ string ")"
+
+and pp_effect_opt x = match x with
+| Effect_opt_aux(effect_opt_aux,l) -> string "(" ^^ pp_effect_opt_aux effect_opt_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_pexp_funcl x = match x with
+| Pat_funcl_exp(pat,exp) -> string "(" ^^ pp_pat pat ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| Pat_funcl_when(pat,exp1,exp) -> string "(" ^^ string "(" ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "when" ^^ string " " ^^ pp_exp exp1 ^^ string " " ^^ string ")" ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_funcl_aux x = match x with
+| FCL_aux(FCL_Funcl(id,pexp_funcl),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ pp_pexp_funcl pexp_funcl ^^ string ")"
+
+and pp_funcl x = match x with
+| FCL_aux(funcl_aux,annot) -> string "(" ^^ pp_funcl_aux funcl_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_fundef_aux x = match x with
+| FD_aux(FD_function(rec_opt,tannot_opt,effect_opt,funcl0),ott_menhir_loc) -> string "(" ^^ string "function" ^^ string " " ^^ pp_rec_opt rec_opt ^^ string " " ^^ pp_tannot_opt tannot_opt ^^ string " " ^^ pp_effect_opt effect_opt ^^ string " " ^^ separate (string "and") (List.map (function (funcl0) -> pp_funcl funcl0) funcl0) ^^ string ")"
+
+and pp_fundef x = match x with
+| FD_aux(fundef_aux,annot) -> string "(" ^^ pp_fundef_aux fundef_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_mpat_aux x = match x with
+| MP_aux(MP_lit(lit),ott_menhir_loc) -> pp_lit lit
+| MP_aux(MP_id(id),ott_menhir_loc) -> pp_id id
+| MP_aux(MP_app(id,mpat0),ott_menhir_loc) -> string "(" ^^ pp_id id ^^ string " " ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0) ^^ string " " ^^ string ")" ^^ string ")"
+| MP_aux(MP_vector(mpat0),ott_menhir_loc) -> string "(" ^^ string "[" ^^ string " " ^^ separate (string ",") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0) ^^ string " " ^^ string "]" ^^ string ")"
+| MP_aux(MP_vector_concat(mpat0),ott_menhir_loc) -> separate (string "@") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0)
+| MP_aux(MP_tup(mpat0),ott_menhir_loc) -> string "(" ^^ string "(" ^^ string " " ^^ separate (string ",") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0) ^^ string " " ^^ string ")" ^^ string ")"
+| MP_aux(MP_list(mpat0),ott_menhir_loc) -> string "(" ^^ string "[||" ^^ string " " ^^ separate (string ",") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0) ^^ string " " ^^ string "||]" ^^ string ")"
+| MP_aux(MP_cons(mpat1,mpat2),ott_menhir_loc) -> string "(" ^^ pp_mpat mpat1 ^^ string " " ^^ string "::" ^^ string " " ^^ pp_mpat mpat2 ^^ string ")"
+| MP_aux(MP_string_append(mpat0),ott_menhir_loc) -> separate (string "^^") (List.map (function (mpat0) -> pp_mpat mpat0) mpat0)
+| MP_aux(MP_typ(mpat,typ),ott_menhir_loc) -> string "(" ^^ pp_mpat mpat ^^ string " " ^^ string ":" ^^ string " " ^^ pp_typ typ ^^ string ")"
+| MP_aux(MP_as(mpat,id),ott_menhir_loc) -> string "(" ^^ pp_mpat mpat ^^ string " " ^^ string "as" ^^ string " " ^^ pp_id id ^^ string ")"
+
+and pp_mpat x = match x with
+| MP_aux(mpat_aux,annot) -> string "(" ^^ pp_mpat_aux mpat_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_mpexp_aux x = match x with
+| MPat_aux(MPat_pat(mpat),ott_menhir_loc) -> pp_mpat mpat
+| MPat_aux(MPat_when(mpat,exp),ott_menhir_loc) -> string "(" ^^ pp_mpat mpat ^^ string " " ^^ string "when" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_mpexp x = match x with
+| MPat_aux(mpexp_aux,annot) -> string "(" ^^ pp_mpexp_aux mpexp_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_mapcl_aux x = match x with
+| MCL_aux(MCL_bidir(mpexp1,mpexp2),ott_menhir_loc) -> string "(" ^^ pp_mpexp mpexp1 ^^ string " " ^^ string "<->" ^^ string " " ^^ pp_mpexp mpexp2 ^^ string ")"
+| MCL_aux(MCL_forwards(mpexp,exp),ott_menhir_loc) -> string "(" ^^ pp_mpexp mpexp ^^ string " " ^^ string "=>" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| MCL_aux(MCL_backwards(mpexp,exp),ott_menhir_loc) -> string "(" ^^ pp_mpexp mpexp ^^ string " " ^^ string "<-" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_mapcl x = match x with
+| MCL_aux(mapcl_aux,annot) -> string "(" ^^ pp_mapcl_aux mapcl_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_mapdef_aux x = match x with
+| MD_aux(MD_mapping(id,tannot_opt,mapcl0),ott_menhir_loc) -> string "(" ^^ string "mapping" ^^ string " " ^^ pp_id id ^^ string " " ^^ pp_tannot_opt tannot_opt ^^ string " " ^^ string "=" ^^ string " " ^^ string "{" ^^ string " " ^^ separate (string ",") (List.map (function (mapcl0) -> pp_mapcl mapcl0) mapcl0) ^^ string " " ^^ string "}" ^^ string ")"
+
+and pp_mapdef x = match x with
+| MD_aux(mapdef_aux,annot) -> string "(" ^^ pp_mapdef_aux mapdef_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_letbind_aux x = match x with
+| LB_aux(LB_val(pat,exp),ott_menhir_loc) -> string "(" ^^ string "let" ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_letbind x = match x with
+| LB_aux(letbind_aux,annot) -> string "(" ^^ pp_letbind_aux letbind_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_val_spec x = match x with
+| VS_aux(val_spec_aux) -> pp_val_spec_aux val_spec_aux
+
+and pp_val_spec_aux x = match x with
+
+and pp_default_spec_aux x = match x with
+| DT_aux(DT_order(order),ott_menhir_loc) -> string "(" ^^ string "default" ^^ string " " ^^ string "Order" ^^ string " " ^^ pp_order order ^^ string ")"
+
+and pp_default_spec x = match x with
+| DT_aux(default_spec_aux,l) -> string "(" ^^ pp_default_spec_aux default_spec_aux ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_scattered_def_aux x = match x with
+| SD_aux(SD_function(rec_opt,tannot_opt,effect_opt,id),ott_menhir_loc) -> string "(" ^^ string "scattered" ^^ string " " ^^ string "function" ^^ string " " ^^ pp_rec_opt rec_opt ^^ string " " ^^ pp_tannot_opt tannot_opt ^^ string " " ^^ pp_effect_opt effect_opt ^^ string " " ^^ pp_id id ^^ string ")"
+| SD_aux(SD_funcl(funcl),ott_menhir_loc) -> string "(" ^^ string "function" ^^ string " " ^^ string "clause" ^^ string " " ^^ pp_funcl funcl ^^ string ")"
+| SD_aux(SD_variant(id,typquant),ott_menhir_loc) -> string "(" ^^ string "scattered" ^^ string " " ^^ string "typedef" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ string "const" ^^ string " " ^^ string "union" ^^ string " " ^^ pp_typquant typquant ^^ string ")"
+| SD_aux(SD_unioncl(id,type_union),ott_menhir_loc) -> string "(" ^^ string "union" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "member" ^^ string " " ^^ pp_type_union type_union ^^ string ")"
+| SD_aux(SD_mapping(id,tannot_opt),ott_menhir_loc) -> string "(" ^^ string "scattered" ^^ string " " ^^ string "mapping" ^^ string " " ^^ pp_id id ^^ string " " ^^ string ":" ^^ string " " ^^ pp_tannot_opt tannot_opt ^^ string ")"
+| SD_aux(SD_mapcl(id,mapcl),ott_menhir_loc) -> string "(" ^^ string "mapping" ^^ string " " ^^ string "clause" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ pp_mapcl mapcl ^^ string ")"
+| SD_aux(SD_end(id),ott_menhir_loc) -> string "(" ^^ string "end" ^^ string " " ^^ pp_id id ^^ string ")"
+
+and pp_scattered_def x = match x with
+| SD_aux(scattered_def_aux,annot) -> string "(" ^^ pp_scattered_def_aux scattered_def_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_reg_id_aux x = match x with
+| RI_aux(RI_id(id),ott_menhir_loc) -> pp_id id
+
+and pp_reg_id x = match x with
+| RI_aux(reg_id_aux,annot) -> string "(" ^^ pp_reg_id_aux reg_id_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_alias_spec_aux x = match x with
+| AL_aux(AL_subreg(reg_id,id),ott_menhir_loc) -> string "(" ^^ pp_reg_id reg_id ^^ string " " ^^ string "." ^^ string " " ^^ pp_id id ^^ string ")"
+| AL_aux(AL_bit(reg_id,exp),ott_menhir_loc) -> string "(" ^^ pp_reg_id reg_id ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string "]" ^^ string ")"
+| AL_aux(AL_slice(reg_id,exp,exp_prime),ott_menhir_loc) -> string "(" ^^ pp_reg_id reg_id ^^ string " " ^^ string "[" ^^ string " " ^^ pp_exp exp ^^ string " " ^^ string ".." ^^ string " " ^^ pp_exp exp_prime ^^ string " " ^^ string "]" ^^ string ")"
+| AL_aux(AL_concat(reg_id,reg_id_prime),ott_menhir_loc) -> string "(" ^^ pp_reg_id reg_id ^^ string " " ^^ string ":" ^^ string " " ^^ pp_reg_id reg_id_prime ^^ string ")"
+
+and pp_alias_spec x = match x with
+| AL_aux(alias_spec_aux,annot) -> string "(" ^^ pp_alias_spec_aux alias_spec_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_dec_spec_aux x = match x with
+| DEC_aux(DEC_reg(effect,effect_prime,typ,id),ott_menhir_loc) -> string "(" ^^ string "register" ^^ string " " ^^ pp_effect effect ^^ string " " ^^ pp_effect effect_prime ^^ string " " ^^ pp_typ typ ^^ string " " ^^ pp_id id ^^ string ")"
+| DEC_aux(DEC_config(id,typ,exp),ott_menhir_loc) -> string "(" ^^ string "register" ^^ string " " ^^ string "configuration" ^^ string " " ^^ pp_id id ^^ string " " ^^ string ":" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| DEC_aux(DEC_alias(id,alias_spec),ott_menhir_loc) -> string "(" ^^ string "register" ^^ string " " ^^ string "alias" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ pp_alias_spec alias_spec ^^ string ")"
+| DEC_aux(DEC_typ_alias(typ,id,alias_spec),ott_menhir_loc) -> string "(" ^^ string "register" ^^ string " " ^^ string "alias" ^^ string " " ^^ pp_typ typ ^^ string " " ^^ pp_id id ^^ string " " ^^ string "=" ^^ string " " ^^ pp_alias_spec alias_spec ^^ string ")"
+
+and pp_dec_spec x = match x with
+| DEC_aux(dec_spec_aux,annot) -> string "(" ^^ pp_dec_spec_aux dec_spec_aux ^^ string " " ^^ pp_annot annot ^^ string ")"
+
+and pp_prec x = match x with
+| Infix -> string "infix"
+| InfixL -> string "infixl"
+| InfixR -> string "infixr"
+
+and pp_loop_measure x = match x with
+| Loop(loop,exp) -> string "(" ^^ pp_loop loop ^^ string " " ^^ pp_exp exp ^^ string ")"
+
+and pp_def x = match x with
+| DEF_type(type_def) -> pp_type_def type_def
+| DEF_fundef(fundef) -> pp_fundef fundef
+| DEF_mapdef(mapdef) -> pp_mapdef mapdef
+| DEF_val(letbind) -> pp_letbind letbind
+| DEF_spec(val_spec) -> pp_val_spec val_spec
+| DEF_fixity(prec,num,id) -> string "(" ^^ string "fix" ^^ string " " ^^ pp_prec prec ^^ string " " ^^ string num ^^ string " " ^^ pp_id id ^^ string ")"
+| DEF_overload(id,id0) -> string "(" ^^ string "overload" ^^ string " " ^^ pp_id id ^^ string " " ^^ string "[" ^^ string " " ^^ separate (string ";") (List.map (function (id0) -> pp_id id0) id0) ^^ string " " ^^ string "]" ^^ string ")"
+| DEF_default(default_spec) -> pp_default_spec default_spec
+| DEF_scattered(scattered_def) -> pp_scattered_def scattered_def
+| DEF_measure(id,pat,exp) -> string "(" ^^ string "termination_measure" ^^ string " " ^^ pp_id id ^^ string " " ^^ pp_pat pat ^^ string " " ^^ string "=" ^^ string " " ^^ pp_exp exp ^^ string ")"
+| DEF_loop_measures(id,loop_measure0) -> string "(" ^^ string "termination_measure" ^^ string " " ^^ pp_id id ^^ string " " ^^ separate (string ",") (List.map (function (loop_measure0) -> pp_loop_measure loop_measure0) loop_measure0) ^^ string ")"
+| DEF_reg_dec(dec_spec) -> pp_dec_spec dec_spec
+| DEF_internal_mutrec(fundef0) -> separate (string " ") (List.map (function (fundef0) -> pp_fundef fundef0) fundef0)
+| DEF_pragma(string1,string2,l) -> string "(" ^^ string "$" ^^ string " " ^^ string string1 ^^ string " " ^^ string string2 ^^ string " " ^^ pp_l l ^^ string ")"
+
+and pp_defs x = match x with
+| Defs(def0) -> separate (string " ") (List.map (function (def0) -> pp_def def0) def0)
+
diff --git a/src/slice.ml b/src/slice.ml
index 1ac390bd..c249fb5a 100644
--- a/src/slice.ml
+++ b/src/slice.ml
@@ -130,7 +130,7 @@ and typ_ids' (Typ_aux (aux, _)) =
      IdSet.add id (List.fold_left IdSet.union IdSet.empty (List.map typ_arg_ids' args))
   | Typ_fn (typs, typ, _) ->
      IdSet.union (typ_ids' typ) (List.fold_left IdSet.union IdSet.empty (List.map typ_ids' typs))
-  | Typ_bidir (typ1, typ2) ->
+  | Typ_bidir (typ1, typ2, _) ->
      IdSet.union (typ_ids' typ1) (typ_ids' typ2)
   | Typ_tup typs ->
      List.fold_left IdSet.union IdSet.empty (List.map typ_ids' typs)
@@ -169,13 +169,23 @@ let add_def_to_graph graph def =
   let scan_lexp self lexp_aux annot =
     let env = env_of_annot annot in
     begin match lexp_aux with
-    | LEXP_cast (typ, _) ->
-       IdSet.iter (fun id -> graph := G.add_edge self (Type id) !graph) (typ_ids typ)
+    | LEXP_cast (typ, id) ->
+       IdSet.iter (fun id -> graph := G.add_edge self (Type id) !graph) (typ_ids typ);
+       begin match Env.lookup_id id env with
+       | Register _ ->
+          graph := G.add_edge self (Register id) !graph
+       | Enum _ -> graph := G.add_edge self (Constructor id) !graph
+       | _ ->
+          if IdSet.mem id (Env.get_toplevel_lets env) then
+            graph := G.add_edge self (Letbind id) !graph
+          else ()
+       end
     | LEXP_memory (id, _) ->
        graph := G.add_edge self (Function id) !graph
     | LEXP_id id ->
        begin match Env.lookup_id id env with
-       | Register _ -> graph := G.add_edge self (Register id) !graph
+       | Register _ ->
+          graph := G.add_edge self (Register id) !graph
        | Enum _ -> graph := G.add_edge self (Constructor id) !graph
        | _ ->
           if IdSet.mem id (Env.get_toplevel_lets env) then
@@ -361,24 +371,20 @@ let () =
   let slice_roots = ref IdSet.empty in
   let slice_cuts = ref IdSet.empty in
 
-  (fun arg ->
+  ArgString ("identifiers", fun arg -> Action (fun () ->
     let args = Str.split (Str.regexp " +") arg in
     let ids = List.map mk_id args |> IdSet.of_list in
     Specialize.add_initial_calls ids;
     slice_roots := IdSet.union ids !slice_roots
-  ) |> register_command
-         ~name:"slice_roots"
-         ~help:(sprintf ":slice_roots %s - Set the roots for %s" (arg "identifiers") (command "slice"));
+  )) |> register_command ~name:"slice_roots" ~help:"Set the roots for :slice";
 
-  (fun arg ->
+  ArgString ("identifiers", fun arg -> Action (fun () ->
     let args = Str.split (Str.regexp " +") arg in
     let ids = List.map mk_id args |> IdSet.of_list in
     slice_cuts := IdSet.union ids !slice_cuts
-  ) |> register_command
-         ~name:"slice_cuts"
-         ~help:(sprintf ":slice_cuts %s - Set the roots for %s" (arg "identifiers") (command "slice"));
+  )) |> register_command ~name:"slice_cuts" ~help:"Set the cuts for :slice";
 
-  (fun arg ->
+  Action (fun () ->
     let module NodeSet = Set.Make(Node) in
     let module G = Graph.Make(Node) in
     let g = graph_of_ast !ast in
@@ -388,10 +394,11 @@ let () =
     ast := filter_ast cuts g !ast
   ) |> register_command
          ~name:"slice"
-         ~help:(sprintf ":slice - Slice AST to the definitions which the functions given by %s depend on, up to the functions given by %s"
-                        (command "slice_roots") (command "slice_cuts"));
+         ~help:"Slice AST to the definitions which the functions given \
+                by :slice_roots depend on, up to the functions given \
+                by :slice_cuts";
 
-  (fun arg ->
+  Action (fun () ->
     let module NodeSet = Set.Make(Node) in
     let module NodeMap = Map.Make(Node) in
     let module G = Graph.Make(Node) in
@@ -409,7 +416,7 @@ let () =
          ~name:"thin_slice"
          ~help:(sprintf ":thin_slice - Slice AST to the function definitions given with %s" (command "slice_roots"));
 
-  (fun arg ->
+  ArgString ("format", fun arg -> Action (fun () ->
     let format = if arg = "" then "svg" else arg in
     let dotfile, out_chan = Filename.open_temp_file "sail_graph_" ".gz" in
     let image = Filename.temp_file "sail_graph_" ("." ^ format) in
@@ -418,9 +425,8 @@ let () =
     let _ = Unix.system (Printf.sprintf "dot -T%s %s -o %s" format dotfile image) in
     let _ = Unix.system (Printf.sprintf "xdg-open %s" image) in
     ()
-  ) |> register_command
-         ~name:"graph"
-         ~help:(sprintf ":graph %s - Draw a callgraph using dot in %s (default svg if none provided), and open with xdg-open"
-                        (arg "format") (arg "format"));
+  )) |> register_command
+          ~name:"graph"
+          ~help:"Draw a callgraph using dot in :0 (e.g. svg), and open with xdg-open"
 
 
diff --git a/src/smtlib.ml b/src/smtlib.ml
index b90f33a7..e12657c3 100644
--- a/src/smtlib.ml
+++ b/src/smtlib.ml
@@ -60,6 +60,30 @@ type smt_typ =
   | Tuple of smt_typ list
   | Array of smt_typ * smt_typ
 
+let rec smt_typ_compare t1 t2 =
+  match t1, t2 with
+  | Bitvec n, Bitvec m -> compare n m
+  | Bool, Bool -> 0
+  | String, String -> 0
+  | Real, Real -> 0
+  | Datatype (name1, _), Datatype (name2, _) -> String.compare name1 name2
+  | Tuple ts1, Tuple ts2 -> Util.lex_ord_list smt_typ_compare ts1 ts2
+  | Array (t11, t12), Array (t21, t22) ->
+     let c = smt_typ_compare t11 t21 in
+     if c = 0 then smt_typ_compare t12 t22 else c
+  | Bitvec _, _ -> 1
+  | _, Bitvec _ -> -1
+  | Bool, _ -> 1
+  | _, Bool -> -1
+  | String, _ -> 1
+  | _, String -> -1
+  | Real, _ -> 1
+  | _, Real -> -1
+  | Datatype _, _ -> 1
+  | _, Datatype _ -> -1
+  | Tuple _, _ -> 1
+  | _, Tuple _ -> -1
+
 let rec smt_typ_equal t1 t2 =
   match t1, t2 with
   | Bitvec n, Bitvec m -> n = m
@@ -89,11 +113,11 @@ let mk_variant name ctors =
 
 type smt_exp =
   | Bool_lit of bool
-  | Hex of string
-  | Bin of string
+  | Bitvec_lit of Sail2_values.bitU list
   | Real_lit of string
   | String_lit of string
   | Var of string
+  | Shared of string
   | Read_res of string
   | Enum of string
   | Fn of string * smt_exp list
@@ -102,6 +126,11 @@ type smt_exp =
   | SignExtend of int * smt_exp
   | Extract of int * int * smt_exp
   | Tester of string * smt_exp
+  | Syntactic of smt_exp * smt_exp list
+  | Struct of string * (string * smt_exp) list
+  | Field of string * smt_exp
+  (* Used by sail-axiomatic, should never be generated by sail -smt! *)
+  | Forall of (string * smt_typ) list * smt_exp
 
 let rec fold_smt_exp f = function
   | Fn (name, args) -> f (Fn (name, List.map (fold_smt_exp f) args))
@@ -110,7 +139,11 @@ let rec fold_smt_exp f = function
   | SignExtend (n, exp) -> f (SignExtend (n, fold_smt_exp f exp))
   | Extract (n, m, exp) -> f (Extract (n, m, fold_smt_exp f exp))
   | Tester (ctor, exp) -> f (Tester (ctor, fold_smt_exp f exp))
-  | (Bool_lit _ | Hex _ | Bin _ | Real_lit _ | String_lit _ | Var _ | Read_res _ | Enum _ as exp) -> f exp
+  | Forall (binders, exp) -> f (Forall (binders, fold_smt_exp f exp))
+  | Syntactic (exp, exps) -> f (Syntactic (fold_smt_exp f exp, List.map (fold_smt_exp f) exps))
+  | Field (name, exp) -> f (Field (name, fold_smt_exp f exp))
+  | Struct (name, fields) -> f (Struct (name, List.map (fun (field, exp) -> field, fold_smt_exp f exp) fields))
+  | (Bool_lit _ | Bitvec_lit  _ | Real_lit _ | String_lit _ | Var _ | Shared _ | Read_res _ | Enum _ as exp) -> f exp
 
 let smt_conj = function
   | [] -> Bool_lit true
@@ -136,21 +169,13 @@ let bvshl x y  = Fn ("bvshl", [x; y])
 let bvlshr x y = Fn ("bvlshr", [x; y])
 let bvult x y  = Fn ("bvult", [x; y])
 
-let bvzero n =
-  if n mod 4 = 0 then
-    Hex (String.concat "" (Util.list_init (n / 4) (fun _ -> "0")))
-  else
-    Bin (String.concat "" (Util.list_init n (fun _ -> "0")))
+let bvzero n = Bitvec_lit (Sail2_operators_bitlists.zeros (Big_int.of_int n))
 
-let bvones n =
-  if n mod 4 = 0 then
-    Hex (String.concat "" (Util.list_init (n / 4) (fun _ -> "F")))
-  else
-    Bin (String.concat "" (Util.list_init n (fun _ -> "1")))
+let bvones n = Bitvec_lit (Sail2_operators_bitlists.ones (Big_int.of_int n))
 
 let simp_equal x y =
   match x, y with
-  | Bin str1, Bin str2 -> Some (str1 = str2)
+  | Bitvec_lit bv1, Bitvec_lit bv2 -> Some (Sail2_operators_bitlists.eq_vec bv1 bv2)
   | _, _ -> None
 
 let simp_and xs =
@@ -175,6 +200,16 @@ let simp_or xs =
      else
        Fn ("or", xs)
 
+let rec all_bitvec_lit = function
+  | Bitvec_lit _ :: rest -> all_bitvec_lit rest
+  | [] -> true
+  | _ :: _ -> false
+
+let rec merge_bitvec_lit = function
+  | Bitvec_lit b :: rest -> b @ merge_bitvec_lit rest
+  | [] -> []
+  | _ :: _ -> assert false
+
 let simp_fn = function
   | Fn ("not", [Fn ("not", [exp])]) -> exp
   | Fn ("not", [Bool_lit b]) -> Bool_lit (not b)
@@ -184,6 +219,9 @@ let simp_fn = function
   | Fn ("and", xs) -> simp_and xs
   | Fn ("=>", [Bool_lit true; y]) -> y
   | Fn ("=>", [Bool_lit false; y]) -> Bool_lit true
+  | Fn ("bvsub", [Bitvec_lit bv1; Bitvec_lit bv2]) -> Bitvec_lit (Sail2_operators_bitlists.sub_vec bv1 bv2)
+  | Fn ("bvadd", [Bitvec_lit bv1; Bitvec_lit bv2]) -> Bitvec_lit (Sail2_operators_bitlists.add_vec bv1 bv2)
+  | Fn ("concat", xs) when all_bitvec_lit xs -> Bitvec_lit (merge_bitvec_lit xs)
   | Fn ("=", [x; y]) as exp ->
      begin match simp_equal x y with
      | Some b -> Bool_lit b
@@ -205,7 +243,16 @@ let rec simp_smt_exp vars kinds = function
      | Some exp -> simp_smt_exp vars kinds exp
      | None -> Var v
      end
-  | (Read_res _ | Enum _ | Hex _ | Bin _ | Bool_lit _ | String_lit _ | Real_lit _ as exp) -> exp
+  | (Read_res _ | Shared _ | Enum _ | Bitvec_lit _ | Bool_lit _ | String_lit _ | Real_lit _ as exp) -> exp
+  | Field (field, exp) ->
+     let exp = simp_smt_exp vars kinds exp in
+     begin match exp with
+     | Struct (_, fields) ->
+        List.assoc field fields
+     | _ -> Field (field, exp)
+     end
+  | Struct (name, fields) ->
+     Struct (name, List.map (fun (field, exp) -> field, simp_smt_exp vars kinds exp) fields)
   | Fn (f, exps) ->
      let exps = List.map (simp_smt_exp vars kinds) exps in
      simp_fn (Fn (f, exps))
@@ -220,8 +267,8 @@ let rec simp_smt_exp vars kinds = function
   | Extract (i, j, exp) ->
      let exp = simp_smt_exp vars kinds exp in
      begin match exp with
-     | Bin str ->
-        Bin (String.sub str ((String.length str - 1) - i) ((i + 1) - j))
+     | Bitvec_lit bv ->
+        Bitvec_lit (Sail2_operators_bitlists.subrange_vec_dec bv (Big_int.of_int i) (Big_int.of_int j))
      | _ -> Extract (i, j, exp)
      end
   | Tester (str, exp) ->
@@ -235,48 +282,167 @@ let rec simp_smt_exp vars kinds = function
         end
      | _ -> Tester (str, exp)
      end
+  | Syntactic (exp, _) -> exp
   | SignExtend (i, exp) ->
      let exp = simp_smt_exp vars kinds exp in
-     SignExtend (i, exp)
+     begin match exp with
+     | Bitvec_lit bv ->
+        Bitvec_lit (Sail2_operators_bitlists.sign_extend bv (Big_int.of_int (i + List.length bv)))
+     | _ -> SignExtend (i, exp)
+     end
+  | Forall (binders, exp) -> Forall (binders, exp)
+
+type read_info = {
+    name : string;
+    node : int;
+    active : smt_exp;
+    kind : smt_exp;
+    addr_type : smt_typ;
+    addr : smt_exp;
+    ret_type : smt_typ;
+    doc : string
+  }
+
+type write_info = {
+    name : string;
+    node : int;
+    active  : smt_exp;
+    kind : smt_exp;
+    addr_type : smt_typ;
+    addr : smt_exp;
+    data_type : smt_typ;
+    data : smt_exp;
+    doc : string
+  }
+
+type barrier_info = {
+    name : string;
+    node : int;
+    active : smt_exp;
+    kind : smt_exp;
+    doc : string
+  }
+
+type branch_info = {
+    name : string;
+    node : int;
+    active : smt_exp;
+    addr_type : smt_typ;
+    addr : smt_exp;
+    doc : string
+  }
+
+type cache_op_info = {
+    name : string;
+    node : int;
+    active : smt_exp;
+    kind : smt_exp;
+    addr_type : smt_typ;
+    addr : smt_exp;
+    doc : string
+  }
 
 type smt_def =
   | Define_fun of string * (string * smt_typ) list * smt_typ * smt_exp
+  | Declare_fun of string * smt_typ list * smt_typ
   | Declare_const of string * smt_typ
   | Define_const of string * smt_typ * smt_exp
-  | Write_mem of string * int * smt_exp * smt_exp * smt_exp * smt_typ * smt_exp * smt_typ
+  (* Same as Define_const, but it'll never be removed by simplification *)
+  | Preserve_const of string * smt_typ * smt_exp
+  | Write_mem of write_info
   | Write_mem_ea of string * int * smt_exp * smt_exp * smt_exp * smt_typ * smt_exp * smt_typ
-  | Read_mem of string * int * smt_exp * smt_typ * smt_exp * smt_exp * smt_typ
-  | Barrier of string * int * smt_exp * smt_exp
+  | Read_mem of read_info
+  | Barrier of barrier_info
+  | Branch_announce of branch_info
+  | Cache_maintenance of cache_op_info
   | Excl_res of string * int * smt_exp
   | Declare_datatypes of string * (string * (string * smt_typ) list) list
   | Declare_tuple of int
   | Assert of smt_exp
 
+let smt_def_map_exp f = function
+  | Define_fun (name, args, ty, exp) -> Define_fun (name, args, ty, f exp)
+  | Declare_fun (name, args, ty) -> Declare_fun (name, args, ty)
+  | Declare_const (name, ty) -> Declare_const (name, ty)
+  | Define_const (name, ty, exp) -> Define_const (name, ty, f exp)
+  | Preserve_const (name, ty, exp) -> Preserve_const (name, ty, f exp)
+  | Write_mem w -> Write_mem { w with active = f w.active; kind = f w.kind; addr = f w.addr; data = f w.data }
+  | Write_mem_ea (name, node, active, wk, addr, addr_ty, data_size, data_size_ty) ->
+     Write_mem_ea (name, node, f active, f wk, f addr, addr_ty, f data_size, data_size_ty)
+  | Read_mem r -> Read_mem { r with active = f r.active; kind = f r.kind; addr = f r.addr }
+  | Barrier b -> Barrier { b with active = f b.active; kind = f b.kind }
+  | Cache_maintenance m -> Cache_maintenance { m with active = f m.active; kind = f m.kind ; addr = f m.addr }
+  | Branch_announce c -> Branch_announce { c with active = f c.active; addr = f c.addr }
+  | Excl_res (name, node, active) -> Excl_res (name, node, f active)
+  | Declare_datatypes (name, ctors) -> Declare_datatypes (name, ctors)
+  | Declare_tuple n -> Declare_tuple n
+  | Assert exp -> Assert (f exp)
+
+let smt_def_iter_exp f = function
+  | Define_fun (name, args, ty, exp) -> f exp
+  | Define_const (name, ty, exp) -> f exp
+  | Preserve_const (name, ty, exp) -> f exp
+  | Write_mem w -> f w.active; f w.kind; f w.addr; f w.data
+  | Write_mem_ea (name, node, active, wk, addr, addr_ty, data_size, data_size_ty) ->
+     f active; f wk; f addr; f data_size
+  | Read_mem r -> f r.active; f r.kind; f r.addr
+  | Barrier b -> f b.active; f b.kind
+  | Cache_maintenance m -> f m.active; f m.kind; f m.addr
+  | Branch_announce c -> f c.active; f c.addr
+  | Excl_res (name, node, active) -> f active
+  | Assert exp -> f exp
+  | Declare_fun _ | Declare_const _ | Declare_tuple _ | Declare_datatypes _ -> ()
+
 let declare_datatypes = function
   | Datatype (name, ctors) -> Declare_datatypes (name, ctors)
   | _ -> assert false
 
+(** For generating SMT with multiple threads (i.e. for litmus tests),
+   we suffix all the variables in the generated SMT with a thread
+   identifier to avoid any name clashes between the two threads. *)
+
 let suffix_variables_exp sfx =
-  fold_smt_exp (function Var v -> Var (v ^ sfx) | exp -> exp)
+  fold_smt_exp (function Var v -> Var (v ^ sfx) | Read_res v -> Read_res (v ^ sfx) | exp -> exp)
+
+let suffix_variables_read_info sfx (r : read_info) =
+  let suffix exp = suffix_variables_exp sfx exp in
+  { r with name = r.name ^ sfx; active = suffix r.active; kind = suffix r.kind; addr = suffix r.addr }
+
+let suffix_variables_write_info sfx (w : write_info) =
+  let suffix exp = suffix_variables_exp sfx exp in
+  { w with name = w.name ^ sfx; active = suffix w.active; kind = suffix w.kind; addr = suffix w.addr; data = suffix w.data }
+
+let suffix_variables_barrier_info sfx (b : barrier_info) =
+  let suffix exp = suffix_variables_exp sfx exp in
+  { b with name = b.name ^ sfx; active = suffix b.active; kind = suffix b.kind }
+
+let suffix_variables_branch_info sfx (c : branch_info) =
+  let suffix exp = suffix_variables_exp sfx exp in
+  { c with name = c.name ^ sfx; active = suffix c.active; addr = suffix c.addr }
+
+let suffix_variables_cache_op_info sfx (m : cache_op_info) =
+  let suffix exp = suffix_variables_exp sfx exp in
+  { m with name = m.name ^ sfx; kind = suffix m.kind; active = suffix m.active; addr = suffix m.addr }
 
 let suffix_variables_def sfx = function
   | Define_fun (name, args, ty, exp) ->
      Define_fun (name ^ sfx, List.map (fun (arg, ty) -> sfx ^ arg, ty) args, ty, suffix_variables_exp sfx exp)
+  | Declare_fun (name, tys, ty) ->
+     Declare_fun (name ^ sfx, tys, ty)
   | Declare_const (name, ty) ->
      Declare_const (name ^ sfx, ty)
   | Define_const (name, ty, exp) ->
      Define_const (name ^ sfx, ty, suffix_variables_exp sfx exp)
-  | Write_mem (name, node, active, wk, addr, addr_ty, data, data_ty) ->
-     Write_mem (name ^ sfx, node, suffix_variables_exp sfx active, suffix_variables_exp sfx wk,
-                suffix_variables_exp sfx addr, addr_ty, suffix_variables_exp sfx data, data_ty)
+  | Preserve_const (name, ty, exp) ->
+     Preserve_const (name, ty, suffix_variables_exp sfx exp)
+  | Write_mem w -> Write_mem (suffix_variables_write_info sfx w)
   | Write_mem_ea (name, node, active , wk, addr, addr_ty, data_size, data_size_ty) ->
-     Write_mem (name ^ sfx, node, suffix_variables_exp sfx active, suffix_variables_exp sfx wk,
-                suffix_variables_exp sfx addr, addr_ty, suffix_variables_exp sfx data_size, data_size_ty)
-  | Read_mem (name, node, active, ty, rk, addr, addr_ty) ->
-     Read_mem (name ^ sfx, node, suffix_variables_exp sfx active, ty, suffix_variables_exp sfx rk,
-               suffix_variables_exp sfx addr, addr_ty)
-  | Barrier (name, node, active, bk) ->
-     Barrier (name ^ sfx, node, suffix_variables_exp sfx active, suffix_variables_exp sfx bk)
+     Write_mem_ea (name ^ sfx, node, suffix_variables_exp sfx active, suffix_variables_exp sfx wk,
+                   suffix_variables_exp sfx addr, addr_ty, suffix_variables_exp sfx data_size, data_size_ty)
+  | Read_mem r -> Read_mem (suffix_variables_read_info sfx r)
+  | Barrier b -> Barrier (suffix_variables_barrier_info sfx b)
+  | Cache_maintenance m -> Cache_maintenance (suffix_variables_cache_op_info sfx m)
+  | Branch_announce c -> Branch_announce (suffix_variables_branch_info sfx c)
   | Excl_res (name, node, active) ->
      Excl_res (name ^ sfx, node, suffix_variables_exp sfx active)
   | Declare_datatypes (name, ctors) ->
@@ -286,54 +452,37 @@ let suffix_variables_def sfx = function
   | Assert exp ->
      Assert (suffix_variables_exp sfx exp)
 
-let merge_datatypes defs1 defs2 =
-  let module StringSet = Set.Make(String) in
-  let datatype_name = function
-    | Declare_datatypes (name, _) -> name
-    | _ -> assert false
-  in
-  let names = List.fold_left (fun set def -> StringSet.add (datatype_name def) set) StringSet.empty defs1 in
-  defs1 @ List.filter (fun def -> not (StringSet.mem (datatype_name def) names)) defs2
-
-let merge_tuples defs1 defs2 =
-  let tuple_size = function
-    | Declare_tuple size -> size
-    | _ -> assert false
-  in
-  let names = List.fold_left (fun set def -> Util.IntSet.add (tuple_size def) set) Util.IntSet.empty defs1 in
-  defs1 @ List.filter (fun def -> not (Util.IntSet.mem (tuple_size def) names)) defs2
-
-let merge_smt_defs defs1 defs2 =
-  let is_tuple = function
-    | Declare_datatypes _ | Declare_tuple _ -> true
-    | _ -> false
-  in
-  let is_datatype = function
-    | Declare_datatypes _ | Declare_tuple _ -> true
-    | _ -> false
-  in
-  let datatypes1, body1 = List.partition is_datatype defs1 in
-  let datatypes2, body2 = List.partition is_datatype defs2 in
-  let tuples1, datatypes1 = List.partition is_tuple datatypes1 in
-  let tuples2, datatypes2 = List.partition is_tuple datatypes2 in
-  merge_tuples tuples1 tuples2 @ merge_datatypes datatypes1 datatypes2 @ body1 @ body2
-
 let pp_sfun str docs =
   let open PPrint in
   parens (separate space (string str :: docs))
 
+let rec pp_smt_typ =
+  let open PPrint in
+  function
+  | Bool -> string "Bool"
+  | String -> string "String"
+  | Real -> string "Real"
+  | Bitvec n -> string (Printf.sprintf "(_ BitVec %d)" n)
+  | Datatype (name, _) -> string name
+  | Tuple tys -> pp_sfun ("Tup" ^ string_of_int (List.length tys)) (List.map pp_smt_typ tys)
+  | Array (ty1, ty2) -> pp_sfun "Array" [pp_smt_typ ty1; pp_smt_typ ty2]
+
+let pp_str_smt_typ (str, ty) = let open PPrint in parens (string str ^^ space ^^ pp_smt_typ ty)
+
 let rec pp_smt_exp =
   let open PPrint in
   function
   | Bool_lit b -> string (string_of_bool b)
   | Real_lit str -> string str
   | String_lit str -> string ("\"" ^ str ^ "\"")
-  | Hex str -> string ("#x" ^ str)
-  | Bin str -> string ("#b" ^ str)
+  | Bitvec_lit bv -> string (Sail2_values.show_bitlist_prefix '#' bv)
   | Var str -> string str
+  | Shared str -> string str
   | Read_res str -> string (str ^ "_ret")
   | Enum str -> string str
   | Fn (str, exps) -> parens (string str ^^ space ^^ separate_map space pp_smt_exp exps)
+  | Field (str, exp) -> parens (string str ^^ space ^^ pp_smt_exp exp)
+  | Struct (str, fields) -> parens (string str ^^ space ^^ separate_map space (fun (_, exp) -> pp_smt_exp exp) fields)
   | Ctor (str, exps) -> parens (string str ^^ space ^^ separate_map space pp_smt_exp exps)
   | Ite (cond, then_exp, else_exp) ->
      parens (separate space [string "ite"; pp_smt_exp cond; pp_smt_exp then_exp; pp_smt_exp else_exp])
@@ -343,19 +492,9 @@ let rec pp_smt_exp =
      parens (string (Printf.sprintf "(_ is %s)" kind) ^^ space ^^ pp_smt_exp exp)
   | SignExtend (i, exp) ->
      parens (string (Printf.sprintf "(_ sign_extend %d)" i) ^^ space ^^ pp_smt_exp exp)
-
-let rec pp_smt_typ =
-  let open PPrint in
-  function
-  | Bool -> string "Bool"
-  | String -> string "String"
-  | Real -> string "Real"
-  | Bitvec n -> string (Printf.sprintf "(_ BitVec %d)" n)
-  | Datatype (name, _) -> string name
-  | Tuple tys -> pp_sfun ("Tup" ^ string_of_int (List.length tys)) (List.map pp_smt_typ tys)
-  | Array (ty1, ty2) -> pp_sfun "Array" [pp_smt_typ ty1; pp_smt_typ ty2]
-
-let pp_str_smt_typ (str, ty) = let open PPrint in string str ^^ space ^^ pp_smt_typ ty
+  | Syntactic (exp, _) -> pp_smt_exp exp
+  | Forall (binders, exp) ->
+     parens (string "forall" ^^ space ^^ parens (separate_map space pp_str_smt_typ binders) ^^ space ^^ pp_smt_exp exp)
 
 let pp_smt_def =
   let open PPrint in
@@ -367,18 +506,23 @@ let pp_smt_def =
              ^^ space ^^ pp_smt_typ ty
              ^//^ pp_smt_exp exp)
 
+  | Declare_fun (name, args, ty) ->
+     parens (string "declare-fun" ^^ space ^^ string name
+             ^^ space ^^ parens (separate_map space pp_smt_typ args)
+             ^^ space ^^ pp_smt_typ ty)
+
   | Declare_const (name, ty) ->
      pp_sfun "declare-const" [string name; pp_smt_typ ty]
 
-  | Define_const (name, ty, exp) ->
+  | Define_const (name, ty, exp) | Preserve_const (name, ty, exp) ->
      pp_sfun "define-const" [string name; pp_smt_typ ty; pp_smt_exp exp]
 
-  | Write_mem (name, _, active, wk, addr, addr_ty, data, data_ty) ->
-     pp_sfun "define-const" [string (name ^ "_kind"); string "Zwrite_kind"; pp_smt_exp wk] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_active"); pp_smt_typ Bool; pp_smt_exp active] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_data"); pp_smt_typ data_ty; pp_smt_exp data] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_addr"); pp_smt_typ addr_ty; pp_smt_exp addr] ^^ hardline
-     ^^ pp_sfun "declare-const" [string (name ^ "_ret"); pp_smt_typ Bool]
+  | Write_mem w ->
+     pp_sfun "define-const" [string (w.name ^ "_kind"); string "Zwrite_kind"; pp_smt_exp w.kind] ^^ hardline
+     ^^ pp_sfun "define-const" [string (w.name ^ "_active"); pp_smt_typ Bool; pp_smt_exp w.active] ^^ hardline
+     ^^ pp_sfun "define-const" [string (w.name ^ "_data"); pp_smt_typ w.data_type; pp_smt_exp w.data] ^^ hardline
+     ^^ pp_sfun "define-const" [string (w.name ^ "_addr"); pp_smt_typ w.addr_type; pp_smt_exp w.addr] ^^ hardline
+     ^^ pp_sfun "declare-const" [string (w.name ^ "_ret"); pp_smt_typ Bool]
 
   | Write_mem_ea (name, _, active, wk, addr, addr_ty, data_size, data_size_ty) ->
      pp_sfun "define-const" [string (name ^ "_kind"); string "Zwrite_kind"; pp_smt_exp wk] ^^ hardline
@@ -386,15 +530,24 @@ let pp_smt_def =
      ^^ pp_sfun "define-const" [string (name ^ "_size"); pp_smt_typ data_size_ty; pp_smt_exp data_size] ^^ hardline
      ^^ pp_sfun "define-const" [string (name ^ "_addr"); pp_smt_typ addr_ty; pp_smt_exp addr]
 
-  | Read_mem (name, _, active, ty, rk, addr, addr_ty) ->
-     pp_sfun "define-const" [string (name ^ "_kind"); string "Zread_kind"; pp_smt_exp rk] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_active"); pp_smt_typ Bool; pp_smt_exp active] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_addr"); pp_smt_typ addr_ty; pp_smt_exp addr] ^^ hardline
-     ^^ pp_sfun "declare-const" [string (name ^ "_ret"); pp_smt_typ ty]
+  | Read_mem r ->
+     pp_sfun "define-const" [string (r.name ^ "_kind"); string "Zread_kind"; pp_smt_exp r.kind] ^^ hardline
+     ^^ pp_sfun "define-const" [string (r.name ^ "_active"); pp_smt_typ Bool; pp_smt_exp r.active] ^^ hardline
+     ^^ pp_sfun "define-const" [string (r.name ^ "_addr"); pp_smt_typ r.addr_type; pp_smt_exp r.addr] ^^ hardline
+     ^^ pp_sfun "declare-const" [string (r.name ^ "_ret"); pp_smt_typ r.ret_type]
 
-  | Barrier (name, _, active, bk) ->
-     pp_sfun "define-const" [string (name ^ "_kind"); string "Zbarrier_kind"; pp_smt_exp bk] ^^ hardline
-     ^^ pp_sfun "define-const" [string (name ^ "_active"); pp_smt_typ Bool; pp_smt_exp active]
+  | Barrier b ->
+     pp_sfun "define-const" [string (b.name ^ "_kind"); string "Zbarrier_kind"; pp_smt_exp b.kind] ^^ hardline
+     ^^ pp_sfun "define-const" [string (b.name ^ "_active"); pp_smt_typ Bool; pp_smt_exp b.active]
+
+  | Cache_maintenance m ->
+     pp_sfun "define-const" [string (m.name ^ "_active"); pp_smt_typ Bool; pp_smt_exp m.active] ^^ hardline
+     ^^ pp_sfun "define-const" [string (m.name ^ "_kind"); string "Zcache_op_kind"; pp_smt_exp m.kind] ^^ hardline
+     ^^ pp_sfun "define-const" [string (m.name ^ "_addr"); pp_smt_typ m.addr_type; pp_smt_exp m.addr]
+
+  | Branch_announce c ->
+     pp_sfun "define-const" [string (c.name ^ "_active"); pp_smt_typ Bool; pp_smt_exp c.active] ^^ hardline
+     ^^ pp_sfun "define-const" [string (c.name ^ "_addr"); pp_smt_typ c.addr_type; pp_smt_exp c.addr]
 
   | Excl_res (name, _, active) ->
      pp_sfun "declare-const" [string (name ^ "_res"); pp_smt_typ Bool] ^^ hardline
@@ -404,7 +557,7 @@ let pp_smt_def =
      let pp_ctor (ctor_name, fields) =
        match fields with
        | [] -> parens (string ctor_name)
-       | _ -> pp_sfun ctor_name (List.map (fun field -> parens (pp_str_smt_typ field)) fields)
+       | _ -> pp_sfun ctor_name (List.map pp_str_smt_typ fields)
      in
      pp_sfun "declare-datatypes"
        [Printf.ksprintf string "((%s 0))" name;
@@ -529,7 +682,7 @@ let check_counterexample ast env fname function_id args arg_ctyps arg_smt_names
      prerr_endline (sprintf "Solver found counterexample: %s" Util.("ok" |> green |> clear));
      let counterexample = build_counterexample args arg_ctyps arg_smt_names model in
      List.iter (fun (id, v) -> prerr_endline ("  " ^ string_of_id id ^ " -> " ^ string_of_value v)) counterexample;
-     let istate = initial_state ast env primops in
+     let istate = initial_state ast env !primops in
      let annot = (Parse_ast.Unknown, Type_check.mk_tannot env bool_typ no_effect) in
      let call = E_aux (E_app (function_id, List.map (fun (_, v) -> E_aux (E_internal_value v, (Parse_ast.Unknown, Type_check.empty_tannot))) counterexample), annot) in
      let result = run (Step (lazy "", istate, return call, [])) in
diff --git a/src/spec_analysis.ml b/src/spec_analysis.ml
index 40855eec..75f2ff6e 100644
--- a/src/spec_analysis.ml
+++ b/src/spec_analysis.ml
@@ -89,8 +89,8 @@ let rec free_type_names_t consider_var (Typ_aux (t, l)) = match t with
   | Typ_id name -> Nameset.add (string_of_id name) mt
   | Typ_fn (arg_typs,ret_typ,_) ->
      List.fold_left Nameset.union (free_type_names_t consider_var ret_typ) (List.map (free_type_names_t consider_var) arg_typs)
-  | Typ_bidir (t1, t2) -> Nameset.union (free_type_names_t consider_var t1)
-                                        (free_type_names_t consider_var t2)
+  | Typ_bidir (t1,t2,_) -> Nameset.union (free_type_names_t consider_var t1)
+                                         (free_type_names_t consider_var t2)
   | Typ_tup ts -> free_type_names_ts consider_var ts
   | Typ_app (name,targs) -> Nameset.add (string_of_id name) (free_type_names_t_args consider_var targs)
   | Typ_exist (kopts,_,t') -> List.fold_left (fun s kopt -> Nameset.remove (string_of_kid (kopt_kid kopt)) s) (free_type_names_t consider_var t') kopts
@@ -121,7 +121,7 @@ let rec fv_of_typ consider_var bound used (Typ_aux (t,l)) : Nameset.t =
   | Typ_id id -> conditional_add_typ bound used id
   | Typ_fn(arg,ret,_) ->
      fv_of_typ consider_var bound (List.fold_left Nameset.union Nameset.empty (List.map (fv_of_typ consider_var bound used) arg)) ret
-  | Typ_bidir(t1, t2) -> fv_of_typ consider_var bound (fv_of_typ consider_var bound used t1) t2 (* TODO FIXME? *)
+  | Typ_bidir(t1,t2,_) -> fv_of_typ consider_var bound (fv_of_typ consider_var bound used t1) t2 (* TODO FIXME? *)
   | Typ_tup ts -> List.fold_right (fun t n -> fv_of_typ consider_var bound n t) ts used
   | Typ_app(id,targs) ->
      List.fold_right (fun ta n -> fv_of_targ consider_var bound n ta) targs (conditional_add_typ bound used id)
diff --git a/src/specialize.ml b/src/specialize.ml
index 483697ce..d705b83a 100644
--- a/src/specialize.ml
+++ b/src/specialize.ml
@@ -92,7 +92,7 @@ let rec nexp_simp_typ (Typ_aux (typ_aux, l)) =
     | Typ_exist (kids, nc, typ) -> Typ_exist (kids, nc, nexp_simp_typ typ)
     | Typ_fn (arg_typs, ret_typ, effect) ->
        Typ_fn (List.map nexp_simp_typ arg_typs, nexp_simp_typ ret_typ, effect)
-    | Typ_bidir (t1, t2) -> Typ_bidir (nexp_simp_typ t1, nexp_simp_typ t2)
+    | Typ_bidir (t1, t2, effect) -> Typ_bidir (nexp_simp_typ t1, nexp_simp_typ t2, effect)
     | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   in
   Typ_aux (typ_aux, l)
@@ -170,8 +170,8 @@ let string_of_instantiation instantiation =
     | Typ_app (id, args) -> string_of_id id ^ "(" ^ Util.string_of_list "," string_of_typ_arg args ^ ")"
     | Typ_fn (arg_typs, ret_typ, eff) ->
        "(" ^ Util.string_of_list ", " string_of_typ arg_typs ^ ") -> " ^ string_of_typ ret_typ ^ " effect " ^ string_of_effect eff
-    | Typ_bidir (t1, t2) ->
-       string_of_typ t1 ^ " <-> " ^ string_of_typ t2
+    | Typ_bidir (t1, t2, eff) ->
+       string_of_typ t1 ^ " <-> " ^ string_of_typ t2 ^ " effect " ^ string_of_effect eff
     | Typ_exist (kids, nc, typ) ->
        "exist " ^ Util.string_of_list " " kid_name kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ
     | Typ_internal_unknown -> "UNKNOWN"
@@ -290,7 +290,7 @@ let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | Typ_exist (kopts, nc, typ) -> typ_frees ~exs:(KidSet.of_list (List.map kopt_kid kopts)) typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.fold_left KidSet.union (typ_frees ~exs:exs ret_typ) (List.map (typ_frees ~exs:exs) arg_typs)
-  | Typ_bidir (t1, t2) -> KidSet.union (typ_frees ~exs:exs t1) (typ_frees ~exs:exs t2)
+  | Typ_bidir (t1, t2, _) -> KidSet.union (typ_frees ~exs:exs t1) (typ_frees ~exs:exs t2)
   | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and typ_arg_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
@@ -308,7 +308,7 @@ let rec typ_int_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | Typ_exist (kopts, nc, typ) -> typ_int_frees ~exs:(KidSet.of_list (List.map kopt_kid kopts)) typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.fold_left KidSet.union (typ_int_frees ~exs:exs ret_typ) (List.map (typ_int_frees ~exs:exs) arg_typs)
-  | Typ_bidir (t1, t2) -> KidSet.union (typ_int_frees ~exs:exs t1) (typ_int_frees ~exs:exs t2)
+  | Typ_bidir (t1, t2, _) -> KidSet.union (typ_int_frees ~exs:exs t1) (typ_int_frees ~exs:exs t2)
   | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and typ_arg_int_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
@@ -325,7 +325,7 @@ let rec remove_implicit (Typ_aux (aux, l) as t) =
   | Typ_internal_unknown -> Typ_aux (Typ_internal_unknown, l)
   | Typ_tup typs -> Typ_aux (Typ_tup (List.map remove_implicit typs), l)
   | Typ_fn (arg_typs, ret_typ, effs) -> Typ_aux (Typ_fn (List.map remove_implicit arg_typs, remove_implicit ret_typ, effs), l)
-  | Typ_bidir (typ1, typ2) -> Typ_aux (Typ_bidir (remove_implicit typ1, remove_implicit typ2), l)
+  | Typ_bidir (typ1, typ2, effs) -> Typ_aux (Typ_bidir (remove_implicit typ1, remove_implicit typ2, effs), l)
   | Typ_app (Id_aux (Id "implicit", _), args) -> Typ_aux (Typ_app (mk_id "atom", List.map remove_implicit_arg args), l)
   | Typ_app (id, args) -> Typ_aux (Typ_app (id, List.map remove_implicit_arg args), l)
   | Typ_id id -> Typ_aux (Typ_id id, l)
@@ -602,11 +602,9 @@ let rec specialize_passes n spec env ast =
 let specialize = specialize_passes (-1)
 
 let () =
-  let open Printf in
   let open Interactive in
-
-  (fun _ ->
+  Action (fun () ->
     let ast', env' = specialize typ_ord_specialization !env !ast in
     ast := ast';
-    env := env')
-  |> register_command ~name:"specialize" ~help:":specialize - Specialize Type and Order type variables in the AST"
+    env := env'
+  ) |> register_command ~name:"specialize" ~help:"Specialize Type and Order type variables in the AST"
diff --git a/src/state.ml b/src/state.ml
index 9d79fef0..478a3fd5 100644
--- a/src/state.ml
+++ b/src/state.ml
@@ -58,6 +58,8 @@ open PPrint
 open Pretty_print_common
 open Pretty_print_sail
 
+let opt_type_grouped_regstate = ref false
+
 let defs_of_string = ast_of_def_string
 
 let is_defined defs name = IdSet.mem (mk_id name) (ids_of_defs (Defs defs))
@@ -78,11 +80,48 @@ let find_registers defs =
       | _ -> acc
     ) [] defs
 
-let generate_regstate = function
-  | [] -> ["type regstate = unit"]
+let generate_register_id_enum = function
+  | [] -> ["type register_id = unit"]
   | registers ->
-     let reg (typ, id) = Printf.sprintf "%s : %s" (string_of_id id) (to_string (doc_typ typ)) in
-     ["struct regstate = { " ^ (String.concat ", " (List.map reg registers)) ^ " }"]
+     let reg (typ, id) = string_of_id id in
+     ["type register_id = " ^ String.concat " | " (List.map reg registers)]
+
+let rec id_of_regtyp builtins mwords (Typ_aux (t, l) as typ) = match t with
+  | Typ_id id -> id
+  | Typ_app (id, args) ->
+     let name_arg (A_aux (targ, _)) = match targ with
+       | A_typ targ -> string_of_id (id_of_regtyp builtins mwords targ)
+       | A_nexp nexp when is_nexp_constant (nexp_simp nexp) ->
+          string_of_nexp (nexp_simp nexp)
+       | A_order (Ord_aux (Ord_inc, _)) -> "inc"
+       | A_order (Ord_aux (Ord_dec, _)) -> "dec"
+       | _ ->
+          raise (Reporting.err_typ l "Unsupported register type")
+     in
+     if IdSet.mem id builtins && not (mwords && is_bitvector_typ typ) then id else
+     append_id id (String.concat "_" ("" :: List.map name_arg args))
+  | _ -> raise (Reporting.err_typ l "Unsupported register type")
+
+let regstate_field typ = append_id (id_of_regtyp IdSet.empty false typ) "_reg"
+
+let generate_regstate registers =
+  let regstate_def =
+    if registers = [] then
+      TD_abbrev (mk_id "regstate", mk_typquant [], mk_typ_arg (A_typ unit_typ))
+    else
+      let fields =
+        if !opt_type_grouped_regstate then
+          List.map
+            (fun (typ, id) ->
+                 (function_typ [string_typ] typ no_effect,
+                  regstate_field typ))
+            registers
+          |> List.sort_uniq (fun (typ1, id1) (typ2, id2) -> Id.compare id1 id2)
+        else registers
+      in
+      TD_record (mk_id "regstate", mk_typquant [], fields, false)
+  in
+  Defs [DEF_type (TD_aux (regstate_def, (Unknown, ())))]
 
 let generate_initial_regstate defs =
   let registers = find_registers defs in
@@ -181,27 +220,15 @@ let generate_initial_regstate defs =
       | _ -> inits) ([], Bindings.empty) defs
     in
     let init_reg (typ, id) = string_of_id id ^ " = " ^ lookup_init_val init_vals typ in
-    init_defs @
-    ["let initial_regstate : regstate = struct { " ^ (String.concat ", " (List.map init_reg registers)) ^ " }"]
+    List.map defs_of_string
+      (init_defs @
+       ["let initial_regstate : regstate = struct { " ^
+        (String.concat ", " (List.map init_reg registers)) ^
+        " }"])
   with
   | _ -> [] (* Do not generate an initial register state if anything goes wrong *)
 
-let rec regval_constr_id mwords (Typ_aux (t, l) as typ) = match t with
-  | Typ_id id -> id
-  | Typ_app (id, args) ->
-     let name_arg (A_aux (targ, _)) = match targ with
-       | A_typ targ -> string_of_id (regval_constr_id mwords targ)
-       | A_nexp nexp when is_nexp_constant (nexp_simp nexp) ->
-          string_of_nexp (nexp_simp nexp)
-       | A_order (Ord_aux (Ord_inc, _)) -> "inc"
-       | A_order (Ord_aux (Ord_dec, _)) -> "dec"
-       | _ ->
-          raise (Reporting.err_typ l "Unsupported register type")
-     in
-     let builtins = IdSet.of_list (List.map mk_id ["vector"; "bitvector"; "list"; "option"]) in
-     if IdSet.mem id builtins && not (mwords && is_bitvector_typ typ) then id else
-     append_id id (String.concat "_" ("" :: List.map name_arg args))
-  | _ -> raise (Reporting.err_typ l "Unsupported register type")
+let regval_constr_id = id_of_regtyp (IdSet.of_list (List.map mk_id ["vector"; "bitvector"; "list"; "option"]))
 
 let register_base_types mwords typs =
   let rec add_base_typs typs (Typ_aux (t, _) as typ) =
@@ -211,8 +238,8 @@ let register_base_types mwords typs =
         when IdSet.mem id builtins && not (mwords && is_bitvector_typ typ) ->
          let add_typ_arg base_typs (A_aux (targ, _)) =
            match targ with
-             | A_typ typ -> add_base_typs typs typ
-             | _ -> typs
+             | A_typ typ -> add_base_typs base_typs typ
+             | _ -> base_typs
          in
          List.fold_left add_typ_arg typs args
       | _ -> Bindings.add (regval_constr_id mwords typ) typ typs
@@ -223,13 +250,14 @@ let generate_regval_typ typs =
   let constr (constr_id, typ) =
     Printf.sprintf "Regval_%s : %s" (string_of_id constr_id) (to_string (doc_typ typ)) in
   let builtins =
-    "Regval_vector : (int, bool, list(register_value)), " ^
+    "Regval_vector : list(register_value), " ^
     "Regval_list : list(register_value), " ^
     "Regval_option : option(register_value)"
   in
-  ["union register_value = { " ^
-  (String.concat ", " (builtins :: List.map constr (Bindings.bindings typs))) ^
-  " }"]
+  [defs_of_string
+    ("union register_value = { " ^
+     (String.concat ", " (builtins :: List.map constr (Bindings.bindings typs))) ^
+     " }")]
 
 let add_regval_conv id typ (Defs defs) =
   let id = string_of_id id in
@@ -253,11 +281,9 @@ let add_regval_conv id typ (Defs defs) =
 let rec regval_convs_lem mwords (Typ_aux (t, _) as typ) = match t with
   | Typ_app _ when (is_vector_typ typ || is_bitvector_typ typ) && not (mwords && is_bitvector_typ typ) ->
      let size, ord, etyp = vector_typ_args_of typ in
-     let size = string_of_nexp (nexp_simp size) in
-     let is_inc = if is_order_inc ord then "true" else "false" in
      let etyp_of, of_etyp = regval_convs_lem mwords etyp in
      "(fun v -> vector_of_regval " ^ etyp_of ^ " v)",
-     "(fun v -> regval_of_vector " ^ of_etyp ^ " " ^ size ^ " " ^ is_inc ^ " v)"
+     "(fun v -> regval_of_vector " ^ of_etyp ^ " v)"
   | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "list" ->
      let etyp_of, of_etyp = regval_convs_lem mwords etyp in
@@ -277,12 +303,12 @@ let register_refs_lem mwords registers =
     separate_map hardline string [
       "val vector_of_regval : forall 'a. (register_value -> maybe 'a) -> register_value -> maybe (list 'a)";
       "let vector_of_regval of_regval = function";
-      "  | Regval_vector (_, _, v) -> just_list (List.map of_regval v)";
+      "  | Regval_vector v -> just_list (List.map of_regval v)";
       "  | _ -> Nothing";
       "end";
       "";
-      "val regval_of_vector : forall 'a. ('a -> register_value) -> integer -> bool -> list 'a -> register_value";
-      "let regval_of_vector regval_of size is_inc xs = Regval_vector (size, is_inc, List.map regval_of xs)";
+      "val regval_of_vector : forall 'a. ('a -> register_value) -> list 'a -> register_value";
+      "let regval_of_vector regval_of xs = Regval_vector (List.map regval_of xs)";
       "";
       "val list_of_regval : forall 'a. (register_value -> maybe 'a) -> register_value -> maybe (list 'a)";
       "let list_of_regval of_regval = function";
@@ -307,12 +333,20 @@ let register_refs_lem mwords registers =
   in
   let register_ref (typ, id) =
     let idd = string (string_of_id id) in
+    let (read_from, write_to) =
+      if !opt_type_grouped_regstate then
+        let field_idd = string (string_of_id (regstate_field typ)) in
+        (field_idd ^^ space ^^ dquotes idd,
+         doc_op equals field_idd (string "(fun reg -> if reg = \"" ^^ idd ^^ string "\" then v else s." ^^ field_idd ^^ string " reg)"))
+      else
+        (idd, doc_op equals idd (string "v"))
+    in
     (* let field = if prefix_recordtype then string "regstate_" ^^ idd else idd in *)
     let of_regval, regval_of = regval_convs_lem mwords typ in
     concat [string "let "; idd; string "_ref = <|"; hardline;
       string "  name = \""; idd; string "\";"; hardline;
-      string "  read_from = (fun s -> s."; idd; string ");"; hardline;
-      string "  write_to = (fun v s -> (<| s with "; idd; string " = v |>));"; hardline;
+      string "  read_from = (fun s -> s."; read_from; string ");"; hardline;
+      string "  write_to = (fun v s -> (<| s with "; write_to; string " |>));"; hardline;
       string "  of_regval = "; string of_regval; string ";"; hardline;
       string "  regval_of = "; string regval_of; string " |>"; hardline]
   in
@@ -393,7 +427,7 @@ let generate_isa_lemmas mwords (Defs defs : tannot defs) =
   separate_map hardline string [
     "lemma vector_of_rv_rv_of_vector[simp]:";
     "  assumes \"\\<And>v. of_rv (rv_of v) = Some v\"";
-    "  shows \"vector_of_regval of_rv (regval_of_vector rv_of len is_inc v) = Some v\"";
+    "  shows \"vector_of_regval of_rv (regval_of_vector rv_of v) = Some v\"";
     "proof -";
     "  from assms have \"of_rv \\<circ> rv_of = Some\" by auto";
     "  then show ?thesis by (auto simp: vector_of_regval_def regval_of_vector_def)";
@@ -421,7 +455,7 @@ let rec regval_convs_coq (Typ_aux (t, _) as typ) = match t with
      let is_inc = if is_order_inc ord then "true" else "false" in
      let etyp_of, of_etyp = regval_convs_coq etyp in
      "(fun v => vector_of_regval " ^ size ^ " " ^ etyp_of ^ " v)",
-     "(fun v => regval_of_vector " ^ of_etyp ^ " " ^ size ^ " " ^ is_inc ^ " v)"
+     "(fun v => regval_of_vector " ^ of_etyp ^ " v)"
   | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "list" ->
      let etyp_of, of_etyp = regval_convs_coq etyp in
@@ -440,11 +474,11 @@ let register_refs_coq registers =
   let generic_convs =
     separate_map hardline string [
       "Definition vector_of_regval {a} n (of_regval : register_value -> option a) (rv : register_value) : option (vec a n) := match rv with";
-      "  | Regval_vector (n', _, v) => if n =? n' then map_bind (vec_of_list n) (just_list (List.map of_regval v)) else None";
+      "  | Regval_vector v => if n =? length_list v then map_bind (vec_of_list n) (just_list (List.map of_regval v)) else None";
       "  | _ => None";
       "end.";
       "";
-      "Definition regval_of_vector {a} (regval_of : a -> register_value) (size : Z) (is_inc : bool) (xs : vec a size) : register_value := Regval_vector (size, is_inc, List.map regval_of (list_of_vec xs)).";
+      "Definition regval_of_vector {a size} (regval_of : a -> register_value) (xs : vec a size) : register_value := Regval_vector (List.map regval_of (list_of_vec xs)).";
       "";
       "Definition list_of_regval {a} (of_regval : register_value -> option a) (rv : register_value) : option (list a) := match rv with";
       "  | Regval_list v => just_list (List.map of_regval v)";
@@ -504,14 +538,20 @@ let generate_regstate_defs mwords defs =
   let regtyps = register_base_types mwords (List.map fst registers) in
   let option_typ =
     if is_defined defs "option" then [] else
-      ["union option ('a : Type) = {None : unit, Some : 'a}"]
+      [defs_of_string "union option ('a : Type) = {None : unit, Some : 'a}"]
   in
   let regval_typ = if is_defined defs "register_value" then [] else generate_regval_typ regtyps in
-  let regstate_typ = if is_defined defs "regstate" then [] else generate_regstate registers in
-  let initregstate = if is_defined defs "initial_regstate" then [] else generate_initial_regstate defs in
+  let regstate_typ = if is_defined defs "regstate" then [] else [generate_regstate registers] in
+  let initregstate =
+    (* Don't create initial regstate if it is already defined or if we generated
+       a regstate record with registers grouped per type; the latter would
+       require record fields storing functions, which is not supported in
+       Sail. *)
+    if is_defined defs "initial_regstate" || !opt_type_grouped_regstate then [] else
+    generate_initial_regstate defs
+  in
   let defs =
     option_typ @ regval_typ @ regstate_typ @ initregstate
-    |> List.map defs_of_string
     |> concat_ast
     |> Bindings.fold add_regval_conv regtyps
   in
diff --git a/src/type_check.ml b/src/type_check.ml
index af4a7f65..73ad5362 100644
--- a/src/type_check.ml
+++ b/src/type_check.ml
@@ -79,6 +79,9 @@ let opt_smt_linearize = ref false
 (* Allow use of div and mod when rewriting nexps *)
 let opt_smt_div = ref false
 
+(* Use new bitfield syntax, more compatible with ASL *)
+let opt_new_bitfields = ref false
+
 let depth = ref 0
 
 let rec indent n = match n with
@@ -112,6 +115,7 @@ type env =
     union_ids : (typquant * typ) Bindings.t;
     registers : (effect * effect * typ) Bindings.t;
     variants : (typquant * type_union list) Bindings.t;
+    scattered_variant_envs : env Bindings.t;
     mappings : (typquant * typ * typ) Bindings.t;
     typ_vars : (Ast.l * kind_aux) KBindings.t;
     shadow_vars : int KBindings.t;
@@ -130,6 +134,7 @@ type env =
     poly_undefineds : bool;
     prove : (env -> n_constraint -> bool) option;
     allow_unknowns : bool;
+    bitfields : (Big_int.num * Big_int.num) Bindings.t Bindings.t;
   }
 
 exception Type_error of env * l * type_error;;
@@ -233,7 +238,7 @@ and strip_typ_aux : typ_aux -> typ_aux = function
   | Typ_id id -> Typ_id (strip_id id)
   | Typ_var kid -> Typ_var (strip_kid kid)
   | Typ_fn (arg_typs, ret_typ, effect) -> Typ_fn (List.map strip_typ arg_typs, strip_typ ret_typ, strip_effect effect)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (strip_typ typ1, strip_typ typ2)
+  | Typ_bidir (typ1, typ2, effect) -> Typ_bidir (strip_typ typ1, strip_typ typ2, strip_effect effect)
   | Typ_tup typs -> Typ_tup (List.map strip_typ typs)
   | Typ_exist (kopts, constr, typ) ->
      Typ_exist ((List.map strip_kinded_id kopts), strip_n_constraint constr, strip_typ typ)
@@ -267,7 +272,7 @@ let rec typ_constraints (Typ_aux (typ_aux, l)) =
   | Typ_exist (kids, nc, typ) -> typ_constraints typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.concat (List.map typ_constraints arg_typs) @ typ_constraints ret_typ
-  | Typ_bidir (typ1, typ2) ->
+  | Typ_bidir (typ1, typ2, _) ->
      typ_constraints typ1 @ typ_constraints typ2
 and typ_arg_nexps (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
@@ -286,7 +291,7 @@ let rec typ_nexps (Typ_aux (typ_aux, l)) =
   | Typ_exist (kids, nc, typ) -> typ_nexps typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.concat (List.map typ_nexps arg_typs) @ typ_nexps ret_typ
-  | Typ_bidir (typ1, typ2) ->
+  | Typ_bidir (typ1, typ2, _) ->
      typ_nexps typ1 @ typ_nexps typ2
 and typ_arg_nexps (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
@@ -421,7 +426,8 @@ module Env : sig
   val add_scattered_variant : id -> typquant -> t -> t
   val add_variant_clause : id -> type_union -> t -> t
   val get_variant : id -> t -> typquant * type_union list
-  val add_mapping : id -> typquant * typ * typ -> t -> t
+  val get_scattered_variant_env : id -> t -> t
+  val add_mapping : id -> typquant * typ * typ * effect -> t -> t
   val add_union_id : id -> typquant * typ -> t -> t
   val get_union_id  : id -> t -> typquant * typ
   val is_register : id -> t -> bool
@@ -434,6 +440,7 @@ module Env : sig
   val get_typ_var_loc : kid -> t -> Ast.l
   val get_typ_vars : t -> kind_aux KBindings.t
   val get_typ_var_locs : t -> Ast.l KBindings.t
+  val shadows : kid -> t -> int
   val add_typ_var_shadow : l -> kinded_id -> t -> t * kid option
   val add_typ_var : l -> kinded_id -> t -> t
   val get_ret_typ : t -> typ option
@@ -467,6 +474,8 @@ module Env : sig
   val base_typ_of : t -> typ -> typ
   val allow_unknowns : t -> bool
   val set_allow_unknowns : bool -> t -> t
+  val add_bitfield : id -> (Big_int.num * Big_int.num) Bindings.t -> t -> t
+  val get_bitfield_range : l -> id -> id -> t -> (Big_int.num * Big_int.num)
 
   val no_bindings : t -> t
 
@@ -499,6 +508,7 @@ end = struct
       union_ids = Bindings.empty;
       registers = Bindings.empty;
       variants = Bindings.empty;
+      scattered_variant_envs = Bindings.empty;
       mappings = Bindings.empty;
       typ_vars = KBindings.empty;
       shadow_vars = KBindings.empty;
@@ -517,6 +527,7 @@ end = struct
       poly_undefineds = false;
       prove = None;
       allow_unknowns = false;
+      bitfields = Bindings.empty;
     }
 
   let set_prover f env = { env with prove = f }
@@ -563,8 +574,8 @@ end = struct
   let builtin_mappings =
     List.fold_left (fun m (name, typ) -> Bindings.add (mk_id name) typ m) Bindings.empty
       [
-        ("int", Typ_bidir(int_typ, string_typ));
-        ("nat", Typ_bidir(nat_typ, string_typ));
+        ("int", Typ_bidir(int_typ, string_typ, no_effect));
+        ("nat", Typ_bidir(nat_typ, string_typ, no_effect));
       ]
 
   let bound_typ_id env id =
@@ -715,7 +726,7 @@ end = struct
     | Typ_internal_unknown -> Typ_aux (Typ_internal_unknown, l)
     | Typ_tup typs -> Typ_aux (Typ_tup (List.map (expand_synonyms env) typs), l)
     | Typ_fn (arg_typs, ret_typ, effs) -> Typ_aux (Typ_fn (List.map (expand_synonyms env) arg_typs, expand_synonyms env ret_typ, effs), l)
-    | Typ_bidir (typ1, typ2) -> Typ_aux (Typ_bidir (expand_synonyms env typ1, expand_synonyms env typ2), l)
+    | Typ_bidir (typ1, typ2, effs) -> Typ_aux (Typ_bidir (expand_synonyms env typ1, expand_synonyms env typ2, effs), l)
     | Typ_app (id, args) ->
        (try
           begin match get_typ_synonym id env l env args with
@@ -776,7 +787,7 @@ end = struct
     | Typ_internal_unknown
     | Typ_id _ | Typ_var _ -> typ
     | Typ_fn (arg_typs, ret_typ, effect) -> Typ_aux (Typ_fn (List.map (map_nexps f) arg_typs, map_nexps f ret_typ, effect), l)
-    | Typ_bidir (typ1, typ2) -> Typ_aux (Typ_bidir (map_nexps f typ1, map_nexps f typ2), l)
+    | Typ_bidir (typ1, typ2, effect) -> Typ_aux (Typ_bidir (map_nexps f typ1, map_nexps f typ2, effect), l)
     | Typ_tup typs -> Typ_aux (Typ_tup (List.map (map_nexps f) typs), l)
     | Typ_exist (kids, nc, typ) -> Typ_aux (Typ_exist (kids, nc, map_nexps f typ), l)
     | Typ_app (id, args) -> Typ_aux (Typ_app (id, List.map (map_nexps_arg f) args), l)
@@ -803,15 +814,15 @@ end = struct
     | Typ_var kid -> begin
       match KBindings.find kid env.typ_vars with
       | (_, K_type) -> ()
-      | (_, k) -> typ_error env l ("Kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ
+      | (_, k) -> typ_error env l ("Type variable " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ
                                ^ " is " ^ string_of_kind_aux k ^ " rather than Type")
       | exception Not_found ->
-         typ_error env l ("Unbound kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ)
+         typ_error env l ("Unbound type variable " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ)
     end
     | Typ_fn (arg_typs, ret_typ, effs) -> List.iter (wf_typ ~exs:exs env) arg_typs; wf_typ ~exs:exs env ret_typ
-    | Typ_bidir (typ1, typ2) when strip_typ typ1 = strip_typ typ2 ->
+    | Typ_bidir (typ1, typ2, _) when strip_typ typ1 = strip_typ typ2 ->
        typ_error env l "Bidirectional types cannot be the same on both sides"
-    | Typ_bidir (typ1, typ2) -> wf_typ ~exs:exs env typ1; wf_typ ~exs:exs env typ2
+    | Typ_bidir (typ1, typ2, _) -> wf_typ ~exs:exs env typ1; wf_typ ~exs:exs env typ2
     | Typ_tup typs -> List.iter (wf_typ ~exs:exs env) typs
     | Typ_app (id, [A_aux (A_nexp _, _) as arg]) when string_of_id id = "implicit" ->
        wf_typ_arg ~exs:exs env arg
@@ -969,8 +980,8 @@ end = struct
        typ_print (lazy (adding ^ "val " ^ string_of_id id ^ " : " ^ string_of_bind (typq, typ)));
        { env with top_val_specs = Bindings.add id (typq, typ) env.top_val_specs }
 
-    | Typ_aux (Typ_bidir (typ1, typ2), l) ->
-       let env = add_mapping id (typq, typ1, typ2) env in
+    | Typ_aux (Typ_bidir (typ1, typ2, effect), l) ->
+       let env = add_mapping id (typq, typ1, typ2, effect) env in
        typ_print (lazy (adding ^ "mapping " ^ string_of_id id ^ " : " ^ string_of_bind (typq, typ)));
        { env with top_val_specs = Bindings.add id (typq, typ) env.top_val_specs }
 
@@ -992,16 +1003,16 @@ end = struct
         env
          *)
 
-  and add_mapping id (typq, typ1, typ2) env =
+  and add_mapping id (typq, typ1, typ2, effect) env =
     typ_print (lazy (adding ^ "mapping " ^ string_of_id id));
     let forwards_id = mk_id (string_of_id id ^ "_forwards") in
     let forwards_matches_id = mk_id (string_of_id id ^ "_forwards_matches") in
     let backwards_id = mk_id (string_of_id id ^ "_backwards") in
     let backwards_matches_id = mk_id (string_of_id id ^ "_backwards_matches") in
-    let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, no_effect), Parse_ast.Unknown) in
-    let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, no_effect), Parse_ast.Unknown) in
-    let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, no_effect), Parse_ast.Unknown) in
-    let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, no_effect), Parse_ast.Unknown) in
+    let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, effect), Parse_ast.Unknown) in
+    let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, effect), Parse_ast.Unknown) in
+    let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, effect), Parse_ast.Unknown) in
+    let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, effect), Parse_ast.Unknown) in
     let env =
       { env with mappings = Bindings.add id (typq, typ1, typ2) env.mappings }
       |> add_val_spec forwards_id (typq, forwards_typ)
@@ -1059,7 +1070,7 @@ end = struct
     | Not_found -> typ_error env (id_loc id) ("Enumeration " ^ string_of_id id ^ " does not exist")
 
   let is_enum id env = Bindings.mem id env.enums
-                 
+
   let is_record id env = Bindings.mem id env.records
 
   let get_record id env = Bindings.find id env.records
@@ -1140,7 +1151,10 @@ end = struct
 
   let add_scattered_variant id typq env =
     typ_print (lazy (adding ^ "scattered variant " ^ string_of_id id));
-    { env with variants = Bindings.add id (typq, []) env.variants }
+    { env with
+      variants = Bindings.add id (typq, []) env.variants;
+      scattered_variant_envs = Bindings.add id env env.scattered_variant_envs
+    }
 
   let add_variant_clause id tu env =
     match Bindings.find_opt id env.variants with
@@ -1152,6 +1166,11 @@ end = struct
     | Some (typq, tus) -> typq, tus
     | None -> typ_error env (id_loc id) ("union " ^ string_of_id id ^ " not found")
 
+  let get_scattered_variant_env id env =
+    match Bindings.find_opt id env.scattered_variant_envs with
+    | Some env' -> env'
+    | None -> typ_error env (id_loc id) ("scattered union " ^ string_of_id id ^ " has not been declared")
+
   let is_register id env =
     Bindings.mem id env.registers
 
@@ -1206,6 +1225,8 @@ end = struct
     with
     | Not_found -> Unbound
 
+  let shadows v env = match KBindings.find_opt v env.shadow_vars with Some n -> n | None -> 0
+                 
   let add_typ_var_shadow l (KOpt_aux (KOpt_kind (K_aux (k, _), v), _)) env =
     if KBindings.mem v env.typ_vars then begin
         let n = match KBindings.find_opt v env.shadow_vars with Some n -> n | None -> 0 in
@@ -1308,6 +1329,18 @@ end = struct
       | targ -> rewrap targ in
     aux (expand_synonyms env typ)
 
+  let get_bitfield_range l id field env =
+    match Bindings.find_opt id env.bitfields with
+    | Some ranges ->
+       begin match Bindings.find_opt field ranges with
+       | Some range -> range
+       | None -> typ_error env l (Printf.sprintf "Field %s does not exist in the bitfield %s" (string_of_id field) (string_of_id id))
+       end
+    | None -> typ_error env l (Printf.sprintf "%s is not a bitfield" (string_of_id id))
+
+  let add_bitfield id ranges env =
+    { env with bitfields = Bindings.add id ranges env.bitfields }
+
   let allow_polymorphic_undefineds env =
     { env with poly_undefineds = true }
 
@@ -1335,10 +1368,12 @@ let add_typquant l (quant : typquant) (env : Env.t) : Env.t =
 let expand_bind_synonyms l env (typq, typ) =
   typq, Env.expand_synonyms (add_typquant l typq env) typ
 
-let wf_typschm env (TypSchm_aux (TypSchm_ts (typq, typ), l)) =
+let wf_binding l env (typq, typ) =
   let env = add_typquant l typq env in
   Env.wf_typ env typ
 
+let wf_typschm env (TypSchm_aux (TypSchm_ts (typq, typ), l)) = wf_binding l env (typq, typ)
+
 (* Create vectors with the default order from the environment *)
 
 let default_order_error_string =
@@ -1367,6 +1402,16 @@ let bind_numeric l typ env =
      nexp, add_existential l (List.map (mk_kopt K_int) kids) nc env
   | None -> typ_error env l ("Expected " ^ string_of_typ typ ^ " to be numeric")
 
+let rec check_shadow_leaks l inner_env outer_env typ =
+  let vars = tyvars_of_typ typ in
+  List.iter (fun var ->
+      if Env.shadows var inner_env > Env.shadows var outer_env then
+        typ_error outer_env l
+          ("Type variable " ^ string_of_kid var ^ " would leak into a scope where it is shadowed")
+      else ())
+    (KidSet.elements vars);
+  typ
+   
 (** Pull an (potentially)-existentially qualified type into the global
    typing environment **)
 let bind_existential l name typ env =
@@ -1419,7 +1464,7 @@ let rec is_typ_monomorphic (Typ_aux (typ, l)) =
   | Typ_tup typs -> List.for_all is_typ_monomorphic typs
   | Typ_app (id, args) -> List.for_all is_typ_arg_monomorphic args
   | Typ_fn (arg_typs, ret_typ, _) -> List.for_all is_typ_monomorphic arg_typs && is_typ_monomorphic ret_typ
-  | Typ_bidir (typ1, typ2) -> is_typ_monomorphic typ1 && is_typ_monomorphic typ2
+  | Typ_bidir (typ1, typ2, _) -> is_typ_monomorphic typ1 && is_typ_monomorphic typ2
   | Typ_exist _ | Typ_var _ -> false
   | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and is_typ_arg_monomorphic (A_aux (arg, _)) =
@@ -1618,9 +1663,10 @@ and typ_identical (Typ_aux (typ1, _)) (Typ_aux (typ2, _)) =
      List.for_all2 typ_identical arg_typs1 arg_typs2
      && typ_identical ret_typ1 ret_typ2
      && strip_effect eff1 = strip_effect eff2
-  | Typ_bidir (typ1, typ2), Typ_bidir (typ3, typ4) ->
+  | Typ_bidir (typ1, typ2, eff1), Typ_bidir (typ3, typ4, eff2) ->
      typ_identical typ1 typ3
      && typ_identical typ2 typ4
+     && strip_effect eff1 = strip_effect eff2
   | Typ_tup typs1, Typ_tup typs2 ->
      begin
        try List.for_all2 typ_identical typs1 typs2 with
@@ -2018,7 +2064,7 @@ let rec alpha_equivalent env typ1 typ2 =
       | Typ_internal_unknown -> Typ_internal_unknown
       | Typ_id _ | Typ_var _ -> aux
       | Typ_fn (arg_typs, ret_typ, eff) -> Typ_fn (List.map relabel arg_typs, relabel ret_typ, eff)
-      | Typ_bidir (typ1, typ2) -> Typ_bidir (relabel typ1, relabel typ2)
+      | Typ_bidir (typ1, typ2, eff) -> Typ_bidir (relabel typ1, relabel typ2, eff)
       | Typ_tup typs -> Typ_tup (List.map relabel typs)
       | Typ_exist (kopts, nc, typ) ->
          let kind_map = List.fold_left (fun m kopt -> KBindings.add (kopt_kid kopt) (kopt_kind kopt) m) KBindings.empty kopts in
@@ -2812,12 +2858,14 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
        | LB_val (P_aux (P_typ (ptyp, _), _) as pat, bind) ->
           Env.wf_typ env ptyp;
           let checked_bind = crule check_exp env bind ptyp in
-          let tpat, env = bind_pat_no_guard env pat ptyp in
-          annot_exp (E_let (LB_aux (LB_val (tpat, checked_bind), (let_loc, None)), crule check_exp env exp typ)) typ
+          let tpat, inner_env = bind_pat_no_guard env pat ptyp in
+          annot_exp (E_let (LB_aux (LB_val (tpat, checked_bind), (let_loc, None)), crule check_exp inner_env exp typ))
+            (check_shadow_leaks l inner_env env typ)
        | LB_val (pat, bind) ->
           let inferred_bind = irule infer_exp env bind in
-          let tpat, env = bind_pat_no_guard env pat (typ_of inferred_bind) in
-          annot_exp (E_let (LB_aux (LB_val (tpat, inferred_bind), (let_loc, None)), crule check_exp env exp typ)) typ
+          let tpat, inner_env = bind_pat_no_guard env pat (typ_of inferred_bind) in
+          annot_exp (E_let (LB_aux (LB_val (tpat, inferred_bind), (let_loc, None)), crule check_exp inner_env exp typ))
+            (check_shadow_leaks l inner_env env typ)
      end
   | E_app_infix (x, op, y), _ ->
      check_exp env (E_aux (E_app (deinfix op, [x; y]), (l, ()))) typ
@@ -3278,7 +3326,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
          | _ -> [typ]
        in
        match Env.expand_synonyms env mapping_typ with
-       | Typ_aux (Typ_bidir (typ1, typ2), _) ->
+       | Typ_aux (Typ_bidir (typ1, typ2, _), _) ->
           begin
             try
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for pattern " ^ string_of_typ typ));
@@ -3372,7 +3420,7 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
      begin
        let (typq, mapping_typ) = Env.get_val_spec f env in
        match Env.expand_synonyms env mapping_typ with
-       | Typ_aux (Typ_bidir (typ1, typ2), _) ->
+       | Typ_aux (Typ_bidir (typ1, typ2, _), _) ->
           begin
             try
               bind_pat env pat typ2
@@ -3484,46 +3532,6 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
     | _ -> false
   in
   match lexp_aux with
-  | LEXP_field (LEXP_aux (flexp, _), field) ->
-     begin
-       let infer_flexp = function
-         | LEXP_id v ->
-            begin match Env.lookup_id v env with
-            | Register (_, _, typ) -> typ, LEXP_id v, true
-            | Local (Mutable, typ) -> typ, LEXP_id v, false
-            | _ -> typ_error env l "l-expression field is not a register or a local mutable type"
-            end
-         | LEXP_vector (LEXP_aux (LEXP_id v, _), exp) ->
-            begin
-              (* Check: is this ok if the vector is immutable? *)
-              let is_immutable, vtyp, is_register = match Env.lookup_id v env with
-                | Unbound -> typ_error env l "Cannot assign to element of unbound vector"
-                | Enum _ -> typ_error env l "Cannot vector assign to enumeration element"
-                | Local (Immutable, vtyp) -> true, vtyp, false
-                | Local (Mutable, vtyp) -> false, vtyp, false
-                | Register (_, _, vtyp) -> false, vtyp, true
-              in
-              let access = infer_exp (Env.enable_casts env) (E_aux (E_app (mk_id "vector_access", [E_aux (E_id v, (l, ())); exp]), (l, ()))) in
-              let inferred_exp = match access with
-                | E_aux (E_app (_, [_; inferred_exp]), _) -> inferred_exp
-                | _ -> assert false
-              in
-              typ_of access, LEXP_vector (annot_lexp (LEXP_id v) vtyp, inferred_exp), is_register
-            end
-         | _ -> typ_error env l "Field l-expression must be either a vector or an identifier"
-       in
-       let regtyp, inferred_flexp, is_register = infer_flexp flexp in
-       typ_debug (lazy ("REGTYP: " ^ string_of_typ regtyp ^ " / " ^ string_of_typ (Env.expand_synonyms env regtyp)));
-       match Env.expand_synonyms env regtyp with
-       | Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
-          let eff = if is_register then mk_effect [BE_wreg] else no_effect in
-          let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
-          let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q regtyp with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
-          let field_typ' = subst_unifiers unifiers field_typ in
-          let checked_exp = crule check_exp env exp field_typ' in
-          annot_assign (annot_lexp (LEXP_field (annot_lexp_effect inferred_flexp regtyp eff, field)) field_typ') checked_exp, env
-       | _ ->  typ_error env l "Field l-expression has invalid type"
-     end
   | LEXP_memory (f, xs) ->
      check_exp env (E_aux (E_app (f, xs @ [exp]), (l, ()))) unit_typ, env
   | LEXP_cast (typ_annot, v) ->
@@ -3661,7 +3669,16 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
             annot_lexp (LEXP_vector (inferred_v_lexp, inferred_exp)) bit_typ
           else
             typ_error env l ("Vector assignment not provably in bounds " ^ string_of_lexp lexp)
-       | _ -> typ_error env l "Cannot assign vector element of non vector type"
+       | Typ_id id when !opt_new_bitfields ->
+          begin match exp with
+          | E_aux (E_id field, _) ->
+             let (hi, lo) = Env.get_bitfield_range l id field env in
+             let hi, lo = mk_exp ~loc:l (E_lit (L_aux (L_num hi, l))), mk_exp ~loc:l (E_lit (L_aux (L_num lo, l))) in
+             infer_lexp env (LEXP_aux (LEXP_vector_range (LEXP_aux (LEXP_field (v_lexp, Id_aux (Id "bits", l)), (l, ())), hi, lo), (l, ())))
+          | _ ->
+             typ_error env l (string_of_exp exp ^ " is not a bitfield accessor")
+          end
+       | _ -> typ_error env l "Cannot assign vector element of non vector or bitfield type"
      end
   | LEXP_vector_concat [] -> typ_error env l "Cannot have empty vector concatenation l-expression"
   | LEXP_vector_concat (v_lexp :: v_lexps) ->
@@ -3696,15 +3713,17 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
           annot_lexp (LEXP_vector_concat (inferred_v_lexp :: inferred_v_lexps)) (bitvector_typ (nexp_simp len) ord)
        | _ -> typ_error env l ("Vector concatentation l-expression must only contain bitvector or vector types, found " ^ string_of_typ v_typ)
      end
-  | LEXP_field (LEXP_aux (LEXP_id v, _), fid) ->
-     (* FIXME: will only work for ASL *)
-     let rec_id, weff =
-       match Env.lookup_id v env with
-       | Register (_, weff, Typ_aux (Typ_id rec_id, _)) -> rec_id, weff
-       | _ -> typ_error env l (string_of_lexp lexp ^ " must be a record register here")
-     in
-     let typq, _, ret_typ, _ = Env.get_accessor rec_id fid env in
-     annot_lexp_effect (LEXP_field (annot_lexp (LEXP_id v) (mk_id_typ rec_id), fid)) ret_typ weff
+  | LEXP_field ((LEXP_aux (_, (l, ())) as lexp), field_id) ->
+     let inferred_lexp = infer_lexp env lexp in
+     let rectyp = lexp_typ_of inferred_lexp in
+     begin match lexp_typ_of inferred_lexp with
+     | Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
+        let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field_id env in
+        let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q rectyp with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
+        let field_typ' = subst_unifiers unifiers field_typ in
+        annot_lexp (LEXP_field (inferred_lexp, field_id)) field_typ'
+     | _ -> typ_error env l "Field l-expression has invalid type"
+     end
   | LEXP_deref exp ->
      let inferred_exp = infer_exp env exp in
      begin match typ_of inferred_exp with
@@ -3880,7 +3899,25 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
            annot_exp (E_if (cond', then_branch', else_branch')) (typ_of then_branch')
         end
      end
-  | E_vector_access (v, n) -> infer_exp env (E_aux (E_app (mk_id "vector_access", [v; n]), (l, ())))
+  | E_vector_access (v, n) ->
+     begin
+       try infer_exp env (E_aux (E_app (mk_id "vector_access", [v; n]), (l, ()))) with
+       | Type_error (err_env, err_l, err) when !opt_new_bitfields ->
+          (try (
+             let inferred_v = infer_exp env v in
+             begin match typ_of inferred_v, n with
+             | Typ_aux (Typ_id id, _), E_aux (E_id field, (f_l, _)) ->
+                let (hi, lo) = Env.get_bitfield_range f_l id field env in
+                let hi, lo = mk_exp ~loc:l (E_lit (L_aux (L_num hi, l))), mk_exp ~loc:l (E_lit (L_aux (L_num lo, l))) in
+                infer_exp env (E_aux (E_vector_subrange (E_aux (E_field (v, Id_aux (Id "bits", f_l)), (l, ())), hi, lo), (l, ())))
+             | _, _ ->
+                typ_error env l "Vector access could not be interpreted as a bitfield access"
+             end
+           ) with
+           | Type_error (_, err_l', err') ->
+              typ_raise err_env err_l (Err_because (err, err_l', err')))
+       | exn -> raise exn
+     end
   | E_vector_update (v, n, exp) -> infer_exp env (E_aux (E_app (mk_id "vector_update", [v; n; exp]), (l, ())))
   | E_vector_update_subrange (v, n, m, exp) -> infer_exp env (E_aux (E_app (mk_id "vector_update_subrange", [v; n; m; exp]), (l, ())))
   | E_vector_append (v1, E_aux (E_vector [], _)) -> infer_exp env v1
@@ -3938,9 +3975,10 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        | LB_val (pat, bind) ->
           let inferred_bind = irule infer_exp env bind in
           inferred_bind, pat, typ_of inferred_bind in
-     let tpat, env = bind_pat_no_guard env pat ptyp in
-     let inferred_exp = irule infer_exp env exp in
-     annot_exp (E_let (LB_aux (LB_val (tpat, bind_exp), (let_loc, None)), inferred_exp)) (typ_of inferred_exp)
+     let tpat, inner_env = bind_pat_no_guard env pat ptyp in
+     let inferred_exp = irule infer_exp inner_env exp in
+     annot_exp (E_let (LB_aux (LB_val (tpat, bind_exp), (let_loc, None)), inferred_exp))
+       (check_shadow_leaks l inner_env env (typ_of inferred_exp))
   | E_ref id when Env.is_register id env ->
      let _, _, typ = Env.get_register id env in
      annot_exp (E_ref id) (register_typ typ)
@@ -4221,7 +4259,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
          | _ -> [typ]
        in
        match Env.expand_synonyms env mapping_typ with
-       | Typ_aux (Typ_bidir (typ1, typ2), _) ->
+       | Typ_aux (Typ_bidir (typ1, typ2, _), _) ->
           begin
             try
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for mapping-pattern " ^ string_of_typ typ));
@@ -4320,7 +4358,7 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
      begin
        let (typq, mapping_typ) = Env.get_val_spec f env in
        match Env.expand_synonyms env mapping_typ with
-       | Typ_aux (Typ_bidir (typ1, typ2), _) ->
+       | Typ_aux (Typ_bidir (typ1, typ2, _), _) ->
           begin
             try
               bind_mpat allow_unknown other_env env mpat typ2
@@ -4814,7 +4852,7 @@ let check_funcl env (FCL_aux (FCL_Funcl (id, pexp), (l, _))) typ =
 let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
   fun env (MCL_aux (cl, (l, _))) typ ->
     match typ with
-    | Typ_aux (Typ_bidir (typ1, typ2), _) -> begin
+    | Typ_aux (Typ_bidir (typ1, typ2, _), _) -> begin
         match cl with
         | MCL_bidir (mpexp1, mpexp2) -> begin
             let testing_env = Env.set_allow_unknowns true env in
@@ -4979,7 +5017,7 @@ let check_mapdef env (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, _)) as md
           raise err
   in
   let vtyp1, vtyp2, vl = match typ with
-    | Typ_aux (Typ_bidir (vtyp1, vtyp2), vl) -> vtyp1, vtyp2, vl
+    | Typ_aux (Typ_bidir (vtyp1, vtyp2, _), vl) -> vtyp1, vtyp2, vl
     | _ -> typ_error env l "Mapping val spec was not a mapping type"
   in
   begin match tannot_opt with
@@ -5072,55 +5110,108 @@ let fold_union_quant quants (QI_aux (qi, l)) =
   | QI_id kind_id -> quants @ [kinded_id_arg kind_id]
   | _ -> quants
 
-let check_type_union env variant typq (Tu_aux (tu, l)) =
+(* We wrap this around wf_binding checks that aim to forbid recursive
+   types to explain any error messages raised if the well-formedness
+   check fails. *)
+let forbid_recursive_types type_l f =
+  try f () with
+  | Type_error (env, l, err) ->
+     let msg = "Types are not well-formed within this type definition. Note that recursive types are forbidden." in
+     raise (Type_error (env, l, Err_because (err, type_l, Err_other msg)))
+
+let check_type_union u_l non_rec_env env variant typq (Tu_aux (tu, l)) =
   let ret_typ = app_typ variant (List.fold_left fold_union_quant [] (quant_items typq)) in
   match tu with
   | Tu_ty_id (Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) as typ, v) ->
      let typq = mk_typquant (List.map (mk_qi_id K_type) (KidSet.elements (tyvars_of_typ typ))) in
+     wf_binding l env (typq, typ);
+     forbid_recursive_types u_l (fun () -> wf_binding l non_rec_env (typq, tuple_typ arg_typ));
      env
      |> Env.add_union_id v (typq, typ)
      |> Env.add_val_spec v (typq, typ)
   | Tu_ty_id (arg_typ, v) ->
      let typ' = mk_typ (Typ_fn ([arg_typ], ret_typ, no_effect)) in
+     forbid_recursive_types u_l (fun () -> wf_binding l non_rec_env (typq, arg_typ));
+     wf_binding l env (typq, typ');
      env
      |> Env.add_union_id v (typq, typ')
      |> Env.add_val_spec v (typq, typ')
 
-(* FIXME: This code is duplicated with general kind-checking code in environment, can they be merged? *)
-
 let rec check_typedef : 'a. Env.t -> 'a type_def -> (tannot def) list * Env.t =
   fun env (TD_aux (tdef, (l, _))) ->
   let td_err () = raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Typedef") in
   match tdef with
   | TD_abbrev (id, typq, typ_arg) ->
+     begin match typ_arg with
+     | A_aux (A_typ typ, a_l) ->
+        forbid_recursive_types l (fun () -> wf_binding a_l env (typq, typ));
+     | _ -> ()
+     end;
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_typ_synonym id typq typ_arg env
   | TD_record (id, typq, fields, _) ->
+     forbid_recursive_types l (fun () -> List.iter (fun (Typ_aux (_, l) as field, _) -> wf_binding l env (typq, field)) fields);
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_record id typq fields env
   | TD_variant (id, typq, arms, _) ->
+     let rec_env = Env.add_variant id (typq, arms) env in
+     (* register_value is a special type used by theorem prover
+        backends that we allow to be recursive. *)
+     let non_rec_env = if string_of_id id = "register_value" then rec_env else env in
      let env =
-       env
-       |> Env.add_variant id (typq, arms)
-       |> (fun env -> List.fold_left (fun env tu -> check_type_union env id typq tu) env arms)
+       rec_env
+       |> (fun env -> List.fold_left (fun env tu -> check_type_union l non_rec_env env id typq tu) env arms)
      in
      [DEF_type (TD_aux (tdef, (l, None)))], env
   | TD_enum (id, ids, _) ->
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_enum id ids env
+  | TD_bitfield (id, typ, ranges) when !opt_new_bitfields ->
+     let typ = Env.expand_synonyms env typ in
+     begin match typ with
+     (* The type of a bitfield must be a constant-width bitvector *)
+     | Typ_aux (Typ_app (v, [A_aux (A_nexp (Nexp_aux (Nexp_constant size, _)), _);
+                             A_aux (A_order order, _)]), _)
+          when string_of_id v = "bitvector" ->
+        let size = Big_int.to_int size in
+        let eval_index_nexp l nexp =
+          match int_of_nexp_opt (nexp_simp (Env.expand_nexp_synonyms env nexp)) with
+          | Some i -> i
+          | None -> typ_error env l ("This numeric expression must evaluate to a constant: " ^ string_of_nexp nexp)
+        in
+        let record_tdef = TD_record (id, mk_typquant [], [(typ, mk_id "bits")], false) in
+        let ranges =
+          List.fold_left (fun ranges (field, range) ->
+              match range with
+              | BF_aux (BF_single nexp, l) ->
+                 let n = eval_index_nexp l nexp in
+                 Bindings.add field (n, n) ranges
+              | BF_aux (BF_range (hi, lo), l) ->
+                 let hi, lo = eval_index_nexp l hi, eval_index_nexp l lo in
+                 Bindings.add field (hi, lo) ranges
+              | BF_aux (BF_concat _, _) ->
+                 typ_error env l "Bitfield concatenation ranges are not supported"
+            ) Bindings.empty ranges
+        in
+        [DEF_type (TD_aux (record_tdef, (l, None)))],
+        env
+        |> Env.add_record id (mk_typquant []) [(typ, mk_id "bits")]
+        |> Env.add_bitfield id ranges
+     | _ ->
+        typ_error env l "Underlying bitfield type must be a constant-width bitvector"
+     end
   | TD_bitfield (id, typ, ranges) ->
      let typ = Env.expand_synonyms env typ in
-     begin
-       match typ with
-       (* The type of a bitfield must be a constant-width bitvector *)
-       | Typ_aux (Typ_app (v, [A_aux (A_nexp (Nexp_aux (Nexp_constant size, _)), _);
-                               A_aux (A_order order, _)]), _)
-            when string_of_id v = "bitvector" ->
-          let size = Big_int.to_int size in
-          let eval_index_nexp env nexp =
-            int_of_nexp_opt (nexp_simp (Env.expand_nexp_synonyms env nexp)) in
-          let (Defs defs), env =
-            check env (Bitfield.macro (eval_index_nexp env, (typ_error env)) id size order ranges) in
-          defs, env
-       | _ ->
-          typ_error env l "Bad bitfield type"
+     begin match typ with
+     (* The type of a bitfield must be a constant-width bitvector *)
+     | Typ_aux (Typ_app (v, [A_aux (A_nexp (Nexp_aux (Nexp_constant size, _)), _);
+                             A_aux (A_order order, _)]), _)
+          when string_of_id v = "bitvector" ->
+        let size = Big_int.to_int size in
+        let eval_index_nexp env nexp =
+          int_of_nexp_opt (nexp_simp (Env.expand_nexp_synonyms env nexp)) in
+        let (Defs defs), env =
+          check env (Bitfield.macro (eval_index_nexp env, (typ_error env)) id size order ranges) in
+        defs, env
+     | _ ->
+        typ_error env l "Underlying bitfield type must be a constant-width bitvector"
      end
 
 and check_scattered : 'a. Env.t -> 'a scattered_def -> (tannot def) list * Env.t =
@@ -5133,7 +5224,13 @@ and check_scattered : 'a. Env.t -> 'a scattered_def -> (tannot def) list * Env.t
      [DEF_scattered (SD_aux (SD_unioncl (id, tu), (l, None)))],
      let env = Env.add_variant_clause id tu env in
      let typq, _ = Env.get_variant id env in
-     check_type_union env id typq tu
+     let definition_env = Env.get_scattered_variant_env id env in
+     (try check_type_union l definition_env env id typq tu with
+      | Type_error (env, l', err) ->
+         let msg = "As this is a scattered union clause, this could \
+                    also be caused by using a type defined after the \
+                    'scattered union' declaration" in
+         raise (Type_error (env, l', Err_because (err, id_loc id, Err_other msg))))
   | SD_funcl (FCL_aux (FCL_Funcl (id, _), (l, _)) as funcl) ->
      let typq, typ = Env.get_val_spec id env in
      let funcl_env = add_typquant l typq env in
diff --git a/src/type_check.mli b/src/type_check.mli
index 711f2411..76b38557 100644
--- a/src/type_check.mli
+++ b/src/type_check.mli
@@ -80,6 +80,9 @@ val opt_smt_linearize : bool ref
 (** Allow use of div and mod when rewriting nexps *)
 val opt_smt_div : bool ref
 
+(** Use new bitfield syntax, more compatible with ASL *)
+val opt_new_bitfields : bool ref
+
 (** {2 Type errors} *)
 
 type type_error =
diff --git a/src/type_error.ml b/src/type_error.ml
index eed1379a..6205302e 100644
--- a/src/type_error.ml
+++ b/src/type_error.ml
@@ -107,7 +107,7 @@ let message_of_type_error =
   let rec msg = function
     | Err_because (err, l', err') ->
        Seq [msg err;
-            Line "This error occured because of a previous error:";
+            Line "This error was caused by:";
             Location (l', msg err')]
 
     | Err_other str -> Line str
diff --git a/src/util.ml b/src/util.ml
index 2745631c..99f1111f 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -143,6 +143,22 @@ let remove_dups compare eq l =
   in
   aux [] l'
 
+let lex_ord_list comparison xs ys =
+  let rec lex_lists xs ys =
+    match xs, ys with
+    | x :: xs, y :: ys ->
+       let c = comparison x y in
+       if c = 0 then lex_lists xs ys else c
+    | [], [] -> 0
+    | _, _ -> assert false
+  in
+  if List.length xs = List.length ys then
+    lex_lists xs ys
+  else if List.length xs < List.length ys then
+    -1
+  else
+    1
+
 let rec power i tothe =
   if tothe <= 0
   then 1
@@ -228,7 +244,7 @@ let option_bind f = function
   | None -> None
   | Some(o) -> f o
 
-let rec option_binop f x y = match x, y with
+let option_binop f x y = match x, y with
   | Some x, Some y -> Some (f x y)
   | _ -> None
 
@@ -418,6 +434,7 @@ let termcode n =
   else ""
 
 let bold str = termcode 1 ^ str
+let dim str = termcode 2 ^ str
 
 let darkgray str = termcode 90 ^ str
 let red str = termcode 91 ^ str
diff --git a/src/util.mli b/src/util.mli
index 9c57e360..3d83a1a4 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -73,6 +73,9 @@ val remove_duplicates : 'a list -> 'a list
 (** [remove_dups compare eq l] as remove_duplicates but with parameterised comparison and equality *)
 val remove_dups : ('a -> 'a -> int) -> ('a -> 'a -> bool) -> 'a list -> 'a list
 
+(** Lift a comparison order to the lexical order on lists *)
+val lex_ord_list : ('a -> 'a -> int) -> 'a list -> 'a list -> int
+
 (** [assoc_equal_opt] and [assoc_compare_opt] are like List.assoc_opt
    but take equality/comparison functions as arguments, rather than
    relying on OCaml's built in equality *)
@@ -237,6 +240,7 @@ val split_on_char : char -> string -> string list
 
 val termcode : int -> string
 val bold : string -> string
+val dim : string -> string
 val darkgray : string -> string
 val green : string -> string
 val red : string -> string
diff --git a/src/value.ml b/src/value.ml
index 71d9ffe6..3a9a071f 100644
--- a/src/value.ml
+++ b/src/value.ml
@@ -369,6 +369,14 @@ let value_mult = function
   | [v1; v2] -> V_int (Sail_lib.mult (coerce_int v1, coerce_int v2))
   | _ -> failwith "value mult"
 
+let value_tdiv_int = function
+  | [v1; v2] -> V_int (Sail_lib.tdiv_int (coerce_int v1, coerce_int v2))
+  | _ -> failwith "value tdiv_int"
+
+let value_tmod_int = function
+  | [v1; v2] -> V_int (Sail_lib.tmod_int (coerce_int v1, coerce_int v2))
+  | _ -> failwith "value tmod_int"
+
 let value_quotient = function
   | [v1; v2] -> V_int (Sail_lib.quotient (coerce_int v1, coerce_int v2))
   | _ -> failwith "value quotient"
@@ -486,7 +494,7 @@ let value_undefined_vector = function
 let value_undefined_bitvector = function
   | [v] -> V_vector (Sail_lib.undefined_vector (coerce_int v, V_bit (Sail_lib.B0)))
   | _ -> failwith "value undefined_bitvector"
-       
+
 let value_read_ram = function
   | [v1; v2; v3; v4] -> mk_vector (Sail_lib.read_ram (coerce_int v1, coerce_int v2, coerce_bv v3, coerce_bv v4))
   | _ -> failwith "value read_ram"
@@ -620,131 +628,136 @@ let value_decimal_string_of_bits = function
   | [v] -> V_string (Sail_lib.decimal_string_of_bits (coerce_bv v))
   | _ -> failwith "value decimal_string_of_bits"
 
-let primops =
-  List.fold_left
-    (fun r (x, y) -> StringMap.add x y r)
-    StringMap.empty
-    [ ("and_bool", and_bool);
-      ("or_bool", or_bool);
-      ("print", value_print);
-      ("prerr", fun vs -> (prerr_string (string_of_value (List.hd vs)); V_unit));
-      ("dec_str", fun _ -> V_string "X");
-      ("print_endline", value_print_endline);
-      ("prerr_endline", fun vs -> (prerr_endline (string_of_value (List.hd vs)); V_unit));
-      ("putchar", value_putchar);
-      ("string_of_int", fun vs -> V_string (string_of_value (List.hd vs)));
-      ("string_of_bits", fun vs -> V_string (string_of_value (List.hd vs)));
-      ("decimal_string_of_bits", value_decimal_string_of_bits);
-      ("print_bits", value_print_bits);
-      ("print_int", value_print_int);
-      ("print_string", value_print_string);
-      ("prerr_bits", value_print_bits);
-      ("prerr_int", value_print_int);
-      ("prerr_string", value_prerr_string);
-      ("concat_str", value_concat_str);
-      ("eq_int", value_eq_int);
-      ("lteq", value_lteq);
-      ("gteq", value_gteq);
-      ("lt", value_lt);
-      ("gt", value_gt);
-      ("eq_list", value_eq_list);
-      ("eq_bool", value_eq_bool);
-      ("eq_string", value_eq_string);
-      ("string_startswith", value_string_startswith);
-      ("string_drop", value_string_drop);
-      ("string_take", value_string_take);
-      ("string_length", value_string_length);
-      ("eq_bit", value_eq_bit);
-      ("eq_anything", value_eq_anything);
-      ("length", value_length);
-      ("subrange", value_subrange);
-      ("access", value_access);
-      ("update", value_update);
-      ("update_subrange", value_update_subrange);
-      ("slice", value_slice);
-      ("append", value_append);
-      ("append_list", value_append_list);
-      ("not", value_not);
-      ("not_vec", value_not_vec);
-      ("and_vec", value_and_vec);
-      ("or_vec", value_or_vec);
-      ("xor_vec", value_xor_vec);
-      ("uint", value_uint);
-      ("sint", value_sint);
-      ("get_slice_int", value_get_slice_int);
-      ("set_slice_int", value_set_slice_int);
-      ("set_slice", value_set_slice);
-      ("hex_slice", value_hex_slice);
-      ("zero_extend", value_zero_extend);
-      ("sign_extend", value_sign_extend);
-      ("zeros", value_zeros);
-      ("ones", value_ones);
-      ("shiftr", value_shiftr);
-      ("shiftl", value_shiftl);
-      ("shift_bits_left", value_shift_bits_left);
-      ("shift_bits_right", value_shift_bits_right);
-      ("add_int", value_add_int);
-      ("sub_int", value_sub_int);
-      ("sub_nat", value_sub_nat);
-      ("div_int", value_quotient);
-      ("mult_int", value_mult);
-      ("mult", value_mult);
-      ("quotient", value_quotient);
-      ("modulus", value_modulus);
-      ("negate", value_negate);
-      ("pow2", value_pow2);
-      ("int_power", value_int_power);
-      ("shr_int", value_shr_int);
-      ("shl_int", value_shl_int);
-      ("max_int", value_max_int);
-      ("min_int", value_min_int);
-      ("abs_int", value_abs_int);
-      ("add_vec_int", value_add_vec_int);
-      ("sub_vec_int", value_sub_vec_int);
-      ("add_vec", value_add_vec);
-      ("sub_vec", value_sub_vec);
-      ("vector_truncate", value_vector_truncate);
-      ("vector_truncateLSB", value_vector_truncateLSB);
-      ("read_ram", value_read_ram);
-      ("write_ram", value_write_ram);
-      ("trace_memory_read", fun _ -> V_unit);
-      ("trace_memory_write", fun _ -> V_unit);
-      ("get_time_ns", fun _ -> V_int (Sail_lib.get_time_ns()));
-      ("load_raw", value_load_raw);
-      ("to_real", value_to_real);
-      ("eq_real", value_eq_real);
-      ("lt_real", value_lt_real);
-      ("gt_real", value_gt_real);
-      ("lteq_real", value_lteq_real);
-      ("gteq_real", value_gteq_real);
-      ("add_real", value_add_real);
-      ("sub_real", value_sub_real);
-      ("mult_real", value_mult_real);
-      ("round_up", value_round_up);
-      ("round_down", value_round_down);
-      ("quot_round_zero", value_quot_round_zero);
-      ("rem_round_zero", value_rem_round_zero);
-      ("quotient_real", value_quotient_real);
-      ("abs_real", value_abs_real);
-      ("div_real", value_div_real);
-      ("sqrt_real", value_sqrt_real);
-      ("print_real", value_print_real);
-      ("random_real", value_random_real);
-      ("undefined_unit", fun _ -> V_unit);
-      ("undefined_bit", fun _ -> V_bit Sail_lib.B0);
-      ("undefined_int", fun _ -> V_int Big_int.zero);
-      ("undefined_nat", fun _ -> V_int Big_int.zero);
-      ("undefined_bool", fun _ -> V_bool false);
-      ("undefined_bitvector", value_undefined_bitvector);
-      ("undefined_vector", value_undefined_vector);
-      ("undefined_string", fun _ -> V_string "");
-      ("internal_pick", value_internal_pick);
-      ("replicate_bits", value_replicate_bits);
-      ("Elf_loader.elf_entry", fun _ -> V_int (!Elf_loader.opt_elf_entry));
-      ("Elf_loader.elf_tohost", fun _ -> V_int (!Elf_loader.opt_elf_tohost));
-      ("string_append", value_string_append);
-      ("string_length", value_string_length);
-      ("string_startswith", value_string_startswith);
-      ("string_drop", value_string_drop);
-      ("skip", fun _ -> V_unit);
-    ]
+let primops = ref
+  (List.fold_left
+     (fun r (x, y) -> StringMap.add x y r)
+     StringMap.empty
+     [ ("and_bool", and_bool);
+       ("or_bool", or_bool);
+       ("print", value_print);
+       ("prerr", fun vs -> (prerr_string (string_of_value (List.hd vs)); V_unit));
+       ("dec_str", fun _ -> V_string "X");
+       ("print_endline", value_print_endline);
+       ("prerr_endline", fun vs -> (prerr_endline (string_of_value (List.hd vs)); V_unit));
+       ("putchar", value_putchar);
+       ("string_of_int", fun vs -> V_string (string_of_value (List.hd vs)));
+       ("string_of_bits", fun vs -> V_string (string_of_value (List.hd vs)));
+       ("decimal_string_of_bits", value_decimal_string_of_bits);
+       ("print_bits", value_print_bits);
+       ("print_int", value_print_int);
+       ("print_string", value_print_string);
+       ("prerr_bits", value_print_bits);
+       ("prerr_int", value_print_int);
+       ("prerr_string", value_prerr_string);
+       ("concat_str", value_concat_str);
+       ("eq_int", value_eq_int);
+       ("lteq", value_lteq);
+       ("gteq", value_gteq);
+       ("lt", value_lt);
+       ("gt", value_gt);
+       ("eq_list", value_eq_list);
+       ("eq_bool", value_eq_bool);
+       ("eq_string", value_eq_string);
+       ("string_startswith", value_string_startswith);
+       ("string_drop", value_string_drop);
+       ("string_take", value_string_take);
+       ("string_length", value_string_length);
+       ("eq_bit", value_eq_bit);
+       ("eq_anything", value_eq_anything);
+       ("length", value_length);
+       ("subrange", value_subrange);
+       ("access", value_access);
+       ("update", value_update);
+       ("update_subrange", value_update_subrange);
+       ("slice", value_slice);
+       ("append", value_append);
+       ("append_list", value_append_list);
+       ("not", value_not);
+       ("not_vec", value_not_vec);
+       ("and_vec", value_and_vec);
+       ("or_vec", value_or_vec);
+       ("xor_vec", value_xor_vec);
+       ("uint", value_uint);
+       ("sint", value_sint);
+       ("get_slice_int", value_get_slice_int);
+       ("set_slice_int", value_set_slice_int);
+       ("set_slice", value_set_slice);
+       ("hex_slice", value_hex_slice);
+       ("zero_extend", value_zero_extend);
+       ("sign_extend", value_sign_extend);
+       ("zeros", value_zeros);
+       ("ones", value_ones);
+       ("shiftr", value_shiftr);
+       ("shiftl", value_shiftl);
+       ("shift_bits_left", value_shift_bits_left);
+       ("shift_bits_right", value_shift_bits_right);
+       ("add_int", value_add_int);
+       ("sub_int", value_sub_int);
+       ("sub_nat", value_sub_nat);
+       ("div_int", value_quotient);
+       ("tdiv_int", value_tdiv_int);
+       ("tmod_int", value_tmod_int);
+       ("mult_int", value_mult);
+       ("mult", value_mult);
+       ("quotient", value_quotient);
+       ("modulus", value_modulus);
+       ("negate", value_negate);
+       ("pow2", value_pow2);
+       ("int_power", value_int_power);
+       ("shr_int", value_shr_int);
+       ("shl_int", value_shl_int);
+       ("max_int", value_max_int);
+       ("min_int", value_min_int);
+       ("abs_int", value_abs_int);
+       ("add_vec_int", value_add_vec_int);
+       ("sub_vec_int", value_sub_vec_int);
+       ("add_vec", value_add_vec);
+       ("sub_vec", value_sub_vec);
+       ("vector_truncate", value_vector_truncate);
+       ("vector_truncateLSB", value_vector_truncateLSB);
+       ("read_ram", value_read_ram);
+       ("write_ram", value_write_ram);
+       ("trace_memory_read", fun _ -> V_unit);
+       ("trace_memory_write", fun _ -> V_unit);
+       ("get_time_ns", fun _ -> V_int (Sail_lib.get_time_ns()));
+       ("load_raw", value_load_raw);
+       ("to_real", value_to_real);
+       ("eq_real", value_eq_real);
+       ("lt_real", value_lt_real);
+       ("gt_real", value_gt_real);
+       ("lteq_real", value_lteq_real);
+       ("gteq_real", value_gteq_real);
+       ("add_real", value_add_real);
+       ("sub_real", value_sub_real);
+       ("mult_real", value_mult_real);
+       ("round_up", value_round_up);
+       ("round_down", value_round_down);
+       ("quot_round_zero", value_quot_round_zero);
+       ("rem_round_zero", value_rem_round_zero);
+       ("quotient_real", value_quotient_real);
+       ("abs_real", value_abs_real);
+       ("div_real", value_div_real);
+       ("sqrt_real", value_sqrt_real);
+       ("print_real", value_print_real);
+       ("random_real", value_random_real);
+       ("undefined_unit", fun _ -> V_unit);
+       ("undefined_bit", fun _ -> V_bit Sail_lib.B0);
+       ("undefined_int", fun _ -> V_int Big_int.zero);
+       ("undefined_nat", fun _ -> V_int Big_int.zero);
+       ("undefined_bool", fun _ -> V_bool false);
+       ("undefined_bitvector", value_undefined_bitvector);
+       ("undefined_vector", value_undefined_vector);
+       ("undefined_string", fun _ -> V_string "");
+       ("internal_pick", value_internal_pick);
+       ("replicate_bits", value_replicate_bits);
+       ("Elf_loader.elf_entry", fun _ -> V_int (!Elf_loader.opt_elf_entry));
+       ("Elf_loader.elf_tohost", fun _ -> V_int (!Elf_loader.opt_elf_tohost));
+       ("string_append", value_string_append);
+       ("string_length", value_string_length);
+       ("string_startswith", value_string_startswith);
+       ("string_drop", value_string_drop);
+       ("skip", fun _ -> V_unit);
+     ])
+
+let add_primop name impl =
+  primops := StringMap.add name impl !primops
diff --git a/src/value2.lem b/src/value2.lem
index 0afaa2d1..1c525f80 100644
--- a/src/value2.lem
+++ b/src/value2.lem
@@ -60,4 +60,7 @@ type vl =
   | VL_int of integer
   | VL_string of string
   | VL_real of string
-  | VL_null (* Used for unitialized values and null pointers in C compilation *)
+  | VL_empty_list
+  | VL_enum of string
+  | VL_ref of string
+  | VL_undefined