Switch to new typechecker (almost)

Initial typecheck still uses previous typechecker

17 files changed, 1106 insertions, 6039 deletions

diff --git a/src/pretty_print.ml b/src/pretty_print.ml
index 442c368b..7ef6b537 100644
--- a/src/pretty_print.ml
+++ b/src/pretty_print.ml
@@ -45,4 +45,3 @@ include Pretty_print_lem_ast
 include Pretty_print_sail
 include Pretty_print_ocaml
 include Pretty_print_lem
-
diff --git a/src/pretty_print.mli b/src/pretty_print.mli
index 67475616..78764657 100644
--- a/src/pretty_print.mli
+++ b/src/pretty_print.mli
@@ -41,11 +41,11 @@
 (**************************************************************************)
 
 open Ast
-open Type_internal
+open Type_check_new
 
 (* Prints the defs following source syntax *)
 val pp_defs : out_channel -> 'a defs -> unit 
-val pp_exp : Buffer.t -> exp -> unit
+val pp_exp : Buffer.t -> 'a exp -> unit
 val pat_to_string : 'a pat -> string
 
 (* Prints on formatter the defs as Lem Ast nodes *)
@@ -55,4 +55,4 @@ val pp_defs_ocaml : out_channel -> tannot defs -> string -> string list -> unit
 val pp_defs_lem : (out_channel * string list) -> (out_channel * string list) -> (out_channel * string list) -> tannot defs -> string -> unit
 
 
-val pp_format_annot_ascii : tannot -> string
+val pp_format_annot_ascii : Type_internal.tannot -> string
diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml
index 0e139989..911c4138 100644
--- a/src/pretty_print_lem.ml
+++ b/src/pretty_print_lem.ml
@@ -9,6 +9,7 @@
 (*    Robert Norton-Wright                                                *)
 (*    Christopher Pulte                                                   *)
 (*    Peter Sewell                                                        *)
+(*    Thomas Bauereiss                                                    *)
 (*                                                                        *)
 (*  All rights reserved.                                                  *)
 (*                                                                        *)
@@ -40,8 +41,10 @@
 (*  SUCH DAMAGE.                                                          *)
 (**************************************************************************)
 
-open Type_internal
+open Type_check_new
 open Ast
+open Ast_util
+open Rewriter
 open Big_int
 open PPrint
 open Pretty_print_common
@@ -132,19 +135,6 @@ let effectful (Effect_aux (eff,_)) =
   | Effect_var _ -> failwith "effectful: Effect_var not supported"
   | Effect_set effs -> effectful_set effs
 
-let effectful_t eff =
-  match eff.effect with
-  | Eset effs -> effectful_set effs
-  | _ -> false
-
-let rec is_number {t=t} =
-  match t with
-  | Tabbrev (t1,t2) -> is_number t1 || is_number t2
-  | Tapp ("range",_)
-  | Tapp ("implicit",_)
-  | Tapp ("atom",_) -> true
-  | _ -> false
-
 let doc_typ_lem, doc_atomic_typ_lem =
   (* following the structure of parser for precedence *)
   let rec typ regtypes ty = fn_typ regtypes true ty
@@ -200,8 +190,8 @@ let doc_typ_lem, doc_atomic_typ_lem =
       | Typ_id (Id_aux (Id "bool",_)) -> string "bitU"
       | Typ_id (Id_aux (Id "boolean",_)) -> string "bitU"
       | Typ_id (Id_aux (Id "bit",_)) -> string "bitU"
-      | Typ_id ((Id_aux (Id name,_)) as id) ->
-         if List.exists ((=) name) regtypes
+      | Typ_id (id) ->
+         if List.exists ((=) (string_of_id id)) regtypes
          then string "register"
          else doc_id_lem_type id
       | Typ_var v -> doc_var v
@@ -218,8 +208,8 @@ let doc_typ_lem, doc_atomic_typ_lem =
       | Typ_arg_effect e -> empty
   in typ', atomic_typ
 
-let doc_tannot_lem regtypes eff t =
-  let ta = doc_typ_lem regtypes (t_to_typ (normalize_t t)) in
+let doc_tannot_lem regtypes eff typ =
+  let ta = doc_typ_lem regtypes typ in
   if eff then string " : M " ^^ parens ta
   else string " : " ^^ ta
 
@@ -241,15 +231,14 @@ let doc_lit_lem in_pat (L_aux(lit,l)) a =
   | 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_undef ->
-     let (Base ((_,{t = t}),_,_,_,_,_)) = a in
-     (match t with
-      | Tid "bit"
-      | Tabbrev ({t = Tid "bit"},_) -> "BU"
-      | Tapp ("register",_)
-      | Tabbrev ({t = Tapp ("register",_)},_) -> "UndefinedRegister 0"
-      | Tid "string"
-      | Tabbrev ({t = Tapp ("string",_)},_) -> "\"\""
-      | _ -> "(failwith \"undefined value of unsupported type\")")
+     (match a with
+       | Some (_, Typ_aux (t,_), _) ->
+         (match t with
+          | Typ_id (Id_aux (Id "bit", _))
+          | Typ_app (Id_aux (Id "register", _),_) -> "UndefinedRegister 0"
+          | Typ_id (Id_aux (Id "string", _)) -> "\"\""
+          | _ -> "(failwith \"undefined value of unsupported type\")")
+       | _ -> "(failwith \"undefined value of unsupported type\")")
   | L_string s -> "\"" ^ s ^ "\"")
 
 (* typ_doc is the doc for the type being quantified *)
@@ -259,20 +248,24 @@ let doc_typquant_lem (TypQ_aux(tq,_)) typ_doc = typ_doc
 let doc_typschm_lem regtypes (TypSchm_aux(TypSchm_ts(tq,t),_)) =
   (doc_typquant_lem tq (doc_typ_lem regtypes t))
 
+let is_ctor env id = match Env.lookup_id id env with
+| Enum _ | Union _ -> true
+| _ -> false
+
 (*Note: vector concatenation, literal vectors, indexed vectors, and record should
   be removed prior to pp. The latter two have never yet been seen
 *)
 let rec doc_pat_lem regtypes apat_needed (P_aux (p,(l,annot)) as pa) = match p with
   | P_app(id, ((_ :: _) as pats)) ->
      (match annot with
-      | Base(_,(Constructor _ | Enum _),_,_,_,_) ->
+      | Some (env, _, _) when (is_ctor env id) ->
          let ppp = doc_unop (doc_id_lem_ctor id)
                             (parens (separate_map comma (doc_pat_lem regtypes true) pats)) in
          if apat_needed then parens ppp else ppp
       | _ -> empty)
   | P_app(id,[]) ->
     (match annot with
-     | Base(_,(Constructor _| Enum _),_,_,_,_) -> doc_id_lem_ctor id
+     | Some (env, _, _) when (is_ctor env id) -> doc_id_lem_ctor id
      | _ -> empty)
   | P_lit lit  -> doc_lit_lem true lit annot
   | P_wild -> underscore
@@ -297,19 +290,19 @@ let rec doc_pat_lem regtypes apat_needed (P_aux (p,(l,annot)) as pa) = match p w
       | [p] -> doc_pat_lem regtypes apat_needed p
       | _ -> parens (separate_map comma_sp (doc_pat_lem regtypes false) pats))
      | P_list pats -> brackets (separate_map semi (doc_pat_lem regtypes false) pats) (*Never seen but easy in lem*)
+  | P_record (_,_) | P_vector_indexed _ -> empty (* TODO *)
 
-let rec contains_bitvector_type t = match t.t with
-  | Ttup ts -> List.exists contains_bitvector_type ts
-  | Tapp (_, targs) -> is_bit_vector t || List.exists contains_bitvector_type_arg targs
-  | Tabbrev (_,t') -> contains_bitvector_type t'
-  | Tfn (t1,t2,_,_) -> contains_bitvector_type t1 || contains_bitvector_type t2
+let rec contains_bitvector_typ (Typ_aux (t,_) as typ) = match t with
+  | Typ_tup ts -> List.exists contains_bitvector_typ ts
+  | Typ_app (_, targs) -> is_bitvector_typ typ || List.exists contains_bitvector_typ_arg targs
+  | Typ_fn (t1,t2,_) -> contains_bitvector_typ t1 || contains_bitvector_typ t2
   | _ -> false
-and contains_bitvector_type_arg targ = match targ with
-  | TA_typ t -> contains_bitvector_type t
+and contains_bitvector_typ_arg (Typ_arg_aux (targ, _)) = match targ with
+  | Typ_arg_typ t -> contains_bitvector_typ t
   | _ -> false
 
-let const_nexp nexp = match nexp.nexp with
-  | Nconst _ -> true
+let const_nexp (Nexp_aux (nexp,_)) = match nexp with
+  | Nexp_constant _ -> true
   | _ -> false
 
 (* Check for variables in types that would be pretty-printed.
@@ -317,41 +310,38 @@ let const_nexp nexp = match nexp.nexp with
    length argument are checked for variables, and the latter only if it is
    a bitvector; for other types of vectors, the length is not pretty-printed
    in the type, and the start index is never pretty-printed in vector types. *)
-let rec contains_t_pp_var t = match t.t with
-  | Tvar _ -> true
-  | Tfn (t1,t2,_,_) -> contains_t_pp_var t1 || contains_t_pp_var t2
-  | Ttup ts -> List.exists contains_t_pp_var ts
-  | Tapp ("vector",[_;TA_nexp m;_;TA_typ t']) ->
-      if is_bit_vector t then not (const_nexp (normalize_nexp m))
-      else contains_t_pp_var t'
-  | Tapp (c,targs) -> List.exists contains_t_arg_pp_var targs
-  | Tabbrev (_,t') -> contains_t_pp_var t'
-  | Toptions (t1,t2o) ->
-      contains_t_pp_var t1 ||
-      (match t2o with Some t2 -> contains_t_pp_var t2 | _ -> false)
-  | Tuvar _ -> true
-  | Tid _ -> false
-and contains_t_arg_pp_var targ = match targ with
-  | TA_typ t -> contains_t_pp_var t
-  | TA_nexp nexp -> not (const_nexp (normalize_nexp nexp))
+let rec contains_t_pp_var (Typ_aux (t,a) as typ) = match t with
+  | Typ_wild -> true
+  | Typ_id _ -> false
+  | Typ_var _ -> true
+  | Typ_fn (t1,t2,_) -> contains_t_pp_var t1 || contains_t_pp_var t2
+  | Typ_tup ts -> List.exists contains_t_pp_var ts
+  | Typ_app (c,targs) ->
+      if is_bitvector_typ typ then
+        let (_,length,_,_) = vector_typ_args_of typ in
+        not (const_nexp ((*normalize_nexp*) length))
+      else List.exists contains_t_arg_pp_var targs
+and contains_t_arg_pp_var (Typ_arg_aux (targ, _)) = match targ with
+  | Typ_arg_typ t -> contains_t_pp_var t
+  | Typ_arg_nexp nexp -> not (const_nexp ((*normalize_nexp*) nexp))
   | _ -> false
 
 let prefix_recordtype = true
 let report = Reporting_basic.err_unreachable
 let doc_exp_lem, doc_let_lem =
-  let rec top_exp regtypes (aexp_needed : bool) (E_aux (e, (l,annot))) =
+  let rec top_exp regtypes (aexp_needed : bool) (E_aux (e, (l,annot)) as full_exp) =
     let expY = top_exp regtypes true in
     let expN = top_exp regtypes false in
     let expV = top_exp regtypes in
     match e with
-    | E_assign((LEXP_aux(le_act,tannot) as le),e) ->
+    | E_assign((LEXP_aux(le_act,tannot) as le), e) ->
        (* can only be register writes *)
-       let (_,(Base ((_,{t = t}),tag,_,_,_,_))) = tannot in
-       (match le_act, t, tag with
-        | LEXP_vector_range (le,e2,e3),_,_ ->
+       let t = typ_of_annot tannot in
+       (match le_act (*, t, tag*) with
+        | LEXP_vector_range (le,e2,e3) ->
            (match le with
-            | LEXP_aux (LEXP_field (le,id), (_,((Base ((_,{t = t}),_,_,_,_,_))))) ->
-               if t = Tid "bit" then
+            | LEXP_aux (LEXP_field (le,id), lannot) ->
+               if is_bit_typ (typ_of_annot lannot) then
                  raise (report l "indexing a register's (single bit) bitfield not supported")
                else
                  (prefix 2 1)
@@ -363,10 +353,10 @@ let doc_exp_lem, doc_let_lem =
                  (string "write_reg_range")
                  (align (doc_lexp_deref_lem regtypes le ^^ space ^^ expY e2 ^/^ expY e3 ^/^ expY e))
            )
-        | LEXP_vector (le,e2), (Tid "bit" | Tabbrev (_,{t=Tid "bit"})),_ ->
+        | LEXP_vector (le,e2) when is_bit_typ t ->
            (match le with
-            | LEXP_aux (LEXP_field (le,id), (_,((Base ((_,{t = t}),_,_,_,_,_))))) ->
-               if t = Tid "bit" then
+            | LEXP_aux (LEXP_field (le,id), lannot) ->
+               if is_bit_typ (typ_of_annot lannot) then
                  raise (report l "indexing a register's (single bit) bitfield not supported")
                else
                  (prefix 2 1)
@@ -377,16 +367,16 @@ let doc_exp_lem, doc_let_lem =
                  (string "write_reg_bit")
                  (doc_lexp_deref_lem regtypes le ^^ space ^^ expY e2 ^/^ expY e)
            )
-        | LEXP_field (le,id), (Tid "bit"| Tabbrev (_,{t=Tid "bit"})), _ ->
+        | LEXP_field (le,id) when is_bit_typ t ->
            (prefix 2 1)
              (string "write_reg_bitfield")
              (doc_lexp_deref_lem regtypes le ^^ space ^^ string_lit(doc_id_lem id) ^/^ expY e)
-        | LEXP_field (le,id), _, _ ->
+        | LEXP_field (le,id) ->
            (prefix 2 1)
              (string "write_reg_field")
              (doc_lexp_deref_lem regtypes le ^^ space ^^
                 string_lit(doc_id_lem id) ^/^ expY e)
-        | (LEXP_id id | LEXP_cast (_,id)), t, Alias alias_info ->
+        (* | (LEXP_id id | LEXP_cast (_,id)), t, Alias alias_info ->
            (match alias_info with
             | Alias_field(reg,field) ->
                let f = match t with
@@ -398,21 +388,21 @@ let doc_exp_lem, doc_let_lem =
                  (separate space [string reg;string_lit(string field);expY e])
             | Alias_pair(reg1,reg2) ->
                string "write_two_regs" ^^ space ^^ string reg1 ^^ space ^^
-                 string reg2 ^^ space ^^ expY e)
+                 string reg2 ^^ space ^^ expY e) *)
         | _ ->
            (prefix 2 1) (string "write_reg") (doc_lexp_deref_lem regtypes le ^/^ expY e))
-    | E_vector_append(l,r) ->
-       let (Base((_,t),_,_,_,_,_)) = annot in
+    | E_vector_append(le,re) ->
+       let t = typ_of_annot (l,annot) in
        let (call,ta,aexp_needed) =
-         if is_bit_vector t then
+         if is_bitvector_typ t then
            if not (contains_t_pp_var t)
            then ("bitvector_concat", doc_tannot_lem regtypes false t, true)
            else ("bitvector_concat", empty, aexp_needed)
          else ("vector_concat",empty,aexp_needed) in
        let epp =
-         align (group (separate space [string call;expY l;expY r])) ^^ ta in
+         align (group (separate space [string call;expY le;expY re])) ^^ ta in
        if aexp_needed then parens epp else epp
-    | E_cons(l,r) -> doc_op (group (colon^^colon)) (expY l) (expY r)
+    | E_cons(le,re) -> doc_op (group (colon^^colon)) (expY le) (expY re)
     | E_if(c,t,e) ->
        let (E_aux (_,(_,cannot))) = c in
        let epp =
@@ -455,38 +445,39 @@ let doc_exp_lem, doc_let_lem =
           if aexp_needed then parens (align epp) else epp
        | Id_aux (Id "slice_raw",_) ->
           let [e1;e2;e3] = args in
-          let (E_aux (_,(_,Base((_,t1),_,_,eff1,_,_)))) = e1 in
-          let call = if is_bit_vector t1 then "bvslice_raw" else "slice_raw" in
+          let t1 = typ_of e1 in
+          let eff1 = effect_of e1 in
+          let call = if is_bitvector_typ t1 then "bvslice_raw" else "slice_raw" in
           let epp = separate space [string call;expY e1;expY e2;expY e3] in
           let (taepp,aexp_needed) =
-            let (Base ((_,t),_,_,eff,_,_)) = annot in
-            if contains_bitvector_type t && not (contains_t_pp_var t)
-            then (align epp ^^ (doc_tannot_lem regtypes (effectful_t eff) t), true)
+            let t = typ_of full_exp in
+            let eff = effect_of full_exp in
+            if contains_bitvector_typ t && not (contains_t_pp_var t)
+            then (align epp ^^ (doc_tannot_lem regtypes (effectful eff) t), true)
             else (epp, aexp_needed) in
           if aexp_needed then parens (align taepp) else taepp
        | Id_aux (Id "length",_) ->
           let [arg] = args in
-          let (E_aux (_,(_,Base((_,targ),_,_,_,_,_)))) = arg in
-          let call = if is_bit_vector targ then "bvlength" else "length" in
+          let targ = typ_of arg in
+          let call = if is_bitvector_typ targ then "bvlength" else "length" in
           let epp = separate space [string call;expY arg] in
           if aexp_needed then parens (align epp) else epp
+       | Id_aux (Id "bool_not", _) ->
+          let [a] = args in
+          let epp = align (string "~" ^^ expY a) in
+          if aexp_needed then parens (align epp) else epp
        | _ ->
           begin match annot with
-          | Base (_,External (Some "bitwise_not_bit"),_,_,_,_) ->
-             let [a] = args in
-             let epp = align (string "~" ^^ expY a) in
-             if aexp_needed then parens (align epp) else epp
-          | Base (_,Constructor _,_,_,_,_) ->
+          | Some (env, _, _) when (is_ctor env f) ->
              let argpp a_needed arg =
-               let (E_aux (_,(_,Base((_,t),_,_,_,_,_)))) = arg in
-               match t.t with
-               | Tapp("vector",[_;_;_;_]) ->
-                  let call =
-                    if is_bit_vector t then "reset_bitvector_start"
-                    else "reset_vector_start" in
-                  let epp = concat [string call;space;expY arg] in
-                  if a_needed then parens epp else epp
-               | _ -> expV a_needed arg in
+               let t = typ_of arg in
+               if is_vector_typ t then
+                 let call =
+                   if is_bitvector_typ t then "reset_bitvector_start"
+                   else "reset_vector_start" in
+                 let epp = concat [string call;space;expY arg] in
+                 if a_needed then parens epp else epp
+               else expV a_needed arg in
              let epp =
                match args with
                | [] -> doc_id_lem_ctor f
@@ -496,51 +487,52 @@ let doc_exp_lem, doc_let_lem =
                     parens (separate_map comma (argpp false) args) in
              if aexp_needed then parens (align epp) else epp
           | _ ->
-             let call = match annot with
+             let call = (*match annot with
                | Base(_,External (Some n),_,_,_,_) -> string n
-               | _ -> doc_id_lem f in
+               | _ ->*) doc_id_lem f in
              let argpp a_needed arg =
-               let (E_aux (_,(_,Base((_,t),_,_,_,_,_)))) = arg in
-               match t.t with
-               | Tapp("vector",[_;_;_;_]) ->
-                  let call =
-                    if is_bit_vector t then "reset_bitvector_start"
-                    else "reset_vector_start" in
-                  let epp = concat [string call;space;expY arg] in
-                  if a_needed then parens epp else epp
-               | _ -> expV a_needed arg in
+               let t = typ_of arg in
+               if is_vector_typ t then
+                 let call =
+                   if is_bitvector_typ t then "reset_bitvector_start"
+                   else "reset_vector_start" in
+                 let epp = concat [string call;space;expY arg] in
+                 if a_needed then parens epp else epp
+               else expV a_needed arg in
              let argspp = match args with
                | [arg] -> argpp true arg
                | args -> parens (align (separate_map (comma ^^ break 0) (argpp false) args)) in
              let epp = align (call ^//^ argspp) in
              let (taepp,aexp_needed) =
-               let (Base ((_,t),_,_,eff,_,_)) = annot in
-               if contains_bitvector_type t && not (contains_t_pp_var t)
-               then (align epp ^^ (doc_tannot_lem regtypes (effectful_t eff) t), true)
+               let t = typ_of full_exp in
+               let eff = effect_of full_exp in
+               if contains_bitvector_typ t && not (contains_t_pp_var t)
+               then (align epp ^^ (doc_tannot_lem regtypes (effectful eff) t), true)
                else (epp, aexp_needed) in
              if aexp_needed then parens (align taepp) else taepp
           end
        end
     | E_vector_access (v,e) ->
-       let (Base (_,_,_,_,eff,_)) = annot in
+       let eff = effect_of full_exp in
        let epp =
-         if has_rreg_effect eff then
+         if has_effect eff BE_rreg then
            separate space [string "read_reg_bit";expY v;expY e]
          else
-           let (E_aux (_,(_,Base ((_,tv),_,_,_,_,_)))) = v in
-           let call = if is_bit_vector tv then "bvaccess" else "access" in
+           let tv = typ_of v in
+           let call = if is_bitvector_typ tv then "bvaccess" else "access" in
            separate space [string call;expY v;expY e] in
        if aexp_needed then parens (align epp) else epp
     | E_vector_subrange (v,e1,e2) ->
-       let (Base ((_,t),_,_,_,eff,_)) = annot in
+       let t = typ_of full_exp in
+       let eff = effect_of full_exp in
        let (epp,aexp_needed) =
-         if has_rreg_effect eff then
+         if has_effect eff BE_rreg then
            let epp = align (string "read_reg_range" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2) in
-           if contains_bitvector_type t && not (contains_t_pp_var t)
+           if contains_bitvector_typ t && not (contains_t_pp_var t)
            then (epp ^^ doc_tannot_lem regtypes true t, true)
            else (epp, aexp_needed)
          else
-           if is_bit_vector t then
+           if is_bitvector_typ t then
              let bepp = string "bvslice" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2 in
              if not (contains_t_pp_var t)
              then (bepp ^^ doc_tannot_lem regtypes false t, true)
@@ -548,24 +540,24 @@ let doc_exp_lem, doc_let_lem =
            else (string "slice" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2, aexp_needed) in
        if aexp_needed then parens (align epp) else epp
     | E_field((E_aux(_,(l,fannot)) as fexp),id) ->
-       let (Base ((_,{t = ft}),_,_,_,_,_)) = fannot in
-       (match ft with
-        | Tabbrev({t = Tid regtyp},{t=Tapp("register",_)}) ->
-           let (Base((_,t),_,_,_,_,_)) = annot in
-           let field_f = match t.t with
-             | Tid "bit" | Tabbrev(_,{t=Tid "bit"}) -> string "read_reg_bitfield"
-             | _ -> string "read_reg_field" in
+       let ft = typ_of_annot (l,fannot) in
+       (match fannot with
+        | Some(env, (Typ_aux (Typ_id tid, _)), _) when Env.is_regtyp tid env ->
+           let t = typ_of full_exp in
+           let field_f = string
+             (if is_bit_typ t
+             then "read_reg_bitfield"
+             else "read_reg_field") in
            let (ta,aexp_needed) =
-             if contains_bitvector_type t && not (contains_t_pp_var t)
+             if contains_bitvector_typ t && not (contains_t_pp_var t)
              then (doc_tannot_lem regtypes true t, true)
              else (empty, aexp_needed) in
            let epp = field_f ^^ space ^^ (expY fexp) ^^ space ^^ string_lit (doc_id_lem id) in
            if aexp_needed then parens (align epp ^^ ta) else (epp ^^ ta)
-        | Tid recordtyp
-          | Tabbrev ({t = Tid recordtyp},_) ->
+        | Some(env, (Typ_aux (Typ_id tid, _)), _) when Env.is_record tid env ->
            let fname =
              if prefix_recordtype
-             then (string (recordtyp ^ "_")) ^^ doc_id_lem id
+             then (string (string_of_id tid ^ "_")) ^^ doc_id_lem id
              else doc_id_lem id in
            expY fexp ^^ dot ^^ fname
         | _ ->
@@ -574,34 +566,33 @@ let doc_exp_lem, doc_let_lem =
     | E_block exps -> raise (report l "Blocks should have been removed till now.")
     | E_nondet exps -> raise (report l "Nondet blocks not supported.")
     | E_id id ->
-       let (Base((_,t),_,_,_,_,_)) = annot in
+       let t = typ_of full_exp in
        (match annot with
-        | Base((_, ({t = Tapp("register",_)} | {t=Tabbrev(_,{t=Tapp("register",_)})})),
-               External _,_,eff,_,_) ->
-           if has_rreg_effect eff then
+        | Some (env, Typ_aux (Typ_id tid, _), eff) when Env.is_regtyp tid env ->
+           if has_effect eff BE_rreg then
              let epp = separate space [string "read_reg";doc_id_lem id] in
-             if contains_bitvector_type t && not (contains_t_pp_var t)
+             if contains_bitvector_typ t && not (contains_t_pp_var t)
              then parens (epp ^^ doc_tannot_lem regtypes true t)
              else epp
            else
              doc_id_lem id
-        | Base(_,(Constructor i |Enum i),_,_,_,_) -> doc_id_lem_ctor id
-        | Base((_,t),Alias alias_info,_,eff,_,_) ->
+        | Some (env, _, _) when (is_ctor env id) -> doc_id_lem_ctor id
+        (*| Base((_,t),Alias alias_info,_,eff,_,_) ->
            (match alias_info with
             | Alias_field(reg,field) ->
                 let call = match t.t with
                   | Tid "bit" | Tabbrev (_,{t=Tid "bit"}) -> "read_reg_bitfield"
                   | _ -> "read_reg_field" in
                 let ta =
-                  if contains_bitvector_type t && not (contains_t_pp_var t)
+                  if contains_bitvector_typ t && not (contains_t_pp_var t)
                   then doc_tannot_lem regtypes true t else empty in
                 let epp = separate space [string call;string reg;string_lit(string field)] ^^ ta in
                 if aexp_needed then parens (align epp) else epp
             | Alias_pair(reg1,reg2) ->
                 let (call,ta) =
-                  if has_rreg_effect eff then
+                  if has_effect eff BE_rreg then
                     let ta =
-                      if contains_bitvector_type t && not (contains_t_pp_var t)
+                      if contains_bitvector_typ t && not (contains_t_pp_var t)
                       then doc_tannot_lem regtypes true t else empty in
                     ("read_two_regs", ta)
                   else
@@ -614,69 +605,83 @@ let doc_exp_lem, doc_let_lem =
                     separate space [string "read_reg_bit";string reg;doc_int start]
                   else
                     let ta =
-                      if contains_bitvector_type t && not (contains_t_pp_var t)
+                      if contains_bitvector_typ t && not (contains_t_pp_var t)
                       then doc_tannot_lem regtypes true t else empty in
                     separate space [string "read_reg_range";string reg;doc_int start;doc_int stop] ^^ ta in
                 if aexp_needed then parens (align epp) else epp
-           )
+           )*)
         | _ -> doc_id_lem id)
     | E_lit lit -> doc_lit_lem false lit annot
-    | E_cast(Typ_aux (typ,_),e) ->
+    | E_cast(typ,e) ->
+       if is_vector_typ typ then
+         let (start,_,_,_) = vector_typ_args_of typ in
+         let call =
+           if is_bitvector_typ typ then "set_bitvector_start"
+           else "set_vector_start" in
+         let epp = (concat [string call;space;doc_nexp start]) ^//^
+                     expY e in
+         if aexp_needed then parens epp else epp
+       else
+         expV aexp_needed e (*
        (match annot with
         | Base((_,t),External _,_,_,_,_) ->
+           (* TODO: Does this case still exist with the new type checker? *)
            let epp = string "read_reg" ^^ space ^^ expY e in
-           if contains_bitvector_type t && not (contains_t_pp_var t)
+           if contains_bitvector_typ t && not (contains_t_pp_var t)
            then parens (epp ^^ doc_tannot_lem regtypes true t) else epp
         | Base((_,t),_,_,_,_,_) ->
            (match typ with
             | Typ_app (Id_aux (Id "vector",_), [Typ_arg_aux (Typ_arg_nexp(Nexp_aux (Nexp_constant i,_)),_);_;_;_]) ->
                let call =
-                 if is_bit_vector t then "set_bitvector_start"
+                 if is_bitvector_typ t then "set_bitvector_start"
                  else "set_vector_start" in
                let epp = (concat [string call;space;string (string_of_int i)]) ^//^
                            expY e in
                if aexp_needed then parens epp else epp
+               (*
             | Typ_var (Kid_aux (Var "length",_)) ->
+               (* TODO: Does this case still exist with the new type checker? *)
                let call =
-                 if is_bit_vector t then "set_bitvector_start_to_length"
+                 if is_bitvector_typ t then "set_bitvector_start_to_length"
                  else "set_vector_start_to_length" in
                let epp = (string call) ^//^ expY e in
                if aexp_needed then parens epp else epp
+               *)
             | _ -> 
                expV aexp_needed e)) (*(parens (doc_op colon (group (expY e)) (doc_typ_lem typ)))) *)
+               *)
     | E_tuple exps ->
-       (match exps with
-        (* | [e] -> expV aexp_needed e *)
+       (match exps with (*
+        | [e] -> expV aexp_needed e *)
         | _ -> parens (separate_map comma expN exps))
     | E_record(FES_aux(FES_Fexps(fexps,_),_)) ->
-       let (Base ((_,{t = t}),_,_,_,_,_)) = annot in
-       let recordtyp = match t with
-         | Tid recordtyp
-           | Tabbrev ({t = Tid recordtyp},_) -> recordtyp
+       let recordtyp = match annot with
+         | Some (env, Typ_aux (Typ_id tid,_), _) when Env.is_record tid env ->
+           tid
          | _ ->  raise (report l "cannot get record type") in
        let epp = anglebars (space ^^ (align (separate_map
                                           (semi_sp ^^ break 1)
                                           (doc_fexp regtypes recordtyp) fexps)) ^^ space) in
        if aexp_needed then parens epp else epp
     | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
-       let (Base ((_,{t = t}),_,_,_,_,_)) = annot in
-       let recordtyp = match t with
-         | Tid recordtyp
-           | Tabbrev ({t = Tid recordtyp},_) -> recordtyp
+       let recordtyp = match annot with
+         | Some (env, Typ_aux (Typ_id tid,_), _) when Env.is_record tid env ->
+           tid
          | _ ->  raise (report l "cannot get record type") in
        anglebars (doc_op (string "with") (expY e) (separate_map semi_sp (doc_fexp regtypes recordtyp) fexps))
     | E_vector exps ->
-       (match annot with
+       let t = typ_of full_exp in
+       let (start, len, order, etyp) =
+         if is_vector_typ t then vector_typ_args_of t
+         else raise (Reporting_basic.err_unreachable l "E_vector of non-vector type") in
+       (*match annot with
         | Base((_,t),_,_,_,_,_) ->
            match t.t with
            | Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; TA_typ etyp])
-             | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; TA_typ etyp])}) ->
-              let dir,dir_out = match order.order with
-                | Oinc -> true,"true"
-                | _ -> false, "false" in
-              let start = match start.nexp with
-                | Nconst i -> string_of_big_int i
-                | N2n(_,Some i) -> string_of_big_int i
+             | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; TA_typ etyp])}) ->*)
+              let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
+              let start = match start with
+                | Nexp_aux (Nexp_constant i, _) -> string_of_int i
                 | _ -> if dir then "0" else string_of_int (List.length exps) in
               let expspp =
                 match exps with
@@ -693,43 +698,41 @@ let doc_exp_lem, doc_let_lem =
               let epp =
                 group (separate space [string "Vector"; brackets expspp;string start;string dir_out]) in
               let (epp,aexp_needed) =
-                if etyp.t = Tid "bit" then
+                if is_bit_typ etyp then
                   let bepp = string "vec_to_bvec" ^^ space ^^ parens (align epp) in
                   if contains_t_pp_var t
                   then (bepp, aexp_needed)
                   else (bepp ^^ doc_tannot_lem regtypes false t, true)
                 else (epp,aexp_needed) in
               if aexp_needed then parens (align epp) else epp
-       )
+       (* *)
     | E_vector_indexed (iexps, (Def_val_aux (default,(dl,dannot)))) ->
-       let (Base((_,t),_,_,_,_,_)) = annot in
-       let call = string "make_indexed_vector" in
-       let (start,len,order) = match t.t with
-         | Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])
-         | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])})
-         | Tapp("reg", [TA_typ {t =Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])}]) ->
-            (start,len,order.order) in
-       let dir,dir_out = match order with
-         | Oinc -> true,"true"
-         | _ -> false, "false" in
-       let start = match start.nexp with
-         | Nconst i | N2n(_,Some i)-> string_of_big_int i
-         | N2n({nexp=Nconst i},_) -> string_of_int (Util.power 2 (int_of_big_int i))
+      let t = typ_of full_exp in
+      let (start, len, order, etyp) =
+        if is_vector_typ t then vector_typ_args_of t
+        else raise (Reporting_basic.err_unreachable l "E_vector_indexed of non-vector type") in
+       let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
+       let start = match start with
+         | Nexp_aux (Nexp_constant i, _) -> string_of_int i
          | _ -> if dir then "0" else string_of_int (List.length iexps) in
-       let size = match len.nexp with
-         | Nconst i | N2n(_,Some i)-> string_of_big_int i
-         | N2n({nexp=Nconst i},_) -> string_of_int (Util.power 2 (int_of_big_int i)) in
+       let size = match len with
+         | Nexp_aux (Nexp_constant i, _)-> string_of_int i
+         | Nexp_aux (Nexp_exp (Nexp_aux (Nexp_constant i, _)), _) ->
+           string_of_int (Util.power 2 i)
+         | _ ->
+           raise (Reporting_basic.err_unreachable l
+             "trying to pretty-print indexed vector without constant size") in
        let default_string =
          match default with
          | Def_val_empty ->
-            if is_bit_vector t then string "BU"
+            if is_bitvector_typ t then string "BU"
             else failwith "E_vector_indexed of non-bitvector type without default argument"
          | Def_val_dec e ->
-            let (Base ((_,{t = t}),_,_,_,_,_)) = dannot in
+            (*let (Base ((_,{t = t}),_,_,_,_,_)) = dannot in
             match t with
             | Tapp ("register",
                     [TA_typ ({t = rt})]) ->
-
+               (* TODO: Does this case still occur with the new type checker? *)
                let n = match rt with
                  | Tapp ("vector",TA_nexp {nexp = Nconst i} :: TA_nexp {nexp = Nconst j} ::_) ->
                     abs_big_int (sub_big_int i j)
@@ -738,7 +741,7 @@ let doc_exp_lem, doc_let_lem =
                              ("not the right type information available to construct "^
                                 "undefined register")) in
                parens (string ("UndefinedRegister " ^ string_of_big_int n))
-            | _ -> expY e in
+            | _ ->*) expY e in
        let iexp (i,e) = parens (doc_int i ^^ comma ^^ expN e) in
        let expspp =
          match iexps with
@@ -751,22 +754,23 @@ let doc_exp_lem, doc_let_lem =
                   if count = 5 then 0 else count + 1)
                 (iexp e,0) es in
             align (expspp) in
+       let call = string "make_indexed_vector" in
        let epp =
          align (group (call ^//^ brackets expspp ^/^
                          separate space [default_string;string start;string size;string dir_out])) in
        let (bepp, aexp_needed) =
-         if is_bit_vector t
+         if is_bitvector_typ t
          then (string "vec_to_bvec" ^^ space ^^ parens (epp) ^^ doc_tannot_lem regtypes false t, true)
          else (epp, aexp_needed) in
        if aexp_needed then parens (align bepp) else bepp
     | E_vector_update(v,e1,e2) ->
-       let (Base((_,t),_,_,_,_,_)) = annot in
-       let call = if is_bit_vector t then "bvupdate_pos" else "update_pos" in
+       let t = typ_of full_exp in
+       let call = if is_bitvector_typ t then "bvupdate_pos" else "update_pos" in
        let epp = separate space [string call;expY v;expY e1;expY e2] in
        if aexp_needed then parens (align epp) else epp
     | E_vector_update_subrange(v,e1,e2,e3) ->
-       let (Base((_,t),_,_,_,_,_)) = annot in
-       let call = if is_bit_vector t then "bvupdate" else "update" in
+       let t = typ_of full_exp in
+       let call = if is_bitvector_typ t then "bvupdate" else "update" in
        let epp = align (string call ^//^
                           group (group (expY v) ^/^ group (expY e1) ^/^ group (expY e2)) ^/^
                             group (expY e3)) in
@@ -774,20 +778,18 @@ let doc_exp_lem, doc_let_lem =
     | E_list exps ->
        brackets (separate_map semi (expN) exps)
     | E_case(e,pexps) ->
-
-       let only_integers (E_aux(_,(_,annot)) as e) =
-         match annot with
-         | Base((_,t),_,_,_,_,_) ->
-            if is_number t then
-              let e_pp = expY e in
-              align (string "toNatural" ^//^ e_pp)
-            else
-              (match t with
-               | {t = Ttup ([t1;t2;t3;t4;t5] as ts)} when List.for_all is_number ts ->
-                  let e_pp = expY e in
-                  align (string "toNaturalFiveTup" ^//^ e_pp)
-               | _ -> expY e)
-         | _ -> expY e
+       let only_integers e =
+         let typ = typ_of e in
+         if Ast_util.is_number typ then
+           let e_pp = expY e in
+           align (string "toNatural" ^//^ e_pp)
+         else
+           (* TODO: Where does this come from?? *)
+           (match typ with
+            | Typ_aux (Typ_tup ([t1;t2;t3;t4;t5] as ts), _) when List.for_all Ast_util.is_number ts ->
+               let e_pp = expY e in
+               align (string "toNaturalFiveTup" ^//^ e_pp)
+            | _ -> expY e)
        in
 
        (* This is a hack, incomplete. It's because lem does not allow
@@ -802,14 +804,17 @@ let doc_exp_lem, doc_let_lem =
        let epp = separate space [string "assert'"; expY e1; expY e2] in
        if aexp_needed then parens (align epp) else align epp
     | E_app_infix (e1,id,e2) ->
-       (match annot with
+       (* TODO: Should have been removed by the new type checker; check with Alasdair *)
+       raise (Reporting_basic.err_unreachable l
+         "E_app_infix should have been rewritten before pretty-printing")
+       (*match annot with
         | Base((_,t),External(Some name),_,_,_,_) ->
            let argpp arg =
              let (E_aux (_,(_,Base((_,t),_,_,_,_,_)))) = arg in
              match t.t with
              | Tapp("vector",_) ->
                  let call =
-                   if is_bit_vector t then "reset_bitvector_start"
+                   if is_bitvector_typ t then "reset_bitvector_start"
                    else "reset_vector_start" in
                  parens (concat [string call;space;expY arg])
              | _ -> expY arg in
@@ -880,14 +885,14 @@ let doc_exp_lem, doc_let_lem =
                 | _ ->
                    string name ^//^ parens (expN e1 ^^ comma ^/^ expN e2)) in
            let (epp,aexp_needed) =
-             if contains_bitvector_type t && not (contains_t_pp_var t)
+             if contains_bitvector_typ t && not (contains_t_pp_var t)
              then (parens epp ^^ doc_tannot_lem regtypes false t, true)
              else (epp, aexp_needed) in
            if aexp_needed then parens (align epp) else epp
         | _ ->
            let epp =
              align (doc_id_lem id ^//^ parens (expN e1 ^^ comma ^/^ expN e2)) in
-           if aexp_needed then parens (align epp) else epp)
+           if aexp_needed then parens (align epp) else epp*)
     | E_internal_let(lexp, eq_exp, in_exp) ->
        raise (report l "E_internal_lets should have been removed till now")
     (*     (separate
@@ -910,6 +915,19 @@ let doc_exp_lem, doc_let_lem =
        if aexp_needed then parens (align epp) else epp
     | E_internal_return (e1) ->
        separate space [string "return"; expY e1;]
+    | E_sizeof nexp ->
+      (match nexp with
+        | Nexp_aux (Nexp_constant i, _) -> doc_lit_lem false (L_aux (L_num i, l)) annot
+        | _ ->
+          raise (Reporting_basic.err_unreachable l
+            "pretty-printing non-constant sizeof expressions to Lem not supported"))
+    | E_return _ ->
+      raise (Reporting_basic.err_todo l
+        "pretty-printing early return statements to Lem not yet supported")
+    | E_comment _ | E_comment_struc _ -> empty
+    | E_internal_cast _ | E_internal_exp _ | E_sizeof_internal _ | E_internal_exp_user _ ->
+      raise (Reporting_basic.err_unreachable l
+        "unsupported internal expression encountered while pretty-printing")
   and let_exp regtypes (LB_aux(lb,_)) = match lb with
     | LB_val_explicit(_,pat,e)
       | LB_val_implicit(pat,e) ->
@@ -920,7 +938,7 @@ let doc_exp_lem, doc_let_lem =
   and doc_fexp regtypes recordtyp (FE_aux(FE_Fexp(id,e),_)) =
     let fname =
       if prefix_recordtype
-      then (string (recordtyp ^ "_")) ^^ doc_id_lem id
+      then (string (string_of_id recordtyp ^ "_")) ^^ doc_id_lem id
       else doc_id_lem id in
     group (doc_op equals fname (top_exp regtypes true e))
 
@@ -1205,7 +1223,14 @@ let rec doc_fundef_lem regtypes (FD_aux(FD_function(r, typa, efa, fcls),fannot))
           (fun (already_used_fnames,auxiliary_functions,clauses) funcl ->
             match funcl with
             | FCL_aux (FCL_Funcl (Id_aux (Id _,l),pat,exp),annot) ->
-               let (P_aux (P_app (Id_aux (Id ctor,l),argspat),pannot)) = pat in
+               let ctor, l, argspat, pannot = (match pat with
+                 | P_aux (P_app (Id_aux (Id ctor,l),argspat),pannot) ->
+                   (ctor, l, argspat, pannot)
+                 | P_aux (P_id (Id_aux (Id ctor,l)), pannot) ->
+                   (ctor, l, [], pannot)
+                 | _ ->
+                   raise (Reporting_basic.err_unreachable l
+                     "unsupported parameter pattern in function clause")) in
                let rec pick_name_not_clashing_with already_used candidate =
                  if StringSet.mem candidate already_used then
                    pick_name_not_clashing_with already_used (candidate ^ "'")
@@ -1257,33 +1282,33 @@ let rec doc_fundef_lem regtypes (FD_aux(FD_function(r, typa, efa, fcls),fannot))
 let doc_dec_lem (DEC_aux (reg,(l,annot))) =
   match reg with
   | DEC_reg(typ,id) ->
-     (match annot with
-     | Base((_,t),_,_,_,_,_) ->
-       (match t.t with
-        | Tapp("register", [TA_typ {t= Tapp("vector", [TA_nexp start; TA_nexp size; TA_ord order; TA_typ itemt])}])
-        | Tapp("register", [TA_typ {t= Tabbrev(_,{t=Tapp("vector", [TA_nexp start; TA_nexp size; TA_ord order; TA_typ itemt])})}]) ->
-          (match itemt.t,start.nexp,size.nexp with
-           | Tid "bit", Nconst start, Nconst size ->
-             let o = if order.order = Oinc then "true" else "false" in
+     (match typ with
+      | Typ_aux (Typ_app (r, [Typ_arg_aux (Typ_arg_typ rt, _)]), _)
+        when string_of_id r = "register" && is_vector_typ rt ->
+        let (start, size, order, etyp) = vector_typ_args_of rt in
+        (match is_bit_typ etyp, start, size with
+          | true, Nexp_aux (Nexp_constant start, _), Nexp_aux (Nexp_constant size, _) ->
+             let o = if is_order_inc order then "true" else "false" in
              (doc_op equals)
              (string "let" ^^ space ^^ doc_id_lem id)
              (string "Register" ^^ space ^^
                 align (separate space [string_lit(doc_id_lem id);
-                                       doc_int (int_of_big_int size);
-                                       doc_int (int_of_big_int start);
+                                       doc_int (size);
+                                       doc_int (start);
                                        string o;
                                        string "[]"]))
                 ^/^ hardline
            | _ ->
               let (Id_aux (Id name,_)) = id in
               failwith ("can't deal with register " ^ name))
-        | Tapp("register", [TA_typ {t=Tid idt}])
-        | Tid idt
-        | Tabbrev( {t= Tid idt}, _) ->
-           separate space [string "let";doc_id_lem id;equals;
-                           string "build_" ^^ string idt;string_lit (doc_id_lem id)] ^/^ hardline
-        |_-> empty)
-     | _ ->  empty)
+      | Typ_aux (Typ_app(r, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id idt, _)), _)]), _)
+        when string_of_id r = "register" ->
+         separate space [string "let";doc_id_lem id;equals;
+                         string "build_" ^^ string (string_of_id idt);string_lit (doc_id_lem id)] ^/^ hardline
+      | Typ_aux (Typ_id idt, _) ->
+         separate space [string "let";doc_id_lem id;equals;
+                         string "build_" ^^ string (string_of_id idt);string_lit (doc_id_lem id)] ^/^ hardline
+      |_-> empty)
   | DEC_alias(id,alspec) -> empty
   | DEC_typ_alias(typ,id,alspec) -> empty
 
@@ -1291,12 +1316,13 @@ let doc_spec_lem regtypes (VS_aux (valspec,annot)) =
   match valspec with
   | VS_extern_no_rename _
   | VS_extern_spec _ -> empty (* ignore these at the moment *)
-  | VS_val_spec (typschm,id) -> empty
+  | VS_val_spec (typschm,id) | VS_cast_spec (typschm,id) -> empty
 (* separate space [string "val"; doc_id_lem id; string ":";doc_typschm_lem regtypes typschm] ^/^ hardline *)
 
 
 let rec doc_def_lem regtypes def = match def with
   | DEF_spec v_spec -> (doc_spec_lem regtypes v_spec,empty)
+  | DEF_overload _ -> (empty,empty)
   | DEF_type t_def -> (group (doc_typdef_lem regtypes t_def) ^/^ hardline,empty)
   | DEF_reg_dec dec -> (group (doc_dec_lem dec),empty)
 
diff --git a/src/pretty_print_lem_ast.ml b/src/pretty_print_lem_ast.ml
index ef7a8b95..0fb6ed91 100644
--- a/src/pretty_print_lem_ast.ml
+++ b/src/pretty_print_lem_ast.ml
@@ -40,7 +40,7 @@
 (*  SUCH DAMAGE.                                                          *)
 (**************************************************************************)
 
-open Type_internal
+open Type_check_new
 open Ast
 open Format
 open Big_int
@@ -284,68 +284,6 @@ let pp_format_lit_lem (L_aux(lit,l)) =
 let pp_lem_lit ppf l = base ppf (pp_format_lit_lem l)
 
 
-let rec pp_format_t_lem t =
-  match t.t with
-    | Tid i -> "(T_id \"" ^ i ^ "\")"
-    | Tvar i -> "(T_var \"" ^ i ^ "\")"
-    | Tfn(t1,t2,_,e) -> "(T_fn " ^ (pp_format_t_lem t1) ^ " " ^ (pp_format_t_lem t2) ^ " " ^ pp_format_e_lem e ^ ")"
-    | Ttup(tups) -> "(T_tup [" ^ (list_format "; " pp_format_t_lem tups) ^ "])"
-    | Tapp(i,args) -> "(T_app \"" ^ i ^ "\" (T_args [" ^  list_format "; " pp_format_targ_lem args ^ "]))"
-    | Tabbrev(ti,ta) -> "(T_abbrev " ^ (pp_format_t_lem ti) ^ " " ^ (pp_format_t_lem ta) ^ ")"
-    | Tuvar(_) -> "(T_var \"fresh_v\")"
-    | Toptions _ -> "(T_var \"fresh_v\")"
-and pp_format_targ_lem = function
-  | TA_typ t -> "(T_arg_typ " ^ pp_format_t_lem t ^ ")"
-  | TA_nexp n -> "(T_arg_nexp " ^ pp_format_n_lem n ^ ")"
-  | TA_eft e -> "(T_arg_effect " ^ pp_format_e_lem e ^ ")"
-  | TA_ord o -> "(T_arg_order " ^ pp_format_o_lem o ^ ")"
-and pp_format_n_lem n =
-  match n.nexp with
-  | Nid (i, n) -> "(Ne_id \"" ^ i ^ " " ^ "\")"
-  | Nvar i -> "(Ne_var \"" ^ i ^ "\")"
-  | Nconst i -> "(Ne_const " ^ (lemnum string_of_int (int_of_big_int i)) ^ ")"
-  | Npos_inf -> "Ne_inf"
-  | Nadd(n1,n2) -> "(Ne_add [" ^ (pp_format_n_lem n1) ^ "; " ^ (pp_format_n_lem n2) ^ "])"
-  | Nsub(n1,n2) -> "(Ne_minus "^ (pp_format_n_lem n1) ^ " " ^ (pp_format_n_lem n2) ^ ")"
-  | Nmult(n1,n2) -> "(Ne_mult " ^ (pp_format_n_lem n1) ^ " " ^ (pp_format_n_lem n2) ^ ")"
-  | N2n(n,Some i) -> "(Ne_exp " ^ (pp_format_n_lem n) ^ "(*" ^ string_of_big_int i ^ "*)" ^ ")"
-  | N2n(n,None) -> "(Ne_exp " ^ (pp_format_n_lem n) ^ ")"
-  | Nneg n -> "(Ne_unary " ^ (pp_format_n_lem n) ^ ")"
-  | Nuvar _ -> "(Ne_var \"fresh_v_" ^ string_of_int (get_index n) ^ "\")"
-  | Nneg_inf -> "(Ne_unary Ne_inf)"
-  | Npow _ -> "power_not_implemented"
-  | Ninexact -> "(Ne_add Ne_inf (Ne_unary Ne_inf)"
-and pp_format_e_lem e =
-  "(Effect_aux " ^
-  (match e.effect with
-  | Evar i -> "(Effect_var (Kid_aux (Var \"" ^ i ^ "\") Unknown))"
-  | Eset es -> "(Effect_set [" ^
-                  (list_format "; " pp_format_base_effect_lem es) ^ " ])"
-  | Euvar(_) -> "(Effect_var (Kid_aux (Var \"fresh_v\") Unknown))")
-  ^ " Unknown)"
-and pp_format_o_lem o =
-  "(Ord_aux " ^
-  (match o.order with
-  | Ovar i -> "(Ord_var (Kid_aux (Var \"" ^ i ^ "\") Unknown))"
-  | Oinc -> "Ord_inc"
-  | Odec -> "Ord_dec"
-  | Ouvar(_) -> "(Ord_var (Kid_aux (Var \"fresh_v\") Unknown))")
-  ^ " Unknown)"
-
-let rec pp_format_tag = function
-  | Emp_local -> "Tag_empty"
-  | Emp_intro -> "Tag_intro"
-  | Emp_set -> "Tag_set"
-  | Emp_global -> "Tag_global"
-  | Tuple_assign tags -> (*"(Tag_tuple_assign [" ^ list_format " ;" pp_format_tag tags ^ "])"*) "Tag_tuple_assign"
-  | External (Some s) -> "(Tag_extern (Just \""^s^"\"))"
-  | External None -> "(Tag_extern Nothing)"
-  | Default -> "Tag_default"
-  | Constructor _ -> "Tag_ctor"
-  | Enum i -> "(Tag_enum " ^ (lemnum string_of_int i) ^ ")"
-  | Alias alias_inf -> "Tag_alias"
-  | Spec -> "Tag_spec"
-
 let rec pp_format_nes nes =
   "[" ^ (*
   (list_format "; "
@@ -365,12 +303,16 @@ let rec pp_format_nes nes =
      nes) ^*) "]"
 
 let pp_format_annot = function
+  | None -> "Nothing"
+  | Some (_, typ, eff) ->
+    "(Just (Env.empty, " ^ pp_format_typ_lem typ ^ ", " ^ pp_format_effects_lem eff ^ "))"
+(*
   | NoTyp -> "Nothing"
   | Base((_,t),tag,nes,efct,efctsum,_) ->
     (*TODO print out bindings for use in pattern match in interpreter*)
      "(Just (" ^ pp_format_t_lem t ^ ", " ^ pp_format_tag tag ^ ", " ^ pp_format_nes nes ^ ", " ^
        pp_format_e_lem efct ^ ", " ^ pp_format_e_lem efctsum ^ "))"
-  | Overload _ -> "Nothing"
+  | Overload _ -> "Nothing" *)
 
 let pp_annot ppf ant = base ppf (pp_format_annot ant)
 
@@ -423,7 +365,7 @@ and pp_lem_exp ppf (E_aux(e,(l,annot))) =
     | E_lit(lit) -> fprintf ppf "(E_aux (%a %a) (%a, %a))" kwd "E_lit" pp_lem_lit lit pp_lem_l l pp_annot annot
     | E_cast(typ,exp) ->
       fprintf ppf "@[<0>(E_aux (E_cast %a %a) (%a, %a))@]" pp_lem_typ typ pp_lem_exp exp pp_lem_l l pp_annot annot
-    | E_internal_cast((_,NoTyp),e) -> pp_lem_exp ppf e
+    | E_internal_cast((_,None),e) -> pp_lem_exp ppf e
     | E_app(f,args) -> fprintf ppf "@[<0>(E_aux (E_app %a [%a]) (%a, %a))@]"
                          pp_lem_id f (list_pp pp_semi_lem_exp pp_lem_exp) args pp_lem_l l pp_annot annot
     | E_app_infix(l',op,r) -> fprintf ppf "@[<0>(E_aux (E_app_infix %a %a %a) (%a, %a))@]"
@@ -490,6 +432,7 @@ and pp_lem_exp ppf (E_aux(e,(l,annot))) =
       fprintf ppf "@[<0>(E_aux (E_return %a) (%a, %a))@]" pp_lem_exp exp pp_lem_l l pp_annot annot
     | E_assert(c,msg) ->
       fprintf ppf "@[<0>(E_aux (E_assert %a %a) (%a, %a))@]" pp_lem_exp c pp_lem_exp msg pp_lem_l l pp_annot annot
+      (*
     | E_internal_exp ((l, Base((_,t),_,_,_,_,bindings))) ->
       (*TODO use bindings where appropriate*)
       (match t.t with
@@ -508,16 +451,22 @@ and pp_lem_exp ppf (E_aux(e,(l,annot))) =
             | Nvar v -> fprintf ppf "@[<0>(E_aux (E_id (Id_aux (Id \"%a\") %a)) (%a,%a))@]"
                                      kwd v pp_lem_l l pp_lem_l l pp_annot (Base(([],nat_t),Emp_local,[],pure_e,pure_e,nob))
             | _ -> raise (Reporting_basic.err_unreachable l "Internal_exp given implicit without variable or const"))
-        | _ ->  raise (Reporting_basic.err_unreachable l "Internal exp given non-vector or implicit"))
+        | _ ->  raise (Reporting_basic.err_unreachable l "Internal exp given non-vector or implicit")*)
     | E_comment _ | E_comment_struc _ ->
       fprintf ppf "@[(E_aux (E_lit (L_aux L_unit %a)) (%a,%a))@]" pp_lem_l l pp_lem_l l pp_annot annot
     | E_internal_cast _ | E_internal_exp _ ->
       raise (Reporting_basic.err_unreachable l "Found internal cast or exp")
     | E_internal_exp_user _ -> (raise (Reporting_basic.err_unreachable l "Found non-rewritten internal_exp_user"))
     | E_sizeof_internal _ -> (raise (Reporting_basic.err_unreachable l "Internal sizeof not removed"))
-    | E_internal_let _ -> (raise (Reporting_basic.err_unreachable l "Found non-rewritten internal_let"))
-    | E_internal_return _ -> (raise (Reporting_basic.err_unreachable l "Found non-rewritten internal_return"))
-    | E_internal_plet _ -> raise (Reporting_basic.err_unreachable l "Found non-rewritten internal_plet")
+    | E_internal_let (lexp,exp1,exp2) ->
+      fprintf ppf "@[<0>(E_aux (E_internal_let %a %a %a) (%a, %a))@]"
+        pp_lem_lexp lexp pp_lem_exp exp1 pp_lem_exp exp2 pp_lem_l l pp_annot annot
+    | E_internal_return exp ->
+      fprintf ppf "@[<0>(E_aux (E_internal_return %a) (%a, %a))@]"
+        pp_lem_exp exp pp_lem_l l pp_annot annot
+    | E_internal_plet (pat,exp1,exp2) ->
+      fprintf ppf "@[<0>(E_aux (E_internal_plet %a %a %a) (%a, %a))@]"
+        pp_lem_pat pat pp_lem_exp exp1 pp_lem_exp exp2 pp_lem_l l pp_annot annot
   in
   print_e ppf e
 
@@ -547,6 +496,7 @@ and pp_lem_lexp ppf (LEXP_aux(lexp,(l,annot))) =
   fprintf ppf "@[(LEXP_aux %a (%a, %a))@]" print_le lexp pp_lem_l l pp_annot annot
 and pp_semi_lem_lexp ppf le = fprintf ppf "@[<1>%a%a@]" pp_lem_lexp le kwd ";"
 
+let pp_semi_lem_id ppf id = fprintf ppf "@[<1>%a%a@]" pp_lem_id id kwd ";"
 
 let pp_lem_default ppf (DT_aux(df,l)) =
   let print_de ppf df =
@@ -566,6 +516,8 @@ let pp_lem_spec ppf (VS_aux(v,(l,annot))) =
       fprintf ppf "@[<0>(%a %a %a \"%s\")@]@\n" kwd "VS_extern_spec" pp_lem_typscm ts pp_lem_id id s
     | VS_extern_no_rename(ts,id) ->
       fprintf ppf "@[<0>(%a %a %a)@]@\n" kwd "VS_extern_no_rename" pp_lem_typscm ts pp_lem_id id
+    | VS_cast_spec(ts,id) ->
+      fprintf ppf "@[<0>(%a %a %a)@]@\n" kwd "VS_cast_spec" pp_lem_typscm ts pp_lem_id id
   in
   fprintf ppf "@[<0>(VS_aux %a (%a, %a))@]" print_spec v pp_lem_l l pp_annot annot
 
@@ -655,6 +607,8 @@ let pp_lem_tannot_opt ppf (Typ_annot_opt_aux(t,l)) =
   match t with
   | Typ_annot_opt_some(tq,typ) ->
     fprintf ppf "(Typ_annot_opt_aux (Typ_annot_opt_some %a %a) %a)" pp_lem_typquant tq pp_lem_typ typ pp_lem_l l
+  | Typ_annot_opt_none ->
+    fprintf ppf "(Typ_annot_opt_aux (Typ_annot_opt_none) %a)" pp_lem_l l
 
 let pp_lem_effects_opt ppf (Effect_opt_aux(e,l)) =
   match e with
@@ -701,6 +655,7 @@ let pp_lem_def ppf d =
   match d with
   | DEF_default(df) -> fprintf ppf "(DEF_default %a);@\n" pp_lem_default df
   | DEF_spec(v_spec) -> fprintf ppf "(DEF_spec %a);@\n" pp_lem_spec v_spec
+  | DEF_overload(id,ids) -> fprintf ppf "(DEF_overload %a [%a]);@\n" pp_lem_id id (list_pp pp_semi_lem_id pp_lem_id) ids
   | DEF_type(t_def) -> fprintf ppf "(DEF_type %a);@\n" pp_lem_typdef t_def
   | DEF_kind(k_def) -> fprintf ppf "(DEF_kind %a);@\n" pp_lem_kindef k_def
   | DEF_fundef(f_def) -> fprintf ppf "(DEF_fundef %a);@\n" pp_lem_fundef f_def
@@ -711,4 +666,3 @@ let pp_lem_def ppf d =
 
 let pp_lem_defs ppf (Defs(defs)) =
   fprintf ppf "Defs [@[%a@]]@\n" (list_pp pp_lem_def pp_lem_def) defs
-
diff --git a/src/pretty_print_lem_new_tc.ml b/src/pretty_print_lem_new_tc.ml
deleted file mode 100644
index 77e0e9de..00000000
--- a/src/pretty_print_lem_new_tc.ml
+++ /dev/null
@@ -1,1392 +0,0 @@
-(**************************************************************************)
-(*     Sail                                                               *)
-(*                                                                        *)
-(*  Copyright (c) 2013-2017                                               *)
-(*    Kathyrn Gray                                                        *)
-(*    Shaked Flur                                                         *)
-(*    Stephen Kell                                                        *)
-(*    Gabriel Kerneis                                                     *)
-(*    Robert Norton-Wright                                                *)
-(*    Christopher Pulte                                                   *)
-(*    Peter Sewell                                                        *)
-(*    Thomas Bauereiss                                                    *)
-(*                                                                        *)
-(*  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 Type_check_new
-open Ast
-open Ast_util
-open Rewriter_new_tc
-open Big_int
-open PPrint
-open Pretty_print_common
-
-(****************************************************************************
- * PPrint-based sail-to-lem pprinter
-****************************************************************************)
-
-let print_to_from_interp_value = ref false
-let langlebar = string "<|"
-let ranglebar = string "|>"
-let anglebars = enclose langlebar ranglebar
-
-let fix_id name = match name with
-  | "assert"
-  | "lsl"
-  | "lsr"
-  | "asr"
-  | "type"
-  | "fun"
-  | "function"
-  | "raise"
-  | "try"
-  | "match"
-  | "with"
-  | "field"
-  | "LT"
-  | "GT"
-  | "EQ"
-  | "integer"
-    -> name ^ "'"
-  | _ -> name
-
-let is_number char =
-  char = '0' || char = '1' || char = '2' || char = '3' || char = '4' || char = '5' ||
-  char = '6' || char = '7' || char = '8' || char = '9'
-
-let doc_id_lem (Id_aux(i,_)) =
-  match i with
-  | Id i ->
-     (* this not the right place to do this, just a workaround *)
-     if i.[0] = '\'' then
-       string ((String.sub i 1 (String.length i - 1)) ^ "'")
-     else if is_number(i.[0]) then
-       string ("v" ^ i ^ "'")
-     else
-       string (fix_id i)
-  | DeIid x ->
-     (* add an extra space through empty to avoid a closing-comment
-      * token in case of x ending with star. *)
-     parens (separate space [colon; string x; empty])
-
-let doc_id_lem_type (Id_aux(i,_)) =
-  match i with
-  | Id("int") -> string "ii"
-  | Id("nat") -> string "ii"
-  | Id("option") -> string "maybe"
-  | Id i -> string (fix_id i)
-  | DeIid x ->
-     (* add an extra space through empty to avoid a closing-comment
-      * token in case of x ending with star. *)
-     parens (separate space [colon; string x; empty])
-
-let doc_id_lem_ctor (Id_aux(i,_)) =
-  match i with
-  | Id("bit") -> string "bitU"
-  | Id("int") -> string "integer"
-  | Id("nat") -> string "integer"
-  | Id("Some") -> string "Just"
-  | Id("None") -> string "Nothing"
-  | Id i -> string (fix_id (String.capitalize i))
-  | DeIid x ->
-     (* add an extra space through empty to avoid a closing-comment
-      * token in case of x ending with star. *)
-     separate space [colon; string (String.capitalize x); empty]
-
-let effectful_set =
-  List.exists
-    (fun (BE_aux (eff,_)) ->
-      match eff with
-      | BE_rreg | BE_wreg | BE_rmem | BE_rmemt | BE_wmem | BE_eamem
-      | BE_exmem | BE_wmv | BE_wmvt | BE_barr | BE_depend | BE_nondet
-      | BE_escape -> true
-      | _ -> false)
-
-let effectful (Effect_aux (eff,_)) =
-  match eff with
-  | Effect_var _ -> failwith "effectful: Effect_var not supported"
-  | Effect_set effs -> effectful_set effs
-
-let doc_typ_lem, doc_atomic_typ_lem =
-  (* following the structure of parser for precedence *)
-  let rec typ regtypes ty = fn_typ regtypes true ty
-    and typ' regtypes ty = fn_typ regtypes false ty
-    and fn_typ regtypes atyp_needed ((Typ_aux (t, _)) as ty) = match t with
-      | Typ_fn(arg,ret,efct) ->
-         (*let exc_typ = string "string" in*)
-         let ret_typ =
-           if effectful efct
-           then separate space [string "M";(*parens exc_typ;*) fn_typ regtypes true ret]
-           else separate space [fn_typ regtypes false ret] in
-         let tpp = separate space [tup_typ regtypes true arg; arrow;ret_typ] in
-         (* once we have proper excetions we need to know what the exceptions type is *)
-         if atyp_needed then parens tpp else tpp
-      | _ -> tup_typ regtypes atyp_needed ty
-    and tup_typ regtypes atyp_needed ((Typ_aux (t, _)) as ty) = match t with
-      | Typ_tup typs ->
-         let tpp = separate_map (space ^^ star ^^ space) (app_typ regtypes false) typs in
-         if atyp_needed then parens tpp else tpp
-      | _ -> app_typ regtypes atyp_needed ty
-    and app_typ regtypes atyp_needed ((Typ_aux (t, _)) as ty) = match t with
-      | Typ_app(Id_aux (Id "vector", _), [
-          Typ_arg_aux (Typ_arg_nexp n, _);
-          Typ_arg_aux (Typ_arg_nexp m, _);
-          Typ_arg_aux (Typ_arg_order ord, _);
-          Typ_arg_aux (Typ_arg_typ elem_typ, _)]) ->
-         let tpp = match elem_typ with
-           | Typ_aux (Typ_id (Id_aux (Id "bit",_)),_) ->
-               let len = match m with
-                 | (Nexp_aux(Nexp_constant i,_)) -> string "ty" ^^ doc_int i
-                 | _ -> doc_nexp m in
-               string "bitvector" ^^ space ^^ len
-           | _ -> string "vector" ^^ space ^^ typ regtypes elem_typ in
-         if atyp_needed then parens tpp else tpp
-      | Typ_app(Id_aux (Id "register", _), [Typ_arg_aux (Typ_arg_typ etyp, _)]) ->
-         (* TODO: Better distinguish register names and contents?
-            The former are represented in the Lem library using a type
-            "register" (without parameters), the latter just using the content
-            type (e.g. "bitvector ty64").  We assume the latter is meant here
-            and drop the "register" keyword. *)
-         fn_typ regtypes atyp_needed etyp
-      | Typ_app(Id_aux (Id "range", _),_) ->
-         (string "integer")
-      | Typ_app(Id_aux (Id "implicit", _),_) ->
-         (string "integer")
-      | Typ_app(Id_aux (Id "atom", _), [Typ_arg_aux(Typ_arg_nexp n,_)]) ->
-         (string "integer")
-      | Typ_app(id,args) ->
-         let tpp = (doc_id_lem_type id) ^^ space ^^ (separate_map space (doc_typ_arg_lem regtypes) args) in
-         if atyp_needed then parens tpp else tpp
-      | _ -> atomic_typ regtypes atyp_needed ty
-    and atomic_typ regtypes atyp_needed ((Typ_aux (t, _)) as ty) = match t with
-      | Typ_id (Id_aux (Id "bool",_)) -> string "bitU"
-      | Typ_id (Id_aux (Id "boolean",_)) -> string "bitU"
-      | Typ_id (Id_aux (Id "bit",_)) -> string "bitU"
-      | Typ_id (id) ->
-         if List.exists ((=) (string_of_id id)) regtypes
-         then string "register"
-         else doc_id_lem_type id
-      | Typ_var v -> doc_var v
-      | Typ_wild -> underscore
-      | Typ_app _ | Typ_tup _ | Typ_fn _ ->
-         (* exhaustiveness matters here to avoid infinite loops
-          * if we add a new Typ constructor *)
-         let tpp = typ regtypes ty in
-         if atyp_needed then parens tpp else tpp
-    and doc_typ_arg_lem regtypes (Typ_arg_aux(t,_)) = match t with
-      | Typ_arg_typ t -> app_typ regtypes true t
-      | Typ_arg_nexp n -> empty
-      | Typ_arg_order o -> empty
-      | Typ_arg_effect e -> empty
-  in typ', atomic_typ
-
-let doc_tannot_lem regtypes eff typ =
-  let ta = doc_typ_lem regtypes typ in
-  if eff then string " : M " ^^ parens ta
-  else string " : " ^^ ta
-
-(* doc_lit_lem gets as an additional parameter the type information from the
- * expression around it: that's a hack, but how else can we distinguish between
- * undefined values of different types ? *)
-let doc_lit_lem in_pat (L_aux(lit,l)) a =
-  utf8string (match lit with
-  | L_unit  -> "()"
-  | L_zero  -> "B0"
-  | L_one   -> "B1"
-  | L_false -> "B0"
-  | L_true  -> "B1"
-  | L_num i ->
-     let ipp = string_of_int i in
-     if in_pat then "("^ipp^":nn)"
-     else if i < 0 then "((0"^ipp^"):ii)"
-     else "("^ipp^":ii)"
-  | 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_undef ->
-     (match a with
-       | Some (_, Typ_aux (t,_), _) ->
-         (match t with
-          | Typ_id (Id_aux (Id "bit", _))
-          | Typ_app (Id_aux (Id "register", _),_) -> "UndefinedRegister 0"
-          | Typ_id (Id_aux (Id "string", _)) -> "\"\""
-          | _ -> "(failwith \"undefined value of unsupported type\")")
-       | _ -> "(failwith \"undefined value of unsupported type\")")
-  | L_string s -> "\"" ^ s ^ "\"")
-
-(* typ_doc is the doc for the type being quantified *)
-
-let doc_typquant_lem (TypQ_aux(tq,_)) typ_doc = typ_doc
-
-let doc_typschm_lem regtypes (TypSchm_aux(TypSchm_ts(tq,t),_)) =
-  (doc_typquant_lem tq (doc_typ_lem regtypes t))
-
-let is_ctor env id = match Env.lookup_id id env with
-| Enum _ | Union _ -> true
-| _ -> false
-
-(*Note: vector concatenation, literal vectors, indexed vectors, and record should
-  be removed prior to pp. The latter two have never yet been seen
-*)
-let rec doc_pat_lem regtypes apat_needed (P_aux (p,(l,annot)) as pa) = match p with
-  | P_app(id, ((_ :: _) as pats)) ->
-     (match annot with
-      | Some (env, _, _) when (is_ctor env id) ->
-         let ppp = doc_unop (doc_id_lem_ctor id)
-                            (parens (separate_map comma (doc_pat_lem regtypes true) pats)) in
-         if apat_needed then parens ppp else ppp
-      | _ -> empty)
-  | P_app(id,[]) ->
-    (match annot with
-     | Some (env, _, _) when (is_ctor env id) -> doc_id_lem_ctor id
-     | _ -> empty)
-  | P_lit lit  -> doc_lit_lem true lit annot
-  | P_wild -> underscore
-  | P_id id ->
-     begin match id with
-     | Id_aux (Id "None",_) -> string "Nothing" (* workaround temporary issue *)
-     | _ -> doc_id_lem id end
-  | P_as(p,id) -> parens (separate space [doc_pat_lem regtypes true p; string "as"; doc_id_lem id])
-  | P_typ(typ,p) -> doc_op colon (doc_pat_lem regtypes true p) (doc_typ_lem regtypes typ)
-  | P_vector pats ->
-     let ppp =
-       (separate space)
-         [string "Vector";brackets (separate_map semi (doc_pat_lem regtypes true) pats);underscore;underscore] in
-     if apat_needed then parens ppp else ppp
-  | P_vector_concat pats ->
-     let ppp =
-       (separate space)
-         [string "Vector";parens (separate_map (string "::") (doc_pat_lem regtypes true) pats);underscore;underscore] in
-     if apat_needed then parens ppp else ppp
-  | P_tup pats  ->
-     (match pats with
-      | [p] -> doc_pat_lem regtypes apat_needed p
-      | _ -> parens (separate_map comma_sp (doc_pat_lem regtypes false) pats))
-     | P_list pats -> brackets (separate_map semi (doc_pat_lem regtypes false) pats) (*Never seen but easy in lem*)
-  | P_record (_,_) | P_vector_indexed _ -> empty (* TODO *)
-
-let rec contains_bitvector_typ (Typ_aux (t,_) as typ) = match t with
-  | Typ_tup ts -> List.exists contains_bitvector_typ ts
-  | Typ_app (_, targs) -> is_bitvector_typ typ || List.exists contains_bitvector_typ_arg targs
-  | Typ_fn (t1,t2,_) -> contains_bitvector_typ t1 || contains_bitvector_typ t2
-  | _ -> false
-and contains_bitvector_typ_arg (Typ_arg_aux (targ, _)) = match targ with
-  | Typ_arg_typ t -> contains_bitvector_typ t
-  | _ -> false
-
-let const_nexp (Nexp_aux (nexp,_)) = match nexp with
-  | Nexp_constant _ -> true
-  | _ -> false
-
-(* Check for variables in types that would be pretty-printed.
-   In particular, in case of vector types, only the element type and the
-   length argument are checked for variables, and the latter only if it is
-   a bitvector; for other types of vectors, the length is not pretty-printed
-   in the type, and the start index is never pretty-printed in vector types. *)
-let rec contains_t_pp_var (Typ_aux (t,a) as typ) = match t with
-  | Typ_wild -> true
-  | Typ_id _ -> false
-  | Typ_var _ -> true
-  | Typ_fn (t1,t2,_) -> contains_t_pp_var t1 || contains_t_pp_var t2
-  | Typ_tup ts -> List.exists contains_t_pp_var ts
-  | Typ_app (c,targs) ->
-      if is_bitvector_typ typ then
-        let (_,length,_,_) = vector_typ_args_of typ in
-        not (const_nexp ((*normalize_nexp*) length))
-      else List.exists contains_t_arg_pp_var targs
-and contains_t_arg_pp_var (Typ_arg_aux (targ, _)) = match targ with
-  | Typ_arg_typ t -> contains_t_pp_var t
-  | Typ_arg_nexp nexp -> not (const_nexp ((*normalize_nexp*) nexp))
-  | _ -> false
-
-let prefix_recordtype = true
-let report = Reporting_basic.err_unreachable
-let doc_exp_lem, doc_let_lem =
-  let rec top_exp regtypes (aexp_needed : bool) (E_aux (e, (l,annot)) as full_exp) =
-    let expY = top_exp regtypes true in
-    let expN = top_exp regtypes false in
-    let expV = top_exp regtypes in
-    match e with
-    | E_assign((LEXP_aux(le_act,tannot) as le), e) ->
-       (* can only be register writes *)
-       let t = typ_of_annot tannot in
-       (match le_act (*, t, tag*) with
-        | LEXP_vector_range (le,e2,e3) ->
-           (match le with
-            | LEXP_aux (LEXP_field (le,id), lannot) ->
-               if is_bit_typ (typ_of_annot lannot) then
-                 raise (report l "indexing a register's (single bit) bitfield not supported")
-               else
-                 (prefix 2 1)
-                   (string "write_reg_field_range")
-                   (align (doc_lexp_deref_lem regtypes le ^^ space^^
-                             string_lit (doc_id_lem id) ^/^ expY e2 ^/^ expY e3 ^/^ expY e))
-            | _ ->
-               (prefix 2 1)
-                 (string "write_reg_range")
-                 (align (doc_lexp_deref_lem regtypes le ^^ space ^^ expY e2 ^/^ expY e3 ^/^ expY e))
-           )
-        | LEXP_vector (le,e2) when is_bit_typ t ->
-           (match le with
-            | LEXP_aux (LEXP_field (le,id), lannot) ->
-               if is_bit_typ (typ_of_annot lannot) then
-                 raise (report l "indexing a register's (single bit) bitfield not supported")
-               else
-                 (prefix 2 1)
-                   (string "write_reg_field_bit")
-                   (align (doc_lexp_deref_lem regtypes le ^^ space ^^ doc_id_lem id ^/^ expY e2 ^/^ expY e))
-            | _ ->
-               (prefix 2 1)
-                 (string "write_reg_bit")
-                 (doc_lexp_deref_lem regtypes le ^^ space ^^ expY e2 ^/^ expY e)
-           )
-        | LEXP_field (le,id) when is_bit_typ t ->
-           (prefix 2 1)
-             (string "write_reg_bitfield")
-             (doc_lexp_deref_lem regtypes le ^^ space ^^ string_lit(doc_id_lem id) ^/^ expY e)
-        | LEXP_field (le,id) ->
-           (prefix 2 1)
-             (string "write_reg_field")
-             (doc_lexp_deref_lem regtypes le ^^ space ^^
-                string_lit(doc_id_lem id) ^/^ expY e)
-        (* | (LEXP_id id | LEXP_cast (_,id)), t, Alias alias_info ->
-           (match alias_info with
-            | Alias_field(reg,field) ->
-               let f = match t with
-                 | (Tid "bit" | Tabbrev (_,{t=Tid "bit"})) ->
-                    string "write_reg_bitfield"
-                 | _ -> string "write_reg_field" in
-               (prefix 2 1)
-                 f
-                 (separate space [string reg;string_lit(string field);expY e])
-            | Alias_pair(reg1,reg2) ->
-               string "write_two_regs" ^^ space ^^ string reg1 ^^ space ^^
-                 string reg2 ^^ space ^^ expY e) *)
-        | _ ->
-           (prefix 2 1) (string "write_reg") (doc_lexp_deref_lem regtypes le ^/^ expY e))
-    | E_vector_append(le,re) ->
-       let t = typ_of_annot (l,annot) in
-       let (call,ta,aexp_needed) =
-         if is_bitvector_typ t then
-           if not (contains_t_pp_var t)
-           then ("bitvector_concat", doc_tannot_lem regtypes false t, true)
-           else ("bitvector_concat", empty, aexp_needed)
-         else ("vector_concat",empty,aexp_needed) in
-       let epp =
-         align (group (separate space [string call;expY le;expY re])) ^^ ta in
-       if aexp_needed then parens epp else epp
-    | E_cons(le,re) -> doc_op (group (colon^^colon)) (expY le) (expY re)
-    | E_if(c,t,e) ->
-       let (E_aux (_,(_,cannot))) = c in
-       let epp =
-         separate space [string "if";group (align (string "bitU_to_bool" ^//^ group (expY c)))] ^^
-           break 1 ^^
-             (prefix 2 1 (string "then") (expN t)) ^^ (break 1) ^^
-               (prefix 2 1 (string "else") (expN e)) in
-       if aexp_needed then parens (align epp) else epp
-    | E_for(id,exp1,exp2,exp3,(Ord_aux(order,_)),exp4) ->
-       raise (report l "E_for should have been removed till now")
-    | E_let(leb,e) ->
-       let epp = let_exp regtypes leb ^^ space ^^ string "in" ^^ hardline ^^ expN e in
-       if aexp_needed then parens epp else epp
-    | E_app(f,args) ->
-       begin match f with
-       (* temporary hack to make the loop body a function of the temporary variables *)
-       | Id_aux ((Id (("foreach_inc" | "foreach_dec" |
-                       "foreachM_inc" | "foreachM_dec" ) as loopf),_)) ->
-          let [id;indices;body;e5] = args in
-          let varspp = match e5 with
-            | E_aux (E_tuple vars,_) ->
-               let vars = List.map (fun (E_aux (E_id (Id_aux (Id name,_)),_)) -> string name) vars in
-               begin match vars with
-               | [v] -> v
-               | _ -> parens (separate comma vars) end
-            | E_aux (E_id (Id_aux (Id name,_)),_) ->
-               string name
-            | E_aux (E_lit (L_aux (L_unit,_)),_) ->
-               string "_" in
-          parens (
-              (prefix 2 1)
-                ((separate space) [string loopf;group (expY indices);expY e5])
-                (parens
-                   (prefix 1 1 (separate space [string "fun";expY id;varspp;arrow]) (expN body))
-                )
-            )
-       | Id_aux (Id "append",_) ->
-          let [e1;e2] = args in
-          let epp = align (expY e1 ^^ space ^^ string "++" ^//^ expY e2) in
-          if aexp_needed then parens (align epp) else epp
-       | Id_aux (Id "slice_raw",_) ->
-          let [e1;e2;e3] = args in
-          let t1 = typ_of e1 in
-          let eff1 = effect_of e1 in
-          let call = if is_bitvector_typ t1 then "bvslice_raw" else "slice_raw" in
-          let epp = separate space [string call;expY e1;expY e2;expY e3] in
-          let (taepp,aexp_needed) =
-            let t = typ_of full_exp in
-            let eff = effect_of full_exp in
-            if contains_bitvector_typ t && not (contains_t_pp_var t)
-            then (align epp ^^ (doc_tannot_lem regtypes (effectful eff) t), true)
-            else (epp, aexp_needed) in
-          if aexp_needed then parens (align taepp) else taepp
-       | Id_aux (Id "length",_) ->
-          let [arg] = args in
-          let targ = typ_of arg in
-          let call = if is_bitvector_typ targ then "bvlength" else "length" in
-          let epp = separate space [string call;expY arg] in
-          if aexp_needed then parens (align epp) else epp
-       | Id_aux (Id "bool_not", _) ->
-          let [a] = args in
-          let epp = align (string "~" ^^ expY a) in
-          if aexp_needed then parens (align epp) else epp
-       | _ ->
-          begin match annot with
-          | Some (env, _, _) when (is_ctor env f) ->
-             let argpp a_needed arg =
-               let t = typ_of arg in
-               if is_vector_typ t then
-                 let call =
-                   if is_bitvector_typ t then "reset_bitvector_start"
-                   else "reset_vector_start" in
-                 let epp = concat [string call;space;expY arg] in
-                 if a_needed then parens epp else epp
-               else expV a_needed arg in
-             let epp =
-               match args with
-               | [] -> doc_id_lem_ctor f
-               | [arg] -> doc_id_lem_ctor f ^^ space ^^ argpp true arg
-               | _ ->
-                  doc_id_lem_ctor f ^^ space ^^ 
-                    parens (separate_map comma (argpp false) args) in
-             if aexp_needed then parens (align epp) else epp
-          | _ ->
-             let call = (*match annot with
-               | Base(_,External (Some n),_,_,_,_) -> string n
-               | _ ->*) doc_id_lem f in
-             let argpp a_needed arg =
-               let t = typ_of arg in
-               if is_vector_typ t then
-                 let call =
-                   if is_bitvector_typ t then "reset_bitvector_start"
-                   else "reset_vector_start" in
-                 let epp = concat [string call;space;expY arg] in
-                 if a_needed then parens epp else epp
-               else expV a_needed arg in
-             let argspp = match args with
-               | [arg] -> argpp true arg
-               | args -> parens (align (separate_map (comma ^^ break 0) (argpp false) args)) in
-             let epp = align (call ^//^ argspp) in
-             let (taepp,aexp_needed) =
-               let t = typ_of full_exp in
-               let eff = effect_of full_exp in
-               if contains_bitvector_typ t && not (contains_t_pp_var t)
-               then (align epp ^^ (doc_tannot_lem regtypes (effectful eff) t), true)
-               else (epp, aexp_needed) in
-             if aexp_needed then parens (align taepp) else taepp
-          end
-       end
-    | E_vector_access (v,e) ->
-       let eff = effect_of full_exp in
-       let epp =
-         if has_effect eff BE_rreg then
-           separate space [string "read_reg_bit";expY v;expY e]
-         else
-           let tv = typ_of v in
-           let call = if is_bitvector_typ tv then "bvaccess" else "access" in
-           separate space [string call;expY v;expY e] in
-       if aexp_needed then parens (align epp) else epp
-    | E_vector_subrange (v,e1,e2) ->
-       let t = typ_of full_exp in
-       let eff = effect_of full_exp in
-       let (epp,aexp_needed) =
-         if has_effect eff BE_rreg then
-           let epp = align (string "read_reg_range" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2) in
-           if contains_bitvector_typ t && not (contains_t_pp_var t)
-           then (epp ^^ doc_tannot_lem regtypes true t, true)
-           else (epp, aexp_needed)
-         else
-           if is_bitvector_typ t then
-             let bepp = string "bvslice" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2 in
-             if not (contains_t_pp_var t)
-             then (bepp ^^ doc_tannot_lem regtypes false t, true)
-             else (bepp, aexp_needed)
-           else (string "slice" ^^ space ^^ expY v ^//^ expY e1 ^//^ expY e2, aexp_needed) in
-       if aexp_needed then parens (align epp) else epp
-    | E_field((E_aux(_,(l,fannot)) as fexp),id) ->
-       let ft = typ_of_annot (l,fannot) in
-       (match fannot with
-        | Some(env, (Typ_aux (Typ_id tid, _)), _) when Env.is_regtyp tid env ->
-           let t = typ_of full_exp in
-           let field_f = string
-             (if is_bit_typ t
-             then "read_reg_bitfield"
-             else "read_reg_field") in
-           let (ta,aexp_needed) =
-             if contains_bitvector_typ t && not (contains_t_pp_var t)
-             then (doc_tannot_lem regtypes true t, true)
-             else (empty, aexp_needed) in
-           let epp = field_f ^^ space ^^ (expY fexp) ^^ space ^^ string_lit (doc_id_lem id) in
-           if aexp_needed then parens (align epp ^^ ta) else (epp ^^ ta)
-        | Some(env, (Typ_aux (Typ_id tid, _)), _) when Env.is_record tid env ->
-           let fname =
-             if prefix_recordtype
-             then (string (string_of_id tid ^ "_")) ^^ doc_id_lem id
-             else doc_id_lem id in
-           expY fexp ^^ dot ^^ fname
-        | _ ->
-           raise (report l "E_field expression with no register or record type"))
-    | E_block [] -> string "()"
-    | E_block exps -> raise (report l "Blocks should have been removed till now.")
-    | E_nondet exps -> raise (report l "Nondet blocks not supported.")
-    | E_id id ->
-       let t = typ_of full_exp in
-       (match annot with
-        | Some (env, Typ_aux (Typ_id tid, _), eff) when Env.is_regtyp tid env ->
-           if has_effect eff BE_rreg then
-             let epp = separate space [string "read_reg";doc_id_lem id] in
-             if contains_bitvector_typ t && not (contains_t_pp_var t)
-             then parens (epp ^^ doc_tannot_lem regtypes true t)
-             else epp
-           else
-             doc_id_lem id
-        | Some (env, _, _) when (is_ctor env id) -> doc_id_lem_ctor id
-        (*| Base((_,t),Alias alias_info,_,eff,_,_) ->
-           (match alias_info with
-            | Alias_field(reg,field) ->
-                let call = match t.t with
-                  | Tid "bit" | Tabbrev (_,{t=Tid "bit"}) -> "read_reg_bitfield"
-                  | _ -> "read_reg_field" in
-                let ta =
-                  if contains_bitvector_typ t && not (contains_t_pp_var t)
-                  then doc_tannot_lem regtypes true t else empty in
-                let epp = separate space [string call;string reg;string_lit(string field)] ^^ ta in
-                if aexp_needed then parens (align epp) else epp
-            | Alias_pair(reg1,reg2) ->
-                let (call,ta) =
-                  if has_effect eff BE_rreg then
-                    let ta =
-                      if contains_bitvector_typ t && not (contains_t_pp_var t)
-                      then doc_tannot_lem regtypes true t else empty in
-                    ("read_two_regs", ta)
-                  else
-                    ("RegisterPair", empty) in
-                let epp = separate space [string call;string reg1;string reg2] ^^ ta in
-                if aexp_needed then parens (align epp) else epp
-            | Alias_extract(reg,start,stop) ->
-                let epp =
-                  if start = stop then
-                    separate space [string "read_reg_bit";string reg;doc_int start]
-                  else
-                    let ta =
-                      if contains_bitvector_typ t && not (contains_t_pp_var t)
-                      then doc_tannot_lem regtypes true t else empty in
-                    separate space [string "read_reg_range";string reg;doc_int start;doc_int stop] ^^ ta in
-                if aexp_needed then parens (align epp) else epp
-           )*)
-        | _ -> doc_id_lem id)
-    | E_lit lit -> doc_lit_lem false lit annot
-    | E_cast(typ,e) ->
-       if is_vector_typ typ then
-         let (start,_,_,_) = vector_typ_args_of typ in
-         let call =
-           if is_bitvector_typ typ then "set_bitvector_start"
-           else "set_vector_start" in
-         let epp = (concat [string call;space;doc_nexp start]) ^//^
-                     expY e in
-         if aexp_needed then parens epp else epp
-       else
-         expV aexp_needed e (*
-       (match annot with
-        | Base((_,t),External _,_,_,_,_) ->
-           (* TODO: Does this case still exist with the new type checker? *)
-           let epp = string "read_reg" ^^ space ^^ expY e in
-           if contains_bitvector_typ t && not (contains_t_pp_var t)
-           then parens (epp ^^ doc_tannot_lem regtypes true t) else epp
-        | Base((_,t),_,_,_,_,_) ->
-           (match typ with
-            | Typ_app (Id_aux (Id "vector",_), [Typ_arg_aux (Typ_arg_nexp(Nexp_aux (Nexp_constant i,_)),_);_;_;_]) ->
-               let call =
-                 if is_bitvector_typ t then "set_bitvector_start"
-                 else "set_vector_start" in
-               let epp = (concat [string call;space;string (string_of_int i)]) ^//^
-                           expY e in
-               if aexp_needed then parens epp else epp
-               (*
-            | Typ_var (Kid_aux (Var "length",_)) ->
-               (* TODO: Does this case still exist with the new type checker? *)
-               let call =
-                 if is_bitvector_typ t then "set_bitvector_start_to_length"
-                 else "set_vector_start_to_length" in
-               let epp = (string call) ^//^ expY e in
-               if aexp_needed then parens epp else epp
-               *)
-            | _ -> 
-               expV aexp_needed e)) (*(parens (doc_op colon (group (expY e)) (doc_typ_lem typ)))) *)
-               *)
-    | E_tuple exps ->
-       (match exps with (*
-        | [e] -> expV aexp_needed e *)
-        | _ -> parens (separate_map comma expN exps))
-    | E_record(FES_aux(FES_Fexps(fexps,_),_)) ->
-       let recordtyp = match annot with
-         | Some (env, Typ_aux (Typ_id tid,_), _) when Env.is_record tid env ->
-           tid
-         | _ ->  raise (report l "cannot get record type") in
-       let epp = anglebars (space ^^ (align (separate_map
-                                          (semi_sp ^^ break 1)
-                                          (doc_fexp regtypes recordtyp) fexps)) ^^ space) in
-       if aexp_needed then parens epp else epp
-    | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
-       let recordtyp = match annot with
-         | Some (env, Typ_aux (Typ_id tid,_), _) when Env.is_record tid env ->
-           tid
-         | _ ->  raise (report l "cannot get record type") in
-       anglebars (doc_op (string "with") (expY e) (separate_map semi_sp (doc_fexp regtypes recordtyp) fexps))
-    | E_vector exps ->
-       let t = typ_of full_exp in
-       let (start, len, order, etyp) =
-         if is_vector_typ t then vector_typ_args_of t
-         else raise (Reporting_basic.err_unreachable l "E_vector of non-vector type") in
-       (*match annot with
-        | Base((_,t),_,_,_,_,_) ->
-           match t.t with
-           | Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; TA_typ etyp])
-             | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; TA_typ etyp])}) ->*)
-              let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
-              let start = match start with
-                | Nexp_aux (Nexp_constant i, _) -> string_of_int i
-                | _ -> if dir then "0" else string_of_int (List.length exps) in
-              let expspp =
-                match exps with
-                | [] -> empty
-                | e :: es ->
-                   let (expspp,_) =
-                     List.fold_left
-                       (fun (pp,count) e ->
-                         (pp ^^ semi ^^ (if count = 20 then break 0 else empty) ^^
-                            expN e),
-                         if count = 20 then 0 else count + 1)
-                       (expN e,0) es in
-                   align (group expspp) in
-              let epp =
-                group (separate space [string "Vector"; brackets expspp;string start;string dir_out]) in
-              let (epp,aexp_needed) =
-                if is_bit_typ etyp then
-                  let bepp = string "vec_to_bvec" ^^ space ^^ parens (align epp) in
-                  if contains_t_pp_var t
-                  then (bepp, aexp_needed)
-                  else (bepp ^^ doc_tannot_lem regtypes false t, true)
-                else (epp,aexp_needed) in
-              if aexp_needed then parens (align epp) else epp
-       (* *)
-    | E_vector_indexed (iexps, (Def_val_aux (default,(dl,dannot)))) ->
-      let t = typ_of full_exp in
-      let (start, len, order, etyp) =
-        if is_vector_typ t then vector_typ_args_of t
-        else raise (Reporting_basic.err_unreachable l "E_vector_indexed of non-vector type") in
-       let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
-       let start = match start with
-         | Nexp_aux (Nexp_constant i, _) -> string_of_int i
-         | _ -> if dir then "0" else string_of_int (List.length iexps) in
-       let size = match len with
-         | Nexp_aux (Nexp_constant i, _)-> string_of_int i
-         | Nexp_aux (Nexp_exp (Nexp_aux (Nexp_constant i, _)), _) ->
-           string_of_int (Util.power 2 i)
-         | _ ->
-           raise (Reporting_basic.err_unreachable l
-             "trying to pretty-print indexed vector without constant size") in
-       let default_string =
-         match default with
-         | Def_val_empty ->
-            if is_bitvector_typ t then string "BU"
-            else failwith "E_vector_indexed of non-bitvector type without default argument"
-         | Def_val_dec e ->
-            (*let (Base ((_,{t = t}),_,_,_,_,_)) = dannot in
-            match t with
-            | Tapp ("register",
-                    [TA_typ ({t = rt})]) ->
-               (* TODO: Does this case still occur with the new type checker? *)
-               let n = match rt with
-                 | Tapp ("vector",TA_nexp {nexp = Nconst i} :: TA_nexp {nexp = Nconst j} ::_) ->
-                    abs_big_int (sub_big_int i j)
-                 | _ ->
-                    raise ((Reporting_basic.err_unreachable dl)
-                             ("not the right type information available to construct "^
-                                "undefined register")) in
-               parens (string ("UndefinedRegister " ^ string_of_big_int n))
-            | _ ->*) expY e in
-       let iexp (i,e) = parens (doc_int i ^^ comma ^^ expN e) in
-       let expspp =
-         match iexps with
-         | [] -> empty
-         | e :: es ->
-            let (expspp,_) =
-              List.fold_left
-                (fun (pp,count) e ->
-                  (pp ^^ semi ^^ (if count = 5 then break 1 else empty) ^^ iexp e),
-                  if count = 5 then 0 else count + 1)
-                (iexp e,0) es in
-            align (expspp) in
-       let call = string "make_indexed_vector" in
-       let epp =
-         align (group (call ^//^ brackets expspp ^/^
-                         separate space [default_string;string start;string size;string dir_out])) in
-       let (bepp, aexp_needed) =
-         if is_bitvector_typ t
-         then (string "vec_to_bvec" ^^ space ^^ parens (epp) ^^ doc_tannot_lem regtypes false t, true)
-         else (epp, aexp_needed) in
-       if aexp_needed then parens (align bepp) else bepp
-    | E_vector_update(v,e1,e2) ->
-       let t = typ_of full_exp in
-       let call = if is_bitvector_typ t then "bvupdate_pos" else "update_pos" in
-       let epp = separate space [string call;expY v;expY e1;expY e2] in
-       if aexp_needed then parens (align epp) else epp
-    | E_vector_update_subrange(v,e1,e2,e3) ->
-       let t = typ_of full_exp in
-       let call = if is_bitvector_typ t then "bvupdate" else "update" in
-       let epp = align (string call ^//^
-                          group (group (expY v) ^/^ group (expY e1) ^/^ group (expY e2)) ^/^
-                            group (expY e3)) in
-       if aexp_needed then parens (align epp) else epp
-    | E_list exps ->
-       brackets (separate_map semi (expN) exps)
-    | E_case(e,pexps) ->
-       let only_integers e =
-         let typ = typ_of e in
-         if Ast_util.is_number typ then
-           let e_pp = expY e in
-           align (string "toNatural" ^//^ e_pp)
-         else
-           (* TODO: Where does this come from?? *)
-           (match typ with
-            | Typ_aux (Typ_tup ([t1;t2;t3;t4;t5] as ts), _) when List.for_all Ast_util.is_number ts ->
-               let e_pp = expY e in
-               align (string "toNaturalFiveTup" ^//^ e_pp)
-            | _ -> expY e)
-       in
-
-       (* This is a hack, incomplete. It's because lem does not allow
-        pattern-matching on integers *)
-       let epp =
-         group ((separate space [string "match"; only_integers e; string "with"]) ^/^
-                  (separate_map (break 1) (doc_case regtypes) pexps) ^/^
-                    (string "end")) in
-       if aexp_needed then parens (align epp) else align epp
-    | E_exit e -> separate space [string "exit"; expY e;]
-    | E_assert (e1,e2) ->
-       let epp = separate space [string "assert'"; expY e1; expY e2] in
-       if aexp_needed then parens (align epp) else align epp
-    | E_app_infix (e1,id,e2) ->
-       (* TODO: Should have been removed by the new type checker; check with Alasdair *)
-       raise (Reporting_basic.err_unreachable l
-         "E_app_infix should have been rewritten before pretty-printing")
-       (*match annot with
-        | Base((_,t),External(Some name),_,_,_,_) ->
-           let argpp arg =
-             let (E_aux (_,(_,Base((_,t),_,_,_,_,_)))) = arg in
-             match t.t with
-             | Tapp("vector",_) ->
-                 let call =
-                   if is_bitvector_typ t then "reset_bitvector_start"
-                   else "reset_vector_start" in
-                 parens (concat [string call;space;expY arg])
-             | _ -> expY arg in
-           let epp =
-             let aux name = align (argpp e1 ^^ space ^^ string name ^//^ argpp e2) in
-             let aux2 name = align (string name ^//^ argpp e1 ^/^ argpp e2) in
-             align
-               (match name with
-                | "power" -> aux2 "pow"
-
-                | "bitwise_and_bit" -> aux "&."
-                | "bitwise_or_bit" -> aux "|."
-                | "bitwise_xor_bit" -> aux "+."
-                | "add" -> aux "+"
-                | "minus" -> aux "-"
-                | "multiply" -> aux "*"
-
-                | "quot" -> aux2 "quot"
-                | "quot_signed" -> aux2 "quot"
-                | "modulo" -> aux2 "modulo"
-                | "add_vec" -> aux2 "add_VVV"
-                | "add_vec_signed" -> aux2 "addS_VVV"
-                | "add_overflow_vec" -> aux2 "addO_VVV"
-                | "add_overflow_vec_signed" -> aux2 "addSO_VVV"
-                | "minus_vec" -> aux2 "minus_VVV"
-                | "minus_overflow_vec" -> aux2 "minusO_VVV"
-                | "minus_overflow_vec_signed" -> aux2 "minusSO_VVV"
-                | "multiply_vec" -> aux2 "mult_VVV"
-                | "multiply_vec_signed" -> aux2 "multS_VVV"
-                | "mult_overflow_vec" -> aux2 "multO_VVV"
-                | "mult_overflow_vec_signed" -> aux2 "multSO_VVV"
-                | "quot_vec" -> aux2 "quot_VVV"
-                | "quot_vec_signed" -> aux2 "quotS_VVV"
-                | "quot_overflow_vec" -> aux2 "quotO_VVV"
-                | "quot_overflow_vec_signed" -> aux2 "quotSO_VVV"
-                | "mod_vec" -> aux2 "mod_VVV"
-
-                | "add_vec_range" -> aux2 "add_VIV"
-                | "add_vec_range_signed" -> aux2 "addS_VIV"
-                | "minus_vec_range" -> aux2 "minus_VIV"
-                | "mult_vec_range" -> aux2 "mult_VIV"
-                | "mult_vec_range_signed" -> aux2 "multS_VIV"
-                | "mod_vec_range" -> aux2 "minus_VIV"
-
-                | "add_range_vec" -> aux2 "add_IVV"
-                | "add_range_vec_signed" -> aux2 "addS_IVV"
-                | "minus_range_vec" -> aux2 "minus_IVV"
-                | "mult_range_vec" -> aux2 "mult_IVV"
-                | "mult_range_vec_signed" -> aux2 "multS_IVV"
-
-                | "add_range_vec_range" -> aux2 "add_IVI"
-                | "add_range_vec_range_signed" -> aux2 "addS_IVI"
-                | "minus_range_vec_range" -> aux2 "minus_IVI"
-
-                | "add_vec_range_range" -> aux2 "add_VII"
-                | "add_vec_range_range_signed" -> aux2 "addS_VII"
-                | "minus_vec_range_range" -> aux2 "minus_VII"
-                | "add_vec_vec_range" -> aux2 "add_VVI"
-                | "add_vec_vec_range_signed" -> aux2 "addS_VVI"
-
-                | "add_vec_bit" -> aux2 "add_VBV"
-                | "add_vec_bit_signed" -> aux2 "addS_VBV"
-                | "add_overflow_vec_bit_signed" -> aux2 "addSO_VBV"
-                | "minus_vec_bit_signed" -> aux2 "minus_VBV"
-                | "minus_overflow_vec_bit" -> aux2 "minusO_VBV"
-                | "minus_overflow_vec_bit_signed" -> aux2 "minusSO_VBV"
-
-                | _ ->
-                   string name ^//^ parens (expN e1 ^^ comma ^/^ expN e2)) in
-           let (epp,aexp_needed) =
-             if contains_bitvector_typ t && not (contains_t_pp_var t)
-             then (parens epp ^^ doc_tannot_lem regtypes false t, true)
-             else (epp, aexp_needed) in
-           if aexp_needed then parens (align epp) else epp
-        | _ ->
-           let epp =
-             align (doc_id_lem id ^//^ parens (expN e1 ^^ comma ^/^ expN e2)) in
-           if aexp_needed then parens (align epp) else epp*)
-    | E_internal_let(lexp, eq_exp, in_exp) ->
-       raise (report l "E_internal_lets should have been removed till now")
-    (*     (separate
-        space
-        [string "let internal";
-         (match lexp with (LEXP_aux ((LEXP_id id | LEXP_cast (_,id)),_)) -> doc_id_lem id);
-         coloneq;
-         exp eq_exp;
-         string "in"]) ^/^
-       exp in_exp *)
-    | E_internal_plet (pat,e1,e2) ->
-       let epp =
-         let b = match e1 with E_aux (E_if _,_) -> true | _ -> false in
-         match pat with
-         | P_aux (P_wild,_) ->
-            (separate space [expV b e1; string ">>"]) ^^ hardline ^^ expN e2
-         | _ ->
-            (separate space [expV b e1; string ">>= fun";
-                             doc_pat_lem regtypes true pat;arrow]) ^^ hardline ^^ expN e2 in
-       if aexp_needed then parens (align epp) else epp
-    | E_internal_return (e1) ->
-       separate space [string "return"; expY e1;]
-    | E_sizeof nexp ->
-      (match nexp with
-        | Nexp_aux (Nexp_constant i, _) -> doc_lit_lem false (L_aux (L_num i, l)) annot
-        | _ ->
-          raise (Reporting_basic.err_unreachable l
-            "pretty-printing non-constant sizeof expressions to Lem not supported"))
-    | E_return _ ->
-      raise (Reporting_basic.err_todo l
-        "pretty-printing early return statements to Lem not yet supported")
-    | E_comment _ | E_comment_struc _ -> empty
-    | E_internal_cast _ | E_internal_exp _ | E_sizeof_internal _ | E_internal_exp_user _ ->
-      raise (Reporting_basic.err_unreachable l
-        "unsupported internal expression encountered while pretty-printing")
-  and let_exp regtypes (LB_aux(lb,_)) = match lb with
-    | LB_val_explicit(_,pat,e)
-      | LB_val_implicit(pat,e) ->
-       prefix 2 1
-              (separate space [string "let"; doc_pat_lem regtypes true pat; equals])
-              (top_exp regtypes false e)
-
-  and doc_fexp regtypes recordtyp (FE_aux(FE_Fexp(id,e),_)) =
-    let fname =
-      if prefix_recordtype
-      then (string (string_of_id recordtyp ^ "_")) ^^ doc_id_lem id
-      else doc_id_lem id in
-    group (doc_op equals fname (top_exp regtypes true e))
-
-  and doc_case regtypes (Pat_aux(Pat_exp(pat,e),_)) =
-    group (prefix 3 1 (separate space [pipe; doc_pat_lem regtypes false pat;arrow])
-                  (group (top_exp regtypes false e)))
-
-  and doc_lexp_deref_lem regtypes ((LEXP_aux(lexp,(l,annot))) as le) = match lexp with
-    | LEXP_field (le,id) ->
-       parens (separate empty [doc_lexp_deref_lem regtypes le;dot;doc_id_lem id])
-    | LEXP_vector(le,e) ->
-       parens ((separate space) [string "access";doc_lexp_deref_lem regtypes le;
-                                 top_exp regtypes true e])
-    | LEXP_id id -> doc_id_lem id
-    | LEXP_cast (typ,id) -> doc_id_lem id
-    | _ ->
-       raise (Reporting_basic.err_unreachable l ("doc_lexp_deref_lem: Shouldn't happen"))
-             (* expose doc_exp_lem and doc_let *)
-  in top_exp, let_exp
-
-(*TODO Upcase and downcase type and constructors as needed*)
-let doc_type_union_lem regtypes (Tu_aux(typ_u,_)) = match typ_u with
-  | Tu_ty_id(typ,id) -> separate space [pipe; doc_id_lem_ctor id; string "of";
-                                        parens (doc_typ_lem regtypes typ)]
-  | Tu_id id -> separate space [pipe; doc_id_lem_ctor id]
-
-let rec doc_range_lem (BF_aux(r,_)) = match r with
-  | BF_single i -> parens (doc_op comma (doc_int i) (doc_int i))
-  | BF_range(i1,i2) -> parens (doc_op comma (doc_int i1) (doc_int i2))
-  | BF_concat(ir1,ir2) -> (doc_range ir1) ^^ comma ^^ (doc_range ir2)
-
-let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with
-  | TD_abbrev(id,nm,typschm) ->
-     doc_op equals (concat [string "type"; space; doc_id_lem_type id])
-            (doc_typschm_lem regtypes typschm)
-  | TD_record(id,nm,typq,fs,_) ->
-     let f_pp (typ,fid) =
-       let fname = if prefix_recordtype
-                   then concat [doc_id_lem id;string "_";doc_id_lem_type fid;]
-                   else doc_id_lem_type fid in
-       concat [fname;space;colon;space;doc_typ_lem regtypes typ; semi] in
-      let fs_doc = group (separate_map (break 1) f_pp fs) in
-      doc_op equals
-             (concat [string "type"; space; doc_id_lem_type id;])
-             (doc_typquant_lem typq (anglebars (space ^^ align fs_doc ^^ space)))
-  | TD_variant(id,nm,typq,ar,_) ->
-     (match id with
-      | Id_aux ((Id "read_kind"),_) -> empty
-      | Id_aux ((Id "write_kind"),_) -> empty
-      | Id_aux ((Id "barrier_kind"),_) -> empty
-      | Id_aux ((Id "trans_kind"),_) -> empty
-      | Id_aux ((Id "instruction_kind"),_) -> empty
-      | Id_aux ((Id "regfp"),_) -> empty
-      | Id_aux ((Id "niafp"),_) -> empty
-      | Id_aux ((Id "diafp"),_) -> empty
-      | _ ->
-         let ar_doc = group (separate_map (break 1) (doc_type_union_lem regtypes) ar) in
-         let typ_pp =
-
-           (doc_op equals)
-             (concat [string "type"; space; doc_id_lem_type id;])
-             (doc_typquant_lem typq ar_doc) in
-         let make_id pat id =
-           separate space [string "SIA.Id_aux";
-                           parens (string "SIA.Id " ^^ string_lit (doc_id id));
-                           if pat then underscore else string "SIA.Unknown"] in
-         let fromInterpValueF = concat [doc_id_lem_type id;string "FromInterpValue"] in
-         let toInterpValueF = concat [doc_id_lem_type id;string "ToInterpValue"] in
-         let fromInterpValuePP =
-           (prefix 2 1)
-             (separate space [string "let rec";fromInterpValueF;string "v";equals;string "match v with"])
-             (
-               ((separate_map (break 1))
-                  (fun (Tu_aux (tu,_)) ->
-                    match tu with
-                    | Tu_ty_id (ty,cid) ->
-                       (separate space)
-                         [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v";
-                          arrow;
-                          doc_id_lem_ctor cid;
-                          parens (string "fromInterpValue v")]
-                    | Tu_id cid ->
-                       (separate space)
-                         [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v";
-                          arrow;
-                          doc_id_lem_ctor cid])
-                  ar) ^/^
-
-                  ((separate space) [pipe;string "SI.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^
-
-                 let failmessage =
-                    (string_lit
-                       (concat [string "fromInterpValue";space;doc_id_lem_type id;colon;space;string "unexpected value. ";]))
-                    ^^
-                      (string " ^ Interp.debug_print_value v") in
-                  ((separate space) [pipe;string "v";arrow;string "failwith";parens failmessage]) ^/^
-                 string "end") in
-         let toInterpValuePP =
-           (prefix 2 1)
-             (separate space [string "let";toInterpValueF;equals;string "function"])
-             (
-               ((separate_map (break 1))
-                  (fun (Tu_aux (tu,_)) ->
-                    match tu with
-                    | Tu_ty_id (ty,cid) ->
-                       (separate space)
-                         [pipe;doc_id_lem_ctor cid;string "v";arrow;
-                          string "SI.V_ctor";
-                          parens (make_id false cid);
-                          parens (string "SIA.T_id " ^^ string_lit (doc_id id));
-                          string "SI.C_Union";
-                          parens (string "toInterpValue v")]
-                    | Tu_id cid ->
-                       (separate space)
-                         [pipe;doc_id_lem_ctor cid;arrow;
-                          string "SI.V_ctor";
-                          parens (make_id false cid);
-                          parens (string "SIA.T_id " ^^ string_lit (doc_id id));
-                          string "SI.C_Union";
-                          parens (string "toInterpValue ()")])
-                  ar) ^/^
-                 string "end") in
-         let fromToInterpValuePP =
-           ((prefix 2 1)
-              (concat [string "instance ";parens (string "ToFromInterpValue " ^^ doc_id_lem_type id)])
-              (concat [string "let toInterpValue = ";toInterpValueF;hardline;
-                       string "let fromInterpValue = ";fromInterpValueF]))
-           ^/^ string "end" in
-         typ_pp ^^ hardline ^^ hardline ^^
-           if !print_to_from_interp_value then
-           toInterpValuePP ^^ hardline ^^ hardline ^^
-             fromInterpValuePP ^^ hardline ^^ hardline ^^
-               fromToInterpValuePP ^^ hardline
-           else empty)
-  | TD_enum(id,nm,enums,_) ->
-     (match id with
-      | Id_aux ((Id "read_kind"),_) -> empty
-      | Id_aux ((Id "write_kind"),_) -> empty
-      | Id_aux ((Id "barrier_kind"),_) -> empty
-      | Id_aux ((Id "trans_kind"),_) -> empty
-      | Id_aux ((Id "instruction_kind"),_) -> empty
-      | Id_aux ((Id "regfp"),_) -> empty
-      | Id_aux ((Id "niafp"),_) -> empty
-      | Id_aux ((Id "diafp"),_) -> empty
-      | _ ->
-         let rec range i j = if i > j then [] else i :: (range (i+1) j) in
-         let nats = range 0 in
-         let enums_doc = group (separate_map (break 1 ^^ pipe ^^ space) doc_id_lem_ctor enums) in
-         let typ_pp = (doc_op equals)
-                        (concat [string "type"; space; doc_id_lem_type id;])
-                        (enums_doc) in
-         let fromInterpValueF = concat [doc_id_lem_type id;string "FromInterpValue"] in
-         let toInterpValueF = concat [doc_id_lem_type id;string "ToInterpValue"] in
-         let make_id pat id =
-           separate space [string "SIA.Id_aux";
-                           parens (string "SIA.Id " ^^ string_lit (doc_id id));
-                           if pat then underscore else string "SIA.Unknown"] in
-         let fromInterpValuePP =
-           (prefix 2 1)
-             (separate space [string "let rec";fromInterpValueF;string "v";equals;string "match v with"])
-             (
-               ((separate_map (break 1))
-                  (fun (cid) ->
-                    (separate space)
-                      [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v";
-                       arrow;doc_id_lem_ctor cid]
-                  )
-                  enums
-               ) ^/^
-                 (
-                   (align
-                      ((prefix 3 1)
-                         (separate space [pipe;string ("SI.V_lit (SIA.L_aux (SIA.L_num n) _)");arrow])
-                         (separate space [string "match";parens(string "natFromInteger n");string "with"] ^/^
-                            (
-                              ((separate_map (break 1))
-                                 (fun (cid,number) ->
-                                   (separate space)
-                                     [pipe;string (string_of_int number);arrow;doc_id_lem_ctor cid]
-                                 )
-                                 (List.combine enums (nats ((List.length enums) - 1)))
-                              ) ^/^ string "end"
-                            )
-                         )
-                      )
-                   )
-                 ) ^/^
-
-                  ((separate space) [pipe;string "SI.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^
-
-                   let failmessage =
-                     (string_lit
-                        (concat [string "fromInterpValue";space;doc_id_lem_type id;colon;space;string "unexpected value. ";]))
-                     ^^
-                       (string " ^ Interp.debug_print_value v") in
-                   ((separate space) [pipe;string "v";arrow;string "failwith";parens failmessage]) ^/^
-
-                     string "end") in
-         let toInterpValuePP =
-           (prefix 2 1)
-             (separate space [string "let";toInterpValueF;equals;string "function"])
-             (
-               ((separate_map (break 1))
-                  (fun (cid,number) ->
-                    (separate space)
-                      [pipe;doc_id_lem_ctor cid;arrow;
-                       string "SI.V_ctor";
-                       parens (make_id false cid);
-                       parens (string "SIA.T_id " ^^ string_lit (doc_id id));
-                       parens (string ("SI.C_Enum " ^ string_of_int number));
-                       parens (string "toInterpValue ()")])
-                  (List.combine enums (nats ((List.length enums) - 1)))) ^/^
-                 string "end") in
-         let fromToInterpValuePP =
-           ((prefix 2 1)
-             (concat [string "instance ";parens (string "ToFromInterpValue " ^^ doc_id_lem_type id)])
-             (concat [string "let toInterpValue = ";toInterpValueF;hardline;
-                      string "let fromInterpValue = ";fromInterpValueF]))
-           ^/^ string "end" in
-          typ_pp ^^ hardline ^^ hardline ^^
-            if !print_to_from_interp_value 
-            then toInterpValuePP ^^ hardline ^^ hardline ^^
-              fromInterpValuePP ^^ hardline ^^ hardline ^^
-                fromToInterpValuePP ^^ hardline
-            else empty)
-  | TD_register(id,n1,n2,rs) ->
-    match n1,n2 with
-    | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) ->
-       let doc_rid (r,id) = parens (separate comma_sp [string_lit (doc_id_lem id);
-                                                       doc_range_lem r;]) in
-       let doc_rids = group (separate_map (semi ^^ (break 1)) doc_rid rs) in
-       (*let doc_rfield (_,id) =
-         (doc_op equals)
-           (string "let" ^^ space ^^ doc_id_lem id)
-           (string "Register_field" ^^ space ^^ string_lit(doc_id_lem id)) in*)
-       let dir_b = i1 < i2 in
-       let dir = string (if dir_b then "true" else "false") in
-       let size = if dir_b then i2-i1 +1 else i1-i2 + 1 in
-       (doc_op equals)
-         (concat [string "let";space;string "build_";doc_id_lem id;space;string "regname"])
-         (string "Register" ^^ space ^^
-            align (separate space [string "regname"; doc_int size; doc_int i1; dir;
-                                   break 0 ^^ brackets (align doc_rids)]))
-       (*^^ hardline ^^
-         separate_map hardline doc_rfield rs *)
-
-let doc_rec_lem (Rec_aux(r,_)) = match r with
-  | Rec_nonrec -> space
-  | Rec_rec -> space ^^ string "rec" ^^ space
-
-let doc_tannot_opt_lem regtypes (Typ_annot_opt_aux(t,_)) = match t with
-  | Typ_annot_opt_some(tq,typ) -> doc_typquant_lem tq (doc_typ_lem regtypes typ)
-
-let doc_funcl_lem regtypes (FCL_aux(FCL_Funcl(id,pat,exp),_)) =
-  group (prefix 3 1 ((doc_pat_lem regtypes false pat) ^^ space ^^ arrow)
-                (doc_exp_lem regtypes false exp))
-
-let get_id = function
-  | [] -> failwith "FD_function with empty list"
-  | (FCL_aux (FCL_Funcl (id,_,_),_))::_ -> id
-
-module StringSet = Set.Make(String)
-
-let rec doc_fundef_lem regtypes (FD_aux(FD_function(r, typa, efa, fcls),fannot)) =
-  match fcls with
-  | [] -> failwith "FD_function with empty function list"
-  | [FCL_aux (FCL_Funcl(id,pat,exp),_)] ->
-     (prefix 2 1)
-       ((separate space)
-          [(string "let") ^^ (doc_rec_lem r) ^^ (doc_id_lem id);
-           (doc_pat_lem regtypes true pat);
-           equals])
-       (doc_exp_lem regtypes false exp)
-  | _ ->
-    let id = get_id fcls in
-    (*    let sep = hardline ^^ pipe ^^ space in *)
-    match id with
-    | Id_aux (Id fname,idl)
-      when fname = "execute" || fname = "initial_analysis" ->
-      let (_,auxiliary_functions,clauses) = 
-        List.fold_left 
-          (fun (already_used_fnames,auxiliary_functions,clauses) funcl ->
-            match funcl with
-            | FCL_aux (FCL_Funcl (Id_aux (Id _,l),pat,exp),annot) ->
-               let ctor, l, argspat, pannot = (match pat with
-                 | P_aux (P_app (Id_aux (Id ctor,l),argspat),pannot) ->
-                   (ctor, l, argspat, pannot)
-                 | P_aux (P_id (Id_aux (Id ctor,l)), pannot) ->
-                   (ctor, l, [], pannot)
-                 | _ ->
-                   raise (Reporting_basic.err_unreachable l
-                     "unsupported parameter pattern in function clause")) in
-               let rec pick_name_not_clashing_with already_used candidate =
-                 if StringSet.mem candidate already_used then
-                   pick_name_not_clashing_with already_used (candidate ^ "'")
-                 else candidate in
-               let aux_fname = pick_name_not_clashing_with already_used_fnames (fname ^ "_" ^ ctor) in
-               let already_used_fnames = StringSet.add aux_fname already_used_fnames in
-               let fcl = FCL_aux (FCL_Funcl (Id_aux (Id aux_fname,l),
-                                             P_aux (P_tup argspat,pannot),exp),annot) in
-               let auxiliary_functions = 
-                  auxiliary_functions ^^ hardline ^^ hardline ^^
-                    doc_fundef_lem regtypes (FD_aux (FD_function(r,typa,efa,[fcl]),fannot)) in
-               (* Bind complex patterns to names so that we can pass them to the
-                  auxiliary function *)
-               let name_pat idx (P_aux (p,a)) = match p with
-                 | P_as (pat,_) -> P_aux (p,a) (* already named *)
-                 | P_lit _ -> P_aux (p,a) (* no need to name a literal *)
-                 | P_id _ -> P_aux (p,a) (* no need to name an identifier *)
-                 | _ -> P_aux (P_as (P_aux (p,a), Id_aux (Id ("arg" ^ string_of_int idx),l)),a) in
-               let named_argspat = List.mapi name_pat argspat in
-               let named_pat = P_aux (P_app (Id_aux (Id ctor,l),named_argspat),pannot) in
-               let doc_arg idx (P_aux (p,(l,a))) = match p with
-                 | P_as (pat,id) -> doc_id_lem id
-                 | P_lit lit -> doc_lit_lem false lit a
-                 | P_id id -> doc_id_lem id
-                 | _ -> string ("arg" ^ string_of_int idx) in
-               let clauses =
-                 clauses ^^ (break 1) ^^
-                   (separate space
-                      [pipe;doc_pat_lem regtypes false named_pat;arrow;
-                       string aux_fname;
-                       parens (separate comma (List.mapi doc_arg named_argspat))]) in
-               (already_used_fnames,auxiliary_functions,clauses)
-          ) (StringSet.empty,empty,empty) fcls in
-
-      auxiliary_functions ^^ hardline ^^ hardline ^^
-      (prefix 2 1)
-        ((separate space) [string "let" ^^ doc_rec_lem r ^^ doc_id_lem id;equals;string "function"])
-        (clauses ^/^ string "end")
-    | _ ->
-      let clauses =
-        (separate_map (break 1))
-          (fun fcl -> separate space [pipe;doc_funcl_lem regtypes fcl]) fcls in
-      (prefix 2 1)
-        ((separate space) [string "let" ^^ doc_rec_lem r ^^ doc_id_lem id;equals;string "function"])
-        (clauses ^/^ string "end")
-      
-
-
-let doc_dec_lem (DEC_aux (reg,(l,annot))) =
-  match reg with
-  | DEC_reg(typ,id) ->
-     (match typ with
-      | Typ_aux (Typ_app (r, [Typ_arg_aux (Typ_arg_typ rt, _)]), _)
-        when string_of_id r = "register" && is_vector_typ rt ->
-        let (start, size, order, etyp) = vector_typ_args_of rt in
-        (match is_bit_typ etyp, start, size with
-          | true, Nexp_aux (Nexp_constant start, _), Nexp_aux (Nexp_constant size, _) ->
-             let o = if is_order_inc order then "true" else "false" in
-             (doc_op equals)
-             (string "let" ^^ space ^^ doc_id_lem id)
-             (string "Register" ^^ space ^^
-                align (separate space [string_lit(doc_id_lem id);
-                                       doc_int (size);
-                                       doc_int (start);
-                                       string o;
-                                       string "[]"]))
-                ^/^ hardline
-           | _ ->
-              let (Id_aux (Id name,_)) = id in
-              failwith ("can't deal with register " ^ name))
-      | Typ_aux (Typ_app(r, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id idt, _)), _)]), _)
-        when string_of_id r = "register" ->
-         separate space [string "let";doc_id_lem id;equals;
-                         string "build_" ^^ string (string_of_id idt);string_lit (doc_id_lem id)] ^/^ hardline
-      | Typ_aux (Typ_id idt, _) ->
-         separate space [string "let";doc_id_lem id;equals;
-                         string "build_" ^^ string (string_of_id idt);string_lit (doc_id_lem id)] ^/^ hardline
-      |_-> empty)
-  | DEC_alias(id,alspec) -> empty
-  | DEC_typ_alias(typ,id,alspec) -> empty
-
-let doc_spec_lem regtypes (VS_aux (valspec,annot)) =
-  match valspec with
-  | VS_extern_no_rename _
-  | VS_extern_spec _ -> empty (* ignore these at the moment *)
-  | VS_val_spec (typschm,id) | VS_cast_spec (typschm,id) -> empty
-(* separate space [string "val"; doc_id_lem id; string ":";doc_typschm_lem regtypes typschm] ^/^ hardline *)
-
-
-let rec doc_def_lem regtypes def = match def with
-  | DEF_spec v_spec -> (doc_spec_lem regtypes v_spec,empty)
-  | DEF_overload _ -> (empty,empty)
-  | DEF_type t_def -> (group (doc_typdef_lem regtypes t_def) ^/^ hardline,empty)
-  | DEF_reg_dec dec -> (group (doc_dec_lem dec),empty)
-
-  | DEF_default df -> (empty,empty)
-  | DEF_fundef f_def -> (empty,group (doc_fundef_lem regtypes f_def) ^/^ hardline)
-  | DEF_val lbind -> (empty,group (doc_let_lem regtypes lbind) ^/^ hardline)
-  | DEF_scattered sdef -> failwith "doc_def_lem: shoulnd't have DEF_scattered at this point"
-
-  | DEF_kind _ -> (empty,empty)
-
-  | DEF_comm (DC_comm s) -> (empty,comment (string s))
-  | DEF_comm (DC_comm_struct d) ->
-     let (typdefs,vdefs) = doc_def_lem regtypes d in
-     (empty,comment (typdefs ^^ hardline ^^ vdefs))
-
-
-let doc_defs_lem regtypes (Defs defs) =
-  let (typdefs,valdefs) = List.split (List.map (doc_def_lem regtypes) defs) in
-  (separate empty typdefs,separate empty valdefs)
-
-let find_regtypes (Defs defs) =
-  List.fold_left
-    (fun acc def ->
-      match def with
-      | DEF_type (TD_aux(TD_register (Id_aux (Id tname, _),_,_,_),_)) -> tname :: acc
-      | _ -> acc
-    ) [] defs
-
-
-let typ_to_t env =
-  Type_check.typ_to_t env false false
-
-let pp_defs_lem (types_file,types_modules) (prompt_file,prompt_modules) (state_file,state_modules) d top_line =
-  let regtypes = find_regtypes d in
-  let (typdefs,valdefs) = doc_defs_lem regtypes d in
-  (print types_file)
-    (concat
-       [string "(*" ^^ (string top_line) ^^ string "*)";hardline;
-        (separate_map hardline)
-          (fun lib -> separate space [string "open import";string lib]) types_modules;hardline;
-        if !print_to_from_interp_value
-        then
-          concat
-            [(separate_map hardline)
-               (fun lib -> separate space [string "     import";string lib]) ["Interp";"Interp_ast"];
-             string "open import Deep_shallow_convert";
-             hardline;
-             hardline;
-             string "module SI = Interp"; hardline;
-             string "module SIA = Interp_ast"; hardline;
-             hardline]
-        else empty;
-        typdefs]);
-  (print prompt_file)
-    (concat
-       [string "(*" ^^ (string top_line) ^^ string "*)";hardline;
-        (separate_map hardline)
-          (fun lib -> separate space [string "open import";string lib]) prompt_modules;hardline;
-        hardline;
-        valdefs]);
-  (print state_file)
-    (concat
-       [string "(*" ^^ (string top_line) ^^ string "*)";hardline;
-        (separate_map hardline)
-          (fun lib -> separate space [string "open import";string lib]) state_modules;hardline;
-        hardline;
-        valdefs]);
diff --git a/src/pretty_print_ocaml.ml b/src/pretty_print_ocaml.ml
index adca6b12..35a34cd6 100644
--- a/src/pretty_print_ocaml.ml
+++ b/src/pretty_print_ocaml.ml
@@ -41,8 +41,9 @@
 (**************************************************************************)
 
 open Big_int
-open Type_internal
 open Ast
+open Ast_util
+open Type_check_new
 open PPrint
 open Pretty_print_common
 
@@ -73,10 +74,10 @@ let doc_id_ocaml_type (Id_aux(i,_)) =
        * token in case of x ending with star. *)
       parens (separate space [colon; string (String.uncapitalize x); empty])
 
-let doc_id_ocaml_ctor n (Id_aux(i,_)) =
+let doc_id_ocaml_ctor (Id_aux(i,_)) =
   match i with
   | Id("bit") -> string "vbit"
-  | Id i -> string ((if n > 246 then "`" else "") ^ (String.capitalize i))
+  | Id i -> string ((* TODO if n > 246 then "`" else "") ^ *) (String.capitalize i))
   | DeIid x ->
       (* add an extra space through empty to avoid a closing-comment
        * token in case of x ending with star. *)
@@ -154,10 +155,17 @@ let doc_pat_ocaml =
   let rec pat pa = app_pat pa
   and app_pat ((P_aux(p,(l,annot))) as pa) = match p with
     | P_app(id, ((_ :: _) as pats)) ->
-      (match annot with
-       | Base(_,Constructor n,_,_,_,_) ->
-         doc_unop (doc_id_ocaml_ctor n id) (parens (separate_map comma_sp pat pats))
-       | _ -> empty)
+      (* TODO This check fails for some reason in the MIPS execute function;
+         lookup_id returns Unbound, maybe because the environment is not
+         propagated correctly during rewriting.
+         I comment out the check for now. *)
+      (* (match annot with
+       | Some (env, typ, eff) ->
+         (match Env.lookup_id id env with
+           | Union _ -> *)
+             doc_unop (doc_id_ocaml_ctor id) (parens (separate_map comma_sp pat pats))
+           (* | _ -> empty)
+       | _ -> empty) *)
   | P_lit lit  -> doc_lit_ocaml true lit
   | P_wild -> underscore
   | P_id id -> doc_id_ocaml id
@@ -165,8 +173,10 @@ let doc_pat_ocaml =
   | P_typ(typ,p) -> doc_op colon (pat p) (doc_typ_ocaml typ)
   | P_app(id,[]) ->
     (match annot with
-     | Base(_,(Constructor n | Enum n),_,_,_,_) ->
-       doc_id_ocaml_ctor n id
+     | Some (env, typ, eff) ->
+       (match Env.lookup_id id env with
+         | Union _ | Enum _ -> doc_id_ocaml_ctor id
+         | _ -> failwith "encountered unexpected P_app pattern")
      | _ -> failwith "encountered unexpected P_app pattern")
   | P_vector pats ->
     let non_bit_print () =
@@ -176,14 +186,14 @@ let doc_pat_ocaml =
                                                     underscore;
                                                     underscore])]) in
     (match annot with
-     | Base(([],t),_,_,_,_,_) ->
-       if is_bit_vector t
-       then parens (separate space [string "Vvector";
-                                    parens (separate comma_sp [squarebars (separate_map semi pat pats);
-                                                                underscore;
-                                                                underscore])])
-       else non_bit_print()
-     | _ -> non_bit_print ())
+    | Some (env, typ, _) ->
+      if is_bitvector_typ (Env.base_typ_of env typ)
+      then parens (separate space [string "Vvector";
+                                   parens (separate comma_sp [squarebars (separate_map semi pat pats);
+                                                               underscore;
+                                                               underscore])])
+      else non_bit_print()
+    | None -> non_bit_print())
   | P_tup pats  -> parens (separate_map comma_sp pat pats)
   | P_list pats -> brackets (separate_map semi pat pats) (*Never seen but easy in ocaml*)
   | P_record _ -> raise (Reporting_basic.err_unreachable l "unhandled record pattern")
@@ -191,26 +201,47 @@ let doc_pat_ocaml =
   | P_vector_concat _ -> raise (Reporting_basic.err_unreachable l "unhandled vector_concat pattern")
   in pat
 
+let id_is_local_var id env = match Env.lookup_id id env with
+  | Local _ | Unbound -> true
+  | _ -> false
+
+let rec lexp_is_local (LEXP_aux (lexp, _)) env = match lexp with
+  | LEXP_memory _ -> false
+  | LEXP_id id
+  | LEXP_cast (_, id) -> id_is_local_var id env
+  | LEXP_tup lexps -> List.for_all (fun lexp -> lexp_is_local lexp env) lexps
+  | LEXP_vector (lexp,_)
+  | LEXP_vector_range (lexp,_,_)
+  | LEXP_field (lexp,_) -> lexp_is_local lexp env
+
+let is_regtyp (Typ_aux (typ,_)) env = match typ with
+  | Typ_app (register, _) -> string_of_id register = "register"
+  | Typ_id id -> Env.is_regtyp id env
+  | _ -> false
+
 let doc_exp_ocaml, doc_let_ocaml =
-  let rec top_exp read_registers (E_aux (e, (_,annot))) =
+  let rec top_exp read_registers (E_aux (e, (l,annot)) as full_exp) =
     let exp = top_exp read_registers in
+    let (env, typ, eff) = match annot with
+    | Some (env, typ, eff) -> (env, typ, eff)
+    | None -> raise (Reporting_basic.err_unreachable l "no type annotation") in
     match e with
     | E_assign((LEXP_aux(le_act,tannot) as le),e) ->
-      (match annot with
-       | Base(_,(Emp_local | Emp_set),_,_,_,_) ->
-         (match le_act with
-          | LEXP_id _ | LEXP_cast _ ->
-            (*Setting local variable fully *)
-            doc_op coloneq (doc_lexp_ocaml true le) (exp e)
-          | LEXP_vector _ ->
-            doc_op (string "<-") (doc_lexp_array_ocaml le) (exp e)
-          | LEXP_vector_range _ ->
-            doc_lexp_rwrite le e)
-       | _ ->
-         (match le_act with
-          | LEXP_vector _ | LEXP_vector_range _ | LEXP_cast _ | LEXP_field _ | LEXP_id _ ->
-            (doc_lexp_rwrite le e)
-          | LEXP_memory _ -> (doc_lexp_fcall le e)))
+      if lexp_is_local le env
+      then
+       (match le_act with
+        | LEXP_id _ | LEXP_cast _ ->
+          (*Setting local variable fully *)
+          doc_op coloneq (doc_lexp_ocaml true le) (exp e)
+        | LEXP_vector _ ->
+          doc_op (string "<-") (doc_lexp_array_ocaml le) (exp e)
+        | LEXP_vector_range _ ->
+          doc_lexp_rwrite le e)
+      else
+       (match le_act with
+        | LEXP_vector _ | LEXP_vector_range _ | LEXP_cast _ | LEXP_field _ | LEXP_id _ ->
+          (doc_lexp_rwrite le e)
+        | LEXP_memory _ -> (doc_lexp_fcall le e))
     | E_vector_append(l,r) ->
       parens ((string "vector_concat ") ^^ (exp l) ^^ space ^^ (exp r))
     | E_cons(l,r) -> doc_op (group (colon^^colon)) (exp l) (exp r)
@@ -258,9 +289,8 @@ let doc_exp_ocaml, doc_let_ocaml =
          *)*)
     | E_let(leb,e) -> doc_op (string "in") (let_exp leb) (exp e)
     | E_app(f,args) ->
-      let call,ctor = match annot with
-        | Base(_,External (Some n),_,_,_,_) -> string n,false
-        | Base(_,Constructor i,_,_,_,_) -> doc_id_ocaml_ctor i f,true
+      let call,ctor = match Env.lookup_id f env with
+        | Union _ -> doc_id_ocaml_ctor f,true
         | _ -> doc_id_ocaml f,false in
       let base_print () = parens (doc_unop call (parens (separate_map comma exp args))) in
       if not(ctor)
@@ -272,39 +302,38 @@ let doc_exp_ocaml, doc_let_ocaml =
             | _ -> base_print())
         | args ->  base_print())
     | E_vector_access(v,e) ->
-      let call = (match annot with
-          | Base((_,t),_,_,_,_,_) ->
-            (match t.t with
-             | Tid "bit" | Tabbrev(_,{t=Tid "bit"}) -> (string "bit_vector_access")
-             | _ -> (string "vector_access"))
-          | _ -> (string "vector_access")) in
+      let call =
+        if is_bit_typ (Env.base_typ_of env typ)
+        then (string "bit_vector_access")
+        else (string "vector_access") in
       parens (call ^^ space ^^ exp v ^^ space ^^ exp e)
     | E_vector_subrange(v,e1,e2) ->
       parens ((string "vector_subrange") ^^ space ^^ (exp v) ^^ space ^^ (exp e1) ^^ space ^^ (exp e2))
-    | E_field((E_aux(_,(_,fannot)) as fexp),id) ->
-      (match fannot with
-       | Base((_,{t= Tapp("register",_)}),_,_,_,_,_) |
-         Base((_,{t= Tabbrev(_,{t=Tapp("register",_)})}),_,_,_,_,_)->
-         let field_f = match annot with
-           | Base((_,{t = Tid "bit"}),_,_,_,_,_) |
-             Base((_,{t = Tabbrev(_,{t=Tid "bit"})}),_,_,_,_,_) ->
-             string "get_register_field_bit"
-           | _ -> string "get_register_field_vec" in
-         parens (field_f ^^ space ^^ (exp fexp) ^^ space ^^ string_lit (doc_id id))
-      | _ -> exp fexp ^^ dot ^^ doc_id_ocaml id)
+    | E_field((E_aux(_,(fl,fannot)) as fexp),id) ->
+      let ftyp = typ_of_annot (fl,fannot) in
+      if (is_regtyp ftyp env) then
+        let field_f =
+          if (is_bit_typ (Env.base_typ_of env ftyp))
+          then string "get_register_field_bit"
+          else string "get_register_field_vec" in
+        parens (field_f ^^ space ^^ (exp fexp) ^^ space ^^ string_lit (doc_id id))
+      else exp fexp ^^ dot ^^ doc_id_ocaml id
     | E_block [] -> string "()"
     | E_block exps | E_nondet exps ->
       let exps_doc = separate_map (semi ^^ hardline) exp exps in
       surround 2 1 (string "begin") exps_doc (string "end")
     | E_id id ->
-      (match annot with
-      | Base((_, ({t = Tapp("reg",_)} | {t=Tabbrev(_,{t=Tapp("reg",_)})})),_,_,_,_,_) ->
-        string "!" ^^ doc_id_ocaml id
-      | Base((_, ({t = Tapp("register",_)} | {t=Tabbrev(_,{t=Tapp("register",_)})})),_,_,_,_,_) ->
-        if read_registers
-        then string "(read_register " ^^ doc_id_ocaml id ^^ string ")"
-        else doc_id_ocaml id
-      | Base(_,(Constructor i |Enum i),_,_,_,_) -> doc_id_ocaml_ctor i id
+      (match Env.lookup_id id env with
+        | Local (Mutable, _) ->
+          string "!" ^^ doc_id_ocaml id
+        | Union _ | Enum _ -> doc_id_ocaml_ctor id
+        | _ ->
+          if (is_regtyp typ env) then
+            if read_registers
+            then string "(read_register " ^^ doc_id_ocaml id ^^ string ")"
+            else doc_id_ocaml id
+          else doc_id_ocaml id)
+      (*match annot with
       | Base((_,t),Alias alias_info,_,_,_,_) ->
          (match alias_info with
          | Alias_field(reg,field) ->
@@ -320,16 +349,15 @@ let doc_exp_ocaml, doc_let_ocaml =
          | Alias_pair(reg1,reg2) ->
            parens (separate space [string "vector_concat";
                                    string (sanitize_name reg1);
-                                   string (sanitize_name reg2)]))
-      | _ -> doc_id_ocaml id)
+                                   string (sanitize_name reg2)])) *)
     | E_lit lit -> doc_lit_ocaml false lit
     | E_cast(typ,e) ->
-      (match annot with
+      (* (match annot with
       | Base(_,External _,_,_,_,_) ->
         if read_registers
         then parens (string "read_register" ^^ space ^^ exp e)
         else exp e
-      | _ -> 
+      | _ ->  *)
          let (Typ_aux (t,_)) = typ in
              (match t with
             | Typ_app (Id_aux (Id "vector",_), [Typ_arg_aux (Typ_arg_nexp(Nexp_aux (Nexp_constant i,_)),_);_;_;_]) ->
@@ -338,7 +366,7 @@ let doc_exp_ocaml, doc_let_ocaml =
             | Typ_var (Kid_aux (Var "length",_)) ->
                parens ((string "set_start_to_length") ^//^ exp e)
             | _ -> 
-               parens (doc_op colon (group (exp e)) (doc_typ_ocaml typ))))
+               parens (doc_op colon (group (exp e)) (doc_typ_ocaml typ)))
     | E_tuple exps ->
       parens (separate_map comma exp exps)
     | E_record(FES_aux(FES_Fexps(fexps,_),_)) ->
@@ -346,41 +374,47 @@ let doc_exp_ocaml, doc_let_ocaml =
     | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
       braces (doc_op (string "with") (exp e) (separate_map semi_sp doc_fexp fexps))
     | E_vector exps ->
-      (match annot with
+      let (start, _, order, _) = vector_typ_args_of (Env.base_typ_of env typ) in
+      (*match annot with
        | Base((_,t),_,_,_,_,_) ->
          match t.t with
          | Tapp("vector", [TA_nexp start; _; TA_ord order; _])
-         | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; _; TA_ord order; _])}) ->
-           let call = if is_bit_vector t then (string "Vvector") else (string "VvectorR") in
-           let dir,dir_out = match order.order with
-             | Oinc -> true,"true"
-             | _ -> false, "false" in
-           let start = match start.nexp with
-             | Nconst i -> string_of_big_int i
-             | N2n(_,Some i) -> string_of_big_int i
+         | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; _; TA_ord order; _])}) ->*)
+           let call = if is_bitvector_typ typ then (string "Vvector") else (string "VvectorR") in
+           let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
+           let start = match start with
+             | Nexp_aux (Nexp_constant i, _) -> string_of_int i
+             | Nexp_aux (Nexp_exp (Nexp_aux (Nexp_constant i, _)), _) ->
+               string_of_int (Util.power 2 i)
              | _ -> if dir then "0" else string_of_int (List.length exps) in
            parens (separate space [call; parens (separate comma_sp [squarebars (separate_map semi exp exps);
                                                                    string start;
-                                                                   string dir_out])]))
+                                                                   string dir_out])])
     | E_vector_indexed (iexps, (Def_val_aux (default,_))) ->
-      (match annot with
+      let (start, len, order, _) = vector_typ_args_of (Env.base_typ_of env typ) in
+      (*match annot with
        | Base((_,t),_,_,_,_,_) ->
          match t.t with
          | Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])
          | Tabbrev(_,{t= Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])})
-         | Tapp("reg", [TA_typ {t =Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])}]) ->
-           let call = if is_bit_vector t then (string "make_indexed_bitv") else (string "make_indexed_v") in
-           let dir,dir_out = match order.order with
-             | Oinc -> true,"true"
-             | _ -> false, "false" in
-           let start = match start.nexp with
-             | Nconst i | N2n(_,Some i)-> string_of_big_int i
-             | N2n({nexp=Nconst i},_) -> string_of_int (Util.power 2 (int_of_big_int i))
+         | Tapp("reg", [TA_typ {t =Tapp("vector", [TA_nexp start; TA_nexp len; TA_ord order; _])}]) ->*)
+           let call =
+             if is_bitvector_typ (Env.base_typ_of env typ)
+             then (string "make_indexed_bitv")
+             else (string "make_indexed_v") in
+           let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
+           let start = match start with
+             | Nexp_aux (Nexp_constant i, _) -> string_of_int i
+             | Nexp_aux (Nexp_exp (Nexp_aux (Nexp_constant i, _)), _) ->
+               string_of_int (Util.power 2 i)
              | _ -> if dir then "0" else string_of_int (List.length iexps) in
-           let size = match len.nexp with
-             | Nconst i | N2n(_,Some i)-> string_of_big_int i
-             | N2n({nexp=Nconst i},_) -> string_of_int (Util.power 2 (int_of_big_int i))
-           in
+           let size = match len with
+             | Nexp_aux (Nexp_constant i, _) -> string_of_int i
+             | Nexp_aux (Nexp_exp (Nexp_aux (Nexp_constant i, _)), _) ->
+               string_of_int (Util.power 2 i)
+             | _ ->
+               raise (Reporting_basic.err_unreachable l
+                 "indexed vector without known length") in
            let default_string =
              (match default with
               | Def_val_empty -> string "None"
@@ -391,7 +425,7 @@ let doc_exp_ocaml, doc_let_ocaml =
                                    default_string;
                                    string start;
                                    string size;
-                                   string dir_out]))
+                                   string dir_out])
   | E_vector_update(v,e1,e2) ->
     (*Has never happened to date*)
       brackets (doc_op (string "with") (exp v) (doc_op equals (exp e1) (exp e2)))
@@ -412,9 +446,9 @@ let doc_exp_ocaml, doc_let_ocaml =
     separate space [string "begin ret := Some" ; exp e ; string "; raise Sail_return; end"]
   | E_app_infix (e1,id,e2) ->
     let call =
-      match annot with
+      (* match annot with
       | Base((_,t),External(Some name),_,_,_,_) -> string name
-      | _ -> doc_id_ocaml id in
+      | _ -> *) doc_id_ocaml id in
     parens (separate space [call; parens (separate_map comma exp [e1;e2])])
   | E_internal_let(lexp, eq_exp, in_exp) ->
     separate space [string "let";
@@ -458,37 +492,30 @@ let doc_exp_ocaml, doc_let_ocaml =
     | LEXP_id id | LEXP_cast(_,id) ->
       let name = doc_id_ocaml id in
       match annot,top_call with
-      | Base((_,{t=Tapp("reg",_)}),Emp_set,_,_,_,_),false | Base((_,{t=Tabbrev(_,{t=Tapp("reg",_)})}),Emp_set,_,_,_,_),false ->
-        string "!" ^^ name
+      | Some (env, _, _), false ->
+        (match Env.lookup_id id env with
+          | Local (Mutable, _) -> string "!" ^^ name
+          | _ -> name)
       | _ -> name
 
   and doc_lexp_array_ocaml ((LEXP_aux(lexp,(l,annot))) as le) = match lexp with
     | LEXP_vector(v,e) ->
       (match annot with
-       | Base((_,t),_,_,_,_,_) ->
-         let t_act = match t.t with | Tapp("reg",[TA_typ t]) | Tabbrev(_,{t=Tapp("reg",[TA_typ t])}) -> t | _ -> t in
-         (match t_act.t with
-          | Tid "bit" | Tabbrev(_,{t=Tid "bit"}) ->
-            parens ((string "get_barray") ^^ space ^^ doc_lexp_ocaml false v) ^^ dot ^^ parens ((string "int_of_big_int") ^^ space ^^ (top_exp false e))
-          | _ -> parens ((string "get_varray") ^^ space ^^ doc_lexp_ocaml false v) ^^ dot ^^ parens ((string "int_of_big_int") ^^ space ^^ (top_exp false e)))
+       | Some (env, t, _) ->
+         if (is_bit_typ (Env.base_typ_of env t))
+         then parens ((string "get_barray") ^^ space ^^ doc_lexp_ocaml false v) ^^ dot ^^ parens ((string "int_of_big_int") ^^ space ^^ (top_exp false e))
+         else parens ((string "get_varray") ^^ space ^^ doc_lexp_ocaml false v) ^^ dot ^^ parens ((string "int_of_big_int") ^^ space ^^ (top_exp false e))
        | _ ->
          parens ((string "get_varray") ^^ space ^^ doc_lexp_ocaml false v) ^^ dot ^^ parens ((string "int_of_big_int") ^^ space ^^ (top_exp false e)))
     | _ -> empty
 
   and doc_lexp_rwrite ((LEXP_aux(lexp,(l,annot))) as le) e_new_v =
     let exp = top_exp false in
-    let (is_bit,is_bitv) = match e_new_v with
-      | E_aux(_,(_,Base((_,t),_,_,_,_,_))) ->
-        (match t.t with
-         | Tapp("vector", [_;_;_;(TA_typ ({t=Tid "bit"} | {t=Tabbrev(_,{t=Tid "bit"})}))]) |
-           Tabbrev(_,{t=Tapp("vector",[_;_;_;TA_typ ({t=Tid "bit"} | {t=Tabbrev(_,{t=Tid "bit"})})])}) |
-           Tapp("reg", [TA_typ {t= Tapp("vector", [_;_;_;(TA_typ ({t=Tid "bit"} | {t=Tabbrev(_,{t=Tid "bit"})}))])}])
-           ->
-           (false,true)
-         | Tid "bit" | Tabbrev(_,{t=Tid "bit"}) | Tapp("reg",[TA_typ ({t=Tid "bit"} | {t=Tabbrev(_,{t=Tid "bit"})})])
-           -> (true,false)
-         | _ -> (false,false))
-      | _ -> (false,false) in
+    let (is_bit,is_bitv) = match annot with
+    | Some (env, typ, _) ->
+      let typ = Env.base_typ_of env typ in
+      (is_bit_typ typ, is_bitvector_typ typ)
+    | _ -> (false, false) in
     match lexp with
     | LEXP_vector(v,e) ->
        if is_bit then (* XXX check whether register or not?? *)
@@ -504,7 +531,7 @@ let doc_exp_ocaml, doc_let_ocaml =
       parens ((string (if is_bit then "set_register_field_bit" else "set_register_field_v")) ^^ space ^^
               doc_lexp_ocaml false v ^^ space ^^string_lit (doc_id id) ^^ space ^^ exp e_new_v)
     | LEXP_id id | LEXP_cast (_,id) ->
-      (match annot with
+      (* (match annot with
        | Base(_,Alias alias_info,_,_,_,_) ->
          (match alias_info with
           | Alias_field(reg,field) ->
@@ -522,8 +549,8 @@ let doc_exp_ocaml, doc_let_ocaml =
                       string reg ^^ space ^^ doc_int start ^^ space ^^ doc_int stop ^^ space ^^ exp e_new_v)
           | Alias_pair(reg1,reg2) ->
             parens ((string "set_two_regs") ^^ space ^^ string reg1 ^^ space ^^ string reg2 ^^ space ^^ exp e_new_v))
-       | _ ->
-         parens (separate space [string "set_register"; doc_id_ocaml id; exp e_new_v]))
+       | _ -> *)
+         parens (separate space [string "set_register"; doc_id_ocaml id; exp e_new_v])
 
   and doc_lexp_fcall ((LEXP_aux(lexp,(l,annot))) as le) e_new_v = match lexp with
     | LEXP_memory(id,args) -> doc_id_ocaml id ^^ parens (separate_map comma (top_exp false) (args@[e_new_v]))
@@ -533,8 +560,8 @@ let doc_exp_ocaml, doc_let_ocaml =
 
 (*TODO Upcase and downcase type and constructors as needed*)
 let doc_type_union_ocaml n (Tu_aux(typ_u,_)) = match typ_u with
-  | Tu_ty_id(typ,id) -> separate space [pipe; doc_id_ocaml_ctor n id; string "of"; doc_typ_ocaml typ;]
-  | Tu_id id -> separate space [pipe; doc_id_ocaml_ctor n id]
+  | Tu_ty_id(typ,id) -> separate space [pipe; doc_id_ocaml_ctor id; string "of"; doc_typ_ocaml typ;]
+  | Tu_id id -> separate space [pipe; doc_id_ocaml_ctor id]
 
 let rec doc_range_ocaml (BF_aux(r,_)) = match r with
   | BF_single i -> parens (doc_op comma (doc_int i) (doc_int i))
@@ -559,7 +586,7 @@ let doc_typdef_ocaml (TD_aux(td,_)) = match td with
        else (doc_typquant_ocaml typq ar_doc))
   | TD_enum(id,nm,enums,_) ->
     let n = List.length enums in
-    let enums_doc = group (separate_map (break 1 ^^ pipe) (doc_id_ocaml_ctor n) enums) in
+    let enums_doc = group (separate_map (break 1 ^^ pipe) (doc_id_ocaml_ctor) enums) in
     doc_op equals
       (concat [string "type"; space; doc_id_ocaml_type id;])
       (enums_doc)
@@ -615,7 +642,7 @@ let doc_kdef_ocaml (KD_aux(kd,_)) = match kd with
        else (doc_typquant_ocaml typq ar_doc))
   | KD_enum(_,id,nm,enums,_) ->
     let n = List.length enums in
-    let enums_doc = group (separate_map (break 1 ^^ pipe) (doc_id_ocaml_ctor n) enums) in
+    let enums_doc = group (separate_map (break 1 ^^ pipe) (doc_id_ocaml_ctor) enums) in
     doc_op equals
       (concat [string "type"; space; doc_id_ocaml_type id;])
       (enums_doc)
@@ -656,8 +683,9 @@ let doc_tannot_opt_ocaml (Typ_annot_opt_aux(t,_)) = match t with
   | Typ_annot_opt_some(tq,typ) -> doc_typquant_ocaml tq (doc_typ_ocaml typ)
 
 let doc_funcl_exp_ocaml (E_aux (e, (l, annot)) as ea) = match annot with
-  | Base((_,t),tag,nes,efct,efctsum,_) ->
-     if has_lret_effect efctsum then
+  | Some (_, t, efctsum) ->
+  (* | Base((_,t),tag,nes,efct,efctsum,_) -> *)
+     if has_effect efctsum BE_lret then
        separate hardline [string "let ret = ref None in"; 
                        string "try";
                        (doc_exp_ocaml ea);
@@ -696,14 +724,16 @@ let doc_fundef_ocaml (FD_aux(FD_function(r, typa, efa, fcls),_)) =
 let doc_dec_ocaml (DEC_aux (reg,(l,annot))) =
   match reg with
   | DEC_reg(typ,id) ->
-    (match annot with
+    if is_vector_typ typ then
+      let (start, size, order, itemt) = vector_typ_args_of typ in
+    (* (match annot with
      | Base((_,t),_,_,_,_,_) ->
        (match t.t with
         | Tapp("register", [TA_typ {t= Tapp("vector", [TA_nexp start; TA_nexp size; TA_ord order; TA_typ itemt])}]) 
-        | Tapp("register", [TA_typ {t= Tabbrev(_,{t=Tapp("vector", [TA_nexp start; TA_nexp size; TA_ord order; TA_typ itemt])})}]) ->
-          (match itemt.t,start.nexp,size.nexp with
-           | Tid "bit", Nconst start, Nconst size ->
-             let o = if order.order = Oinc then string "true" else string "false" in
+        | Tapp("register", [TA_typ {t= Tabbrev(_,{t=Tapp("vector", [TA_nexp start; TA_nexp size; TA_ord order; TA_typ itemt])})}]) -> *)
+          (match is_bit_typ itemt, start, size with
+           | true, Nexp_aux (Nexp_constant start, _), Nexp_aux (Nexp_constant size, _) ->
+             let o = if is_order_inc order then string "true" else string "false" in
              separate space [string "let";
                              doc_id_ocaml id;
                              equals;
@@ -711,22 +741,25 @@ let doc_dec_ocaml (DEC_aux (reg,(l,annot))) =
                              parens (separate comma [separate space [string "ref";
                                                                      parens (separate space
                                                                                [string "Array.make";
-                                                                                doc_int (int_of_big_int size);
+                                                                                doc_int size;
                                                                                 string "Vzero";])];
-                                                     doc_int (int_of_big_int start);
+                                                     doc_int start;
                                                      o;
                                                      string_lit (doc_id id);
                                                      brackets empty])]
            | _ -> empty)
-        | Tapp("register", [TA_typ {t=Tid idt}]) |
-          Tabbrev( {t= Tid idt}, _) ->
+    else
+      (match typ with
+        | Typ_aux (Typ_id idt, _) ->
+        (* | Tapp("register", [TA_typ {t=Tid idt}]) |
+          Tabbrev( {t= Tid idt}, _) -> *)
           separate space [string "let";
                           doc_id_ocaml id;
                           equals;
-                          doc_id_ocaml (Id_aux (Id idt, Unknown));
+                          doc_id_ocaml idt;
                           string "None"]
         |_-> failwith "type was not handled in register declaration")
-     | _ -> failwith "annot was not Base")
+     (* | _ -> failwith "annot was not Base") *)
     | DEC_alias(id,alspec) -> empty (*
         doc_op equals (string "register alias" ^^ space ^^ doc_id id) (doc_alias alspec) *)
     | DEC_typ_alias(typ,id,alspec) -> empty (*
@@ -741,6 +774,7 @@ let doc_def_ocaml def = group (match def with
   | DEF_reg_dec dec -> doc_dec_ocaml dec
   | DEF_scattered sdef -> empty (*shoulnd't still be here*)
   | DEF_kind k_def -> doc_kdef_ocaml k_def
+  | DEF_overload _ -> empty
   | DEF_comm _ -> failwith "unhandled DEF_comm"
   ) ^^ hardline
 
diff --git a/src/process_file.ml b/src/process_file.ml
index efa2ec55..9c105968 100644
--- a/src/process_file.ml
+++ b/src/process_file.ml
@@ -91,7 +91,7 @@ let opt_ddump_tc_ast = ref false
 let opt_dno_cast = ref false
 let opt_mono_split = ref ([]:((string * int) * string) list)
 
-let check_ast (defs : Type_internal.tannot Ast.defs) (k : kind Envmap.t) (o:Ast.order) : Type_internal.tannot Ast.defs * Type_check.envs =
+let check_ast (defs : Type_internal.tannot Ast.defs) (k : kind Envmap.t) (o:Ast.order) : Type_check_new.tannot Ast.defs * Type_check_new.Env.t =
   let d_env = { Type_internal.k_env = k; Type_internal.abbrevs = Type_internal.initial_abbrev_env;
                 Type_internal.nabbrevs = Envmap.empty;
 		Type_internal.namesch = Envmap.empty; Type_internal.enum_env = Envmap.empty; 
@@ -100,10 +100,10 @@ let check_ast (defs : Type_internal.tannot Ast.defs) (k : kind Envmap.t) (o:Ast.
                 {Type_internal.order = (match o with | (Ast.Ord_aux(Ast.Ord_inc,_)) -> Type_internal.Oinc 
 		                                     | (Ast.Ord_aux(Ast.Ord_dec,_)) -> Type_internal.Odec
 						     | _ -> Type_internal.Oinc)};} in
-  if !opt_new_typecheck
-  then
+  (* if !opt_new_typecheck
+  then *)
     let ienv = if !opt_dno_cast then Type_check_new.Env.no_casts Type_check_new.initial_env else Type_check_new.initial_env in
-    let ast, _ = Type_check_new.check ienv defs in
+    let ast, env = Type_check_new.check ienv defs in
     let ast = match !opt_mono_split with
       | [] -> ast
       | l ->
@@ -112,16 +112,14 @@ let check_ast (defs : Type_internal.tannot Ast.defs) (k : kind Envmap.t) (o:Ast.
          let ast, _ = Type_check_new.check ienv ast in
          ast
     in
-    if !opt_ddump_tc_ast then Pretty_print.pp_defs stdout ast else ()
-  else ();
-  if !opt_just_check
-  then exit 0
-  else ();
-  Type_check.check (Type_check.Env (d_env, Type_internal.initial_typ_env,Type_internal.nob,Envmap.empty)) defs 
+    let () = if !opt_ddump_tc_ast then Pretty_print.pp_defs stdout ast else () in
+    let () = if !opt_just_check then exit 0 else () in
+    (ast, env)
+  (* else Type_check.check (Type_check.Env (d_env, Type_internal.initial_typ_env,Type_internal.nob,Envmap.empty)) defs  *)
 
-let rewrite_ast (defs: Type_internal.tannot Ast.defs) = Rewriter.rewrite_defs defs
-let rewrite_ast_lem (Type_check.Env (_, typ_env, _, _)) (defs: Type_internal.tannot Ast.defs) = Rewriter.rewrite_defs_lem typ_env defs
-let rewrite_ast_ocaml (defs: Type_internal.tannot Ast.defs) = Rewriter.rewrite_defs_ocaml defs
+let rewrite_ast (defs: Type_check_new.tannot Ast.defs) = Rewriter.rewrite_defs defs
+let rewrite_ast_lem (defs: Type_check_new.tannot Ast.defs) = Rewriter.rewrite_defs_lem defs
+let rewrite_ast_ocaml (defs: Type_check_new.tannot Ast.defs) = Rewriter.rewrite_defs_ocaml defs
 
 let open_output_with_check file_name =
   let (temp_file_name, o) = Filename.open_temp_file "ll_temp" "" in
@@ -237,7 +235,6 @@ let output1 libpath out_arg filename defs  =
 	Pretty_print.pp_defs_ocaml o defs (generated_line filename) ["Big_int_Z"; "Sail_values"; lib];
         close_output_with_check ext_o
 
-
 let output libpath out_arg files =
   List.iter
     (fun (f, defs) ->
diff --git a/src/process_file.mli b/src/process_file.mli
index 9620712a..23851138 100644
--- a/src/process_file.mli
+++ b/src/process_file.mli
@@ -42,10 +42,10 @@
 
 val parse_file : string -> Parse_ast.defs
 val convert_ast : Parse_ast.defs -> Type_internal.tannot Ast.defs * Type_internal.kind Type_internal.Envmap.t * Ast.order
-val check_ast: Type_internal.tannot Ast.defs -> Type_internal.kind Type_internal.Envmap.t -> Ast.order -> Type_internal.tannot Ast.defs * Type_check.envs
-val rewrite_ast: Type_internal.tannot Ast.defs -> Type_internal.tannot Ast.defs
-val rewrite_ast_lem : Type_check.envs -> Type_internal.tannot Ast.defs -> Type_internal.tannot Ast.defs
-val rewrite_ast_ocaml : Type_internal.tannot Ast.defs -> Type_internal.tannot Ast.defs
+val check_ast: Type_internal.tannot Ast.defs -> Type_internal.kind Type_internal.Envmap.t -> Ast.order -> Type_check_new.tannot Ast.defs * Type_check_new.Env.t
+val rewrite_ast: Type_check_new.tannot Ast.defs -> Type_check_new.tannot Ast.defs
+val rewrite_ast_lem : Type_check_new.tannot Ast.defs -> Type_check_new.tannot Ast.defs
+val rewrite_ast_ocaml : Type_check_new.tannot Ast.defs -> Type_check_new.tannot Ast.defs
 
 val opt_new_typecheck : bool ref
 val opt_just_check : bool ref
@@ -61,7 +61,7 @@ type out_type =
 val output :
   string ->                           (* The path to the library *)
   out_type ->                         (* Backend kind *)
-  (string * Type_internal.tannot Ast.defs) list -> (*File names paired with definitions *)
+  (string * Type_check_new.tannot Ast.defs) list -> (*File names paired with definitions *)
   unit
 
 (** [always_replace_files] determines whether Sail only updates modified files.
diff --git a/src/rewriter.ml b/src/rewriter.ml
index a2eccece..96a729e6 100644
--- a/src/rewriter.ml
+++ b/src/rewriter.ml
@@ -9,6 +9,7 @@
 (*    Robert Norton-Wright                                                *)
 (*    Christopher Pulte                                                   *)
 (*    Peter Sewell                                                        *)
+(*    Thomas Bauereiss                                                    *)
 (*                                                                        *)
 (*  All rights reserved.                                                  *)
 (*                                                                        *)
@@ -42,19 +43,15 @@
 
 open Big_int
 open Ast
-open Type_internal
+open Ast_util
+open Type_check_new
 open Spec_analysis
-type typ = Type_internal.t
-type 'a exp = 'a Ast.exp
-type 'a emap = 'a Envmap.t
-type envs = Type_check.envs
-type 'a namemap = (typ * 'a exp) emap
 
 type 'a rewriters = {
-    rewrite_exp  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a exp -> 'a exp;
-    rewrite_lexp : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a lexp -> 'a lexp;
-    rewrite_pat  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a pat -> 'a pat;
-    rewrite_let  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a letbind -> 'a letbind;
+    rewrite_exp  : 'a rewriters -> 'a exp -> 'a exp;
+    rewrite_lexp : 'a rewriters -> 'a lexp -> 'a lexp;
+    rewrite_pat  : 'a rewriters -> 'a pat -> 'a pat;
+    rewrite_let  : 'a rewriters -> 'a letbind -> 'a letbind;
     rewrite_fun  : 'a rewriters -> 'a fundef -> 'a fundef;
     rewrite_def  : 'a rewriters -> 'a def -> 'a def;
     rewrite_defs : 'a rewriters -> 'a defs -> 'a defs;
@@ -63,24 +60,28 @@ type 'a rewriters = {
 
 let (>>) f g = fun x -> g(f(x))
 
-let get_effsum_annot (_,t) = match t with
-  | Base (_,_,_,_,effs,_) -> effs
-  | NoTyp -> failwith "no effect information" 
-  | _ -> failwith "get_effsum_annot doesn't support Overload"
+let env_of_annot = function
+  | (_,Some(env,_,_)) -> env
+  | (l,None) -> Env.empty
 
-let get_localeff_annot (_,t) = match t with
-  | Base (_,_,_,eff,_,_) -> eff
-  | NoTyp -> failwith "no effect information" 
-  | _ -> failwith "get_localeff_annot doesn't support Overload"
+let env_of (E_aux (_,a)) = env_of_annot a
 
-let get_type_annot (_,t) = match t with
-  | Base((_,t),_,_,_,_,_) -> t
-  | NoTyp -> failwith "no type information" 
-  | _ -> failwith "get_type_annot doesn't support Overload"
+let effect_of_fpat (FP_aux (_,(_,a))) = effect_of_annot a
+let effect_of_lexp (LEXP_aux (_,(_,a))) = effect_of_annot a
+let effect_of_fexp (FE_aux (_,(_,a))) = effect_of_annot a
+let effect_of_fexps (FES_aux (FES_Fexps (fexps,_),_)) =
+  List.fold_left union_effects no_effect (List.map effect_of_fexp fexps)
+let effect_of_opt_default (Def_val_aux (_,(_,a))) = effect_of_annot a
+let effect_of_pexp (Pat_aux (_,(_,a))) = effect_of_annot a
+let effect_of_lb (LB_aux (_,(_,a))) = effect_of_annot a
 
-let get_type (E_aux (_,a)) = get_type_annot a
+let get_loc_exp (E_aux (_,(l,_))) = l
 
-let get_loc (E_aux (_,(l,_))) = l
+let simple_annot l typ = (Parse_ast.Generated l, Some (Env.empty, typ, no_effect))
+let simple_num l n = E_aux (
+  E_lit (L_aux (L_num n, Parse_ast.Generated l)),
+  simple_annot (Parse_ast.Generated l)
+    (atom_typ (Nexp_aux (Nexp_constant n, Parse_ast.Generated l))))
 
 let fresh_name_counter = ref 0
 
@@ -95,136 +96,141 @@ let fresh_id pre l =
   let current = fresh_name () in
   Id_aux (Id (pre ^ string_of_int current), Parse_ast.Generated l)
 
-let fresh_id_exp pre ((l,_) as annot) =
+let fresh_id_exp pre ((l,annot)) =
   let id = fresh_id pre l in
-  let annot_var = (Parse_ast.Generated l,simple_annot (get_type_annot annot)) in
-  E_aux (E_id id, annot_var)
+  E_aux (E_id id, (Parse_ast.Generated l, annot))
 
-let fresh_id_pat pre ((l,_) as annot) =
+let fresh_id_pat pre ((l,annot)) =
   let id = fresh_id pre l in
-  let annot_var = (Parse_ast.Generated l,simple_annot (get_type_annot annot)) in
-  P_aux (P_id id, annot_var)
-
-let union_effs effs =
-  List.fold_left (fun acc eff -> union_effects acc eff) pure_e effs
-
-let get_effsum_exp (E_aux (_,a)) = get_effsum_annot a
-let get_effsum_fpat (FP_aux (_,a)) = get_effsum_annot a
-let get_effsum_lexp (LEXP_aux (_,a)) = get_effsum_annot a
-let get_effsum_fexp (FE_aux (_,a)) = get_effsum_annot a
-let get_effsum_fexps (FES_aux (FES_Fexps (fexps,_),_)) =
-  union_effs (List.map get_effsum_fexp fexps)
-let get_effsum_opt_default (Def_val_aux (_,a)) = get_effsum_annot a
-let get_effsum_pexp (Pat_aux (_,a)) = get_effsum_annot a
-let get_effsum_lb (LB_aux (_,a)) = get_effsum_annot a
-
-let eff_union_exps es =
-  union_effs (List.map get_effsum_exp es)
-
-let fix_effsum_exp (E_aux (e,(l,annot))) = 
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match e with
-    | E_block es -> eff_union_exps es
-    | E_nondet es -> eff_union_exps es
+  P_aux (P_id id, (Parse_ast.Generated l, annot))
+
+let union_eff_exps es =
+  List.fold_left union_effects no_effect (List.map effect_of es)
+
+let fix_eff_exp (E_aux (e,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match e with
+    | E_block es -> union_eff_exps es
+    | E_nondet es -> union_eff_exps es
     | E_id _
-    | E_lit _ -> pure_e
-    | E_cast (_,e) -> get_effsum_exp e
+    | E_lit _ -> no_effect
+    | E_cast (_,e) -> effect_of e
     | E_app (_,es)
-    | E_tuple es -> eff_union_exps es
-    | E_app_infix (e1,_,e2) -> eff_union_exps [e1;e2]
-    | E_if (e1,e2,e3) -> eff_union_exps [e1;e2;e3]
-    | E_for (_,e1,e2,e3,_,e4) -> eff_union_exps [e1;e2;e3;e4]
-    | E_vector es -> eff_union_exps es
+    | E_tuple es -> union_eff_exps es
+    | E_app_infix (e1,_,e2) -> union_eff_exps [e1;e2]
+    | E_if (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
+    | E_for (_,e1,e2,e3,_,e4) -> union_eff_exps [e1;e2;e3;e4]
+    | E_vector es -> union_eff_exps es
     | E_vector_indexed (ies,opt_default) ->
        let (_,es) = List.split ies in
-       union_effs (get_effsum_opt_default opt_default :: List.map get_effsum_exp es)
-    | E_vector_access (e1,e2) -> eff_union_exps [e1;e2]
-    | E_vector_subrange (e1,e2,e3) -> eff_union_exps [e1;e2;e3]
-    | E_vector_update (e1,e2,e3) -> eff_union_exps [e1;e2;e3]
-    | E_vector_update_subrange (e1,e2,e3,e4) -> eff_union_exps [e1;e2;e3;e4]
-    | E_vector_append (e1,e2) -> eff_union_exps [e1;e2]
-    | E_list es -> eff_union_exps es
-    | E_cons (e1,e2) -> eff_union_exps [e1;e2]
-    | E_record fexps -> get_effsum_fexps fexps
-    | E_record_update(e,fexps) -> union_effs ((get_effsum_exp e)::[(get_effsum_fexps fexps)])
-    | E_field (e,_) -> get_effsum_exp e
-    | E_case (e,pexps) -> union_effs (get_effsum_exp e :: List.map get_effsum_pexp pexps)
-    | E_let (lb,e) -> union_effs [get_effsum_lb lb;get_effsum_exp e]
-    | E_assign (lexp,e) -> union_effs [get_effsum_lexp lexp;get_effsum_exp e]
-    | E_exit e -> get_effsum_exp e
-    | E_return e -> get_effsum_exp e
-    | E_sizeof _ | E_sizeof_internal _ -> pure_e
-    | E_assert (c,m) -> pure_e
-    | E_comment _ | E_comment_struc _ -> pure_e
-    | E_internal_cast (_,e) -> get_effsum_exp e
-    | E_internal_exp _ -> pure_e
-    | E_internal_exp_user _ -> pure_e
-    | E_internal_let (lexp,e1,e2) -> union_effs [get_effsum_lexp lexp;
-                                                 get_effsum_exp e1;get_effsum_exp e2]
-    | E_internal_plet (_,e1,e2) -> union_effs [get_effsum_exp e1;get_effsum_exp e2]
-    | E_internal_return e1 -> get_effsum_exp e1
+       union_effects (effect_of_opt_default opt_default) (union_eff_exps es)
+    | E_vector_access (e1,e2) -> union_eff_exps [e1;e2]
+    | E_vector_subrange (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
+    | E_vector_update (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
+    | E_vector_update_subrange (e1,e2,e3,e4) -> union_eff_exps [e1;e2;e3;e4]
+    | E_vector_append (e1,e2) -> union_eff_exps [e1;e2]
+    | E_list es -> union_eff_exps es
+    | E_cons (e1,e2) -> union_eff_exps [e1;e2]
+    | E_record fexps -> effect_of_fexps fexps
+    | E_record_update(e,fexps) ->
+      union_effects (effect_of e) (effect_of_fexps fexps)
+    | E_field (e,_) -> effect_of e
+    | E_case (e,pexps) ->
+      List.fold_left union_effects (effect_of e) (List.map effect_of_pexp pexps)
+    | E_let (lb,e) -> union_effects (effect_of_lb lb) (effect_of e)
+    | E_assign (lexp,e) -> union_effects (effect_of_lexp lexp) (effect_of e)
+    | E_exit e -> effect_of e
+    | E_return e -> effect_of e
+    | E_sizeof _ | E_sizeof_internal _ -> no_effect
+    | E_assert (c,m) -> no_effect
+    | E_comment _ | E_comment_struc _ -> no_effect
+    | E_internal_cast (_,e) -> effect_of e
+    | E_internal_exp _ -> no_effect
+    | E_internal_exp_user _ -> no_effect
+    | E_internal_let (lexp,e1,e2) ->
+      union_effects (effect_of_lexp lexp)
+        (union_effects (effect_of e1) (effect_of e2))
+    | E_internal_plet (_,e1,e2) -> union_effects (effect_of e1) (effect_of e2)
+    | E_internal_return e1 -> effect_of e1)
   in
-  E_aux (e,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let fix_effsum_lexp (LEXP_aux (lexp,(l,annot))) =
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match lexp with
-    | LEXP_id _ -> pure_e
-    | LEXP_cast _ -> pure_e
-    | LEXP_memory (_,es) -> eff_union_exps es
-    | LEXP_vector (lexp,e) -> union_effs [get_effsum_lexp lexp;get_effsum_exp e]
-    | LEXP_vector_range (lexp,e1,e2) -> union_effs [get_effsum_lexp lexp;get_effsum_exp e1;
-                                                    get_effsum_exp e2]
-    | LEXP_field (lexp,_) -> get_effsum_lexp lexp in
-  LEXP_aux (lexp,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let fix_effsum_fexp (FE_aux (fexp,(l,annot))) =
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match fexp with
-    | FE_Fexp (_,e) -> get_effsum_exp e in
-  FE_aux (fexp,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let fix_effsum_fexps fexps = fexps (* FES_aux have no effect information *)
-
-let fix_effsum_opt_default (Def_val_aux (opt_default,(l,annot))) =
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match opt_default with
-    | Def_val_empty -> pure_e
-    | Def_val_dec e -> get_effsum_exp e in
-  Def_val_aux (opt_default,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let fix_effsum_pexp (Pat_aux (pexp,(l,annot))) =
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match pexp with
-    | Pat_exp (_,e) -> get_effsum_exp e in
-  Pat_aux (pexp,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let fix_effsum_lb (LB_aux (lb,(l,annot))) =
-  let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-  let effsum = match lb with
-    | LB_val_explicit (_,_,e) -> get_effsum_exp e
-    | LB_val_implicit (_,e) -> get_effsum_exp e in
-  LB_aux (lb,(l,(Base (t,tag,nexps,eff,union_effects eff effsum,bounds))))
-
-let effectful_effs {effect = Eset effs} =
-  List.exists
-    (fun (BE_aux (be,_)) ->
-     match be with
-     | BE_nondet | BE_unspec | BE_undef | BE_lset -> false
-     | _ -> true
-    ) effs
-
-let effectful eaux = effectful_effs (get_effsum_exp eaux)
-
-let updates_vars_effs {effect = Eset effs} =
-  List.exists
-    (fun (BE_aux (be,_)) ->
-     match be with
-     | BE_lset -> true
-     | _ -> false
-    ) effs
-
-let updates_vars eaux = updates_vars_effs (get_effsum_exp eaux)
+  E_aux (e, (l, Some (env, typ, effsum)))
+| None ->
+  E_aux (e, (l, None))
+
+let fix_eff_lexp (LEXP_aux (lexp,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match lexp with
+    | LEXP_id _ -> no_effect
+    | LEXP_cast _ -> no_effect
+    | LEXP_memory (_,es) -> union_eff_exps es
+    | LEXP_vector (lexp,e) -> union_effects (effect_of_lexp lexp) (effect_of e)
+    | LEXP_vector_range (lexp,e1,e2) ->
+      union_effects (effect_of_lexp lexp)
+        (union_effects (effect_of e1) (effect_of e2))
+    | LEXP_field (lexp,_) -> effect_of_lexp lexp) in
+  LEXP_aux (lexp, (l, Some (env, typ, effsum)))
+| None ->
+  LEXP_aux (lexp, (l, None))
+
+let fix_eff_fexp (FE_aux (fexp,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match fexp with
+    | FE_Fexp (_,e) -> effect_of e) in
+  FE_aux (fexp, (l, Some (env, typ, effsum)))
+| None ->
+  FE_aux (fexp, (l, None))
+
+let fix_eff_fexps fexps = fexps (* FES_aux have no effect information *)
+
+let fix_eff_opt_default (Def_val_aux (opt_default,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match opt_default with
+    | Def_val_empty -> no_effect
+    | Def_val_dec e -> effect_of e) in
+  Def_val_aux (opt_default, (l, Some (env, typ, effsum)))
+| None ->
+  Def_val_aux (opt_default, (l, None))
+
+let fix_eff_pexp (Pat_aux (pexp,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match pexp with
+    | Pat_exp (_,e) -> effect_of e) in
+  Pat_aux (pexp, (l, Some (env, typ, effsum)))
+| None ->
+  Pat_aux (pexp, (l, None))
+
+let fix_eff_lb (LB_aux (lb,((l,_) as annot))) = match snd annot with
+| Some (env, typ, eff) ->
+  let effsum = union_effects eff (match lb with
+    | LB_val_explicit (_,_,e) -> effect_of e
+    | LB_val_implicit (_,e) -> effect_of e) in
+  LB_aux (lb, (l, Some (env, typ, effsum)))
+| None ->
+  LB_aux (lb, (l, None))
+
+let effectful_effs = function
+  | Effect_aux (Effect_set effs, _) ->
+    List.exists
+      (fun (BE_aux (be,_)) ->
+       match be with
+       | BE_nondet | BE_unspec | BE_undef | BE_lset -> false
+       | _ -> true
+      ) effs
+  | _ -> true
+
+let effectful eaux = effectful_effs (effect_of eaux)
+
+let updates_vars_effs = function
+  | Effect_aux (Effect_set effs, _) ->
+    List.exists
+      (fun (BE_aux (be,_)) ->
+       match be with
+       | BE_lset -> true
+       | _ -> false
+      ) effs
+  | _ -> true
+
+let updates_vars eaux = updates_vars_effs (effect_of eaux)
 
 let id_to_string (Id_aux(id,l)) =
   match id with
@@ -232,7 +238,7 @@ let id_to_string (Id_aux(id,l)) =
     | DeIid(s) -> s
 
 
-let rec partial_assoc (eq: 'a -> 'a -> bool) (v: 'a) (ls : ('a *'b) list ) : 'b option  = match ls with
+(*let rec partial_assoc (eq: 'a -> 'a -> bool) (v: 'a) (ls : ('a *'b) list ) : 'b option  = match ls with
   | [] -> None
   | (v1,v2)::ls -> if (eq v1 v) then Some v2 else partial_assoc eq v ls
 
@@ -291,7 +297,7 @@ let rec match_to_program_vars ns bounds =
         | None -> match_to_program_vars ns bounds
         | Some(augment,ev) -> 
           (*let _ = Printf.eprintf "adding n %s to program var %s\n" (n_to_string n) ev in*)
-          (n,(augment,ev))::(match_to_program_vars ns bounds)
+          (n,(augment,ev))::(match_to_program_vars ns bounds)*)
 
 let explode s =
   let rec exp i l = if i < 0 then l else exp (i - 1) (s.[i] :: l) in
@@ -328,12 +334,12 @@ let vector_string_to_bit_list l lit =
                    | '1' -> L_aux (L_one,Parse_ast.Generated l)
                    | _ -> raise (Reporting_basic.err_unreachable (Parse_ast.Generated l) "binary had non-zero or one")) s_bin
 
-let rewrite_pat rewriters nmap (P_aux (pat,(l,annot))) =
+let rewrite_pat rewriters (P_aux (pat,(l,annot))) =
   let rewrap p = P_aux (p,(l,annot)) in
-  let rewrite = rewriters.rewrite_pat rewriters nmap in
+  let rewrite = rewriters.rewrite_pat rewriters in
   match pat with
   | P_lit (L_aux ((L_hex _ | L_bin _) as lit,_)) ->
-    let ps =  List.map (fun p -> P_aux (P_lit p,(Parse_ast.Generated l,simple_annot {t = Tid "bit"})))
+    let ps =  List.map (fun p -> P_aux (P_lit p, simple_annot l bit_typ))
         (vector_string_to_bit_list l lit) in
     rewrap (P_vector ps)
   | P_lit _ | P_wild | P_id _ -> rewrap pat
@@ -349,15 +355,15 @@ let rewrite_pat rewriters nmap (P_aux (pat,(l,annot))) =
   | P_tup pats -> rewrap (P_tup (List.map rewrite pats))
   | P_list pats -> rewrap (P_list (List.map rewrite pats))
 
-let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) = 
+let rewrite_exp rewriters (E_aux (exp,(l,annot))) = 
   let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite = rewriters.rewrite_exp rewriters nmap in
+  let rewrite = rewriters.rewrite_exp rewriters in
   match exp with
   | E_comment _ | E_comment_struc _ -> rewrap exp
   | E_block exps -> rewrap (E_block (List.map rewrite exps))
   | E_nondet exps -> rewrap (E_nondet (List.map rewrite exps))
   | E_lit (L_aux ((L_hex _ | L_bin _) as lit,_)) ->
-    let es = List.map (fun p -> E_aux (E_lit p ,(Parse_ast.Generated l,simple_annot {t = Tid "bit"})))
+    let es = List.map (fun p -> E_aux (E_lit p, simple_annot l bit_typ))
         (vector_string_to_bit_list l lit) in
     rewrap (E_vector es)
   | E_id _ | E_lit _  -> rewrap exp
@@ -399,15 +405,17 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
     rewrap (E_case (rewrite exp,
                     (List.map 
                        (fun (Pat_aux (Pat_exp(p,e),pannot)) -> 
-                          Pat_aux (Pat_exp(rewriters.rewrite_pat rewriters nmap p,rewrite e),pannot)) pexps)))
-  | E_let (letbind,body) -> rewrap (E_let(rewriters.rewrite_let rewriters nmap letbind,rewrite body))
-  | E_assign (lexp,exp) -> rewrap (E_assign(rewriters.rewrite_lexp rewriters nmap lexp,rewrite exp))
+                          Pat_aux (Pat_exp(rewriters.rewrite_pat rewriters p,rewrite e),pannot)) pexps)))
+  | E_let (letbind,body) -> rewrap (E_let(rewriters.rewrite_let rewriters letbind,rewrite body))
+  | E_assign (lexp,exp) -> rewrap (E_assign(rewriters.rewrite_lexp rewriters lexp,rewrite exp))
   | E_sizeof n -> rewrap (E_sizeof n)
   | E_exit e -> rewrap (E_exit (rewrite e))
   | E_return e -> rewrap (E_return (rewrite e))
   | E_assert(e1,e2) -> rewrap (E_assert(rewrite e1,rewrite e2))
-  | E_internal_cast ((l,casted_annot),exp) -> 
-    let new_exp = rewrite exp in
+  | E_internal_cast (casted_annot,exp) ->
+    rewrap (E_internal_cast (casted_annot, rewrite exp))
+    (* check_exp (env_of exp) (strip_exp exp) (typ_of_annot casted_annot) *)
+    (*let new_exp = rewrite exp in
     (*let _ = Printf.eprintf "Removing an internal_cast with %s\n" (tannot_to_string casted_annot) in*)
     (match casted_annot,exp with
      | Base((_,t),_,_,_,_,_),E_aux(ec,(ecl,Base((_,exp_t),_,_,_,_,_))) ->
@@ -428,7 +436,7 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
                  rewrap (E_cast (Typ_aux (Typ_var (Kid_aux((Var "length"),Parse_ast.Generated l)),
                                           Parse_ast.Generated l),new_exp))
                | _ -> new_exp))
-        | _ -> new_exp)
+        | _ -> new_exp
      | Base((_,t),_,_,_,_,_),_ ->
        (*let _ = Printf.eprintf "Considering removing an internal cast where the remaining type is %s\n%!"
             (t_to_string t) in*)
@@ -442,9 +450,9 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
                                       Parse_ast.Generated l), new_exp))
            | _ -> new_exp)
         | _ -> new_exp)
-     | _ -> (*let _ = Printf.eprintf "Not a base match?\n" in*) new_exp)
-  | E_internal_exp (l,impl) ->
-    (match impl with
+     | _ -> (*let _ = Printf.eprintf "Not a base match?\n" in*) new_exp*)
+  (*| E_internal_exp (l,impl) ->
+    match impl with
      | Base((_,t),_,_,_,_,bounds) ->
        (*let _ = Printf.eprintf "Rewriting internal expression, with type %s, and bounds %s\n" 
          (t_to_string t) (bounds_to_string bounds) in*)
@@ -470,8 +478,8 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
         | _ -> 
           raise (Reporting_basic.err_unreachable l 
                    ("Internal_exp given unexpected types " ^ (t_to_string t))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp given none Base annot")))
-  | E_sizeof_internal (l,impl) ->
+     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp given none Base annot"))*)
+  (*| E_sizeof_internal (l,impl) ->
     (match impl with
      | Base((_,t),_,_,_,_,bounds) ->
        let bounds = match nmap with | None -> bounds | Some (nm,_) -> add_map_to_bounds nm bounds in
@@ -483,8 +491,8 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
            | [] -> rewrite_nexp_to_exp None l n
            | map -> rewrite_nexp_to_exp (Some map) l n)
         | _ -> raise (Reporting_basic.err_unreachable l ("Sizeof internal had non-atom type " ^ (t_to_string t))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Sizeof internal had none base annot")))
-  | E_internal_exp_user ((l,user_spec),(_,impl)) -> 
+     | _ -> raise (Reporting_basic.err_unreachable l ("Sizeof internal had none base annot"))*)
+  (*| E_internal_exp_user ((l,user_spec),(_,impl)) -> 
     (match (user_spec,impl) with
      | (Base((_,tu),_,_,_,_,_), Base((_,ti),_,_,_,_,bounds)) ->
        (*let _ = Printf.eprintf "E_interal_user getting rewritten two types are %s and %s\n"
@@ -501,13 +509,14 @@ let rewrite_exp rewriters nmap (E_aux (exp,(l,annot))) =
         | _ -> 
           raise (Reporting_basic.err_unreachable l 
                    ("Internal_exp_user given unexpected types " ^ (t_to_string tu) ^ ", " ^ (t_to_string ti))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp_user given none Base annot")))
+     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp_user given none Base annot")))*)
   | E_internal_let _ -> raise (Reporting_basic.err_unreachable l "Internal let found before it should have been introduced")
   | E_internal_return _ -> raise (Reporting_basic.err_unreachable l "Internal return found before it should have been introduced")
   | E_internal_plet _ -> raise (Reporting_basic.err_unreachable l " Internal plet found before it should have been introduced")
+  | _ -> rewrap exp
                            
-let rewrite_let rewriters map (LB_aux(letbind,(l,annot))) =
-  let local_map = get_map_tannot annot in
+let rewrite_let rewriters (LB_aux(letbind,(l,annot))) =
+  (*let local_map = get_map_tannot annot in
   let map =
     match map,local_map with
     | None,None -> None
@@ -515,47 +524,47 @@ let rewrite_let rewriters map (LB_aux(letbind,(l,annot))) =
     | Some(m,s), None -> Some(m,s)
     | Some(m,s), Some m' -> match merge_option_maps (Some m) local_map with
       | None -> Some(m,s) (*Shouldn't happen*)
-      | Some new_m -> Some(new_m,s) in
+      | Some new_m -> Some(new_m,s) in*)
   match letbind with
   | LB_val_explicit (typschm, pat,exp) ->
-    LB_aux(LB_val_explicit (typschm,rewriters.rewrite_pat rewriters map pat,
-                            rewriters.rewrite_exp rewriters map exp),(l,annot))
+    LB_aux(LB_val_explicit (typschm,rewriters.rewrite_pat rewriters pat,
+                            rewriters.rewrite_exp rewriters exp),(l,annot))
   | LB_val_implicit ( pat, exp) ->
-    LB_aux(LB_val_implicit (rewriters.rewrite_pat rewriters map pat,
-                            rewriters.rewrite_exp rewriters map exp),(l,annot))
+    LB_aux(LB_val_implicit (rewriters.rewrite_pat rewriters pat,
+                            rewriters.rewrite_exp rewriters exp),(l,annot))
 
-let rewrite_lexp rewriters map (LEXP_aux(lexp,(l,annot))) = 
+let rewrite_lexp rewriters (LEXP_aux(lexp,(l,annot))) =
   let rewrap le = LEXP_aux(le,(l,annot)) in
   match lexp with
   | LEXP_id _ | LEXP_cast _ -> rewrap lexp
-  | LEXP_tup tupls -> rewrap (LEXP_tup (List.map (rewriters.rewrite_lexp rewriters map) tupls))
-  | LEXP_memory (id,exps) -> rewrap (LEXP_memory(id,List.map (rewriters.rewrite_exp rewriters map) exps))
+  | LEXP_tup tupls -> rewrap (LEXP_tup (List.map (rewriters.rewrite_lexp rewriters) tupls))
+  | LEXP_memory (id,exps) -> rewrap (LEXP_memory(id,List.map (rewriters.rewrite_exp rewriters) exps))
   | LEXP_vector (lexp,exp) ->
-    rewrap (LEXP_vector (rewriters.rewrite_lexp rewriters map lexp,rewriters.rewrite_exp rewriters map exp))
+    rewrap (LEXP_vector (rewriters.rewrite_lexp rewriters lexp,rewriters.rewrite_exp rewriters exp))
   | LEXP_vector_range (lexp,exp1,exp2) -> 
-    rewrap (LEXP_vector_range (rewriters.rewrite_lexp rewriters map lexp,
-                               rewriters.rewrite_exp rewriters map exp1,
-                               rewriters.rewrite_exp rewriters map exp2))
-  | LEXP_field (lexp,id) -> rewrap (LEXP_field (rewriters.rewrite_lexp rewriters map lexp,id))
+    rewrap (LEXP_vector_range (rewriters.rewrite_lexp rewriters lexp,
+                               rewriters.rewrite_exp rewriters exp1,
+                               rewriters.rewrite_exp rewriters exp2))
+  | LEXP_field (lexp,id) -> rewrap (LEXP_field (rewriters.rewrite_lexp rewriters lexp,id))
 
 let rewrite_fun rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) = 
   let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),(l,annot))) =
     let _ = reset_fresh_name_counter () in
     (*let _ = Printf.eprintf "Rewriting function %s, pattern %s\n" 
       (match id with (Id_aux (Id i,_)) -> i) (Pretty_print.pat_to_string pat) in*)
-  let map = get_map_tannot fdannot in
+  (*let map = get_map_tannot fdannot in
   let map =
     match map with
     | None -> None
-    | Some m -> Some(m, Envmap.empty) in
-  (FCL_aux (FCL_Funcl (id,rewriters.rewrite_pat rewriters map pat,
-                         rewriters.rewrite_exp rewriters map exp),(l,annot))) 
+    | Some m -> Some(m, Envmap.empty) in*)
+  (FCL_aux (FCL_Funcl (id,rewriters.rewrite_pat rewriters pat,
+                         rewriters.rewrite_exp rewriters exp),(l,annot))) 
   in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
 
 let rewrite_def rewriters d = match d with
-  | DEF_type _ | DEF_kind _ | DEF_spec _ | DEF_default _ | DEF_reg_dec _ | DEF_comm _ -> d
+  | DEF_type _ | DEF_kind _ | DEF_spec _ | DEF_default _ | DEF_reg_dec _ | DEF_comm _ | DEF_overload _ -> d
   | DEF_fundef fdef -> DEF_fundef (rewriters.rewrite_fun rewriters fdef)
-  | DEF_val letbind -> DEF_val (rewriters.rewrite_let rewriters None letbind)
+  | DEF_val letbind -> DEF_val (rewriters.rewrite_let rewriters letbind)
   | DEF_scattered _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown "DEF_scattered survived to rewritter")
 
 let rewrite_defs_base rewriters (Defs defs) = 
@@ -573,22 +582,28 @@ let rewrite_defs (Defs defs) = rewrite_defs_base
      rewrite_def = rewrite_def;
      rewrite_defs = rewrite_defs_base} (Defs defs)
 
+module Envmap = Finite_map.Fmap_map(String)
 
-let rec introduced_variables (E_aux (exp,(l,annot))) =
+(* TODO: This seems to only consider a single assignment (or possibly two, in
+   separate branches of an if-expression). Hence, it seems the result is always
+   at most one variable. Is this intended?
+   It is only used below when pulling out local variables inside if-expressions
+   into the outer scope, which seems dubious. I comment it out for now. *)
+(*let rec introduced_variables (E_aux (exp,(l,annot))) =
   match exp with
   | E_cast (typ, exp) -> introduced_variables exp
   | E_if (c,t,e) -> Envmap.intersect (introduced_variables t) (introduced_variables e)
   | E_assign (lexp,exp) -> introduced_vars_le lexp exp
   | _ -> Envmap.empty
 
-and introduced_vars_le (LEXP_aux(lexp,(l,annot))) exp = 
+and introduced_vars_le (LEXP_aux(lexp,annot)) exp =
   match lexp with
   | LEXP_id (Id_aux (Id id,_))  | LEXP_cast(_,(Id_aux (Id id,_))) ->
     (match annot with
      | Base((_,t),Emp_intro,_,_,_,_) ->
        Envmap.insert Envmap.empty (id,(t,exp))
      | _ -> Envmap.empty)
-  | _ -> Envmap.empty
+  | _ -> Envmap.empty*)
 
 type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
   { p_lit            : lit -> 'pat_aux
@@ -681,6 +696,7 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
   ; e_case                   : 'exp * 'pexp list -> 'exp_aux
   ; e_let                    : 'letbind * 'exp -> 'exp_aux
   ; e_assign                 : 'lexp * 'exp -> 'exp_aux
+  ; e_sizeof                 : nexp -> 'exp_aux
   ; e_exit                   : 'exp -> 'exp_aux
   ; e_return                 : 'exp -> 'exp_aux
   ; e_assert                 : 'exp * 'exp -> 'exp_aux
@@ -745,6 +761,7 @@ let rec fold_exp_aux alg = function
   | E_case (e,pexps) -> alg.e_case (fold_exp alg e, List.map (fold_pexp alg) pexps)
   | E_let (letbind,e) -> alg.e_let (fold_letbind alg letbind, fold_exp alg e)
   | E_assign (lexp,e) -> alg.e_assign (fold_lexp alg lexp, fold_exp alg e)
+  | E_sizeof nexp -> alg.e_sizeof nexp
   | E_exit e -> alg.e_exit (fold_exp alg e)
   | E_return e -> alg.e_return (fold_exp alg e)
   | E_assert(e1,e2) -> alg.e_assert (fold_exp alg e1, fold_exp alg e2)
@@ -809,6 +826,7 @@ let id_exp_alg =
   ; e_case = (fun (e1,pexps) -> E_case (e1,pexps))
   ; e_let = (fun (lb,e2) -> E_let (lb,e2))
   ; e_assign = (fun (lexp,e2) -> E_assign (lexp,e2))
+  ; e_sizeof = (fun nexp -> E_sizeof nexp)
   ; e_exit = (fun e1 -> E_exit (e1))
   ; e_return = (fun e1 -> E_return e1)
   ; e_assert = (fun (e1,e2) -> E_assert(e1,e2)) 
@@ -909,7 +927,7 @@ let remove_vector_concat_pat pat =
 
   let pat = fold_pat name_vector_concat_elements pat in
 
-    
+
 
   let rec tag_last = function
     | x :: xs -> let is_last = xs = [] in (x,is_last) :: tag_last xs
@@ -931,52 +949,36 @@ let remove_vector_concat_pat pat =
       let (Id_aux (Id rootname,_)) = rootid in
       let (Id_aux (Id childname,_)) = child in
       
-      let vlength_info (Base ((_,{t = Tapp("vector",[_;TA_nexp nexp;_;_])}),_,_,_,_,_)) =
-        nexp in
-
-      let root : tannot exp = E_aux (E_id rootid,rannot) in
+      let root = E_aux (E_id rootid, rannot) in
       let index_i = simple_num l i in
-      let index_j : tannot exp = match j with
-        | Some j -> simple_num l j
-        | None ->
-           let length_root_nexp = vlength_info (snd rannot) in
-           let length_app_exp : tannot exp =
-             let typ = mk_atom_typ length_root_nexp in
-             let annot = (l,tag_annot typ (External (Some "length"))) in
-             E_aux (E_app (Id_aux (Id "length",l),[root]),annot) in
-           let minus = Id_aux (Id "-",l) in
-           let one_exp : tannot exp = 
-             let typ = (mk_atom_typ (mk_c unit_big_int)) in
-             let annot = (l,simple_annot typ) in
-             E_aux (E_lit (L_aux (L_num 1,l)),annot) in
-           
-           let typ = mk_atom_typ (mk_sub length_root_nexp (mk_c unit_big_int)) in
-           let annot = (l,tag_annot typ (External (Some "minus"))) in
-           let exp : tannot exp =
-             E_aux (E_app_infix(length_app_exp,minus,one_exp),annot) in
-           exp in
+      let index_j = simple_num l j in
       
-      let subv = E_aux (E_app (Id_aux (Id "slice_raw",Unknown),
-                               [root;index_i;index_j]),cannot) in
+      let subv = fix_eff_exp (E_aux (E_vector_subrange (root, index_i, index_j), cannot)) in
 
-      let typ = (Parse_ast.Generated l,simple_annot {t = Tid "unit"}) in
-      
-      let letbind = LB_val_implicit (P_aux (P_id child,cannot),subv) in
-      (LB_aux (letbind,typ),
-       (fun body -> E_aux (E_let (LB_aux (letbind,cannot),body),typ)),
+      let letbind = fix_eff_lb (LB_aux (LB_val_implicit (P_aux (P_id child,cannot),subv),cannot)) in
+      (letbind,
+       (fun body -> fix_eff_exp (E_aux (E_let (letbind,body), simple_annot l (typ_of body)))),
        (rootname,childname)) in
 
     let p_aux = function
       | ((P_as (P_aux (P_vector_concat pats,rannot'),rootid),decls),rannot) ->
-         let aux (pos,pat_acc,decl_acc) (P_aux (p,cannot),is_last) = match cannot with
-            | (l,Base((_,({t = Tapp ("vector",[_;TA_nexp length;_;_])} as t)),_,_,_,_,_))
-            | (l,Base((_,({t = Tabbrev (_,{t = Tapp ("vector",[_;TA_nexp length;_;_])})} as t)),_,_,_,_,_)) ->
-               let (pos',index_j) = match has_const_vector_length t with
-                 | Some i ->
-                     let length = int_of_big_int i in
-                     (pos+length, Some(pos+length-1))
-                 | None ->
-                     if is_last then (pos,None)
+         let rtyp = Env.base_typ_of (env_of_annot rannot') (typ_of_annot rannot') in
+         let (start,last_idx) = (match vector_typ_args_of rtyp with
+          | (Nexp_aux (Nexp_constant start,_), Nexp_aux (Nexp_constant length,_), ord, _) ->
+            (start, if is_order_inc ord then start + length - 1 else start - length + 1)
+          | _ ->
+            raise (Reporting_basic.err_unreachable (fst rannot')
+              ("unname_vector_concat_elements: vector of unspecified length in vector-concat pattern"))) in
+         let aux (pos,pat_acc,decl_acc) (P_aux (p,cannot),is_last) =
+           let ctyp = Env.base_typ_of (env_of_annot cannot) (typ_of_annot cannot) in
+           let (_,length,ord,_) = vector_typ_args_of ctyp in
+            (*)| (_,length,ord,_) ->*)
+               let (pos',index_j) = match length with
+                 | Nexp_aux (Nexp_constant i,_) ->
+                   if is_order_inc ord then (pos+i, pos+i-1)
+                   else (pos-i, pos-i+1)
+                 | Nexp_aux (_,l) ->
+                     if is_last then (pos,last_idx)
                      else
                      raise
                        (Reporting_basic.err_unreachable
@@ -994,20 +996,21 @@ let remove_vector_concat_pat pat =
                 (* normal vector patterns are fine *)
                 | _ -> (pos', pat_acc @ [P_aux (p,cannot)],decl_acc) )
             (* non-vector patterns aren't *)
-            | (l,Base((_,t),_,_,_,_,_)) ->
+            (*)| _ ->
                raise
                  (Reporting_basic.err_unreachable
-                    l ("unname_vector_concat_elements: Non-vector in vector-concat pattern:" ^
-                       t_to_string t)
-                 ) in
+                    (fst cannot)
+                    ("unname_vector_concat_elements: Non-vector in vector-concat pattern:" ^
+                       string_of_typ (typ_of_annot cannot))
+                 )*) in
           let pats_tagged = tag_last pats in
-          let (_,pats',decls') = List.fold_left aux (0,[],[]) pats_tagged in
+          let (_,pats',decls') = List.fold_left aux (start,[],[]) pats_tagged in
 
           (* abuse P_vector_concat as a P_vector_const pattern: it has the of
           patterns as an argument but they're meant to be consed together *)
           (P_aux (P_as (P_aux (P_vector_concat pats',rannot'),rootid),rannot), decls @ decls')
       | ((p,decls),annot) -> (P_aux (p,annot),decls) in
-    
+
     { p_lit            = (fun lit -> (P_lit lit,[]))
     ; p_wild           = (P_wild,[])
     ; p_as             = (fun ((pat,decls),id) -> (P_as (pat,id),decls))
@@ -1088,41 +1091,28 @@ let remove_vector_concat_pat pat =
   let remove_vector_concats =
     let p_vector_concat ps =
       let aux acc (P_aux (p,annot),is_last) =
+        let env = env_of_annot annot in
+        let typ = Env.base_typ_of env (typ_of_annot annot) in
+        let eff = effect_of_annot (snd annot) in
         let (l,_) = annot in
-        match p,annot with
-        | P_vector ps,_ -> acc @ ps
-        | P_id _,(_,Base((_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])}),_,_,_,_,_))
-        | P_id _,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector",[_;TA_nexp {nexp = Nconst length};_;_])})}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])})}),_,_,_,_,_)) ->
-           let wild _ = P_aux (P_wild,(Parse_ast.Generated l,simple_annot {t = Tid "bit"})) in
-           acc @ (List.map wild (range 0 ((int_of_big_int length) - 1)))
-        | P_id _,(_,Base((_,{t = Tapp ("vector", _)}),_,_,_,_,_))
-        | P_id _,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector",_)})}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tapp ("vector", _)}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector", _)})}),_,_,_,_,_))
-             when is_last ->
-           let wild _ = P_aux (P_wild,(Parse_ast.Generated l,simple_annot {t = Tid "bit"})) in
-           acc @ [P_aux(P_wild,annot)]
-        | P_lit _,(l,_) ->
-           raise (Reporting_basic.err_unreachable l "remove_vector_concats: P_lit pattern in vector-concat pattern")
-        | _,(l,Base((_,t),_,_,_,_,_)) ->
-           raise (Reporting_basic.err_unreachable l ("remove_vector_concats: Non-vector in vector-concat pattern " ^
-                       t_to_string t)) in
+        let wild _ = P_aux (P_wild,(Parse_ast.Generated l, Some (env, bit_typ, eff))) in
+        if is_vector_typ typ then
+          match p, vector_typ_args_of typ with
+          | P_vector ps,_ -> acc @ ps
+          | _, (_,Nexp_aux (Nexp_constant length,_),_,_) ->
+             acc @ (List.map wild (range 0 (length - 1)))
+          | _, _ ->
+            (*if is_last then*) acc @ [wild 0]
+        else raise
+          (Reporting_basic.err_unreachable l
+            ("remove_vector_concats: Non-vector in vector-concat pattern " ^
+              string_of_typ (typ_of_annot annot))) in
 
       let has_length (P_aux (p,annot)) =
-        match p,annot with
-        | P_vector _,_ -> true
-        | P_id _,(_,Base((_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])}),_,_,_,_,_))
-        | P_id _,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector",[_;TA_nexp {nexp = Nconst length};_;_])})}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector", [_;TA_nexp {nexp = Nconst length};_;_])})}),_,_,_,_,_)) ->
-           true
-        | P_id _,(_,Base((_,{t = Tapp ("vector", _)}),_,_,_,_,_))
-        | P_id _,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector",_)})}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tapp ("vector", _)}),_,_,_,_,_))
-        | P_wild,(_,Base((_,{t = Tabbrev (_,{t = Tapp ("vector", _)})}),_,_,_,_,_)) ->
-           false in
+        let typ = Env.base_typ_of (env_of_annot annot) (typ_of_annot annot) in
+        match vector_typ_args_of typ with
+        | (_,Nexp_aux (Nexp_constant length,_),_,_) -> true
+        | _ -> false in
 
       let ps_tagged = tag_last ps in
       let ps' = List.fold_left aux [] ps_tagged in
@@ -1144,16 +1134,16 @@ let remove_vector_concat_pat pat =
   (pat,letbinds,decls)
 
 (* assumes there are no more E_internal expressions *)
-let rewrite_exp_remove_vector_concat_pat rewriters nmap (E_aux (exp,(l,annot)) as full_exp) = 
+let rewrite_exp_remove_vector_concat_pat rewriters (E_aux (exp,(l,annot)) as full_exp) =
   let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters nmap in
-  let rewrite_base = rewrite_exp rewriters nmap in
+  let rewrite_rec = rewriters.rewrite_exp rewriters in
+  let rewrite_base = rewrite_exp rewriters in
   match exp with
   | E_case (e,ps) ->
      let aux (Pat_aux (Pat_exp (pat,body),annot')) =
        let (pat,_,decls) = remove_vector_concat_pat pat in
-       Pat_aux (Pat_exp (pat,decls (rewrite_rec body)),annot') in
-     rewrap (E_case (rewrite_rec e,List.map aux ps))
+       Pat_aux (Pat_exp (pat, decls (rewrite_rec body)),annot') in
+     rewrap (E_case (rewrite_rec e, List.map aux ps))
   | E_let (LB_aux (LB_val_explicit (typ,pat,v),annot'),body) ->
      let (pat,_,decls) = remove_vector_concat_pat pat in
      rewrap (E_let (LB_aux (LB_val_explicit (typ,pat,rewrite_rec v),annot'),
@@ -1167,8 +1157,9 @@ let rewrite_exp_remove_vector_concat_pat rewriters nmap (E_aux (exp,(l,annot)) a
 let rewrite_fun_remove_vector_concat_pat
       rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) = 
   let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),(l,annot))) =
-    let (pat,_,decls) = remove_vector_concat_pat pat in
-    (FCL_aux (FCL_Funcl (id,pat,rewriters.rewrite_exp rewriters None (decls exp)),(l,annot))) 
+    let (pat',_,decls) = remove_vector_concat_pat pat in
+    let exp' = decls (rewriters.rewrite_exp rewriters exp) in
+    (FCL_aux (FCL_Funcl (id,pat',exp'),(l,annot))) 
   in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
 
 let rewrite_defs_remove_vector_concat (Defs defs) =
@@ -1194,21 +1185,12 @@ let rewrite_defs_remove_vector_concat (Defs defs) =
     | d -> [d] in
   Defs (List.flatten (List.map rewrite_def defs))
 
-let map_default f = function
-| None -> None
-| Some x -> f x
-
-let rec binop_opt f x y = match x, y with
-| None, None -> None
-| Some x, None -> Some x
-| None, Some y -> Some y
-| Some x, Some y -> Some (f x y)
-
 let rec contains_bitvector_pat (P_aux (pat,annot)) = match pat with
 | P_lit _ | P_wild | P_id _ -> false
 | P_as (pat,_) | P_typ (_,pat) -> contains_bitvector_pat pat
 | P_vector _ | P_vector_concat _ | P_vector_indexed _ ->
-    is_bit_vector (get_type_annot annot)
+    let typ = Env.base_typ_of (env_of_annot annot) (typ_of_annot annot) in
+    is_bitvector_typ typ
 | P_app (_,pats) | P_tup pats | P_list pats ->
     List.exists contains_bitvector_pat pats
 | P_record (fpats,_) ->
@@ -1232,9 +1214,10 @@ let remove_bitvector_pat pat =
     ; p_list           = (fun ps -> P_list (List.map (fun p -> p false) ps))
     ; p_aux =
         (fun (pat,annot) contained_in_p_as ->
-          let t = get_type_annot annot in
+          let env = env_of_annot annot in
+          let t = Env.base_typ_of env (typ_of_annot annot) in
           let (l,_) = annot in
-          match pat, is_bit_vector t, contained_in_p_as with
+          match pat, is_bitvector_typ t, contained_in_p_as with
           | P_vector _, true, false
           | P_vector_indexed _, true, false ->
             P_aux (P_as (P_aux (pat,annot),fresh_id "b__" l), annot)
@@ -1249,59 +1232,49 @@ let remove_bitvector_pat pat =
      bitvector pattern match those of a given bitvector, and collect let
      bindings for the bits bound by P_id or P_as patterns *)
 
-  (* Helper functions for calculating vector indices *)
-  let vec_ord t = match (normalize_t t).t with
-    | Tapp("vector", [_;_;TA_ord {order = ord}; _]) -> ord
-    | _ -> Oinc (* TODO Use default order *) in
-
-  let vec_is_inc t = match vec_ord t with Oinc -> true | _ -> false in
-
-  let vec_start t = match (normalize_t t).t with
-    | Tapp("vector", [TA_nexp {nexp = Nconst i};_;_; _]) -> int_of_big_int i
-    | _ -> 0 in
-
-  let vec_length t = match (normalize_t t).t with
-    | Tapp("vector", [_;TA_nexp {nexp = Nconst j};_; _]) -> int_of_big_int j
-    | _ -> 0 in
-
   (* Helper functions for generating guard expressions *)
-  let bit_annot l = (Parse_ast.Generated l, simple_annot {t = Tid "bit"}) in
-
   let access_bit_exp (rootid,rannot) l idx =
     let root : tannot exp = E_aux (E_id rootid,rannot) in
-    E_aux (E_vector_access (root,simple_num l idx), bit_annot l) in
+    E_aux (E_vector_access (root,simple_num l idx), simple_annot l bit_typ) in
 
   let test_bit_exp rootid l t idx exp =
-    let rannot = (Parse_ast.Generated l, simple_annot t) in
+    let rannot = simple_annot l t in
     let elem = access_bit_exp (rootid,rannot) l idx in
-    let eqid = Id_aux (Id "==", Parse_ast.Generated l) in
-    let eqannot = (Parse_ast.Generated l,
-                   tag_annot {t = Tid "bit"} (External (Some "eq_bit"))) in
-    let eqexp : tannot exp = E_aux (E_app_infix(elem,eqid,exp), eqannot) in
+    let eqid = Id_aux (Id "eq", Parse_ast.Generated l) in
+    let eqannot = simple_annot l bool_typ in
+    let eqexp : tannot exp = E_aux (E_app(eqid,[elem;exp]), eqannot) in
     Some (eqexp) in
 
-  let test_subvec_exp rootid l t i j lits =
-    let l' = Parse_ast.Generated l in
-    let t' = mk_vector {t = Tid "bit"} {order = vec_ord t}
-                       (mk_c_int i) (mk_c_int (List.length lits)) in
+  let test_subvec_exp rootid l typ i j lits =
+    let (start, length, ord, _) = vector_typ_args_of typ in
+    let length' = nconstant (List.length lits) in
+    let start' =
+      if is_order_inc ord then nconstant 0
+      else nminus length' (nconstant 1) in
+    let typ' = vector_typ start' length' ord bit_typ in
     let subvec_exp =
-      if vec_start t = i && vec_length t = List.length lits
+      match start, length with
+      | Nexp_aux (Nexp_constant s, _), Nexp_aux (Nexp_constant l, _)
+        when s = i && l = List.length lits ->
+        E_id rootid
+      | _ ->
+      (*if vec_start t = i && vec_length t = List.length lits
       then E_id rootid
-      else E_vector_subrange (
-             E_aux (E_id rootid, (l', simple_annot t)),
+      else*) E_vector_subrange (
+             E_aux (E_id rootid, simple_annot l typ),
              simple_num l i,
              simple_num l j) in
-    E_aux (E_app_infix(
-        E_aux (subvec_exp, (l', simple_annot t')),
-        Id_aux (Id "==", l'),
-        E_aux (E_vector lits, (l', simple_annot t'))),
-      (l', tag_annot {t = Tid "bit"} (External (Some "eq_vec")))) in
-
-  let letbind_bit_exp rootid l t idx id =
-    let rannot = (Parse_ast.Generated l, simple_annot t) in
+    E_aux (E_app(
+      Id_aux (Id "eq_vec", Parse_ast.Generated l),
+      [E_aux (subvec_exp, simple_annot l typ');
+      E_aux (E_vector lits, simple_annot l typ')]),
+      simple_annot l bool_typ) in
+
+  let letbind_bit_exp rootid l typ idx id =
+    let rannot = simple_annot l typ in
     let elem = access_bit_exp (rootid,rannot) l idx in
-    let e = P_aux (P_id id, bit_annot l) in
-    let letbind = LB_aux (LB_val_implicit (e,elem), bit_annot l) in
+    let e = P_aux (P_id id, simple_annot l bit_typ) in
+    let letbind = LB_aux (LB_val_implicit (e,elem), simple_annot l bit_typ) in
     let letexp = (fun body ->
       let (E_aux (_,(_,bannot))) = body in
       E_aux (E_let (letbind,body), (Parse_ast.Generated l, bannot))) in
@@ -1310,13 +1283,11 @@ let remove_bitvector_pat pat =
   (* Helper functions for composing guards *)
   let bitwise_and exp1 exp2 =
     let (E_aux (_,(l,_))) = exp1 in
-    let andid = Id_aux (Id "&", Parse_ast.Generated l) in
-    let andannot = (Parse_ast.Generated l,
-                    tag_annot {t = Tid "bit"} (External (Some "bitwise_and_bit"))) in
-    E_aux (E_app_infix(exp1,andid,exp2), andannot) in
+    let andid = Id_aux (Id "bool_and", Parse_ast.Generated l) in
+    E_aux (E_app(andid,[exp1;exp2]), simple_annot l bool_typ) in
 
   let compose_guards guards =
-    List.fold_right (binop_opt bitwise_and) guards None in
+    List.fold_right (Util.option_binop bitwise_and) guards None in
 
   let flatten_guards_decls gd =
     let (guards,decls,letbinds) = Util.split3 gd in
@@ -1325,8 +1296,9 @@ let remove_bitvector_pat pat =
   (* Collect guards and let bindings *)
   let guard_bitvector_pat =
     let collect_guards_decls ps rootid t =
+      let (start,_,ord,_) = vector_typ_args_of t in
       let rec collect current (guards,dls) idx ps =
-        let idx' = if vec_is_inc t then idx + 1 else idx - 1 in
+        let idx' = if is_order_inc ord then idx + 1 else idx - 1 in
         (match ps with
           | pat :: ps' ->
             (match pat with
@@ -1355,7 +1327,13 @@ let remove_bitvector_pat pat =
                 guards @ [Some (test_subvec_exp rootid l t i j lits)]
               | None -> guards) in
             (guards',dls)) in
-      let (guards,dls) = collect None ([],[]) (vec_start t) ps in
+      let (guards,dls) = match start with
+      | Nexp_aux (Nexp_constant s, _) ->
+        collect None ([],[]) s ps
+      | _ ->
+        let (P_aux (_, (l,_))) = pat in
+        raise (Reporting_basic.err_unreachable l
+          "guard_bitvector_pat called on pattern with non-constant start index") in
       let (decls,letbinds) = List.split dls in
       (compose_guards guards, List.fold_right (@@) decls, letbinds) in
 
@@ -1397,8 +1375,9 @@ let remove_bitvector_pat pat =
     ; p_list           = (fun ps -> let (ps,gdls) = List.split ps in
                                     (P_list ps, flatten_guards_decls gdls))
     ; p_aux            = (fun ((pat,gdls),annot) ->
-                           let t = get_type_annot annot in
-                           (match pat, is_bit_vector t with
+                           let env = env_of_annot annot in
+                           let t = Env.base_typ_of env (typ_of_annot annot) in
+                           (match pat, is_bitvector_typ t with
                            | P_as (P_aux (P_vector ps, _), id), true ->
                              (P_aux (P_id id, annot), collect_guards_decls ps id t)
                            | P_as (P_aux (P_vector_indexed ips, _), id), true ->
@@ -1417,22 +1396,13 @@ let remove_wildcards pre (P_aux (_,(l,_)) as pat) =
         | (p,annot) -> P_aux (p,annot) }
     pat
 
-(* Based on current type checker's behaviour *)
-let pat_id_is_variable t_env id =
-  match Envmap.apply t_env id with
-  | Some (Base(_,Constructor _,_,_,_,_))
-  | Some (Base(_,Enum _,_,_,_,_))
-    -> false
-  | _ -> true
-
 (* Check if one pattern subsumes the other, and if so, calculate a
    substitution of variables that are used in the same position.
    TODO: Check somewhere that there are no variable clashes (the same variable
    name used in different positions of the patterns)
  *)
-let rec subsumes_pat typ_env (P_aux (p1,annot1) as pat1) (P_aux (p2,_) as pat2) =
+let rec subsumes_pat (P_aux (p1,annot1) as pat1) (P_aux (p2,annot2) as pat2) =
   let rewrap p = P_aux (p,annot1) in
-  let subsumes = subsumes_pat typ_env in
   let subsumes_list s pats1 pats2 =
     if List.length pats1 = List.length pats2
     then
@@ -1446,36 +1416,37 @@ let rec subsumes_pat typ_env (P_aux (p1,annot1) as pat1) (P_aux (p2,_) as pat2)
   match p1, p2 with
   | P_lit (L_aux (lit1,_)), P_lit (L_aux (lit2,_)) ->
       if lit1 = lit2 then Some [] else None
-  | P_as (pat1,_), _ -> subsumes pat1 pat2
-  | _, P_as (pat2,_) -> subsumes pat1 pat2
-  | P_typ (_,pat1), _ -> subsumes pat1 pat2
-  | _, P_typ (_,pat2) -> subsumes pat1 pat2
+  | P_as (pat1,_), _ -> subsumes_pat pat1 pat2
+  | _, P_as (pat2,_) -> subsumes_pat pat1 pat2
+  | P_typ (_,pat1), _ -> subsumes_pat pat1 pat2
+  | _, P_typ (_,pat2) -> subsumes_pat pat1 pat2
   | P_id (Id_aux (id1,_) as aid1), P_id (Id_aux (id2,_) as aid2) ->
     if id1 = id2 then Some []
-    else if pat_id_is_variable typ_env (id_to_string aid1) &&
-            pat_id_is_variable typ_env (id_to_string aid1)
+    else if Env.lookup_id aid1 (env_of_annot annot1) = Unbound &&
+            Env.lookup_id aid2 (env_of_annot annot2) = Unbound
            then Some [(id2,id1)] else None
-  | P_id id1, _ -> if pat_id_is_variable typ_env (id_to_string id1) then Some [] else None
+  | P_id id1, _ ->
+    if Env.lookup_id id1 (env_of_annot annot1) = Unbound then Some [] else None
   | P_wild, _ -> Some []
   | P_app (Id_aux (id1,l1),args1), P_app (Id_aux (id2,_),args2) ->
-    if id1 = id2 then subsumes_list subsumes args1 args2 else None
+    if id1 = id2 then subsumes_list subsumes_pat args1 args2 else None
   | P_record (fps1,b1), P_record (fps2,b2) ->
-    if b1 = b2 then subsumes_list (subsumes_fpat typ_env) fps1 fps2 else None
+    if b1 = b2 then subsumes_list subsumes_fpat fps1 fps2 else None
   | P_vector pats1, P_vector pats2
   | P_vector_concat pats1, P_vector_concat pats2
   | P_tup pats1, P_tup pats2
   | P_list pats1, P_list pats2 ->
-    subsumes_list subsumes pats1 pats2
+    subsumes_list subsumes_pat pats1 pats2
   | P_vector_indexed ips1, P_vector_indexed ips2 ->
     let (is1,ps1) = List.split ips1 in
     let (is2,ps2) = List.split ips2 in
-    if is1 = is2 then subsumes_list subsumes ps1 ps2 else None
+    if is1 = is2 then subsumes_list subsumes_pat ps1 ps2 else None
   | _ -> None
-and subsumes_fpat typ_env (FP_aux (FP_Fpat (id1,pat1),_)) (FP_aux (FP_Fpat (id2,pat2),_)) =
-  if id1 = id2 then subsumes_pat typ_env pat1 pat2 else None
+and subsumes_fpat (FP_aux (FP_Fpat (id1,pat1),_)) (FP_aux (FP_Fpat (id2,pat2),_)) =
+  if id1 = id2 then subsumes_pat pat1 pat2 else None
 
-let equiv_pats typ_env pat1 pat2 =
-  match subsumes_pat typ_env pat1 pat2, subsumes_pat typ_env pat2 pat1 with
+let equiv_pats pat1 pat2 =
+  match subsumes_pat pat1 pat2, subsumes_pat pat2 pat1 with
   | Some _, Some _ -> true
   | _, _ -> false
 
@@ -1488,8 +1459,6 @@ let subst_id_exp exp (id1,id2) =
   let e_id (Id_aux (id,l)) = (if id = id1 then E_id (Id_aux (id2,l)) else E_id (Id_aux (id,l))) in
   fold_exp {id_exp_alg with e_id = e_id} exp
 
-let gen_annot l t efr = (Parse_ast.Generated l,simple_annot_efr t efr)
-
 let rec pat_to_exp (P_aux (pat,(l,annot))) =
   let rewrap e = E_aux (e,(l,annot)) in
   match pat with
@@ -1510,26 +1479,23 @@ let rec pat_to_exp (P_aux (pat,(l,annot))) =
   | P_tup pats -> rewrap (E_tuple (List.map pat_to_exp pats))
   | P_list pats -> rewrap (E_list (List.map pat_to_exp pats))
   | P_vector_indexed ipats -> raise (Reporting_basic.err_unreachable l
-      "pat_to_exp not implemented for P_vector_indexed")
-      (* TODO: We can't guess the default value for the indexed vector
-      expression here. We should make sure that indexed vector patterns are
-      bound to a variable via P_as before calling pat_to_exp *)
+      "pat_to_exp not implemented for P_vector_indexed") (* TODO *)
 and fpat_to_fexp (FP_aux (FP_Fpat (id,pat),(l,annot))) =
   FE_aux (FE_Fexp (id, pat_to_exp pat),(l,annot))
 
 let case_exp e t cs =
   let pexp (pat,body,annot) = Pat_aux (Pat_exp (pat,body),annot) in
   let ps = List.map pexp cs in
-  (* let efr = union_effs (List.map get_effsum_pexp ps) in *)
-  fix_effsum_exp (E_aux (E_case (e,ps), gen_annot (get_loc e) t pure_e))
+  (* let efr = union_effs (List.map effect_of_pexp ps) in *)
+  fix_eff_exp (E_aux (E_case (e,ps), (get_loc_exp e, Some (env_of e, t, no_effect))))
 
-let rewrite_guarded_clauses typ_env l cs =
+let rewrite_guarded_clauses l cs =
   let rec group clauses =
     let add_clause (pat,cls,annot) c = (pat,cls @ [c],annot) in
     let rec group_aux current acc = (function
       | ((pat,guard,body,annot) as c) :: cs ->
           let (current_pat,_,_) = current in
-          (match subsumes_pat typ_env current_pat pat with
+          (match subsumes_pat current_pat pat with
             | Some substs ->
                 let pat' = List.fold_left subst_id_pat pat substs in
                 let guard' = (match guard with
@@ -1551,9 +1517,9 @@ let rewrite_guarded_clauses typ_env l cs =
     List.map (fun cs -> if_pexp cs) groups
   and if_pexp (pat,cs,annot) = (match cs with
     | c :: _ ->
-        (* fix_effsum_pexp (pexp *)
+        (* fix_eff_pexp (pexp *)
         let body = if_exp pat cs in
-        let pexp = fix_effsum_pexp (Pat_aux (Pat_exp (pat,body),annot)) in
+        let pexp = fix_eff_pexp (Pat_aux (Pat_exp (pat,body),annot)) in
         let (Pat_aux (Pat_exp (_,_),annot)) = pexp in
         (pat, body, annot)
     | [] ->
@@ -1564,10 +1530,10 @@ let rewrite_guarded_clauses typ_env l cs =
         (match guard with
           | Some exp ->
               let else_exp =
-                if equiv_pats typ_env current_pat pat'
+                if equiv_pats current_pat pat'
                 then if_exp current_pat (c' :: cs)
-                else case_exp (pat_to_exp current_pat) (get_type_annot annot') (group (c' :: cs)) in
-              fix_effsum_exp (E_aux (E_if (exp,body,else_exp), annot))
+                else case_exp (pat_to_exp current_pat) (typ_of body') (group (c' :: cs)) in
+              fix_eff_exp (E_aux (E_if (exp,body,else_exp), simple_annot (fst annot) (typ_of body)))
           | None -> body)
     | [(pat,guard,body,annot)] -> body
     | [] ->
@@ -1575,10 +1541,10 @@ let rewrite_guarded_clauses typ_env l cs =
             "if_exp given empty list in rewrite_guarded_clauses")) in
   group cs
 
-let rewrite_exp_remove_bitvector_pat typ_env rewriters nmap (E_aux (exp,(l,annot)) as full_exp) =
+let rewrite_exp_remove_bitvector_pat rewriters (E_aux (exp,(l,annot)) as full_exp) =
   let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters nmap in
-  let rewrite_base = rewrite_exp rewriters nmap in
+  let rewrite_rec = rewriters.rewrite_exp rewriters in
+  let rewrite_base = rewrite_exp rewriters in
   match exp with
   | E_case (e,ps)
     when List.exists (fun (Pat_aux (Pat_exp (pat,_),_)) -> contains_bitvector_pat pat) ps ->
@@ -1586,7 +1552,7 @@ let rewrite_exp_remove_bitvector_pat typ_env rewriters nmap (E_aux (exp,(l,annot
        let (pat',(guard,decls,_)) = remove_bitvector_pat pat in
        let body' = decls (rewrite_rec body) in
        (pat',guard,body',annot') in
-     let clauses = rewrite_guarded_clauses typ_env l (List.map clause ps) in
+     let clauses = rewrite_guarded_clauses l (List.map clause ps) in
      if (effectful e) then
        let e = rewrite_rec e in
        let (E_aux (_,(el,eannot))) = e in
@@ -1595,10 +1561,10 @@ let rewrite_exp_remove_bitvector_pat typ_env rewriters nmap (E_aux (exp,(l,annot
        (* let fresh = fresh_id "p__" el in
        let exp_e' = E_aux (E_id fresh, gen_annot l (get_type e) pure_e) in
        let pat_e' = P_aux (P_id fresh, gen_annot l (get_type e) pure_e) in *)
-       let letbind_e = LB_aux (LB_val_implicit (pat_e',e), gen_annot l (get_type e) (get_effsum_exp e)) in
-       let exp' = case_exp exp_e' (get_type full_exp) clauses in
+       let letbind_e = LB_aux (LB_val_implicit (pat_e',e), (el,eannot)) in
+       let exp' = case_exp exp_e' (typ_of full_exp) clauses in
        rewrap (E_let (letbind_e, exp'))
-     else case_exp e (get_type full_exp) clauses
+     else case_exp e (typ_of full_exp) clauses
   | E_let (LB_aux (LB_val_explicit (typ,pat,v),annot'),body) ->
      let (pat,(_,decls,_)) = remove_bitvector_pat pat in
      rewrap (E_let (LB_aux (LB_val_explicit (typ,pat,rewrite_rec v),annot'),
@@ -1610,27 +1576,27 @@ let rewrite_exp_remove_bitvector_pat typ_env rewriters nmap (E_aux (exp,(l,annot
   | _ -> rewrite_base full_exp
 
 let rewrite_fun_remove_bitvector_pat
-      typ_env rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) =
+      rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) =
   let _ = reset_fresh_name_counter () in
   (* TODO Can there be clauses with different id's in one FD_function? *)
   let funcls = match funcls with
     | (FCL_aux (FCL_Funcl(id,_,_),_) :: _) ->
         let clause (FCL_aux (FCL_Funcl(_,pat,exp),annot)) =
           let (pat,(guard,decls,_)) = remove_bitvector_pat pat in
-          let exp = decls (rewriters.rewrite_exp rewriters None exp) in
+          let exp = decls (rewriters.rewrite_exp rewriters exp) in
           (pat,guard,exp,annot) in
-        let cs = rewrite_guarded_clauses typ_env l (List.map clause funcls) in
+        let cs = rewrite_guarded_clauses l (List.map clause funcls) in
         List.map (fun (pat,exp,annot) -> FCL_aux (FCL_Funcl(id,pat,exp),annot)) cs
     | _ -> funcls (* TODO is the empty list possible here? *) in
   FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))
 
-let rewrite_defs_remove_bitvector_pats typ_env (Defs defs) =
+let rewrite_defs_remove_bitvector_pats (Defs defs) =
   let rewriters =
-    {rewrite_exp = rewrite_exp_remove_bitvector_pat typ_env;
+    {rewrite_exp = rewrite_exp_remove_bitvector_pat;
      rewrite_pat = rewrite_pat;
      rewrite_let = rewrite_let;
      rewrite_lexp = rewrite_lexp;
-     rewrite_fun = rewrite_fun_remove_bitvector_pat typ_env;
+     rewrite_fun = rewrite_fun_remove_bitvector_pat;
      rewrite_def = rewrite_def;
      rewrite_defs = rewrite_defs_base } in
   let rewrite_def d =
@@ -1652,25 +1618,28 @@ let rewrite_defs_remove_bitvector_pats typ_env (Defs defs) =
   internal_exp of any form
   lit vectors in patterns or expressions
  *)
-let rewrite_exp_lift_assign_intro rewriters nmap ((E_aux (exp,(l,annot))) as full_exp) = 
-  let rewrap e = E_aux (e,(l,annot)) in
-  let rewrap_effects e effsum =
-    let (Base (t,tag,nexps,eff,_,bounds)) = annot in
-    E_aux (e,(l,Base (t,tag,nexps,eff,effsum,bounds))) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters nmap in
-  let rewrite_base = rewrite_exp rewriters nmap in
+let rewrite_exp_lift_assign_intro rewriters ((E_aux (exp,((l,_) as annot))) as full_exp) =
+  let rewrap e = E_aux (e,annot) in
+  let rewrap_effects e eff =
+    E_aux (e, (l,Some (env_of_annot annot, typ_of_annot annot, eff))) in
+  let rewrite_rec = rewriters.rewrite_exp rewriters in
+  let rewrite_base = rewrite_exp rewriters in
   match exp with
   | E_block exps ->
     let rec walker exps = match exps with
       | [] -> []
-      | (E_aux(E_assign(le,e), (l, Base((_,t),Emp_intro,_,_,_,_))))::exps ->
-        let le' = rewriters.rewrite_lexp rewriters nmap le in
-        let e' = rewrite_base e in
-        let exps' = walker exps in
-        let effects = eff_union_exps exps' in
-        [E_aux (E_internal_let(le', e', E_aux(E_block exps', (l, simple_annot_efr {t=Tid "unit"} effects))),
-                 (l, simple_annot_efr t (eff_union_exps (e::exps'))))]
-      | ((E_aux(E_if(c,t,e),(l,annot))) as exp)::exps ->
+      | (E_aux(E_assign((LEXP_aux ((LEXP_id id | LEXP_cast (_,id)),_)) as le,e),
+               ((l, Some (env,typ,eff)) as annot)) as exp)::exps ->
+        (match Env.lookup_id id env with
+         | Unbound ->
+            let le' = rewriters.rewrite_lexp rewriters le in
+            let e' = rewrite_base e in
+            let exps' = walker exps in
+            let effects = union_eff_exps exps' in
+            let block = E_aux (E_block exps', (l, Some (env, unit_typ, effects))) in
+            [fix_eff_exp (E_aux (E_internal_let(le', e', block), annot))]
+         | _ -> (rewrite_rec exp)::(walker exps))
+      (*| ((E_aux(E_if(c,t,e),(l,annot))) as exp)::exps ->
         let vars_t = introduced_variables t in
         let vars_e = introduced_variables e in
         let new_vars = Envmap.intersect vars_t vars_e in
@@ -1711,43 +1680,34 @@ let rewrite_exp_lift_assign_intro rewriters nmap ((E_aux (exp,(l,annot))) as ful
                                         set_exp,
                                         E_aux (E_block res, (Parse_ast.Generated l, (simple_annot_efr unit_t effects)))),
                         (Parse_ast.Generated l, simple_annot_efr unit_t unioneffs))],unioneffs)))
-             (E_aux(E_if(c',t',e'),(Parse_ast.Generated l, annot))::exps',eff_union_exps (c'::t'::e'::exps')) new_vars)
+             (E_aux(E_if(c',t',e'),(Parse_ast.Generated l, annot))::exps',eff_union_exps (c'::t'::e'::exps')) new_vars)*)
       | e::exps -> (rewrite_rec e)::(walker exps)
     in
     rewrap (E_block (walker exps))
-  | E_assign(le,e) ->
-    (match annot with
-     | Base((_,t),Emp_intro,_,_,_,_) ->
-       let le' = rewriters.rewrite_lexp rewriters nmap le in
-       let e' = rewrite_base e in
-       let effects = get_effsum_exp e' in
-       (match le' with
-        | LEXP_aux(_, (_,Base(_,Emp_intro,_,_,_,_))) ->
-          rewrap_effects
-            (E_internal_let(le', e', E_aux(E_block [], (l, simple_annot_efr unit_t effects))))
-            effects
-        | LEXP_aux(_, (_,Base(_,_,_,_,efr,_))) ->
-          let effects' = union_effects effects efr in
-          E_aux((E_assign(le', e')),(l, tag_annot_efr unit_t Emp_set effects'))
-        | _ -> assert false)
+  | E_assign(((LEXP_aux ((LEXP_id id | LEXP_cast (_,id)),lannot)) as le),e) ->
+    let le' = rewriters.rewrite_lexp rewriters le in
+    let e' = rewrite_base e in
+    let effects = effect_of e' in
+    (match Env.lookup_id id (env_of_annot annot) with
+     | Unbound ->
+       rewrap_effects
+         (E_internal_let(le', e', E_aux(E_block [], simple_annot l unit_typ)))
+         effects
+     | Local _ ->
+       let effects' = union_effects effects (effect_of_annot (snd lannot)) in
+       let annot' = Some (env_of_annot annot, unit_typ, effects') in
+       E_aux((E_assign(le', e')),(l, annot'))
      | _ -> rewrite_base full_exp)
   | _ -> rewrite_base full_exp
 
-let rewrite_lexp_lift_assign_intro rewriters map ((LEXP_aux(lexp,(l,annot))) as le) = 
-  let rewrap le = LEXP_aux(le,(l,annot)) in
-  let rewrite_base = rewrite_lexp rewriters map in
-  match lexp with
-  | LEXP_id (Id_aux (Id i, _)) | LEXP_cast (_,(Id_aux (Id i,_))) ->
-    (match annot with
-    | Base((p,t),Emp_intro,cs,e1,e2,bs) ->
-      (match map with
-       | Some(_,s) ->
-         (match Envmap.apply s i with
-          | None -> rewrap lexp
-          | Some _ ->
-            let ls = BE_aux(BE_lset,l) in
-            LEXP_aux(lexp,(l,(Base((p,t),Emp_set,cs,add_effect ls e1, add_effect ls e2,bs)))))
-       | _ -> rewrap lexp)
+let rewrite_lexp_lift_assign_intro rewriters ((LEXP_aux(lexp,annot)) as le) =
+  let rewrap le = LEXP_aux(le,annot) in
+  let rewrite_base = rewrite_lexp rewriters in
+  match lexp, annot with
+  | (LEXP_id id | LEXP_cast (_,id)), (l, Some (env, typ, eff)) ->
+    (match Env.lookup_id id env with
+    | Unbound | Local _ ->
+      LEXP_aux (lexp, (l, Some (env, typ, union_effects eff (mk_effect [BE_lset]))))
     | _ -> rewrap lexp)
   | _ -> rewrite_base le
 
@@ -1760,16 +1720,16 @@ let rewrite_defs_exp_lift_assign defs = rewrite_defs_base
      rewrite_fun = rewrite_fun;
      rewrite_def = rewrite_def;
      rewrite_defs = rewrite_defs_base} defs
-    
-let rewrite_exp_separate_ints rewriters nmap ((E_aux (exp,(l,annot))) as full_exp) =
-  let tparms,t,tag,nexps,eff,cum_eff,bounds = match annot with
+
+(*let rewrite_exp_separate_ints rewriters ((E_aux (exp,((l,_) as annot))) as full_exp) =
+  (*let tparms,t,tag,nexps,eff,cum_eff,bounds = match annot with
     | Base((tparms,t),tag,nexps,eff,cum_eff,bounds) -> tparms,t,tag,nexps,eff,cum_eff,bounds
-    | _ -> [],unit_t,Emp_local,[],pure_e,pure_e,nob in
-  let rewrap e = E_aux (e,(l,annot)) in
-  let rewrap_effects e effsum =
-    E_aux (e,(l,Base ((tparms,t),tag,nexps,eff,effsum,bounds))) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters nmap in
-  let rewrite_base = rewrite_exp rewriters nmap in
+    | _ -> [],unit_t,Emp_local,[],pure_e,pure_e,nob in*)
+  let rewrap e = E_aux (e,annot) in
+  (*let rewrap_effects e effsum =
+    E_aux (e,(l,Base ((tparms,t),tag,nexps,eff,effsum,bounds))) in*)
+  let rewrite_rec = rewriters.rewrite_exp rewriters in
+  let rewrite_base = rewrite_exp rewriters in
   match exp with
   | E_lit (L_aux (((L_num _) as lit),_)) ->
     (match (is_within_machine64 t nexps) with
@@ -1806,7 +1766,7 @@ let rewrite_defs_separate_numbs defs = rewrite_defs_base
      rewrite_lexp = rewrite_lexp; (*will likely need a new one?*)
      rewrite_fun = rewrite_fun;
      rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base} defs
+     rewrite_defs = rewrite_defs_base} defs*)
 
 let rewrite_defs_ocaml defs =
   let defs_sorted = top_sort_defs defs in
@@ -1817,14 +1777,14 @@ let rewrite_defs_ocaml defs =
 
 let rewrite_defs_remove_blocks =
   let letbind_wild v body =
-    let (E_aux (_,(l,_))) = v in
-    let annot_pat = (Parse_ast.Generated l,simple_annot (get_type v)) in
-    let annot_lb = (Parse_ast.Generated l,simple_annot_efr (get_type v) (get_effsum_exp v)) in
-    let annot_let = (Parse_ast.Generated l,simple_annot_efr (get_type body) (eff_union_exps [v;body])) in
+    let (E_aux (_,(l,tannot))) = v in
+    let annot_pat = (simple_annot l (typ_of v)) in
+    let annot_lb = (Parse_ast.Generated l, tannot) in
+    let annot_let = (Parse_ast.Generated l, Some (env_of body, typ_of body, union_eff_exps [v;body])) in
     E_aux (E_let (LB_aux (LB_val_implicit (P_aux (P_wild,annot_pat),v),annot_lb),body),annot_let) in
 
   let rec f l = function
-    | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)), (Parse_ast.Generated l,simple_annot ({t = Tid "unit"})))
+    | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)), (simple_annot l unit_typ))
     | [e] -> e  (* check with Kathy if that annotation is fine *)
     | e :: es -> letbind_wild e (f l es) in
 
@@ -1835,7 +1795,7 @@ let rewrite_defs_remove_blocks =
   let alg = { id_exp_alg with e_aux = e_aux } in
 
   rewrite_defs_base
-    {rewrite_exp = (fun _ _ -> fold_exp alg)
+    {rewrite_exp = (fun _ -> fold_exp alg)
     ; rewrite_pat = rewrite_pat
     ; rewrite_let = rewrite_let
     ; rewrite_lexp = rewrite_lexp
@@ -1848,28 +1808,30 @@ let rewrite_defs_remove_blocks =
 
 let letbind (v : 'a exp) (body : 'a exp -> 'a exp) : 'a exp =
   (* body is a function : E_id variable -> actual body *)
-  match get_type v with
-  | {t = Tid "unit"} ->
-     let (E_aux (_,(l,annot))) = v in
-     let e = E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(Parse_ast.Generated l,simple_annot unit_t))  in
+  let (E_aux (_,(l,annot))) = v in
+  match annot with
+  | Some (env, Typ_aux (Typ_id tid, _), eff) when string_of_id tid = "unit" ->
+     let e = E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(simple_annot l unit_typ))  in
      let body = body e in
-     let annot_pat = (Parse_ast.Generated l,simple_annot unit_t) in
+     let annot_pat = simple_annot l unit_typ in
      let annot_lb = annot_pat in
-     let annot_let = (Parse_ast.Generated l,simple_annot_efr (get_type body) (eff_union_exps [v;body])) in
+     let annot_let = (Parse_ast.Generated l, Some (env, typ_of body, union_eff_exps [v;body])) in
      let pat = P_aux (P_wild,annot_pat) in
      
      E_aux (E_let (LB_aux (LB_val_implicit (pat,v),annot_lb),body),annot_let)
-  | _ -> 
-     let (E_aux (_,((l,_) as annot))) = v in
-     let ((E_aux (E_id id,_)) as e_id) = fresh_id_exp "w__" annot in
+  | Some (env, typ, eff) ->
+     let id = fresh_id "w__" l in
+     let annot_pat = simple_annot l (typ_of v) in
+     let e_id = E_aux (E_id id, (Parse_ast.Generated l, Some (env, typ, no_effect))) in
      let body = body e_id in
-     
-     let annot_pat = (Parse_ast.Generated l,simple_annot (get_type v)) in
+
      let annot_lb = annot_pat in
-     let annot_let = (Parse_ast.Generated l,simple_annot_efr (get_type body) (eff_union_exps [v;body])) in
+     let annot_let = (Parse_ast.Generated l, Some (env, typ_of body, union_eff_exps [v;body])) in
      let pat = P_aux (P_id id,annot_pat) in
      
      E_aux (E_let (LB_aux (LB_val_implicit (pat,v),annot_lb),body),annot_let)
+  | None ->
+     raise (Reporting_basic.err_unreachable l "no type information")
 
 
 let rec mapCont (f : 'b -> ('b -> 'a exp) -> 'a exp) (l : 'b list) (k : 'b list -> 'a exp) : 'a exp = 
@@ -1880,7 +1842,7 @@ let rec mapCont (f : 'b -> ('b -> 'a exp) -> 'a exp) (l : 'b list) (k : 'b list
 let rewrite_defs_letbind_effects  =  
 
   let rec value ((E_aux (exp_aux,_)) as exp) =
-    not (effectful exp) && not (updates_vars exp)
+    not (effectful exp || updates_vars exp)
   and value_optdefault (Def_val_aux (o,_)) = match o with
     | Def_val_empty -> true
     | Def_val_dec e -> value e
@@ -1892,7 +1854,7 @@ let rewrite_defs_letbind_effects  =
     n_exp exp (fun exp -> if value exp then k exp else letbind exp k)
 
   and n_exp_pure (exp : 'a exp) (k : 'a exp -> 'a exp) : 'a exp =
-    n_exp exp (fun exp -> if not (effectful exp || updates_vars exp) then k exp else letbind exp k)
+    n_exp exp (fun exp -> if value exp then k exp else letbind exp k)
 
   and n_exp_nameL (exps : 'a exp list) (k : 'a exp list -> 'a exp) : 'a exp =
     mapCont n_exp_name exps k
@@ -1900,14 +1862,14 @@ let rewrite_defs_letbind_effects  =
   and n_fexp (fexp : 'a fexp) (k : 'a fexp -> 'a exp) : 'a exp =
     let (FE_aux (FE_Fexp (id,exp),annot)) = fexp in
     n_exp_name exp (fun exp -> 
-    k (fix_effsum_fexp (FE_aux (FE_Fexp (id,exp),annot))))
+    k (fix_eff_fexp (FE_aux (FE_Fexp (id,exp),annot))))
 
   and n_fexpL (fexps : 'a fexp list) (k : 'a fexp list -> 'a exp) : 'a exp =
     mapCont n_fexp fexps k
 
   and n_pexp (newreturn : bool) (pexp : 'a pexp) (k : 'a pexp -> 'a exp) : 'a exp =
     let (Pat_aux (Pat_exp (pat,exp),annot)) = pexp in
-    k (fix_effsum_pexp (Pat_aux (Pat_exp (pat,n_exp_term newreturn exp), annot)))
+    k (fix_eff_pexp (Pat_aux (Pat_exp (pat,n_exp_term newreturn exp), annot)))
 
   and n_pexpL (newreturn : bool) (pexps : 'a pexp list) (k : 'a pexp list -> 'a exp) : 'a exp =
     mapCont (n_pexp newreturn) pexps k
@@ -1915,7 +1877,7 @@ let rewrite_defs_letbind_effects  =
   and n_fexps (fexps : 'a fexps) (k : 'a fexps -> 'a exp) : 'a exp = 
     let (FES_aux (FES_Fexps (fexps_aux,b),annot)) = fexps in
     n_fexpL fexps_aux (fun fexps_aux -> 
-    k (fix_effsum_fexps (FES_aux (FES_Fexps (fexps_aux,b),annot))))
+    k (fix_eff_fexps (FES_aux (FES_Fexps (fexps_aux,b),annot))))
 
   and n_opt_default (opt_default : 'a opt_default) (k : 'a opt_default -> 'a exp) : 'a exp = 
     let (Def_val_aux (opt_default,annot)) = opt_default in
@@ -1923,17 +1885,17 @@ let rewrite_defs_letbind_effects  =
     | Def_val_empty -> k (Def_val_aux (Def_val_empty,annot))
     | Def_val_dec exp ->
        n_exp_name exp (fun exp -> 
-       k (fix_effsum_opt_default (Def_val_aux (Def_val_dec exp,annot))))
+       k (fix_eff_opt_default (Def_val_aux (Def_val_dec exp,annot))))
 
   and n_lb (lb : 'a letbind) (k : 'a letbind -> 'a exp) : 'a exp =
     let (LB_aux (lb,annot)) = lb in
     match lb with
     | LB_val_explicit (typ,pat,exp1) ->
        n_exp exp1 (fun exp1 -> 
-       k (fix_effsum_lb (LB_aux (LB_val_explicit (typ,pat,exp1),annot))))
+       k (fix_eff_lb (LB_aux (LB_val_explicit (typ,pat,exp1),annot))))
     | LB_val_implicit (pat,exp1) ->
        n_exp exp1 (fun exp1 -> 
-       k (fix_effsum_lb (LB_aux (LB_val_implicit (pat,exp1),annot))))
+       k (fix_eff_lb (LB_aux (LB_val_implicit (pat,exp1),annot))))
 
   and n_lexp (lexp : 'a lexp) (k : 'a lexp -> 'a exp) : 'a exp =
     let (LEXP_aux (lexp_aux,annot)) = lexp in
@@ -1941,27 +1903,28 @@ let rewrite_defs_letbind_effects  =
     | LEXP_id _ -> k lexp
     | LEXP_memory (id,es) ->
        n_exp_nameL es (fun es -> 
-       k (fix_effsum_lexp (LEXP_aux (LEXP_memory (id,es),annot))))
+       k (fix_eff_lexp (LEXP_aux (LEXP_memory (id,es),annot))))
     | LEXP_cast (typ,id) -> 
-       k (fix_effsum_lexp (LEXP_aux (LEXP_cast (typ,id),annot)))
+       k (fix_eff_lexp (LEXP_aux (LEXP_cast (typ,id),annot)))
     | LEXP_vector (lexp,e) ->
        n_lexp lexp (fun lexp -> 
        n_exp_name e (fun e -> 
-       k (fix_effsum_lexp (LEXP_aux (LEXP_vector (lexp,e),annot)))))
+       k (fix_eff_lexp (LEXP_aux (LEXP_vector (lexp,e),annot)))))
     | LEXP_vector_range (lexp,e1,e2) ->
        n_lexp lexp (fun lexp ->
        n_exp_name e1 (fun e1 ->
        n_exp_name e2 (fun e2 ->
-       k (fix_effsum_lexp (LEXP_aux (LEXP_vector_range (lexp,e1,e2),annot))))))
+       k (fix_eff_lexp (LEXP_aux (LEXP_vector_range (lexp,e1,e2),annot))))))
     | LEXP_field (lexp,id) ->
        n_lexp lexp (fun lexp ->
-       k (fix_effsum_lexp (LEXP_aux (LEXP_field (lexp,id),annot))))
+       k (fix_eff_lexp (LEXP_aux (LEXP_field (lexp,id),annot))))
 
   and n_exp_term (newreturn : bool) (exp : 'a exp) : 'a exp =
-    let (E_aux (_,(l,_))) = exp in
+    let (E_aux (_,(l,tannot))) = exp in
     let exp =
       if newreturn then
-        E_aux (E_internal_return exp,(Parse_ast.Generated l,simple_annot_efr (get_type exp) (get_effsum_exp exp)))
+        let typ = typ_of exp in
+        E_aux (E_internal_return exp, simple_annot l typ)
       else
         exp in
     (* n_exp_term forces an expression to be translated into a form 
@@ -1971,7 +1934,7 @@ let rewrite_defs_letbind_effects  =
 
   and n_exp (E_aux (exp_aux,annot) as exp : 'a exp) (k : 'a exp -> 'a exp) : 'a exp = 
 
-    let rewrap e = fix_effsum_exp (E_aux (e,annot)) in
+    let rewrap e = fix_eff_exp (E_aux (e,annot)) in
 
     match exp_aux with
     | E_block es -> failwith "E_block should have been removed till now"
@@ -2058,7 +2021,7 @@ let rewrite_defs_letbind_effects  =
     | E_case (exp1,pexps) ->
        let newreturn =
          List.fold_left
-           (fun b (Pat_aux (_,(_,Base (_,_,_,_,effs,_)))) -> b || effectful_effs effs)
+           (fun b (Pat_aux (_,(_,annot))) -> b || effectful_effs (effect_of_annot annot))
            false pexps in
        n_exp_name exp1 (fun exp1 -> 
        n_pexpL newreturn pexps (fun pexps ->
@@ -2104,8 +2067,8 @@ let rewrite_defs_letbind_effects  =
   let rewrite_fun _ (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),fdannot)) = 
     let newreturn =
       List.fold_left
-        (fun b (FCL_aux (FCL_Funcl(id,pat,exp),annot)) ->
-         b || effectful_effs (get_localeff_annot annot)) false funcls in
+        (fun b (FCL_aux (FCL_Funcl(id,pat,exp),(_,annot))) ->
+         b || effectful_effs (effect_of_annot annot)) false funcls in
     let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),annot)) =
       let _ = reset_fresh_name_counter () in
       FCL_aux (FCL_Funcl (id,pat,n_exp_term newreturn exp),annot)
@@ -2141,7 +2104,7 @@ let rewrite_defs_effectful_let_expressions =
 
   let alg = { id_exp_alg with e_let = e_let; e_internal_let = e_internal_let } in
   rewrite_defs_base
-    {rewrite_exp = (fun _ _ -> fold_exp alg)
+    {rewrite_exp = (fun _ -> fold_exp alg)
     ; rewrite_pat = rewrite_pat
     ; rewrite_let = rewrite_let
     ; rewrite_lexp = rewrite_lexp
@@ -2198,6 +2161,7 @@ let find_updated_vars exp =
       ; e_case = (fun (e1,pexps) -> e1 @@ lapp2 pexps)
       ; e_let = (fun (lb,e2) -> lb @@ e2)
       ; e_assign = (fun ((ids,acc),e2) -> ([],ids) @@ acc @@ e2)
+      ; e_sizeof = (fun nexp -> ([],[]))
       ; e_exit = (fun e1 -> ([],[]))
       ; e_return = (fun e1 -> e1)
       ; e_assert = (fun (e1,e2) -> ([],[]))
@@ -2220,8 +2184,10 @@ let find_updated_vars exp =
       ; lEXP_field = (fun ((ids,acc),_) -> (None,ids,acc))
       ; lEXP_aux =
           (function
-            | ((Some id,ids,acc),((_,Base (_,(Emp_set | Emp_intro),_,_,_,_)) as annot)) ->
-               ((id,annot) :: ids,acc)
+            | ((Some id,ids,acc),(annot)) ->
+               (match Env.lookup_id id (env_of_annot annot) with
+               | Unbound | Local _ -> ((id,annot) :: ids,acc)
+               | _ -> (ids,acc))
             | ((_,ids,acc),_) -> (ids,acc)
           )
       ; fE_Fexp = (fun (_,e) -> e)
@@ -2240,29 +2206,33 @@ let find_updated_vars exp =
       } exp in
   dedup eqidtyp updates
 
-let swaptyp t (l,(Base ((t_params,_),tag,nexps,eff,effsum,bounds))) = 
-  (l,Base ((t_params,t),tag,nexps,eff,effsum,bounds))
+let swaptyp typ (l,tannot) = match tannot with
+  | Some (env, typ', eff) -> (l, Some (env, typ, eff))
+  | _ -> raise (Reporting_basic.err_unreachable l "swaptyp called with empty type annotation")
 
 let mktup l es =
   match es with
-  | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(Parse_ast.Generated l,simple_annot unit_t))
+  | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(simple_annot l unit_typ))
   | [e] -> e
-  | _ -> 
+  | e :: _ -> 
      let effs =
-       List.fold_left (fun acc e -> union_effects acc (get_effsum_exp e)) {effect = Eset []} es in
-     let typs = List.map get_type es in
-     E_aux (E_tuple es,(Parse_ast.Generated l,simple_annot_efr {t = Ttup typs} effs))
+       List.fold_left (fun acc e -> union_effects acc (effect_of e)) no_effect es in
+     let typ = mk_typ (Typ_tup (List.map typ_of es)) in
+     E_aux (E_tuple es,(Parse_ast.Generated l, Some (env_of e, typ, effs)))
 
 let mktup_pat l es =
   match es with
-  | [] -> P_aux (P_wild,(Parse_ast.Generated l,simple_annot unit_t))
+  | [] -> P_aux (P_wild,(simple_annot l unit_typ))
   | [E_aux (E_id id,_) as exp] ->
-     P_aux (P_id id,(Parse_ast.Generated l,simple_annot (get_type exp)))
+     P_aux (P_id id,(simple_annot l (typ_of exp)))
   | _ ->
-     let typs = List.map get_type es in
-     let pats = List.map (fun (E_aux (E_id id,_) as exp) ->
-                    P_aux (P_id id,(Parse_ast.Generated l,simple_annot (get_type exp)))) es in
-     P_aux (P_tup pats,(Parse_ast.Generated l,simple_annot {t = Ttup typs}))
+     let typ = mk_typ (Typ_tup (List.map typ_of es)) in
+     let pats = List.map (function
+       | (E_aux (E_id id,_) as exp) ->
+         P_aux (P_id id,(simple_annot l (typ_of exp)))
+       | exp ->
+         P_aux (P_wild,(simple_annot l (typ_of exp)))) es in
+     P_aux (P_tup pats,(simple_annot l typ))
 
 
 type 'a updated_term =
@@ -2275,36 +2245,48 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
     match expaux with
     | E_let (lb,exp) ->
        let exp = add_vars overwrite exp vars in
-       E_aux (E_let (lb,exp),swaptyp (get_type exp) annot)
+       E_aux (E_let (lb,exp),swaptyp (typ_of exp) annot)
     | E_internal_let (lexp,exp1,exp2) ->
        let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_let (lexp,exp1,exp2), swaptyp (get_type exp2) annot)
+       E_aux (E_internal_let (lexp,exp1,exp2), swaptyp (typ_of exp2) annot)
     | E_internal_plet (pat,exp1,exp2) ->
        let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_plet (pat,exp1,exp2), swaptyp (get_type exp2) annot)
+       E_aux (E_internal_plet (pat,exp1,exp2), swaptyp (typ_of exp2) annot)
     | E_internal_return exp2 ->
        let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_return exp2,swaptyp (get_type exp2) annot)
+       E_aux (E_internal_return exp2,swaptyp (typ_of exp2) annot)
     | _ ->
        (* after rewrite_defs_letbind_effects there cannot be terms that have
           effects/update local variables in "tail-position": check n_exp_term
           and where it is used. *)
        if overwrite then
-         let () = if get_type exp = {t = Tid "unit"} then ()
-                  else failwith "nono" in
-         vars
+         match typ_of exp with
+         | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> vars
+         | _ -> raise (Reporting_basic.err_unreachable l
+             "add_vars: trying to overwrite a non-unit expression in tail-position")
        else
-         E_aux (E_tuple [exp;vars],swaptyp {t = Ttup [get_type exp;get_type vars]} annot) in
+         let typ' = Typ_aux (Typ_tup [typ_of exp;typ_of vars], Parse_ast.Generated l) in
+         E_aux (E_tuple [exp;vars],swaptyp typ' annot) in
   
   let rewrite (E_aux (expaux,((el,_) as annot))) (P_aux (_,(pl,pannot)) as pat) =
-    let overwrite = match get_type_annot annot with
-      | {t = Tid "unit"} -> true
+    let overwrite = match typ_of_annot annot with
+      | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> true
       | _ -> false in
     match expaux with
     | E_for(id,exp1,exp2,exp3,order,exp4) ->
+       (* Translate for loops into calls to one of the foreach combinators.
+          The loop body becomes a function of the loop variable and any
+          mutable local variables that are updated inside the loop.
+          Since the foreach* combinators are higher-order functions,
+          they cannot be represented faithfully in the AST. The following
+          code abuses the parameters of an E_app node, embedding the loop body
+          function as an expression followed by the list of variables it
+          expects. In (Lem) pretty-printing, this turned into an anonymous
+          function and passed to foreach*. *)
        let vars = List.map (fun (var,(l,t)) -> E_aux (E_id var,(l,t))) (find_updated_vars exp4) in
        let vartuple = mktup el vars in
        let exp4 = rewrite_var_updates (add_vars overwrite exp4 vartuple) in
+       let (E_aux (_,(_,annot4))) = exp4 in
        let fname = match effectful exp4,order with
          | false, Ord_aux (Ord_inc,_) -> "foreach_inc"
          | false, Ord_aux (Ord_dec,_) -> "foreach_dec"
@@ -2312,13 +2294,15 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          | true,  Ord_aux (Ord_dec,_) -> "foreachM_dec" in
        let funcl = Id_aux (Id fname,Parse_ast.Generated el) in
        let loopvar =
-         let (bf,tf) = match get_type exp1 with
+         (* Don't bother with creating a range type annotation, since the
+         Lem pretty-printing does not use it. *)
+         (* let (bf,tf) = match typ_of exp1 with
            | {t = Tapp ("atom",[TA_nexp f])} -> (TA_nexp f,TA_nexp f)
            | {t = Tapp ("reg", [TA_typ {t = Tapp ("atom",[TA_nexp f])}])} -> (TA_nexp f,TA_nexp f)
            | {t = Tapp ("range",[TA_nexp bf;TA_nexp tf])} -> (TA_nexp bf,TA_nexp tf)
            | {t = Tapp ("reg", [TA_typ {t = Tapp ("range",[TA_nexp bf;TA_nexp tf])}])} -> (TA_nexp bf,TA_nexp tf)
            | {t = Tapp (name,_)} -> failwith (name ^ " shouldn't be here") in
-         let (bt,tt) = match get_type exp2 with
+         let (bt,tt) = match typ_of exp2 with
            | {t = Tapp ("atom",[TA_nexp t])} -> (TA_nexp t,TA_nexp t)
            | {t = Tapp ("atom",[TA_typ {t = Tapp ("atom", [TA_nexp t])}])} -> (TA_nexp t,TA_nexp t)
            | {t = Tapp ("range",[TA_nexp bt;TA_nexp tt])} -> (TA_nexp bt,TA_nexp tt)
@@ -2326,14 +2310,14 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
            | {t = Tapp (name,_)} -> failwith (name ^ " shouldn't be here") in
          let t = {t = Tapp ("range",match order with
                                     | Ord_aux (Ord_inc,_) -> [bf;tt]
-                                    | Ord_aux (Ord_dec,_) -> [tf;bt])} in
-         E_aux (E_id id,(Parse_ast.Generated el,simple_annot t)) in
+                                    | Ord_aux (Ord_dec,_) -> [tf;bt])} in *)
+         E_aux (E_id id, simple_annot l int_typ) in
        let v = E_aux (E_app (funcl,[loopvar;mktup el [exp1;exp2;exp3];exp4;vartuple]),
-                      (Parse_ast.Generated el,simple_annot_efr (get_type exp4) (get_effsum_exp exp4))) in
+                      (Parse_ast.Generated el, annot4)) in
        let pat =
          if overwrite then mktup_pat el vars
          else P_aux (P_tup [pat; mktup_pat pl vars],
-                     (Parse_ast.Generated pl,simple_annot (get_type v))) in
+                     simple_annot pl (typ_of v)) in
        Added_vars (v,pat)
     | E_if (c,e1,e2) ->
        let vars = List.map (fun (var,(l,t)) -> E_aux (E_id var,(l,t)))
@@ -2345,12 +2329,14 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          let e1 = rewrite_var_updates (add_vars overwrite e1 vartuple) in
          let e2 = rewrite_var_updates (add_vars overwrite e2 vartuple) in
          (* after rewrite_defs_letbind_effects c has no variable updates *)
-         let t = get_type e1 in
-         let v = E_aux (E_if (c,e1,e2), (Parse_ast.Generated el,simple_annot_efr t (eff_union_exps [e1;e2]))) in
+         let env = env_of_annot annot in
+         let typ = typ_of e1 in
+         let eff = union_eff_exps [e1;e2] in
+         let v = E_aux (E_if (c,e1,e2), (Parse_ast.Generated el, Some (env, typ, eff))) in
          let pat =
            if overwrite then mktup_pat el vars
            else P_aux (P_tup [pat; mktup_pat pl vars],
-                       (Parse_ast.Generated pl,simple_annot (get_type v))) in
+                       (simple_annot pl (typ_of v))) in
          Added_vars (v,pat)
     | E_case (e1,ps) ->
        (* after rewrite_defs_letbind_effects e1 needs no rewriting *)
@@ -2365,48 +2351,53 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          let vartuple = mktup el vars in
          let typ = 
            let (Pat_aux (Pat_exp (_,first),_)) = List.hd ps in
-           get_type first in
+           typ_of first in
          let (ps,typ,effs) =
            let f (acc,typ,effs) (Pat_aux (Pat_exp (p,e),pannot)) =
-             let etyp = get_type e in
-             let () = assert (simple_annot etyp = simple_annot typ) in
+             let etyp = typ_of e in
+             let () = assert (string_of_typ etyp = string_of_typ typ) in
              let e = rewrite_var_updates (add_vars overwrite e vartuple) in
-             let pannot = (Parse_ast.Generated pl,simple_annot (get_type e)) in
-             let effs = union_effects effs (get_effsum_exp e) in
+             let pannot = simple_annot pl (typ_of e) in
+             let effs = union_effects effs (effect_of e) in
              let pat' = Pat_aux (Pat_exp (p,e),pannot) in
              (acc @ [pat'],typ,effs) in
-           List.fold_left f ([],typ,{effect = Eset []}) ps in
-         let v = E_aux (E_case (e1,ps), (Parse_ast.Generated pl,simple_annot_efr typ effs)) in
+           List.fold_left f ([],typ,no_effect) ps in
+         let v = E_aux (E_case (e1,ps), (Parse_ast.Generated pl, Some (env_of_annot annot, typ, effs))) in
          let pat =
            if overwrite then mktup_pat el vars
            else P_aux (P_tup [pat; mktup_pat pl vars],
-                       (Parse_ast.Generated pl,simple_annot (get_type v))) in
+                       (simple_annot pl (typ_of v))) in
          Added_vars (v,pat)
     | E_assign (lexp,vexp) ->
-       let {effect = Eset effs} = get_effsum_annot annot in
+       let effs = match effect_of_annot (snd annot) with
+         | Effect_aux (Effect_set effs, _) -> effs
+         | _ ->
+           raise (Reporting_basic.err_unreachable l
+             "assignment without effects annotation") in
        if not (List.exists (function BE_aux (BE_lset,_) -> true | _ -> false) effs) then
          Same_vars (E_aux (E_assign (lexp,vexp),annot))
        else 
          (match lexp with
           | LEXP_aux (LEXP_id id,annot) ->
-             let pat = P_aux (P_id id,(Parse_ast.Generated pl,simple_annot (get_type vexp))) in
+             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
              Added_vars (vexp,pat)
           | LEXP_aux (LEXP_cast (_,id),annot) ->
-             let pat = P_aux (P_id id,(Parse_ast.Generated pl,simple_annot (get_type vexp))) in
+             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
              Added_vars (vexp,pat)
           | LEXP_aux (LEXP_vector (LEXP_aux (LEXP_id id,((l2,_) as annot2)),i),((l1,_) as annot)) ->
-             let eid = E_aux (E_id id,(Parse_ast.Generated l2,simple_annot (get_type_annot annot2))) in
+             let eid = E_aux (E_id id, simple_annot l2 (typ_of_annot annot2)) in
              let vexp = E_aux (E_vector_update (eid,i,vexp),
-                               (Parse_ast.Generated l1,simple_annot (get_type_annot annot))) in
-             let pat = P_aux (P_id id,(Parse_ast.Generated pl,simple_annot (get_type vexp))) in
+                               simple_annot l1 (typ_of_annot annot)) in
+             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
              Added_vars (vexp,pat)
           | LEXP_aux (LEXP_vector_range (LEXP_aux (LEXP_id id,((l2,_) as annot2)),i,j),
                       ((l,_) as annot)) -> 
-             let eid = E_aux (E_id id,(Parse_ast.Generated l2,simple_annot (get_type_annot annot2))) in
+             let eid = E_aux (E_id id, simple_annot l2 (typ_of_annot annot2)) in
              let vexp = E_aux (E_vector_update_subrange (eid,i,j,vexp),
-                               (Parse_ast.Generated l,simple_annot (get_type_annot annot))) in
-             let pat = P_aux (P_id id,(Parse_ast.Generated pl,simple_annot (get_type vexp))) in
-             Added_vars (vexp,pat))
+                               simple_annot l (typ_of_annot annot)) in
+             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
+             Added_vars (vexp,pat)
+          | _ -> raise (Reporting_basic.err_unreachable el "Unsupported l-exp"))
     | _ ->
        (* after rewrite_defs_letbind_effects this expression is pure and updates
        no variables: check n_exp_term and where it's used. *)
@@ -2420,27 +2411,33 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
           (match rewrite v pat with
            | Added_vars (v,pat) ->
               let (E_aux (_,(l,_))) = v in
-              let lbannot = (Parse_ast.Generated l,simple_annot (get_type v)) in
-              (get_effsum_exp v,LB_aux (LB_val_implicit (pat,v),lbannot))
-           | Same_vars v -> (get_effsum_exp v,LB_aux (LB_val_implicit (pat,v),lbannot)))
+              let lbannot = (simple_annot l (typ_of v)) in
+              (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot))
+           | Same_vars v -> (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot)))
        | LB_aux (LB_val_explicit (typ,pat,v),lbannot) ->
           (match rewrite v pat with 
            | Added_vars (v,pat) ->
               let (E_aux (_,(l,_))) = v in
-              let lbannot = (Parse_ast.Generated l,simple_annot (get_type v)) in
-              (get_effsum_exp v,LB_aux (LB_val_implicit (pat,v),lbannot))
-           | Same_vars v -> (get_effsum_exp v,LB_aux (LB_val_explicit (typ,pat,v),lbannot))) in
-     let typ = simple_annot_efr (get_type body) (union_effects eff (get_effsum_exp body)) in
-     E_aux (E_let (lb,body),(Parse_ast.Generated l,typ))
+              let lbannot = (simple_annot l (typ_of v)) in
+              (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot))
+           | Same_vars v -> (effect_of v,LB_aux (LB_val_explicit (typ,pat,v),lbannot))) in
+     let tannot = Some (env_of_annot annot, typ_of body, union_effects eff (effect_of body)) in
+     E_aux (E_let (lb,body),(Parse_ast.Generated l,tannot))
   | E_internal_let (lexp,v,body) ->
      (* Rewrite E_internal_let into E_let and call recursively *)
      let id = match lexp with
        | LEXP_aux (LEXP_id id,_) -> id
        | LEXP_aux (LEXP_cast (_,id),_) -> id in
-     let pat = P_aux (P_id id, (Parse_ast.Generated l,simple_annot (get_type v))) in
-     let lbannot = (Parse_ast.Generated l,simple_annot_efr (get_type v) (get_effsum_exp v)) in
+     let env = env_of_annot annot in
+     let vtyp = typ_of v in
+     let veff = effect_of v in
+     let bodyenv = env_of body in
+     let bodytyp = typ_of body in
+     let bodyeff = effect_of body in
+     let pat = P_aux (P_id id, (simple_annot l vtyp)) in
+     let lbannot = (Parse_ast.Generated l, Some (env, vtyp, veff)) in
      let lb = LB_aux (LB_val_implicit (pat,v),lbannot) in
-     let exp = E_aux (E_let (lb,body),(Parse_ast.Generated l,simple_annot_efr (get_type body) (eff_union_exps [v;body]))) in
+     let exp = E_aux (E_let (lb,body),(Parse_ast.Generated l, Some (bodyenv, bodytyp, union_effects veff bodyeff))) in
      rewrite_var_updates exp
   | E_internal_plet (pat,v,body) ->
      failwith "rewrite_var_updates: E_internal_plet shouldn't be introduced yet"
@@ -2459,42 +2456,23 @@ let replace_memwrite_e_assign exp =
 
 let remove_reference_types exp =
 
-  let rec rewrite_t {t = t_aux} = {t = rewrite_t_aux t_aux}
+  let rec rewrite_t (Typ_aux (t_aux,a)) = (Typ_aux (rewrite_t_aux t_aux,a))
   and rewrite_t_aux t_aux = match t_aux with
-    | Tapp ("reg",[TA_typ {t = t_aux2}]) -> rewrite_t_aux t_aux2
-    | Tapp (name,t_args) -> Tapp (name,List.map rewrite_t_arg t_args)
-    | Tfn (t1,t2,imp,e) -> Tfn (rewrite_t t1,rewrite_t t2,imp,e)
-    | Ttup ts -> Ttup (List.map rewrite_t ts)
-    | Tabbrev (t1,t2) -> Tabbrev (rewrite_t t1,rewrite_t t2)
-    | Toptions (t1,t2) ->
-       let t2 = match t2 with Some t2 -> Some (rewrite_t t2) | None -> None in
-       Toptions (rewrite_t t1,t2)
-    | Tuvar t_uvar -> Tuvar t_uvar (*(rewrite_t_uvar t_uvar) *)
+    | Typ_app (Id_aux (Id "reg",_), [Typ_arg_aux (Typ_arg_typ (Typ_aux (t_aux2, _)), _)]) ->
+      rewrite_t_aux t_aux2
+    | Typ_app (name,t_args) -> Typ_app (name,List.map rewrite_t_arg t_args)
+    | Typ_fn (t1,t2,eff) -> Typ_fn (rewrite_t t1,rewrite_t t2,eff)
+    | Typ_tup ts -> Typ_tup (List.map rewrite_t ts)
     | _ -> t_aux
-(*  and rewrite_t_uvar t_uvar =
-    t_uvar.subst <- (match t_uvar.subst with None -> None | Some t -> Some (rewrite_t t)) *)
   and rewrite_t_arg t_arg = match t_arg with
-    | TA_typ t -> TA_typ (rewrite_t t)
+    | Typ_arg_aux (Typ_arg_typ t, a) -> Typ_arg_aux (Typ_arg_typ (rewrite_t t), a)
     | _ -> t_arg in
 
   let rec rewrite_annot = function
-    | NoTyp -> NoTyp
-    | Base ((tparams,t),tag,nexprs,effs,effsum,bounds) ->
-       Base ((tparams,rewrite_t t),tag,nexprs,effs,effsum,bounds)
-    | Overload (tannot1,b,tannots) ->
-       Overload (rewrite_annot tannot1,b,List.map rewrite_annot tannots) in
-
-
-  fold_exp
-    { id_exp_alg with 
-      e_aux = (fun (e,(l,annot)) -> E_aux (e,(l,rewrite_annot annot)))
-    ; lEXP_aux = (fun (lexp,(l,annot)) -> LEXP_aux (lexp,(l,rewrite_annot annot)))
-    ; fE_aux = (fun (fexp,(l,annot)) -> FE_aux (fexp,(l,(rewrite_annot annot))))
-    ; fES_aux = (fun (fexp,(l,annot)) -> FES_aux (fexp,(l,rewrite_annot annot)))
-    ; pat_aux = (fun (pexp,(l,annot)) -> Pat_aux (pexp,(l,rewrite_annot annot)))
-    ; lB_aux = (fun (lb,(l,annot)) -> LB_aux (lb,(l,rewrite_annot annot)))
-    }
-    exp
+    | (l, None) -> (l, None)
+    | (l, Some (env, typ, eff)) -> (l, Some (env, rewrite_t typ, eff)) in
+
+  map_exp_annot rewrite_annot exp
 
 
 
@@ -2538,7 +2516,7 @@ let rewrite_defs_remove_superfluous_letbinds =
 
   let alg = { id_exp_alg with e_aux = e_aux } in
   rewrite_defs_base
-    { rewrite_exp = (fun _ _ -> fold_exp alg)
+    { rewrite_exp = (fun _ -> fold_exp alg)
     ; rewrite_pat = rewrite_pat
     ; rewrite_let = rewrite_let
     ; rewrite_lexp = rewrite_lexp
@@ -2550,9 +2528,9 @@ let rewrite_defs_remove_superfluous_letbinds =
 
 let rewrite_defs_remove_superfluous_returns =
 
-  let has_unittype e = 
-    let {t = t} = get_type e in
-    t = Tid "unit" in
+  let has_unittype e = match typ_of e with
+    | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> true
+    | _ -> false in
 
   let e_aux (exp,annot) = match exp with
     | E_internal_plet (pat,exp1,exp2) ->
@@ -2575,7 +2553,7 @@ let rewrite_defs_remove_superfluous_returns =
 
   let alg = { id_exp_alg with e_aux = e_aux } in
   rewrite_defs_base
-    {rewrite_exp = (fun _ _ -> fold_exp alg)
+    {rewrite_exp = (fun _ -> fold_exp alg)
     ; rewrite_pat = rewrite_pat
     ; rewrite_let = rewrite_let
     ; rewrite_lexp = rewrite_lexp
@@ -2586,7 +2564,7 @@ let rewrite_defs_remove_superfluous_returns =
 
 
 let rewrite_defs_remove_e_assign =
-  let rewrite_exp _ _ e =
+  let rewrite_exp _ e =
     replace_memwrite_e_assign (remove_reference_types (rewrite_var_updates e)) in
   rewrite_defs_base
     { rewrite_exp = rewrite_exp
@@ -2599,10 +2577,10 @@ let rewrite_defs_remove_e_assign =
     }
 
 
-let rewrite_defs_lem typ_env =
+let rewrite_defs_lem =
   top_sort_defs >>
   rewrite_defs_remove_vector_concat >>
-  rewrite_defs_remove_bitvector_pats typ_env >>
+  rewrite_defs_remove_bitvector_pats >>
   rewrite_defs_exp_lift_assign >> 
   rewrite_defs_remove_blocks >> 
   rewrite_defs_letbind_effects >> 
diff --git a/src/rewriter.mli b/src/rewriter.mli
index 19ab4aca..584d33fa 100644
--- a/src/rewriter.mli
+++ b/src/rewriter.mli
@@ -9,6 +9,7 @@
 (*    Robert Norton-Wright                                                *)
 (*    Christopher Pulte                                                   *)
 (*    Peter Sewell                                                        *)
+(*    Thomas Bauereiss                                                    *)
 (*                                                                        *)
 (*  All rights reserved.                                                  *)
 (*                                                                        *)
@@ -42,26 +43,21 @@
 
 open Big_int
 open Ast
-open Type_internal
-type typ = Type_internal.t
-type 'a exp = 'a Ast.exp
-type 'a emap = 'a Envmap.t
-type envs = Type_check.envs
-type 'a namemap = (typ * 'a exp) emap
+open Type_check_new
 
-type 'a rewriters = { rewrite_exp  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a exp -> 'a exp;
-                      rewrite_lexp : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a lexp -> 'a lexp;
-                      rewrite_pat  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a pat -> 'a pat;
-                      rewrite_let  : 'a rewriters -> (nexp_map * 'a namemap) option -> 'a letbind -> 'a letbind;
+type 'a rewriters = { rewrite_exp  : 'a rewriters -> 'a exp -> 'a exp;
+                      rewrite_lexp : 'a rewriters -> 'a lexp -> 'a lexp;
+                      rewrite_pat  : 'a rewriters -> 'a pat -> 'a pat;
+                      rewrite_let  : 'a rewriters -> 'a letbind -> 'a letbind;
                       rewrite_fun  : 'a rewriters -> 'a fundef -> 'a fundef;
                       rewrite_def  : 'a rewriters -> 'a def -> 'a def;
                       rewrite_defs : 'a rewriters -> 'a defs -> 'a defs;
                     }
                     
-val rewrite_exp : tannot rewriters -> (nexp_map * tannot namemap) option -> tannot exp -> tannot exp
+val rewrite_exp : tannot rewriters -> tannot exp -> tannot exp
 val rewrite_defs : tannot defs -> tannot defs
 val rewrite_defs_ocaml : tannot defs -> tannot defs (*Perform rewrites to exclude AST nodes not supported for ocaml out*)
-val rewrite_defs_lem : tannot emap -> tannot defs -> tannot defs (*Perform rewrites to exclude AST nodes not supported for lem out*)
+val rewrite_defs_lem : tannot defs -> tannot defs (*Perform rewrites to exclude AST nodes not supported for lem out*)
 
 (* the type of interpretations of pattern-matching expressions *)
 type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
@@ -114,6 +110,7 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
  ; e_case                   : 'exp * 'pexp list -> 'exp_aux
  ; e_let                    : 'letbind * 'exp -> 'exp_aux
  ; e_assign                 : 'lexp * 'exp -> 'exp_aux
+ ; e_sizeof                 : nexp -> 'exp_aux
  ; e_exit                   : 'exp -> 'exp_aux
  ; e_return                 : 'exp -> 'exp_aux
  ; e_assert                 : 'exp * 'exp -> 'exp_aux
diff --git a/src/rewriter_new_tc.ml b/src/rewriter_new_tc.ml
deleted file mode 100644
index 4f842dc5..00000000
--- a/src/rewriter_new_tc.ml
+++ /dev/null
@@ -1,2623 +0,0 @@
-(**************************************************************************)
-(*     Sail                                                               *)
-(*                                                                        *)
-(*  Copyright (c) 2013-2017                                               *)
-(*    Kathyrn Gray                                                        *)
-(*    Shaked Flur                                                         *)
-(*    Stephen Kell                                                        *)
-(*    Gabriel Kerneis                                                     *)
-(*    Robert Norton-Wright                                                *)
-(*    Christopher Pulte                                                   *)
-(*    Peter Sewell                                                        *)
-(*    Thomas Bauereiss                                                    *)
-(*                                                                        *)
-(*  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 Big_int
-open Ast
-open Ast_util
-open Type_check_new
-open Spec_analysis_new_tc
-(*type typ = Type_internal.t
-type 'a exp = 'a Ast.exp
-type 'a emap = 'a Envmap.t
-type envs = Type_check.envs
-type 'a namemap = (typ * 'a exp) emap*)
-
-type 'a rewriters = {
-    rewrite_exp  : 'a rewriters -> 'a exp -> 'a exp;
-    rewrite_lexp : 'a rewriters -> 'a lexp -> 'a lexp;
-    rewrite_pat  : 'a rewriters -> 'a pat -> 'a pat;
-    rewrite_let  : 'a rewriters -> 'a letbind -> 'a letbind;
-    rewrite_fun  : 'a rewriters -> 'a fundef -> 'a fundef;
-    rewrite_def  : 'a rewriters -> 'a def -> 'a def;
-    rewrite_defs : 'a rewriters -> 'a defs -> 'a defs;
-  }
-
-
-let (>>) f g = fun x -> g(f(x))
-
-let env_of_annot = function
-  | (_,Some(env,_,_)) -> env
-  | (l,None) -> Env.empty
-
-let env_of (E_aux (_,a)) = env_of_annot a
-
-(*let typ_of_annot = function
-  | (_,Some(_,typ,_)) -> typ
-  | (l,None) -> raise (Reporting_basic.err_typ l "no type information")
-
-let effect_of_annot = function
-  | (_,Some(_,_,eff)) -> eff
-  | (l,None) -> no_effect
-
-let typ_of (E_aux (_,a)) = typ_of_annot a*)
-let effect_of_fpat (FP_aux (_,(_,a))) = effect_of_annot a
-let effect_of_lexp (LEXP_aux (_,(_,a))) = effect_of_annot a
-let effect_of_fexp (FE_aux (_,(_,a))) = effect_of_annot a
-let effect_of_fexps (FES_aux (FES_Fexps (fexps,_),_)) =
-  List.fold_left union_effects no_effect (List.map effect_of_fexp fexps)
-let effect_of_opt_default (Def_val_aux (_,(_,a))) = effect_of_annot a
-let effect_of_pexp (Pat_aux (_,(_,a))) = effect_of_annot a
-let effect_of_lb (LB_aux (_,(_,a))) = effect_of_annot a
-
-let get_loc_exp (E_aux (_,(l,_))) = l
-
-let simple_annot l typ = (Parse_ast.Generated l, Some (Env.empty, typ, no_effect))
-let simple_num l n = E_aux (
-  E_lit (L_aux (L_num n, Parse_ast.Generated l)),
-  simple_annot (Parse_ast.Generated l)
-    (atom_typ (Nexp_aux (Nexp_constant n, Parse_ast.Generated l))))
-
-let fresh_name_counter = ref 0
-
-let fresh_name () =
-  let current = !fresh_name_counter in
-  let () = fresh_name_counter := (current + 1) in
-  current
-let reset_fresh_name_counter () =
-  fresh_name_counter := 0
-
-let fresh_id pre l =
-  let current = fresh_name () in
-  Id_aux (Id (pre ^ string_of_int current), Parse_ast.Generated l)
-
-let fresh_id_exp pre ((l,annot)) =
-  let id = fresh_id pre l in
-  E_aux (E_id id, (Parse_ast.Generated l, annot))
-
-let fresh_id_pat pre ((l,annot)) =
-  let id = fresh_id pre l in
-  P_aux (P_id id, (Parse_ast.Generated l, annot))
-
-let union_eff_exps es =
-  List.fold_left union_effects no_effect (List.map effect_of es)
-
-let fix_eff_exp (E_aux (e,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match e with
-    | E_block es -> union_eff_exps es
-    | E_nondet es -> union_eff_exps es
-    | E_id _
-    | E_lit _ -> no_effect
-    | E_cast (_,e) -> effect_of e
-    | E_app (_,es)
-    | E_tuple es -> union_eff_exps es
-    | E_app_infix (e1,_,e2) -> union_eff_exps [e1;e2]
-    | E_if (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
-    | E_for (_,e1,e2,e3,_,e4) -> union_eff_exps [e1;e2;e3;e4]
-    | E_vector es -> union_eff_exps es
-    | E_vector_indexed (ies,opt_default) ->
-       let (_,es) = List.split ies in
-       union_effects (effect_of_opt_default opt_default) (union_eff_exps es)
-    | E_vector_access (e1,e2) -> union_eff_exps [e1;e2]
-    | E_vector_subrange (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
-    | E_vector_update (e1,e2,e3) -> union_eff_exps [e1;e2;e3]
-    | E_vector_update_subrange (e1,e2,e3,e4) -> union_eff_exps [e1;e2;e3;e4]
-    | E_vector_append (e1,e2) -> union_eff_exps [e1;e2]
-    | E_list es -> union_eff_exps es
-    | E_cons (e1,e2) -> union_eff_exps [e1;e2]
-    | E_record fexps -> effect_of_fexps fexps
-    | E_record_update(e,fexps) ->
-      union_effects (effect_of e) (effect_of_fexps fexps)
-    | E_field (e,_) -> effect_of e
-    | E_case (e,pexps) ->
-      List.fold_left union_effects (effect_of e) (List.map effect_of_pexp pexps)
-    | E_let (lb,e) -> union_effects (effect_of_lb lb) (effect_of e)
-    | E_assign (lexp,e) -> union_effects (effect_of_lexp lexp) (effect_of e)
-    | E_exit e -> effect_of e
-    | E_return e -> effect_of e
-    | E_sizeof _ | E_sizeof_internal _ -> no_effect
-    | E_assert (c,m) -> no_effect
-    | E_comment _ | E_comment_struc _ -> no_effect
-    | E_internal_cast (_,e) -> effect_of e
-    | E_internal_exp _ -> no_effect
-    | E_internal_exp_user _ -> no_effect
-    | E_internal_let (lexp,e1,e2) ->
-      union_effects (effect_of_lexp lexp)
-        (union_effects (effect_of e1) (effect_of e2))
-    | E_internal_plet (_,e1,e2) -> union_effects (effect_of e1) (effect_of e2)
-    | E_internal_return e1 -> effect_of e1)
-  in
-  E_aux (e, (l, Some (env, typ, effsum)))
-| None ->
-  E_aux (e, (l, None))
-
-let fix_eff_lexp (LEXP_aux (lexp,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match lexp with
-    | LEXP_id _ -> no_effect
-    | LEXP_cast _ -> no_effect
-    | LEXP_memory (_,es) -> union_eff_exps es
-    | LEXP_vector (lexp,e) -> union_effects (effect_of_lexp lexp) (effect_of e)
-    | LEXP_vector_range (lexp,e1,e2) ->
-      union_effects (effect_of_lexp lexp)
-        (union_effects (effect_of e1) (effect_of e2))
-    | LEXP_field (lexp,_) -> effect_of_lexp lexp) in
-  LEXP_aux (lexp, (l, Some (env, typ, effsum)))
-| None ->
-  LEXP_aux (lexp, (l, None))
-
-let fix_eff_fexp (FE_aux (fexp,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match fexp with
-    | FE_Fexp (_,e) -> effect_of e) in
-  FE_aux (fexp, (l, Some (env, typ, effsum)))
-| None ->
-  FE_aux (fexp, (l, None))
-
-let fix_eff_fexps fexps = fexps (* FES_aux have no effect information *)
-
-let fix_eff_opt_default (Def_val_aux (opt_default,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match opt_default with
-    | Def_val_empty -> no_effect
-    | Def_val_dec e -> effect_of e) in
-  Def_val_aux (opt_default, (l, Some (env, typ, effsum)))
-| None ->
-  Def_val_aux (opt_default, (l, None))
-
-let fix_eff_pexp (Pat_aux (pexp,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match pexp with
-    | Pat_exp (_,e) -> effect_of e) in
-  Pat_aux (pexp, (l, Some (env, typ, effsum)))
-| None ->
-  Pat_aux (pexp, (l, None))
-
-let fix_eff_lb (LB_aux (lb,((l,_) as annot))) = match snd annot with
-| Some (env, typ, eff) ->
-  let effsum = union_effects eff (match lb with
-    | LB_val_explicit (_,_,e) -> effect_of e
-    | LB_val_implicit (_,e) -> effect_of e) in
-  LB_aux (lb, (l, Some (env, typ, effsum)))
-| None ->
-  LB_aux (lb, (l, None))
-
-let effectful_effs = function
-  | Effect_aux (Effect_set effs, _) ->
-    List.exists
-      (fun (BE_aux (be,_)) ->
-       match be with
-       | BE_nondet | BE_unspec | BE_undef | BE_lset -> false
-       | _ -> true
-      ) effs
-  | _ -> true
-
-let effectful eaux = effectful_effs (effect_of eaux)
-
-let updates_vars_effs = function
-  | Effect_aux (Effect_set effs, _) ->
-    List.exists
-      (fun (BE_aux (be,_)) ->
-       match be with
-       | BE_lset -> true
-       | _ -> false
-      ) effs
-  | _ -> true
-
-let updates_vars eaux = updates_vars_effs (effect_of eaux)
-
-let id_to_string (Id_aux(id,l)) =
-  match id with
-    | Id(s) -> s
-    | DeIid(s) -> s
-
-
-(*let rec partial_assoc (eq: 'a -> 'a -> bool) (v: 'a) (ls : ('a *'b) list ) : 'b option  = match ls with
-  | [] -> None
-  | (v1,v2)::ls -> if (eq v1 v) then Some v2 else partial_assoc eq v ls
-
-let mk_atom_typ i = {t=Tapp("atom",[TA_nexp i])}
-
-let simple_num l n : tannot exp =
-  let typ = simple_annot (mk_atom_typ (mk_c (big_int_of_int n))) in
-  E_aux (E_lit (L_aux (L_num n,l)), (l,typ))
-
-let rec rewrite_nexp_to_exp program_vars l nexp = 
-  let rewrite n = rewrite_nexp_to_exp program_vars l n in
-  let typ = mk_atom_typ nexp in
-  let actual_rewrite_n nexp = 
-    match nexp.nexp with
-      | Nconst i -> E_aux (E_lit (L_aux (L_num (int_of_big_int i),l)), (l,simple_annot typ))
-      | Nadd (n1,n2) -> E_aux (E_app_infix (rewrite n1,(Id_aux (Id "+",l)),rewrite n2),
-                               (l, (tag_annot typ (External (Some "add")))))
-      | Nmult (n1,n2) -> E_aux (E_app_infix (rewrite n1,(Id_aux (Id "*",l)),rewrite n2),
-                                (l, tag_annot typ (External (Some "multiply"))))
-      | Nsub (n1,n2) -> E_aux (E_app_infix (rewrite n1,(Id_aux (Id "-",l)),rewrite n2),
-                               (l, tag_annot typ (External (Some "minus"))))
-      | N2n (n, _) -> E_aux (E_app_infix (E_aux (E_lit (L_aux (L_num 2,l)), (l, simple_annot (mk_atom_typ n_two))),
-                                          (Id_aux (Id "**",l)),
-                                          rewrite n), (l, tag_annot typ (External (Some "power"))))
-      | Npow(n,i) -> E_aux (E_app_infix 
-                              (rewrite n, (Id_aux (Id "**",l)),
-                               E_aux (E_lit (L_aux (L_num i,l)),
-                                      (l, simple_annot (mk_atom_typ (mk_c_int i))))),
-                            (l, tag_annot typ (External (Some "power"))))
-      | Nneg(n) -> E_aux (E_app_infix (E_aux (E_lit (L_aux (L_num 0,l)), (l, simple_annot (mk_atom_typ n_zero))),
-                                       (Id_aux (Id "-",l)),
-                                       rewrite n),
-                          (l, tag_annot typ (External (Some "minus"))))
-      | Nvar v -> (*TODO these need to generate an error as it's a place where there's insufficient specification. 
-                    But, for now I need to permit this to make power.sail compile, and most errors are in trap 
-                    or vectors *)
-              (*let _ = Printf.eprintf "unbound variable here %s\n" v in*) 
-        E_aux (E_id (Id_aux (Id v,l)),(l,simple_annot typ))
-      | _ -> raise (Reporting_basic.err_unreachable l ("rewrite_nexp given n that can't be rewritten: " ^ (n_to_string nexp))) in
-  match program_vars with
-    | None -> actual_rewrite_n nexp
-    | Some program_vars ->
-      (match partial_assoc nexp_eq_check nexp program_vars with
-        | None -> actual_rewrite_n nexp
-        | Some(None,ev) ->
-          (*let _ = Printf.eprintf "var case of rewrite, %s\n" ev in*)
-          E_aux (E_id (Id_aux (Id ev,l)), (l, simple_annot typ))
-        | Some(Some f,ev) -> 
-          E_aux (E_app ((Id_aux (Id f,l)), [ (E_aux (E_id (Id_aux (Id ev,l)), (l,simple_annot typ)))]),
-                 (l, tag_annot typ (External (Some f)))))
-
-let rec match_to_program_vars ns bounds =
-  match ns with
-    | [] -> []
-    | n::ns -> match find_var_from_nexp n bounds with
-        | None -> match_to_program_vars ns bounds
-        | Some(augment,ev) -> 
-          (*let _ = Printf.eprintf "adding n %s to program var %s\n" (n_to_string n) ev in*)
-          (n,(augment,ev))::(match_to_program_vars ns bounds)*)
-
-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_basic.err_unreachable l "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 s_hex)))
-    | L_bin s_bin -> explode s_bin
-    | _ -> raise (Reporting_basic.err_unreachable l "s_bin given non vector literal") in
-
-  List.map (function '0' -> L_aux (L_zero, Parse_ast.Generated l)
-                   | '1' -> L_aux (L_one,Parse_ast.Generated l)
-                   | _ -> raise (Reporting_basic.err_unreachable (Parse_ast.Generated l) "binary had non-zero or one")) s_bin
-
-let rewrite_pat rewriters (P_aux (pat,(l,annot))) =
-  let rewrap p = P_aux (p,(l,annot)) in
-  let rewrite = rewriters.rewrite_pat rewriters in
-  match pat with
-  | P_lit (L_aux ((L_hex _ | L_bin _) as lit,_)) ->
-    let ps =  List.map (fun p -> P_aux (P_lit p, simple_annot l bit_typ))
-        (vector_string_to_bit_list l lit) in
-    rewrap (P_vector ps)
-  | P_lit _ | P_wild | P_id _ -> rewrap pat
-  | P_as(pat,id) -> rewrap (P_as( rewrite pat, id))
-  | P_typ(typ,pat) -> rewrite pat
-  | P_app(id ,pats) -> rewrap (P_app(id, List.map rewrite pats))
-  | P_record(fpats,_) ->
-    rewrap (P_record(List.map (fun (FP_aux(FP_Fpat(id,pat),pannot)) -> FP_aux(FP_Fpat(id, rewrite pat), pannot)) fpats,
-                     false))
-  | P_vector pats -> rewrap (P_vector(List.map rewrite pats))
-  | P_vector_indexed ipats -> rewrap (P_vector_indexed(List.map (fun (i,pat) -> (i, rewrite pat)) ipats))
-  | P_vector_concat pats -> rewrap (P_vector_concat (List.map rewrite pats))
-  | P_tup pats -> rewrap (P_tup (List.map rewrite pats))
-  | P_list pats -> rewrap (P_list (List.map rewrite pats))
-
-let rewrite_exp rewriters (E_aux (exp,(l,annot))) = 
-  let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite = rewriters.rewrite_exp rewriters in
-  match exp with
-  | E_comment _ | E_comment_struc _ -> rewrap exp
-  | E_block exps -> rewrap (E_block (List.map rewrite exps))
-  | E_nondet exps -> rewrap (E_nondet (List.map rewrite exps))
-  | E_lit (L_aux ((L_hex _ | L_bin _) as lit,_)) ->
-    let es = List.map (fun p -> E_aux (E_lit p, simple_annot l bit_typ))
-        (vector_string_to_bit_list l lit) in
-    rewrap (E_vector es)
-  | E_id _ | E_lit _  -> rewrap exp
-  | E_cast (typ, exp) -> rewrap (E_cast (typ, rewrite exp))
-  | E_app (id,exps) -> rewrap (E_app (id,List.map rewrite exps))
-  | E_app_infix(el,id,er) -> rewrap (E_app_infix(rewrite el,id,rewrite er))
-  | E_tuple exps -> rewrap (E_tuple (List.map rewrite exps))
-  | E_if (c,t,e) -> rewrap (E_if (rewrite c,rewrite t, rewrite e))
-  | E_for (id, e1, e2, e3, o, body) ->
-    rewrap (E_for (id, rewrite e1, rewrite e2, rewrite e3, o, rewrite body))
-  | E_vector exps -> rewrap (E_vector (List.map rewrite exps))
-  | E_vector_indexed (exps,(Def_val_aux(default,dannot))) ->
-    let def = match default with
-      | Def_val_empty -> default
-      | Def_val_dec e -> Def_val_dec (rewrite e) in
-    rewrap (E_vector_indexed (List.map (fun (i,e) -> (i, rewrite e)) exps, Def_val_aux(def,dannot)))
-  | E_vector_access (vec,index) -> rewrap (E_vector_access (rewrite vec,rewrite index))
-  | E_vector_subrange (vec,i1,i2) ->
-    rewrap (E_vector_subrange (rewrite vec,rewrite i1,rewrite i2))
-  | E_vector_update (vec,index,new_v) -> 
-    rewrap (E_vector_update (rewrite vec,rewrite index,rewrite new_v))
-  | E_vector_update_subrange (vec,i1,i2,new_v) ->
-    rewrap (E_vector_update_subrange (rewrite vec,rewrite i1,rewrite i2,rewrite new_v))
-  | E_vector_append (v1,v2) -> rewrap (E_vector_append (rewrite v1,rewrite v2))
-  | E_list exps -> rewrap (E_list (List.map rewrite exps)) 
-  | E_cons(h,t) -> rewrap (E_cons (rewrite h,rewrite t))
-  | E_record (FES_aux (FES_Fexps(fexps, bool),fannot)) -> 
-    rewrap (E_record 
-              (FES_aux (FES_Fexps 
-                          (List.map (fun (FE_aux(FE_Fexp(id,e),fannot)) -> 
-                               FE_aux(FE_Fexp(id,rewrite e),fannot)) fexps, bool), fannot)))
-  | E_record_update (re,(FES_aux (FES_Fexps(fexps, bool),fannot))) ->
-    rewrap (E_record_update ((rewrite re),
-                             (FES_aux (FES_Fexps 
-                                         (List.map (fun (FE_aux(FE_Fexp(id,e),fannot)) -> 
-                                              FE_aux(FE_Fexp(id,rewrite e),fannot)) fexps, bool), fannot))))
-  | E_field(exp,id) -> rewrap (E_field(rewrite exp,id))
-  | E_case (exp ,pexps) -> 
-    rewrap (E_case (rewrite exp,
-                    (List.map 
-                       (fun (Pat_aux (Pat_exp(p,e),pannot)) -> 
-                          Pat_aux (Pat_exp(rewriters.rewrite_pat rewriters p,rewrite e),pannot)) pexps)))
-  | E_let (letbind,body) -> rewrap (E_let(rewriters.rewrite_let rewriters letbind,rewrite body))
-  | E_assign (lexp,exp) -> rewrap (E_assign(rewriters.rewrite_lexp rewriters lexp,rewrite exp))
-  | E_sizeof n -> rewrap (E_sizeof n)
-  | E_exit e -> rewrap (E_exit (rewrite e))
-  | E_return e -> rewrap (E_return (rewrite e))
-  | E_assert(e1,e2) -> rewrap (E_assert(rewrite e1,rewrite e2))
-  | E_internal_cast (casted_annot,exp) ->
-    rewrap (E_internal_cast (casted_annot, rewrite exp))
-    (* check_exp (env_of exp) (strip_exp exp) (typ_of_annot casted_annot) *)
-    (*let new_exp = rewrite exp in
-    (*let _ = Printf.eprintf "Removing an internal_cast with %s\n" (tannot_to_string casted_annot) in*)
-    (match casted_annot,exp with
-     | Base((_,t),_,_,_,_,_),E_aux(ec,(ecl,Base((_,exp_t),_,_,_,_,_))) ->
-       (*let _ = Printf.eprintf "Considering removing an internal cast where the two types are %s and %s\n" 
-         (t_to_string t) (t_to_string exp_t) in*)
-       (match t.t,exp_t.t with
-        (*TODO should pass d_env into here so that I can look at the abbreviations if there are any here*)
-        | Tapp("vector",[TA_nexp n1;TA_nexp nw1;TA_ord o1;_]),
-          Tapp("vector",[TA_nexp n2;TA_nexp nw2;TA_ord o2;_]) 
-        | Tapp("vector",[TA_nexp n1;TA_nexp nw1;TA_ord o1;_]),
-          Tapp("reg",[TA_typ {t=(Tapp("vector",[TA_nexp n2; TA_nexp nw2; TA_ord o2;_]))}]) ->
-          (match n1.nexp with
-           | Nconst i1 -> if nexp_eq n1 n2 then new_exp else rewrap (E_cast (t_to_typ t,new_exp))
-           | _ -> (match o1.order with
-               | Odec -> 
-                 (*let _ = Printf.eprintf "Considering removing a cast or not: %s %s, %b\n" 
-                     (n_to_string nw1) (n_to_string n1) (nexp_one_more_than nw1 n1) in*)
-                 rewrap (E_cast (Typ_aux (Typ_var (Kid_aux((Var "length"),Parse_ast.Generated l)),
-                                          Parse_ast.Generated l),new_exp))
-               | _ -> new_exp))
-        | _ -> new_exp
-     | Base((_,t),_,_,_,_,_),_ ->
-       (*let _ = Printf.eprintf "Considering removing an internal cast where the remaining type is %s\n%!"
-            (t_to_string t) in*)
-       (match t.t with
-        | Tapp("vector",[TA_nexp n1;TA_nexp nw1;TA_ord o1;_]) ->
-          (match o1.order with
-           | Odec -> 
-             let _ = Printf.eprintf "Considering removing a cast or not: %s %s, %b\n" 
-                 (n_to_string nw1) (n_to_string n1) (nexp_one_more_than nw1 n1) in
-             rewrap (E_cast (Typ_aux (Typ_var (Kid_aux((Var "length"), Parse_ast.Generated l)),
-                                      Parse_ast.Generated l), new_exp))
-           | _ -> new_exp)
-        | _ -> new_exp)
-     | _ -> (*let _ = Printf.eprintf "Not a base match?\n" in*) new_exp*)
-  (*| E_internal_exp (l,impl) ->
-    match impl with
-     | Base((_,t),_,_,_,_,bounds) ->
-       (*let _ = Printf.eprintf "Rewriting internal expression, with type %s, and bounds %s\n" 
-         (t_to_string t) (bounds_to_string bounds) in*)
-       let bounds = match nmap with | None -> bounds | Some (nm,_) -> add_map_to_bounds nm bounds in
-       (*let _ = Printf.eprintf "Bounds after looking at nmap %s\n" (bounds_to_string bounds) in*)
-       (match t.t with
-        (*Old case; should possibly be removed*)
-        | Tapp("register",[TA_typ {t= Tapp("vector",[ _; TA_nexp r;_;_])}])
-        | Tapp("vector", [_;TA_nexp r;_;_])
-        | Tabbrev(_, {t=Tapp("vector",[_;TA_nexp r;_;_])}) ->
-          (*let _ = Printf.eprintf "vector case with %s, bounds are %s\n" 
-                (n_to_string r) (bounds_to_string bounds) in*)
-          let nexps = expand_nexp r in
-          (match (match_to_program_vars nexps bounds) with
-           | [] -> rewrite_nexp_to_exp None l r
-           | map -> rewrite_nexp_to_exp (Some map) l r)
-        | Tapp("implicit", [TA_nexp i]) ->
-          (*let _ = Printf.eprintf "Implicit case with %s\n" (n_to_string i) in*)
-          let nexps = expand_nexp i in
-          (match (match_to_program_vars nexps bounds) with
-           | [] -> rewrite_nexp_to_exp None l i
-           | map -> rewrite_nexp_to_exp (Some map) l i)
-        | _ -> 
-          raise (Reporting_basic.err_unreachable l 
-                   ("Internal_exp given unexpected types " ^ (t_to_string t))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp given none Base annot"))*)
-  (*| E_sizeof_internal (l,impl) ->
-    (match impl with
-     | Base((_,t),_,_,_,_,bounds) ->
-       let bounds = match nmap with | None -> bounds | Some (nm,_) -> add_map_to_bounds nm bounds in
-       (match t.t with
-        | Tapp("atom",[TA_nexp n]) ->
-          let nexps = expand_nexp n in
-          (*let _ = Printf.eprintf "Removing sizeof_internal with type %s\n" (t_to_string t) in*)
-          (match (match_to_program_vars nexps bounds) with
-           | [] -> rewrite_nexp_to_exp None l n
-           | map -> rewrite_nexp_to_exp (Some map) l n)
-        | _ -> raise (Reporting_basic.err_unreachable l ("Sizeof internal had non-atom type " ^ (t_to_string t))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Sizeof internal had none base annot"))*)
-  (*| E_internal_exp_user ((l,user_spec),(_,impl)) -> 
-    (match (user_spec,impl) with
-     | (Base((_,tu),_,_,_,_,_), Base((_,ti),_,_,_,_,bounds)) ->
-       (*let _ = Printf.eprintf "E_interal_user getting rewritten two types are %s and %s\n"
-            (t_to_string tu) (t_to_string ti) in*)
-       let bounds =  match nmap with | None -> bounds | Some (nm,_) -> add_map_to_bounds nm bounds in
-       (match (tu.t,ti.t) with
-        | (Tapp("implicit", [TA_nexp u]),Tapp("implicit",[TA_nexp i])) ->
-          (*let _ = Printf.eprintf "Implicit case with %s\n" (n_to_string i) in*)
-          let nexps = expand_nexp i in
-          (match (match_to_program_vars nexps bounds) with
-           | [] -> rewrite_nexp_to_exp None l i
-           (*add u to program_vars env; for now it will work out properly by accident*)
-           | map -> rewrite_nexp_to_exp (Some map) l i)
-        | _ -> 
-          raise (Reporting_basic.err_unreachable l 
-                   ("Internal_exp_user given unexpected types " ^ (t_to_string tu) ^ ", " ^ (t_to_string ti))))
-     | _ -> raise (Reporting_basic.err_unreachable l ("Internal_exp_user given none Base annot")))*)
-  | E_internal_let _ -> raise (Reporting_basic.err_unreachable l "Internal let found before it should have been introduced")
-  | E_internal_return _ -> raise (Reporting_basic.err_unreachable l "Internal return found before it should have been introduced")
-  | E_internal_plet _ -> raise (Reporting_basic.err_unreachable l " Internal plet found before it should have been introduced")
-  | _ -> rewrap exp
-                           
-let rewrite_let rewriters (LB_aux(letbind,(l,annot))) =
-  (*let local_map = get_map_tannot annot in
-  let map =
-    match map,local_map with
-    | None,None -> None
-    | None,Some m -> Some(m, Envmap.empty)
-    | Some(m,s), None -> Some(m,s)
-    | Some(m,s), Some m' -> match merge_option_maps (Some m) local_map with
-      | None -> Some(m,s) (*Shouldn't happen*)
-      | Some new_m -> Some(new_m,s) in*)
-  match letbind with
-  | LB_val_explicit (typschm, pat,exp) ->
-    LB_aux(LB_val_explicit (typschm,rewriters.rewrite_pat rewriters pat,
-                            rewriters.rewrite_exp rewriters exp),(l,annot))
-  | LB_val_implicit ( pat, exp) ->
-    LB_aux(LB_val_implicit (rewriters.rewrite_pat rewriters pat,
-                            rewriters.rewrite_exp rewriters exp),(l,annot))
-
-let rewrite_lexp rewriters (LEXP_aux(lexp,(l,annot))) = 
-  let rewrap le = LEXP_aux(le,(l,annot)) in
-  match lexp with
-  | LEXP_id _ | LEXP_cast _ -> rewrap lexp
-  | LEXP_tup tupls -> rewrap (LEXP_tup (List.map (rewriters.rewrite_lexp rewriters) tupls))
-  | LEXP_memory (id,exps) -> rewrap (LEXP_memory(id,List.map (rewriters.rewrite_exp rewriters) exps))
-  | LEXP_vector (lexp,exp) ->
-    rewrap (LEXP_vector (rewriters.rewrite_lexp rewriters lexp,rewriters.rewrite_exp rewriters exp))
-  | LEXP_vector_range (lexp,exp1,exp2) -> 
-    rewrap (LEXP_vector_range (rewriters.rewrite_lexp rewriters lexp,
-                               rewriters.rewrite_exp rewriters exp1,
-                               rewriters.rewrite_exp rewriters exp2))
-  | LEXP_field (lexp,id) -> rewrap (LEXP_field (rewriters.rewrite_lexp rewriters lexp,id))
-
-let rewrite_fun rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) = 
-  let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),(l,annot))) =
-    let _ = reset_fresh_name_counter () in
-    (*let _ = Printf.eprintf "Rewriting function %s, pattern %s\n" 
-      (match id with (Id_aux (Id i,_)) -> i) (Pretty_print.pat_to_string pat) in*)
-  (*let map = get_map_tannot fdannot in
-  let map =
-    match map with
-    | None -> None
-    | Some m -> Some(m, Envmap.empty) in*)
-  (FCL_aux (FCL_Funcl (id,rewriters.rewrite_pat rewriters pat,
-                         rewriters.rewrite_exp rewriters exp),(l,annot))) 
-  in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
-
-let rewrite_def rewriters d = match d with
-  | DEF_type _ | DEF_kind _ | DEF_spec _ | DEF_default _ | DEF_reg_dec _ | DEF_comm _ | DEF_overload _ -> d
-  | DEF_fundef fdef -> DEF_fundef (rewriters.rewrite_fun rewriters fdef)
-  | DEF_val letbind -> DEF_val (rewriters.rewrite_let rewriters letbind)
-  | DEF_scattered _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown "DEF_scattered survived to rewritter")
-
-let rewrite_defs_base rewriters (Defs defs) = 
-  let rec rewrite ds = match ds with
-    | [] -> []
-    | d::ds -> (rewriters.rewrite_def rewriters d)::(rewrite ds) in
-  Defs (rewrite defs)
-    
-let rewrite_defs (Defs defs) = rewrite_defs_base
-    {rewrite_exp = rewrite_exp;
-     rewrite_pat = rewrite_pat;
-     rewrite_let = rewrite_let;
-     rewrite_lexp = rewrite_lexp;
-     rewrite_fun = rewrite_fun;
-     rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base} (Defs defs)
-
-module Envmap = Finite_map.Fmap_map(String)
-
-(* TODO: This seems to only consider a single assignment (or possibly two, in
-   separate branches of an if-expression). Hence, it seems the result is always
-   at most one variable. Is this intended?
-   It is only used below when pulling out local variables inside if-expressions
-   into the outer scope, which seems dubious. I comment it out for now. *)
-(*let rec introduced_variables (E_aux (exp,(l,annot))) =
-  match exp with
-  | E_cast (typ, exp) -> introduced_variables exp
-  | E_if (c,t,e) -> Envmap.intersect (introduced_variables t) (introduced_variables e)
-  | E_assign (lexp,exp) -> introduced_vars_le lexp exp
-  | _ -> Envmap.empty
-
-and introduced_vars_le (LEXP_aux(lexp,annot)) exp = 
-  match lexp with
-  | LEXP_id (Id_aux (Id id,_))  | LEXP_cast(_,(Id_aux (Id id,_))) ->
-    (match annot with
-     | Base((_,t),Emp_intro,_,_,_,_) ->
-       Envmap.insert Envmap.empty (id,(t,exp))
-     | _ -> Envmap.empty)
-  | _ -> Envmap.empty*)
-
-type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
-  { p_lit            : lit -> 'pat_aux
-  ; p_wild           : 'pat_aux
-  ; p_as             : 'pat * id -> 'pat_aux
-  ; p_typ            : Ast.typ * 'pat -> 'pat_aux
-  ; p_id             : id -> 'pat_aux
-  ; p_app            : id * 'pat list -> 'pat_aux
-  ; p_record         : 'fpat list * bool -> 'pat_aux
-  ; p_vector         : 'pat list -> 'pat_aux
-  ; p_vector_indexed : (int * 'pat) list -> 'pat_aux
-  ; p_vector_concat  : 'pat list -> 'pat_aux
-  ; p_tup            : 'pat list -> 'pat_aux
-  ; p_list           : 'pat list -> 'pat_aux
-  ; p_aux            : 'pat_aux * 'a annot -> 'pat
-  ; fP_aux           : 'fpat_aux * 'a annot -> 'fpat
-  ; fP_Fpat          : id * 'pat -> 'fpat_aux
-  }
-
-let rec fold_pat_aux (alg : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg) : 'a pat_aux -> 'pat_aux =
-  function
-  | P_lit lit           -> alg.p_lit lit
-  | P_wild              -> alg.p_wild
-  | P_id id             -> alg.p_id id
-  | P_as (p,id)         -> alg.p_as (fold_pat alg p,id)
-  | P_typ (typ,p)       -> alg.p_typ (typ,fold_pat alg p)
-  | P_app (id,ps)       -> alg.p_app (id,List.map (fold_pat alg) ps)
-  | P_record (ps,b)     -> alg.p_record (List.map (fold_fpat alg) ps, b)
-  | P_vector ps         -> alg.p_vector (List.map (fold_pat alg) ps)
-  | P_vector_indexed ps -> alg.p_vector_indexed (List.map (fun (i,p) -> (i, fold_pat alg p)) ps)
-  | P_vector_concat ps  -> alg.p_vector_concat (List.map (fold_pat alg) ps)
-  | P_tup ps            -> alg.p_tup (List.map (fold_pat alg) ps)
-  | P_list ps           -> alg.p_list (List.map (fold_pat alg) ps)
-
-
-and fold_pat (alg : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg) : 'a pat -> 'pat =
-  function
-  | P_aux (pat,annot)   -> alg.p_aux (fold_pat_aux alg pat,annot)
-and fold_fpat_aux (alg : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg) : 'a fpat_aux -> 'fpat_aux =
-  function
-  | FP_Fpat (id,pat)    -> alg.fP_Fpat (id,fold_pat alg pat)
-and fold_fpat (alg : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg) : 'a fpat -> 'fpat =
-  function
-  | FP_aux (fpat,annot) -> alg.fP_aux (fold_fpat_aux alg fpat,annot)
-                                      
-(* identity fold from term alg to term alg *)
-let id_pat_alg : ('a,'a pat, 'a pat_aux, 'a fpat, 'a fpat_aux) pat_alg = 
-  { p_lit            = (fun lit -> P_lit lit)
-  ; p_wild           = P_wild
-  ; p_as             = (fun (pat,id) -> P_as (pat,id))
-  ; p_typ            = (fun (typ,pat) -> P_typ (typ,pat))
-  ; p_id             = (fun id -> P_id id)
-  ; p_app            = (fun (id,ps) -> P_app (id,ps))
-  ; p_record         = (fun (ps,b) -> P_record (ps,b))
-  ; p_vector         = (fun ps -> P_vector ps)
-  ; p_vector_indexed = (fun ps -> P_vector_indexed ps)
-  ; p_vector_concat  = (fun ps -> P_vector_concat ps)
-  ; p_tup            = (fun ps -> P_tup ps)
-  ; p_list           = (fun ps -> P_list ps)
-  ; p_aux            = (fun (pat,annot) -> P_aux (pat,annot))
-  ; fP_aux           = (fun (fpat,annot) -> FP_aux (fpat,annot))
-  ; fP_Fpat          = (fun (id,pat) -> FP_Fpat (id,pat))
-  }
-  
-type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
-      'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
-      'pat,'pat_aux,'fpat,'fpat_aux) exp_alg = 
-  { e_block                  : 'exp list -> 'exp_aux
-  ; e_nondet                 : 'exp list -> 'exp_aux
-  ; e_id                     : id -> 'exp_aux
-  ; e_lit                    : lit -> 'exp_aux
-  ; e_cast                   : Ast.typ * 'exp -> 'exp_aux
-  ; e_app                    : id * 'exp list -> 'exp_aux
-  ; e_app_infix              : 'exp * id * 'exp -> 'exp_aux
-  ; e_tuple                  : 'exp list -> 'exp_aux
-  ; e_if                     : 'exp * 'exp * 'exp -> 'exp_aux
-  ; e_for                    : id * 'exp * 'exp * 'exp * Ast.order * 'exp -> 'exp_aux
-  ; e_vector                 : 'exp list -> 'exp_aux
-  ; e_vector_indexed         : (int * 'exp) list * 'opt_default -> 'exp_aux
-  ; e_vector_access          : 'exp * 'exp -> 'exp_aux
-  ; e_vector_subrange        : 'exp * 'exp * 'exp -> 'exp_aux
-  ; e_vector_update          : 'exp * 'exp * 'exp -> 'exp_aux
-  ; e_vector_update_subrange : 'exp * 'exp * 'exp * 'exp -> 'exp_aux
-  ; e_vector_append          : 'exp * 'exp -> 'exp_aux
-  ; e_list                   : 'exp list -> 'exp_aux
-  ; e_cons                   : 'exp * 'exp -> 'exp_aux
-  ; e_record                 : 'fexps -> 'exp_aux
-  ; e_record_update          : 'exp * 'fexps -> 'exp_aux
-  ; e_field                  : 'exp * id -> 'exp_aux
-  ; e_case                   : 'exp * 'pexp list -> 'exp_aux
-  ; e_let                    : 'letbind * 'exp -> 'exp_aux
-  ; e_assign                 : 'lexp * 'exp -> 'exp_aux
-  ; e_sizeof                 : nexp -> 'exp_aux
-  ; e_exit                   : 'exp -> 'exp_aux
-  ; e_return                 : 'exp -> 'exp_aux
-  ; e_assert                 : 'exp * 'exp -> 'exp_aux
-  ; e_internal_cast          : 'a annot * 'exp -> 'exp_aux
-  ; e_internal_exp           : 'a annot -> 'exp_aux
-  ; e_internal_exp_user      : 'a annot * 'a annot -> 'exp_aux
-  ; e_internal_let           : 'lexp * 'exp * 'exp -> 'exp_aux
-  ; e_internal_plet          : 'pat * 'exp * 'exp -> 'exp_aux
-  ; e_internal_return        : 'exp -> 'exp_aux
-  ; e_aux                    : 'exp_aux * 'a annot -> 'exp
-  ; lEXP_id                  : id -> 'lexp_aux
-  ; lEXP_memory              : id * 'exp list -> 'lexp_aux
-  ; lEXP_cast                : Ast.typ * id -> 'lexp_aux
-  ; lEXP_tup                 : 'lexp list -> 'lexp_aux
-  ; lEXP_vector              : 'lexp * 'exp -> 'lexp_aux
-  ; lEXP_vector_range        : 'lexp * 'exp * 'exp -> 'lexp_aux
-  ; lEXP_field               : 'lexp * id -> 'lexp_aux
-  ; lEXP_aux                 : 'lexp_aux * 'a annot -> 'lexp
-  ; fE_Fexp                  : id * 'exp -> 'fexp_aux
-  ; fE_aux                   : 'fexp_aux * 'a annot -> 'fexp
-  ; fES_Fexps                : 'fexp list * bool -> 'fexps_aux
-  ; fES_aux                  : 'fexps_aux * 'a annot -> 'fexps
-  ; def_val_empty            : 'opt_default_aux
-  ; def_val_dec              : 'exp -> 'opt_default_aux
-  ; def_val_aux              : 'opt_default_aux * 'a annot -> 'opt_default
-  ; pat_exp                  : 'pat * 'exp -> 'pexp_aux
-  ; pat_aux                  : 'pexp_aux * 'a annot -> 'pexp
-  ; lB_val_explicit          : typschm * 'pat * 'exp -> 'letbind_aux
-  ; lB_val_implicit          : 'pat * 'exp -> 'letbind_aux
-  ; lB_aux                   : 'letbind_aux * 'a annot -> 'letbind
-  ; pat_alg                  : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg
-  }
-    
-let rec fold_exp_aux alg = function
-  | E_block es -> alg.e_block (List.map (fold_exp alg) es)
-  | E_nondet es -> alg.e_nondet (List.map (fold_exp alg) es)
-  | E_id id -> alg.e_id id
-  | E_lit lit -> alg.e_lit lit
-  | E_cast (typ,e) -> alg.e_cast (typ, fold_exp alg e)
-  | E_app (id,es) -> alg.e_app (id, List.map (fold_exp alg) es)
-  | E_app_infix (e1,id,e2) -> alg.e_app_infix (fold_exp alg e1, id, fold_exp alg e2)
-  | E_tuple es -> alg.e_tuple (List.map (fold_exp alg) es)
-  | E_if (e1,e2,e3) -> alg.e_if (fold_exp alg e1, fold_exp alg e2, fold_exp alg e3)
-  | E_for (id,e1,e2,e3,order,e4) ->
-     alg.e_for (id,fold_exp alg e1, fold_exp alg e2, fold_exp alg e3, order, fold_exp alg e4)
-  | E_vector es -> alg.e_vector (List.map (fold_exp alg) es)
-  | E_vector_indexed (es,opt) ->
-     alg.e_vector_indexed (List.map (fun (id,e) -> (id,fold_exp alg e)) es, fold_opt_default alg opt)
-  | E_vector_access (e1,e2) -> alg.e_vector_access (fold_exp alg e1, fold_exp alg e2)
-  | E_vector_subrange (e1,e2,e3) ->
-     alg.e_vector_subrange (fold_exp alg e1, fold_exp alg e2, fold_exp alg e3)
-  | E_vector_update (e1,e2,e3) ->
-     alg.e_vector_update (fold_exp alg e1, fold_exp alg e2, fold_exp alg e3)
-  | E_vector_update_subrange (e1,e2,e3,e4) ->
-     alg.e_vector_update_subrange (fold_exp alg e1,fold_exp alg e2, fold_exp alg e3, fold_exp alg e4)
-  | E_vector_append (e1,e2) -> alg.e_vector_append (fold_exp alg e1, fold_exp alg e2)
-  | E_list es -> alg.e_list (List.map (fold_exp alg) es)
-  | E_cons (e1,e2) -> alg.e_cons (fold_exp alg e1, fold_exp alg e2)
-  | E_record fexps -> alg.e_record (fold_fexps alg fexps)
-  | E_record_update (e,fexps) -> alg.e_record_update (fold_exp alg e, fold_fexps alg fexps)
-  | E_field (e,id) -> alg.e_field (fold_exp alg e, id)
-  | E_case (e,pexps) -> alg.e_case (fold_exp alg e, List.map (fold_pexp alg) pexps)
-  | E_let (letbind,e) -> alg.e_let (fold_letbind alg letbind, fold_exp alg e)
-  | E_assign (lexp,e) -> alg.e_assign (fold_lexp alg lexp, fold_exp alg e)
-  | E_sizeof nexp -> alg.e_sizeof nexp
-  | E_exit e -> alg.e_exit (fold_exp alg e)
-  | E_return e -> alg.e_return (fold_exp alg e)
-  | E_assert(e1,e2) -> alg.e_assert (fold_exp alg e1, fold_exp alg e2)
-  | E_internal_cast (annot,e) -> alg.e_internal_cast (annot, fold_exp alg e)
-  | E_internal_exp annot -> alg.e_internal_exp annot
-  | E_internal_exp_user (annot1,annot2) -> alg.e_internal_exp_user (annot1,annot2)
-  | E_internal_let (lexp,e1,e2) ->
-     alg.e_internal_let (fold_lexp alg lexp, fold_exp alg e1, fold_exp alg e2)
-  | E_internal_plet (pat,e1,e2) ->
-     alg.e_internal_plet (fold_pat alg.pat_alg pat, fold_exp alg e1, fold_exp alg e2)
-  | E_internal_return e -> alg.e_internal_return (fold_exp alg e)
-and fold_exp alg (E_aux (exp_aux,annot)) = alg.e_aux (fold_exp_aux alg exp_aux, annot)
-and fold_lexp_aux alg = function
-  | LEXP_id id -> alg.lEXP_id id
-  | LEXP_memory (id,es) -> alg.lEXP_memory (id, List.map (fold_exp alg) es)
-  | LEXP_cast (typ,id) -> alg.lEXP_cast (typ,id)
-  | LEXP_vector (lexp,e) -> alg.lEXP_vector (fold_lexp alg lexp, fold_exp alg e)
-  | LEXP_vector_range (lexp,e1,e2) ->
-     alg.lEXP_vector_range (fold_lexp alg lexp, fold_exp alg e1, fold_exp alg e2)
- | LEXP_field (lexp,id) -> alg.lEXP_field (fold_lexp alg lexp, id)
-and fold_lexp alg (LEXP_aux (lexp_aux,annot)) =
-  alg.lEXP_aux (fold_lexp_aux alg lexp_aux, annot)
-and fold_fexp_aux alg (FE_Fexp (id,e)) = alg.fE_Fexp (id, fold_exp alg e)
-and fold_fexp alg (FE_aux (fexp_aux,annot)) = alg.fE_aux (fold_fexp_aux alg fexp_aux,annot)
-and fold_fexps_aux alg (FES_Fexps (fexps,b)) = alg.fES_Fexps (List.map (fold_fexp alg) fexps, b)
-and fold_fexps alg (FES_aux (fexps_aux,annot)) = alg.fES_aux (fold_fexps_aux alg fexps_aux, annot)
-and fold_opt_default_aux alg = function
-  | Def_val_empty -> alg.def_val_empty
-  | Def_val_dec e -> alg.def_val_dec (fold_exp alg e)
-and fold_opt_default alg (Def_val_aux (opt_default_aux,annot)) =
-  alg.def_val_aux (fold_opt_default_aux alg opt_default_aux, annot)
-and fold_pexp_aux alg (Pat_exp (pat,e)) = alg.pat_exp (fold_pat alg.pat_alg pat, fold_exp alg e)
-and fold_pexp alg (Pat_aux (pexp_aux,annot)) = alg.pat_aux (fold_pexp_aux alg pexp_aux, annot)
-and fold_letbind_aux alg = function
-  | LB_val_explicit (t,pat,e) -> alg.lB_val_explicit (t,fold_pat alg.pat_alg pat, fold_exp alg e)
-  | LB_val_implicit (pat,e) -> alg.lB_val_implicit (fold_pat alg.pat_alg pat, fold_exp alg e)
-and fold_letbind alg (LB_aux (letbind_aux,annot)) = alg.lB_aux (fold_letbind_aux alg letbind_aux, annot)
-
-let id_exp_alg =
-  { e_block = (fun es -> E_block es)
-  ; e_nondet = (fun es -> E_nondet es)
-  ; e_id = (fun id -> E_id id)
-  ; e_lit = (fun lit -> (E_lit lit))
-  ; e_cast = (fun (typ,e) -> E_cast (typ,e))
-  ; e_app = (fun (id,es) -> E_app (id,es))
-  ; e_app_infix = (fun (e1,id,e2) -> E_app_infix (e1,id,e2))
-  ; e_tuple = (fun es -> E_tuple es)
-  ; e_if = (fun (e1,e2,e3) -> E_if (e1,e2,e3))
-  ; e_for = (fun (id,e1,e2,e3,order,e4) -> E_for (id,e1,e2,e3,order,e4))
-  ; e_vector = (fun es -> E_vector es)
-  ; e_vector_indexed = (fun (es,opt2) -> E_vector_indexed (es,opt2))
-  ; e_vector_access = (fun (e1,e2) -> E_vector_access (e1,e2))
-  ; e_vector_subrange =  (fun (e1,e2,e3) -> E_vector_subrange (e1,e2,e3))
-  ; e_vector_update = (fun (e1,e2,e3) -> E_vector_update (e1,e2,e3))
-  ; e_vector_update_subrange =  (fun (e1,e2,e3,e4) -> E_vector_update_subrange (e1,e2,e3,e4))
-  ; e_vector_append = (fun (e1,e2) -> E_vector_append (e1,e2))
-  ; e_list = (fun es -> E_list es)
-  ; e_cons = (fun (e1,e2) -> E_cons (e1,e2))
-  ; e_record = (fun fexps -> E_record fexps)
-  ; e_record_update = (fun (e1,fexp) -> E_record_update (e1,fexp))
-  ; e_field = (fun (e1,id) -> (E_field (e1,id)))
-  ; e_case = (fun (e1,pexps) -> E_case (e1,pexps))
-  ; e_let = (fun (lb,e2) -> E_let (lb,e2))
-  ; e_assign = (fun (lexp,e2) -> E_assign (lexp,e2))
-  ; e_sizeof = (fun nexp -> E_sizeof nexp)
-  ; e_exit = (fun e1 -> E_exit (e1))
-  ; e_return = (fun e1 -> E_return e1)
-  ; e_assert = (fun (e1,e2) -> E_assert(e1,e2)) 
-  ; e_internal_cast = (fun (a,e1) -> E_internal_cast (a,e1))
-  ; e_internal_exp = (fun a -> E_internal_exp a)
-  ; e_internal_exp_user = (fun (a1,a2) -> E_internal_exp_user (a1,a2))
-  ; e_internal_let = (fun (lexp, e2, e3) -> E_internal_let (lexp,e2,e3))
-  ; e_internal_plet = (fun (pat, e1, e2) -> E_internal_plet (pat,e1,e2))
-  ; e_internal_return = (fun e -> E_internal_return e)
-  ; e_aux = (fun (e,annot) -> E_aux (e,annot))
-  ; lEXP_id = (fun id -> LEXP_id id)
-  ; lEXP_memory = (fun (id,es) -> LEXP_memory (id,es))
-  ; lEXP_cast = (fun (typ,id) -> LEXP_cast (typ,id))
-  ; lEXP_tup = (fun tups -> LEXP_tup tups)
-  ; lEXP_vector = (fun (lexp,e2) -> LEXP_vector (lexp,e2))
-  ; lEXP_vector_range = (fun (lexp,e2,e3) -> LEXP_vector_range (lexp,e2,e3))
-  ; lEXP_field = (fun (lexp,id) -> LEXP_field (lexp,id))
-  ; lEXP_aux = (fun (lexp,annot) -> LEXP_aux (lexp,annot))
-  ; fE_Fexp = (fun (id,e) -> FE_Fexp (id,e))
-  ; fE_aux = (fun (fexp,annot) -> FE_aux (fexp,annot))
-  ; fES_Fexps = (fun (fexps,b) -> FES_Fexps (fexps,b))
-  ; fES_aux = (fun (fexp,annot) -> FES_aux (fexp,annot))
-  ; def_val_empty = Def_val_empty
-  ; def_val_dec = (fun e -> Def_val_dec e)
-  ; def_val_aux = (fun (defval,aux) -> Def_val_aux (defval,aux))
-  ; pat_exp = (fun (pat,e) -> (Pat_exp (pat,e)))
-  ; pat_aux = (fun (pexp,a) -> (Pat_aux (pexp,a)))
-  ; lB_val_explicit = (fun (typ,pat,e) -> LB_val_explicit (typ,pat,e))
-  ; lB_val_implicit = (fun (pat,e) -> LB_val_implicit (pat,e))
-  ; lB_aux = (fun (lb,annot) -> LB_aux (lb,annot))
-  ; pat_alg = id_pat_alg
-  }
-  
-
-let remove_vector_concat_pat pat =
-
-  (* ivc: bool that indicates whether the exp is in a vector_concat pattern *)
-  let remove_typed_patterns =
-    fold_pat { id_pat_alg with
-               p_aux = (function
-                        | (P_typ (_,P_aux (p,_)),annot)
-                        | (p,annot) -> 
-                           P_aux (p,annot)
-                       )
-             } in
-  
-  let pat = remove_typed_patterns pat in
-
-  let fresh_id_v = fresh_id "v__" in
-
-  (* expects that P_typ elements have been removed from AST,
-     that the length of all vectors involved is known,
-     that we don't have indexed vectors *)
-
-  (* introduce names for all patterns of form P_vector_concat *)
-  let name_vector_concat_roots =
-    { p_lit = (fun lit -> P_lit lit)
-    ; p_typ = (fun (typ,p) -> P_typ (typ,p false)) (* cannot happen *)
-    ; p_wild = P_wild
-    ; p_as = (fun (pat,id) -> P_as (pat true,id))
-    ; p_id  = (fun id -> P_id id)
-    ; p_app = (fun (id,ps) -> P_app (id, List.map (fun p -> p false) ps))
-    ; p_record = (fun (fpats,b) -> P_record (fpats, b))
-    ; p_vector = (fun ps -> P_vector (List.map (fun p -> p false) ps))
-    ; p_vector_indexed = (fun ps -> P_vector_indexed (List.map (fun (i,p) -> (i,p false)) ps))
-    ; p_vector_concat  = (fun ps -> P_vector_concat (List.map (fun p -> p false) ps))
-    ; p_tup            = (fun ps -> P_tup (List.map (fun p -> p false) ps))
-    ; p_list           = (fun ps -> P_list (List.map (fun p -> p false) ps))
-    ; p_aux =
-        (fun (pat,((l,_) as annot)) contained_in_p_as ->
-          match pat with
-          | P_vector_concat pats ->
-             (if contained_in_p_as
-              then P_aux (pat,annot)
-              else P_aux (P_as (P_aux (pat,annot),fresh_id_v l),annot))
-          | _ -> P_aux (pat,annot)
-        )
-    ; fP_aux = (fun (fpat,annot) -> FP_aux (fpat,annot))
-    ; fP_Fpat = (fun (id,p) -> FP_Fpat (id,p false))
-    } in
-
-  let pat = (fold_pat name_vector_concat_roots pat) false in
-
-  (* introduce names for all unnamed child nodes of P_vector_concat *)
-  let name_vector_concat_elements =
-    let p_vector_concat pats =
-      let aux ((P_aux (p,((l,_) as a))) as pat) = match p with
-        | P_vector _ -> P_aux (P_as (pat,fresh_id_v l),a)
-        | P_id id -> P_aux (P_id id,a)
-        | P_as (p,id) -> P_aux (P_as (p,id),a)
-        | P_wild -> P_aux (P_wild,a)
-        | _ ->
-           raise
-             (Reporting_basic.err_unreachable
-                l "name_vector_concat_elements: Non-vector in vector-concat pattern") in
-      P_vector_concat (List.map aux pats) in
-    {id_pat_alg with p_vector_concat = p_vector_concat} in
-
-  let pat = fold_pat name_vector_concat_elements pat in
-
-
-
-  let rec tag_last = function
-    | x :: xs -> let is_last = xs = [] in (x,is_last) :: tag_last xs
-    | _ -> [] in
-
-  (* remove names from vectors in vector_concat patterns and collect them as declarations for the
-     function body or expression *)
-  let unname_vector_concat_elements = (* :
-        ('a,
-         'a pat *      ((tannot exp -> tannot exp) list),
-         'a pat_aux *  ((tannot exp -> tannot exp) list),
-         'a fpat *     ((tannot exp -> tannot exp) list),
-         'a fpat_aux * ((tannot exp -> tannot exp) list))
-          pat_alg = *)
-
-    (* build a let-expression of the form "let child = root[i..j] in body" *)
-    let letbind_vec (rootid,rannot) (child,cannot) (i,j) =
-      let (l,_) = cannot in
-      let (Id_aux (Id rootname,_)) = rootid in
-      let (Id_aux (Id childname,_)) = child in
-      
-      (*let vlength_info (Base ((_,{t = Tapp("vector",[_;TA_nexp nexp;_;_])}),_,_,_,_,_)) =
-        nexp in*)
-      (* let uannot = (Parse_ast.Generated l, ()) in
-      let unit_exp l eaux = E_aux (eaux, uannot) in
-      let simple_num l n = unit_exp l (E_lit (L_aux (L_num n, l))) in *)
-
-      let root = E_aux (E_id rootid, rannot) in
-      let index_i = simple_num l i in
-      let index_j = (*match j with
-        | Some j ->*) simple_num l j in
-        (*)| None ->
-           let length_app_exp = unit_exp l (E_app (Id_aux (Id "length",l),[root])) in
-           (*let (_,length_root_nexp,_,_) = vector_typ_args_of (snd rannot) in
-           let length_app_exp : tannot exp =
-             let typ = mk_atom_typ length_root_nexp in
-             let annot = (l,tag_annot typ (External (Some "length"))) in
-             E_aux (E_app (Id_aux (Id "length",l),[root]),annot) in*)
-           let minus = Id_aux (Id "-",l) in
-           let one_exp = simple_num l 1 in
-           unit_exp l (E_app_infix(length_app_exp,minus,one_exp)) in*)
-      
-      let subv = fix_eff_exp (E_aux (E_vector_subrange (root, index_i, index_j), cannot)) in
-        (*(E_app (Id_aux (Id "slice_raw",Unknown), [root;index_i;index_j])) in*)
-
-      let letbind = fix_eff_lb (LB_aux (LB_val_implicit (P_aux (P_id child,cannot),subv),cannot)) in
-      (letbind,
-       (fun body -> fix_eff_exp (E_aux (E_let (letbind,body), simple_annot l (typ_of body)))),
-       (rootname,childname)) in
-
-    let p_aux = function
-      | ((P_as (P_aux (P_vector_concat pats,rannot'),rootid),decls),rannot) ->
-         let rtyp = Env.base_typ_of (env_of_annot rannot') (typ_of_annot rannot') in
-         let (start,last_idx) = (match vector_typ_args_of rtyp with
-          | (Nexp_aux (Nexp_constant start,_), Nexp_aux (Nexp_constant length,_), ord, _) ->
-            (start, if is_order_inc ord then start + length - 1 else start - length + 1)
-          | _ ->
-            raise (Reporting_basic.err_unreachable (fst rannot')
-              ("unname_vector_concat_elements: vector of unspecified length in vector-concat pattern"))) in
-         let aux (pos,pat_acc,decl_acc) (P_aux (p,cannot),is_last) =
-           let ctyp = Env.base_typ_of (env_of_annot cannot) (typ_of_annot cannot) in
-           let (_,length,ord,_) = vector_typ_args_of ctyp in
-            (*)| (_,length,ord,_) ->*)
-               let (pos',index_j) = match length with
-                 | Nexp_aux (Nexp_constant i,_) ->
-                   if is_order_inc ord then (pos+i, pos+i-1)
-                   else (pos-i, pos-i+1)
-                 | Nexp_aux (_,l) ->
-                     if is_last then (pos,last_idx)
-                     else
-                     raise
-                       (Reporting_basic.err_unreachable
-                          l ("unname_vector_concat_elements: vector of unspecified length in vector-concat pattern")) in
-               (match p with 
-                (* if we see a named vector pattern, remove the name and remember to 
-                  declare it later *)
-                | P_as (P_aux (p,cannot),cname) ->
-                   let (lb,decl,info) = letbind_vec (rootid,rannot) (cname,cannot) (pos,index_j) in
-                   (pos', pat_acc @ [P_aux (p,cannot)], decl_acc @ [((lb,decl),info)])
-                (* if we see a P_id variable, remember to declare it later *)
-                | P_id cname ->
-                   let (lb,decl,info) = letbind_vec (rootid,rannot) (cname,cannot) (pos,index_j) in
-                   (pos', pat_acc @ [P_aux (P_id cname,cannot)], decl_acc @ [((lb,decl),info)])
-                (* normal vector patterns are fine *)
-                | _ -> (pos', pat_acc @ [P_aux (p,cannot)],decl_acc) )
-            (* non-vector patterns aren't *)
-            (*)| _ ->
-               raise
-                 (Reporting_basic.err_unreachable
-                    (fst cannot)
-                    ("unname_vector_concat_elements: Non-vector in vector-concat pattern:" ^
-                       string_of_typ (typ_of_annot cannot))
-                 )*) in
-          let pats_tagged = tag_last pats in
-          let (_,pats',decls') = List.fold_left aux (start,[],[]) pats_tagged in
-
-          (* abuse P_vector_concat as a P_vector_const pattern: it has the of
-          patterns as an argument but they're meant to be consed together *)
-          (P_aux (P_as (P_aux (P_vector_concat pats',rannot'),rootid),rannot), decls @ decls')
-      | ((p,decls),annot) -> (P_aux (p,annot),decls) in
-
-    { p_lit            = (fun lit -> (P_lit lit,[]))
-    ; p_wild           = (P_wild,[])
-    ; p_as             = (fun ((pat,decls),id) -> (P_as (pat,id),decls))
-    ; p_typ            = (fun (typ,(pat,decls)) -> (P_typ (typ,pat),decls))
-    ; p_id             = (fun id -> (P_id id,[]))
-    ; p_app            = (fun (id,ps) -> let (ps,decls) = List.split ps in
-                                         (P_app (id,ps),List.flatten decls))
-    ; p_record         = (fun (ps,b) -> let (ps,decls) = List.split ps in
-                                        (P_record (ps,b),List.flatten decls))
-    ; p_vector         = (fun ps -> let (ps,decls) = List.split ps in
-                                    (P_vector ps,List.flatten decls))
-    ; p_vector_indexed = (fun ps -> let (is,ps) = List.split ps in
-                                    let (ps,decls) = List.split ps in
-                                    let ps = List.combine is ps in
-                                    (P_vector_indexed ps,List.flatten decls))
-    ; p_vector_concat  = (fun ps -> let (ps,decls) = List.split ps in
-                                    (P_vector_concat ps,List.flatten decls))
-    ; p_tup            = (fun ps -> let (ps,decls) = List.split ps in
-                                    (P_tup ps,List.flatten decls))
-    ; p_list           = (fun ps -> let (ps,decls) = List.split ps in
-                                    (P_list ps,List.flatten decls))
-    ; p_aux            = (fun ((pat,decls),annot) -> p_aux ((pat,decls),annot))
-    ; fP_aux           = (fun ((fpat,decls),annot) -> (FP_aux (fpat,annot),decls))
-    ; fP_Fpat          = (fun (id,(pat,decls)) -> (FP_Fpat (id,pat),decls))
-    } in
-
-  let (pat,decls) = fold_pat unname_vector_concat_elements pat in
-
-  let decls =
-    let module S = Set.Make(String) in
-
-    let roots_needed =
-      List.fold_right
-        (fun (_,(rootid,childid)) roots_needed ->
-         if S.mem childid roots_needed then
-           (* let _ = print_endline rootid in *)
-           S.add rootid roots_needed
-         else if String.length childid >= 3 && String.sub childid 0 2 = String.sub "v__" 0 2 then
-           roots_needed
-         else
-           S.add rootid roots_needed
-        ) decls S.empty in
-    List.filter
-      (fun (_,(_,childid)) ->  
-       S.mem childid roots_needed ||
-         String.length childid < 3 ||
-           not (String.sub childid 0 2 = String.sub "v__" 0 2))
-      decls in
-
-  let (letbinds,decls) =
-    let (decls,_) = List.split decls in
-    List.split decls in
-
-  let decls = List.fold_left (fun f g x -> f (g x)) (fun b -> b) decls in
-
-
-  (* at this point shouldn't have P_as patterns in P_vector_concat patterns any more,
-     all P_as and P_id vectors should have their declarations in decls.
-     Now flatten all vector_concat patterns *)
-  
-  let flatten =
-    let p_vector_concat ps =
-      let aux p acc = match p with
-        | (P_aux (P_vector_concat pats,_)) -> pats @ acc
-        | pat -> pat :: acc in
-      P_vector_concat (List.fold_right aux ps []) in
-    {id_pat_alg with p_vector_concat = p_vector_concat} in
-  
-  let pat = fold_pat flatten pat in
-
-  (* at this point pat should be a flat pattern: no vector_concat patterns
-     with vector_concats patterns as direct child-nodes anymore *)
-
-  let range a b =
-    let rec aux a b = if a > b then [] else a :: aux (a+1) b in
-    if a > b then List.rev (aux b a) else aux a b in
-
-  let remove_vector_concats =
-    let p_vector_concat ps =
-      let aux acc (P_aux (p,annot),is_last) =
-        let env = env_of_annot annot in
-        let typ = Env.base_typ_of env (typ_of_annot annot) in
-        let eff = effect_of_annot (snd annot) in
-        let (l,_) = annot in
-        let wild _ = P_aux (P_wild,(Parse_ast.Generated l, Some (env, bit_typ, eff))) in
-        if is_vector_typ typ then
-          match p, vector_typ_args_of typ with
-          | P_vector ps,_ -> acc @ ps
-          | _, (_,Nexp_aux (Nexp_constant length,_),_,_) ->
-             acc @ (List.map wild (range 0 (length - 1)))
-          | _, _ ->
-            (*if is_last then*) acc @ [wild 0]
-        else raise
-          (Reporting_basic.err_unreachable l
-            ("remove_vector_concats: Non-vector in vector-concat pattern " ^
-              string_of_typ (typ_of_annot annot))) in
-
-      let has_length (P_aux (p,annot)) =
-        let typ = Env.base_typ_of (env_of_annot annot) (typ_of_annot annot) in
-        match vector_typ_args_of typ with
-        | (_,Nexp_aux (Nexp_constant length,_),_,_) -> true
-        | _ -> false in
-
-      let ps_tagged = tag_last ps in
-      let ps' = List.fold_left aux [] ps_tagged in
-      let last_has_length ps = List.exists (fun (p,b) -> b && has_length p) ps_tagged in
-
-      if last_has_length ps then
-        P_vector ps'
-      else
-        (* If the last vector pattern in the vector_concat pattern has unknown
-        length we misuse the P_vector_concat constructor's argument to place in
-        the following way: P_vector_concat [x;y; ... ;z] should be mapped to the
-        pattern-match x :: y :: .. z, i.e. if x : 'a, then z : vector 'a. *)
-        P_vector_concat ps' in
-
-    {id_pat_alg with p_vector_concat = p_vector_concat} in
-  
-  let pat = fold_pat remove_vector_concats pat in
-  
-  (pat,letbinds,decls)
-
-(* assumes there are no more E_internal expressions *)
-let rewrite_exp_remove_vector_concat_pat rewriters (E_aux (exp,(l,annot)) as full_exp) = 
-  let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters in
-  let rewrite_base = rewrite_exp rewriters in
-  match exp with
-  | E_case (e,ps) ->
-     let aux (Pat_aux (Pat_exp (pat,body),annot')) =
-       let (pat,_,decls) = remove_vector_concat_pat pat in
-       Pat_aux (Pat_exp (pat, decls (rewrite_rec body)),annot') in
-     rewrap (E_case (rewrite_rec e, List.map aux ps))
-  | E_let (LB_aux (LB_val_explicit (typ,pat,v),annot'),body) ->
-     let (pat,_,decls) = remove_vector_concat_pat pat in
-     rewrap (E_let (LB_aux (LB_val_explicit (typ,pat,rewrite_rec v),annot'),
-                    decls (rewrite_rec body)))
-  | E_let (LB_aux (LB_val_implicit (pat,v),annot'),body) ->
-     let (pat,_,decls) = remove_vector_concat_pat pat in
-     rewrap (E_let (LB_aux (LB_val_implicit (pat,rewrite_rec v),annot'),
-                    decls (rewrite_rec body)))
-  | exp -> rewrite_base full_exp
-
-let rewrite_fun_remove_vector_concat_pat
-      rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) = 
-  let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),(l,annot))) =
-    let (pat',_,decls) = remove_vector_concat_pat pat in
-    let exp' = decls (rewriters.rewrite_exp rewriters exp) in
-    (FCL_aux (FCL_Funcl (id,pat',exp'),(l,annot))) 
-  in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
-
-let rewrite_defs_remove_vector_concat (Defs defs) =
-  let rewriters =
-    {rewrite_exp = rewrite_exp_remove_vector_concat_pat;
-     rewrite_pat = rewrite_pat;
-     rewrite_let = rewrite_let;
-     rewrite_lexp = rewrite_lexp;
-     rewrite_fun = rewrite_fun_remove_vector_concat_pat;
-     rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base} in
-  let rewrite_def d =
-    let d = rewriters.rewrite_def rewriters d in
-    match d with
-    | DEF_val (LB_aux (LB_val_explicit (t,pat,exp),a)) ->
-       let (pat,letbinds,_) = remove_vector_concat_pat pat in
-       let defvals = List.map (fun lb -> DEF_val lb) letbinds in
-       [DEF_val (LB_aux (LB_val_explicit (t,pat,exp),a))] @ defvals
-    | DEF_val (LB_aux (LB_val_implicit (pat,exp),a)) -> 
-       let (pat,letbinds,_) = remove_vector_concat_pat pat in
-       let defvals = List.map (fun lb -> DEF_val lb) letbinds in
-       [DEF_val (LB_aux (LB_val_implicit (pat,exp),a))] @ defvals
-    | d -> [d] in
-  Defs (List.flatten (List.map rewrite_def defs))
-
-let rec contains_bitvector_pat (P_aux (pat,annot)) = match pat with
-| P_lit _ | P_wild | P_id _ -> false
-| P_as (pat,_) | P_typ (_,pat) -> contains_bitvector_pat pat
-| P_vector _ | P_vector_concat _ | P_vector_indexed _ ->
-    let typ = Env.base_typ_of (env_of_annot annot) (typ_of_annot annot) in
-    is_bitvector_typ typ
-| P_app (_,pats) | P_tup pats | P_list pats ->
-    List.exists contains_bitvector_pat pats
-| P_record (fpats,_) ->
-    List.exists (fun (FP_aux (FP_Fpat (_,pat),_)) -> contains_bitvector_pat pat) fpats
-
-let remove_bitvector_pat pat =
-
-  (* first introduce names for bitvector patterns *)
-  let name_bitvector_roots =
-    { p_lit = (fun lit -> P_lit lit)
-    ; p_typ = (fun (typ,p) -> P_typ (typ,p false))
-    ; p_wild = P_wild
-    ; p_as = (fun (pat,id) -> P_as (pat true,id))
-    ; p_id  = (fun id -> P_id id)
-    ; p_app = (fun (id,ps) -> P_app (id, List.map (fun p -> p false) ps))
-    ; p_record = (fun (fpats,b) -> P_record (fpats, b))
-    ; p_vector = (fun ps -> P_vector (List.map (fun p -> p false) ps))
-    ; p_vector_indexed = (fun ps -> P_vector_indexed (List.map (fun (i,p) -> (i,p false)) ps))
-    ; p_vector_concat  = (fun ps -> P_vector_concat (List.map (fun p -> p false) ps))
-    ; p_tup            = (fun ps -> P_tup (List.map (fun p -> p false) ps))
-    ; p_list           = (fun ps -> P_list (List.map (fun p -> p false) ps))
-    ; p_aux =
-        (fun (pat,annot) contained_in_p_as ->
-          let env = env_of_annot annot in
-          let t = Env.base_typ_of env (typ_of_annot annot) in
-          let (l,_) = annot in
-          match pat, is_bitvector_typ t, contained_in_p_as with
-          | P_vector _, true, false
-          | P_vector_indexed _, true, false ->
-            P_aux (P_as (P_aux (pat,annot),fresh_id "b__" l), annot)
-          | _ -> P_aux (pat,annot)
-        )
-    ; fP_aux = (fun (fpat,annot) -> FP_aux (fpat,annot))
-    ; fP_Fpat = (fun (id,p) -> FP_Fpat (id,p false))
-    } in
-  let pat = (fold_pat name_bitvector_roots pat) false in
-
-  (* Then collect guard expressions testing whether the literal bits of a
-     bitvector pattern match those of a given bitvector, and collect let
-     bindings for the bits bound by P_id or P_as patterns *)
-
-  (* Helper functions for generating guard expressions *)
-  let access_bit_exp (rootid,rannot) l idx =
-    let root : tannot exp = E_aux (E_id rootid,rannot) in
-    E_aux (E_vector_access (root,simple_num l idx), simple_annot l bit_typ) in
-
-  let test_bit_exp rootid l t idx exp =
-    let rannot = simple_annot l t in
-    let elem = access_bit_exp (rootid,rannot) l idx in
-    let eqid = Id_aux (Id "eq", Parse_ast.Generated l) in
-    let eqannot = simple_annot l bool_typ in
-    let eqexp : tannot exp = E_aux (E_app(eqid,[elem;exp]), eqannot) in
-    Some (eqexp) in
-
-  let test_subvec_exp rootid l typ i j lits =
-    let (start, length, ord, _) = vector_typ_args_of typ in
-    let length' = nconstant (List.length lits) in
-    let start' =
-      if is_order_inc ord then nconstant 0
-      else nminus length' (nconstant 1) in
-    let typ' = vector_typ start' length' ord bit_typ in
-    let subvec_exp =
-      match start, length with
-      | Nexp_aux (Nexp_constant s, _), Nexp_aux (Nexp_constant l, _)
-        when s = i && l = List.length lits ->
-        E_id rootid
-      | _ ->
-      (*if vec_start t = i && vec_length t = List.length lits
-      then E_id rootid
-      else*) E_vector_subrange (
-             E_aux (E_id rootid, simple_annot l typ),
-             simple_num l i,
-             simple_num l j) in
-    E_aux (E_app(
-      Id_aux (Id "eq_vec", Parse_ast.Generated l),
-      [E_aux (subvec_exp, simple_annot l typ');
-      E_aux (E_vector lits, simple_annot l typ')]),
-      simple_annot l bool_typ) in
-
-  let letbind_bit_exp rootid l typ idx id =
-    let rannot = simple_annot l typ in
-    let elem = access_bit_exp (rootid,rannot) l idx in
-    let e = P_aux (P_id id, simple_annot l bit_typ) in
-    let letbind = LB_aux (LB_val_implicit (e,elem), simple_annot l bit_typ) in
-    let letexp = (fun body ->
-      let (E_aux (_,(_,bannot))) = body in
-      E_aux (E_let (letbind,body), (Parse_ast.Generated l, bannot))) in
-    (letexp, letbind) in
-
-  (* Helper functions for composing guards *)
-  let bitwise_and exp1 exp2 =
-    let (E_aux (_,(l,_))) = exp1 in
-    let andid = Id_aux (Id "bool_and", Parse_ast.Generated l) in
-    E_aux (E_app(andid,[exp1;exp2]), simple_annot l bool_typ) in
-
-  let compose_guards guards =
-    List.fold_right (Util.option_binop bitwise_and) guards None in
-
-  let flatten_guards_decls gd =
-    let (guards,decls,letbinds) = Util.split3 gd in
-    (compose_guards guards, (List.fold_right (@@) decls), List.flatten letbinds) in
-
-  (* Collect guards and let bindings *)
-  let guard_bitvector_pat =
-    let collect_guards_decls ps rootid t =
-      let (start,_,ord,_) = vector_typ_args_of t in
-      let rec collect current (guards,dls) idx ps =
-        let idx' = if is_order_inc ord then idx + 1 else idx - 1 in
-        (match ps with
-          | pat :: ps' ->
-            (match pat with
-              | P_aux (P_lit lit, (l,annot)) ->
-                let e = E_aux (E_lit lit, (Parse_ast.Generated l, annot)) in
-                let current' = (match current with
-                  | Some (l,i,j,lits) -> Some (l,i,idx,lits @ [e])
-                  | None -> Some (l,idx,idx,[e])) in
-                collect current' (guards, dls) idx' ps'
-              | P_aux (P_as (pat',id), (l,annot)) ->
-                let dl = letbind_bit_exp rootid l t idx id in
-                collect current (guards, dls @ [dl]) idx (pat' :: ps')
-              | _ ->
-                let dls' = (match pat with
-                  | P_aux (P_id id, (l,annot)) ->
-                    dls @ [letbind_bit_exp rootid l t idx id]
-                  | _ -> dls) in
-                let guards' = (match current with
-                  | Some (l,i,j,lits) ->
-                    guards @ [Some (test_subvec_exp rootid l t i j lits)]
-                  | None -> guards) in
-                collect None (guards', dls') idx' ps')
-          | [] ->
-            let guards' = (match current with
-              | Some (l,i,j,lits) ->
-                guards @ [Some (test_subvec_exp rootid l t i j lits)]
-              | None -> guards) in
-            (guards',dls)) in
-      let (guards,dls) = match start with
-      | Nexp_aux (Nexp_constant s, _) ->
-        collect None ([],[]) s ps
-      | _ ->
-        let (P_aux (_, (l,_))) = pat in
-        raise (Reporting_basic.err_unreachable l
-          "guard_bitvector_pat called on pattern with non-constant start index") in
-      let (decls,letbinds) = List.split dls in
-      (compose_guards guards, List.fold_right (@@) decls, letbinds) in
-
-    let collect_guards_decls_indexed ips rootid t =
-      let rec guard_decl (idx,pat) = (match pat with
-        | P_aux (P_lit lit, (l,annot)) ->
-          let exp = E_aux (E_lit lit, (l,annot)) in
-          (test_bit_exp rootid l t idx exp, (fun b -> b), [])
-        | P_aux (P_as (pat',id), (l,annot)) ->
-          let (guard,decls,letbinds) = guard_decl (idx,pat') in
-          let (letexp,letbind) = letbind_bit_exp rootid l t idx id in
-          (guard, decls >> letexp, letbind :: letbinds)
-        | P_aux (P_id id, (l,annot)) ->
-          let (letexp,letbind) = letbind_bit_exp rootid l t idx id in
-          (None, letexp, [letbind])
-        | _ -> (None, (fun b -> b), [])) in
-      let (guards,decls,letbinds) = Util.split3 (List.map guard_decl ips) in
-      (compose_guards guards, List.fold_right (@@) decls, List.flatten letbinds) in
-
-    { p_lit            = (fun lit -> (P_lit lit, (None, (fun b -> b), [])))
-    ; p_wild           = (P_wild, (None, (fun b -> b), []))
-    ; p_as             = (fun ((pat,gdls),id) -> (P_as (pat,id), gdls))
-    ; p_typ            = (fun (typ,(pat,gdls)) -> (P_typ (typ,pat), gdls))
-    ; p_id             = (fun id -> (P_id id, (None, (fun b -> b), [])))
-    ; p_app            = (fun (id,ps) -> let (ps,gdls) = List.split ps in
-                                         (P_app (id,ps), flatten_guards_decls gdls))
-    ; p_record         = (fun (ps,b) -> let (ps,gdls) = List.split ps in
-                                        (P_record (ps,b), flatten_guards_decls gdls))
-    ; p_vector         = (fun ps -> let (ps,gdls) = List.split ps in
-                                    (P_vector ps, flatten_guards_decls gdls))
-    ; p_vector_indexed = (fun p -> let (is,p) = List.split p in
-                                   let (ps,gdls) = List.split p in
-                                   let ps = List.combine is ps in
-                                   (P_vector_indexed ps, flatten_guards_decls gdls))
-    ; p_vector_concat  = (fun ps -> let (ps,gdls) = List.split ps in
-                                    (P_vector_concat ps, flatten_guards_decls gdls))
-    ; p_tup            = (fun ps -> let (ps,gdls) = List.split ps in
-                                    (P_tup ps, flatten_guards_decls gdls))
-    ; p_list           = (fun ps -> let (ps,gdls) = List.split ps in
-                                    (P_list ps, flatten_guards_decls gdls))
-    ; p_aux            = (fun ((pat,gdls),annot) ->
-                           let env = env_of_annot annot in
-                           let t = Env.base_typ_of env (typ_of_annot annot) in
-                           (match pat, is_bitvector_typ t with
-                           | P_as (P_aux (P_vector ps, _), id), true ->
-                             (P_aux (P_id id, annot), collect_guards_decls ps id t)
-                           | P_as (P_aux (P_vector_indexed ips, _), id), true ->
-                             (P_aux (P_id id, annot), collect_guards_decls_indexed ips id t)
-                           | _, _ -> (P_aux (pat,annot), gdls)))
-    ; fP_aux           = (fun ((fpat,gdls),annot) -> (FP_aux (fpat,annot), gdls))
-    ; fP_Fpat          = (fun (id,(pat,gdls)) -> (FP_Fpat (id,pat), gdls))
-    } in
-  fold_pat guard_bitvector_pat pat
-
-let remove_wildcards pre (P_aux (_,(l,_)) as pat) =
-  fold_pat
-    {id_pat_alg with
-      p_aux = function
-        | (P_wild,(l,annot)) -> P_aux (P_id (fresh_id pre l),(l,annot))
-        | (p,annot) -> P_aux (p,annot) }
-    pat
-
-(* Check if one pattern subsumes the other, and if so, calculate a
-   substitution of variables that are used in the same position.
-   TODO: Check somewhere that there are no variable clashes (the same variable
-   name used in different positions of the patterns)
- *)
-let rec subsumes_pat (P_aux (p1,annot1) as pat1) (P_aux (p2,annot2) as pat2) =
-  let rewrap p = P_aux (p,annot1) in
-  let subsumes_list s pats1 pats2 =
-    if List.length pats1 = List.length pats2
-    then
-      let subs = List.map2 s pats1 pats2 in
-      List.fold_right
-        (fun p acc -> match p, acc with
-          | Some subst, Some substs -> Some (subst @ substs)
-          | _ -> None)
-        subs (Some [])
-    else None in
-  match p1, p2 with
-  | P_lit (L_aux (lit1,_)), P_lit (L_aux (lit2,_)) ->
-      if lit1 = lit2 then Some [] else None
-  | P_as (pat1,_), _ -> subsumes_pat pat1 pat2
-  | _, P_as (pat2,_) -> subsumes_pat pat1 pat2
-  | P_typ (_,pat1), _ -> subsumes_pat pat1 pat2
-  | _, P_typ (_,pat2) -> subsumes_pat pat1 pat2
-  | P_id (Id_aux (id1,_) as aid1), P_id (Id_aux (id2,_) as aid2) ->
-    if id1 = id2 then Some []
-    else if Env.lookup_id aid1 (env_of_annot annot1) = Unbound &&
-            Env.lookup_id aid2 (env_of_annot annot2) = Unbound
-           then Some [(id2,id1)] else None
-  | P_id id1, _ ->
-    if Env.lookup_id id1 (env_of_annot annot1) = Unbound then Some [] else None
-  | P_wild, _ -> Some []
-  | P_app (Id_aux (id1,l1),args1), P_app (Id_aux (id2,_),args2) ->
-    if id1 = id2 then subsumes_list subsumes_pat args1 args2 else None
-  | P_record (fps1,b1), P_record (fps2,b2) ->
-    if b1 = b2 then subsumes_list subsumes_fpat fps1 fps2 else None
-  | P_vector pats1, P_vector pats2
-  | P_vector_concat pats1, P_vector_concat pats2
-  | P_tup pats1, P_tup pats2
-  | P_list pats1, P_list pats2 ->
-    subsumes_list subsumes_pat pats1 pats2
-  | P_vector_indexed ips1, P_vector_indexed ips2 ->
-    let (is1,ps1) = List.split ips1 in
-    let (is2,ps2) = List.split ips2 in
-    if is1 = is2 then subsumes_list subsumes_pat ps1 ps2 else None
-  | _ -> None
-and subsumes_fpat (FP_aux (FP_Fpat (id1,pat1),_)) (FP_aux (FP_Fpat (id2,pat2),_)) =
-  if id1 = id2 then subsumes_pat pat1 pat2 else None
-
-let equiv_pats pat1 pat2 =
-  match subsumes_pat pat1 pat2, subsumes_pat pat2 pat1 with
-  | Some _, Some _ -> true
-  | _, _ -> false
-
-let subst_id_pat pat (id1,id2) =
-  let p_id (Id_aux (id,l)) = (if id = id1 then P_id (Id_aux (id2,l)) else P_id (Id_aux (id,l))) in
-  fold_pat {id_pat_alg with p_id = p_id} pat
-
-let subst_id_exp exp (id1,id2) =
-  (* TODO Don't substitute bound occurrences inside let expressions etc *)
-  let e_id (Id_aux (id,l)) = (if id = id1 then E_id (Id_aux (id2,l)) else E_id (Id_aux (id,l))) in
-  fold_exp {id_exp_alg with e_id = e_id} exp
-
-let rec pat_to_exp (P_aux (pat,(l,annot))) =
-  let rewrap e = E_aux (e,(l,annot)) in
-  match pat with
-  | P_lit lit -> rewrap (E_lit lit)
-  | P_wild -> raise (Reporting_basic.err_unreachable l
-      "pat_to_exp given wildcard pattern")
-  | P_as (pat,id) -> rewrap (E_id id)
-  | P_typ (_,pat) -> pat_to_exp pat
-  | P_id id -> rewrap (E_id id)
-  | P_app (id,pats) -> rewrap (E_app (id, List.map pat_to_exp pats))
-  | P_record (fpats,b) ->
-      rewrap (E_record (FES_aux (FES_Fexps (List.map fpat_to_fexp fpats,b),(l,annot))))
-  | P_vector pats -> rewrap (E_vector (List.map pat_to_exp pats))
-  | P_vector_concat pats -> raise (Reporting_basic.err_unreachable l
-      "pat_to_exp not implemented for P_vector_concat")
-      (* We assume that vector concatenation patterns have been transformed
-         away already *)
-  | P_tup pats -> rewrap (E_tuple (List.map pat_to_exp pats))
-  | P_list pats -> rewrap (E_list (List.map pat_to_exp pats))
-  | P_vector_indexed ipats -> raise (Reporting_basic.err_unreachable l
-      "pat_to_exp not implemented for P_vector_indexed") (* TODO *)
-and fpat_to_fexp (FP_aux (FP_Fpat (id,pat),(l,annot))) =
-  FE_aux (FE_Fexp (id, pat_to_exp pat),(l,annot))
-
-let case_exp e t cs =
-  let pexp (pat,body,annot) = Pat_aux (Pat_exp (pat,body),annot) in
-  let ps = List.map pexp cs in
-  (* let efr = union_effs (List.map effect_of_pexp ps) in *)
-  fix_eff_exp (E_aux (E_case (e,ps), (get_loc_exp e, Some (env_of e, t, no_effect))))
-
-let rewrite_guarded_clauses l cs =
-  let rec group clauses =
-    let add_clause (pat,cls,annot) c = (pat,cls @ [c],annot) in
-    let rec group_aux current acc = (function
-      | ((pat,guard,body,annot) as c) :: cs ->
-          let (current_pat,_,_) = current in
-          (match subsumes_pat current_pat pat with
-            | Some substs ->
-                let pat' = List.fold_left subst_id_pat pat substs in
-                let guard' = (match guard with
-                  | Some exp -> Some (List.fold_left subst_id_exp exp substs)
-                  | None -> None) in
-                let body' = List.fold_left subst_id_exp body substs in
-                let c' = (pat',guard',body',annot) in
-                group_aux (add_clause current c') acc cs
-            | None ->
-                let pat = remove_wildcards "g__" pat in
-                group_aux (pat,[c],annot) (acc @ [current]) cs)
-      | [] -> acc @ [current]) in
-    let groups = match clauses with
-      | ((pat,guard,body,annot) as c) :: cs ->
-          group_aux (remove_wildcards "g__" pat, [c], annot) [] cs
-      | _ ->
-          raise (Reporting_basic.err_unreachable l
-            "group given empty list in rewrite_guarded_clauses") in
-    List.map (fun cs -> if_pexp cs) groups
-  and if_pexp (pat,cs,annot) = (match cs with
-    | c :: _ ->
-        (* fix_eff_pexp (pexp *)
-        let body = if_exp pat cs in
-        let pexp = fix_eff_pexp (Pat_aux (Pat_exp (pat,body),annot)) in
-        let (Pat_aux (Pat_exp (_,_),annot)) = pexp in
-        (pat, body, annot)
-    | [] ->
-        raise (Reporting_basic.err_unreachable l
-            "if_pexp given empty list in rewrite_guarded_clauses"))
-  and if_exp current_pat = (function
-    | (pat,guard,body,annot) :: ((pat',guard',body',annot') as c') :: cs ->
-        (match guard with
-          | Some exp ->
-              let else_exp =
-                if equiv_pats current_pat pat'
-                then if_exp current_pat (c' :: cs)
-                else case_exp (pat_to_exp current_pat) (typ_of body') (group (c' :: cs)) in
-              fix_eff_exp (E_aux (E_if (exp,body,else_exp), simple_annot (fst annot) (typ_of body)))
-          | None -> body)
-    | [(pat,guard,body,annot)] -> body
-    | [] ->
-        raise (Reporting_basic.err_unreachable l
-            "if_exp given empty list in rewrite_guarded_clauses")) in
-  group cs
-
-let rewrite_exp_remove_bitvector_pat rewriters (E_aux (exp,(l,annot)) as full_exp) =
-  let rewrap e = E_aux (e,(l,annot)) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters in
-  let rewrite_base = rewrite_exp rewriters in
-  match exp with
-  | E_case (e,ps)
-    when List.exists (fun (Pat_aux (Pat_exp (pat,_),_)) -> contains_bitvector_pat pat) ps ->
-     let clause (Pat_aux (Pat_exp (pat,body),annot')) =
-       let (pat',(guard,decls,_)) = remove_bitvector_pat pat in
-       let body' = decls (rewrite_rec body) in
-       (pat',guard,body',annot') in
-     let clauses = rewrite_guarded_clauses l (List.map clause ps) in
-     if (effectful e) then
-       let e = rewrite_rec e in
-       let (E_aux (_,(el,eannot))) = e in
-       let pat_e' = fresh_id_pat "p__" (el,eannot) in
-       let exp_e' = pat_to_exp pat_e' in
-       (* let fresh = fresh_id "p__" el in
-       let exp_e' = E_aux (E_id fresh, gen_annot l (get_type e) pure_e) in
-       let pat_e' = P_aux (P_id fresh, gen_annot l (get_type e) pure_e) in *)
-       let letbind_e = LB_aux (LB_val_implicit (pat_e',e), (el,eannot)) in
-       let exp' = case_exp exp_e' (typ_of full_exp) clauses in
-       rewrap (E_let (letbind_e, exp'))
-     else case_exp e (typ_of full_exp) clauses
-  | E_let (LB_aux (LB_val_explicit (typ,pat,v),annot'),body) ->
-     let (pat,(_,decls,_)) = remove_bitvector_pat pat in
-     rewrap (E_let (LB_aux (LB_val_explicit (typ,pat,rewrite_rec v),annot'),
-                    decls (rewrite_rec body)))
-  | E_let (LB_aux (LB_val_implicit (pat,v),annot'),body) ->
-     let (pat,(_,decls,_)) = remove_bitvector_pat pat in
-     rewrap (E_let (LB_aux (LB_val_implicit (pat,rewrite_rec v),annot'),
-                    decls (rewrite_rec body)))
-  | _ -> rewrite_base full_exp
-
-let rewrite_fun_remove_bitvector_pat
-      rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) =
-  let _ = reset_fresh_name_counter () in
-  (* TODO Can there be clauses with different id's in one FD_function? *)
-  let funcls = match funcls with
-    | (FCL_aux (FCL_Funcl(id,_,_),_) :: _) ->
-        let clause (FCL_aux (FCL_Funcl(_,pat,exp),annot)) =
-          let (pat,(guard,decls,_)) = remove_bitvector_pat pat in
-          let exp = decls (rewriters.rewrite_exp rewriters exp) in
-          (pat,guard,exp,annot) in
-        let cs = rewrite_guarded_clauses l (List.map clause funcls) in
-        List.map (fun (pat,exp,annot) -> FCL_aux (FCL_Funcl(id,pat,exp),annot)) cs
-    | _ -> funcls (* TODO is the empty list possible here? *) in
-  FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))
-
-let rewrite_defs_remove_bitvector_pats (Defs defs) =
-  let rewriters =
-    {rewrite_exp = rewrite_exp_remove_bitvector_pat;
-     rewrite_pat = rewrite_pat;
-     rewrite_let = rewrite_let;
-     rewrite_lexp = rewrite_lexp;
-     rewrite_fun = rewrite_fun_remove_bitvector_pat;
-     rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base } in
-  let rewrite_def d =
-    let d = rewriters.rewrite_def rewriters d in
-    match d with
-    | DEF_val (LB_aux (LB_val_explicit (t,pat,exp),a)) ->
-       let (pat',(_,_,letbinds)) = remove_bitvector_pat pat in
-       let defvals = List.map (fun lb -> DEF_val lb) letbinds in
-       [DEF_val (LB_aux (LB_val_explicit (t,pat',exp),a))] @ defvals
-    | DEF_val (LB_aux (LB_val_implicit (pat,exp),a)) ->
-       let (pat',(_,_,letbinds)) = remove_bitvector_pat pat in
-       let defvals = List.map (fun lb -> DEF_val lb) letbinds in
-       [DEF_val (LB_aux (LB_val_implicit (pat',exp),a))] @ defvals
-    | d -> [d] in
-  Defs (List.flatten (List.map rewrite_def defs))
-
-
-(*Expects to be called after rewrite_defs; thus the following should not appear:
-  internal_exp of any form
-  lit vectors in patterns or expressions
- *)
-let rewrite_exp_lift_assign_intro rewriters ((E_aux (exp,((l,_) as annot))) as full_exp) = 
-  let rewrap e = E_aux (e,annot) in
-  let rewrap_effects e eff =
-    E_aux (e, (l,Some (env_of_annot annot, typ_of_annot annot, eff))) in
-  let rewrite_rec = rewriters.rewrite_exp rewriters in
-  let rewrite_base = rewrite_exp rewriters in
-  match exp with
-  | E_block exps ->
-    let rec walker exps = match exps with
-      | [] -> []
-      | (E_aux(E_assign((LEXP_aux ((LEXP_id id | LEXP_cast (_,id)),_)) as le,e),
-               ((l, Some (env,typ,eff)) as annot)) as exp)::exps ->
-        (match Env.lookup_id id env with
-         | Unbound ->
-            let le' = rewriters.rewrite_lexp rewriters le in
-            let e' = rewrite_base e in
-            let exps' = walker exps in
-            let effects = union_eff_exps exps' in
-            let block = E_aux (E_block exps', (l, Some (env, unit_typ, effects))) in
-            [fix_eff_exp (E_aux (E_internal_let(le', e', block), annot))]
-         | _ -> (rewrite_rec exp)::(walker exps))
-      (*| ((E_aux(E_if(c,t,e),(l,annot))) as exp)::exps ->
-        let vars_t = introduced_variables t in
-        let vars_e = introduced_variables e in
-        let new_vars = Envmap.intersect vars_t vars_e in
-        if Envmap.is_empty new_vars
-         then (rewrite_base exp)::walker exps
-         else
-           let new_nmap = match nmap with
-             | None -> Some(Nexpmap.empty,new_vars)
-             | Some(nm,s) -> Some(nm, Envmap.union new_vars s) in
-           let c' = rewrite_base c in
-           let t' = rewriters.rewrite_exp rewriters new_nmap t in
-           let e' = rewriters.rewrite_exp rewriters new_nmap e in
-           let exps' = walker exps in
-           fst ((Envmap.fold 
-                  (fun (res,effects) i (t,e) ->
-                let bitlit =  E_aux (E_lit (L_aux(L_zero, Parse_ast.Generated l)),
-                                     (Parse_ast.Generated l, simple_annot bit_t)) in
-                let rangelit = E_aux (E_lit (L_aux (L_num 0, Parse_ast.Generated l)),
-                                      (Parse_ast.Generated l, simple_annot nat_t)) in
-                let set_exp =
-                  match t.t with
-                  | Tid "bit" | Tabbrev(_,{t=Tid "bit"}) -> bitlit
-                  | Tapp("range", _) | Tapp("atom", _) -> rangelit
-                  | Tapp("vector", [_;_;_;TA_typ ( {t=Tid "bit"} | {t=Tabbrev(_,{t=Tid "bit"})})])
-                  | Tapp(("reg"|"register"),[TA_typ ({t = Tapp("vector",
-                                                               [_;_;_;TA_typ ( {t=Tid "bit"}
-                                                                             | {t=Tabbrev(_,{t=Tid "bit"})})])})])
-                  | Tabbrev(_,{t = Tapp("vector",
-                                        [_;_;_;TA_typ ( {t=Tid "bit"}
-                                                      | {t=Tabbrev(_,{t=Tid "bit"})})])}) ->
-                    E_aux (E_vector_indexed([], Def_val_aux(Def_val_dec bitlit,
-                                                            (Parse_ast.Generated l,simple_annot bit_t))),
-                           (Parse_ast.Generated l, simple_annot t))
-                  | _ -> e in
-                let unioneffs = union_effects effects (get_effsum_exp set_exp) in
-                ([E_aux (E_internal_let (LEXP_aux (LEXP_id (Id_aux (Id i, Parse_ast.Generated l)),
-                                                  (Parse_ast.Generated l, (tag_annot t Emp_intro))),
-                                        set_exp,
-                                        E_aux (E_block res, (Parse_ast.Generated l, (simple_annot_efr unit_t effects)))),
-                        (Parse_ast.Generated l, simple_annot_efr unit_t unioneffs))],unioneffs)))
-             (E_aux(E_if(c',t',e'),(Parse_ast.Generated l, annot))::exps',eff_union_exps (c'::t'::e'::exps')) new_vars)*)
-      | e::exps -> (rewrite_rec e)::(walker exps)
-    in
-    rewrap (E_block (walker exps))
-  | E_assign(((LEXP_aux ((LEXP_id id | LEXP_cast (_,id)),lannot)) as le),e) ->
-    let le' = rewriters.rewrite_lexp rewriters le in
-    let e' = rewrite_base e in
-    let effects = effect_of e' in
-    (match Env.lookup_id id (env_of_annot annot) with
-     | Unbound ->
-       rewrap_effects
-         (E_internal_let(le', e', E_aux(E_block [], simple_annot l unit_typ)))
-         effects
-     | Local _ ->
-       let effects' = union_effects effects (effect_of_annot (snd lannot)) in
-       let annot' = Some (env_of_annot annot, unit_typ, effects') in
-       E_aux((E_assign(le', e')),(l, annot'))
-     | _ -> rewrite_base full_exp)
-  | _ -> rewrite_base full_exp
-
-let rewrite_lexp_lift_assign_intro rewriters ((LEXP_aux(lexp,annot)) as le) =
-  let rewrap le = LEXP_aux(le,annot) in
-  let rewrite_base = rewrite_lexp rewriters in
-  match lexp, annot with
-  | (LEXP_id id | LEXP_cast (_,id)), (l, Some (env, typ, eff)) ->
-    (match Env.lookup_id id env with
-    | Unbound | Local _ ->
-      LEXP_aux (lexp, (l, Some (env, typ, union_effects eff (mk_effect [BE_lset]))))
-    | _ -> rewrap lexp)
-  | _ -> rewrite_base le
-
-
-let rewrite_defs_exp_lift_assign defs = rewrite_defs_base
-    {rewrite_exp = rewrite_exp_lift_assign_intro;
-     rewrite_pat = rewrite_pat;
-     rewrite_let = rewrite_let;
-     rewrite_lexp = rewrite_lexp_lift_assign_intro;
-     rewrite_fun = rewrite_fun;
-     rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base} defs
-
-(*let rewrite_exp_separate_ints rewriters ((E_aux (exp,((l,_) as annot))) as full_exp) =
-  (*let tparms,t,tag,nexps,eff,cum_eff,bounds = match annot with
-    | Base((tparms,t),tag,nexps,eff,cum_eff,bounds) -> tparms,t,tag,nexps,eff,cum_eff,bounds
-    | _ -> [],unit_t,Emp_local,[],pure_e,pure_e,nob in*)
-  let rewrap e = E_aux (e,annot) in
-  (*let rewrap_effects e effsum =
-    E_aux (e,(l,Base ((tparms,t),tag,nexps,eff,effsum,bounds))) in*)
-  let rewrite_rec = rewriters.rewrite_exp rewriters in
-  let rewrite_base = rewrite_exp rewriters in
-  match exp with
-  | E_lit (L_aux (((L_num _) as lit),_)) ->
-    (match (is_within_machine64 t nexps) with
-     | Yes -> let _ = Printf.eprintf "Rewriter of num_const, within 64bit int yes\n" in rewrite_base full_exp
-     | Maybe -> let _ = Printf.eprintf "Rewriter of num_const, within 64bit int maybe\n" in rewrite_base full_exp
-     | No -> let _ = Printf.eprintf "Rewriter of num_const, within 64bit int no\n" in E_aux(E_app(Id_aux (Id "integer_of_int",l),[rewrite_base full_exp]),
-                   (l, Base((tparms,t),External(None),nexps,eff,cum_eff,bounds))))
-  | E_cast (typ, exp) -> rewrap (E_cast (typ, rewrite_rec exp))
-  | E_app (id,exps) -> rewrap (E_app (id,List.map rewrite_rec exps))
-  | E_app_infix(el,id,er) -> rewrap (E_app_infix(rewrite_rec el,id,rewrite_rec er))
-  | E_for (id, e1, e2, e3, o, body) ->
-      rewrap (E_for (id, rewrite_rec e1, rewrite_rec e2, rewrite_rec e3, o, rewrite_rec body))
-  | E_vector_access (vec,index) -> rewrap (E_vector_access (rewrite_rec vec,rewrite_rec index))
-  | E_vector_subrange (vec,i1,i2) ->
-    rewrap (E_vector_subrange (rewrite_rec vec,rewrite_rec i1,rewrite_rec i2))
-  | E_vector_update (vec,index,new_v) -> 
-    rewrap (E_vector_update (rewrite_rec vec,rewrite_rec index,rewrite_rec new_v))
-  | E_vector_update_subrange (vec,i1,i2,new_v) ->
-    rewrap (E_vector_update_subrange (rewrite_rec vec,rewrite_rec i1,rewrite_rec i2,rewrite_rec new_v))
-  | E_case (exp ,pexps) -> 
-    rewrap (E_case (rewrite_rec exp,
-                    (List.map 
-                       (fun (Pat_aux (Pat_exp(p,e),pannot)) -> 
-                          Pat_aux (Pat_exp(rewriters.rewrite_pat rewriters nmap p,rewrite_rec e),pannot)) pexps)))
-  | E_let (letbind,body) -> rewrap (E_let(rewriters.rewrite_let rewriters nmap letbind,rewrite_rec body))
-  | E_internal_let (lexp,exp,body) ->
-    rewrap (E_internal_let (rewriters.rewrite_lexp rewriters nmap lexp, rewrite_rec exp, rewrite_rec body))
-  | _ -> rewrite_base full_exp
-
-let rewrite_defs_separate_numbs defs = rewrite_defs_base
-    {rewrite_exp = rewrite_exp_separate_ints;
-     rewrite_pat = rewrite_pat;
-     rewrite_let = rewrite_let; (*will likely need a new one?*)
-     rewrite_lexp = rewrite_lexp; (*will likely need a new one?*)
-     rewrite_fun = rewrite_fun;
-     rewrite_def = rewrite_def;
-     rewrite_defs = rewrite_defs_base} defs*)
-
-let rewrite_defs_ocaml defs =
-  let defs_sorted = top_sort_defs defs in
-  let defs_vec_concat_removed = rewrite_defs_remove_vector_concat defs_sorted in
-  let defs_lifted_assign = rewrite_defs_exp_lift_assign defs_vec_concat_removed in
-(*  let defs_separate_nums = rewrite_defs_separate_numbs defs_lifted_assign in *)
-  defs_lifted_assign
-
-let rewrite_defs_remove_blocks =
-  let letbind_wild v body =
-    let (E_aux (_,(l,tannot))) = v in
-    let annot_pat = (simple_annot l (typ_of v)) in
-    let annot_lb = (Parse_ast.Generated l, tannot) in
-    let annot_let = (Parse_ast.Generated l, Some (env_of body, typ_of body, union_eff_exps [v;body])) in
-    E_aux (E_let (LB_aux (LB_val_implicit (P_aux (P_wild,annot_pat),v),annot_lb),body),annot_let) in
-
-  let rec f l = function
-    | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)), (simple_annot l unit_typ))
-    | [e] -> e  (* check with Kathy if that annotation is fine *)
-    | e :: es -> letbind_wild e (f l es) in
-
-  let e_aux = function
-    | (E_block es,(l,_)) -> f l es
-    | (e,annot) -> E_aux (e,annot) in
-    
-  let alg = { id_exp_alg with e_aux = e_aux } in
-
-  rewrite_defs_base
-    {rewrite_exp = (fun _ -> fold_exp alg)
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-
-
-
-let letbind (v : 'a exp) (body : 'a exp -> 'a exp) : 'a exp =
-  (* body is a function : E_id variable -> actual body *)
-  let (E_aux (_,(l,annot))) = v in
-  match annot with
-  | Some (env, Typ_aux (Typ_id tid, _), eff) when string_of_id tid = "unit" ->
-     let e = E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(simple_annot l unit_typ))  in
-     let body = body e in
-     let annot_pat = simple_annot l unit_typ in
-     let annot_lb = annot_pat in
-     let annot_let = (Parse_ast.Generated l, Some (env, typ_of body, union_eff_exps [v;body])) in
-     let pat = P_aux (P_wild,annot_pat) in
-     
-     E_aux (E_let (LB_aux (LB_val_implicit (pat,v),annot_lb),body),annot_let)
-  | Some (env, typ, eff) ->
-     let id = fresh_id "w__" l in
-     let annot_pat = simple_annot l (typ_of v) in
-     let e_id = E_aux (E_id id, (Parse_ast.Generated l, Some (env, typ, no_effect))) in
-     let body = body e_id in
-
-     let annot_lb = annot_pat in
-     let annot_let = (Parse_ast.Generated l, Some (env, typ_of body, union_eff_exps [v;body])) in
-     let pat = P_aux (P_id id,annot_pat) in
-     
-     E_aux (E_let (LB_aux (LB_val_implicit (pat,v),annot_lb),body),annot_let)
-  | None ->
-     raise (Reporting_basic.err_unreachable l "no type information")
-
-
-let rec mapCont (f : 'b -> ('b -> 'a exp) -> 'a exp) (l : 'b list) (k : 'b list -> 'a exp) : 'a exp = 
-  match l with
-  | [] -> k []
-  | exp :: exps -> f exp (fun exp -> mapCont f exps (fun exps -> k (exp :: exps)))
-                
-let rewrite_defs_letbind_effects  =  
-
-  let rec value ((E_aux (exp_aux,_)) as exp) =
-    not (effectful exp || updates_vars exp)
-  and value_optdefault (Def_val_aux (o,_)) = match o with
-    | Def_val_empty -> true
-    | Def_val_dec e -> value e
-  and value_fexps (FES_aux (FES_Fexps (fexps,_),_)) =
-    List.fold_left (fun b (FE_aux (FE_Fexp (_,e),_)) -> b && value e) true fexps in
-
-
-  let rec n_exp_name (exp : 'a exp) (k : 'a exp -> 'a exp) : 'a exp =
-    n_exp exp (fun exp -> if value exp then k exp else letbind exp k)
-
-  and n_exp_pure (exp : 'a exp) (k : 'a exp -> 'a exp) : 'a exp =
-    n_exp exp (fun exp -> if value exp then k exp else letbind exp k)
-
-  and n_exp_nameL (exps : 'a exp list) (k : 'a exp list -> 'a exp) : 'a exp =
-    mapCont n_exp_name exps k
-
-  and n_fexp (fexp : 'a fexp) (k : 'a fexp -> 'a exp) : 'a exp =
-    let (FE_aux (FE_Fexp (id,exp),annot)) = fexp in
-    n_exp_name exp (fun exp -> 
-    k (fix_eff_fexp (FE_aux (FE_Fexp (id,exp),annot))))
-
-  and n_fexpL (fexps : 'a fexp list) (k : 'a fexp list -> 'a exp) : 'a exp =
-    mapCont n_fexp fexps k
-
-  and n_pexp (newreturn : bool) (pexp : 'a pexp) (k : 'a pexp -> 'a exp) : 'a exp =
-    let (Pat_aux (Pat_exp (pat,exp),annot)) = pexp in
-    k (fix_eff_pexp (Pat_aux (Pat_exp (pat,n_exp_term newreturn exp), annot)))
-
-  and n_pexpL (newreturn : bool) (pexps : 'a pexp list) (k : 'a pexp list -> 'a exp) : 'a exp =
-    mapCont (n_pexp newreturn) pexps k
-
-  and n_fexps (fexps : 'a fexps) (k : 'a fexps -> 'a exp) : 'a exp = 
-    let (FES_aux (FES_Fexps (fexps_aux,b),annot)) = fexps in
-    n_fexpL fexps_aux (fun fexps_aux -> 
-    k (fix_eff_fexps (FES_aux (FES_Fexps (fexps_aux,b),annot))))
-
-  and n_opt_default (opt_default : 'a opt_default) (k : 'a opt_default -> 'a exp) : 'a exp = 
-    let (Def_val_aux (opt_default,annot)) = opt_default in
-    match opt_default with
-    | Def_val_empty -> k (Def_val_aux (Def_val_empty,annot))
-    | Def_val_dec exp ->
-       n_exp_name exp (fun exp -> 
-       k (fix_eff_opt_default (Def_val_aux (Def_val_dec exp,annot))))
-
-  and n_lb (lb : 'a letbind) (k : 'a letbind -> 'a exp) : 'a exp =
-    let (LB_aux (lb,annot)) = lb in
-    match lb with
-    | LB_val_explicit (typ,pat,exp1) ->
-       n_exp exp1 (fun exp1 -> 
-       k (fix_eff_lb (LB_aux (LB_val_explicit (typ,pat,exp1),annot))))
-    | LB_val_implicit (pat,exp1) ->
-       n_exp exp1 (fun exp1 -> 
-       k (fix_eff_lb (LB_aux (LB_val_implicit (pat,exp1),annot))))
-
-  and n_lexp (lexp : 'a lexp) (k : 'a lexp -> 'a exp) : 'a exp =
-    let (LEXP_aux (lexp_aux,annot)) = lexp in
-    match lexp_aux with
-    | LEXP_id _ -> k lexp
-    | LEXP_memory (id,es) ->
-       n_exp_nameL es (fun es -> 
-       k (fix_eff_lexp (LEXP_aux (LEXP_memory (id,es),annot))))
-    | LEXP_cast (typ,id) -> 
-       k (fix_eff_lexp (LEXP_aux (LEXP_cast (typ,id),annot)))
-    | LEXP_vector (lexp,e) ->
-       n_lexp lexp (fun lexp -> 
-       n_exp_name e (fun e -> 
-       k (fix_eff_lexp (LEXP_aux (LEXP_vector (lexp,e),annot)))))
-    | LEXP_vector_range (lexp,e1,e2) ->
-       n_lexp lexp (fun lexp ->
-       n_exp_name e1 (fun e1 ->
-       n_exp_name e2 (fun e2 ->
-       k (fix_eff_lexp (LEXP_aux (LEXP_vector_range (lexp,e1,e2),annot))))))
-    | LEXP_field (lexp,id) ->
-       n_lexp lexp (fun lexp ->
-       k (fix_eff_lexp (LEXP_aux (LEXP_field (lexp,id),annot))))
-
-  and n_exp_term (newreturn : bool) (exp : 'a exp) : 'a exp =
-    let (E_aux (_,(l,tannot))) = exp in
-    let exp =
-      if newreturn then
-        let typ = typ_of exp in
-        E_aux (E_internal_return exp, simple_annot l typ)
-      else
-        exp in
-    (* n_exp_term forces an expression to be translated into a form 
-       "let .. let .. let .. in EXP" where EXP has no effect and does not update
-       variables *)
-    n_exp_pure exp (fun exp -> exp)
-
-  and n_exp (E_aux (exp_aux,annot) as exp : 'a exp) (k : 'a exp -> 'a exp) : 'a exp = 
-
-    let rewrap e = fix_eff_exp (E_aux (e,annot)) in
-
-    match exp_aux with
-    | E_block es -> failwith "E_block should have been removed till now"
-    | E_nondet _ -> failwith "E_nondet not supported"
-    | E_id id -> k exp
-    | E_lit _ -> k exp
-    | E_cast (typ,exp') ->
-       n_exp_name exp' (fun exp' ->
-       k (rewrap (E_cast (typ,exp'))))
-    | E_app (id,exps) ->
-       n_exp_nameL exps (fun exps ->
-       k (rewrap (E_app (id,exps))))
-    | E_app_infix (exp1,id,exp2) ->
-       n_exp_name exp1 (fun exp1 ->
-       n_exp_name exp2 (fun exp2 ->
-       k (rewrap (E_app_infix (exp1,id,exp2)))))
-    | E_tuple exps ->
-       n_exp_nameL exps (fun exps ->
-       k (rewrap (E_tuple exps)))
-    | E_if (exp1,exp2,exp3) ->
-       n_exp_name exp1 (fun exp1 ->
-       let (E_aux (_,annot2)) = exp2 in
-       let (E_aux (_,annot3)) = exp3 in
-       let newreturn = effectful exp2 || effectful exp3 in
-       let exp2 = n_exp_term newreturn exp2 in
-       let exp3 = n_exp_term newreturn exp3 in
-       k (rewrap (E_if (exp1,exp2,exp3))))
-    | E_for (id,start,stop,by,dir,body) ->
-       n_exp_name start (fun start -> 
-       n_exp_name stop (fun stop ->
-       n_exp_name by (fun by ->
-       let body = n_exp_term (effectful body) body in
-       k (rewrap (E_for (id,start,stop,by,dir,body))))))
-    | E_vector exps ->
-       n_exp_nameL exps (fun exps ->
-       k (rewrap (E_vector exps)))
-    | E_vector_indexed (exps,opt_default)  ->
-       let (is,exps) = List.split exps in
-       n_exp_nameL exps (fun exps -> 
-       n_opt_default opt_default (fun opt_default ->
-       let exps = List.combine is exps in
-       k (rewrap (E_vector_indexed (exps,opt_default)))))
-    | E_vector_access (exp1,exp2) ->
-       n_exp_name exp1 (fun exp1 ->
-       n_exp_name exp2 (fun exp2 ->
-       k (rewrap (E_vector_access (exp1,exp2)))))
-    | E_vector_subrange (exp1,exp2,exp3) ->
-       n_exp_name exp1 (fun exp1 -> 
-       n_exp_name exp2 (fun exp2 -> 
-       n_exp_name exp3 (fun exp3 ->
-       k (rewrap (E_vector_subrange (exp1,exp2,exp3))))))
-    | E_vector_update (exp1,exp2,exp3) ->
-       n_exp_name exp1 (fun exp1 -> 
-       n_exp_name exp2 (fun exp2 -> 
-       n_exp_name exp3 (fun exp3 ->
-       k (rewrap (E_vector_update (exp1,exp2,exp3))))))
-    | E_vector_update_subrange (exp1,exp2,exp3,exp4) ->
-       n_exp_name exp1 (fun exp1 -> 
-       n_exp_name exp2 (fun exp2 -> 
-       n_exp_name exp3 (fun exp3 -> 
-       n_exp_name exp4 (fun exp4 ->
-       k (rewrap (E_vector_update_subrange (exp1,exp2,exp3,exp4)))))))
-    | E_vector_append (exp1,exp2) ->
-       n_exp_name exp1 (fun exp1 ->
-       n_exp_name exp2 (fun exp2 ->
-       k (rewrap (E_vector_append (exp1,exp2)))))
-    | E_list exps ->
-       n_exp_nameL exps (fun exps ->
-       k (rewrap (E_list exps)))
-    | E_cons (exp1,exp2) -> 
-       n_exp_name exp1 (fun exp1 ->
-       n_exp_name exp2 (fun exp2 ->
-       k (rewrap (E_cons (exp1,exp2)))))
-    | E_record fexps ->
-       n_fexps fexps (fun fexps ->
-       k (rewrap (E_record fexps)))
-    | E_record_update (exp1,fexps) -> 
-       n_exp_name exp1 (fun exp1 ->
-       n_fexps fexps (fun fexps ->
-       k (rewrap (E_record_update (exp1,fexps)))))
-    | E_field (exp1,id) ->
-       n_exp_name exp1 (fun exp1 ->
-       k (rewrap (E_field (exp1,id))))
-    | E_case (exp1,pexps) ->
-       let newreturn =
-         List.fold_left
-           (fun b (Pat_aux (_,(_,annot))) -> b || effectful_effs (effect_of_annot annot))
-           false pexps in
-       n_exp_name exp1 (fun exp1 -> 
-       n_pexpL newreturn pexps (fun pexps ->
-       k (rewrap (E_case (exp1,pexps)))))
-    | E_let (lb,body) ->
-       n_lb lb (fun lb -> 
-       rewrap (E_let (lb,n_exp body k)))
-    | E_sizeof nexp ->
-       k (rewrap (E_sizeof nexp))
-    | E_sizeof_internal annot ->
-       k (rewrap (E_sizeof_internal annot))
-    | E_assign (lexp,exp1) ->
-       n_lexp lexp (fun lexp ->
-       n_exp_name exp1 (fun exp1 ->
-       k (rewrap (E_assign (lexp,exp1)))))
-    | E_exit exp' -> k (E_aux (E_exit (n_exp_term (effectful exp') exp'),annot))
-    | E_assert (exp1,exp2) ->
-       n_exp exp1 (fun exp1 ->
-       n_exp exp2 (fun exp2 ->
-       k (rewrap (E_assert (exp1,exp2)))))
-    | E_internal_cast (annot',exp') ->
-       n_exp_name exp' (fun exp' ->
-       k (rewrap (E_internal_cast (annot',exp'))))
-    | E_internal_exp _ -> k exp
-    | E_internal_exp_user _ -> k exp
-    | E_internal_let (lexp,exp1,exp2) ->
-       n_lexp lexp (fun lexp ->
-       n_exp exp1 (fun exp1 ->
-       rewrap (E_internal_let (lexp,exp1,n_exp exp2 k))))
-    | E_internal_return exp1 ->
-       n_exp_name exp1 (fun exp1 ->
-       k (rewrap (E_internal_return exp1)))
-    | E_comment str ->
-      k (rewrap (E_comment str))
-    | E_comment_struc exp' ->
-       n_exp exp' (fun exp' ->
-               k (rewrap (E_comment_struc exp')))
-    | E_return exp' ->
-       n_exp_name exp' (fun exp' ->
-       k (rewrap (E_return exp')))
-    | E_internal_plet _ -> failwith "E_internal_plet should not be here yet" in
-
-  let rewrite_fun _ (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),fdannot)) = 
-    let newreturn =
-      List.fold_left
-        (fun b (FCL_aux (FCL_Funcl(id,pat,exp),(_,annot))) ->
-         b || effectful_effs (effect_of_annot annot)) false funcls in
-    let rewrite_funcl (FCL_aux (FCL_Funcl(id,pat,exp),annot)) =
-      let _ = reset_fresh_name_counter () in
-      FCL_aux (FCL_Funcl (id,pat,n_exp_term newreturn exp),annot)
-    in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),fdannot) in
-  rewrite_defs_base
-    {rewrite_exp = rewrite_exp
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-
-let rewrite_defs_effectful_let_expressions =
-
-  let e_let (lb,body) = 
-    match lb with
-    | LB_aux (LB_val_explicit (_,pat,exp'),annot')
-    | LB_aux (LB_val_implicit (pat,exp'),annot') ->
-       if effectful exp'
-       then E_internal_plet (pat,exp',body)
-       else E_let (lb,body) in
-                             
-  let e_internal_let = fun (lexp,exp1,exp2) ->
-    if effectful exp1 then
-      match lexp with
-      | LEXP_aux (LEXP_id id,annot)
-      | LEXP_aux (LEXP_cast (_,id),annot) ->
-         E_internal_plet (P_aux (P_id id,annot),exp1,exp2)
-      | _ -> failwith "E_internal_plet with unexpected lexp"
-    else E_internal_let (lexp,exp1,exp2) in
-
-  let alg = { id_exp_alg with e_let = e_let; e_internal_let = e_internal_let } in
-  rewrite_defs_base
-    {rewrite_exp = (fun _ -> fold_exp alg)
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-
-             
-(* Now all expressions have no blocks anymore, any term is a sequence of let-expressions,
- * internal let-expressions, or internal plet-expressions ended by a term that does not
- * access memory or registers and does not update variables *)
-
-let dedup eq =
-  List.fold_left (fun acc e -> if List.exists (eq e) acc then acc else e :: acc) []
-
-let eqidtyp (id1,_) (id2,_) =
-  let name1 = match id1 with Id_aux ((Id name | DeIid name),_) -> name in
-  let name2 = match id2 with Id_aux ((Id name | DeIid name),_) -> name in
-  name1 = name2
-
-let find_updated_vars exp = 
-  let ( @@ ) (a,b) (a',b') = (a @ a',b @ b') in
-  let lapp2 (l : (('a list * 'b list) list)) : ('a list * 'b list) =
-    List.fold_left
-      (fun ((intros_acc : 'a list),(updates_acc : 'b list)) (intros,updates) ->
-       (intros_acc @ intros, updates_acc @ updates)) ([],[]) l in
-  
-  let (intros,updates) =
-    fold_exp
-      { e_aux = (fun (e,_) -> e)
-      ; e_id = (fun _ -> ([],[]))
-      ; e_lit = (fun _ -> ([],[]))
-      ; e_cast = (fun (_,e) -> e)
-      ; e_block = (fun es -> lapp2 es)
-      ; e_nondet = (fun es -> lapp2 es)
-      ; e_app = (fun (_,es) -> lapp2 es)
-      ; e_app_infix = (fun (e1,_,e2) -> e1 @@ e2)
-      ; e_tuple = (fun es -> lapp2 es)
-      ; e_if = (fun (e1,e2,e3) -> e1 @@ e2 @@ e3)
-      ; e_for = (fun (_,e1,e2,e3,_,e4) -> e1 @@ e2 @@ e3 @@ e4)
-      ; e_vector = (fun es -> lapp2 es)
-      ; e_vector_indexed = (fun (es,opt) -> opt @@ lapp2 (List.map snd es))
-      ; e_vector_access = (fun (e1,e2) -> e1 @@ e2)
-      ; e_vector_subrange =  (fun (e1,e2,e3) -> e1 @@ e2 @@ e3)
-      ; e_vector_update = (fun (e1,e2,e3) -> e1 @@ e2 @@ e3)
-      ; e_vector_update_subrange =  (fun (e1,e2,e3,e4) -> e1 @@ e2 @@ e3 @@ e4)
-      ; e_vector_append = (fun (e1,e2) -> e1 @@ e2)
-      ; e_list = (fun es -> lapp2 es)
-      ; e_cons = (fun (e1,e2) -> e1 @@ e2)
-      ; e_record = (fun fexps -> fexps)
-      ; e_record_update = (fun (e1,fexp) -> e1 @@ fexp)
-      ; e_field = (fun (e1,id) -> e1)
-      ; e_case = (fun (e1,pexps) -> e1 @@ lapp2 pexps)
-      ; e_let = (fun (lb,e2) -> lb @@ e2)
-      ; e_assign = (fun ((ids,acc),e2) -> ([],ids) @@ acc @@ e2)
-      ; e_sizeof = (fun nexp -> ([],[]))
-      ; e_exit = (fun e1 -> ([],[]))
-      ; e_return = (fun e1 -> e1)
-      ; e_assert = (fun (e1,e2) -> ([],[]))
-      ; e_internal_cast = (fun (_,e1) -> e1)
-      ; e_internal_exp = (fun _ -> ([],[]))
-      ; e_internal_exp_user = (fun _ -> ([],[]))
-      ; e_internal_let =
-          (fun (([id],acc),e2,e3) ->
-           let (xs,ys) = ([id],[]) @@ acc @@ e2 @@ e3 in
-           let ys = List.filter (fun id2 -> not (eqidtyp id id2)) ys in
-           (xs,ys))
-      ; e_internal_plet = (fun (_, e1, e2) -> e1 @@ e2)
-      ; e_internal_return = (fun e -> e)
-      ; lEXP_id = (fun id -> (Some id,[],([],[])))
-      ; lEXP_memory = (fun (_,es) -> (None,[],lapp2 es))
-      ; lEXP_cast = (fun (_,id) -> (Some id,[],([],[])))
-      ; lEXP_tup = (fun tups -> failwith "FORCHRISTOPHER:: this needs implementing, not sure what you want to do")
-      ; lEXP_vector = (fun ((ids,acc),e1) -> (None,ids,acc @@ e1))
-      ; lEXP_vector_range = (fun ((ids,acc),e1,e2) -> (None,ids,acc @@ e1 @@ e2))
-      ; lEXP_field = (fun ((ids,acc),_) -> (None,ids,acc))
-      ; lEXP_aux =
-          (function
-            | ((Some id,ids,acc),(annot)) ->
-               (match Env.lookup_id id (env_of_annot annot) with
-               | Unbound | Local _ -> ((id,annot) :: ids,acc)
-               | _ -> (ids,acc))
-            | ((_,ids,acc),_) -> (ids,acc)
-          )
-      ; fE_Fexp = (fun (_,e) -> e)
-      ; fE_aux = (fun (fexp,_) -> fexp)
-      ; fES_Fexps = (fun (fexps,_) -> lapp2 fexps)
-      ; fES_aux = (fun (fexp,_) -> fexp)
-      ; def_val_empty = ([],[])
-      ; def_val_dec = (fun e -> e)
-      ; def_val_aux = (fun (defval,_) -> defval)
-      ; pat_exp = (fun (_,e) -> e)
-      ; pat_aux = (fun (pexp,_) -> pexp)
-      ; lB_val_explicit = (fun (_,_,e) -> e)
-      ; lB_val_implicit = (fun (_,e) -> e)
-      ; lB_aux = (fun (lb,_) -> lb)
-      ; pat_alg = id_pat_alg
-      } exp in
-  dedup eqidtyp updates
-
-let swaptyp typ (l,tannot) = match tannot with
-  | Some (env, typ', eff) -> (l, Some (env, typ, eff))
-  | _ -> raise (Reporting_basic.err_unreachable l "swaptyp called with empty type annotation")
-
-let mktup l es =
-  match es with
-  | [] -> E_aux (E_lit (L_aux (L_unit,Parse_ast.Generated l)),(simple_annot l unit_typ))
-  | [e] -> e
-  | e :: _ -> 
-     let effs =
-       List.fold_left (fun acc e -> union_effects acc (effect_of e)) no_effect es in
-     let typ = mk_typ (Typ_tup (List.map typ_of es)) in
-     E_aux (E_tuple es,(Parse_ast.Generated l, Some (env_of e, typ, effs)))
-
-let mktup_pat l es =
-  match es with
-  | [] -> P_aux (P_wild,(simple_annot l unit_typ))
-  | [E_aux (E_id id,_) as exp] ->
-     P_aux (P_id id,(simple_annot l (typ_of exp)))
-  | _ ->
-     let typ = mk_typ (Typ_tup (List.map typ_of es)) in
-     let pats = List.map (function
-       | (E_aux (E_id id,_) as exp) ->
-         P_aux (P_id id,(simple_annot l (typ_of exp)))
-       | exp ->
-         P_aux (P_wild,(simple_annot l (typ_of exp)))) es in
-     P_aux (P_tup pats,(simple_annot l typ))
-
-
-type 'a updated_term =
-  | Added_vars of 'a exp * 'a pat
-  | Same_vars of 'a exp
-
-let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
-
-  let rec add_vars overwrite ((E_aux (expaux,annot)) as exp) vars =
-    match expaux with
-    | E_let (lb,exp) ->
-       let exp = add_vars overwrite exp vars in
-       E_aux (E_let (lb,exp),swaptyp (typ_of exp) annot)
-    | E_internal_let (lexp,exp1,exp2) ->
-       let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_let (lexp,exp1,exp2), swaptyp (typ_of exp2) annot)
-    | E_internal_plet (pat,exp1,exp2) ->
-       let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_plet (pat,exp1,exp2), swaptyp (typ_of exp2) annot)
-    | E_internal_return exp2 ->
-       let exp2 = add_vars overwrite exp2 vars in
-       E_aux (E_internal_return exp2,swaptyp (typ_of exp2) annot)
-    | _ ->
-       (* after rewrite_defs_letbind_effects there cannot be terms that have
-          effects/update local variables in "tail-position": check n_exp_term
-          and where it is used. *)
-       if overwrite then
-         match typ_of exp with
-         | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> vars
-         | _ -> raise (Reporting_basic.err_unreachable l
-             "add_vars: trying to overwrite a non-unit expression in tail-position")
-       else
-         let typ' = Typ_aux (Typ_tup [typ_of exp;typ_of vars], Parse_ast.Generated l) in
-         E_aux (E_tuple [exp;vars],swaptyp typ' annot) in
-  
-  let rewrite (E_aux (expaux,((el,_) as annot))) (P_aux (_,(pl,pannot)) as pat) =
-    let overwrite = match typ_of_annot annot with
-      | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> true
-      | _ -> false in
-    match expaux with
-    | E_for(id,exp1,exp2,exp3,order,exp4) ->
-       (* Translate for loops into calls to one of the foreach combinators.
-          The loop body becomes a function of the loop variable and any
-          mutable local variables that are updated inside the loop.
-          Since the foreach* combinators are higher-order functions,
-          they cannot be represented faithfully in the AST. The following
-          code abuses the parameters of an E_app node, embedding the loop body
-          function as an expression followed by the list of variables it
-          expects. In (Lem) pretty-printing, this turned into an anonymous
-          function and passed to foreach*. *)
-       let vars = List.map (fun (var,(l,t)) -> E_aux (E_id var,(l,t))) (find_updated_vars exp4) in
-       let vartuple = mktup el vars in
-       let exp4 = rewrite_var_updates (add_vars overwrite exp4 vartuple) in
-       let (E_aux (_,(_,annot4))) = exp4 in
-       let fname = match effectful exp4,order with
-         | false, Ord_aux (Ord_inc,_) -> "foreach_inc"
-         | false, Ord_aux (Ord_dec,_) -> "foreach_dec"
-         | true,  Ord_aux (Ord_inc,_) -> "foreachM_inc"
-         | true,  Ord_aux (Ord_dec,_) -> "foreachM_dec" in
-       let funcl = Id_aux (Id fname,Parse_ast.Generated el) in
-       let loopvar =
-         (* Don't bother with creating a range type annotation, since the
-         Lem pretty-printing does not use it. *)
-         (* let (bf,tf) = match typ_of exp1 with
-           | {t = Tapp ("atom",[TA_nexp f])} -> (TA_nexp f,TA_nexp f)
-           | {t = Tapp ("reg", [TA_typ {t = Tapp ("atom",[TA_nexp f])}])} -> (TA_nexp f,TA_nexp f)
-           | {t = Tapp ("range",[TA_nexp bf;TA_nexp tf])} -> (TA_nexp bf,TA_nexp tf)
-           | {t = Tapp ("reg", [TA_typ {t = Tapp ("range",[TA_nexp bf;TA_nexp tf])}])} -> (TA_nexp bf,TA_nexp tf)
-           | {t = Tapp (name,_)} -> failwith (name ^ " shouldn't be here") in
-         let (bt,tt) = match typ_of exp2 with
-           | {t = Tapp ("atom",[TA_nexp t])} -> (TA_nexp t,TA_nexp t)
-           | {t = Tapp ("atom",[TA_typ {t = Tapp ("atom", [TA_nexp t])}])} -> (TA_nexp t,TA_nexp t)
-           | {t = Tapp ("range",[TA_nexp bt;TA_nexp tt])} -> (TA_nexp bt,TA_nexp tt)
-           | {t = Tapp ("atom",[TA_typ {t = Tapp ("range",[TA_nexp bt;TA_nexp tt])}])} -> (TA_nexp bt,TA_nexp tt)
-           | {t = Tapp (name,_)} -> failwith (name ^ " shouldn't be here") in
-         let t = {t = Tapp ("range",match order with
-                                    | Ord_aux (Ord_inc,_) -> [bf;tt]
-                                    | Ord_aux (Ord_dec,_) -> [tf;bt])} in *)
-         E_aux (E_id id, simple_annot l int_typ) in
-       let v = E_aux (E_app (funcl,[loopvar;mktup el [exp1;exp2;exp3];exp4;vartuple]),
-                      (Parse_ast.Generated el, annot4)) in
-       let pat =
-         if overwrite then mktup_pat el vars
-         else P_aux (P_tup [pat; mktup_pat pl vars],
-                     simple_annot pl (typ_of v)) in
-       Added_vars (v,pat)
-    | E_if (c,e1,e2) ->
-       let vars = List.map (fun (var,(l,t)) -> E_aux (E_id var,(l,t)))
-                           (dedup eqidtyp (find_updated_vars e1 @ find_updated_vars e2)) in
-       if vars = [] then
-         (Same_vars (E_aux (E_if (c,rewrite_var_updates e1,rewrite_var_updates e2),annot)))
-       else
-         let vartuple = mktup el vars in
-         let e1 = rewrite_var_updates (add_vars overwrite e1 vartuple) in
-         let e2 = rewrite_var_updates (add_vars overwrite e2 vartuple) in
-         (* after rewrite_defs_letbind_effects c has no variable updates *)
-         let env = env_of_annot annot in
-         let typ = typ_of e1 in
-         let eff = union_eff_exps [e1;e2] in
-         let v = E_aux (E_if (c,e1,e2), (Parse_ast.Generated el, Some (env, typ, eff))) in
-         let pat =
-           if overwrite then mktup_pat el vars
-           else P_aux (P_tup [pat; mktup_pat pl vars],
-                       (simple_annot pl (typ_of v))) in
-         Added_vars (v,pat)
-    | E_case (e1,ps) ->
-       (* after rewrite_defs_letbind_effects e1 needs no rewriting *)
-       let vars =
-                 let f acc (Pat_aux (Pat_exp (_,e),_)) = acc @ find_updated_vars e in
-         List.map (fun (var,(l,t)) -> E_aux (E_id var,(l,t)))
-                  (dedup eqidtyp (List.fold_left f [] ps)) in
-       if vars = [] then
-         let ps = List.map (fun (Pat_aux (Pat_exp (p,e),a)) -> Pat_aux (Pat_exp (p,rewrite_var_updates e),a)) ps in
-         Same_vars (E_aux (E_case (e1,ps),annot))
-       else
-         let vartuple = mktup el vars in
-         let typ = 
-           let (Pat_aux (Pat_exp (_,first),_)) = List.hd ps in
-           typ_of first in
-         let (ps,typ,effs) =
-           let f (acc,typ,effs) (Pat_aux (Pat_exp (p,e),pannot)) =
-             let etyp = typ_of e in
-             let () = assert (string_of_typ etyp = string_of_typ typ) in
-             let e = rewrite_var_updates (add_vars overwrite e vartuple) in
-             let pannot = simple_annot pl (typ_of e) in
-             let effs = union_effects effs (effect_of e) in
-             let pat' = Pat_aux (Pat_exp (p,e),pannot) in
-             (acc @ [pat'],typ,effs) in
-           List.fold_left f ([],typ,no_effect) ps in
-         let v = E_aux (E_case (e1,ps), (Parse_ast.Generated pl, Some (env_of_annot annot, typ, effs))) in
-         let pat =
-           if overwrite then mktup_pat el vars
-           else P_aux (P_tup [pat; mktup_pat pl vars],
-                       (simple_annot pl (typ_of v))) in
-         Added_vars (v,pat)
-    | E_assign (lexp,vexp) ->
-       let effs = match effect_of_annot (snd annot) with
-         | Effect_aux (Effect_set effs, _) -> effs
-         | _ ->
-           raise (Reporting_basic.err_unreachable l
-             "assignment without effects annotation") in
-       if not (List.exists (function BE_aux (BE_lset,_) -> true | _ -> false) effs) then
-         Same_vars (E_aux (E_assign (lexp,vexp),annot))
-       else 
-         (match lexp with
-          | LEXP_aux (LEXP_id id,annot) ->
-             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
-             Added_vars (vexp,pat)
-          | LEXP_aux (LEXP_cast (_,id),annot) ->
-             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
-             Added_vars (vexp,pat)
-          | LEXP_aux (LEXP_vector (LEXP_aux (LEXP_id id,((l2,_) as annot2)),i),((l1,_) as annot)) ->
-             let eid = E_aux (E_id id, simple_annot l2 (typ_of_annot annot2)) in
-             let vexp = E_aux (E_vector_update (eid,i,vexp),
-                               simple_annot l1 (typ_of_annot annot)) in
-             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
-             Added_vars (vexp,pat)
-          | LEXP_aux (LEXP_vector_range (LEXP_aux (LEXP_id id,((l2,_) as annot2)),i,j),
-                      ((l,_) as annot)) -> 
-             let eid = E_aux (E_id id, simple_annot l2 (typ_of_annot annot2)) in
-             let vexp = E_aux (E_vector_update_subrange (eid,i,j,vexp),
-                               simple_annot l (typ_of_annot annot)) in
-             let pat = P_aux (P_id id, simple_annot pl (typ_of vexp)) in
-             Added_vars (vexp,pat)
-          | _ -> raise (Reporting_basic.err_unreachable el "Unsupported l-exp"))
-    | _ ->
-       (* after rewrite_defs_letbind_effects this expression is pure and updates
-       no variables: check n_exp_term and where it's used. *)
-       Same_vars (E_aux (expaux,annot))  in
-
-  match expaux with
-  | E_let (lb,body) ->
-     let body = rewrite_var_updates body in
-     let (eff,lb) = match lb with
-       | LB_aux (LB_val_implicit (pat,v),lbannot) ->
-          (match rewrite v pat with
-           | Added_vars (v,pat) ->
-              let (E_aux (_,(l,_))) = v in
-              let lbannot = (simple_annot l (typ_of v)) in
-              (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot))
-           | Same_vars v -> (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot)))
-       | LB_aux (LB_val_explicit (typ,pat,v),lbannot) ->
-          (match rewrite v pat with 
-           | Added_vars (v,pat) ->
-              let (E_aux (_,(l,_))) = v in
-              let lbannot = (simple_annot l (typ_of v)) in
-              (effect_of v,LB_aux (LB_val_implicit (pat,v),lbannot))
-           | Same_vars v -> (effect_of v,LB_aux (LB_val_explicit (typ,pat,v),lbannot))) in
-     let tannot = Some (env_of_annot annot, typ_of body, union_effects eff (effect_of body)) in
-     E_aux (E_let (lb,body),(Parse_ast.Generated l,tannot))
-  | E_internal_let (lexp,v,body) ->
-     (* Rewrite E_internal_let into E_let and call recursively *)
-     let id = match lexp with
-       | LEXP_aux (LEXP_id id,_) -> id
-       | LEXP_aux (LEXP_cast (_,id),_) -> id in
-     let env = env_of_annot annot in
-     let vtyp = typ_of v in
-     let veff = effect_of v in
-     let bodyenv = env_of body in
-     let bodytyp = typ_of body in
-     let bodyeff = effect_of body in
-     let pat = P_aux (P_id id, (simple_annot l vtyp)) in
-     let lbannot = (Parse_ast.Generated l, Some (env, vtyp, veff)) in
-     let lb = LB_aux (LB_val_implicit (pat,v),lbannot) in
-     let exp = E_aux (E_let (lb,body),(Parse_ast.Generated l, Some (bodyenv, bodytyp, union_effects veff bodyeff))) in
-     rewrite_var_updates exp
-  | E_internal_plet (pat,v,body) ->
-     failwith "rewrite_var_updates: E_internal_plet shouldn't be introduced yet"
-  (* There are no expressions that have effects or variable updates in
-     "tail-position": check the definition nexp_term and where it is used. *)
-  | _ -> exp
-
-let replace_memwrite_e_assign exp = 
-  let e_aux = fun (expaux,annot) ->
-    match expaux with
-    | E_assign (LEXP_aux (LEXP_memory (id,args),_),v) -> E_aux (E_app (id,args @ [v]),annot)
-    | _ -> E_aux (expaux,annot) in
-  fold_exp { id_exp_alg with e_aux = e_aux } exp
-
-
-
-let remove_reference_types exp =
-
-  let rec rewrite_t (Typ_aux (t_aux,a)) = (Typ_aux (rewrite_t_aux t_aux,a))
-  and rewrite_t_aux t_aux = match t_aux with
-    | Typ_app (Id_aux (Id "reg",_), [Typ_arg_aux (Typ_arg_typ (Typ_aux (t_aux2, _)), _)]) ->
-      rewrite_t_aux t_aux2
-    | Typ_app (name,t_args) -> Typ_app (name,List.map rewrite_t_arg t_args)
-    | Typ_fn (t1,t2,eff) -> Typ_fn (rewrite_t t1,rewrite_t t2,eff)
-    | Typ_tup ts -> Typ_tup (List.map rewrite_t ts)
-    | _ -> t_aux
-  and rewrite_t_arg t_arg = match t_arg with
-    | Typ_arg_aux (Typ_arg_typ t, a) -> Typ_arg_aux (Typ_arg_typ (rewrite_t t), a)
-    | _ -> t_arg in
-
-  let rec rewrite_annot = function
-    | (l, None) -> (l, None)
-    | (l, Some (env, typ, eff)) -> (l, Some (env, rewrite_t typ, eff)) in
-
-  map_exp_annot rewrite_annot exp
-
-
-
-let rewrite_defs_remove_superfluous_letbinds =
-
-  let rec small (E_aux (exp,_)) = match exp with
-    | E_id _
-    | E_lit _ -> true
-    | E_cast (_,e) -> small e
-    | E_list es -> List.for_all small es
-    | E_cons (e1,e2) -> small e1 && small e2
-    | E_sizeof _ -> true
-    | _ -> false in
-
-  let e_aux (exp,annot) = match exp with
-    | E_let (lb,exp2) ->
-       begin match lb,exp2 with
-       (* 'let x = EXP1 in x' can be replaced with 'EXP1' *)
-       | LB_aux (LB_val_explicit (_,P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_id (Id_aux (id',_)),_)
-       | LB_aux (LB_val_explicit (_,P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_cast (_,E_aux (E_id (Id_aux (id',_)),_)),_)
-       | LB_aux (LB_val_implicit (P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_id (Id_aux (id',_)),_)
-       | LB_aux (LB_val_implicit (P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_cast (_,E_aux (E_id (Id_aux (id',_)),_)),_)
-            when id = id' ->
-          exp1
-       (* "let x = EXP1 in return x" can be replaced with 'return (EXP1)', at
-          least when EXP1 is 'small' enough *)
-       | LB_aux (LB_val_explicit (_,P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_internal_return (E_aux (E_id (Id_aux (id',_)),_)),_)
-       | LB_aux (LB_val_implicit (P_aux (P_id (Id_aux (id,_)),_),exp1),_),
-         E_aux (E_internal_return (E_aux (E_id (Id_aux (id',_)),_)),_)
-            when id = id' && small exp1 ->
-          let (E_aux (_,e1annot)) = exp1 in
-          E_aux (E_internal_return (exp1),e1annot)
-       | _ -> E_aux (exp,annot) 
-       end
-    | _ -> E_aux (exp,annot) in
-
-  let alg = { id_exp_alg with e_aux = e_aux } in
-  rewrite_defs_base
-    { rewrite_exp = (fun _ -> fold_exp alg)
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-  
-
-let rewrite_defs_remove_superfluous_returns =
-
-  let has_unittype e = match typ_of e with
-    | Typ_aux (Typ_id (Id_aux (Id "unit", _)), _) -> true
-    | _ -> false in
-
-  let e_aux (exp,annot) = match exp with
-    | E_internal_plet (pat,exp1,exp2) ->
-       begin match pat,exp2 with
-       | P_aux (P_lit (L_aux (lit,_)),_),
-         E_aux (E_internal_return (E_aux (E_lit (L_aux (lit',_)),_)),_)
-            when lit = lit' ->
-          exp1
-       | P_aux (P_wild,pannot),
-         E_aux (E_internal_return (E_aux (E_lit (L_aux (L_unit,_)),_)),_)
-            when has_unittype exp1 ->
-          exp1
-       | P_aux (P_id (Id_aux (id,_)),_),
-         E_aux (E_internal_return (E_aux (E_id (Id_aux (id',_)),_)),_)
-            when id = id' ->
-          exp1
-       | _ -> E_aux (exp,annot)
-       end
-    | _ -> E_aux (exp,annot) in
-
-  let alg = { id_exp_alg with e_aux = e_aux } in
-  rewrite_defs_base
-    {rewrite_exp = (fun _ -> fold_exp alg)
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-
-
-let rewrite_defs_remove_e_assign =
-  let rewrite_exp _ e =
-    replace_memwrite_e_assign (remove_reference_types (rewrite_var_updates e)) in
-  rewrite_defs_base
-    { rewrite_exp = rewrite_exp
-    ; rewrite_pat = rewrite_pat
-    ; rewrite_let = rewrite_let
-    ; rewrite_lexp = rewrite_lexp
-    ; rewrite_fun = rewrite_fun
-    ; rewrite_def = rewrite_def
-    ; rewrite_defs = rewrite_defs_base
-    }
-
-
-let rewrite_defs_lem =
-  top_sort_defs >>
-  rewrite_defs_remove_vector_concat >>
-  rewrite_defs_remove_bitvector_pats >>
-  rewrite_defs_exp_lift_assign >> 
-  rewrite_defs_remove_blocks >> 
-  rewrite_defs_letbind_effects >> 
-  rewrite_defs_remove_e_assign >> 
-  rewrite_defs_effectful_let_expressions >> 
-  rewrite_defs_remove_superfluous_letbinds >>
-  rewrite_defs_remove_superfluous_returns
-  
diff --git a/src/rewriter_new_tc.mli b/src/rewriter_new_tc.mli
deleted file mode 100644
index 584d33fa..00000000
--- a/src/rewriter_new_tc.mli
+++ /dev/null
@@ -1,152 +0,0 @@
-(**************************************************************************)
-(*     Sail                                                               *)
-(*                                                                        *)
-(*  Copyright (c) 2013-2017                                               *)
-(*    Kathyrn Gray                                                        *)
-(*    Shaked Flur                                                         *)
-(*    Stephen Kell                                                        *)
-(*    Gabriel Kerneis                                                     *)
-(*    Robert Norton-Wright                                                *)
-(*    Christopher Pulte                                                   *)
-(*    Peter Sewell                                                        *)
-(*    Thomas Bauereiss                                                    *)
-(*                                                                        *)
-(*  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 Big_int
-open Ast
-open Type_check_new
-
-type 'a rewriters = { rewrite_exp  : 'a rewriters -> 'a exp -> 'a exp;
-                      rewrite_lexp : 'a rewriters -> 'a lexp -> 'a lexp;
-                      rewrite_pat  : 'a rewriters -> 'a pat -> 'a pat;
-                      rewrite_let  : 'a rewriters -> 'a letbind -> 'a letbind;
-                      rewrite_fun  : 'a rewriters -> 'a fundef -> 'a fundef;
-                      rewrite_def  : 'a rewriters -> 'a def -> 'a def;
-                      rewrite_defs : 'a rewriters -> 'a defs -> 'a defs;
-                    }
-                    
-val rewrite_exp : tannot rewriters -> tannot exp -> tannot exp
-val rewrite_defs : tannot defs -> tannot defs
-val rewrite_defs_ocaml : tannot defs -> tannot defs (*Perform rewrites to exclude AST nodes not supported for ocaml out*)
-val rewrite_defs_lem : tannot defs -> tannot defs (*Perform rewrites to exclude AST nodes not supported for lem out*)
-
-(* the type of interpretations of pattern-matching expressions *)
-type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
-  { p_lit            : lit -> 'pat_aux
-  ; p_wild           : 'pat_aux
-  ; p_as             : 'pat * id -> 'pat_aux
-  ; p_typ            : Ast.typ * 'pat -> 'pat_aux
-  ; p_id             : id -> 'pat_aux
-  ; p_app            : id * 'pat list -> 'pat_aux
-  ; p_record         : 'fpat list * bool -> 'pat_aux
-  ; p_vector         : 'pat list -> 'pat_aux
-  ; p_vector_indexed : (int * 'pat) list -> 'pat_aux
-  ; p_vector_concat  : 'pat list -> 'pat_aux
-  ; p_tup            : 'pat list -> 'pat_aux
-  ; p_list           : 'pat list -> 'pat_aux
-  ; p_aux            : 'pat_aux * 'a annot -> 'pat
-  ; fP_aux           : 'fpat_aux * 'a annot -> 'fpat
-  ; fP_Fpat          : id * 'pat -> 'fpat_aux
-  }
-
-(* fold over pat_aux expressions *)
-
-
-(* the type of interpretations of expressions *)
-type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
-      'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
-      'pat,'pat_aux,'fpat,'fpat_aux) exp_alg = 
- { e_block                  : 'exp list -> 'exp_aux
- ; e_nondet                 : 'exp list -> 'exp_aux
- ; e_id                     : id -> 'exp_aux
- ; e_lit                    : lit -> 'exp_aux
- ; e_cast                   : Ast.typ * 'exp -> 'exp_aux
- ; e_app                    : id * 'exp list -> 'exp_aux
- ; e_app_infix              : 'exp * id * 'exp -> 'exp_aux
- ; e_tuple                  : 'exp list -> 'exp_aux
- ; e_if                     : 'exp * 'exp * 'exp -> 'exp_aux
- ; e_for                    : id * 'exp * 'exp * 'exp * Ast.order * 'exp -> 'exp_aux
- ; e_vector                 : 'exp list -> 'exp_aux
- ; e_vector_indexed         : (int * 'exp) list * 'opt_default -> 'exp_aux
- ; e_vector_access          : 'exp * 'exp -> 'exp_aux
- ; e_vector_subrange        : 'exp * 'exp * 'exp -> 'exp_aux
- ; e_vector_update          : 'exp * 'exp * 'exp -> 'exp_aux
- ; e_vector_update_subrange : 'exp * 'exp * 'exp * 'exp -> 'exp_aux
- ; e_vector_append          : 'exp * 'exp -> 'exp_aux
- ; e_list                   : 'exp list -> 'exp_aux
- ; e_cons                   : 'exp * 'exp -> 'exp_aux
- ; e_record                 : 'fexps -> 'exp_aux
- ; e_record_update          : 'exp * 'fexps -> 'exp_aux
- ; e_field                  : 'exp * id -> 'exp_aux
- ; e_case                   : 'exp * 'pexp list -> 'exp_aux
- ; e_let                    : 'letbind * 'exp -> 'exp_aux
- ; e_assign                 : 'lexp * 'exp -> 'exp_aux
- ; e_sizeof                 : nexp -> 'exp_aux
- ; e_exit                   : 'exp -> 'exp_aux
- ; e_return                 : 'exp -> 'exp_aux
- ; e_assert                 : 'exp * 'exp -> 'exp_aux
- ; e_internal_cast          : 'a annot * 'exp -> 'exp_aux
- ; e_internal_exp           : 'a annot -> 'exp_aux
- ; e_internal_exp_user      : 'a annot * 'a annot -> 'exp_aux
- ; e_internal_let           : 'lexp * 'exp * 'exp -> 'exp_aux
- ; e_internal_plet          : 'pat * 'exp * 'exp -> 'exp_aux
- ; e_internal_return        : 'exp -> 'exp_aux
- ; e_aux                    : 'exp_aux * 'a annot -> 'exp
- ; lEXP_id                  : id -> 'lexp_aux
- ; lEXP_memory              : id * 'exp list -> 'lexp_aux
- ; lEXP_cast                : Ast.typ * id -> 'lexp_aux
- ; lEXP_tup                 : 'lexp list -> 'lexp_aux
- ; lEXP_vector              : 'lexp * 'exp -> 'lexp_aux
- ; lEXP_vector_range        : 'lexp * 'exp * 'exp -> 'lexp_aux
- ; lEXP_field               : 'lexp * id -> 'lexp_aux
- ; lEXP_aux                 : 'lexp_aux * 'a annot -> 'lexp
- ; fE_Fexp                  : id * 'exp -> 'fexp_aux
- ; fE_aux                   : 'fexp_aux * 'a annot -> 'fexp
- ; fES_Fexps                : 'fexp list * bool -> 'fexps_aux
- ; fES_aux                  : 'fexps_aux * 'a annot -> 'fexps
- ; def_val_empty            : 'opt_default_aux
- ; def_val_dec              : 'exp -> 'opt_default_aux
- ; def_val_aux              : 'opt_default_aux * 'a annot -> 'opt_default
- ; pat_exp                  : 'pat * 'exp -> 'pexp_aux
- ; pat_aux                  : 'pexp_aux * 'a annot -> 'pexp
- ; lB_val_explicit          : typschm * 'pat * 'exp -> 'letbind_aux
- ; lB_val_implicit          : 'pat * 'exp -> 'letbind_aux
- ; lB_aux                   : 'letbind_aux * 'a annot -> 'letbind
- ; pat_alg                  : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg
- }
-
-(* fold over expressions *)
-val fold_exp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
-      'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
-      'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a exp -> 'exp
-
-val id_pat_alg : ('a,'a pat, 'a pat_aux, 'a fpat, 'a fpat_aux) pat_alg
diff --git a/src/sail.ml b/src/sail.ml
index 007a3208..82ce4f83 100644
--- a/src/sail.ml
+++ b/src/sail.ml
@@ -152,10 +152,10 @@ let main() =
     let (ast,kenv,ord) = convert_ast ast in
     let (ast,type_envs) = check_ast ast kenv ord in 
 
-    let ast = match !opt_mono_split with
+    (* let ast = match !opt_mono_split with
       | [] -> ast
       | l -> Monomorphise.split_defs l type_envs ast
-    in
+    in *)
 
     let ast = rewrite_ast ast in
     let out_name = match !opt_file_out with
@@ -176,7 +176,7 @@ let main() =
          else output "" (Ocaml_out (Some (List.hd !opt_libs_ocaml))) [out_name,ast_ocaml]
        else ());
       (if !(opt_print_lem)
-       then let ast_lem = rewrite_ast_lem type_envs ast in
+       then let ast_lem = rewrite_ast_lem ast in
          if !(opt_libs_lem) = []
          then output "" (Lem_out None) [out_name,ast_lem]
          else output "" (Lem_out (Some (List.hd !opt_libs_lem))) [out_name,ast_lem]
diff --git a/src/spec_analysis.ml b/src/spec_analysis.ml
index 8cb5a796..1447ff02 100644
--- a/src/spec_analysis.ml
+++ b/src/spec_analysis.ml
@@ -42,10 +42,9 @@
 
 open Ast
 open Util
-open Big_int
-open Type_internal
+open Ast_util
 
-type typ = Type_internal.t
+module Nameset = Set.Make(String)
 
 let mt = Nameset.empty
 
@@ -58,7 +57,7 @@ let set_to_string n =
 
 
 (*Query a spec for its default order if one is provided. Assumes Inc if not *)
-let get_default_order_sp (DT_aux(spec,_)) =
+(* let get_default_order_sp (DT_aux(spec,_)) =
   match spec with
   | DT_order (Ord_aux(o,_)) ->
     (match o with
@@ -77,11 +76,11 @@ let rec default_order (Defs defs) =
   | def::defs ->
     match get_default_order_def def with
     | None -> default_order (Defs defs)
-    | Some o -> o
+    | Some o -> o *)
 
 (*Is within range*)
 
-let check_in_range (candidate : big_int) (range : typ) : bool =
+(* let check_in_range (candidate : big_int) (range : typ) : bool =
   match range.t with
   | Tapp("range", [TA_nexp min; TA_nexp max]) | Tabbrev(_,{t=Tapp("range", [TA_nexp min; TA_nexp max])}) ->
     let min,max = 
@@ -182,21 +181,18 @@ let is_within_range candidate range constraints =
      | _ -> Maybe)
   | _ -> Maybe
 
-let is_within_machine64 candidate constraints = is_within_range candidate int64_t constraints
+let is_within_machine64 candidate constraints = is_within_range candidate int64_t constraints *)
   
 (************************************************************************************************)
 (*FV finding analysis: identifies the free variables of a function, expression, etc *)
 
-let id_to_string (Ast.Id_aux (i,_)) = match i with
-  | Ast.Id s | Ast.DeIid s -> s
-
 let conditional_add typ_or_exp bound used id =
   let known_list =
     if typ_or_exp (*true for typ*)
     then ["bit";"vector";"unit";"string";"int";"bool";"boolean"]
     else ["=="; "!="; "|";"~";"&";"add_int"] in
-  let i = (id_to_string id) in
-  if Nameset.mem i bound || List.mem i  known_list
+  let i = (string_of_id id) in
+  if Nameset.mem i bound || List.mem i known_list
   then used
   else Nameset.add i used
 
@@ -207,34 +203,28 @@ let conditional_add_exp = conditional_add false
 let nameset_bigunion = List.fold_left Nameset.union mt
 
 
-let rec free_type_names_t consider_var {t = t} = match t with
-  | Tvar name -> if consider_var then Nameset.add name mt else mt
-  | Tid name -> Nameset.add name mt
-  | Tfn (t1,t2,_,_) -> Nameset.union (free_type_names_t consider_var t1)
-                                     (free_type_names_t consider_var t2)
-  | Ttup ts -> free_type_names_ts consider_var ts
-  | Tapp (name,targs) -> Nameset.add name (free_type_names_t_args consider_var targs)
-  | Tabbrev (t1,t2) -> Nameset.union (free_type_names_t consider_var t1)
+let rec free_type_names_t consider_var (Typ_aux (t, _)) = match t with
+  | Typ_var name -> if consider_var then Nameset.add (string_of_kid name) mt else mt
+  | Typ_id name -> Nameset.add (string_of_id name) mt
+  | Typ_fn (t1,t2,_) -> Nameset.union (free_type_names_t consider_var t1)
                                      (free_type_names_t consider_var t2)
-  | Toptions (t,m_t) -> Nameset.union (free_type_names_t consider_var t)
-                                      (free_type_names_maybe_t consider_var m_t)
-  | Tuvar _ -> mt
+  | 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_wild -> mt
 and free_type_names_ts consider_var ts = nameset_bigunion (List.map (free_type_names_t consider_var) ts)
 and free_type_names_maybe_t consider_var = function
   | Some t -> free_type_names_t consider_var t
   | None -> mt
 and free_type_names_t_arg consider_var = function
-  | TA_typ t -> free_type_names_t consider_var t
+  | Typ_arg_aux (Typ_arg_typ t, _) -> free_type_names_t consider_var t
   | _ -> mt
 and free_type_names_t_args consider_var targs =
   nameset_bigunion (List.map (free_type_names_t_arg consider_var) targs)
 
 
 let rec free_type_names_tannot consider_var = function
-  | NoTyp -> mt
-  | Base ((_,t),_ ,_,_,_,_) -> free_type_names_t consider_var t
-  | Overload (tannot,_,tannots) ->
-     nameset_bigunion (List.map (free_type_names_tannot consider_var) (tannot :: tannots))
+  | None -> mt
+  | Some (_, t, _) -> free_type_names_t consider_var t
 
 
 let rec fv_of_typ consider_var bound used (Typ_aux (t,_)) : Nameset.t =
@@ -285,16 +275,16 @@ let rec pat_bindings consider_var bound used (P_aux(p,(_,tannot))) =
   let list_fv bound used ps = List.fold_right (fun p (b,n) -> pat_bindings consider_var b n p) ps (bound, used) in
   match p with
   | P_as(p,id) -> let b,ns = pat_bindings consider_var bound used p in
-    Nameset.add (id_to_string id) b,ns
+    Nameset.add (string_of_id id) b,ns
   | P_typ(t,p) ->
      let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
      let ns = fv_of_typ consider_var bound used t in pat_bindings consider_var bound ns p
   | P_id id ->
      let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-     Nameset.add (id_to_string id) bound,used
+     Nameset.add (string_of_id id) bound,used
   | P_app(id,pats) ->
     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    list_fv bound (Nameset.add (id_to_string id) used) pats    
+    list_fv bound (Nameset.add (string_of_id id) used) pats
   | P_record(fpats,_) ->
     List.fold_right (fun (Ast.FP_aux(Ast.FP_Fpat(_,p),_)) (b,n) ->
         pat_bindings consider_var bound used p) fpats (bound,used)
@@ -324,7 +314,7 @@ let rec fv_of_exp consider_var bound used set (E_aux (e,(_,tannot))) : (Nameset.
   | E_if(c,t,e) -> list_fv bound used set [c;t;e]
   | E_for(id,from,to_,by,_,body) ->
     let _,used,set = list_fv bound used set [from;to_;by] in
-    fv_of_exp consider_var (Nameset.add (id_to_string id) bound) used set body
+    fv_of_exp consider_var (Nameset.add (string_of_id id) bound) used set body
   | E_vector_indexed (es_i,(Ast.Def_val_aux(default,_))) ->
     let bound,used,set =
       List.fold_right
@@ -383,13 +373,13 @@ and fv_of_lexp consider_var bound used set (LEXP_aux(lexp,(_,tannot))) =
   match lexp with
   | LEXP_id id ->
     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    let i = id_to_string id in
+    let i = string_of_id id in
     if Nameset.mem i bound
     then bound, used, Nameset.add i set
     else Nameset.add i bound, Nameset.add i used, set
   | LEXP_cast(typ,id) ->
     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    let i = id_to_string id in
+    let i = string_of_id id in
     let used_t = fv_of_typ consider_var bound used typ in
     if Nameset.mem i bound
     then bound, used_t, Nameset.add i set
@@ -401,7 +391,7 @@ and fv_of_lexp consider_var bound used set (LEXP_aux(lexp,(_,tannot))) =
       List.fold_right
         (fun e (b,u,s) ->
           fv_of_exp consider_var b u s e) args (bound,used,set) in
-    bound,Nameset.add (id_to_string id) used,set
+    bound,Nameset.add (string_of_id id) used,set
   | LEXP_field(lexp,_) -> fv_of_lexp consider_var bound used set lexp
   | LEXP_vector(lexp,exp) ->
     let bound_l,used,set = fv_of_lexp consider_var bound used set lexp in
@@ -418,47 +408,49 @@ let init_env s = Nameset.singleton s
 let typ_variants consider_var bound tunions =
   List.fold_right
     (fun (Tu_aux(t,_)) (b,n) -> match t with
-       | Tu_id id -> Nameset.add (id_to_string id) b,n
-       | Tu_ty_id(t,id) -> Nameset.add (id_to_string id) b, fv_of_typ consider_var b n t)
+       | Tu_id id -> Nameset.add (string_of_id id) b,n
+       | Tu_ty_id(t,id) -> Nameset.add (string_of_id id) b, fv_of_typ consider_var b n t)
     tunions
     (bound,mt)
 
 let fv_of_kind_def consider_var (KD_aux(k,_)) = match k with
-  | KD_nabbrev(_,id,_,nexp) -> init_env (id_to_string id), fv_of_nexp consider_var mt mt nexp
+  | KD_nabbrev(_,id,_,nexp) -> init_env (string_of_id id), fv_of_nexp consider_var mt mt nexp
   | KD_abbrev(_,id,_,typschm) ->
-    init_env (id_to_string id), snd (fv_of_typschm consider_var mt mt typschm)
+    init_env (string_of_id id), snd (fv_of_typschm consider_var mt mt typschm)
   | KD_record(_,id,_,typq,tids,_) ->
-    let binds = init_env (id_to_string id) in
+    let binds = init_env (string_of_id id) in
     let bounds = if consider_var then typq_bindings typq else mt in
     binds, List.fold_right (fun (t,_) n -> fv_of_typ consider_var bounds n t) tids mt
   | KD_variant(_,id,_,typq,tunions,_) ->
-    let bindings = Nameset.add (id_to_string id) (if consider_var then typq_bindings typq else mt) in
+    let bindings = Nameset.add (string_of_id id) (if consider_var then typq_bindings typq else mt) in
     typ_variants consider_var bindings tunions
   | KD_enum(_,id,_,ids,_) ->
-    Nameset.of_list (List.map id_to_string (id::ids)),mt
+    Nameset.of_list (List.map string_of_id (id::ids)),mt
   | KD_register(_,id,n1,n2,_) ->
-    init_env (id_to_string id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
+    init_env (string_of_id id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
 
 let fv_of_type_def consider_var (TD_aux(t,_)) = match t with
-  | TD_abbrev(id,_,typschm) -> init_env (id_to_string id), snd (fv_of_typschm consider_var mt mt typschm)
+  | TD_abbrev(id,_,typschm) -> init_env (string_of_id id), snd (fv_of_typschm consider_var mt mt typschm)
   | TD_record(id,_,typq,tids,_) ->
-    let binds = init_env (id_to_string id) in
+    let binds = init_env (string_of_id id) in
     let bounds = if consider_var then typq_bindings typq else mt in
     binds, List.fold_right (fun (t,_) n -> fv_of_typ consider_var bounds n t) tids mt
   | TD_variant(id,_,typq,tunions,_) ->
-    let bindings = Nameset.add (id_to_string id) (if consider_var then typq_bindings typq else mt) in
+    let bindings = Nameset.add (string_of_id id) (if consider_var then typq_bindings typq else mt) in
     typ_variants consider_var bindings tunions
   | TD_enum(id,_,ids,_) ->
-    Nameset.of_list (List.map id_to_string (id::ids)),mt
+    Nameset.of_list (List.map string_of_id (id::ids)),mt
   | TD_register(id,n1,n2,_) ->
-    init_env (id_to_string id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
+    init_env (string_of_id id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
 
 let fv_of_tannot_opt consider_var (Typ_annot_opt_aux (t,_)) =
   match t with
   | Typ_annot_opt_some (typq,typ) ->
     let bindings = if consider_var then typq_bindings typq else mt in
     let free = fv_of_typ consider_var bindings mt typ in
-    (bindings,free)  
+    (bindings,free)
+  | Typ_annot_opt_none ->
+    (mt, mt)
 
 (*Unlike the other fv, the bound returns are the names bound by the pattern for use in the exp*)
 let fv_of_funcl consider_var base_bounds (FCL_aux(FCL_Funcl(id,pat,exp),l)) =
@@ -469,7 +461,7 @@ let fv_of_funcl consider_var base_bounds (FCL_aux(FCL_Funcl(id,pat,exp),l)) =
 let fv_of_fun consider_var (FD_aux (FD_function(rec_opt,tannot_opt,_,funcls),_)) =
   let fun_name = match funcls with
     | [] -> failwith "fv_of_fun fell off the end looking for the function name"
-    | FCL_aux(FCL_Funcl(id,_,_),_)::_ -> id_to_string id in
+    | FCL_aux(FCL_Funcl(id,_,_),_)::_ -> string_of_id id in
   let base_bounds = match rec_opt with
     | Rec_aux(Ast.Rec_rec,_) -> init_env fun_name
     | _ -> mt in
@@ -477,7 +469,9 @@ let fv_of_fun consider_var (FD_aux (FD_function(rec_opt,tannot_opt,_,funcls),_))
     | Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ),_) ->
       let bindings = if consider_var then typq_bindings typq else mt in
       let bound = Nameset.union bindings base_bounds in
-      bound, fv_of_typ consider_var bound mt typ in
+      bound, fv_of_typ consider_var bound mt typ
+    | Typ_annot_opt_aux(Typ_annot_opt_none, _) ->
+      base_bounds, mt in
   let ns = List.fold_right (fun (FCL_aux(FCL_Funcl(_,pat,exp),_)) ns ->
       let pat_bs,pat_ns = pat_bindings consider_var base_bounds ns pat in
       let _, exp_ns,_ = fv_of_exp consider_var pat_bs pat_ns Nameset.empty exp in
@@ -485,8 +479,9 @@ let fv_of_fun consider_var (FD_aux (FD_function(rec_opt,tannot_opt,_,funcls),_))
   init_env fun_name,Nameset.union ns ns_r
 
 let fv_of_vspec consider_var (VS_aux(vspec,_)) = match vspec with
-  | VS_val_spec(ts,id) | VS_extern_no_rename (ts,id) | VS_extern_spec(ts,id,_)->
-     init_env ("val:" ^ (id_to_string id)), snd (fv_of_typschm consider_var mt mt ts)
+  | VS_val_spec(ts,id) | VS_extern_no_rename (ts,id) | VS_extern_spec(ts,id,_)
+  | VS_cast_spec(ts,id) ->
+     init_env ("val:" ^ (string_of_id id)), snd (fv_of_typschm consider_var mt mt ts)
 
 let rec find_scattered_of name = function
   | [] -> []
@@ -495,7 +490,7 @@ let rec find_scattered_of name = function
      | SD_scattered_function(_,_,_,id)
      | SD_scattered_funcl(FCL_aux(FCL_Funcl(id,_,_),_))
      | SD_scattered_unioncl(id,_) ->
-       if name = id_to_string id
+       if name = string_of_id id
        then [sd] else []
      | _ -> [])@
     (find_scattered_of name defs)
@@ -506,17 +501,19 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
     let b,ns = (match tannot_opt with
         | Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ),_) ->
           let bindings = if consider_var then typq_bindings typq else mt in
-          bindings, fv_of_typ consider_var bindings mt typ) in
-    init_env (id_to_string id),ns
+          bindings, fv_of_typ consider_var bindings mt typ
+        | Typ_annot_opt_aux(Typ_annot_opt_none, _) ->
+          mt, mt) in
+    init_env (string_of_id id),ns
   | SD_scattered_funcl (FCL_aux(FCL_Funcl(id,pat,exp),_)) ->
     let pat_bs,pat_ns = pat_bindings consider_var mt mt pat in
     let _,exp_ns,_ = fv_of_exp consider_var pat_bs pat_ns Nameset.empty exp in
     let scattered_binds = match pat with
-      | P_aux(P_app(pid,_),_) -> init_env ((id_to_string id) ^ "/" ^ (id_to_string pid))
+      | P_aux(P_app(pid,_),_) -> init_env ((string_of_id id) ^ "/" ^ (string_of_id pid))
       | _ -> mt in
     scattered_binds, exp_ns
   | SD_scattered_variant (id,_,_) ->
-    let name = id_to_string id in
+    let name = string_of_id id in
     let uses =
       if consider_scatter_as_one
       then
@@ -528,12 +525,12 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
       else mt in
     init_env name, uses
   | SD_scattered_unioncl(id, type_union) ->
-    let typ_name = id_to_string id in
+    let typ_name = string_of_id id in
     let b = init_env typ_name in
     let (b,r) = typ_variants consider_var b [type_union] in
     (Nameset.remove typ_name b, Nameset.add typ_name r)
   | SD_scattered_end id ->
-    let name = id_to_string id in
+    let name = string_of_id id in
     let uses = if consider_scatter_as_one
     (*Note: if this is a function ending, the dec is included *)
       then
@@ -545,11 +542,11 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
 
 let fv_of_rd consider_var (DEC_aux (d,_)) = match d with
   | DEC_reg(t,id) ->
-    init_env (id_to_string id), fv_of_typ consider_var mt mt t
+    init_env (string_of_id id), fv_of_typ consider_var mt mt t
   | DEC_alias(id,alias) ->
-    init_env (id_to_string id),mt
+    init_env (string_of_id id),mt
   | DEC_typ_alias(t,id,alias) ->
-    init_env (id_to_string id), mt
+    init_env (string_of_id id), mt
 
 let fv_of_def consider_var consider_scatter_as_one all_defs = function
   | DEF_kind kdef -> fv_of_kind_def consider_var kdef
@@ -557,6 +554,7 @@ let fv_of_def consider_var consider_scatter_as_one all_defs = function
   | DEF_fundef fdef -> fv_of_fun consider_var fdef
   | DEF_val lebind -> ((fun (b,u,_) -> (b,u)) (fv_of_let consider_var mt mt mt lebind))
   | DEF_spec vspec -> fv_of_vspec consider_var vspec
+  | DEF_overload (id,ids) -> init_env (string_of_id id), List.fold_left (fun ns id -> Nameset.add (string_of_id id) ns) mt ids
   | DEF_default def -> mt,mt
   | DEF_scattered sdef -> fv_of_scattered consider_var consider_scatter_as_one all_defs sdef
   | DEF_reg_dec rdec -> fv_of_rd consider_var rdec
diff --git a/src/spec_analysis.mli b/src/spec_analysis.mli
index fa8dad3b..7c6f3685 100644
--- a/src/spec_analysis.mli
+++ b/src/spec_analysis.mli
@@ -42,13 +42,7 @@
 
 open Ast
 open Util
-open Big_int
-open Type_internal
-
-type typ = Type_internal.t
-
-(*Returns the declared default order of a set of definitions, defaulting to Inc if no default is provided *)
-val default_order : tannot defs -> order
+open Type_check_new
 
 (*Determines if the first typ is within the range of the the second typ, 
   using the constraints provided when the first typ contains variables. 
@@ -58,19 +52,19 @@ val default_order : tannot defs -> order
   to be anything other than a vector, a range, an atom, or a bit (after
   suitable unwrapping of abbreviations, reg, and registers). 
 *)
-val is_within_range: typ -> typ -> nexp_range list -> triple
-val is_within_machine64 : typ -> nexp_range list -> triple
+(* val is_within_range: typ -> typ -> nexp_range list -> triple
+val is_within_machine64 : typ -> nexp_range list -> triple *)
 
 (* free variables and dependencies *)
 
 (*fv_of_def consider_ty_vars consider_scatter_as_one all_defs all_defs def -> (bound_by_def, free_in_def) *)
-val fv_of_def: bool -> bool -> (tannot def) list -> tannot def -> Nameset.t * Nameset.t
+(* val fv_of_def: bool -> bool -> ('a def) list -> 'a def -> Nameset.t * Nameset.t *)
 
 (*group_defs consider_scatter_as_one all_defs -> ((bound_by_def, free_in_def), def) list *)
-val group_defs : bool -> tannot defs -> ((Nameset.t * Nameset.t) * (tannot def)) list
+(* val group_defs : bool -> 'a defs -> ((Nameset.t * Nameset.t) * ('a def)) list *)
 
 (*reodering definitions, initial functions *)
 (* produce a new ordering for defs, limiting to those listed in the list, which respects dependencies *)
-val restrict_defs : tannot defs -> string list -> tannot defs
+(* val restrict_defs : 'a defs -> string list -> 'a defs *)
 
 val top_sort_defs : tannot defs -> tannot defs
diff --git a/src/spec_analysis_new_tc.ml b/src/spec_analysis_new_tc.ml
deleted file mode 100644
index 10eb16f7..00000000
--- a/src/spec_analysis_new_tc.ml
+++ /dev/null
@@ -1,673 +0,0 @@
-(**************************************************************************)
-(*     Sail                                                               *)
-(*                                                                        *)
-(*  Copyright (c) 2013-2017                                               *)
-(*    Kathyrn Gray                                                        *)
-(*    Shaked Flur                                                         *)
-(*    Stephen Kell                                                        *)
-(*    Gabriel Kerneis                                                     *)
-(*    Robert Norton-Wright                                                *)
-(*    Christopher Pulte                                                   *)
-(*    Peter Sewell                                                        *)
-(*                                                                        *)
-(*  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 Util
-open Ast_util
-
-module Nameset = Set.Make(String)
-
-let mt = Nameset.empty
-
-let set_to_string n = 
-  let rec list_to_string = function
-    | [] -> ""
-    | [n] -> n
-    | n::ns -> n ^ ", " ^ list_to_string ns in
-  list_to_string (Nameset.elements n)
-
-
-(*Query a spec for its default order if one is provided. Assumes Inc if not *)
-(* let get_default_order_sp (DT_aux(spec,_)) =
-  match spec with
-  | DT_order (Ord_aux(o,_)) ->
-    (match o with
-     | Ord_inc -> Some {order = Oinc}
-     | Ord_dec -> Some { order = Odec}
-     | _ -> Some {order = Oinc})
-  | _ -> None
-
-let get_default_order_def = function
-  | DEF_default def_spec -> get_default_order_sp def_spec
-  | _ -> None
-
-let rec default_order (Defs defs) =
-  match defs with
-  | [] -> { order = Oinc } (*When no order is specified, we assume that it's inc*)
-  | def::defs ->
-    match get_default_order_def def with
-    | None -> default_order (Defs defs)
-    | Some o -> o *)
-
-(*Is within range*)
-
-(* let check_in_range (candidate : big_int) (range : typ) : bool =
-  match range.t with
-  | Tapp("range", [TA_nexp min; TA_nexp max]) | Tabbrev(_,{t=Tapp("range", [TA_nexp min; TA_nexp max])}) ->
-    let min,max = 
-      match min.nexp,max.nexp with
-      | (Nconst min, Nconst max)
-      | (Nconst min, N2n(_, Some max))
-      | (N2n(_, Some min), Nconst max)
-      | (N2n(_, Some min), N2n(_, Some max))
-        -> min, max
-      | (Nneg n, Nconst max) | (Nneg n, N2n(_, Some max))->
-        (match n.nexp with
-         | Nconst abs_min | N2n(_,Some abs_min) ->
-           (minus_big_int abs_min), max
-         | _ -> assert false (*Put a better error message here*))
-      | (Nconst min,Nneg n) | (N2n(_, Some min), Nneg n) ->
-        (match n.nexp with
-         | Nconst abs_max | N2n(_,Some abs_max) ->
-           min, (minus_big_int abs_max)
-         | _ -> assert false (*Put a better error message here*))
-    | (Nneg nmin, Nneg nmax) ->
-      ((match nmin.nexp with
-          | Nconst abs_min | N2n(_,Some abs_min) -> (minus_big_int abs_min)
-          | _ -> assert false (*Put a better error message here*)),
-       (match nmax.nexp with
-        | Nconst abs_max | N2n(_,Some abs_max) -> (minus_big_int abs_max)
-        | _ -> assert false (*Put a better error message here*)))
-    | _ -> assert false        
-    in le_big_int min candidate && le_big_int candidate max
-  | _ -> assert false
-
-(*Rmove me when switch to zarith*)
-let rec power_big_int b n =
-  if eq_big_int n zero_big_int
-  then unit_big_int
-  else mult_big_int b (power_big_int b (sub_big_int n unit_big_int))
-
-let unpower_of_2 b =
-  let two = big_int_of_int 2 in
-  let four = big_int_of_int 4 in
-  let eight = big_int_of_int 8 in
-  let sixteen = big_int_of_int 16 in
-  let thirty_two = big_int_of_int 32 in
-  let sixty_four = big_int_of_int 64 in
-  let onetwentyeight = big_int_of_int 128 in
-  let twofiftysix = big_int_of_int 256 in
-  let fivetwelve = big_int_of_int 512 in
-  let oneotwentyfour = big_int_of_int 1024 in
-  let to_the_sixteen = big_int_of_int 65536 in
-  let to_the_thirtytwo = big_int_of_string "4294967296" in
-  let to_the_sixtyfour = big_int_of_string "18446744073709551616" in
-  let ck i = eq_big_int b i in
-  if      ck unit_big_int     then zero_big_int
-  else if ck two              then unit_big_int
-  else if ck four             then two
-  else if ck eight            then big_int_of_int 3
-  else if ck sixteen          then four
-  else if ck thirty_two       then big_int_of_int 5
-  else if ck sixty_four       then big_int_of_int 6
-  else if ck onetwentyeight   then big_int_of_int 7
-  else if ck twofiftysix      then eight
-  else if ck fivetwelve       then big_int_of_int 9
-  else if ck oneotwentyfour   then big_int_of_int 10
-  else if ck to_the_sixteen   then sixteen
-  else if ck to_the_thirtytwo then thirty_two
-  else if ck to_the_sixtyfour then sixty_four
-  else let rec unpower b power =
-         if eq_big_int b unit_big_int
-         then power
-         else (unpower (div_big_int b  two) (succ_big_int power)) in
-    unpower b zero_big_int
-
-let is_within_range candidate range constraints =
-  let candidate_actual = match candidate.t with
-    | Tabbrev(_,t) -> t
-    | _ -> candidate in
-  match candidate_actual.t with
-  | Tapp("atom", [TA_nexp n]) ->
-    (match n.nexp with
-     | Nconst i | N2n(_,Some i) -> if check_in_range i range then Yes else No
-     | _ -> Maybe)
-  | Tapp("range", [TA_nexp bot; TA_nexp top]) ->
-    (match bot.nexp,top.nexp with
-     | Nconst b, Nconst t | Nconst b, N2n(_,Some t) | N2n(_, Some b), Nconst t | N2n(_,Some b), N2n(_, Some t) ->
-       let at_least_in = check_in_range b range in
-       let at_most_in = check_in_range t range in
-       if at_least_in && at_most_in
-       then Yes
-       else if at_least_in || at_most_in
-       then Maybe
-       else No
-     | _ -> Maybe)
-  | Tapp("vector", [_; TA_nexp size ; _; _]) ->
-    (match size.nexp with
-     | Nconst i | N2n(_, Some i) ->
-       if check_in_range (power_big_int (big_int_of_int 2) i) range
-       then Yes
-       else No
-     | _ -> Maybe)
-  | _ -> Maybe
-
-let is_within_machine64 candidate constraints = is_within_range candidate int64_t constraints *)
-  
-(************************************************************************************************)
-(*FV finding analysis: identifies the free variables of a function, expression, etc *)
-
-let conditional_add typ_or_exp bound used id =
-  let known_list =
-    if typ_or_exp (*true for typ*)
-    then ["bit";"vector";"unit";"string";"int";"bool";"boolean"]
-    else ["=="; "!="; "|";"~";"&";"add_int"] in
-  let i = (string_of_id id) in
-  if Nameset.mem i bound || List.mem i known_list
-  then used
-  else Nameset.add i used
-
-let conditional_add_typ = conditional_add true
-let conditional_add_exp = conditional_add false
-
-
-let nameset_bigunion = List.fold_left Nameset.union mt
-
-
-let rec free_type_names_t consider_var (Typ_aux (t, _)) = match t with
-  | Typ_var name -> if consider_var then Nameset.add (string_of_kid name) mt else mt
-  | Typ_id name -> Nameset.add (string_of_id name) mt
-  | Typ_fn (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_wild -> mt
-and free_type_names_ts consider_var ts = nameset_bigunion (List.map (free_type_names_t consider_var) ts)
-and free_type_names_maybe_t consider_var = function
-  | Some t -> free_type_names_t consider_var t
-  | None -> mt
-and free_type_names_t_arg consider_var = function
-  | Typ_arg_aux (Typ_arg_typ t, _) -> free_type_names_t consider_var t
-  | _ -> mt
-and free_type_names_t_args consider_var targs =
-  nameset_bigunion (List.map (free_type_names_t_arg consider_var) targs)
-
-
-let rec free_type_names_tannot consider_var = function
-  | None -> mt
-  | Some (_, t, _) -> free_type_names_t consider_var t
-
-
-let rec fv_of_typ consider_var bound used (Typ_aux (t,_)) : Nameset.t =
-  match t with
-  | Typ_wild -> used
-  | Typ_var (Kid_aux (Var v,l)) ->
-    if consider_var
-    then conditional_add_typ bound used (Ast.Id_aux (Ast.Id v,l))
-    else used
-  | Typ_id id -> conditional_add_typ bound used id
-  | Typ_fn(arg,ret,_) -> fv_of_typ consider_var bound (fv_of_typ consider_var bound used arg) ret
-  | 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)
-
-and fv_of_targ consider_var bound used (Ast.Typ_arg_aux(targ,_)) : Nameset.t = match targ with
-  | Typ_arg_typ t -> fv_of_typ consider_var bound used t
-  | Typ_arg_nexp n -> fv_of_nexp consider_var bound used n
-  | _ -> used
-
-and fv_of_nexp consider_var bound used (Ast.Nexp_aux(n,_)) = match n with
-  | Nexp_id id -> conditional_add_typ bound used id
-  | Nexp_var (Ast.Kid_aux (Ast.Var i,_)) ->
-    if consider_var
-    then conditional_add_typ bound used (Ast.Id_aux (Ast.Id i, Parse_ast.Unknown))
-    else used
-  | Nexp_times (n1,n2) | Ast.Nexp_sum (n1,n2) | Ast.Nexp_minus(n1,n2) ->
-    fv_of_nexp consider_var bound (fv_of_nexp consider_var bound used n1) n2
-  | Nexp_exp n | Ast.Nexp_neg n -> fv_of_nexp consider_var bound used n
-  | _ -> used
-
-let typq_bindings (TypQ_aux(tq,_)) = match tq with
-  | TypQ_tq quants ->
-    List.fold_right (fun (QI_aux (qi,_)) bounds ->
-        match qi with
-        | QI_id (KOpt_aux(k,_)) ->
-          (match k with
-           | KOpt_none (Kid_aux (Var s,_)) -> Nameset.add s bounds
-           | KOpt_kind (_, Kid_aux (Var s,_)) -> Nameset.add s bounds)
-        | _ -> bounds) quants mt
-  | TypQ_no_forall -> mt  
-
-let fv_of_typschm consider_var bound used (Ast.TypSchm_aux ((Ast.TypSchm_ts(typq,typ)),_)) =
-  let ts_bound = if consider_var then typq_bindings typq else mt in
-  ts_bound, fv_of_typ consider_var (Nameset.union bound ts_bound) used typ
-
-let rec pat_bindings consider_var bound used (P_aux(p,(_,tannot))) =
-  let list_fv bound used ps = List.fold_right (fun p (b,n) -> pat_bindings consider_var b n p) ps (bound, used) in
-  match p with
-  | P_as(p,id) -> let b,ns = pat_bindings consider_var bound used p in
-    Nameset.add (string_of_id id) b,ns
-  | P_typ(t,p) ->
-     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-     let ns = fv_of_typ consider_var bound used t in pat_bindings consider_var bound ns p
-  | P_id id ->
-     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-     Nameset.add (string_of_id id) bound,used
-  | P_app(id,pats) ->
-    let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    list_fv bound (Nameset.add (string_of_id id) used) pats    
-  | P_record(fpats,_) ->
-    List.fold_right (fun (Ast.FP_aux(Ast.FP_Fpat(_,p),_)) (b,n) ->
-        pat_bindings consider_var bound used p) fpats (bound,used)
-  | P_vector pats | Ast.P_vector_concat pats | Ast.P_tup pats | Ast.P_list pats -> list_fv bound used pats
-  | P_vector_indexed ipats ->
-    List.fold_right (fun (_,p) (b,n) -> pat_bindings consider_var b n p) ipats (bound,used)
-  | _ -> bound,used
-
-let rec fv_of_exp consider_var bound used set (E_aux (e,(_,tannot))) : (Nameset.t * Nameset.t * Nameset.t) =
-  let list_fv b n s es = List.fold_right (fun e (b,n,s) -> fv_of_exp consider_var b n s e) es (b,n,s) in
-  match e with
-  | E_block es | Ast.E_nondet es | Ast.E_tuple es | Ast.E_vector es | Ast.E_list es ->
-    list_fv bound used set es
-  | E_id id ->
-     let used = conditional_add_exp bound used id in
-     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-     bound,used,set
-  | E_cast (t,e) ->
-    let u = fv_of_typ consider_var (if consider_var then bound else mt) used t in
-    fv_of_exp consider_var bound u set e
-  | E_app(id,es) ->
-    let us = conditional_add_exp bound used id in
-    list_fv bound us set es
-  | E_app_infix(l,id,r) ->
-    let us = conditional_add_exp bound used id in
-    list_fv bound us set [l;r]
-  | E_if(c,t,e) -> list_fv bound used set [c;t;e]
-  | E_for(id,from,to_,by,_,body) ->
-    let _,used,set = list_fv bound used set [from;to_;by] in
-    fv_of_exp consider_var (Nameset.add (string_of_id id) bound) used set body
-  | E_vector_indexed (es_i,(Ast.Def_val_aux(default,_))) ->
-    let bound,used,set =
-      List.fold_right
-        (fun (_,e) (b,u,s) -> fv_of_exp consider_var b u s e) es_i (bound,used,set) in
-    (match default with
-     | Def_val_empty -> bound,used,set
-     | Def_val_dec e -> fv_of_exp consider_var bound used set e)
-  | E_vector_access(v,i) -> list_fv bound used set [v;i]
-  | E_vector_subrange(v,i1,i2) -> list_fv bound used set [v;i1;i2]
-  | E_vector_update(v,i,e) -> list_fv bound used set [v;i;e]
-  | E_vector_update_subrange(v,i1,i2,e) -> list_fv bound used set [v;i1;i2;e]
-  | E_vector_append(e1,e2) | E_cons(e1,e2) -> list_fv bound used set [e1;e2]
-  | E_record (FES_aux(FES_Fexps(fexps,_),_)) ->
-     let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-     List.fold_right
-       (fun (FE_aux(FE_Fexp(_,e),_)) (b,u,s) -> fv_of_exp consider_var b u s e) fexps (bound,used,set)
-  | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
-    let b,u,s = fv_of_exp consider_var bound used set e in
-    List.fold_right
-      (fun (FE_aux(FE_Fexp(_,e),_)) (b,u,s) -> fv_of_exp consider_var b u s e) fexps (b,u,s)
-  | E_field(e,_) -> fv_of_exp consider_var bound used set e
-  | E_case(e,pes) ->
-    let b,u,s = fv_of_exp consider_var bound used set e in
-    fv_of_pes consider_var b u s pes
-  | E_let(lebind,e) ->
-    let b,u,s = fv_of_let consider_var bound used set lebind in
-    fv_of_exp consider_var b u s e
-  | E_assign(lexp,e) ->
-    let b,u,s = fv_of_lexp consider_var bound used set lexp in
-    let _,used,set = fv_of_exp consider_var bound u s e in
-    b,used,set
-  | E_exit e -> fv_of_exp consider_var bound used set e
-  | E_assert(c,m) -> list_fv bound used set [c;m]
-  | _ -> bound,used,set
-
-and fv_of_pes consider_var bound used set pes =
-  match pes with
-  | [] -> bound,used,set
-  | Pat_aux(Pat_exp (p,e),_)::pes ->
-    let bound_p,us_p = pat_bindings consider_var bound used p in
-    let bound_e,us_e,set_e = fv_of_exp consider_var bound_p us_p set e in
-    fv_of_pes consider_var bound us_e set_e pes
-    
-and fv_of_let consider_var bound used set (LB_aux(lebind,_)) = match lebind with
-  | LB_val_explicit(typsch,pat,exp) ->
-    let bound_t,us_t = fv_of_typschm consider_var bound used typsch in
-    let bound_p, us_p = pat_bindings consider_var (Nameset.union bound bound_t) used pat in
-    let _,us_e,set_e = fv_of_exp consider_var (Nameset.union bound bound_t) used set exp in
-    (Nameset.union bound_t bound_p),Nameset.union us_t (Nameset.union us_p us_e),set_e
-  | LB_val_implicit(pat,exp) ->
-    let bound_p, us_p = pat_bindings consider_var bound used pat in
-    let _,us_e,set_e = fv_of_exp consider_var bound used set exp in
-    bound_p,Nameset.union us_p us_e,set_e
-    
-and fv_of_lexp consider_var bound used set (LEXP_aux(lexp,(_,tannot))) =
-  match lexp with
-  | LEXP_id id ->
-    let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    let i = string_of_id id in
-    if Nameset.mem i bound
-    then bound, used, Nameset.add i set
-    else Nameset.add i bound, Nameset.add i used, set
-  | LEXP_cast(typ,id) ->
-    let used = Nameset.union (free_type_names_tannot consider_var tannot) used in
-    let i = string_of_id id in
-    let used_t = fv_of_typ consider_var bound used typ in
-    if Nameset.mem i bound
-    then bound, used_t, Nameset.add i set
-    else Nameset.add i bound, Nameset.add i used_t, set
-  | LEXP_tup(tups) ->
-    List.fold_right (fun l (b,u,s) -> fv_of_lexp consider_var b u s l) tups (bound,used,set)
-  | LEXP_memory(id,args) ->
-    let (bound,used,set) =
-      List.fold_right
-        (fun e (b,u,s) ->
-          fv_of_exp consider_var b u s e) args (bound,used,set) in
-    bound,Nameset.add (string_of_id id) used,set
-  | LEXP_field(lexp,_) -> fv_of_lexp consider_var bound used set lexp
-  | LEXP_vector(lexp,exp) ->
-    let bound_l,used,set = fv_of_lexp consider_var bound used set lexp in
-    let _,used,set = fv_of_exp consider_var bound used set exp in
-    bound_l,used,set
-  | LEXP_vector_range(lexp,e1,e2) ->
-    let bound_l,used,set = fv_of_lexp consider_var bound used set lexp in
-    let _,used,set = fv_of_exp consider_var bound used set e1 in
-    let _,used,set = fv_of_exp consider_var bound used set e2 in
-    bound_l,used,set
-
-let init_env s = Nameset.singleton s
-
-let typ_variants consider_var bound tunions =
-  List.fold_right
-    (fun (Tu_aux(t,_)) (b,n) -> match t with
-       | Tu_id id -> Nameset.add (string_of_id id) b,n
-       | Tu_ty_id(t,id) -> Nameset.add (string_of_id id) b, fv_of_typ consider_var b n t)
-    tunions
-    (bound,mt)
-
-let fv_of_kind_def consider_var (KD_aux(k,_)) = match k with
-  | KD_nabbrev(_,id,_,nexp) -> init_env (string_of_id id), fv_of_nexp consider_var mt mt nexp
-  | KD_abbrev(_,id,_,typschm) ->
-    init_env (string_of_id id), snd (fv_of_typschm consider_var mt mt typschm)
-  | KD_record(_,id,_,typq,tids,_) ->
-    let binds = init_env (string_of_id id) in
-    let bounds = if consider_var then typq_bindings typq else mt in
-    binds, List.fold_right (fun (t,_) n -> fv_of_typ consider_var bounds n t) tids mt
-  | KD_variant(_,id,_,typq,tunions,_) ->
-    let bindings = Nameset.add (string_of_id id) (if consider_var then typq_bindings typq else mt) in
-    typ_variants consider_var bindings tunions
-  | KD_enum(_,id,_,ids,_) ->
-    Nameset.of_list (List.map string_of_id (id::ids)),mt
-  | KD_register(_,id,n1,n2,_) ->
-    init_env (string_of_id id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
-
-let fv_of_type_def consider_var (TD_aux(t,_)) = match t with
-  | TD_abbrev(id,_,typschm) -> init_env (string_of_id id), snd (fv_of_typschm consider_var mt mt typschm)
-  | TD_record(id,_,typq,tids,_) ->
-    let binds = init_env (string_of_id id) in
-    let bounds = if consider_var then typq_bindings typq else mt in
-    binds, List.fold_right (fun (t,_) n -> fv_of_typ consider_var bounds n t) tids mt
-  | TD_variant(id,_,typq,tunions,_) ->
-    let bindings = Nameset.add (string_of_id id) (if consider_var then typq_bindings typq else mt) in
-    typ_variants consider_var bindings tunions
-  | TD_enum(id,_,ids,_) ->
-    Nameset.of_list (List.map string_of_id (id::ids)),mt
-  | TD_register(id,n1,n2,_) ->
-    init_env (string_of_id id), fv_of_nexp consider_var mt (fv_of_nexp consider_var mt mt n1) n2
-
-let fv_of_tannot_opt consider_var (Typ_annot_opt_aux (t,_)) =
-  match t with
-  | Typ_annot_opt_some (typq,typ) ->
-    let bindings = if consider_var then typq_bindings typq else mt in
-    let free = fv_of_typ consider_var bindings mt typ in
-    (bindings,free)
-  | Typ_annot_opt_none ->
-    (mt, mt)
-
-(*Unlike the other fv, the bound returns are the names bound by the pattern for use in the exp*)
-let fv_of_funcl consider_var base_bounds (FCL_aux(FCL_Funcl(id,pat,exp),l)) =
-  let pat_bs,pat_ns = pat_bindings consider_var base_bounds mt pat in
-  let _, exp_ns, exp_sets = fv_of_exp consider_var pat_bs pat_ns mt exp in
-  (pat_bs,exp_ns,exp_sets)
-
-let fv_of_fun consider_var (FD_aux (FD_function(rec_opt,tannot_opt,_,funcls),_)) =
-  let fun_name = match funcls with
-    | [] -> failwith "fv_of_fun fell off the end looking for the function name"
-    | FCL_aux(FCL_Funcl(id,_,_),_)::_ -> string_of_id id in
-  let base_bounds = match rec_opt with
-    | Rec_aux(Ast.Rec_rec,_) -> init_env fun_name
-    | _ -> mt in
-  let base_bounds,ns_r = match tannot_opt with
-    | Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ),_) ->
-      let bindings = if consider_var then typq_bindings typq else mt in
-      let bound = Nameset.union bindings base_bounds in
-      bound, fv_of_typ consider_var bound mt typ
-    | Typ_annot_opt_aux(Typ_annot_opt_none, _) ->
-      base_bounds, mt in
-  let ns = List.fold_right (fun (FCL_aux(FCL_Funcl(_,pat,exp),_)) ns ->
-      let pat_bs,pat_ns = pat_bindings consider_var base_bounds ns pat in
-      let _, exp_ns,_ = fv_of_exp consider_var pat_bs pat_ns Nameset.empty exp in
-      exp_ns) funcls mt in
-  init_env fun_name,Nameset.union ns ns_r
-
-let fv_of_vspec consider_var (VS_aux(vspec,_)) = match vspec with
-  | VS_val_spec(ts,id) | VS_extern_no_rename (ts,id) | VS_extern_spec(ts,id,_)
-  | VS_cast_spec(ts,id) ->
-     init_env ("val:" ^ (string_of_id id)), snd (fv_of_typschm consider_var mt mt ts)
-
-let rec find_scattered_of name = function
-  | [] -> []
-  | DEF_scattered (SD_aux(sda,_) as sd):: defs ->
-    (match sda with
-     | SD_scattered_function(_,_,_,id)
-     | SD_scattered_funcl(FCL_aux(FCL_Funcl(id,_,_),_))
-     | SD_scattered_unioncl(id,_) ->
-       if name = string_of_id id
-       then [sd] else []
-     | _ -> [])@
-    (find_scattered_of name defs)
-  | _::defs -> find_scattered_of name defs
-
-let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd,_)) = match sd with
-  | SD_scattered_function(_,tannot_opt,_,id) ->
-    let b,ns = (match tannot_opt with
-        | Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ),_) ->
-          let bindings = if consider_var then typq_bindings typq else mt in
-          bindings, fv_of_typ consider_var bindings mt typ
-        | Typ_annot_opt_aux(Typ_annot_opt_none, _) ->
-          mt, mt) in
-    init_env (string_of_id id),ns
-  | SD_scattered_funcl (FCL_aux(FCL_Funcl(id,pat,exp),_)) ->
-    let pat_bs,pat_ns = pat_bindings consider_var mt mt pat in
-    let _,exp_ns,_ = fv_of_exp consider_var pat_bs pat_ns Nameset.empty exp in
-    let scattered_binds = match pat with
-      | P_aux(P_app(pid,_),_) -> init_env ((string_of_id id) ^ "/" ^ (string_of_id pid))
-      | _ -> mt in
-    scattered_binds, exp_ns
-  | SD_scattered_variant (id,_,_) ->
-    let name = string_of_id id in
-    let uses =
-      if consider_scatter_as_one
-      then
-        let variant_defs = find_scattered_of name all_defs in
-        let pieces_uses =
-          List.fold_right (fun (binds,uses) all_uses -> Nameset.union uses all_uses)
-            (List.map (fv_of_scattered consider_var false []) variant_defs) mt in
-        Nameset.remove name pieces_uses
-      else mt in
-    init_env name, uses
-  | SD_scattered_unioncl(id, type_union) ->
-    let typ_name = string_of_id id in
-    let b = init_env typ_name in
-    let (b,r) = typ_variants consider_var b [type_union] in
-    (Nameset.remove typ_name b, Nameset.add typ_name r)
-  | SD_scattered_end id ->
-    let name = string_of_id id in
-    let uses = if consider_scatter_as_one
-    (*Note: if this is a function ending, the dec is included *)
-      then
-        let scattered_defs = find_scattered_of name all_defs in
-        List.fold_right (fun (binds,uses) all_uses -> Nameset.union (Nameset.union binds uses) all_uses)
-          (List.map (fv_of_scattered consider_var false []) scattered_defs) (init_env name)
-      else init_env name in
-    init_env (name ^ "/end"), uses
-
-let fv_of_rd consider_var (DEC_aux (d,_)) = match d with
-  | DEC_reg(t,id) ->
-    init_env (string_of_id id), fv_of_typ consider_var mt mt t
-  | DEC_alias(id,alias) ->
-    init_env (string_of_id id),mt
-  | DEC_typ_alias(t,id,alias) ->
-    init_env (string_of_id id), mt
-
-let fv_of_def consider_var consider_scatter_as_one all_defs = function
-  | DEF_kind kdef -> fv_of_kind_def consider_var kdef
-  | DEF_type tdef -> fv_of_type_def consider_var tdef
-  | DEF_fundef fdef -> fv_of_fun consider_var fdef
-  | DEF_val lebind -> ((fun (b,u,_) -> (b,u)) (fv_of_let consider_var mt mt mt lebind))
-  | DEF_spec vspec -> fv_of_vspec consider_var vspec
-  | DEF_overload (id,ids) -> init_env (string_of_id id), List.fold_left (fun ns id -> Nameset.add (string_of_id id) ns) mt ids
-  | DEF_default def -> mt,mt
-  | DEF_scattered sdef -> fv_of_scattered consider_var consider_scatter_as_one all_defs sdef
-  | DEF_reg_dec rdec -> fv_of_rd consider_var rdec
-  | DEF_comm _ -> mt,mt
-
-let group_defs consider_scatter_as_one (Ast.Defs defs) =
-  List.map (fun d -> (fv_of_def false consider_scatter_as_one defs d,d)) defs
-
-(*******************************************************************************
- * Reorder defs take 2
-*)
-
-(*remove all of ns1 instances from ns2*)
-let remove_all ns1 ns2 =
-  List.fold_right Nameset.remove (Nameset.elements ns1) ns2
-
-let remove_from_all_uses bs dbts =
-  List.map (fun ((b,uses),d) -> (b,remove_all bs uses),d) dbts
-
-let remove_local_or_lib_vars dbts =
-  let bound_in_dbts = List.fold_right (fun ((b,_),_) bounds -> Nameset.union b bounds) dbts mt in
-  let is_bound_in_defs s = Nameset.mem s bound_in_dbts in
-  let rec remove_from_uses = function
-    | [] -> []
-    | ((b,uses),d)::defs ->
-      ((b,(Nameset.filter is_bound_in_defs uses)),d)::remove_from_uses defs in
-  remove_from_uses dbts
-
-let compare_dbts ((_,u1),_) ((_,u2),_) = Pervasives.compare (Nameset.cardinal u1) (Nameset.cardinal u2)
-
-let rec print_dependencies orig_queue work_queue names =
-  match work_queue with
-  | [] -> ()
-  | ((binds,uses),_)::wq ->
-    (if not(Nameset.is_empty(Nameset.inter names binds))
-     then ((Printf.eprintf "binds of %s has uses of %s\n" (set_to_string binds) (set_to_string uses));
-           print_dependencies orig_queue orig_queue uses));
-    print_dependencies orig_queue wq names
-
-let rec topological_sort work_queue defs =
-  match work_queue with
-  | [] -> List.rev defs
-  | ((binds,uses),def)::wq ->
-    (*Assumes work queue given in sorted order, invariant mantained on appropriate recursive calls*)
-    if (Nameset.cardinal uses = 0)
-    then (*let _ = Printf.eprintf "Adding def that binds %s to definitions\n" (set_to_string binds) in*)
-      topological_sort (remove_from_all_uses binds wq) (def::defs)
-    else if not(Nameset.is_empty(Nameset.inter binds uses))
-    then topological_sort (((binds,(remove_all binds uses)),def)::wq) defs
-    else
-      match List.stable_sort compare_dbts work_queue with (*We wait to sort until there are no 0 dependency nodes on top*)
-      | [] -> failwith "sort shrunk the list???"
-      | (((n,uses),_)::_) as wq ->
-        if (Nameset.cardinal uses = 0)
-        then topological_sort wq defs
-        else let _ = Printf.eprintf "Uses on failure are %s, binds are %s\n" (set_to_string uses) (set_to_string n)
-          in let _ = print_dependencies wq wq uses in failwith "A dependency was unmet"
-
-let rec add_to_partial_order ((binds,uses),def) = function
-  | [] ->
-(*    let _ = Printf.eprintf "add_to_partial_order for def with bindings %s, uses %s.\n Eol case.\n" (set_to_string binds) (set_to_string uses) in*)
-    [(binds,uses),def]
-  | (((bf,uf),deff)::defs as full_defs) ->
-    (*let _ = Printf.eprintf "add_to_partial_order for def with bindings %s, uses %s.\n None eol case. With first def binding %s, uses %s\n" (set_to_string binds) (set_to_string uses) (set_to_string bf) (set_to_string uf) in*)
-    if Nameset.is_empty uses
-    then ((binds,uses),def)::full_defs
-    else if Nameset.subset binds uf (*deff relies on def, so def must be defined first*)
-    then ((binds,uses),def)::((bf,(remove_all binds uf)),deff)::defs
-    else if Nameset.subset bf uses (*def relies at least on deff, but maybe more, push in*)
-    then ((bf,uf),deff)::(add_to_partial_order ((binds,(remove_all bf uses)),def) defs)
-    else (*These two are unrelated but new def might need to go further in*)
-      ((bf,uf),deff)::(add_to_partial_order ((binds,uses),def) defs)
-
-let rec gather_defs name already_included def_bind_triples =
-  match def_bind_triples with
-  | [] -> [],already_included,mt
-  | ((binds,uses),def)::def_bind_triples ->
-    let (defs,already_included,requires) = gather_defs name already_included def_bind_triples in
-    let bound_names = Nameset.elements binds in
-    if List.mem name already_included || List.exists (fun b -> List.mem b already_included) bound_names 
-    then (defs,already_included,requires)
-    else
-      let uses = List.fold_right Nameset.remove already_included uses in
-      if Nameset.mem name binds
-      then (def::defs,(bound_names@already_included), Nameset.remove name (Nameset.union uses requires))
-      else (defs,already_included,requires)
-
-let rec gather_all names already_included def_bind_triples =
-  let rec gather ns already_included defs reqs = match ns with
-    | [] -> defs,already_included,reqs
-    | name::ns ->
-      if List.mem name already_included
-      then gather ns already_included defs (Nameset.remove name reqs)
-      else
-        let (new_defs,already_included,new_reqs) = gather_defs name already_included def_bind_triples in
-        gather ns already_included (new_defs@defs) (Nameset.remove name (Nameset.union new_reqs reqs))
-  in
-  let (defs,already_included,reqs) = gather names already_included [] mt in
-  if Nameset.is_empty reqs
-  then defs
-  else (gather_all (Nameset.elements reqs) already_included def_bind_triples)@defs
-    
-let restrict_defs defs name_list =
-  let defsno = gather_all name_list [] (group_defs false defs) in
-  let rdbts = group_defs true (Defs defsno) in
-  (*let partial_order =
-    List.fold_left (fun po d -> add_to_partial_order d po) [] rdbts in
-    let defs = List.map snd partial_order in*)
-  let defs = topological_sort (List.sort compare_dbts (remove_local_or_lib_vars rdbts)) [] in
-  Defs defs
-
-
-let top_sort_defs defs =
-  let rdbts = group_defs true defs in
-  let defs = topological_sort (List.stable_sort compare_dbts (remove_local_or_lib_vars rdbts)) [] in
-  Defs defs
diff --git a/src/spec_analysis_new_tc.mli b/src/spec_analysis_new_tc.mli
deleted file mode 100644
index 7c6f3685..00000000
--- a/src/spec_analysis_new_tc.mli
+++ /dev/null
@@ -1,70 +0,0 @@
-(**************************************************************************)
-(*     Sail                                                               *)
-(*                                                                        *)
-(*  Copyright (c) 2013-2017                                               *)
-(*    Kathyrn Gray                                                        *)
-(*    Shaked Flur                                                         *)
-(*    Stephen Kell                                                        *)
-(*    Gabriel Kerneis                                                     *)
-(*    Robert Norton-Wright                                                *)
-(*    Christopher Pulte                                                   *)
-(*    Peter Sewell                                                        *)
-(*                                                                        *)
-(*  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 Util
-open Type_check_new
-
-(*Determines if the first typ is within the range of the the second typ, 
-  using the constraints provided when the first typ contains variables. 
-  It is an error for second typ to be anything other than a range type
-  If the first typ is a vector, then determines if the max representable 
-  number is in the range of the second; it is an error for the first typ
-  to be anything other than a vector, a range, an atom, or a bit (after
-  suitable unwrapping of abbreviations, reg, and registers). 
-*)
-(* val is_within_range: typ -> typ -> nexp_range list -> triple
-val is_within_machine64 : typ -> nexp_range list -> triple *)
-
-(* free variables and dependencies *)
-
-(*fv_of_def consider_ty_vars consider_scatter_as_one all_defs all_defs def -> (bound_by_def, free_in_def) *)
-(* val fv_of_def: bool -> bool -> ('a def) list -> 'a def -> Nameset.t * Nameset.t *)
-
-(*group_defs consider_scatter_as_one all_defs -> ((bound_by_def, free_in_def), def) list *)
-(* val group_defs : bool -> 'a defs -> ((Nameset.t * Nameset.t) * ('a def)) list *)
-
-(*reodering definitions, initial functions *)
-(* produce a new ordering for defs, limiting to those listed in the list, which respects dependencies *)
-(* val restrict_defs : 'a defs -> string list -> 'a defs *)
-
-val top_sort_defs : tannot defs -> tannot defs