Merge branch 'sail2' into rmem_interpreter

55 files changed, 6409 insertions, 4496 deletions

diff --git a/src/_tags b/src/_tags
index 6b2bf716..cdc8fbb5 100644
--- a/src/_tags
+++ b/src/_tags
@@ -1,11 +1,12 @@
 true: -traverse, debug, use_menhir
 <**/*.ml>: bin_annot, annot
 
-<sail.{byte,native}>: package(zarith), package(linksem), package(lem), package(base64), use_pprint
-<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(base64), use_pprint
+<sail.{byte,native}>: package(zarith), package(linksem), package(lem), package(omd), package(base64), use_pprint
+<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(omd), package(base64), use_pprint
 
 <isail.ml>: package(linenoise)
 <elf_loader.ml>: package(linksem)
+<latex.ml>: package(omd)
 <**/*.m{l,li}>: package(lem), package(base64)
 
 <gen_lib>: include
diff --git a/src/anf.ml b/src/anf.ml
index 0f98caff..915ab738 100644
--- a/src/anf.ml
+++ b/src/anf.ml
@@ -57,9 +57,6 @@ open PPrint
 
 module Big_int = Nat_big_num
 
-let anf_error ?loc:(l=Parse_ast.Unknown) message =
-  raise (Reporting_basic.err_general l ("\nANF translation: " ^ message))
-
 (**************************************************************************)
 (* 1. Conversion to A-normal form (ANF)                                   *)
 (**************************************************************************)
@@ -130,7 +127,7 @@ and 'a aval =
   | AV_list of ('a aval) list * 'a
   | AV_vector of ('a aval) list * 'a
   | AV_record of ('a aval) Bindings.t * 'a
-  | AV_C_fragment of fragment * 'a
+  | AV_C_fragment of fragment * 'a * ctyp
 
 (* Renaming variables in ANF expressions *)
 
@@ -186,7 +183,7 @@ let rec aval_rename from_id to_id = function
   | AV_list (avals, typ) -> AV_list (List.map (aval_rename from_id to_id) avals, typ)
   | AV_vector (avals, typ) -> AV_vector (List.map (aval_rename from_id to_id) avals, typ)
   | AV_record (avals, typ) -> AV_record (Bindings.map (aval_rename from_id to_id) avals, typ)
-  | AV_C_fragment (fragment, typ) -> AV_C_fragment (frag_rename from_id to_id fragment, typ)
+  | AV_C_fragment (fragment, typ, ctyp) -> AV_C_fragment (frag_rename from_id to_id fragment, typ, ctyp)
 
 let rec aexp_rename from_id to_id (AE_aux (aexp, env, l)) =
   let recur = aexp_rename from_id to_id in
@@ -426,7 +423,8 @@ and pp_aval = function
   | AV_id (id, lvar) -> pp_lvar lvar (pp_id id)
   | AV_tuple avals -> parens (separate_map (comma ^^ space) pp_aval avals)
   | AV_ref (id, lvar) -> string "ref" ^^ space ^^ pp_lvar lvar (pp_id id)
-  | AV_C_fragment (frag, typ) -> pp_annot typ (string (string_of_fragment frag |> Util.cyan |> Util.clear))
+  | AV_C_fragment (frag, typ, ctyp) ->
+     pp_annot typ (string ("(" ^ string_of_ctyp ctyp ^ ")" ^ string_of_fragment frag |> Util.cyan |> Util.clear))
   | AV_vector (avals, typ) ->
      pp_annot typ (string "[" ^^ separate_map (comma ^^ space) pp_aval avals ^^ string "]")
   | AV_list (avals, typ) ->
@@ -453,23 +451,26 @@ let rec split_block l = function
   | exp :: exps ->
      let exps, last = split_block l exps in
      exp :: exps, last
-  | [] -> anf_error ~loc:l "empty block"
+  | [] ->
+     raise (Reporting.err_unreachable l __POS__ "empty block found when converting to ANF")
 
 let rec anf_pat ?global:(global=false) (P_aux (p_aux, annot) as pat) =
   let mk_apat aux = AP_aux (aux, env_of_annot annot, fst annot) in
   match p_aux with
-  | P_id id when global -> mk_apat (AP_global (id, pat_typ_of pat))
-  | P_id id -> mk_apat (AP_id (id, pat_typ_of pat))
-  | P_wild -> mk_apat (AP_wild (pat_typ_of pat))
+  | P_id id when global -> mk_apat (AP_global (id, typ_of_pat pat))
+  | P_id id -> mk_apat (AP_id (id, typ_of_pat pat))
+  | P_wild -> mk_apat (AP_wild (typ_of_pat pat))
   | P_tup pats -> mk_apat (AP_tup (List.map (fun pat -> anf_pat ~global:global pat) pats))
-  | P_app (id, [subpat]) -> mk_apat (AP_app (id, anf_pat ~global:global subpat, pat_typ_of pat))
-  | P_app (id, pats) -> mk_apat (AP_app (id, mk_apat (AP_tup (List.map (fun pat -> anf_pat ~global:global pat) pats)), pat_typ_of pat))
+  | P_app (id, [subpat]) -> mk_apat (AP_app (id, anf_pat ~global:global subpat, typ_of_pat pat))
+  | P_app (id, pats) -> mk_apat (AP_app (id, mk_apat (AP_tup (List.map (fun pat -> anf_pat ~global:global pat) pats)), typ_of_pat pat))
   | P_typ (_, pat) -> anf_pat ~global:global pat
   | P_var (pat, _) -> anf_pat ~global:global pat
   | P_cons (hd_pat, tl_pat) -> mk_apat (AP_cons (anf_pat ~global:global hd_pat, anf_pat ~global:global tl_pat))
-  | P_list pats -> List.fold_right (fun pat apat -> mk_apat (AP_cons (anf_pat ~global:global pat, apat))) pats (mk_apat (AP_nil (pat_typ_of pat)))
-  | P_lit (L_aux (L_unit, _)) -> mk_apat (AP_wild (pat_typ_of pat))
-  | _ -> anf_error ~loc:(fst annot) ("Could not convert pattern to ANF: " ^ string_of_pat pat)
+  | P_list pats -> List.fold_right (fun pat apat -> mk_apat (AP_cons (anf_pat ~global:global pat, apat))) pats (mk_apat (AP_nil (typ_of_pat pat)))
+  | P_lit (L_aux (L_unit, _)) -> mk_apat (AP_wild (typ_of_pat pat))
+  | _ ->
+     raise (Reporting.err_unreachable (fst annot) __POS__
+       ("Could not convert pattern to ANF: " ^ string_of_pat pat))
 
 let rec apat_globals (AP_aux (aux, _, _)) =
   match aux with
@@ -510,7 +511,7 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
   | E_lit lit -> mk_aexp (ae_lit lit (typ_of exp))
 
   | E_block [] ->
-     Util.warn (Reporting_basic.loc_to_string l
+     Util.warn (Reporting.loc_to_string l
                 ^ "\n\nTranslating empty block (possibly assigning to an uninitialized variable at the end of a block?)");
      mk_aexp (ae_lit (L_aux (L_unit, l)) (typ_of exp))
   | E_block exps ->
@@ -529,7 +530,8 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
      mk_aexp (AE_assign (id, lvar_typ (Env.lookup_id id (env_of exp)), aexp))
 
   | E_assign (lexp, _) ->
-     failwith ("Encountered complex l-expression " ^ string_of_lexp lexp ^ " when converting to ANF")
+     raise (Reporting.err_unreachable l __POS__
+       ("Encountered complex l-expression " ^ string_of_lexp lexp ^ " when converting to ANF"))
 
   | E_loop (loop_typ, cond, exp) ->
      let acond = anf cond in
@@ -567,7 +569,7 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
      let aval, wrap = to_aval (anf field_exp) in
      wrap (mk_aexp (AE_field (aval, id, typ_of exp)))
 
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record_update (exp, fexps) ->
      let anf_fexp (FE_aux (FE_Fexp (id, exp), _)) =
        let aval, wrap = to_aval (anf exp) in
        (id, aval), wrap
@@ -665,7 +667,8 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
      mk_aexp (AE_let (Mutable, id, lvar_typ lvar, anf binding, anf body, typ_of exp))
 
   | E_var (lexp, _, _) ->
-     failwith ("Encountered complex l-expression " ^ string_of_lexp lexp ^ " when converting to ANF")
+     raise (Reporting.err_unreachable l __POS__
+       ("Encountered complex l-expression " ^ string_of_lexp lexp ^ " when converting to ANF"))
 
   | E_let (LB_aux (LB_val (pat, binding), _), body) ->
      anf (E_aux (E_case (binding, [Pat_aux (Pat_exp (pat, body), (Parse_ast.Unknown, empty_tannot))]), exp_annot))
@@ -676,7 +679,7 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
      let wrap = List.fold_left (fun f g x -> f (g x)) (fun x -> x) (List.map snd avals) in
      wrap (mk_aexp (AE_val (AV_tuple (List.map fst avals))))
 
-  | E_record (FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record fexps ->
      let anf_fexp (FE_aux (FE_Fexp (id, exp), _)) =
        let aval, wrap = to_aval (anf exp) in
        (id, aval), wrap
@@ -690,19 +693,19 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
 
   | E_vector_access _ | E_vector_subrange _ | E_vector_update _ | E_vector_update_subrange _ | E_vector_append _ ->
      (* Should be re-written by type checker *)
-     failwith "encountered raw vector operation when converting to ANF"
+     raise (Reporting.err_unreachable l __POS__ "encountered raw vector operation when converting to ANF")
 
   | E_internal_value _ ->
      (* Interpreter specific *)
-     failwith "encountered E_internal_value when converting to ANF"
+     raise (Reporting.err_unreachable l __POS__ "encountered E_internal_value when converting to ANF")
 
   | E_sizeof _ | E_constraint _ ->
      (* Sizeof nodes removed by sizeof rewriting pass *)
-     failwith "encountered E_sizeof or E_constraint node when converting to ANF"
+     raise (Reporting.err_unreachable l __POS__ "encountered E_sizeof or E_constraint node when converting to ANF")
 
   | E_nondet _ ->
      (* We don't compile E_nondet nodes *)
-     failwith "encountered E_nondet node when converting to ANF"
+     raise (Reporting.err_unreachable l __POS__ "encountered E_nondet node when converting to ANF")
 
   | E_internal_return _ | E_internal_plet _ ->
-     failwith "encountered unexpected internal node when converting to ANF"
+     raise (Reporting.err_unreachable l __POS__ "encountered unexpected internal node when converting to ANF")
diff --git a/src/anf.mli b/src/anf.mli
index 9854b04c..5e162b7c 100644
--- a/src/anf.mli
+++ b/src/anf.mli
@@ -96,7 +96,7 @@ and 'a aval =
   | AV_list of ('a aval) list * 'a
   | AV_vector of ('a aval) list * 'a
   | AV_record of ('a aval) Bindings.t * 'a
-  | AV_C_fragment of fragment * 'a
+  | AV_C_fragment of fragment * 'a * ctyp
 
 val gensym : unit -> id
 
diff --git a/src/ast_util.ml b/src/ast_util.ml
index 3d13c5c3..34dfd663 100644
--- a/src/ast_util.ml
+++ b/src/ast_util.ml
@@ -106,13 +106,13 @@ let mk_funcl id pat body = FCL_aux (FCL_Funcl (id, Pat_aux (Pat_exp (pat, body),
 
 let mk_qi_nc nc = QI_aux (QI_const nc, Parse_ast.Unknown)
 
-let mk_qi_id bk kid =
+let mk_qi_id k kid =
   let kopt =
-    KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (bk, Parse_ast.Unknown)], Parse_ast.Unknown), kid), Parse_ast.Unknown)
+    KOpt_aux (KOpt_kind (K_aux (k, Parse_ast.Unknown), kid), Parse_ast.Unknown)
   in
   QI_aux (QI_id kopt, Parse_ast.Unknown)
 
-let mk_qi_kopt kopt =QI_aux (QI_id kopt, Parse_ast.Unknown)
+let mk_qi_kopt kopt = QI_aux (QI_id kopt, Parse_ast.Unknown)
 
 let mk_fundef funcls =
   let tannot_opt = Typ_annot_opt_aux (Typ_annot_opt_none, Parse_ast.Unknown) in
@@ -126,21 +126,23 @@ let mk_letbind pat exp = LB_aux (LB_val (pat, exp), no_annot)
 let mk_val_spec vs_aux =
   DEF_spec (VS_aux (vs_aux, no_annot))
 
-let kopt_kid (KOpt_aux (kopt_aux, _)) =
-  match kopt_aux with
-  | KOpt_none kid | KOpt_kind (_, kid) -> kid
-
+let kopt_kid (KOpt_aux (KOpt_kind (_, kid), _)) = kid
+let kopt_kind (KOpt_aux (KOpt_kind (k, _), _)) = k
+                                               
 let is_nat_kopt = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_int, _)], _), _), _) -> true
-  | KOpt_aux (KOpt_none _, _) -> true
+  | KOpt_aux (KOpt_kind (K_aux (K_int, _), _), _) -> true
   | _ -> false
 
 let is_order_kopt = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_order, _)], _), _), _) -> true
+  | KOpt_aux (KOpt_kind (K_aux (K_order, _), _), _) -> true
   | _ -> false
 
 let is_typ_kopt = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_type, _)], _), _), _) -> true
+  | KOpt_aux (KOpt_kind (K_aux (K_type, _), _), _) -> true
+  | _ -> false
+
+let is_bool_kopt = function
+  | KOpt_aux (KOpt_kind (K_aux (K_bool, _), _), _) -> true
   | _ -> false
 
 let string_of_kid = function
@@ -151,6 +153,27 @@ module Kid = struct
   let compare kid1 kid2 = String.compare (string_of_kid kid1) (string_of_kid kid2)
 end
 
+module Kind = struct
+  type t = kind
+  let compare (K_aux (aux1, _)) (K_aux (aux2, _)) =
+    match aux1, aux2 with
+    | K_int, K_int -> 0
+    | K_type, K_type -> 0
+    | K_order, K_order -> 0
+    | K_bool, K_bool -> 0
+    | K_int, _ -> 1 | _, K_int -> -1
+    | K_type, _ -> 1 | _, K_type -> -1
+    | K_order, _ -> 1 | _, K_order -> -1
+end
+                                  
+module KOpt = struct
+  type t = kinded_id
+  let compare kopt1 kopt2 =
+    let lex_ord c1 c2 = if c1 = 0 then c2 else c1 in
+    lex_ord (Kid.compare (kopt_kid kopt1) (kopt_kid kopt2))
+            (Kind.compare (kopt_kind kopt1) (kopt_kind kopt2))
+end
+
 module Id = struct
   type t = id
   let compare id1 id2 =
@@ -198,6 +221,8 @@ module Bindings = Map.Make(Id)
 module IdSet = Set.Make(Id)
 module KBindings = Map.Make(Kid)
 module KidSet = Set.Make(Kid)
+module KOptSet = Set.Make(KOpt)
+module KOptMap = Map.Make(KOpt)
 module NexpSet = Set.Make(Nexp)
 module NexpMap = Map.Make(Nexp)
 
@@ -270,13 +295,60 @@ and nexp_simp_aux = function
      end
   | nexp -> nexp
 
+let rec constraint_simp (NC_aux (nc_aux, l)) =
+  let nc_aux = match nc_aux with
+    | NC_equal (nexp1, nexp2) ->
+       let nexp1, nexp2 = nexp_simp nexp1, nexp_simp nexp2 in
+       if nexp_identical nexp1 nexp2 then
+         NC_true
+       else
+         NC_equal (nexp1, nexp2)
+
+    | NC_and (nc1, nc2) ->
+       let nc1, nc2 = constraint_simp nc1, constraint_simp nc2 in
+       begin match nc1, nc2 with
+       | NC_aux (NC_true, _), NC_aux (nc, _) -> nc
+       | NC_aux (nc, _), NC_aux (NC_true, _) -> nc
+       | _, _ -> NC_and (nc1, nc2)
+       end
+
+    | NC_or (nc1, nc2) ->
+       let nc1, nc2 = constraint_simp nc1, constraint_simp nc2 in
+       begin match nc1, nc2 with
+       | NC_aux (NC_false, _), NC_aux (nc, _) -> nc
+       | NC_aux (nc, _), NC_aux (NC_false, _) -> nc
+       | NC_aux (NC_true, _), NC_aux (nc, _) -> NC_true
+       | NC_aux (nc, _), NC_aux (NC_true, _) -> NC_true
+       | _, _ -> NC_or (nc1, nc2)
+       end
+    | NC_bounded_ge (nexp1, nexp2) ->
+       NC_bounded_ge (nexp_simp nexp1, nexp_simp nexp2)
+    | NC_bounded_le (nexp1, nexp2) ->
+       NC_bounded_le (nexp_simp nexp1, nexp_simp nexp2)
+    | _ -> nc_aux
+  in
+  NC_aux (nc_aux, l)
+
+let rec constraint_conj (NC_aux (nc_aux, l) as nc) =
+  match nc_aux with
+  | NC_and (nc1, nc2) -> constraint_conj nc1 @ constraint_conj nc2
+  | _ -> [nc]
+
+let rec constraint_disj (NC_aux (nc_aux, l) as nc) =
+  match nc_aux with
+  | NC_or (nc1, nc2) -> constraint_disj nc1 @ constraint_disj nc2
+  | _ -> [nc]
+
 let mk_typ typ = Typ_aux (typ, Parse_ast.Unknown)
-let mk_typ_arg arg = Typ_arg_aux (arg, Parse_ast.Unknown)
+let mk_typ_arg arg = A_aux (arg, Parse_ast.Unknown)
 let mk_kid str = Kid_aux (Var ("'" ^ str), Parse_ast.Unknown)
 let mk_infix_id str = Id_aux (DeIid str, Parse_ast.Unknown)
 
 let mk_id_typ id = Typ_aux (Typ_id id, Parse_ast.Unknown)
 
+let mk_kopt kind_aux id =
+  KOpt_aux (KOpt_kind (K_aux (kind_aux, Parse_ast.Unknown), id), Parse_ast.Unknown)
+
 let mk_ord ord_aux = Ord_aux (ord_aux, Parse_ast.Unknown)
 
 let unknown_typ = mk_typ Typ_internal_unknown
@@ -286,23 +358,23 @@ let unit_typ = mk_id_typ (mk_id "unit")
 let bit_typ = mk_id_typ (mk_id "bit")
 let real_typ = mk_id_typ (mk_id "real")
 let app_typ id args = mk_typ (Typ_app (id, args))
-let register_typ typ = mk_typ (Typ_app (mk_id "register", [mk_typ_arg (Typ_arg_typ typ)]))
+let register_typ typ = mk_typ (Typ_app (mk_id "register", [mk_typ_arg (A_typ typ)]))
 let atom_typ nexp =
-  mk_typ (Typ_app (mk_id "atom", [mk_typ_arg (Typ_arg_nexp (nexp_simp nexp))]))
+  mk_typ (Typ_app (mk_id "atom", [mk_typ_arg (A_nexp (nexp_simp nexp))]))
 let range_typ nexp1 nexp2 =
-  mk_typ (Typ_app (mk_id "range", [mk_typ_arg (Typ_arg_nexp (nexp_simp nexp1));
-                                   mk_typ_arg (Typ_arg_nexp (nexp_simp nexp2))]))
+  mk_typ (Typ_app (mk_id "range", [mk_typ_arg (A_nexp (nexp_simp nexp1));
+                                   mk_typ_arg (A_nexp (nexp_simp nexp2))]))
 let bool_typ = mk_id_typ (mk_id "bool")
 let string_typ = mk_id_typ (mk_id "string")
-let list_typ typ = mk_typ (Typ_app (mk_id "list", [mk_typ_arg (Typ_arg_typ typ)]))
+let list_typ typ = mk_typ (Typ_app (mk_id "list", [mk_typ_arg (A_typ typ)]))
 let tuple_typ typs = mk_typ (Typ_tup typs)
 let function_typ arg_typs ret_typ eff = mk_typ (Typ_fn (arg_typs, ret_typ, eff))
 
 let vector_typ n ord typ =
   mk_typ (Typ_app (mk_id "vector",
-                   [mk_typ_arg (Typ_arg_nexp (nexp_simp n));
-                    mk_typ_arg (Typ_arg_order ord);
-                    mk_typ_arg (Typ_arg_typ typ)]))
+                   [mk_typ_arg (A_nexp (nexp_simp n));
+                    mk_typ_arg (A_order ord);
+                    mk_typ_arg (A_typ typ)]))
 
 let exc_typ = mk_id_typ (mk_id "exception")
 
@@ -324,40 +396,49 @@ let nc_lteq n1 n2 = NC_aux (NC_bounded_le (n1, n2), Parse_ast.Unknown)
 let nc_gteq n1 n2 = NC_aux (NC_bounded_ge (n1, n2), Parse_ast.Unknown)
 let nc_lt n1 n2 = nc_lteq (nsum n1 (nint 1)) n2
 let nc_gt n1 n2 = nc_gteq n1 (nsum n2 (nint 1))
-let nc_and nc1 nc2 = mk_nc (NC_and (nc1, nc2))
 let nc_or nc1 nc2 = mk_nc (NC_or (nc1, nc2))
+let nc_var kid = mk_nc (NC_var kid)
 let nc_true = mk_nc NC_true
 let nc_false = mk_nc NC_false
 
-let rec nc_negate (NC_aux (nc, l)) =
-  match nc with
-  | NC_bounded_ge (n1, n2) -> nc_lt n1 n2
-  | NC_bounded_le (n1, n2) -> nc_gt n1 n2
-  | NC_equal (n1, n2) -> nc_neq n1 n2
-  | NC_not_equal (n1, n2) -> nc_eq n1 n2
-  | NC_and (n1, n2) -> mk_nc (NC_or (nc_negate n1, nc_negate n2))
-  | NC_or (n1, n2) -> mk_nc (NC_and (nc_negate n1, nc_negate n2))
-  | NC_false -> mk_nc NC_true
-  | NC_true -> mk_nc NC_false
-  | NC_set (kid, []) -> nc_false
-  | NC_set (kid, [int]) -> nc_neq (nvar kid) (nconstant int)
-  | NC_set (kid, int :: ints) ->
-     mk_nc (NC_and (nc_neq (nvar kid) (nconstant int), nc_negate (mk_nc (NC_set (kid, ints)))))
-  | NC_app _ ->
-     raise (Reporting_basic.err_unreachable l __POS__ "tried to negate constraint with unexpanded synonym")
+let nc_and nc1 nc2 =
+  match nc1, nc2 with
+  | _, NC_aux (NC_true, _) -> nc1
+  | NC_aux (NC_true, _), _ -> nc2
+  | _, _ -> mk_nc (NC_and (nc1, nc2))
+
+let arg_nexp ?loc:(l=Parse_ast.Unknown) n = A_aux (A_nexp n, l)
+let arg_order ?loc:(l=Parse_ast.Unknown) ord = A_aux (A_order ord, l)
+let arg_typ ?loc:(l=Parse_ast.Unknown) typ = A_aux (A_typ typ, l)
+let arg_bool ?loc:(l=Parse_ast.Unknown) nc = A_aux (A_bool nc, l)
+
+let arg_kopt (KOpt_aux (KOpt_kind (K_aux (k, _), v), l)) =
+  match k with
+  | K_int -> arg_nexp (nvar v)
+  | K_order -> arg_order (Ord_aux (Ord_var v, l))
+  | K_bool -> arg_bool (nc_var v)
+  | K_type -> arg_typ (mk_typ (Typ_var v))
+           
+let nc_not nc = mk_nc (NC_app (mk_id "not", [arg_bool nc]))
 
 let mk_typschm typq typ = TypSchm_aux (TypSchm_ts (typq, typ), Parse_ast.Unknown)
 
 let mk_typquant qis = TypQ_aux (TypQ_tq qis, Parse_ast.Unknown)
 
 let mk_fexp id exp = FE_aux (FE_Fexp (id, exp), no_annot)
-let mk_fexps fexps = FES_aux (FES_Fexps (fexps, false), no_annot)
 
 let mk_effect effs =
   Effect_aux (Effect_set (List.map (fun be_aux -> BE_aux (be_aux, Parse_ast.Unknown)) effs), Parse_ast.Unknown)
 
 let no_effect = mk_effect []
 
+let quant_add qi typq =
+  match qi, typq with
+  | QI_aux (QI_const (NC_aux (NC_true, _)), _), _ -> typq
+  | QI_aux (QI_id _, _), TypQ_aux (TypQ_tq qis, l) -> TypQ_aux (TypQ_tq (qi :: qis), l)
+  | QI_aux (QI_const nc, _), TypQ_aux (TypQ_tq qis, l) -> TypQ_aux (TypQ_tq (qis @ [qi]), l)
+  | _, TypQ_aux (TypQ_no_forall, l) -> TypQ_aux (TypQ_tq [qi], l)
+
 let quant_items : typquant -> quant_item list = function
   | TypQ_aux (TypQ_tq qis, _) -> qis
   | TypQ_aux (TypQ_no_forall, _) -> []
@@ -385,9 +466,19 @@ let quant_map_items f = function
   | TypQ_aux (TypQ_no_forall, l) -> TypQ_aux (TypQ_no_forall, l)
   | TypQ_aux (TypQ_tq qis, l) -> TypQ_aux (TypQ_tq (List.map f qis), l)
 
+let is_quant_kopt = function
+  | QI_aux (QI_id _, _) -> true
+  | _ -> false
+
+let is_quant_constraint = function
+  | QI_aux (QI_const _, _) -> true
+  | _ -> false
+                               
 let unaux_nexp (Nexp_aux (nexp, _)) = nexp
 let unaux_order (Ord_aux (ord, _)) = ord
 let unaux_typ (Typ_aux (typ, _)) = typ
+let unaux_kind (K_aux (k, _)) = k
+let unaux_constraint (NC_aux (nc, _)) = nc
 
 let rec map_exp_annot f (E_aux (exp, annot)) = E_aux (map_exp_annot_aux f exp, f annot)
 and map_exp_annot_aux f = function
@@ -412,8 +503,8 @@ and map_exp_annot_aux f = function
   | E_vector_append (exp1, exp2) -> E_vector_append (map_exp_annot f exp1, map_exp_annot f exp2)
   | E_list xs -> E_list (List.map (map_exp_annot f) xs)
   | E_cons (exp1, exp2) -> E_cons (map_exp_annot f exp1, map_exp_annot f exp2)
-  | E_record fexps -> E_record (map_fexps_annot f fexps)
-  | E_record_update (exp, fexps) -> E_record_update (map_exp_annot f exp, map_fexps_annot f fexps)
+  | E_record fexps -> E_record (List.map (map_fexp_annot f) fexps)
+  | E_record_update (exp, fexps) -> E_record_update (map_exp_annot f exp, List.map (map_fexp_annot f) fexps)
   | E_field (exp, id) -> E_field (map_exp_annot f exp, id)
   | E_case (exp, cases) -> E_case (map_exp_annot f exp, List.map (map_pexp_annot f) cases)
   | E_try (exp, cases) -> E_try (map_exp_annot f exp, List.map (map_pexp_annot f) cases)
@@ -433,7 +524,6 @@ and map_opt_default_annot f (Def_val_aux (df, annot)) = Def_val_aux (map_opt_def
 and map_opt_default_annot_aux f = function
   | Def_val_empty -> Def_val_empty
   | Def_val_dec exp -> Def_val_dec (map_exp_annot f exp)
-and map_fexps_annot f (FES_aux (FES_Fexps (fexps, b), annot)) = FES_aux (FES_Fexps (List.map (map_fexp_annot f) fexps, b), f annot)
 and map_fexp_annot f (FE_aux (FE_Fexp (id, exp), annot)) = FE_aux (FE_Fexp (id, map_exp_annot f exp), f annot)
 and map_pexp_annot f (Pat_aux (pexp, annot)) = Pat_aux (map_pexp_annot_aux f pexp, f annot)
 and map_pexp_annot_aux f = function
@@ -530,8 +620,8 @@ let def_loc = function
   | DEF_reg_dec (DEC_aux (_, (l, _)))
   | DEF_fixity (_, _, Id_aux (_, l))
   | DEF_overload (Id_aux (_, l), _) -> l
-  | DEF_constraint (Id_aux (_, l), _, _) -> l
   | DEF_internal_mutrec _ -> Parse_ast.Unknown
+  | DEF_pragma (_, _, l) -> l
 
 let string_of_id = function
   | Id_aux (Id v, _) -> v
@@ -576,14 +666,16 @@ let string_of_base_effect_aux = function
   (*| BE_lset -> "lset"
   | BE_lret -> "lret"*)
 
-let string_of_base_kind_aux = function
-  | BK_type -> "Type"
-  | BK_int -> "Int"
-  | BK_order -> "Order"
+let string_of_kind_aux = function
+  | K_type -> "Type"
+  | K_int -> "Int"
+  | K_order -> "Order"
+  | K_bool -> "Bool"
 
-let string_of_base_kind (BK_aux (bk, _)) = string_of_base_kind_aux bk
+let string_of_kind (K_aux (k, _)) = string_of_kind_aux k
 
-let string_of_kind (K_aux (K_kind bks, _)) = string_of_list " -> " string_of_base_kind bks
+let string_of_kinded_id (KOpt_aux (KOpt_kind (k, kid), _)) =
+  "(" ^ string_of_kid kid ^ " : " ^ string_of_kind k ^ ")"
 
 let string_of_base_effect = function
   | BE_aux (beff, _) -> string_of_base_effect_aux beff
@@ -618,23 +710,26 @@ and string_of_typ_aux = function
   | Typ_id id -> string_of_id id
   | Typ_var kid -> string_of_kid kid
   | Typ_tup typs -> "(" ^ string_of_list ", " string_of_typ typs ^ ")"
+  | Typ_app (id, args) when Id.compare id (mk_id "atom") = 0 -> "int(" ^ string_of_list ", " string_of_typ_arg args ^ ")"
+  | Typ_app (id, args) when Id.compare id (mk_id "atom_bool") = 0 -> "bool(" ^ string_of_list ", " string_of_typ_arg args ^ ")"
   | Typ_app (id, args) -> string_of_id id ^ "(" ^ string_of_list ", " string_of_typ_arg args ^ ")"
   | Typ_fn ([typ_arg], typ_ret, eff) ->
-     string_of_typ typ_arg ^ " -> " ^ string_of_typ typ_ret ^ " effect " ^ string_of_effect eff     
+     string_of_typ typ_arg ^ " -> " ^ string_of_typ typ_ret ^ " effect " ^ string_of_effect eff
   | Typ_fn (typ_args, typ_ret, eff) ->
      "(" ^ string_of_list ", " string_of_typ typ_args ^ ") -> "
      ^ string_of_typ typ_ret ^ " effect " ^ string_of_effect eff
   | Typ_bidir (typ1, typ2) -> string_of_typ typ1 ^ " <-> " ^ string_of_typ typ2
   | Typ_exist (kids, nc, typ) ->
-     "{" ^ string_of_list " " string_of_kid kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ ^ "}"
+     "{" ^ string_of_list " " string_of_kinded_id kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ ^ "}"
 and string_of_typ_arg = function
-  | Typ_arg_aux (typ_arg, l) -> string_of_typ_arg_aux typ_arg
+  | A_aux (typ_arg, l) -> string_of_typ_arg_aux typ_arg
 and string_of_typ_arg_aux = function
-  | Typ_arg_nexp n -> string_of_nexp n
-  | Typ_arg_typ typ -> string_of_typ typ
-  | Typ_arg_order o -> string_of_order o
+  | A_nexp n -> string_of_nexp n
+  | A_typ typ -> string_of_typ typ
+  | A_order o -> string_of_order o
+  | A_bool nc -> string_of_n_constraint nc
 and string_of_n_constraint = function
-  | NC_aux (NC_equal (n1, n2), _) -> string_of_nexp n1 ^ " = " ^ string_of_nexp n2
+  | NC_aux (NC_equal (n1, n2), _) -> string_of_nexp n1 ^ " == " ^ string_of_nexp n2
   | NC_aux (NC_not_equal (n1, n2), _) -> string_of_nexp n1 ^ " != " ^ string_of_nexp n2
   | NC_aux (NC_bounded_ge (n1, n2), _) -> string_of_nexp n1 ^ " >= " ^ string_of_nexp n2
   | NC_aux (NC_bounded_le (n1, n2), _) -> string_of_nexp n1 ^ " <= " ^ string_of_nexp n2
@@ -644,14 +739,14 @@ and string_of_n_constraint = function
      "(" ^ string_of_n_constraint nc1 ^ " & " ^ string_of_n_constraint nc2 ^ ")"
   | NC_aux (NC_set (kid, ns), _) ->
      string_of_kid kid ^ " in {" ^ string_of_list ", " Big_int.to_string ns ^ "}"
-  | NC_aux (NC_app (id, nexps), _) ->
-     "where " ^ string_of_id id ^ "(" ^ Util.string_of_list ", " string_of_nexp nexps ^ ")"
+  | NC_aux (NC_app (Id_aux (DeIid op, _), [arg1; arg2]), _) ->
+     "(" ^ string_of_typ_arg arg1 ^ " " ^ op ^ " " ^ string_of_typ_arg arg2 ^ ")"
+  | NC_aux (NC_app (id, args), _) -> string_of_id id ^ "(" ^ string_of_list ", " string_of_typ_arg args ^ ")"
+  | NC_aux (NC_var v, _) -> string_of_kid v
   | NC_aux (NC_true, _) -> "true"
   | NC_aux (NC_false, _) -> "false"
 
-let string_of_kinded_id = function
-  | KOpt_aux (KOpt_none kid, _) -> string_of_kid kid
-  | KOpt_aux (KOpt_kind (k, kid), _) -> "(" ^ string_of_kid kid ^ " : " ^ string_of_kind k ^ ")"
+let string_of_kinded_id (KOpt_aux (KOpt_kind (k, kid), _)) = "(" ^ string_of_kid kid ^ " : " ^ string_of_kind k ^ ")"
 
 let string_of_quant_item_aux = function
   | QI_id kopt -> string_of_kinded_id kopt
@@ -724,9 +819,9 @@ let rec string_of_exp (E_aux (exp, _)) =
   | E_throw exp -> "throw " ^ string_of_exp exp
   | E_cons (x, xs) -> string_of_exp x ^ " :: " ^ string_of_exp xs
   | E_list xs -> "[|" ^ string_of_list ", " string_of_exp xs ^ "|]"
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record_update (exp, fexps) ->
      "{ " ^ string_of_exp exp ^ " with " ^ string_of_list "; " string_of_fexp fexps ^ " }"
-  | E_record (FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record fexps ->
      "{ " ^ string_of_list "; " string_of_fexp fexps ^ " }"
   | E_var (lexp, binding, exp) -> "var " ^ string_of_lexp lexp ^ " = " ^ string_of_exp binding ^ " in " ^ string_of_exp exp
   | E_internal_return exp -> "internal_return (" ^ string_of_exp exp ^ ")"
@@ -762,8 +857,9 @@ and string_of_pat (P_aux (pat, l)) =
   | P_vector_concat pats -> string_of_list " @ " string_of_pat pats
   | P_vector pats -> "[" ^ string_of_list ", " string_of_pat pats ^ "]"
   | P_as (pat, id) -> "(" ^ string_of_pat pat ^ " as " ^ string_of_id id ^ ")"
+  | P_string_append [] -> "\"\""
   | P_string_append pats -> string_of_list " ^ " string_of_pat pats
-  | _ -> "PAT"
+  | P_record _ -> "PAT"
 
 and string_of_mpat (MP_aux (pat, l)) =
   match pat with
@@ -828,13 +924,13 @@ let id_of_fundef (FD_aux (FD_function (_, _, _, funcls), (l, _))) =
            (fun (FCL_aux (FCL_Funcl (id, _), _)) id' ->
              match id' with
              | Some id' -> if string_of_id id' = string_of_id id then Some id'
-                           else raise (Reporting_basic.err_typ l
+                           else raise (Reporting.err_typ l
                              ("Function declaration expects all definitions to have the same name, "
                               ^ string_of_id id ^ " differs from other definitions of " ^ string_of_id id'))
              | None -> Some id) funcls None)
   with
   | Some id -> id
-  | None -> raise (Reporting_basic.err_typ l "funcl list is empty")
+  | None -> raise (Reporting.err_typ l "funcl list is empty")
 
 let id_of_type_def_aux = function
   | TD_abbrev (id, _, _)
@@ -846,6 +942,13 @@ let id_of_type_def (TD_aux (td_aux, _)) = id_of_type_def_aux td_aux
 
 let id_of_val_spec (VS_aux (VS_val_spec (_, id, _, _), _)) = id
 
+let id_of_dec_spec (DEC_aux (ds_aux, _)) =
+  match ds_aux with
+  | DEC_reg (_, id) -> id
+  | DEC_config (id, _, _) -> id
+  | DEC_alias (id, _) -> id
+  | DEC_typ_alias (_, id, _) -> id
+
 let ids_of_def = function
   | DEF_kind (KD_aux (KD_nabbrev (_, id, _, _), _)) -> IdSet.singleton id
   | DEF_type td -> IdSet.singleton (id_of_type_def td)
@@ -895,8 +998,6 @@ module NC = struct
     | NC_or (nc1,nc2), NC_or (nc3,nc4)
     | NC_and (nc1,nc2), NC_and (nc3,nc4)
       -> lex_ord compare compare nc1 nc3 nc2 nc4
-    | NC_app (id1, nexps1), NC_app (id2, nexps2)
-      -> lex_ord (Id.compare) (Util.compare_list Nexp.compare) id1 id2 nexps1 nexps2
     | NC_true, NC_true
     | NC_false, NC_false
       -> 0
@@ -907,7 +1008,6 @@ module NC = struct
     | NC_set _, _ -> -1        | _, NC_set _ -> 1
     | NC_or _, _ -> -1         | _, NC_or _ -> 1
     | NC_and _, _ -> -1        | _, NC_and _ -> 1
-    | NC_app _, _ -> -1        | _, NC_app _ -> 1
     | NC_true, _ -> -1         | _, NC_true -> 1
 end
 
@@ -930,7 +1030,7 @@ module Typ = struct
        | n -> n)
     | Typ_tup ts1, Typ_tup ts2 -> Util.compare_list compare ts1 ts2
     | Typ_exist (ks1,nc1,t1), Typ_exist (ks2,nc2,t2) ->
-       (match Util.compare_list Kid.compare ks1 ks2 with
+       (match Util.compare_list KOpt.compare ks1 ks2 with
        | 0 -> (match NC.compare nc1 nc2 with
          | 0 -> compare t1 t2
          | n -> n)
@@ -946,20 +1046,22 @@ module Typ = struct
     | Typ_bidir _, _ -> -1 | _, Typ_bidir _ -> 1
     | Typ_tup _, _ -> -1   | _, Typ_tup _ -> 1
     | Typ_exist _, _ -> -1 | _, Typ_exist _ -> 1
-  and arg_compare (Typ_arg_aux (ta1,_)) (Typ_arg_aux (ta2,_)) =
+  and arg_compare (A_aux (ta1,_)) (A_aux (ta2,_)) =
     match ta1, ta2 with
-    | Typ_arg_nexp n1,  Typ_arg_nexp n2  -> Nexp.compare n1 n2
-    | Typ_arg_typ t1,   Typ_arg_typ t2   -> compare t1 t2
-    | Typ_arg_order o1, Typ_arg_order o2 -> order_compare o1 o2
-    | Typ_arg_nexp _, _ -> -1  | _, Typ_arg_nexp _ -> 1
-    | Typ_arg_typ _, _  -> -1  | _, Typ_arg_typ _ -> 1
+    | A_nexp n1,  A_nexp n2  -> Nexp.compare n1 n2
+    | A_typ t1,   A_typ t2   -> compare t1 t2
+    | A_order o1, A_order o2 -> order_compare o1 o2
+    | A_bool nc1, A_bool nc2 -> NC.compare nc1 nc2
+    | A_nexp _, _ -> -1  | _, A_nexp _ -> 1
+    | A_typ _, _  -> -1  | _, A_typ _ -> 1
+    | A_order _, _ -> -1 | _, A_order _ -> 1
 end
 
 module TypMap = Map.Make(Typ)
 
 let rec nexp_frees (Nexp_aux (nexp, l)) =
   match nexp with
-  | Nexp_id _ -> raise (Reporting_basic.err_typ l "Unimplemented Nexp_id in nexp_frees")
+  | Nexp_id _ -> raise (Reporting.err_typ l "Unimplemented Nexp_id in nexp_frees")
   | Nexp_var kid -> KidSet.singleton kid
   | Nexp_constant _ -> KidSet.empty
   | Nexp_times (n1, n2) -> KidSet.union (nexp_frees n1) (nexp_frees n2)
@@ -977,7 +1079,7 @@ let rec lexp_to_exp (LEXP_aux (lexp_aux, annot) as le) =
     let get_id (LEXP_aux(lexp,((l,_) as annot)) as le) = match lexp with
       | LEXP_id id | LEXP_cast (_, id) -> E_aux (E_id id, annot)
       | _ ->
-        raise (Reporting_basic.err_unreachable l __POS__
+        raise (Reporting.err_unreachable l __POS__
          ("Unsupported sub-lexp " ^ string_of_lexp le ^ " in tuple")) in
     rewrap (E_tuple (List.map get_id les))
   | LEXP_vector (lexp, e) -> rewrap (E_vector_access (lexp_to_exp lexp, e))
@@ -1008,23 +1110,23 @@ let is_ref_typ (Typ_aux (typ_aux, _)) = match typ_aux with
 
 let rec is_vector_typ = function
   | Typ_aux (Typ_app (Id_aux (Id "vector",_), [_;_;_]), _) -> true
-  | Typ_aux (Typ_app (Id_aux (Id "register",_), [Typ_arg_aux (Typ_arg_typ rtyp,_)]), _) ->
+  | Typ_aux (Typ_app (Id_aux (Id "register",_), [A_aux (A_typ rtyp,_)]), _) ->
     is_vector_typ rtyp
   | _ -> false
 
 let typ_app_args_of = function
   | Typ_aux (Typ_app (Id_aux (Id c,_), targs), l) ->
-    (c, List.map (fun (Typ_arg_aux (a,_)) -> a) targs, l)
+    (c, List.map (fun (A_aux (a,_)) -> a) targs, l)
   | Typ_aux (_, l) as typ ->
-     raise (Reporting_basic.err_typ l
+     raise (Reporting.err_typ l
        ("typ_app_args_of called on non-app type " ^ string_of_typ typ))
 
 let rec vector_typ_args_of typ = match typ_app_args_of typ with
-  | ("vector", [Typ_arg_nexp len; Typ_arg_order ord; Typ_arg_typ etyp], l) ->
+  | ("vector", [A_nexp len; A_order ord; A_typ etyp], l) ->
      (nexp_simp len, ord, etyp)
-  | ("register", [Typ_arg_typ rtyp], _) -> vector_typ_args_of rtyp
+  | ("register", [A_typ rtyp], _) -> vector_typ_args_of rtyp
   | (_, _, l) ->
-     raise (Reporting_basic.err_typ l
+     raise (Reporting.err_typ l
        ("vector_typ_args_of called on non-vector type " ^ string_of_typ typ))
 
 let vector_start_index typ =
@@ -1032,13 +1134,13 @@ let vector_start_index typ =
   match ord with
   | Ord_aux (Ord_inc, _) -> nint 0
   | Ord_aux (Ord_dec, _) -> nexp_simp (nminus len (nint 1))
-  | _ -> raise (Reporting_basic.err_typ (typ_loc typ) "Can't calculate start index without order")
+  | _ -> raise (Reporting.err_typ (typ_loc typ) "Can't calculate start index without order")
 
 let is_order_inc = function
   | Ord_aux (Ord_inc, _) -> true
   | Ord_aux (Ord_dec, _) -> false
   | Ord_aux (Ord_var _, l) ->
-    raise (Reporting_basic.err_unreachable l __POS__ "is_order_inc called on vector with variable ordering")
+    raise (Reporting.err_unreachable l __POS__ "is_order_inc called on vector with variable ordering")
 
 let is_bit_typ = function
   | Typ_aux (Typ_id (Id_aux (Id "bit", _)), _) -> true
@@ -1082,7 +1184,7 @@ let rec tyvars_of_nexp (Nexp_aux (nexp,_)) =
   | Nexp_neg n -> tyvars_of_nexp n
   | Nexp_app (_, nexps) -> List.fold_left KidSet.union KidSet.empty (List.map tyvars_of_nexp nexps)
 
-let rec tyvars_of_nc (NC_aux (nc, _)) =
+let rec tyvars_of_constraint (NC_aux (nc, _)) =
   match nc with
   | NC_equal (nexp1, nexp2)
   | NC_bounded_ge (nexp1, nexp2)
@@ -1092,13 +1194,14 @@ let rec tyvars_of_nc (NC_aux (nc, _)) =
   | NC_set (kid, _) -> KidSet.singleton kid
   | NC_or (nc1, nc2)
   | NC_and (nc1, nc2) ->
-     KidSet.union (tyvars_of_nc nc1) (tyvars_of_nc nc2)
-  | NC_app (id, nexps) ->
-     List.fold_left KidSet.union KidSet.empty (List.map tyvars_of_nexp nexps)
+     KidSet.union (tyvars_of_constraint nc1) (tyvars_of_constraint nc2)
+  | NC_app (id, args) ->
+     List.fold_left (fun s t -> KidSet.union s (tyvars_of_typ_arg t)) KidSet.empty args
+  | NC_var kid -> KidSet.singleton kid
   | NC_true
   | NC_false -> KidSet.empty
 
-let rec tyvars_of_typ (Typ_aux (t,_)) =
+and tyvars_of_typ (Typ_aux (t,_)) =
   match t with
   | Typ_internal_unknown -> KidSet.empty
   | Typ_id _ -> KidSet.empty
@@ -1112,18 +1215,19 @@ let rec tyvars_of_typ (Typ_aux (t,_)) =
      List.fold_left (fun s ta -> KidSet.union s (tyvars_of_typ_arg ta))
        KidSet.empty tas
   | Typ_exist (kids, nc, t) ->
-     let s = KidSet.union (tyvars_of_typ t) (tyvars_of_nc nc) in
-     List.fold_left (fun s k -> KidSet.remove k s) s kids
-and tyvars_of_typ_arg (Typ_arg_aux (ta,_)) =
+     let s = KidSet.union (tyvars_of_typ t) (tyvars_of_constraint nc) in
+     List.fold_left (fun s k -> KidSet.remove k s) s (List.map kopt_kid kids)
+and tyvars_of_typ_arg (A_aux (ta,_)) =
   match ta with
-  | Typ_arg_nexp nexp -> tyvars_of_nexp nexp
-  | Typ_arg_typ typ -> tyvars_of_typ typ
-  | Typ_arg_order _ -> KidSet.empty
+  | A_nexp nexp -> tyvars_of_nexp nexp
+  | A_typ typ -> tyvars_of_typ typ
+  | A_order _ -> KidSet.empty
+  | A_bool nc -> tyvars_of_constraint nc
 
 let tyvars_of_quant_item (QI_aux (qi, _)) = match qi with
-  | QI_id (KOpt_aux ((KOpt_none kid | KOpt_kind (_, kid)), _)) ->
+  | QI_id (KOpt_aux (KOpt_kind (_, kid), _)) ->
      KidSet.singleton kid
-  | QI_const nc -> tyvars_of_nc nc
+  | QI_const nc -> tyvars_of_constraint nc
 
 let is_kid_generated kid = String.contains (string_of_kid kid) '#'
 
@@ -1135,7 +1239,7 @@ let rec undefined_of_typ mwords l annot (Typ_aux (typ_aux, _) as typ) =
   | Typ_app (_,[size;_;_]) when mwords && is_bitvector_typ typ ->
      wrap (E_app (mk_id "undefined_bitvector",
        undefined_of_typ_args mwords l annot size)) typ
-  | Typ_app (atom, [Typ_arg_aux (Typ_arg_nexp i, _)]) when string_of_id atom = "atom" ->
+  | Typ_app (atom, [A_aux (A_nexp i, _)]) when string_of_id atom = "atom" ->
      wrap (E_sizeof i) typ
   | Typ_app (id, args) ->
      wrap (E_app (prepend_id "undefined_" id,
@@ -1150,11 +1254,11 @@ let rec undefined_of_typ mwords l annot (Typ_aux (typ_aux, _) as typ) =
         case when re-writing those functions. *)
      wrap (E_id (prepend_id "typ_" (id_of_kid kid))) typ
   | Typ_internal_unknown | Typ_bidir _ | Typ_fn _ | Typ_exist _ -> assert false (* Typ_exist should be re-written *)
-and undefined_of_typ_args mwords l annot (Typ_arg_aux (typ_arg_aux, _) as typ_arg) =
+and undefined_of_typ_args mwords l annot (A_aux (typ_arg_aux, _) as typ_arg) =
   match typ_arg_aux with
-  | Typ_arg_nexp n -> [E_aux (E_sizeof n, (l, annot (atom_typ n)))]
-  | Typ_arg_typ typ -> [undefined_of_typ mwords l annot typ]
-  | Typ_arg_order _ -> []
+  | A_nexp n -> [E_aux (E_sizeof n, (l, annot (atom_typ n)))]
+  | A_typ typ -> [undefined_of_typ mwords l annot typ]
+  | A_order _ -> []
 
 let destruct_pexp (Pat_aux (pexp,ann)) =
   match pexp with
@@ -1242,8 +1346,8 @@ let rec subst id value (E_aux (e_aux, annot) as exp) =
     | E_list exps -> E_list (List.map (subst id value) exps)
     | E_cons (exp1, exp2) -> E_cons (subst id value exp1, subst id value exp2)
 
-    | E_record fexps -> E_record (subst_fexps id value fexps)
-    | E_record_update (exp, fexps) -> E_record_update (subst id value exp, subst_fexps id value fexps)
+    | E_record fexps -> E_record (List.map (subst_fexp id value) fexps)
+    | E_record_update (exp, fexps) -> E_record_update (subst id value exp, List.map (subst_fexp id value) fexps)
     | E_field (exp, id') -> E_field (subst id value exp, id')
 
     | E_case (exp, pexps) ->
@@ -1288,10 +1392,6 @@ and subst_pexp id value (Pat_aux (pexp_aux, annot)) =
   in
   Pat_aux (pexp_aux, annot)
 
-
-and subst_fexps id value (FES_aux (FES_Fexps (fexps, flag), annot)) =
-  FES_aux (FES_Fexps (List.map (subst_fexp id value) fexps, flag), annot)
-
 and subst_fexp id value (FE_aux (FE_Fexp (id', exp), annot)) =
   FE_aux (FE_Fexp (id', subst id value exp), annot)
 
@@ -1320,175 +1420,193 @@ let hex_to_bin hex =
 
 (* Functions for working with locations *)
 
-let locate_id l (Id_aux (name, _)) = Id_aux (name, l)
+let locate_id f (Id_aux (name, l)) = Id_aux (name, f l)
+
+let locate_kid f (Kid_aux (name, l)) = Kid_aux (name, f l)
 
-let locate_kid l (Kid_aux (name, _)) = Kid_aux (name, l)
+let locate_kind f (K_aux (kind, l)) = K_aux (kind, f l)
+                                     
+let locate_kinded_id f (KOpt_aux (KOpt_kind (k, kid), l)) =
+  KOpt_aux (KOpt_kind (locate_kind f k, locate_kid f kid), f l)
 
-let locate_lit l (L_aux (lit, _)) = L_aux (lit, l)
+let locate_lit f (L_aux (lit, l)) = L_aux (lit, f l)
 
-let locate_base_effect l (BE_aux (base_effect, _)) = BE_aux (base_effect, l)
+let locate_base_effect f (BE_aux (base_effect, l)) = BE_aux (base_effect, f l)
 
-let locate_effect l (Effect_aux (Effect_set effects, _)) =
-  Effect_aux (Effect_set (List.map (locate_base_effect l) effects), l)
+let locate_effect f (Effect_aux (Effect_set effects, l)) =
+  Effect_aux (Effect_set (List.map (locate_base_effect f) effects), f l)
+
+let locate_order f (Ord_aux (ord_aux, l)) =
+  let ord_aux = match ord_aux with
+    | Ord_inc -> Ord_inc
+    | Ord_dec -> Ord_dec
+    | Ord_var v -> Ord_var (locate_kid f v)
+  in
+  Ord_aux (ord_aux, f l)
 
-let rec locate_nexp l (Nexp_aux (nexp_aux, _)) =
+let rec locate_nexp f (Nexp_aux (nexp_aux, l)) =
   let nexp_aux = match nexp_aux with
-    | Nexp_id id -> Nexp_id (locate_id l id)
-    | Nexp_var kid -> Nexp_var (locate_kid l kid)
+    | Nexp_id id -> Nexp_id (locate_id f id)
+    | Nexp_var kid -> Nexp_var (locate_kid f kid)
     | Nexp_constant n -> Nexp_constant n
-    | Nexp_app (id, nexps) -> Nexp_app (locate_id l id, List.map (locate_nexp l) nexps)
-    | Nexp_times (nexp1, nexp2) -> Nexp_times (locate_nexp l nexp1, locate_nexp l nexp2)
-    | Nexp_sum (nexp1, nexp2) -> Nexp_sum (locate_nexp l nexp1, locate_nexp l nexp2)
-    | Nexp_minus (nexp1, nexp2) -> Nexp_minus (locate_nexp l nexp1, locate_nexp l nexp2)
-    | Nexp_exp nexp -> Nexp_exp (locate_nexp l nexp)
-    | Nexp_neg nexp -> Nexp_neg (locate_nexp l nexp)
+    | Nexp_app (id, nexps) -> Nexp_app (locate_id f id, List.map (locate_nexp f) nexps)
+    | Nexp_times (nexp1, nexp2) -> Nexp_times (locate_nexp f nexp1, locate_nexp f nexp2)
+    | Nexp_sum (nexp1, nexp2) -> Nexp_sum (locate_nexp f nexp1, locate_nexp f nexp2)
+    | Nexp_minus (nexp1, nexp2) -> Nexp_minus (locate_nexp f nexp1, locate_nexp f nexp2)
+    | Nexp_exp nexp -> Nexp_exp (locate_nexp f nexp)
+    | Nexp_neg nexp -> Nexp_neg (locate_nexp f nexp)
   in
-  Nexp_aux (nexp_aux, l)
+  Nexp_aux (nexp_aux, f l)
 
-let rec locate_nc l (NC_aux (nc_aux, _)) =
+let rec locate_nc f (NC_aux (nc_aux, l)) =
   let nc_aux = match nc_aux with
-    | NC_equal (nexp1, nexp2) -> NC_equal (locate_nexp l nexp1, locate_nexp l nexp2)
-    | NC_bounded_ge (nexp1, nexp2) -> NC_bounded_ge (locate_nexp l nexp1, locate_nexp l nexp2)
-    | NC_bounded_le (nexp1, nexp2) -> NC_bounded_le (locate_nexp l nexp1, locate_nexp l nexp2)
-    | NC_not_equal (nexp1, nexp2) -> NC_not_equal (locate_nexp l nexp1, locate_nexp l nexp2)
-    | NC_set (kid, nums) -> NC_set (locate_kid l kid, nums)
-    | NC_or (nc1, nc2) -> NC_or (locate_nc l nc1, locate_nc l nc2)
-    | NC_and (nc1, nc2) -> NC_and (locate_nc l nc1, locate_nc l nc2)
-    | NC_app (id, nexps) -> NC_app (id, List.map (locate_nexp l) nexps)
+    | NC_equal (nexp1, nexp2) -> NC_equal (locate_nexp f nexp1, locate_nexp f nexp2)
+    | NC_bounded_ge (nexp1, nexp2) -> NC_bounded_ge (locate_nexp f nexp1, locate_nexp f nexp2)
+    | NC_bounded_le (nexp1, nexp2) -> NC_bounded_le (locate_nexp f nexp1, locate_nexp f nexp2)
+    | NC_not_equal (nexp1, nexp2) -> NC_not_equal (locate_nexp f nexp1, locate_nexp f nexp2)
+    | NC_set (kid, nums) -> NC_set (locate_kid f kid, nums)
+    | NC_or (nc1, nc2) -> NC_or (locate_nc f nc1, locate_nc f nc2)
+    | NC_and (nc1, nc2) -> NC_and (locate_nc f nc1, locate_nc f nc2)
     | NC_true -> NC_true
     | NC_false -> NC_false
+    | NC_var v -> NC_var (locate_kid f v)
+    | NC_app (id, args) -> NC_app (locate_id f id, List.map (locate_typ_arg f) args)
   in
-  NC_aux (nc_aux, l)
+  NC_aux (nc_aux, f l)
 
-let rec locate_typ l (Typ_aux (typ_aux, _)) =
+and locate_typ f (Typ_aux (typ_aux, l)) =
   let typ_aux = match typ_aux with
     | Typ_internal_unknown -> Typ_internal_unknown
-    | Typ_id id -> Typ_id (locate_id l id)
-    | Typ_var kid -> Typ_var (locate_kid l kid)
+    | Typ_id id -> Typ_id (locate_id f id)
+    | Typ_var kid -> Typ_var (locate_kid f kid)
     | Typ_fn (arg_typs, ret_typ, effect) ->
-       Typ_fn (List.map (locate_typ l) arg_typs, locate_typ l ret_typ, locate_effect l effect)
-    | Typ_bidir (typ1, typ2) -> Typ_bidir (locate_typ l typ1, locate_typ l typ2)
-    | Typ_tup typs -> Typ_tup (List.map (locate_typ l) typs)
-    | Typ_exist (kids, constr, typ) -> Typ_exist (List.map (locate_kid l) kids, locate_nc l constr, locate_typ l typ)
-    | Typ_app (id, typ_args) -> Typ_app (locate_id l id, List.map (locate_typ_arg l) typ_args)
+       Typ_fn (List.map (locate_typ f) arg_typs, locate_typ f ret_typ, locate_effect f effect)
+    | Typ_bidir (typ1, typ2) -> Typ_bidir (locate_typ f typ1, locate_typ f typ2)
+    | Typ_tup typs -> Typ_tup (List.map (locate_typ f) typs)
+    | Typ_exist (kopts, constr, typ) -> Typ_exist (List.map (locate_kinded_id f) kopts, locate_nc f constr, locate_typ f typ)
+    | Typ_app (id, typ_args) -> Typ_app (locate_id f id, List.map (locate_typ_arg f) typ_args)
   in
-  Typ_aux (typ_aux, l)
+  Typ_aux (typ_aux, f l)
 
-and locate_typ_arg l (Typ_arg_aux (typ_arg_aux, _)) =
+and locate_typ_arg f (A_aux (typ_arg_aux, l)) =
   let typ_arg_aux = match typ_arg_aux with
-    | Typ_arg_nexp nexp -> Typ_arg_nexp nexp
-    | Typ_arg_typ typ -> Typ_arg_typ (locate_typ l typ)
-    | Typ_arg_order ord -> Typ_arg_order ord
+    | A_nexp nexp -> A_nexp (locate_nexp f nexp)
+    | A_typ typ -> A_typ (locate_typ f typ)
+    | A_order ord -> A_order (locate_order f ord)
+    | A_bool nc -> A_bool (locate_nc f nc)
   in
-  Typ_arg_aux (typ_arg_aux, l)
+  A_aux (typ_arg_aux, f l)
 
-let rec locate_typ_pat l (TP_aux (tp_aux, _)) =
+let rec locate_typ_pat f (TP_aux (tp_aux, l)) =
   let tp_aux = match tp_aux with
     | TP_wild -> TP_wild
-    | TP_var kid -> TP_var (locate_kid l kid)
-    | TP_app (id, tps) -> TP_app (locate_id l id, List.map (locate_typ_pat l) tps)
+    | TP_var kid -> TP_var (locate_kid f kid)
+    | TP_app (id, tps) -> TP_app (locate_id f id, List.map (locate_typ_pat f) tps)
   in
-  TP_aux (tp_aux, l)
+  TP_aux (tp_aux, f l)
 
-let rec locate_pat : 'a. l -> 'a pat -> 'a pat = fun l (P_aux (p_aux, (_, annot))) ->
+let rec locate_pat : 'a. (l -> l) -> 'a pat -> 'a pat = fun f (P_aux (p_aux, (l, annot))) ->
   let p_aux = match p_aux with
-    | P_lit lit -> P_lit (locate_lit l lit)
+    | P_lit lit -> P_lit (locate_lit f lit)
     | P_wild -> P_wild
-    | P_or (pat1, pat2) -> P_or (locate_pat l pat1, locate_pat l pat2)
-    | P_not pat -> P_not (locate_pat l pat)
-    | P_as (pat, id) -> P_as (locate_pat l pat, locate_id l id)
-    | P_typ (typ, pat) -> P_typ (locate_typ l typ, locate_pat l pat)
-    | P_id id -> P_id (locate_id l id)
-    | P_var (pat, typ_pat) -> P_var (locate_pat l pat, locate_typ_pat l typ_pat)
-    | P_app (id, pats) -> P_app (locate_id l id, List.map (locate_pat l) pats)
-    | P_record (fpats, semi) -> P_record (List.map (locate_fpat l) fpats, semi)
-    | P_vector pats -> P_vector (List.map (locate_pat l) pats)
-    | P_vector_concat pats -> P_vector_concat (List.map (locate_pat l) pats)
-    | P_tup pats -> P_tup (List.map (locate_pat l) pats)
-    | P_list pats -> P_list (List.map (locate_pat l) pats)
-    | P_cons (hd_pat, tl_pat) -> P_cons (locate_pat l hd_pat, locate_pat l tl_pat)
-    | P_string_append pats -> P_string_append (List.map (locate_pat l) pats)
+    | P_or (pat1, pat2) -> P_or (locate_pat f pat1, locate_pat f pat2)
+    | P_not pat -> P_not (locate_pat f pat)
+    | P_as (pat, id) -> P_as (locate_pat f pat, locate_id f id)
+    | P_typ (typ, pat) -> P_typ (locate_typ f typ, locate_pat f pat)
+    | P_id id -> P_id (locate_id f id)
+    | P_var (pat, typ_pat) -> P_var (locate_pat f pat, locate_typ_pat f typ_pat)
+    | P_app (id, pats) -> P_app (locate_id f id, List.map (locate_pat f) pats)
+    | P_record (fpats, semi) -> P_record (List.map (locate_fpat f) fpats, semi)
+    | P_vector pats -> P_vector (List.map (locate_pat f) pats)
+    | P_vector_concat pats -> P_vector_concat (List.map (locate_pat f) pats)
+    | P_tup pats -> P_tup (List.map (locate_pat f) pats)
+    | P_list pats -> P_list (List.map (locate_pat f) pats)
+    | P_cons (hd_pat, tl_pat) -> P_cons (locate_pat f hd_pat, locate_pat f tl_pat)
+    | P_string_append pats -> P_string_append (List.map (locate_pat f) pats)
   in
-  P_aux (p_aux, (l, annot))
+  P_aux (p_aux, (f l, annot))
 
-and locate_fpat : 'a. l -> 'a fpat -> 'a fpat = fun l (FP_aux (FP_Fpat (id, pat), (_, annot))) ->
-  FP_aux (FP_Fpat (locate_id l id, locate_pat l pat), (l, annot))
+and locate_fpat : 'a. (l -> l) -> 'a fpat -> 'a fpat = fun f (FP_aux (FP_Fpat (id, pat), (l, annot))) ->
+  FP_aux (FP_Fpat (locate_id f id, locate_pat f pat), (f l, annot))
 
-let rec locate : 'a. l -> 'a exp -> 'a exp = fun l (E_aux (e_aux, (_, annot))) ->
+let rec locate : 'a. (l -> l) -> 'a exp -> 'a exp = fun f (E_aux (e_aux, (l, annot))) ->
   let e_aux = match e_aux with
-    | E_block exps -> E_block (List.map (locate l) exps)
-    | E_nondet exps -> E_nondet (List.map (locate l) exps)
-    | E_id id -> E_id (locate_id l id)
-    | E_lit lit -> E_lit (locate_lit l lit)
-    | E_cast (typ, exp) -> E_cast (locate_typ l typ, locate l exp)
-    | E_app (f, exps) -> E_app (locate_id l f, List.map (locate l) exps)
-    | E_app_infix (exp1, op, exp2) -> E_app_infix (locate l exp1, locate_id l op, locate l exp2)
-    | E_tuple exps -> E_tuple (List.map (locate l) exps)
-    | E_if (cond_exp, then_exp, else_exp) -> E_if (locate l cond_exp, locate l then_exp, locate l else_exp)
-    | E_loop (loop, cond, body) -> E_loop (loop, locate l cond, locate l body)
+    | E_block exps -> E_block (List.map (locate f) exps)
+    | E_nondet exps -> E_nondet (List.map (locate f) exps)
+    | E_id id -> E_id (locate_id f id)
+    | E_lit lit -> E_lit (locate_lit f lit)
+    | E_cast (typ, exp) -> E_cast (locate_typ f typ, locate f exp)
+    | E_app (id, exps) -> E_app (locate_id f id, List.map (locate f) exps)
+    | E_app_infix (exp1, op, exp2) -> E_app_infix (locate f exp1, locate_id f op, locate f exp2)
+    | E_tuple exps -> E_tuple (List.map (locate f) exps)
+    | E_if (cond_exp, then_exp, else_exp) -> E_if (locate f cond_exp, locate f then_exp, locate f else_exp)
+    | E_loop (loop, cond, body) -> E_loop (loop, locate f cond, locate f body)
     | E_for (id, exp1, exp2, exp3, ord, exp4) ->
-       E_for (locate_id l id, locate l exp1, locate l exp2, locate l exp3, ord, locate l exp4)
-    | E_vector exps -> E_vector (List.map (locate l) exps)
-    | E_vector_access (exp1, exp2) -> E_vector_access (locate l exp1, locate l exp2)
-    | E_vector_subrange (exp1, exp2, exp3) -> E_vector_subrange (locate l exp1, locate l exp2, locate l exp3)
-    | E_vector_update (exp1, exp2, exp3) -> E_vector_update (locate l exp1, locate l exp2, locate l exp3)
+       E_for (locate_id f id, locate f exp1, locate f exp2, locate f exp3, ord, locate f exp4)
+    | E_vector exps -> E_vector (List.map (locate f) exps)
+    | E_vector_access (exp1, exp2) -> E_vector_access (locate f exp1, locate f exp2)
+    | E_vector_subrange (exp1, exp2, exp3) -> E_vector_subrange (locate f exp1, locate f exp2, locate f exp3)
+    | E_vector_update (exp1, exp2, exp3) -> E_vector_update (locate f exp1, locate f exp2, locate f exp3)
     | E_vector_update_subrange (exp1, exp2, exp3, exp4) ->
-       E_vector_update_subrange (locate l exp1, locate l exp2, locate l exp3, locate l exp4)
+       E_vector_update_subrange (locate f exp1, locate f exp2, locate f exp3, locate f exp4)
     | E_vector_append (exp1, exp2) ->
-       E_vector_append (locate l exp1, locate l exp2)
-    | E_list exps -> E_list (List.map (locate l) exps)
-    | E_cons (exp1, exp2) -> E_cons (locate l exp1, locate l exp2)
-    | E_record fexps -> E_record (locate_fexps l fexps)
-    | E_record_update (exp, fexps) -> E_record_update (locate l exp, locate_fexps l fexps)
-    | E_field (exp, id) -> E_field (locate l exp, locate_id l id)
-    | E_case (exp, cases) -> E_case (locate l exp, List.map (locate_pexp l) cases)
-    | E_let (letbind, exp) -> E_let (locate_letbind l letbind, locate l exp)
-    | E_assign (lexp, exp) -> E_assign (locate_lexp l lexp, locate l exp)
-    | E_sizeof nexp -> E_sizeof (locate_nexp l nexp)
-    | E_return exp -> E_return (locate l exp)
-    | E_exit exp -> E_exit (locate l exp)
-    | E_ref id -> E_ref (locate_id l id)
-    | E_throw exp -> E_throw (locate l exp)
-    | E_try (exp, cases) -> E_try (locate l exp, List.map (locate_pexp l) cases)
-    | E_assert (exp, message) -> E_assert (locate l exp, locate l message)
-    | E_constraint constr -> E_constraint (locate_nc l constr)
-    | E_var (lexp, exp1, exp2) -> E_var (locate_lexp l lexp, locate l exp1, locate l exp2)
-    | E_internal_plet (pat, exp1, exp2) -> E_internal_plet (locate_pat l pat, locate l exp1, locate l exp2)
-    | E_internal_return exp -> E_internal_return (locate l exp)
+       E_vector_append (locate f exp1, locate f exp2)
+    | E_list exps -> E_list (List.map (locate f) exps)
+    | E_cons (exp1, exp2) -> E_cons (locate f exp1, locate f exp2)
+    | E_record fexps -> E_record (List.map (locate_fexp f) fexps)
+    | E_record_update (exp, fexps) -> E_record_update (locate f exp, List.map (locate_fexp f) fexps)
+    | E_field (exp, id) -> E_field (locate f exp, locate_id f id)
+    | E_case (exp, cases) -> E_case (locate f exp, List.map (locate_pexp f) cases)
+    | E_let (letbind, exp) -> E_let (locate_letbind f letbind, locate f exp)
+    | E_assign (lexp, exp) -> E_assign (locate_lexp f lexp, locate f exp)
+    | E_sizeof nexp -> E_sizeof (locate_nexp f nexp)
+    | E_return exp -> E_return (locate f exp)
+    | E_exit exp -> E_exit (locate f exp)
+    | E_ref id -> E_ref (locate_id f id)
+    | E_throw exp -> E_throw (locate f exp)
+    | E_try (exp, cases) -> E_try (locate f exp, List.map (locate_pexp f) cases)
+    | E_assert (exp, message) -> E_assert (locate f exp, locate f message)
+    | E_constraint constr -> E_constraint (locate_nc f constr)
+    | E_var (lexp, exp1, exp2) -> E_var (locate_lexp f lexp, locate f exp1, locate f exp2)
+    | E_internal_plet (pat, exp1, exp2) -> E_internal_plet (locate_pat f pat, locate f exp1, locate f exp2)
+    | E_internal_return exp -> E_internal_return (locate f exp)
     | E_internal_value value -> E_internal_value value
   in
-  E_aux (e_aux, (l, annot))
+  E_aux (e_aux, (f l, annot))
 
-and locate_letbind : 'a. l -> 'a letbind -> 'a letbind = fun l (LB_aux (LB_val (pat, exp), (_, annot))) ->
-  LB_aux (LB_val (locate_pat l pat, locate l exp), (l, annot))
+and locate_letbind : 'a. (l -> l) -> 'a letbind -> 'a letbind = fun f (LB_aux (LB_val (pat, exp), (l, annot))) ->
+  LB_aux (LB_val (locate_pat f pat, locate f exp), (f l, annot))
 
-and locate_pexp : 'a. l -> 'a pexp -> 'a pexp = fun l (Pat_aux (pexp_aux, (_, annot))) ->
+and locate_pexp : 'a. (l -> l) -> 'a pexp -> 'a pexp = fun f (Pat_aux (pexp_aux, (l, annot))) ->
   let pexp_aux = match pexp_aux with
-    | Pat_exp (pat, exp) -> Pat_exp (locate_pat l pat, locate l exp)
-    | Pat_when (pat, guard, exp) -> Pat_when (locate_pat l pat, locate l guard, locate l exp)
+    | Pat_exp (pat, exp) -> Pat_exp (locate_pat f pat, locate f exp)
+    | Pat_when (pat, guard, exp) -> Pat_when (locate_pat f pat, locate f guard, locate f exp)
   in
-  Pat_aux (pexp_aux, (l, annot))
+  Pat_aux (pexp_aux, (f l, annot))
 
-and locate_lexp : 'a. l -> 'a lexp -> 'a lexp = fun l (LEXP_aux (lexp_aux, (_, annot))) ->
+and locate_lexp : 'a. (l -> l) -> 'a lexp -> 'a lexp = fun f (LEXP_aux (lexp_aux, (l, annot))) ->
   let lexp_aux = match lexp_aux with
-    | LEXP_id id -> LEXP_id (locate_id l id)
-    | LEXP_deref exp -> LEXP_deref (locate l exp)
-    | LEXP_memory (id, exps) -> LEXP_memory (locate_id l id, List.map (locate l) exps)
-    | LEXP_cast (typ, id) -> LEXP_cast (locate_typ l typ, locate_id l id)
-    | LEXP_tup lexps -> LEXP_tup (List.map (locate_lexp l) lexps)
-    | LEXP_vector_concat lexps -> LEXP_vector_concat (List.map (locate_lexp l) lexps)
-    | LEXP_vector (lexp, exp) -> LEXP_vector (locate_lexp l lexp, locate l exp)
-    | LEXP_vector_range (lexp, exp1, exp2) -> LEXP_vector_range (locate_lexp l lexp, locate l exp1, locate l exp2)
-    | LEXP_field (lexp, id) -> LEXP_field (locate_lexp l lexp, locate_id l id)
+    | LEXP_id id -> LEXP_id (locate_id f id)
+    | LEXP_deref exp -> LEXP_deref (locate f exp)
+    | LEXP_memory (id, exps) -> LEXP_memory (locate_id f id, List.map (locate f) exps)
+    | LEXP_cast (typ, id) -> LEXP_cast (locate_typ f typ, locate_id f id)
+    | LEXP_tup lexps -> LEXP_tup (List.map (locate_lexp f) lexps)
+    | LEXP_vector_concat lexps -> LEXP_vector_concat (List.map (locate_lexp f) lexps)
+    | LEXP_vector (lexp, exp) -> LEXP_vector (locate_lexp f lexp, locate f exp)
+    | LEXP_vector_range (lexp, exp1, exp2) -> LEXP_vector_range (locate_lexp f lexp, locate f exp1, locate f exp2)
+    | LEXP_field (lexp, id) -> LEXP_field (locate_lexp f lexp, locate_id f id)
   in
-  LEXP_aux (lexp_aux, (l, annot))
+  LEXP_aux (lexp_aux, (f l, annot))
 
-and locate_fexps : 'a. l -> 'a fexps -> 'a fexps = fun l (FES_aux (FES_Fexps (fexps, semi), (_, annot))) ->
-  FES_aux (FES_Fexps (List.map (locate_fexp l) fexps, semi), (l, annot))
+and locate_fexp : 'a. (l -> l) -> 'a fexp -> 'a fexp = fun f (FE_aux (FE_Fexp (id, exp), (l, annot))) ->
+  FE_aux (FE_Fexp (locate_id f id, locate f exp), (f l, annot))
 
-and locate_fexp : 'a. l -> 'a fexp -> 'a fexp = fun l (FE_aux (FE_Fexp (id, exp), (_, annot))) ->
-  FE_aux (FE_Fexp (locate_id l id, locate l exp), (l, annot))
+let unique_ref = ref 0
 
+let unique l =
+  let l = Parse_ast.Unique (!unique_ref, l) in
+  incr unique_ref;
+  l
 
 let extern_assoc backend exts =
   try
@@ -1498,3 +1616,111 @@ let extern_assoc backend exts =
       Some (List.assoc "_" exts)
   with Not_found ->
     None
+
+(**************************************************************************)
+(* 1. Substitutions                                                       *)
+(**************************************************************************)
+
+let order_subst_aux sv subst = function
+  | Ord_var kid ->
+     begin match subst with
+     | A_aux (A_order ord, _) when Kid.compare kid sv = 0 ->
+        unaux_order ord
+     | _ -> Ord_var kid
+     end
+  | Ord_inc -> Ord_inc
+  | Ord_dec -> Ord_dec
+
+let order_subst sv subst (Ord_aux (ord, l)) = Ord_aux (order_subst_aux sv subst ord, l)
+
+let rec nexp_subst sv subst (Nexp_aux (nexp, l)) = Nexp_aux (nexp_subst_aux sv subst nexp, l)
+and nexp_subst_aux sv subst = function
+  | Nexp_var kid ->
+     begin match subst with
+     | A_aux (A_nexp n, _) when Kid.compare kid sv = 0 -> unaux_nexp n
+     | _ -> Nexp_var kid
+     end
+  | Nexp_id id -> Nexp_id id
+  | Nexp_constant c -> Nexp_constant c
+  | Nexp_times (nexp1, nexp2) -> Nexp_times (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_sum (nexp1, nexp2) -> Nexp_sum (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_minus (nexp1, nexp2) -> Nexp_minus (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_app (id, nexps) -> Nexp_app (id, List.map (nexp_subst sv subst) nexps)
+  | Nexp_exp nexp -> Nexp_exp (nexp_subst sv subst nexp)
+  | Nexp_neg nexp -> Nexp_neg (nexp_subst sv subst nexp)
+
+let rec nexp_set_to_or l subst = function
+  | [] -> raise (Reporting.err_unreachable l __POS__ "Empty set in constraint")
+  | [int] -> NC_equal (subst, nconstant int)
+  | (int :: ints) -> NC_or (mk_nc (NC_equal (subst, nconstant int)), mk_nc (nexp_set_to_or l subst ints))
+
+let rec constraint_subst sv subst (NC_aux (nc, l)) = NC_aux (constraint_subst_aux l sv subst nc, l)
+and constraint_subst_aux l sv subst = function
+  | NC_equal (n1, n2) -> NC_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_bounded_ge (n1, n2) -> NC_bounded_ge (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_bounded_le (n1, n2) -> NC_bounded_le (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_not_equal (n1, n2) -> NC_not_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_set (kid, ints) as set_nc ->
+     begin match subst with
+     | A_aux (A_nexp n, _) when Kid.compare kid sv = 0 ->
+        nexp_set_to_or l n ints
+     | _ -> set_nc
+     end
+  | NC_or (nc1, nc2) -> NC_or (constraint_subst sv subst nc1, constraint_subst sv subst nc2)
+  | NC_and (nc1, nc2) -> NC_and (constraint_subst sv subst nc1, constraint_subst sv subst nc2)
+  | NC_app (id, args) -> NC_app (id, List.map (typ_arg_subst sv subst) args)
+  | NC_var kid ->
+     begin match subst with
+     | A_aux (A_bool nc, _) when Kid.compare kid sv = 0 ->
+        unaux_constraint nc
+     | _ -> NC_var kid
+     end
+  | NC_false -> NC_false
+  | NC_true -> NC_true
+
+and typ_subst sv subst (Typ_aux (typ, l)) = Typ_aux (typ_subst_aux sv subst typ, l)
+and typ_subst_aux sv subst = function
+  | Typ_internal_unknown -> Typ_internal_unknown
+  | Typ_id v -> Typ_id v
+  | Typ_var kid ->
+     begin match subst with
+     | A_aux (A_typ typ, _) when Kid.compare kid sv = 0 ->
+        unaux_typ typ
+     | _ -> Typ_var kid
+     end
+  | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst sv subst) arg_typs, typ_subst sv subst ret_typ, effs)
+  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst sv subst typ1, typ_subst sv subst typ2)
+  | Typ_tup typs -> Typ_tup (List.map (typ_subst sv subst) typs)
+  | Typ_app (f, args) -> Typ_app (f, List.map (typ_arg_subst sv subst) args)
+  | Typ_exist (kopts, nc, typ) when KidSet.mem sv (KidSet.of_list (List.map kopt_kid kopts)) ->
+     Typ_exist (kopts, nc, typ)
+  | Typ_exist (kopts, nc, typ) ->
+     Typ_exist (kopts, constraint_subst sv subst nc, typ_subst sv subst typ)
+
+and typ_arg_subst sv subst (A_aux (arg, l)) = A_aux (typ_arg_subst_aux sv subst arg, l)
+and typ_arg_subst_aux sv subst = function
+  | A_nexp nexp -> A_nexp (nexp_subst sv subst nexp)
+  | A_typ typ -> A_typ (typ_subst sv subst typ)
+  | A_order ord -> A_order (order_subst sv subst ord)
+  | A_bool nc -> A_bool (constraint_subst sv subst nc)
+
+let subst_kid subst sv v x =
+  x
+  |> subst sv (mk_typ_arg (A_bool (nc_var v)))
+  |> subst sv (mk_typ_arg (A_nexp (nvar v)))
+  |> subst sv (mk_typ_arg (A_order (Ord_aux (Ord_var v, Parse_ast.Unknown))))
+  |> subst sv (mk_typ_arg (A_typ (mk_typ (Typ_var v))))
+
+let quant_item_subst_kid_aux sv subst = function
+  | QI_id (KOpt_aux (KOpt_kind (k, kid), l)) as qid ->
+     if Kid.compare kid sv = 0 then QI_id (KOpt_aux (KOpt_kind (k, subst), l)) else qid
+  | QI_const nc ->
+     QI_const (subst_kid constraint_subst sv subst nc)
+
+let quant_item_subst_kid sv subst (QI_aux (quant, l)) = QI_aux (quant_item_subst_kid_aux sv subst quant, l)
+
+let typquant_subst_kid_aux sv subst = function
+  | TypQ_tq quants -> TypQ_tq (List.map (quant_item_subst_kid sv subst) quants)
+  | TypQ_no_forall -> TypQ_no_forall
+
+let typquant_subst_kid sv subst (TypQ_aux (typq, l)) = TypQ_aux (typquant_subst_kid_aux sv subst typq, l)
diff --git a/src/ast_util.mli b/src/ast_util.mli
index 54f18ae8..dc9f8594 100644
--- a/src/ast_util.mli
+++ b/src/ast_util.mli
@@ -85,18 +85,20 @@ val mk_fundef : (unit funcl) list -> unit def
 val mk_val_spec : val_spec_aux -> unit def
 val mk_typschm : typquant -> typ -> typschm
 val mk_typquant : quant_item list -> typquant
-val mk_qi_id : base_kind_aux -> kid -> quant_item
+val mk_qi_id : kind_aux -> kid -> quant_item
 val mk_qi_nc : n_constraint -> quant_item
 val mk_qi_kopt : kinded_id -> quant_item
 val mk_fexp : id -> unit exp -> unit fexp
-val mk_fexps : (unit fexp) list -> unit fexps
 val mk_letbind : unit pat -> unit exp -> unit letbind
+val mk_kopt : kind_aux -> kid -> kinded_id
 
 val unaux_exp : 'a exp -> 'a exp_aux
 val unaux_pat : 'a pat -> 'a pat_aux
 val unaux_nexp : nexp -> nexp_aux
 val unaux_order : order -> order_aux
 val unaux_typ : typ -> typ_aux
+val unaux_kind : kind -> kind_aux
+val unaux_constraint : n_constraint -> n_constraint_aux
 
 val untyp_pat : 'a pat -> 'a pat * typ option
 val uncast_exp : 'a exp -> 'a exp * typ option
@@ -106,10 +108,12 @@ val dec_ord : order
 
 (* Utilites for working with kinded_ids *)
 val kopt_kid : kinded_id -> kid
+val kopt_kind : kinded_id -> kind
 val is_nat_kopt : kinded_id -> bool
 val is_order_kopt : kinded_id -> bool
 val is_typ_kopt : kinded_id -> bool
-
+val is_bool_kopt : kinded_id -> bool
+  
 (* Some handy utility functions for constructing types. *)
 val mk_typ : typ_aux -> typ
 val mk_typ_arg : typ_arg_aux -> typ_arg
@@ -138,6 +142,12 @@ val no_effect : effect
 val mk_effect : base_effect_aux list -> effect
 
 val nexp_simp : nexp -> nexp
+val constraint_simp : n_constraint -> n_constraint
+
+(* If a constraint is a conjunction, return a list of all the top-level conjuncts *)
+val constraint_conj : n_constraint -> n_constraint list
+(* Same as constraint_conj but for disjunctions *)
+val constraint_disj : n_constraint -> n_constraint list
 
 (* Utilities for building n-expressions *)
 val nconstant : Big_int.num -> nexp
@@ -148,7 +158,7 @@ val ntimes : nexp -> nexp -> nexp
 val npow2 : nexp -> nexp
 val nvar : kid -> nexp
 val napp : id -> nexp list -> nexp
-val nid : id -> nexp (* NOTE: Nexp_id's don't do anything currently *)
+val nid : id -> nexp
 
 (* Numeric constraint builders *)
 val nc_eq : nexp -> nexp -> n_constraint
@@ -159,21 +169,29 @@ val nc_lt : nexp -> nexp -> n_constraint
 val nc_gt : nexp -> nexp -> n_constraint
 val nc_and : n_constraint -> n_constraint -> n_constraint
 val nc_or : n_constraint -> n_constraint -> n_constraint
+val nc_not : n_constraint -> n_constraint
 val nc_true : n_constraint
 val nc_false : n_constraint
 val nc_set : kid -> Big_int.num list -> n_constraint
 val nc_int_set : kid -> int list -> n_constraint
+val nc_var : kid -> n_constraint
 
-(* Negate a n_constraint. Note that there's no NC_not constructor, so
-   this flips all the inequalites a the n_constraint leaves and uses
-   de-morgans to switch and to or and vice versa. *)
-val nc_negate : n_constraint -> n_constraint
+val arg_nexp : ?loc:l -> nexp -> typ_arg
+val arg_order : ?loc:l -> order -> typ_arg
+val arg_typ : ?loc:l -> typ -> typ_arg
+val arg_bool : ?loc:l -> n_constraint -> typ_arg
+val arg_kopt : kinded_id -> typ_arg
 
+(* Functions for working with type quantifiers *)
+val quant_add : quant_item -> typquant -> typquant
 val quant_items : typquant -> quant_item list
 val quant_kopts : typquant -> kinded_id list
 val quant_split : typquant -> kinded_id list * n_constraint list
 val quant_map_items : (quant_item -> quant_item) -> typquant -> typquant
 
+val is_quant_kopt : quant_item -> bool
+val is_quant_constraint : quant_item -> bool
+  
 (* Functions to map over the annotations in sub-expressions *)
 val map_exp_annot : ('a annot -> 'b annot) -> 'a exp -> 'b exp
 val map_pat_annot : ('a annot -> 'b annot) -> 'a pat -> 'b pat
@@ -195,12 +213,10 @@ val def_loc : 'a def -> Parse_ast.l
 
 (* For debugging and error messages only: Not guaranteed to produce
    parseable SAIL, or even print all language constructs! *)
-(* TODO: replace with existing pretty-printer *)
 val string_of_id : id -> string
 val string_of_kid : kid -> string
 val string_of_base_effect_aux : base_effect_aux -> string
-val string_of_base_kind_aux : base_kind_aux -> string
-val string_of_base_kind : base_kind -> string
+val string_of_kind_aux : kind_aux -> string
 val string_of_kind : kind -> string
 val string_of_base_effect : base_effect -> string
 val string_of_effect : effect -> string
@@ -226,6 +242,7 @@ val string_of_index_range : index_range -> string
 val id_of_fundef : 'a fundef -> id
 val id_of_type_def : 'a type_def -> id
 val id_of_val_spec : 'a val_spec -> id
+val id_of_dec_spec : 'a dec_spec -> id
 
 val id_of_kid : kid -> id
 val kid_of_id : id -> kid
@@ -244,6 +261,16 @@ module Kid : sig
   val compare : kid -> kid -> int
 end
 
+module Kind : sig
+  type t = kind
+  val compare : kind -> kind -> int
+end
+
+module KOpt : sig
+  type t = kinded_id
+  val compare : kinded_id -> kinded_id -> int
+end
+
 module Nexp : sig
   type t = nexp
   val compare : nexp -> nexp -> int
@@ -272,6 +299,14 @@ module NexpMap : sig
   include Map.S with type key = nexp
 end
 
+module KOptSet : sig
+  include Set.S with type elt = kinded_id
+end
+
+module KOptMap : sig
+  include Map.S with type key = kinded_id
+end
+
 module BESet : sig
   include Set.S with type elt = base_effect
 end
@@ -320,6 +355,7 @@ val union_effects : effect -> effect -> effect
 
 val tyvars_of_nexp : nexp -> KidSet.t
 val tyvars_of_typ : typ -> KidSet.t
+val tyvars_of_constraint : n_constraint -> KidSet.t
 val tyvars_of_quant_item : quant_item -> KidSet.t
 val is_kid_generated : kid -> bool
 
@@ -353,19 +389,39 @@ val subst : id -> 'a exp -> 'a exp -> 'a exp
 
 val hex_to_bin : string -> string
 
-
 (** locate takes an expression and recursively sets the location in
-   every subexpression to the provided location. Expressions build
-   using mk_exp and similar do not have locations, so they can then be
-   annotated as e.g. locate (gen_loc l) (mk_exp ...) where l is the
-   location from which the code is being generated. *)
-val locate : l -> 'a exp -> 'a exp
+   every subexpression using a function that takes the orginal
+   location as an argument. Expressions build using mk_exp and similar
+   do not have locations, so they can then be annotated as e.g. locate
+   (gen_loc l) (mk_exp ...) where l is the location from which the
+   code is being generated. *)
+val locate : (l -> l) -> 'a exp -> 'a exp
+
+val locate_pat : (l -> l) -> 'a pat -> 'a pat
 
-val locate_pat : l -> 'a pat -> 'a pat
+val locate_lexp : (l -> l) -> 'a lexp -> 'a lexp
 
-val locate_lexp : l -> 'a lexp -> 'a lexp
+val locate_typ : (l -> l) -> typ -> typ
 
-val locate_typ : l -> typ -> typ
+(* Make a unique location by giving it a Parse_ast.Unique wrapper with
+   a generated number. *)
+val unique : l -> l
 
 
 val extern_assoc : string -> (string * string) list -> string option
+
+(** Substitutions *)
+
+(* The function X_subst substitutes a type argument into something of
+   type X. The type of the type argument determines which kind of type
+   variables willb e replaced *)
+val nexp_subst : kid -> typ_arg -> nexp -> nexp
+val constraint_subst : kid -> typ_arg -> n_constraint -> n_constraint
+val order_subst : kid -> typ_arg -> order -> order
+val typ_subst : kid -> typ_arg -> typ -> typ
+val typ_arg_subst : kid -> typ_arg -> typ_arg -> typ_arg
+
+val subst_kid : (kid -> typ_arg -> 'a -> 'a) -> kid -> kid -> 'a -> 'a
+
+val quant_item_subst_kid : kid -> kid -> quant_item -> quant_item
+val typquant_subst_kid : kid -> kid -> typquant -> typquant
diff --git a/src/bytecode_interpreter.ml b/src/bytecode_interpreter.ml
new file mode 100644
index 00000000..398e0c9d
--- /dev/null
+++ b/src/bytecode_interpreter.ml
@@ -0,0 +1,162 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+open Bytecode
+open Bytecode_util
+
+module StringMap = Map.Make(String)
+
+type 'a frame = {
+    jump_table : int StringMap.t;
+    locals : 'a Bindings.t;
+    pc : int;
+    instrs : instr array
+  }
+
+type 'a gstate = {
+    globals : 'a Bindings.t;
+    cdefs : cdef list
+  }
+
+type 'a stack = {
+    top : 'a frame;
+    ret : ('a -> 'a frame) list
+  }
+
+let make_jump_table instrs =
+  let rec aux n = function
+    | I_aux (I_label label, _) :: instrs -> StringMap.add label n (aux (n + 1) instrs)
+    | _ :: instrs -> aux (n + 1) instrs
+    | [] -> StringMap.empty
+  in
+  aux 0 instrs
+
+let new_gstate cdefs = {
+    globals = Bindings.empty;
+    cdefs = cdefs
+  }
+
+let new_stack instrs = {
+    top = {
+      jump_table = make_jump_table instrs;
+      locals = Bindings.empty;
+      pc = 0;
+      instrs = Array.of_list instrs
+    };
+    ret = []
+  }
+
+let with_top stack f =
+  { stack with top = f (stack.top) }
+
+let eval_fragment gstate locals = function
+  | F_id id ->
+     begin match Bindings.find_opt id locals with
+     | Some vl -> vl
+     | None ->
+        begin match Bindings.find_opt id gstate.globals with
+        | Some vl -> vl
+        | None -> failwith "Identifier not found"
+        end
+     end
+  | F_lit vl -> vl
+  | _ -> failwith "Cannot eval fragment"
+
+let is_function id = function
+  | CDEF_fundef (id', _, _, _) when Id.compare id id' = 0 -> true
+  | _ -> false
+
+let step (gstate, stack) =
+  let I_aux (instr_aux, (_, l)) = stack.top.instrs.(stack.top.pc) in
+  match instr_aux with
+  | I_decl _ ->
+     gstate, with_top stack (fun frame -> { frame with pc = frame.pc + 1 })
+
+  | I_init (_, id, (fragment, _)) ->
+     let vl = eval_fragment gstate stack.top.locals fragment in
+     gstate,
+     with_top stack (fun frame -> { frame with pc = frame.pc + 1; locals = Bindings.add id vl frame.locals })
+
+  | I_jump ((fragment, _), label) ->
+     let vl = eval_fragment gstate stack.top.locals fragment in
+     gstate,
+     begin match vl with
+     | V_bool true ->
+        with_top stack (fun frame -> { frame with pc = StringMap.find label frame.jump_table })
+     | V_bool false ->
+        with_top stack (fun frame -> { frame with pc = frame.pc + 1 })
+     | _ ->
+        failwith "Type error"
+     end
+
+  | I_funcall (clexp, _, id, cvals) ->
+     let args = List.map (fun (fragment, _) -> eval_fragment gstate stack.top.locals fragment) cvals in
+     let params, instrs =
+       match List.find_opt (is_function id) gstate.cdefs with
+       | Some (CDEF_fundef (_, _, params, instrs)) -> params, instrs
+       | _ -> failwith "Function not found"
+     in
+     gstate,
+     {
+       top = {
+         jump_table = make_jump_table instrs;
+         locals = List.fold_left2 (fun locals param arg -> Bindings.add param arg locals) Bindings.empty params args;
+         pc = 0;
+         instrs = Array.of_list instrs;
+       };
+       ret = (fun vl -> { stack.top with pc = stack.top.pc + 1 }) :: stack.ret
+     }
+
+  | I_goto label ->
+     gstate, with_top stack (fun frame -> { frame with pc = StringMap.find label frame.jump_table })
+
+  | _ -> raise (Reporting.err_unreachable l __POS__ "Unhandled instruction")
diff --git a/src/bytecode_util.ml b/src/bytecode_util.ml
index 6334210e..3ced48b6 100644
--- a/src/bytecode_util.ml
+++ b/src/bytecode_util.ml
@@ -67,6 +67,9 @@ let instr_number () =
 let idecl ?loc:(l=Parse_ast.Unknown) ctyp id =
   I_aux (I_decl (ctyp, id), (instr_number (), l))
 
+let ireset ?loc:(l=Parse_ast.Unknown) ctyp id =
+  I_aux (I_reset (ctyp, id), (instr_number (), l))
+
 let iinit ?loc:(l=Parse_ast.Unknown) ctyp id cval =
   I_aux (I_init (ctyp, id, cval), (instr_number (), l))
 
@@ -82,6 +85,9 @@ let iextern ?loc:(l=Parse_ast.Unknown) clexp id cvals =
 let icopy l clexp cval =
   I_aux (I_copy (clexp, cval), (instr_number (), l))
 
+let ialias l clexp cval =
+  I_aux (I_alias (clexp, cval), (instr_number (), l))
+
 let iclear ?loc:(l=Parse_ast.Unknown) ctyp id =
   I_aux (I_clear (ctyp, id), (instr_number (), l))
 
@@ -131,6 +137,77 @@ let rec frag_rename from_id to_id = function
   | F_raw raw -> F_raw raw
   | F_poly f -> F_poly (frag_rename from_id to_id f)
 
+let cval_rename from_id to_id (frag, ctyp) = (frag_rename from_id to_id frag, ctyp)
+
+let rec clexp_rename from_id to_id = function
+  | CL_id (id, ctyp) when Id.compare id from_id = 0 -> CL_id (to_id, ctyp)
+  | CL_id (id, ctyp) -> CL_id (id, ctyp)
+  | CL_field (clexp, field) ->
+     CL_field (clexp_rename from_id to_id clexp, field)
+  | CL_addr clexp ->
+     CL_addr (clexp_rename from_id to_id clexp)
+  | CL_tuple (clexp, n) ->
+     CL_tuple (clexp_rename from_id to_id clexp, n)
+  | CL_current_exception ctyp -> CL_current_exception ctyp
+  | CL_have_exception -> CL_have_exception
+
+let rec instr_rename from_id to_id (I_aux (instr, aux)) =
+  let instr = match instr with
+    | I_decl (ctyp, id) when Id.compare id from_id = 0 -> I_decl (ctyp, to_id)
+    | I_decl (ctyp, id) -> I_decl (ctyp, id)
+
+    | I_init (ctyp, id, cval) when Id.compare id from_id = 0 ->
+       I_init (ctyp, to_id, cval_rename from_id to_id cval)
+    | I_init (ctyp, id, cval) ->
+       I_init (ctyp, id, cval_rename from_id to_id cval)
+
+    | I_if (cval, then_instrs, else_instrs, ctyp2) ->
+       I_if (cval_rename from_id to_id cval,
+             List.map (instr_rename from_id to_id) then_instrs,
+             List.map (instr_rename from_id to_id) else_instrs,
+             ctyp2)
+
+    | I_jump (cval, label) -> I_jump (cval_rename from_id to_id cval, label)
+
+    | I_funcall (clexp, extern, id, args) ->
+       I_funcall (clexp_rename from_id to_id clexp, extern, id, List.map (cval_rename from_id to_id) args)
+
+    | I_copy (clexp, cval) -> I_copy (clexp_rename from_id to_id clexp, cval_rename from_id to_id cval)
+    | I_alias (clexp, cval) -> I_alias (clexp_rename from_id to_id clexp, cval_rename from_id to_id cval)
+
+    | I_clear (ctyp, id) when Id.compare id from_id = 0 -> I_clear (ctyp, to_id)
+    | I_clear (ctyp, id) -> I_clear (ctyp, id)
+
+    | I_return cval -> I_return (cval_rename from_id to_id cval)
+
+    | I_block instrs -> I_block (List.map (instr_rename from_id to_id) instrs)
+
+    | I_try_block instrs -> I_try_block (List.map (instr_rename from_id to_id) instrs)
+
+    | I_throw cval -> I_throw (cval_rename from_id to_id cval)
+
+    | I_comment str -> I_comment str
+
+    | I_raw str -> I_raw str
+
+    | I_label label -> I_label label
+
+    | I_goto label -> I_goto label
+
+    | I_undefined ctyp -> I_undefined ctyp
+
+    | I_match_failure -> I_match_failure
+
+    | I_reset (ctyp, id) when Id.compare id from_id = 0 -> I_reset (ctyp, to_id)
+    | I_reset (ctyp, id) -> I_reset (ctyp, id)
+
+    | I_reinit (ctyp, id, cval) when Id.compare id from_id = 0 ->
+       I_reinit (ctyp, to_id, cval_rename from_id to_id cval)
+    | I_reinit (ctyp, id, cval) ->
+       I_reinit (ctyp, id, cval_rename from_id to_id cval)
+  in
+  I_aux (instr, aux)
+
 (**************************************************************************)
 (* 1. Instruction pretty printer                                          *)
 (**************************************************************************)
@@ -175,12 +252,14 @@ and string_of_fragment' ?zencode:(zencode=true) f =
 (* String representation of ctyps here is only for debugging and
    intermediate language pretty-printer. *)
 and string_of_ctyp = function
-  | CT_int -> "mpz_t"
-  | CT_bits true -> "bv_t(dec)"
-  | CT_bits false -> "bv_t(inc)"
-  | CT_bits64 (n, true) -> "uint64_t(" ^ string_of_int n ^ ", dec)"
-  | CT_bits64 (n, false) -> "uint64_t(" ^ string_of_int n ^ ", int)"
-  | CT_int64 -> "int64_t"
+  | CT_int -> "int"
+  | CT_lbits true -> "lbits(dec)"
+  | CT_lbits false -> "lbits(inc)"
+  | CT_fbits (n, true) -> "fbits(" ^ string_of_int n ^ ", dec)"
+  | CT_fbits (n, false) -> "fbits(" ^ string_of_int n ^ ", int)"
+  | CT_sbits true -> "sbits(dec)"
+  | CT_sbits false -> "sbits(inc)"
+  | CT_int64 -> "int64"
   | CT_bit -> "bit"
   | CT_unit -> "unit"
   | CT_bool -> "bool"
@@ -197,12 +276,14 @@ and string_of_ctyp = function
 (** This function is like string_of_ctyp, but recursively prints all
    constructors in variants and structs. Used for debug output. *)
 and full_string_of_ctyp = function
-  | CT_int -> "mpz_t"
-  | CT_bits true -> "bv_t(dec)"
-  | CT_bits false -> "bv_t(inc)"
-  | CT_bits64 (n, true) -> "uint64_t(" ^ string_of_int n ^ ", dec)"
-  | CT_bits64 (n, false) -> "uint64_t(" ^ string_of_int n ^ ", int)"
-  | CT_int64 -> "int64_t"
+  | CT_int -> "int"
+  | CT_lbits true -> "lbits(dec)"
+  | CT_lbits false -> "lbits(inc)"
+  | CT_fbits (n, true) -> "fbits(" ^ string_of_int n ^ ", dec)"
+  | CT_fbits (n, false) -> "fbits(" ^ string_of_int n ^ ", int)"
+  | CT_sbits true -> "sbits(dec)"
+  | CT_sbits false -> "sbits(inc)"
+  | CT_int64 -> "int64"
   | CT_bit -> "bit"
   | CT_unit -> "unit"
   | CT_bool -> "bool"
@@ -222,7 +303,8 @@ and full_string_of_ctyp = function
   | CT_poly -> "*"
 
 let rec map_ctyp f = function
-  | (CT_int | CT_int64 | CT_bits _ | CT_bits64 _ | CT_bit | CT_unit | CT_bool | CT_real | CT_string | CT_poly | CT_enum _) as ctyp -> f ctyp
+  | (CT_int | CT_int64 | CT_lbits _ | CT_fbits _ | CT_sbits _
+     | CT_bit | CT_unit | CT_bool | CT_real | CT_string | CT_poly | CT_enum _) as ctyp -> f ctyp
   | CT_tup ctyps -> f (CT_tup (List.map (map_ctyp f) ctyps))
   | CT_ref ctyp -> f (CT_ref (map_ctyp f ctyp))
   | CT_vector (direction, ctyp) -> f (CT_vector (direction, map_ctyp f ctyp))
@@ -233,8 +315,9 @@ let rec map_ctyp f = function
 let rec ctyp_equal ctyp1 ctyp2 =
   match ctyp1, ctyp2 with
   | CT_int, CT_int -> true
-  | CT_bits d1, CT_bits d2 -> d1 = d2
-  | CT_bits64 (m1, d1), CT_bits64 (m2, d2) -> m1 = m2 && d1 = d2
+  | CT_lbits d1, CT_lbits d2 -> d1 = d2
+  | CT_sbits d1, CT_sbits d2 -> d1 = d2
+  | CT_fbits (m1, d1), CT_fbits (m2, d2) -> m1 = m2 && d1 = d2
   | CT_bit, CT_bit -> true
   | CT_int64, CT_int64 -> true
   | CT_unit, CT_unit -> true
@@ -271,8 +354,9 @@ let rec ctyp_unify ctyp1 ctyp2 =
 
 let rec ctyp_suprema = function
   | CT_int -> CT_int
-  | CT_bits d -> CT_bits d
-  | CT_bits64 (_, d) -> CT_bits d
+  | CT_lbits d -> CT_lbits d
+  | CT_fbits (_, d) -> CT_lbits d
+  | CT_sbits d -> CT_lbits d
   | CT_int64 -> CT_int
   | CT_unit -> CT_unit
   | CT_bool -> CT_bool
@@ -298,7 +382,7 @@ let rec ctyp_ids = function
      IdSet.add id (List.fold_left (fun ids (_, ctyp) -> IdSet.union (ctyp_ids ctyp) ids) IdSet.empty ctors)
   | CT_tup ctyps -> List.fold_left (fun ids ctyp -> IdSet.union (ctyp_ids ctyp) ids) IdSet.empty ctyps
   | CT_vector (_, ctyp) | CT_list ctyp | CT_ref ctyp -> ctyp_ids ctyp
-  | CT_int | CT_int64 | CT_bits _ | CT_bits64 _ | CT_unit
+  | CT_int | CT_int64 | CT_lbits _ | CT_fbits _ | CT_sbits _ | CT_unit
     | CT_bool | CT_real | CT_bit | CT_string | CT_poly -> IdSet.empty
 
 let rec unpoly = function
@@ -310,7 +394,7 @@ let rec unpoly = function
   | f -> f
 
 let rec is_polymorphic = function
-  | CT_int | CT_int64 | CT_bits _ | CT_bits64 _ | CT_bit | CT_unit | CT_bool | CT_real | CT_string -> false
+  | CT_int | CT_int64 | CT_lbits _ | CT_fbits _ | CT_sbits _ | CT_bit | CT_unit | CT_bool | CT_real | CT_string -> false
   | CT_tup ctyps -> List.exists is_polymorphic ctyps
   | CT_enum _ -> false
   | CT_struct (_, ctors) | CT_variant (_, ctors) -> List.exists (fun (_, ctyp) -> is_polymorphic ctyp) ctors
@@ -370,6 +454,8 @@ let rec pp_instr ?short:(short=false) (I_aux (instr, aux)) =
                       string (string_of_id f |> Util.green |> Util.clear) ^^ parens (separate_map (string ", ") pp_cval args) ]
   | I_copy (clexp, cval) ->
      separate space [pp_clexp clexp; string "="; pp_cval cval]
+  | I_alias (clexp, cval) ->
+     pp_keyword "alias" ^^ separate space [pp_clexp clexp; string "="; pp_cval cval]
   | I_clear (ctyp, id) ->
      pp_keyword "kill" ^^ pp_id id ^^ string " : " ^^ pp_ctyp ctyp
   | I_return cval ->
@@ -497,6 +583,7 @@ let instr_deps = function
   | I_jump (cval, label) -> cval_deps cval, NS.singleton (G_label label)
   | I_funcall (clexp, _, _, cvals) -> List.fold_left NS.union NS.empty (List.map cval_deps cvals), clexp_deps clexp
   | I_copy (clexp, cval) -> cval_deps cval, clexp_deps clexp
+  | I_alias (clexp, cval) -> cval_deps cval, clexp_deps clexp
   | I_clear (_, id) -> NS.singleton (G_id id), NS.singleton (G_id id)
   | I_throw cval | I_return cval -> cval_deps cval, NS.empty
   | I_block _ | I_try_block _ -> NS.empty, NS.empty
@@ -621,6 +708,7 @@ let rec map_instr_ctyp f (I_aux (instr, aux)) =
     | I_funcall (clexp, extern, id, cvals) ->
        I_funcall (map_clexp_ctyp f clexp, extern, id, List.map (fun (frag, ctyp) -> frag, f ctyp) cvals)
     | I_copy (clexp, (frag, ctyp)) -> I_copy (map_clexp_ctyp f clexp, (frag, f ctyp))
+    | I_alias (clexp, (frag, ctyp)) -> I_alias (map_clexp_ctyp f clexp, (frag, f ctyp))
     | I_clear (ctyp, id) -> I_clear (f ctyp, id)
     | I_return (frag, ctyp) -> I_return (frag, f ctyp)
     | I_block instrs -> I_block (List.map (map_instr_ctyp f) instrs)
@@ -637,7 +725,7 @@ let rec map_instr_ctyp f (I_aux (instr, aux)) =
 let rec map_instr f (I_aux (instr, aux)) =
   let instr = match instr with
     | I_decl _ | I_init _ | I_reset _ | I_reinit _
-      | I_funcall _ | I_copy _ | I_clear _ | I_jump _ | I_throw _ | I_return _
+      | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_jump _ | I_throw _ | I_return _
       | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure | I_undefined _ -> instr
     | I_if (cval, instrs1, instrs2, ctyp) ->
        I_if (cval, List.map (map_instr f) instrs1, List.map (map_instr f) instrs2, ctyp)
@@ -679,9 +767,52 @@ let rec map_instrs f (I_aux (instr, aux)) =
     | I_decl _ | I_init _ | I_reset _ | I_reinit _ -> instr
     | I_if (cval, instrs1, instrs2, ctyp) ->
        I_if (cval, f (List.map (map_instrs f) instrs1), f (List.map (map_instrs f) instrs2), ctyp)
-    | I_funcall _ | I_copy _ | I_clear _ | I_jump _ | I_throw _ | I_return _ -> instr
+    | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_jump _ | I_throw _ | I_return _ -> instr
     | I_block instrs -> I_block (f (List.map (map_instrs f) instrs))
     | I_try_block instrs -> I_try_block (f (List.map (map_instrs f) instrs))
     | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure | I_undefined _ -> instr
   in
   I_aux (instr, aux)
+
+let rec instr_ids (I_aux (instr, _)) =
+  let reads, writes = instr_deps instr in
+  let get_id = function
+    | G_id id -> Some id
+    | _ -> None
+  in
+  NS.elements reads @ NS.elements writes
+  |> List.map get_id
+  |> Util.option_these
+  |> IdSet.of_list
+
+let rec instr_reads (I_aux (instr, _)) =
+  let reads, _ = instr_deps instr in
+  let get_id = function
+    | G_id id -> Some id
+    | _ -> None
+  in
+  NS.elements reads
+  |> List.map get_id
+  |> Util.option_these
+  |> IdSet.of_list
+
+let rec instr_writes (I_aux (instr, _)) =
+  let _, writes = instr_deps instr in
+  let get_id = function
+    | G_id id -> Some id
+    | _ -> None
+  in
+  NS.elements writes
+  |> List.map get_id
+  |> Util.option_these
+  |> IdSet.of_list
+
+let rec filter_instrs f instrs =
+  let filter_instrs' = function
+    | I_aux (I_block instrs, aux) -> I_aux (I_block (filter_instrs f instrs), aux)
+    | I_aux (I_try_block instrs, aux) -> I_aux (I_try_block (filter_instrs f instrs), aux)
+    | I_aux (I_if (cval, instrs1, instrs2, ctyp), aux) ->
+       I_aux (I_if (cval, filter_instrs f instrs1, filter_instrs f instrs2, ctyp), aux)
+    | instr -> instr
+  in
+  List.filter f (List.map filter_instrs' instrs)
diff --git a/src/c_backend.ml b/src/c_backend.ml
index d825bbae..65702764 100644
--- a/src/c_backend.ml
+++ b/src/c_backend.ml
@@ -61,7 +61,8 @@ open Anf
 module Big_int = Nat_big_num
 
 let c_verbosity = ref 0
-let opt_ddump_flow_graphs = ref false
+let opt_debug_flow_graphs = ref false
+let opt_debug_function = ref ""
 let opt_trace = ref false
 let opt_static = ref false
 let opt_no_main = ref false
@@ -70,12 +71,14 @@ let opt_no_main = ref false
 let optimize_primops = ref false
 let optimize_hoist_allocations = ref false
 let optimize_struct_updates = ref false
+let optimize_alias = ref false
+let optimize_experimental = ref false
 
 let c_debug str =
   if !c_verbosity > 0 then prerr_endline (Lazy.force str) else ()
 
 let c_error ?loc:(l=Parse_ast.Unknown) message =
-  raise (Reporting_basic.err_general l ("\nC backend: " ^ message))
+  raise (Reporting.err_general l ("\nC backend: " ^ message))
 
 let zencode_id = function
   | Id_aux (Id str, l) -> Id_aux (Id (Util.zencode_string str), l)
@@ -88,6 +91,13 @@ let zencode_id = function
 let max_int64 = Big_int.of_int64 Int64.max_int
 let min_int64 = Big_int.of_int64 Int64.min_int
 
+(** The context type contains two type-checking
+   environments. ctx.local_env contains the closest typechecking
+   environment, usually from the expression we are compiling, whereas
+   ctx.tc_env is the global type checking environment from
+   type-checking the entire AST. We also keep track of local variables
+   in ctx.locals, so we know when their type changes due to flow
+   typing. *)
 type ctx =
   { records : (ctyp Bindings.t) Bindings.t;
     enums : IdSet.t Bindings.t;
@@ -114,97 +124,112 @@ let initial_ctx env =
     optimize_z3 = true;
   }
 
-(** Convert a sail type into a C-type **)
+(** Convert a sail type into a C-type. This function can be quite
+   slow, because it uses ctx.local_env and Z3 to analyse the Sail
+   types and attempts to fit them into the smallest possible C
+   types, provided ctx.optimize_z3 is true (default) **)
 let rec ctyp_of_typ ctx typ =
   let Typ_aux (typ_aux, l) as typ = Env.expand_synonyms ctx.tc_env typ in
   match typ_aux with
-  | Typ_id id when string_of_id id = "bit" -> CT_bit
-  | Typ_id id when string_of_id id = "bool" -> CT_bool
-  | Typ_id id when string_of_id id = "int" -> CT_int
-  | Typ_id id when string_of_id id = "nat" -> CT_int
+  | Typ_id id when string_of_id id = "bit"    -> CT_bit
+  | Typ_id id when string_of_id id = "bool"   -> CT_bool
+  | Typ_id id when string_of_id id = "int"    -> CT_int
+  | Typ_id id when string_of_id id = "nat"    -> CT_int
+  | Typ_id id when string_of_id id = "unit"   -> CT_unit
+  | Typ_id id when string_of_id id = "string" -> CT_string
+  | Typ_id id when string_of_id id = "real"   -> CT_real
+
+  | Typ_app (id, _) when string_of_id id = "atom_bool" -> CT_bool
+
   | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" ->
-     begin
-       match destruct_range Env.empty typ with
-       | None -> assert false (* Checked if range type in guard *)
-       | Some (kids, constr, n, m) ->
-          match nexp_simp n, nexp_simp m with
-          | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
-               when Big_int.less_equal min_int64 n && Big_int.less_equal m max_int64 ->
+     begin match destruct_range Env.empty typ with
+     | None -> assert false (* Checked if range type in guard *)
+     | Some (kids, constr, n, m) ->
+        match nexp_simp n, nexp_simp m with
+        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+             when Big_int.less_equal min_int64 n && Big_int.less_equal m max_int64 ->
+           CT_int64
+        | n, m when ctx.optimize_z3 ->
+           if prove ctx.local_env (nc_lteq (nconstant min_int64) n) && prove ctx.local_env (nc_lteq m (nconstant max_int64)) then
              CT_int64
-          | n, m when ctx.optimize_z3 ->
-             if prove ctx.local_env (nc_lteq (nconstant min_int64) n) && prove ctx.local_env (nc_lteq m (nconstant max_int64)) then
-               CT_int64
-             else
-               CT_int
-          | _ -> CT_int
+           else
+             CT_int
+        | _ -> CT_int
      end
 
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) when string_of_id id = "list" ->
+  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
      CT_list (ctyp_of_typ ctx typ)
 
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp n, _);
-                  Typ_arg_aux (Typ_arg_order ord, _);
-                  Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id vtyp_id, _)), _)])
+  (* When converting a sail bitvector type into C, we have three options in order of efficiency:
+     - If the length is obviously static and smaller than 64, use the fixed bits type (aka uint64_t), fbits.
+     - If the length is less than 64, then use a small bits type, sbits.
+     - If the length may be larger than 64, use a large bits type lbits. *)
+  | Typ_app (id, [A_aux (A_nexp n, _);
+                  A_aux (A_order ord, _);
+                  A_aux (A_typ (Typ_aux (Typ_id vtyp_id, _)), _)])
        when string_of_id id = "vector" && string_of_id vtyp_id = "bit" ->
-     begin
-       let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
-       match nexp_simp n with
-       | Nexp_aux (Nexp_constant n, _) when Big_int.less_equal n (Big_int.of_int 64) -> CT_bits64 (Big_int.to_int n, direction)
-       | _ when not ctx.optimize_z3 -> CT_bits direction
-       | _ -> CT_bits direction
-       (* This is extremely slow :(
-       match solve ctx.local_env n with
-       | Some n when Big_int.less_equal n (Big_int.of_int 64) -> CT_bits64 (Big_int.to_int n, direction)
-       | _ -> CT_bits direction
-        *)
+     let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
+     begin match nexp_simp n with
+     | Nexp_aux (Nexp_constant n, _) when Big_int.less_equal n (Big_int.of_int 64) -> CT_fbits (Big_int.to_int n, direction)
+     | n when ctx.optimize_z3 && prove ctx.local_env (nc_lteq n (nint 64)) -> CT_sbits direction
+     | _ -> CT_lbits direction
      end
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp n, _);
-                  Typ_arg_aux (Typ_arg_order ord, _);
-                  Typ_arg_aux (Typ_arg_typ typ, _)])
+
+  | Typ_app (id, [A_aux (A_nexp n, _);
+                  A_aux (A_order ord, _);
+                  A_aux (A_typ typ, _)])
        when string_of_id id = "vector" ->
      let direction = match ord with Ord_aux (Ord_dec, _) -> true | Ord_aux (Ord_inc, _) -> false | _ -> assert false in
      CT_vector (direction, ctyp_of_typ ctx typ)
 
-  | Typ_id id when string_of_id id = "unit" -> CT_unit
-  | Typ_id id when string_of_id id = "string" -> CT_string
-  | Typ_id id when string_of_id id = "real" -> CT_real
-
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) when string_of_id id = "register" ->
+  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "register" ->
      CT_ref (ctyp_of_typ ctx typ)
 
-  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records -> CT_struct (id, Bindings.find id ctx.records |> Bindings.bindings)
+  | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.records  -> CT_struct (id, Bindings.find id ctx.records |> Bindings.bindings)
   | Typ_id id | Typ_app (id, _) when Bindings.mem id ctx.variants -> CT_variant (id, Bindings.find id ctx.variants |> Bindings.bindings)
   | Typ_id id when Bindings.mem id ctx.enums -> CT_enum (id, Bindings.find id ctx.enums |> IdSet.elements)
 
   | Typ_tup typs -> CT_tup (List.map (ctyp_of_typ ctx) typs)
 
   | Typ_exist _ when ctx.optimize_z3 ->
-     (* Use Type_check.destruct_exist when optimising with z3, to ensure that we
-        don't cause any type variable clashes in local_env. *)
-     begin match destruct_exist ctx.local_env typ with
+     (* Use Type_check.destruct_exist when optimising with z3, to
+        ensure that we don't cause any type variable clashes in
+        local_env, and that we can optimize the existential based upon
+        it's constraints. *)
+     begin match destruct_exist (Env.expand_synonyms ctx.local_env typ) with
      | Some (kids, nc, typ) ->
         let env = add_existential l kids nc ctx.local_env in
         ctyp_of_typ { ctx with local_env = env } typ
-     | None -> c_error "Existential cannot be destructured. This should be impossible!"
+     | None -> raise (Reporting.err_unreachable l __POS__ "Existential cannot be destructured!")
      end
 
   | Typ_exist (_, _, typ) -> ctyp_of_typ ctx typ
 
-  | Typ_var kid -> CT_poly (* c_error ~loc:l ("Polymorphic type encountered " ^ string_of_kid kid) *)
+  | Typ_var kid -> CT_poly
 
   | _ -> c_error ~loc:l ("No C type for type " ^ string_of_typ typ)
 
 let rec is_stack_ctyp ctyp = match ctyp with
-  | CT_bits64 _ | CT_int64 | CT_bit | CT_unit | CT_bool | CT_enum _ -> true
-  | CT_bits _ | CT_int | CT_real | CT_string | CT_list _ | CT_vector _ -> false
+  | CT_fbits _ | CT_sbits _ | CT_int64 | CT_bit | CT_unit | CT_bool | CT_enum _ -> true
+  | CT_lbits _ | CT_int | CT_real | CT_string | CT_list _ | CT_vector _ -> false
   | CT_struct (_, fields) -> List.for_all (fun (_, ctyp) -> is_stack_ctyp ctyp) fields
-  | CT_variant (_, ctors) -> false (* List.for_all (fun (_, ctyp) -> is_stack_ctyp ctyp) ctors *) (*FIXME*)
+  | CT_variant (_, ctors) -> false (* List.for_all (fun (_, ctyp) -> is_stack_ctyp ctyp) ctors *) (* FIXME *)
   | CT_tup ctyps -> List.for_all is_stack_ctyp ctyps
   | CT_ref ctyp -> true
   | CT_poly -> true
 
 let is_stack_typ ctx typ = is_stack_ctyp (ctyp_of_typ ctx typ)
 
+let is_fbits_typ ctx typ =
+  match ctyp_of_typ ctx typ with
+  | CT_fbits _ -> true
+  | _ -> false
+
+let is_sbits_typ ctx typ =
+  match ctyp_of_typ ctx typ with
+  | CT_sbits _ -> true
+  | _ -> false
+
 let ctor_bindings = List.fold_left (fun map (id, ctyp) -> Bindings.add id ctyp map) Bindings.empty
 
 (**************************************************************************)
@@ -235,15 +260,15 @@ let hex_char =
 let literal_to_fragment (L_aux (l_aux, _) as lit) =
   match l_aux with
   | L_num n when Big_int.less_equal min_int64 n && Big_int.less_equal n max_int64 ->
-     Some (F_lit (V_int n))
+     Some (F_lit (V_int n), CT_int64)
   | L_hex str when String.length str <= 16 ->
      let padding = 16 - String.length str in
      let padding = Util.list_init padding (fun _ -> Sail2_values.B0) in
      let content = Util.string_to_list str |> List.map hex_char |> List.concat in
-     Some (F_lit (V_bits (padding @ content)))
-  | L_unit -> Some (F_lit V_unit)
-  | L_true -> Some (F_lit (V_bool true))
-  | L_false -> Some (F_lit (V_bool false))
+     Some (F_lit (V_bits (padding @ content)), CT_fbits (String.length str * 4, true))
+  | L_unit -> Some (F_lit V_unit, CT_unit)
+  | L_true -> Some (F_lit (V_bool true), CT_bool)
+  | L_false -> Some (F_lit (V_bool false), CT_bool)
   | _ -> None
 
 let c_literals ctx =
@@ -251,7 +276,7 @@ let c_literals ctx =
     | AV_lit (lit, typ) as v when is_stack_ctyp (ctyp_of_typ { ctx with local_env = env } typ) ->
        begin
          match literal_to_fragment lit with
-         | Some frag -> AV_C_fragment (frag, typ)
+         | Some (frag, ctyp) -> AV_C_fragment (frag, typ, ctyp)
          | None -> v
        end
     | AV_tuple avals -> AV_tuple (List.map (c_literal env l) avals)
@@ -286,34 +311,45 @@ let rec c_aval ctx = function
   | AV_lit (lit, typ) as v ->
      begin
        match literal_to_fragment lit with
-       | Some frag -> AV_C_fragment (frag, typ)
+       | Some (frag, ctyp) -> AV_C_fragment (frag, typ, ctyp)
        | None -> v
      end
-  | AV_C_fragment (str, typ) -> AV_C_fragment (str, typ)
+  | AV_C_fragment (str, typ, ctyp) -> AV_C_fragment (str, typ, ctyp)
   (* An id can be converted to a C fragment if it's type can be
      stack-allocated. *)
   | AV_id (id, lvar) as v ->
      begin
        match lvar with
-       | Local (_, typ) when is_stack_typ ctx typ ->
-          begin
-            try
-              (* We need to check that id's type hasn't changed due to flow typing *)
-              let _, ctyp = Bindings.find id ctx.locals in
-              if is_stack_ctyp ctyp then
-                AV_C_fragment (F_id id, typ)
-              else
-                v (* id's type went from heap -> stack due to flow typing, so it's really still heap allocated! *)
-            with
-              Not_found -> failwith ("could not find " ^ string_of_id id ^ " in local variables")
-          end
+       | Local (_, typ) ->
+          let ctyp = ctyp_of_typ ctx typ in
+          if is_stack_ctyp ctyp then
+            begin
+              try
+                (* We need to check that id's type hasn't changed due to flow typing *)
+                let _, ctyp' = Bindings.find id ctx.locals in
+                if ctyp_equal ctyp ctyp' then
+                  AV_C_fragment (F_id id, typ, ctyp)
+                else
+                  (* id's type changed due to flow
+                     typing, so it's really still heap allocated!  *)
+                  v
+              with
+                (* Hack: Assuming global letbindings don't change from flow typing... *)
+                Not_found -> AV_C_fragment (F_id id, typ, ctyp)
+            end
+          else
+            v
        | Register (_, _, typ) when is_stack_typ ctx typ ->
-          AV_C_fragment (F_id id, typ)
+          let ctyp = ctyp_of_typ ctx typ in
+          if is_stack_ctyp ctyp then
+            AV_C_fragment (F_id id, typ, ctyp)
+          else
+            v
        | _ -> v
      end
   | AV_vector (v, typ) when is_bitvector v && List.length v <= 64 ->
      let bitstring = F_lit (V_bits (List.map value_of_aval_bit v)) in
-     AV_C_fragment (bitstring, typ)
+     AV_C_fragment (bitstring, typ, CT_fbits (List.length v, true))
   | AV_tuple avals -> AV_tuple (List.map (c_aval ctx) avals)
   | aval -> aval
 
@@ -322,7 +358,7 @@ let is_c_fragment = function
   | _ -> false
 
 let c_fragment = function
-  | AV_C_fragment (frag, _) -> frag
+  | AV_C_fragment (frag, _, _) -> frag
   | _ -> assert false
 
 let v_mask_lower i = F_lit (V_bits (Util.list_init i (fun _ -> Sail2_values.B1)))
@@ -339,9 +375,10 @@ let rec analyze_functions ctx f (AE_aux (aexp, env, l)) =
 
     | AE_short_circuit (op, aval, aexp) -> AE_short_circuit (op, aval, analyze_functions ctx f aexp)
 
-    | AE_let (mut, id, typ1, aexp1, aexp2, typ2) ->
+    | AE_let (mut, id, typ1, aexp1, (AE_aux (_, env2, _) as aexp2), typ2) ->
        let aexp1 = analyze_functions ctx f aexp1 in
-       let ctyp1 = ctyp_of_typ ctx typ1 in
+       (* Use aexp2's environment because it will contain constraints for id *)
+       let ctyp1 = ctyp_of_typ { ctx with local_env = env2 } typ1 in
        let ctx = { ctx with locals = Bindings.add id (mut, ctyp1) ctx.locals } in
        AE_let (mut, id, typ1, aexp1, analyze_functions ctx f aexp2, typ2)
 
@@ -357,11 +394,14 @@ let rec analyze_functions ctx f (AE_aux (aexp, env, l)) =
        let aexp2 = analyze_functions ctx f aexp2 in
        let aexp3 = analyze_functions ctx f aexp3 in
        let aexp4 = analyze_functions ctx f aexp4 in
+       (* Currently we assume that loop indexes are always safe to put into an int64 *)
+       let ctx = { ctx with locals = Bindings.add id (Immutable, CT_int64) ctx.locals } in
        AE_for (id, aexp1, aexp2, aexp3, order, aexp4)
 
     | AE_case (aval, cases, typ) ->
-       let analyze_case (pat, aexp1, aexp2) =
+       let analyze_case (AP_aux (_, env, _) as pat, aexp1, aexp2) =
          let pat_bindings = Bindings.bindings (apat_types pat) in
+         let ctx = { ctx with local_env = env } in
          let ctx =
            List.fold_left (fun ctx (id, typ) -> { ctx with locals = Bindings.add id (Immutable, ctyp_of_typ ctx typ) ctx.locals }) ctx pat_bindings
          in
@@ -387,85 +427,138 @@ let analyze_primop' ctx id args typ =
   c_debug (lazy ("Analyzing primop " ^ extern ^ "(" ^ Util.string_of_list ", " (fun aval -> Pretty_print_sail.to_string (pp_aval aval)) args ^ ")"));
 
   match extern, args with
-  | "eq_bits", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "==", v2), typ))
+  | "eq_bits", [AV_C_fragment (v1, _, CT_fbits _); AV_C_fragment (v2, _, _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "==", v2), typ, CT_bool))
+  | "eq_bits", [AV_C_fragment (v1, _, CT_sbits _); AV_C_fragment (v2, _, _)] ->
+     AE_val (AV_C_fragment (F_call ("eq_sbits", [v1; v2]), typ, CT_bool))
 
-  | "neq_bits", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "!=", v2), typ))
+  | "neq_bits", [AV_C_fragment (v1, _, CT_fbits _); AV_C_fragment (v2, _, _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "!=", v2), typ, CT_bool))
+  | "neq_bits", [AV_C_fragment (v1, _, CT_sbits _); AV_C_fragment (v2, _, _)] ->
+     AE_val (AV_C_fragment (F_call ("neq_sbits", [v1; v2]), typ, CT_bool))
 
-  | "eq_int", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "==", v2), typ))
+  | "eq_int", [AV_C_fragment (v1, typ1, _); AV_C_fragment (v2, typ2, _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "==", v2), typ, CT_bool))
 
   | "zeros", [_] ->
      begin match destruct_vector ctx.tc_env typ with
      | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
           when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-        AE_val (AV_C_fragment (F_raw "0x0", typ))
+        AE_val (AV_C_fragment (F_raw "0x0", typ, CT_fbits (Big_int.to_int n, true)))
      | _ -> no_change
      end
 
-  | "gteq", [AV_C_fragment (v1, _); AV_C_fragment (v2, _)] ->
-     AE_val (AV_C_fragment (F_op (v1, ">=", v2), typ))
+  | "gteq", [AV_C_fragment (v1, _, _); AV_C_fragment (v2, _, _)] ->
+     AE_val (AV_C_fragment (F_op (v1, ">=", v2), typ, CT_bool))
 
-  | "xor_bits", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "^", v2), typ))
+  | "xor_bits", [AV_C_fragment (v1, _, (CT_fbits _ as ctyp)); AV_C_fragment (v2, _, CT_fbits _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "^", v2), typ, ctyp))
+  | "xor_bits", [AV_C_fragment (v1, _, (CT_sbits _ as ctyp)); AV_C_fragment (v2, _, CT_sbits _)] ->
+     AE_val (AV_C_fragment (F_call ("xor_sbits", [v1; v2]), typ, ctyp))
 
-  | "or_bits", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "|", v2), typ))
+  | "or_bits", [AV_C_fragment (v1, _, (CT_fbits _ as ctyp)); AV_C_fragment (v2, _, CT_fbits _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "|", v2), typ, ctyp))
 
-  | "and_bits", [AV_C_fragment (v1, typ1); AV_C_fragment (v2, typ2)] ->
-     AE_val (AV_C_fragment (F_op (v1, "&", v2), typ))
+  | "and_bits", [AV_C_fragment (v1, _, (CT_fbits _ as ctyp)); AV_C_fragment (v2, _, CT_fbits _)] ->
+     AE_val (AV_C_fragment (F_op (v1, "&", v2), typ, ctyp))
 
-  | "not_bits", [AV_C_fragment (v, _)] ->
+  | "not_bits", [AV_C_fragment (v, _, ctyp)] ->
      begin match destruct_vector ctx.tc_env typ with
      | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
           when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-        AE_val (AV_C_fragment (F_op (F_unary ("~", v), "&", v_mask_lower (Big_int.to_int n)), typ))
+        AE_val (AV_C_fragment (F_op (F_unary ("~", v), "&", v_mask_lower (Big_int.to_int n)), typ, ctyp))
      | _ -> no_change
      end
 
-  | "vector_subrange", [AV_C_fragment (vec, _); AV_C_fragment (f, _); AV_C_fragment (t, _)] when is_stack_typ ctx typ ->
+  | "vector_subrange", [AV_C_fragment (vec, _, CT_fbits _); AV_C_fragment (f, _, _); AV_C_fragment (t, _, _)]
+       when is_fbits_typ ctx typ ->
      let len = F_op (f, "-", F_op (t, "-", v_one)) in
-     AE_val (AV_C_fragment (F_op (F_call ("safe_rshift", [F_raw "UINT64_MAX"; F_op (v_int 64, "-", len)]), "&", F_op (vec, ">>", t)), typ))
+     AE_val (AV_C_fragment (F_op (F_call ("safe_rshift", [F_raw "UINT64_MAX"; F_op (v_int 64, "-", len)]), "&", F_op (vec, ">>", t)),
+                            typ,
+                            ctyp_of_typ ctx typ))
 
-  | "vector_access", [AV_C_fragment (vec, _); AV_C_fragment (n, _)] ->
-     AE_val (AV_C_fragment (F_op (v_one, "&", F_op (vec, ">>", n)), typ))
+  | "vector_access", [AV_C_fragment (vec, _, CT_fbits _); AV_C_fragment (n, _, _)] ->
+     AE_val (AV_C_fragment (F_op (v_one, "&", F_op (vec, ">>", n)), typ, CT_bit))
 
-  | "eq_bit", [AV_C_fragment (a, _); AV_C_fragment (b, _)] ->
-     AE_val (AV_C_fragment (F_op (a, "==", b), typ))
+  | "eq_bit", [AV_C_fragment (a, _, _); AV_C_fragment (b, _, _)] ->
+     AE_val (AV_C_fragment (F_op (a, "==", b), typ, CT_bool))
 
-  | "slice", [AV_C_fragment (vec, _); AV_C_fragment (start, _); AV_C_fragment (len, _)] ->
-     AE_val (AV_C_fragment (F_op (F_call ("safe_rshift", [F_raw "UINT64_MAX"; F_op (v_int 64, "-", len)]), "&", F_op (vec, ">>", start)), typ))
+  | "slice", [AV_C_fragment (vec, _, CT_fbits _); AV_C_fragment (start, _, _); AV_C_fragment (len, _, _)]
+       when is_fbits_typ ctx typ ->
+     AE_val (AV_C_fragment (F_op (F_call ("safe_rshift", [F_raw "UINT64_MAX"; F_op (v_int 64, "-", len)]), "&", F_op (vec, ">>", start)),
+                            typ,
+                            ctyp_of_typ ctx typ))
 
-  | "undefined_bit", _ ->
-     AE_val (AV_C_fragment (F_lit (V_bit Sail2_values.B0), typ))
+  | "slice", [AV_C_fragment (vec, _, CT_fbits _); AV_C_fragment (start, _, _); AV_C_fragment (len, _, _)]
+       when is_sbits_typ ctx typ ->
+     AE_val (AV_C_fragment (F_call ("sslice", [vec; start; len]), typ, ctyp_of_typ ctx typ))
 
-  | "undefined_vector", [AV_C_fragment (len, _); _] ->
+  | "undefined_bit", _ ->
+     AE_val (AV_C_fragment (F_lit (V_bit Sail2_values.B0), typ, CT_bit))
+
+  (* Optimized routines for all combinations of fixed and small bits
+     appends, where the result is guaranteed to be smaller than 64. *)
+  | "append", [AV_C_fragment (vec1, _, CT_fbits (0, ord1)); AV_C_fragment (vec2, _, CT_fbits (n2, ord2)) as v2]
+       when ord1 = ord2 ->
+     AE_val v2
+  | "append", [AV_C_fragment (vec1, _, CT_fbits (n1, ord1)); AV_C_fragment (vec2, _, CT_fbits (n2, ord2))]
+       when ord1 = ord2 && n1 + n2 <= 64 ->
+     AE_val (AV_C_fragment (F_op (F_op (vec1, "<<", v_int n2), "|", vec2), typ, CT_fbits (n1 + n2, ord1)))
+
+  | "append", [AV_C_fragment (vec1, _, CT_sbits ord1); AV_C_fragment (vec2, _, CT_fbits (n2, ord2))]
+       when ord1 = ord2 && is_sbits_typ ctx typ ->
+     AE_val (AV_C_fragment (F_call ("append_sf", [vec1; vec2; v_int n2]), typ, ctyp_of_typ ctx typ))
+
+  | "append", [AV_C_fragment (vec1, _, CT_fbits (n1, ord1)); AV_C_fragment (vec2, _, CT_sbits ord2)]
+       when ord1 = ord2 && is_sbits_typ ctx typ ->
+     AE_val (AV_C_fragment (F_call ("append_fs", [vec1; v_int n1; vec2]), typ, ctyp_of_typ ctx typ))
+
+  | "append", [AV_C_fragment (vec1, _, CT_sbits ord1); AV_C_fragment (vec2, _, CT_sbits ord2)]
+       when ord1 = ord2 && is_sbits_typ ctx typ ->
+     AE_val (AV_C_fragment (F_call ("append_ss", [vec1; vec2]), typ, ctyp_of_typ ctx typ))
+
+  | "undefined_vector", [AV_C_fragment (len, _, _); _] ->
      begin match destruct_vector ctx.tc_env typ with
      | Some (Nexp_aux (Nexp_constant n, _), _, Typ_aux (Typ_id id, _))
           when string_of_id id = "bit" && Big_int.less_equal n (Big_int.of_int 64) ->
-       AE_val (AV_C_fragment (F_lit (V_bit Sail2_values.B0), typ))
+       AE_val (AV_C_fragment (F_lit (V_bit Sail2_values.B0), typ, ctyp_of_typ ctx typ))
      | _ -> no_change
      end
 
-  | "sail_uint", [AV_C_fragment (frag, vtyp)] ->
+  | "sail_unsigned", [AV_C_fragment (frag, vtyp, _)] ->
      begin match destruct_vector ctx.tc_env vtyp with
      | Some (Nexp_aux (Nexp_constant n, _), _, _)
           when Big_int.less_equal n (Big_int.of_int 63) && is_stack_typ ctx typ ->
-        AE_val (AV_C_fragment (frag, typ))
+        AE_val (AV_C_fragment (F_call ("fast_unsigned", [frag]), typ, ctyp_of_typ ctx typ))
      | _ -> no_change
      end
 
-  | "replicate_bits", [AV_C_fragment (vec, vtyp); AV_C_fragment (times, _)] ->
+  | "add_int", [AV_C_fragment (op1, _, _); AV_C_fragment (op2, _, _)] ->
+     begin match destruct_range Env.empty typ with
+     | None -> no_change
+     | Some (kids, constr, n, m) ->
+        match nexp_simp n, nexp_simp m with
+        | Nexp_aux (Nexp_constant n, _), Nexp_aux (Nexp_constant m, _)
+               when Big_int.less_equal min_int64 n && Big_int.less_equal m max_int64 ->
+           AE_val (AV_C_fragment (F_op (op1, "+", op2), typ, CT_int64))
+        | n, m when prove ctx.local_env (nc_lteq (nconstant min_int64) n) && prove ctx.local_env (nc_lteq m (nconstant max_int64)) ->
+           AE_val (AV_C_fragment (F_op (op1, "+", op2), typ, CT_int64))
+        | _ -> no_change
+     end
+
+  | "neg_int", [AV_C_fragment (frag, _, _)] ->
+     AE_val (AV_C_fragment (F_op (v_int 0, "-", frag), typ, CT_int64))
+
+  | "replicate_bits", [AV_C_fragment (vec, vtyp, _); AV_C_fragment (times, _, _)] ->
      begin match destruct_vector ctx.tc_env typ, destruct_vector ctx.tc_env vtyp with
      | Some (Nexp_aux (Nexp_constant n, _), _, _), Some (Nexp_aux (Nexp_constant m, _), _, _)
           when Big_int.less_equal n (Big_int.of_int 64) ->
-        AE_val (AV_C_fragment (F_call ("fast_replicate_bits", [F_lit (V_int m); vec; times]), typ))
+        AE_val (AV_C_fragment (F_call ("fast_replicate_bits", [F_lit (V_int m); vec; times]), typ, ctyp_of_typ ctx typ))
      | _ -> no_change
      end
 
   | "undefined_bool", _ ->
-     AE_val (AV_C_fragment (F_lit (V_bool false), typ))
+     AE_val (AV_C_fragment (F_lit (V_bool false), typ, CT_bool))
 
   | _, _ ->
      c_debug (lazy ("No optimization routine found"));
@@ -552,7 +645,7 @@ let rec instr_ctyps (I_aux (instr, aux)) =
      ctyp :: cval_ctyp cval :: List.concat (List.map instr_ctyps instrs1 @ List.map instr_ctyps instrs2)
   | I_funcall (clexp, _, _, cvals) ->
      clexp_ctyp clexp :: List.map cval_ctyp cvals
-  | I_copy (clexp, cval) -> [clexp_ctyp clexp; cval_ctyp cval]
+  | I_copy (clexp, cval) | I_alias (clexp, cval) -> [clexp_ctyp clexp; cval_ctyp cval]
   | I_block instrs | I_try_block instrs -> List.concat (List.map instr_ctyps instrs)
   | I_throw cval | I_jump (cval, _) | I_return cval -> [cval_ctyp cval]
   | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure -> []
@@ -566,12 +659,15 @@ let cdef_ctyps ctx = function
   | CDEF_reg_dec (_, ctyp, instrs) -> ctyp :: List.concat (List.map instr_ctyps instrs)
   | CDEF_spec (_, ctyps, ctyp) -> ctyp :: ctyps
   | CDEF_fundef (id, _, _, instrs) ->
-     let _, Typ_aux (fn_typ, _) = Env.get_val_spec id ctx.tc_env in
+     let quant, Typ_aux (fn_typ, _) = Env.get_val_spec id ctx.tc_env in
      let arg_typs, ret_typ = match fn_typ with
        | Typ_fn (arg_typs, ret_typ, _) -> arg_typs, ret_typ
        | _ -> assert false
      in
-     let arg_ctyps, ret_ctyp = List.map (ctyp_of_typ ctx) arg_typs, ctyp_of_typ ctx ret_typ in
+     let arg_ctyps, ret_ctyp =
+       List.map (ctyp_of_typ ctx) arg_typs,
+       ctyp_of_typ { ctx with local_env = add_typquant (id_loc id) quant ctx.local_env } ret_typ
+     in
      ret_ctyp :: arg_ctyps @ List.concat (List.map instr_ctyps instrs)
 
   | CDEF_startup (id, instrs) | CDEF_finish (id, instrs) -> List.concat (List.map instr_ctyps instrs)
@@ -614,7 +710,10 @@ let rec chunkify n xs =
   | xs, ys -> xs :: chunkify n ys
 
 let rec compile_aval l ctx = function
-  | AV_C_fragment (frag, typ) ->
+  | AV_C_fragment (frag, typ, ctyp) ->
+     let ctyp' = ctyp_of_typ ctx typ in
+     if not (ctyp_equal ctyp ctyp') then
+       raise (Reporting.err_unreachable l __POS__ (string_of_ctyp ctyp ^ " != " ^ string_of_ctyp ctyp'));
      [], (frag, ctyp_of_typ ctx typ), []
 
   | AV_id (id, typ) ->
@@ -657,6 +756,8 @@ let rec compile_aval l ctx = function
      (F_id gs, CT_real),
      [iclear CT_real gs]
 
+  | AV_lit (L_aux (L_unit, _), _) -> [], (F_lit V_unit, CT_unit), []
+
   | AV_lit (L_aux (_, l) as lit, _) ->
      c_error ~loc:l ("Encountered unexpected literal " ^ string_of_lit lit)
 
@@ -698,9 +799,9 @@ let rec compile_aval l ctx = function
        let len = List.length avals in
        match destruct_vector ctx.tc_env typ with
        | Some (_, Ord_aux (Ord_inc, _), _) ->
-          [], (bitstring, CT_bits64 (len, false)), []
+          [], (bitstring, CT_fbits (len, false)), []
        | Some (_, Ord_aux (Ord_dec, _), _) ->
-          [], (bitstring, CT_bits64 (len, true)), []
+          [], (bitstring, CT_fbits (len, true)), []
        | Some _ ->
           c_error "Encountered order polymorphic bitvector literal"
        | None ->
@@ -715,15 +816,15 @@ let rec compile_aval l ctx = function
      let first_chunk = bitstring (Util.take (len mod 64) avals) in
      let chunks = Util.drop (len mod 64) avals |> chunkify 64 |> List.map bitstring in
      let gs = gensym () in
-     [iinit (CT_bits true) gs (first_chunk, CT_bits64 (len mod 64, true))]
-     @ List.map (fun chunk -> ifuncall (CL_id (gs, CT_bits true))
+     [iinit (CT_lbits true) gs (first_chunk, CT_fbits (len mod 64, true))]
+     @ List.map (fun chunk -> ifuncall (CL_id (gs, CT_lbits true))
                                        (mk_id "append_64")
-                                       [(F_id gs, CT_bits true); (chunk, CT_bits64 (64, true))]) chunks,
-     (F_id gs, CT_bits true),
-     [iclear (CT_bits true) gs]
+                                       [(F_id gs, CT_lbits true); (chunk, CT_fbits (64, true))]) chunks,
+     (F_id gs, CT_lbits true),
+     [iclear (CT_lbits true) gs]
 
   (* If we have a bitvector value, that isn't a literal then we need to set bits individually. *)
-  | AV_vector (avals, Typ_aux (Typ_app (id, [_; Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id bit_id, _)), _)]), _))
+  | AV_vector (avals, Typ_aux (Typ_app (id, [_; A_aux (A_order ord, _); A_aux (A_typ (Typ_aux (Typ_id bit_id, _)), _)]), _))
        when string_of_id bit_id = "bit" && string_of_id id = "vector" && List.length avals <= 64 ->
      let len = List.length avals in
      let direction = match ord with
@@ -732,7 +833,7 @@ let rec compile_aval l ctx = function
        | Ord_aux (Ord_var _, _) -> c_error "Polymorphic vector direction found"
      in
      let gs = gensym () in
-     let ctyp = CT_bits64 (len, direction) in
+     let ctyp = CT_fbits (len, direction) in
      let mask i = V_bits (Util.list_init (63 - i) (fun _ -> Sail2_values.B0) @ [Sail2_values.B1] @ Util.list_init i (fun _ -> Sail2_values.B0)) in
      let aval_mask i aval =
        let setup, cval, cleanup = compile_aval l ctx aval in
@@ -750,7 +851,7 @@ let rec compile_aval l ctx = function
      []
 
   (* Compiling a vector literal that isn't a bitvector *)
-  | AV_vector (avals, Typ_aux (Typ_app (id, [_; Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ typ, _)]), _))
+  | AV_vector (avals, Typ_aux (Typ_app (id, [_; A_aux (A_order ord, _); A_aux (A_typ typ, _)]), _))
        when string_of_id id = "vector" ->
      let len = List.length avals in
      let direction = match ord with
@@ -779,7 +880,7 @@ let rec compile_aval l ctx = function
 
   | AV_list (avals, Typ_aux (typ, _)) ->
      let ctyp = match typ with
-       | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) when string_of_id id = "list" -> ctyp_of_typ ctx typ
+       | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" -> ctyp_of_typ ctx typ
        | _ -> c_error "Invalid list type"
      in
      let gs = gensym () in
@@ -954,8 +1055,8 @@ let pointer_assign ctyp1 ctyp2 =
 let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
   let ctx = { ctx with local_env = env } in
   match aexp_aux with
-  | AE_let (mut, id, binding_typ, binding, body, body_typ) ->
-     let binding_ctyp = ctyp_of_typ ctx binding_typ in
+  | AE_let (mut, id, binding_typ, binding, (AE_aux (_, body_env, _) as body), body_typ) ->
+     let binding_ctyp = ctyp_of_typ { ctx with local_env = body_env } binding_typ in
      let setup, call, cleanup = compile_aexp ctx binding in
      let letb_setup, letb_cleanup =
        [idecl binding_ctyp id; iblock (setup @ [call (CL_id (id, binding_ctyp))] @ cleanup)], [iclear binding_ctyp id]
@@ -980,7 +1081,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      let compile_case (apat, guard, body) =
        let trivial_guard = match guard with
          | AE_aux (AE_val (AV_lit (L_aux (L_true, _), _)), _, _)
-         | AE_aux (AE_val (AV_C_fragment (F_lit (V_bool true), _)), _, _) -> true
+         | AE_aux (AE_val (AV_C_fragment (F_lit (V_bool true), _, _)), _, _) -> true
          | _ -> false
        in
        let case_label = label "case_" in
@@ -1021,7 +1122,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      let compile_case (apat, guard, body) =
        let trivial_guard = match guard with
          | AE_aux (AE_val (AV_lit (L_aux (L_true, _), _)), _, _)
-         | AE_aux (AE_val (AV_C_fragment (F_lit (V_bool true), _)), _, _) -> true
+         | AE_aux (AE_val (AV_C_fragment (F_lit (V_bool true), _, _)), _, _) -> true
          | _ -> false
        in
        let try_label = label "try_" in
@@ -1134,7 +1235,11 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      []
 
   | AE_assign (id, assign_typ, aexp) ->
-     let assign_ctyp = ctyp_of_typ ctx assign_typ in
+     let assign_ctyp =
+       match Bindings.find_opt id ctx.locals with
+       | Some (_, ctyp) -> ctyp
+       | None -> ctyp_of_typ ctx assign_typ
+     in
      let setup, call, cleanup = compile_aexp ctx aexp in
      setup @ [call (CL_id (id, assign_ctyp))], (fun clexp -> icopy l clexp unit_fragment), cleanup
 
@@ -1224,14 +1329,8 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      cleanup
 
   | AE_for (loop_var, loop_from, loop_to, loop_step, Ord_aux (ord, _), body) ->
-     (* This is a bit of a hack, we force loop_var to be CT_int64 by
-        forcing it's type to be a known nexp that will map to
-        CT_int64. *)
-     let make_small _ _ = function
-       | AV_id (id, Local (Immutable, typ)) when Id.compare id loop_var = 0 -> AV_id (id, Local (Immutable, atom_typ (nint 0)))
-       | aval -> aval
-     in
-     let body = map_aval make_small body in
+     (* We assume that all loop indices are safe to put in a CT_int64. *)
+     let ctx = { ctx with locals = Bindings.add loop_var (Immutable, CT_int64) ctx.locals } in
 
      let is_inc = match ord with
        | Ord_inc -> true
@@ -1471,7 +1570,7 @@ let rec map_try_block f (I_aux (instr, aux)) =
     | I_decl _ | I_reset _ | I_init _ | I_reinit _ -> instr
     | I_if (cval, instrs1, instrs2, ctyp) ->
        I_if (cval, List.map (map_try_block f) instrs1, List.map (map_try_block f) instrs2, ctyp)
-    | I_funcall _ | I_copy _ | I_clear _ | I_throw _ | I_return _ -> instr
+    | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_throw _ | I_return _ -> instr
     | I_block instrs -> I_block (List.map (map_try_block f) instrs)
     | I_try_block instrs -> I_try_block (f (List.map (map_try_block f) instrs))
     | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_jump _ | I_match_failure | I_undefined _ -> instr
@@ -1570,7 +1669,18 @@ let rec compile_def ctx = function
      let aexp = no_shadow (pat_ids pat) (anf exp) in
      c_debug (lazy (Pretty_print_sail.to_string (pp_aexp aexp)));
      let aexp = analyze_functions ctx analyze_primop (c_literals ctx aexp) in
-     c_debug (lazy (Pretty_print_sail.to_string (pp_aexp aexp)));
+
+     if Id.compare (mk_id !opt_debug_function) id = 0 then
+       let header =
+         Printf.sprintf "Sail ANF for %s %s %s. (%s) -> %s" Util.("function" |> red |> clear) (string_of_id id)
+                        (string_of_typquant quant)
+                        Util.(string_of_list ", " (fun typ -> string_of_typ typ |> yellow |> clear) arg_typs)
+                        Util.(string_of_typ ret_typ |> yellow |> clear)
+
+       in
+       prerr_endline (Util.header header (List.length arg_typs + 2));
+       prerr_endline (Pretty_print_sail.to_string (pp_aexp aexp))
+     else ();
 
      (* Compile the function arguments as patterns. *)
      let arg_setup, compiled_args, arg_cleanup = compile_arg_pats ctx fundef_label pat arg_ctyps in
@@ -1617,7 +1727,7 @@ let rec compile_def ctx = function
 
   | DEF_val (LB_aux (LB_val (pat, exp), _)) ->
      c_debug (lazy ("Compiling letbind " ^ string_of_pat pat));
-     let ctyp = ctyp_of_typ ctx (pat_typ_of pat) in
+     let ctyp = ctyp_of_typ ctx (typ_of_pat pat) in
      let aexp = analyze_functions ctx analyze_primop (c_literals ctx (no_shadow IdSet.empty (anf exp))) in
      let setup, call, cleanup = compile_aexp ctx aexp in
      let apat = anf_pat ~global:true pat in
@@ -1714,6 +1824,7 @@ let rec instrs_rename from_id to_id =
   | I_aux (I_funcall (clexp, extern, id, cvals), aux) :: instrs ->
      I_aux (I_funcall (lrename clexp, extern, rename id, List.map crename cvals), aux) :: irename instrs
   | I_aux (I_copy (clexp, cval), aux) :: instrs -> I_aux (I_copy (lrename clexp, crename cval), aux) :: irename instrs
+  | I_aux (I_alias (clexp, cval), aux) :: instrs -> I_aux (I_alias (lrename clexp, crename cval), aux) :: irename instrs
   | I_aux (I_clear (ctyp, id), aux) :: instrs -> I_aux (I_clear (ctyp, rename id), aux) :: irename instrs
   | I_aux (I_return cval, aux) :: instrs -> I_aux (I_return (crename cval), aux) :: irename instrs
   | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (irename block), aux) :: irename instrs
@@ -1723,7 +1834,7 @@ let rec instrs_rename from_id to_id =
   | [] -> []
 
 let hoist_ctyp = function
-  | CT_int | CT_bits _ | CT_struct _ -> true
+  | CT_int | CT_lbits _ | CT_struct _ -> true
   | _ -> false
 
 let hoist_counter = ref 0
@@ -1784,39 +1895,39 @@ let flat_id () =
   incr flat_counter;
   id
 
-let flatten_instrs =
-  let rec flatten = function
-    | I_aux (I_decl (ctyp, decl_id), aux) :: instrs ->
-       let fid = flat_id () in
-       I_aux (I_decl (ctyp, fid), aux) :: flatten (instrs_rename decl_id fid instrs)
-
-    | I_aux ((I_block block | I_try_block block), _) :: instrs ->
-       flatten block @ flatten instrs
-
-    | I_aux (I_if (cval, then_instrs, else_instrs, _), _) :: instrs ->
-       let then_label = label "then_" in
-       let endif_label = label "endif_" in
-       [ijump cval then_label]
-       @ flatten else_instrs
-       @ [igoto endif_label]
-       @ [ilabel then_label]
-       @ flatten then_instrs
-       @ [ilabel endif_label]
-       @ flatten instrs
-
-    | I_aux (I_comment _, _) :: instrs -> flatten instrs
-
-    | instr :: instrs -> instr :: flatten instrs
-    | [] -> []
-  in
+let rec flatten_instrs = function
+  | I_aux (I_decl (ctyp, decl_id), aux) :: instrs ->
+     let fid = flat_id () in
+     I_aux (I_decl (ctyp, fid), aux) :: flatten_instrs (instrs_rename decl_id fid instrs)
+
+  | I_aux ((I_block block | I_try_block block), _) :: instrs ->
+     flatten_instrs block @ flatten_instrs instrs
+
+  | I_aux (I_if (cval, then_instrs, else_instrs, _), _) :: instrs ->
+     let then_label = label "then_" in
+     let endif_label = label "endif_" in
+     [ijump cval then_label]
+     @ flatten_instrs else_instrs
+     @ [igoto endif_label]
+     @ [ilabel then_label]
+     @ flatten_instrs then_instrs
+     @ [ilabel endif_label]
+     @ flatten_instrs instrs
+
+  | I_aux (I_comment _, _) :: instrs -> flatten_instrs instrs
+
+  | instr :: instrs -> instr :: flatten_instrs instrs
+  | [] -> []
+
+let flatten_cdef =
   function
   | CDEF_fundef (function_id, heap_return, args, body) ->
      flat_counter := 0;
-     CDEF_fundef (function_id, heap_return, args, flatten body)
+     CDEF_fundef (function_id, heap_return, args, flatten_instrs body)
 
   | CDEF_let (n, bindings, instrs) ->
     flat_counter := 0;
-    CDEF_let (n, bindings, flatten instrs)
+    CDEF_let (n, bindings, flatten_instrs instrs)
 
   | cdef -> cdef
 
@@ -1947,75 +2058,299 @@ let sort_ctype_defs cdefs =
 
   ctype_defs @ cdefs
 
-              (*
-(* When this optimization fires we know we have bytecode of the form
-
-   recreate x : S; x = y; ...
-
-   when this continues with x.A = a, x.B = b etc until y = x. Then
-   provided there are no further references to x we can eliminate
-   the variable x.
-
-   Must be called after hoist_allocations, otherwise does nothing. *)
-let fix_struct_updates ctx =
-  (* FIXME need to check no remaining references *)
-  let rec fix_updates struct_id id = function
-    | I_aux (I_copy (CL_field (struct_id', field, ctyp), cval), aux) :: instrs
-         when Id.compare struct_id struct_id' = 0 ->
-       Util.option_map (fun instrs -> I_aux (I_copy (CL_field (id, field, ctyp), cval), aux) :: instrs) (fix_updates struct_id id instrs)
-    | I_aux (I_copy (CL_id id', (F_id struct_id', ctyp)), aux) :: instrs
-         when Id.compare struct_id struct_id' = 0 && Id.compare id id' = 0->
-       Some instrs
-    | _ -> None
+let removed = icomment "REMOVED"
+
+let is_not_removed = function
+  | I_aux (I_comment "REMOVED", _) -> false
+  | _ -> true
+
+(** This optimization looks for patterns of the form:
+
+    create x : t;
+    x = y;
+    // modifications to x, and no changes to y
+    y = x;
+    // no further changes to x
+    kill x;
+
+    If found, we can remove the variable x, and directly modify y instead. *)
+let remove_alias ctx =
+  let pattern ctyp id =
+    let alias = ref None in
+    let rec scan ctyp id n instrs =
+      match n, !alias, instrs with
+      | 0, None, I_aux (I_copy (CL_id (id', ctyp'), (F_id a, ctyp'')), _) :: instrs
+           when Id.compare id id' = 0 && ctyp_equal ctyp ctyp' && ctyp_equal ctyp' ctyp'' ->
+         alias := Some a;
+         scan ctyp id 1 instrs
+
+      | 1, Some a, I_aux (I_copy (CL_id (a', ctyp'), (F_id id', ctyp'')), _) :: instrs
+           when Id.compare a a' = 0 && Id.compare id id' = 0 && ctyp_equal ctyp ctyp' && ctyp_equal ctyp' ctyp'' ->
+         scan ctyp id 2 instrs
+
+      | 1, Some a, instr :: instrs ->
+         if IdSet.mem a (instr_ids instr) then
+           None
+         else
+           scan ctyp id 1 instrs
+
+      | 2, Some a, I_aux (I_clear (ctyp', id'), _) :: instrs
+           when Id.compare id id' = 0 && ctyp_equal ctyp ctyp' ->
+         scan ctyp id 2 instrs
+
+      | 2, Some a, instr :: instrs ->
+         if IdSet.mem id (instr_ids instr) then
+           None
+         else
+           scan ctyp id 2 instrs
+
+      | 2, Some a, [] -> !alias
+
+      | n, _, _ :: instrs when n = 0 || n > 2 -> scan ctyp id n instrs
+      | _, _, I_aux (_, (_, l)) :: instrs -> raise (Reporting.err_unreachable l __POS__ "optimize_alias")
+      | _, _, [] -> None
+    in
+    scan ctyp id 0
   in
-  let rec fix_updates_ret struct_id id = function
-    | I_aux (I_copy (CL_field (struct_id', field, ctyp), cval), aux) :: instrs
-         when Id.compare struct_id struct_id' = 0 ->
-       Util.option_map (fun instrs -> I_aux (I_copy (CL_addr_field (id, field, ctyp), cval), aux) :: instrs) (fix_updates_ret struct_id id instrs)
-    | I_aux (I_copy (CL_addr id', (F_id struct_id', ctyp)), aux) :: instrs
-         when Id.compare struct_id struct_id' = 0 && Id.compare id id' = 0->
-       Some instrs
-    | _ -> None
+  let remove_alias id alias = function
+    | I_aux (I_copy (CL_id (id', _), (F_id alias', _)), _)
+         when Id.compare id id' = 0 && Id.compare alias alias' = 0 -> removed
+    | I_aux (I_copy (CL_id (alias', _), (F_id id', _)), _)
+         when Id.compare id id' = 0 && Id.compare alias alias' = 0 -> removed
+    | I_aux (I_clear (_, id'), _) -> removed
+    | instr -> instr
   in
-  let rec opt hr = function
-    | (I_aux (I_reset (ctyp, struct_id), _) as instr1)
-      :: (I_aux (I_copy (CL_id (struct_id', _), (F_id id, ctyp')), _) as instr2)
-      :: instrs
-         when is_ct_struct ctyp && ctyp_equal ctyp ctyp' && Id.compare struct_id struct_id' = 0 ->
-       begin match fix_updates struct_id id instrs with
-       | None -> instr1 :: instr2 :: opt hr instrs
-       | Some updated -> opt hr updated
+  let rec opt = function
+    | I_aux (I_decl (ctyp, id), _) as instr :: instrs ->
+       begin match pattern ctyp id instrs with
+       | None -> instr :: opt instrs
+       | Some alias ->
+          let instrs = List.map (map_instr (remove_alias id alias)) instrs in
+          filter_instrs is_not_removed (List.map (instr_rename id alias) instrs)
        end
 
-    | (I_aux (I_reset (ctyp, struct_id), _) as instr) :: instrs
-         when is_ct_struct ctyp && Util.is_some hr ->
-       let id = match hr with Some id -> id | None -> assert false in
-       begin match fix_updates_ret struct_id id instrs with
-       | None -> instr :: opt hr instrs
-       | Some updated -> opt hr updated
+    | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (opt block), aux) :: opt instrs
+    | I_aux (I_try_block block, aux) :: instrs -> I_aux (I_try_block (opt block), aux) :: opt instrs
+    | I_aux (I_if (cval, then_instrs, else_instrs, ctyp), aux) :: instrs ->
+       I_aux (I_if (cval, opt then_instrs, opt else_instrs, ctyp), aux) :: opt instrs
+
+    | instr :: instrs ->
+       instr :: opt instrs
+    | [] -> []
+  in
+  function
+  | CDEF_fundef (function_id, heap_return, args, body) ->
+     [CDEF_fundef (function_id, heap_return, args, opt body)]
+  | cdef -> [cdef]
+
+
+(** This pass ensures that all variables created by I_decl have unique names *)
+let unique_names =
+  let unique_counter = ref 0 in
+  let unique_id () =
+    let id = mk_id ("u#" ^ string_of_int !unique_counter) in
+    incr unique_counter;
+    id
+  in
+
+  let rec opt seen = function
+    | I_aux (I_decl (ctyp, id), aux) :: instrs when IdSet.mem id seen ->
+       let id' = unique_id () in
+       let instrs', seen = opt seen instrs in
+       I_aux (I_decl (ctyp, id'), aux) :: instrs_rename id id' instrs', seen
+
+    | I_aux (I_decl (ctyp, id), aux) :: instrs ->
+       let instrs', seen = opt (IdSet.add id seen) instrs in
+       I_aux (I_decl (ctyp, id), aux) :: instrs', seen
+
+    | I_aux (I_block block, aux) :: instrs ->
+       let block', seen = opt seen block in
+       let instrs', seen = opt seen instrs in
+       I_aux (I_block block', aux) :: instrs', seen
+
+    | I_aux (I_try_block block, aux) :: instrs ->
+       let block', seen = opt seen block in
+       let instrs', seen = opt seen instrs in
+       I_aux (I_try_block block', aux) :: instrs', seen
+
+    | I_aux (I_if (cval, then_instrs, else_instrs, ctyp), aux) :: instrs ->
+       let then_instrs', seen = opt seen then_instrs in
+       let else_instrs', seen = opt seen else_instrs in
+       let instrs', seen = opt seen instrs in
+       I_aux (I_if (cval, then_instrs', else_instrs', ctyp), aux) :: instrs', seen
+
+    | instr :: instrs ->
+       let instrs', seen = opt seen instrs in
+       instr :: instrs', seen
+
+    | [] -> [], seen
+  in
+  function
+  | CDEF_fundef (function_id, heap_return, args, body) ->
+     [CDEF_fundef (function_id, heap_return, args, fst (opt IdSet.empty body))]
+  | CDEF_reg_dec (id, ctyp, instrs) ->
+     [CDEF_reg_dec (id, ctyp, fst (opt IdSet.empty instrs))]
+  | CDEF_let (n, bindings, instrs) ->
+     [CDEF_let (n, bindings, fst (opt IdSet.empty instrs))]
+  | cdef -> [cdef]
+
+(** This optimization looks for patterns of the form
+
+    create x : t;
+    create y : t;
+    // modifications to y, no changes to x
+    x = y;
+    kill y;
+
+    If found we can replace y by x *)
+let combine_variables ctx =
+  let pattern ctyp id =
+    let combine = ref None in
+    let rec scan id n instrs =
+      match n, !combine, instrs with
+      | 0, None, I_aux (I_block block, _) :: instrs ->
+         begin match scan id 0 block with
+         | Some combine -> Some combine
+         | None -> scan id 0 instrs
+         end
+
+      | 0, None, I_aux (I_decl (ctyp', id'), _) :: instrs when ctyp_equal ctyp ctyp' ->
+         combine := Some id';
+         scan id 1 instrs
+
+      | 1, Some c, I_aux (I_copy (CL_id (id', ctyp'), (F_id c', ctyp'')), _) :: instrs
+           when Id.compare c c' = 0 && Id.compare id id' = 0 && ctyp_equal ctyp ctyp' && ctyp_equal ctyp' ctyp'' ->
+         scan id 2 instrs
+
+      (* Ignore seemingly early clears of x, as this can happen along exception paths *)
+      | 1, Some c, I_aux (I_clear (_, id'), _) :: instrs
+           when Id.compare id id' = 0 ->
+         scan id 1 instrs
+
+      | 1, Some c, instr :: instrs ->
+         if IdSet.mem id (instr_ids instr) then
+           None
+         else
+           scan id 1 instrs
+
+      | 2, Some c, I_aux (I_clear (ctyp', c'), _) :: instrs
+           when Id.compare c c' = 0 && ctyp_equal ctyp ctyp' ->
+         !combine
+
+      | 2, Some c, instr :: instrs ->
+         if IdSet.mem c (instr_ids instr) then
+           None
+         else
+           scan id 2 instrs
+
+      | 2, Some c, [] -> !combine
+
+      | n, _, _ :: instrs -> scan id n instrs
+      | _, _, [] -> None
+    in
+    scan id 0
+  in
+  let remove_variable id = function
+    | I_aux (I_decl (_, id'), _) when Id.compare id id' = 0 -> removed
+    | I_aux (I_clear (_, id'), _) when Id.compare id id' = 0 -> removed
+    | instr -> instr
+  in
+  let is_not_self_assignment = function
+    | I_aux (I_copy (CL_id (id, _), (F_id id', _)), _) when Id.compare id id' = 0 -> false
+    | _ -> true
+  in
+  let rec opt = function
+    | (I_aux (I_decl (ctyp, id), _) as instr) :: instrs ->
+       begin match pattern ctyp id instrs with
+       | None -> instr :: opt instrs
+       | Some combine ->
+          let instrs = List.map (map_instr (remove_variable combine)) instrs in
+          let instrs = filter_instrs (fun i -> is_not_removed i && is_not_self_assignment i)
+                                     (List.map (instr_rename combine id) instrs) in
+          opt (instr :: instrs)
        end
 
-    | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (opt hr block), aux) :: opt hr instrs
-    | I_aux (I_try_block block, aux) :: instrs -> I_aux (I_try_block (opt hr block), aux) :: opt hr instrs
+    | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (opt block), aux) :: opt instrs
+    | I_aux (I_try_block block, aux) :: instrs -> I_aux (I_try_block (opt block), aux) :: opt instrs
     | I_aux (I_if (cval, then_instrs, else_instrs, ctyp), aux) :: instrs ->
-       I_aux (I_if (cval, opt hr then_instrs, opt hr else_instrs, ctyp), aux) :: opt hr instrs
+       I_aux (I_if (cval, opt then_instrs, opt else_instrs, ctyp), aux) :: opt instrs
 
-    | instr :: instrs -> instr :: opt hr instrs
+    | instr :: instrs ->
+       instr :: opt instrs
     | [] -> []
   in
   function
   | CDEF_fundef (function_id, heap_return, args, body) ->
-     [CDEF_fundef (function_id, heap_return, args, opt heap_return body)]
+     [CDEF_fundef (function_id, heap_return, args, opt body)]
+  | cdef -> [cdef]
+
+(** hoist_alias looks for patterns like
+
+    recreate x; y = x; // no furthner mentions of x
+
+    Provided x has a certain type, then we can make y an alias to x
+    (denoted in the IR as 'alias y = x'). This only works if y also has
+    a lifespan that also spans the entire function body. It's possible
+    we may need to do a more thorough lifetime evaluation to get this
+    to be 100% correct - so it's behind the -Oexperimental flag
+    for now. Some benchmarking shows that this kind of optimization
+    is very valuable however! *)
+let hoist_alias ctx =
+  (* Must return true for a subset of the types hoist_ctyp would return true for. *)
+  let is_struct = function
+    | CT_struct _ -> true
+    | _ -> false
+  in
+  let pattern heap_return id ctyp instrs =
+    let rec scan instrs =
+      match instrs with
+      (* The only thing that has a longer lifetime than id is the
+         function return, so we want to make sure we avoid that
+         case. *)
+      | (I_aux (I_copy (clexp, (F_id id', ctyp')), aux) as instr) :: instrs
+           when not (IdSet.mem heap_return (instr_writes instr)) && Id.compare id id' = 0
+                && ctyp_equal (clexp_ctyp clexp) ctyp && ctyp_equal ctyp ctyp' ->
+         if List.exists (IdSet.mem id) (List.map instr_ids instrs) then
+           instr :: scan instrs
+         else
+           I_aux (I_alias (clexp, (F_id id', ctyp')), aux) :: instrs
+
+      | instr :: instrs -> instr :: scan instrs
+      | [] -> []
+    in
+    scan instrs
+  in
+  let optimize heap_return =
+    let rec opt = function
+      | (I_aux (I_reset (ctyp, id), _) as instr) :: instrs when not (is_stack_ctyp ctyp) && is_struct ctyp ->
+         instr :: opt (pattern heap_return id ctyp instrs)
+
+      | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (opt block), aux) :: opt instrs
+      | I_aux (I_try_block block, aux) :: instrs -> I_aux (I_try_block (opt block), aux) :: opt instrs
+      | I_aux (I_if (cval, then_instrs, else_instrs, ctyp), aux) :: instrs ->
+         I_aux (I_if (cval, opt then_instrs, opt else_instrs, ctyp), aux) :: opt instrs
+
+      | instr :: instrs ->
+         instr :: opt instrs
+      | [] -> []
+    in
+    opt
+  in
+  function
+  | CDEF_fundef (function_id, Some heap_return, args, body) ->
+     [CDEF_fundef (function_id, Some heap_return, args, optimize heap_return body)]
   | cdef -> [cdef]
-               *)
 
 let concatMap f xs = List.concat (List.map f xs)
 
 let optimize ctx cdefs =
   let nothing cdefs = cdefs in
   cdefs
+  |> (if !optimize_alias then concatMap unique_names else nothing)
+  |> (if !optimize_alias then concatMap (remove_alias ctx) else nothing)
+  |> (if !optimize_alias then concatMap (combine_variables ctx) else nothing)
   |> (if !optimize_hoist_allocations then concatMap (hoist_allocations ctx) else nothing)
-(* |> (if !optimize_struct_updates then concatMap (fix_struct_updates ctx) else nothing) *)
+  |> (if !optimize_hoist_allocations && !optimize_experimental then concatMap (hoist_alias ctx) else nothing)
 
 (**************************************************************************)
 (* 6. Code generation                                                     *)
@@ -2026,12 +2361,13 @@ let codegen_id id = string (sgen_id id)
 
 let rec sgen_ctyp = function
   | CT_unit -> "unit"
-  | CT_bit -> "mach_bits"
+  | CT_bit -> "fbits"
   | CT_bool -> "bool"
-  | CT_bits64 _ -> "mach_bits"
+  | CT_fbits _ -> "fbits"
+  | CT_sbits _ -> "sbits"
   | CT_int64 -> "mach_int"
   | CT_int -> "sail_int"
-  | CT_bits _ -> "sail_bits"
+  | CT_lbits _ -> "lbits"
   | CT_tup _ as tup -> "struct " ^ Util.zencode_string ("tuple_" ^ string_of_ctyp tup)
   | CT_struct (id, _) -> "struct " ^ sgen_id id
   | CT_enum (id, _) -> "enum " ^ sgen_id id
@@ -2045,12 +2381,13 @@ let rec sgen_ctyp = function
 
 let rec sgen_ctyp_name = function
   | CT_unit -> "unit"
-  | CT_bit -> "mach_bits"
+  | CT_bit -> "fbits"
   | CT_bool -> "bool"
-  | CT_bits64 _ -> "mach_bits"
+  | CT_fbits _ -> "fbits"
+  | CT_sbits _ -> "sbits"
   | CT_int64 -> "mach_int"
   | CT_int -> "sail_int"
-  | CT_bits _ -> "sail_bits"
+  | CT_lbits _ -> "lbits"
   | CT_tup _ as tup -> Util.zencode_string ("tuple_" ^ string_of_ctyp tup)
   | CT_struct (id, _) -> sgen_id id
   | CT_enum (id, _) -> sgen_id id
@@ -2064,9 +2401,11 @@ let rec sgen_ctyp_name = function
 
 let sgen_cval_param (frag, ctyp) =
   match ctyp with
-  | CT_bits direction ->
+  | CT_lbits direction ->
+     string_of_fragment frag ^ ", " ^ string_of_bool direction
+  | CT_sbits direction ->
      string_of_fragment frag ^ ", " ^ string_of_bool direction
-  | CT_bits64 (len, direction) ->
+  | CT_fbits (len, direction) ->
      string_of_fragment frag ^ ", UINT64_C(" ^ string_of_int len ^ ") , " ^ string_of_bool direction
   | _ ->
      string_of_fragment frag
@@ -2077,7 +2416,7 @@ let rec sgen_clexp = function
   | CL_id (id, _) -> "&" ^ sgen_id id
   | CL_field (clexp, field) -> "&((" ^ sgen_clexp clexp ^ ")->" ^ Util.zencode_string field ^ ")"
   | CL_tuple (clexp, n) -> "&((" ^ sgen_clexp clexp ^ ")->ztup" ^ string_of_int n ^ ")"
-  | CL_addr clexp -> "*(" ^ sgen_clexp clexp ^ ")"
+  | CL_addr clexp -> "(*(" ^ sgen_clexp clexp ^ "))"
   | CL_have_exception -> "have_exception"
   | CL_current_exception _ -> "current_exception"
 
@@ -2085,7 +2424,7 @@ let rec sgen_clexp_pure = function
   | CL_id (id, _) -> sgen_id id
   | CL_field (clexp, field) -> sgen_clexp_pure clexp ^ "." ^ Util.zencode_string field
   | CL_tuple (clexp, n) -> sgen_clexp_pure clexp ^ ".ztup" ^ string_of_int n
-  | CL_addr clexp -> "*(" ^ sgen_clexp_pure clexp ^ ")"
+  | CL_addr clexp -> "(*(" ^ sgen_clexp_pure clexp ^ "))"
   | CL_have_exception -> "have_exception"
   | CL_current_exception _ -> "current_exception"
 
@@ -2138,6 +2477,9 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
 
   | I_copy (clexp, cval) -> codegen_conversion l clexp cval
 
+  | I_alias (clexp, cval) ->
+     ksprintf string "  %s = %s;" (sgen_clexp_pure clexp) (sgen_cval cval)
+
   | I_jump (cval, label) ->
      ksprintf string "  if (%s) goto %s;" (sgen_cval cval) label
 
@@ -2146,12 +2488,12 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
      ^^ twice space ^^ codegen_instr fid ctx then_instr
   | I_if (cval, then_instrs, [], ctyp) ->
      string "  if" ^^ space ^^ parens (string (sgen_cval cval)) ^^ space
-     ^^ surround 2 0 lbrace (separate_map hardline (codegen_instr fid ctx) then_instrs) (twice space ^^ rbrace)
+     ^^ surround 0 0 lbrace (separate_map hardline (codegen_instr fid ctx) then_instrs) (twice space ^^ rbrace)
   | I_if (cval, then_instrs, else_instrs, ctyp) ->
      string "  if" ^^ space ^^ parens (string (sgen_cval cval)) ^^ space
-     ^^ surround 2 0 lbrace (separate_map hardline (codegen_instr fid ctx) then_instrs) (twice space ^^ rbrace)
+     ^^ surround 0 0 lbrace (separate_map hardline (codegen_instr fid ctx) then_instrs) (twice space ^^ rbrace)
      ^^ space ^^ string "else" ^^ space
-     ^^ surround 2 0 lbrace (separate_map hardline (codegen_instr fid ctx) else_instrs) (twice space ^^ rbrace)
+     ^^ surround 0 0 lbrace (separate_map hardline (codegen_instr fid ctx) else_instrs) (twice space ^^ rbrace)
 
   | I_block instrs ->
      string "  {"
@@ -2195,30 +2537,32 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
           end
        | "vector_update_subrange", _ -> Printf.sprintf "vector_update_subrange_%s" (sgen_ctyp_name ctyp)
        | "vector_subrange", _ -> Printf.sprintf "vector_subrange_%s" (sgen_ctyp_name ctyp)
-       | "vector_update", CT_bits64 _ -> "update_mach_bits"
-       | "vector_update", CT_bits _ -> "update_sail_bits"
+       | "vector_update", CT_fbits _ -> "update_fbits"
+       | "vector_update", CT_lbits _ -> "update_lbits"
        | "vector_update", _ -> Printf.sprintf "vector_update_%s" (sgen_ctyp_name ctyp)
        | "string_of_bits", _ ->
           begin match cval_ctyp (List.nth args 0) with
-          | CT_bits64 _ -> "string_of_mach_bits"
-          | CT_bits _ -> "string_of_sail_bits"
+          | CT_fbits _ -> "string_of_fbits"
+          | CT_lbits _ -> "string_of_lbits"
           | _ -> assert false
           end
        | "decimal_string_of_bits", _ ->
           begin match cval_ctyp (List.nth args 0) with
-          | CT_bits64 _ -> "decimal_string_of_mach_bits"
-          | CT_bits _ -> "decimal_string_of_sail_bits"
+          | CT_fbits _ -> "decimal_string_of_fbits"
+          | CT_lbits _ -> "decimal_string_of_lbits"
           | _ -> assert false
           end
        | "internal_vector_update", _ -> Printf.sprintf "internal_vector_update_%s" (sgen_ctyp_name ctyp)
        | "internal_vector_init", _ -> Printf.sprintf "internal_vector_init_%s" (sgen_ctyp_name ctyp)
-       | "undefined_vector", CT_bits64 _ -> "UNDEFINED(mach_bits)"
-       | "undefined_vector", CT_bits _ -> "UNDEFINED(sail_bits)"
-       | "undefined_bit", _ -> "UNDEFINED(mach_bits)"
+       | "undefined_vector", CT_fbits _ -> "UNDEFINED(fbits)"
+       | "undefined_vector", CT_lbits _ -> "UNDEFINED(lbits)"
+       | "undefined_bit", _ -> "UNDEFINED(fbits)"
        | "undefined_vector", _ -> Printf.sprintf "UNDEFINED(vector_%s)" (sgen_ctyp_name ctyp)
        | fname, _ -> fname
      in
-     if fname = "reg_deref" then
+     if fname = "sail_assert" && !optimize_experimental then
+       empty
+     else if fname = "reg_deref" then
        if is_stack_ctyp ctyp then
          string (Printf.sprintf  " %s = *(%s);" (sgen_clexp_pure x) c_args)
        else
@@ -2234,26 +2578,13 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
   | I_clear (ctyp, id) ->
      string (Printf.sprintf "  KILL(%s)(&%s);" (sgen_ctyp_name ctyp) (sgen_id id))
 
-  | I_init (ctyp, id, cval) when is_stack_ctyp ctyp ->
-     if ctyp_equal ctyp (cval_ctyp cval) then
-       ksprintf string "  %s %s = %s;" (sgen_ctyp ctyp) (sgen_id id) (sgen_cval cval)
-     else
-       ksprintf string "  %s %s = CREATE_OF(%s, %s)(%s);"
-                (sgen_ctyp ctyp) (sgen_id id) (sgen_ctyp_name ctyp) (sgen_ctyp_name (cval_ctyp cval)) (sgen_cval cval)
   | I_init (ctyp, id, cval) ->
-     ksprintf string "  %s %s;" (sgen_ctyp ctyp) (sgen_id id) ^^ hardline
-     ^^ ksprintf string "  CREATE_OF(%s, %s)(&%s, %s);"
-                 (sgen_ctyp_name ctyp) (sgen_ctyp_name (cval_ctyp cval)) (sgen_id id) (sgen_cval_param cval)
+     codegen_instr fid ctx (idecl ctyp id) ^^ hardline
+     ^^ codegen_conversion Parse_ast.Unknown (CL_id (id, ctyp)) cval
 
-  | I_reinit (ctyp, id, cval) when is_stack_ctyp ctyp ->
-     if ctyp_equal ctyp (cval_ctyp cval) then
-       ksprintf string "  %s %s = %s;" (sgen_ctyp ctyp) (sgen_id id) (sgen_cval cval)
-     else
-       ksprintf string "  %s %s = CREATE_OF(%s, %s)(%s);"
-                (sgen_ctyp ctyp) (sgen_id id) (sgen_ctyp_name ctyp) (sgen_ctyp_name (cval_ctyp cval)) (sgen_cval cval)
   | I_reinit (ctyp, id, cval) ->
-     ksprintf string "  RECREATE_OF(%s, %s)(&%s, %s);"
-              (sgen_ctyp_name ctyp) (sgen_ctyp_name (cval_ctyp cval)) (sgen_id id) (sgen_cval_param cval)
+     codegen_instr fid ctx (ireset ctyp id) ^^ hardline
+     ^^ codegen_conversion Parse_ast.Unknown (CL_id (id, ctyp)) cval
 
   | I_reset (ctyp, id) when is_stack_ctyp ctyp ->
      string (Printf.sprintf "  %s %s;" (sgen_ctyp ctyp) (sgen_id id))
@@ -2272,7 +2603,8 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
        | CT_unit -> "UNIT", []
        | CT_bit -> "UINT64_C(0)", []
        | CT_int64 -> "INT64_C(0xdeadc0de)", []
-       | CT_bits64 _ -> "UINT64_C(0xdeadc0de)", []
+       | CT_fbits _ -> "UINT64_C(0xdeadc0de)", []
+       | CT_sbits _ -> "undefined_sbits()", []
        | CT_bool -> "false", []
        | CT_enum (_, ctor :: _) -> sgen_id ctor, [] 
        | CT_tup ctyps when is_stack_ctyp ctyp ->
@@ -2716,7 +3048,7 @@ let codegen_vector ctx (direction, ctyp) =
       ^^ string (Printf.sprintf "  rop->data = malloc(len * sizeof(%s));\n" (sgen_ctyp ctyp))
       ^^ (if not (is_stack_ctyp ctyp) then
             string "  for (int i = 0; i < len; i++) {\n"
-            ^^ string (Printf.sprintf "    CREATE(%s)((rop->data) + i);\n" (sgen_ctyp ctyp))
+            ^^ string (Printf.sprintf "    CREATE(%s)((rop->data) + i);\n" (sgen_ctyp_name ctyp))
             ^^ string "  }\n"
           else empty)
       ^^ string "}"
@@ -2776,9 +3108,7 @@ let codegen_def' ctx = function
        string (Printf.sprintf "%svoid %s(%s *rop, %s);" static (sgen_id id) (sgen_ctyp ret_ctyp) (Util.string_of_list ", " sgen_ctyp arg_ctyps))
 
   | CDEF_fundef (id, ret_arg, args, instrs) as def ->
-     if !opt_ddump_flow_graphs then make_dot id (instrs_graph instrs) else ();
-
-     c_debug (lazy (Pretty_print_sail.to_string (separate_map hardline pp_instr instrs)));
+     if !opt_debug_flow_graphs then make_dot id (instrs_graph instrs) else ();
 
      (* Extract type information about the function from the environment. *)
      let quant, Typ_aux (fn_typ, _) = Env.get_val_spec id ctx.tc_env in
@@ -2797,6 +3127,18 @@ let codegen_def' ctx = function
                                  ^ Util.string_of_list ", " string_of_ctyp arg_ctyps)
      else ();
 
+     (* If this function is set as opt_debug_function, then output its IR *)
+     if Id.compare (mk_id !opt_debug_function) id = 0 then
+       let header =
+         Printf.sprintf "Sail IR for %s %s(%s) : (%s) -> %s" Util.("function" |> red |> clear) (string_of_id id)
+                        (Util.string_of_list ", " string_of_id args)
+                        (Util.string_of_list ", " (fun ctyp -> Util.(string_of_ctyp ctyp |> yellow |> clear)) arg_ctyps)
+                        Util.(string_of_ctyp ret_ctyp |> yellow |> clear)
+       in
+       prerr_endline (Util.header header (List.length arg_ctyps + 2));
+       prerr_endline (Pretty_print_sail.to_string (separate_map hardline pp_instr instrs))
+     else ();
+
      let instrs = add_local_labels instrs in
      let args = Util.string_of_list ", " (fun x -> x) (List.map2 (fun ctyp arg -> sgen_ctyp ctyp ^ " " ^ sgen_id arg) arg_ctyps args) in
      let function_header =
@@ -2878,7 +3220,7 @@ let rec ctyp_dependencies = function
   | CT_ref ctyp -> ctyp_dependencies ctyp
   | CT_struct (_, ctors) -> List.concat (List.map (fun (_, ctyp) -> ctyp_dependencies ctyp) ctors)
   | CT_variant (_, ctors) -> List.concat (List.map (fun (_, ctyp) -> ctyp_dependencies ctyp) ctors)
-  | CT_int | CT_int64 | CT_bits _ | CT_bits64 _ | CT_unit | CT_bool | CT_real | CT_bit | CT_string | CT_enum _ | CT_poly -> []
+  | CT_int | CT_int64 | CT_lbits _ | CT_fbits _ | CT_sbits _ | CT_unit | CT_bool | CT_real | CT_bit | CT_string | CT_enum _ | CT_poly -> []
 
 let codegen_ctg ctx = function
   | CTG_vector (direction, ctyp) -> codegen_vector ctx (direction, ctyp)
@@ -2921,10 +3263,9 @@ let sgen_finish = function
      Printf.sprintf "  finish_%s();" (sgen_id id)
   | _ -> assert false
 
-       (*
 let instrument_tracing ctx =
   let module StringSet = Set.Make(String) in
-  let traceable = StringSet.of_list ["mach_bits"; "sail_string"; "sail_bits"; "sail_int"; "unit"; "bool"] in
+  let traceable = StringSet.of_list ["fbits"; "sail_string"; "lbits"; "sail_int"; "unit"; "bool"] in
   let rec instrument = function
     | (I_aux (I_funcall (clexp, _, id, args), _) as instr) :: instrs ->
        let trace_start =
@@ -2944,12 +3285,14 @@ let instrument_tracing ctx =
             trace_arg cval :: iraw "trace_argsep();" :: trace_args cvals
        in
        let trace_end = iraw "trace_end();" in
-       let trace_ret =
+       let trace_ret = iraw "trace_unknown();"
+                            (*
          let ctyp_name = sgen_ctyp_name ctyp in
          if StringSet.mem ctyp_name traceable then
            iraw (Printf.sprintf "trace_%s(%s);" (sgen_ctyp_name ctyp) (sgen_clexp_pure clexp))
          else
            iraw "trace_unknown();"
+                             *)
        in
        [trace_start]
        @ trace_args args
@@ -2972,11 +3315,10 @@ let instrument_tracing ctx =
   | CDEF_fundef (function_id, heap_return, args, body) ->
      CDEF_fundef (function_id, heap_return, args, instrument body)
   | cdef -> cdef
-        *)
 
 let bytecode_ast ctx rewrites (Defs defs) =
-  let assert_vs = Initial_check.extern_of_string dec_ord (mk_id "sail_assert") "(bool, string) -> unit effect {escape}" in
-  let exit_vs = Initial_check.extern_of_string dec_ord (mk_id "sail_exit") "unit -> unit effect {escape}" in
+  let assert_vs = Initial_check.extern_of_string (mk_id "sail_assert") "(bool, string) -> unit effect {escape}" in
+  let exit_vs = Initial_check.extern_of_string (mk_id "sail_exit") "unit -> unit effect {escape}" in
 
   let ctx = { ctx with tc_env = snd (Type_error.check ctx.tc_env (Defs [assert_vs; exit_vs])) } in
   let chunks, ctx = List.fold_left (fun (chunks, ctx) def -> let defs, ctx = compile_def ctx def in defs :: chunks, ctx) ([], ctx) defs in
@@ -3017,17 +3359,15 @@ let compile_ast ctx c_includes (Defs defs) =
     let ctx = { ctx with recursive_functions = recursive_functions } in
     c_debug (lazy (Util.string_of_list ", " string_of_id (IdSet.elements recursive_functions)));
 
-    let assert_vs = Initial_check.extern_of_string dec_ord (mk_id "sail_assert") "(bool, string) -> unit effect {escape}" in
-    let exit_vs = Initial_check.extern_of_string dec_ord (mk_id "sail_exit") "unit -> unit effect {escape}" in
+    let assert_vs = Initial_check.extern_of_string (mk_id "sail_assert") "(bool, string) -> unit effect {escape}" in
+    let exit_vs = Initial_check.extern_of_string (mk_id "sail_exit") "unit -> unit effect {escape}" in
     let ctx = { ctx with tc_env = snd (Type_error.check ctx.tc_env (Defs [assert_vs; exit_vs])) } in
     let chunks, ctx = List.fold_left (fun (chunks, ctx) def -> let defs, ctx = compile_def ctx def in defs :: chunks, ctx) ([], ctx) defs in
     let cdefs = List.concat (List.rev chunks) in
     let cdefs, ctx = specialize_variants ctx [] cdefs in
     let cdefs = sort_ctype_defs cdefs in
     let cdefs = optimize ctx cdefs in
-    (*
     let cdefs = if !opt_trace then List.map (instrument_tracing ctx) cdefs else cdefs in
-     *)
     let docs = List.map (codegen_def ctx) cdefs in
 
     let preamble = separate hardline
diff --git a/src/c_backend.mli b/src/c_backend.mli
index 170c5bd9..24f6e03b 100644
--- a/src/c_backend.mli
+++ b/src/c_backend.mli
@@ -53,7 +53,8 @@ open Type_check
 
 (** Global compilation options *)
 
-val opt_ddump_flow_graphs : bool ref
+val opt_debug_flow_graphs : bool ref
+val opt_debug_function : string ref
 val opt_trace : bool ref
 val opt_static : bool ref
 val opt_no_main : bool ref
@@ -63,17 +64,26 @@ val opt_no_main : bool ref
 val optimize_primops : bool ref
 val optimize_hoist_allocations : bool ref
 val optimize_struct_updates : bool ref
+val optimize_alias : bool ref
+val optimize_experimental : bool ref
 
 (** The compilation context. *)
 type ctx
 
+(** Convert a typ to a IR ctyp *)
+val ctyp_of_typ : ctx -> Ast.typ -> ctyp
+
 (** Create a context from a typechecking environment. This environment
    should be the environment returned by typechecking the full AST. *)
 val initial_ctx : Env.t -> ctx
 
+val compile_aexp : ctx -> Ast.typ Anf.aexp -> instr list * (clexp -> instr) * instr list
+
 val compile_ast : ctx -> string list -> tannot Ast.defs -> unit
 
 val bytecode_ast : ctx -> (cdef list -> cdef list) -> tannot Ast.defs -> cdef list
 
 (** Rewriting steps for compiled ASTs *)
-val flatten_instrs : cdef -> cdef
+val flatten_instrs : instr list -> instr list
+
+val flatten_cdef : cdef -> cdef
diff --git a/src/cgen_backend.ml b/src/cgen_backend.ml
new file mode 100644
index 00000000..77029c9e
--- /dev/null
+++ b/src/cgen_backend.ml
@@ -0,0 +1,77 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+open PPrint
+
+let to_string doc =
+  let b = Buffer.create 120 in
+  ToBuffer.pretty 1. 120 b doc;
+  Buffer.contents b
+
+let do_mapdef_thing (MD_aux (MD_mapping (_, _, clauses), _)) =
+  print_endline ("Mapping has " ^ string_of_int (List.length clauses) ^ " clauses")
+
+let rec list_registers = function
+  | [] -> ()
+  | (DEF_reg_dec reg) :: defs ->
+     print_endline (to_string (Pretty_print_sail.doc_dec reg));
+     list_registers defs
+  | (DEF_mapdef mapdef) :: defs ->
+     do_mapdef_thing mapdef;
+     list_registers defs
+  | def :: defs ->
+     list_registers defs
+
+let output env (Defs defs) =
+  let xlenbits = mk_typ (Typ_id (mk_id "xlenbits")) in
+  print_endline (string_of_typ (Type_check.Env.expand_synonyms env xlenbits));
+  list_registers defs
diff --git a/src/constant_fold.ml b/src/constant_fold.ml
index d5fffbbe..acae4581 100644
--- a/src/constant_fold.ml
+++ b/src/constant_fold.ml
@@ -72,12 +72,13 @@ and exp_of_value =
   | V_bool false -> mk_lit_exp L_false
   | V_string str -> mk_lit_exp (L_string str)
   | V_record ctors ->
-     mk_exp (E_record (FES_aux (FES_Fexps (List.map fexp_of_ctor (StringMap.bindings ctors), false), no_annot)))
+     mk_exp (E_record (List.map fexp_of_ctor (StringMap.bindings ctors)))
   | V_vector vs ->
      mk_exp (E_vector (List.map exp_of_value vs))
   | V_tuple vs ->
      mk_exp (E_tuple (List.map exp_of_value vs))
   | V_unit -> mk_lit_exp L_unit
+  | V_attempted_read str -> mk_exp (E_id (mk_id str))
   | _ -> failwith "No expression for value"
 
 (* We want to avoid evaluating things like print statements at compile
@@ -95,11 +96,13 @@ let safe_primops =
       "print_bits";
       "print_int";
       "print_string";
+      "print_real";
       "prerr_bits";
       "prerr_int";
       "prerr_string";
       "read_ram";
       "write_ram";
+      "get_time_ns";
       "Elf_loader.elf_entry";
       "Elf_loader.elf_tohost"
     ]
@@ -108,7 +111,7 @@ let rec is_constant (E_aux (e_aux, _)) =
   match e_aux with
   | E_lit _ -> true
   | E_vector exps -> List.for_all is_constant exps
-  | E_record (FES_aux (FES_Fexps (fexps, _), _)) -> List.for_all is_constant_fexp fexps
+  | E_record fexps -> List.for_all is_constant_fexp fexps
   | E_cast (_, exp) -> is_constant exp
   | E_tuple exps -> List.for_all is_constant exps
   | _ -> false
diff --git a/src/constraint.ml b/src/constraint.ml
index d66705b6..7ead0cc8 100644
--- a/src/constraint.ml
+++ b/src/constraint.ml
@@ -49,86 +49,10 @@
 (**************************************************************************)
 
 module Big_int = Nat_big_num
+open Ast
+open Ast_util
 open Util
 
-(* ===== Integer Constraints ===== *)
-
-type nexp_op = string
-
-type nexp =
-  | NFun of (nexp_op * nexp list)
-  | N2n of nexp
-  | NConstant of Big_int.num
-  | NVar of int
-
-let big_int_op : nexp_op -> (Big_int.num -> Big_int.num -> Big_int.num) option = function
-  | "+" -> Some Big_int.add
-  | "-" -> Some Big_int.sub
-  | "*" -> Some Big_int.mul
-  | _ -> None
-
-let rec arith constr =
-  let constr' = match constr with
-    | NFun (op, [x; y]) -> NFun (op, [arith x; arith y])
-    | N2n c -> N2n (arith c)
-    | c -> c
-  in
-  match constr' with
-  | NFun (op, [NConstant x; NConstant y]) as c ->
-     begin
-       match big_int_op op with
-       | Some op -> NConstant (op x y)
-       | None -> c
-     end
-  | N2n (NConstant x) -> NConstant (Big_int.pow_int_positive 2 (Big_int.to_int x))
-  | c -> c
-
-(* ===== Boolean Constraints ===== *)
-
-type constraint_bool_op = And | Or
-
-type constraint_compare_op = Gt | Lt | GtEq | LtEq | Eq | NEq
-
-let negate_comparison = function
-  | Gt -> LtEq
-  | Lt -> GtEq
-  | GtEq -> Lt
-  | LtEq -> Gt
-  | Eq -> NEq
-  | NEq -> Eq
-
-type 'a constraint_bool =
-  | BFun of (constraint_bool_op * 'a constraint_bool * 'a constraint_bool)
-  | Not of 'a constraint_bool
-  | CFun of (constraint_compare_op * 'a * 'a)
-  | Forall of (int list * 'a constraint_bool)
-  | Boolean of bool
-
-let rec pairs (xs : 'a list) (ys : 'a list) : ('a * 'b) list =
-  match xs with
-  | [] -> []
-  | (x :: xs) -> List.map (fun y -> (x, y)) ys @ pairs xs ys
-
-(* Get a set of variables from a constraint *)
-module IntSet = Set.Make(
-  struct
-    let compare = Pervasives.compare
-    type t = int
-  end)
-
-let rec nexp_vars : nexp -> IntSet.t = function
-  | NConstant _ -> IntSet.empty
-  | NVar v -> IntSet.singleton v
-  | NFun (_, xs) -> List.fold_left IntSet.union IntSet.empty (List.map nexp_vars xs)
-  | N2n x -> nexp_vars x
-
-let rec constraint_vars : nexp constraint_bool -> IntSet.t = function
-  | BFun (_, x, y) -> IntSet.union (constraint_vars x) (constraint_vars y)
-  | Not x -> constraint_vars x
-  | CFun (_, x, y) -> IntSet.union (nexp_vars x) (nexp_vars y)
-  | Forall (vars, x) -> IntSet.diff (constraint_vars x) (IntSet.of_list vars)
-  | Boolean _ -> IntSet.empty
-
 (* SMTLIB v2.0 format is based on S-expressions so we have a
    lightweight representation of those here. *)
 type sexpr = List of (sexpr list) | Atom of string
@@ -139,47 +63,85 @@ let rec pp_sexpr : sexpr -> string = function
   | List xs -> "(" ^ string_of_list " " pp_sexpr xs ^ ")"
   | Atom x -> x
 
-let var_decs constr =
-  constraint_vars constr
-  |> IntSet.elements
-  |> List.map (fun var -> sfun "declare-const" [Atom ("v" ^ string_of_int var); Atom "Int"])
-  |> string_of_list "\n" pp_sexpr
-
-let cop_sexpr op x y =
-  match op with
-  | Gt -> sfun ">" [x; y]
-  | Lt -> sfun "<" [x; y]
-  | GtEq -> sfun ">=" [x; y]
-  | LtEq -> sfun "<=" [x; y]
-  | Eq -> sfun "=" [x; y]
-  | NEq -> sfun "not" [sfun "=" [x; y]]
-
-let rec sexpr_of_nexp = function
-  | NFun (op, xs) -> sfun op (List.map sexpr_of_nexp xs)
-  | N2n x -> sfun "^" [Atom "2"; sexpr_of_nexp x]
-  | NConstant c -> Atom (Big_int.to_string c) (* CHECK: do we do negative constants right? *)
-  | NVar var -> Atom ("v" ^ string_of_int var)
+(** Each non-Type/Order kind in Sail mapes to a type in the SMT solver *)
+let smt_type l = function
+  | K_int -> Atom "Int"
+  | K_bool -> Atom "Bool"
+  | _ -> raise (Reporting.err_unreachable l __POS__ "Tried to pass Type or Order kinded variable to SMT solver")
+
+let to_smt l vars constr =
+  (* Numbering all SMT variables v0, ... vn, rather than generating
+     names based on their Sail names (e.g. using zencode) ensures that
+     alpha-equivalent constraints generate the same SMT problem, which
+     is important for the SMT memoisation to work properly. *)
+  let var_map = ref KBindings.empty in
+  let vnum = ref (-1) in
+  let smt_var v =
+    match KBindings.find_opt v !var_map with
+    | Some n -> Atom ("v" ^ string_of_int n)
+    | None ->
+       let n = !vnum + 1 in
+       var_map := KBindings.add v n !var_map;
+       vnum := n;
+       Atom ("v" ^ string_of_int n)
+  in
 
-let rec sexpr_of_constraint = function
-  | BFun (And, x, y) -> sfun "and" [sexpr_of_constraint x; sexpr_of_constraint y]
-  | BFun (Or, x, y) -> sfun "or" [sexpr_of_constraint x; sexpr_of_constraint y]
-  | Not x -> sfun "not" [sexpr_of_constraint x]
-  | CFun (op, x, y) -> cop_sexpr op (sexpr_of_nexp (arith x)) (sexpr_of_nexp (arith y))
-  | Forall (vars, x) ->
-     sfun "forall" [List (List.map (fun v -> List [Atom ("v" ^ string_of_int v); Atom "Int"]) vars); sexpr_of_constraint x]
-  | Boolean true -> Atom "true"
-  | Boolean false -> Atom "false"
+  (* var_decs outputs the list of variables to be used by the SMT
+     solver in SMTLIB v2.0 format. It takes a kind_aux KBindings, as
+     returned by Type_check.get_typ_vars *)
+  let var_decs l (vars : kind_aux KBindings.t) : string =
+    vars
+    |> KBindings.bindings
+    |> List.map (fun (v, k) -> sfun "declare-const" [smt_var v; smt_type l k])
+    |> string_of_list "\n" pp_sexpr
+  in
+  let rec smt_nexp (Nexp_aux (aux, l) : nexp) : sexpr =
+    match aux with
+    | Nexp_id id -> Atom (Util.zencode_string (string_of_id id))
+    | Nexp_var v -> smt_var v
+    | Nexp_constant c -> Atom (Big_int.to_string c)
+    | Nexp_app (id, nexps) -> sfun (string_of_id id) (List.map smt_nexp nexps)
+    | Nexp_times (nexp1, nexp2) -> sfun "*" [smt_nexp nexp1; smt_nexp nexp2]
+    | Nexp_sum (nexp1, nexp2) -> sfun "+" [smt_nexp nexp1; smt_nexp nexp2]
+    | Nexp_minus (nexp1, nexp2) -> sfun "-" [smt_nexp nexp1; smt_nexp nexp2]
+    | Nexp_exp (Nexp_aux (Nexp_constant c, _)) when Big_int.greater c Big_int.zero ->
+       Atom (Big_int.to_string (Big_int.pow_int_positive 2 (Big_int.to_int c)))
+    | Nexp_exp nexp -> sfun "^" [Atom "2"; smt_nexp nexp]
+    | Nexp_neg nexp -> sfun "-" [smt_nexp nexp]
+  in
+  let rec smt_constraint (NC_aux (aux, l) : n_constraint) : sexpr =
+    match aux with
+    | NC_equal (nexp1, nexp2) -> sfun "=" [smt_nexp nexp1; smt_nexp nexp2]
+    | NC_bounded_le (nexp1, nexp2) -> sfun "<=" [smt_nexp nexp1; smt_nexp nexp2]
+    | NC_bounded_ge (nexp1, nexp2) -> sfun ">=" [smt_nexp nexp1; smt_nexp nexp2]
+    | NC_not_equal (nexp1, nexp2) -> sfun "not" [sfun "=" [smt_nexp nexp1; smt_nexp nexp2]]
+    | NC_set (v, ints) ->
+       sfun "or" (List.map (fun i -> sfun "=" [smt_var v; Atom (Big_int.to_string i)]) ints)
+    | NC_or (nc1, nc2) -> sfun "or" [smt_constraint nc1; smt_constraint nc2]
+    | NC_and (nc1, nc2) -> sfun "and" [smt_constraint nc1; smt_constraint nc2]
+    | NC_app (id, args) ->
+       sfun (string_of_id id) (List.map smt_typ_arg args)
+    | NC_true -> Atom "true"
+    | NC_false -> Atom "false"
+    | NC_var v -> smt_var v
+  and smt_typ_arg (A_aux (aux, l) : typ_arg) : sexpr =
+    match aux with
+    | A_nexp nexp -> smt_nexp nexp
+    | A_bool nc -> smt_constraint nc
+    | _ ->
+       raise (Reporting.err_unreachable l __POS__ "Tried to pass Type or Order kind to SMT function")
+  in
+  var_decs l vars, smt_constraint constr
 
-let smtlib_of_constraints ?get_model:(get_model=false) constr : string =
+let smtlib_of_constraints ?get_model:(get_model=false) l vars constr : string =
+  let variables, problem = to_smt l vars constr in
   "(push)\n"
-  ^ var_decs constr ^ "\n"
-  ^ pp_sexpr (sfun "define-fun" [Atom "constraint"; List []; Atom "Bool"; sexpr_of_constraint constr])
+  ^ variables ^ "\n"
+  ^ pp_sexpr (sfun "define-fun" [Atom "constraint"; List []; Atom "Bool"; problem])
   ^ "\n(assert constraint)\n(check-sat)"
   ^ (if get_model then "\n(get-model)" else "")
   ^ "\n(pop)"
 
-type t = nexp constraint_bool
-
 type smt_result = Unknown | Sat | Unsat
 
 module DigestMap = Map.Make(Digest)
@@ -219,9 +181,9 @@ let save_digests () =
   DigestMap.iter output !known_problems;
   close_out out_chan
 
-let rec call_z3 constraints : smt_result =
+let call_z3' l vars constraints : smt_result =
   let problems = [constraints] in
-  let z3_file = smtlib_of_constraints constraints in
+  let z3_file = smtlib_of_constraints l vars constraints in
 
   (* prerr_endline (Printf.sprintf "SMTLIB2 constraints are: \n%s%!" z3_file); *)
 
@@ -261,9 +223,14 @@ let rec call_z3 constraints : smt_result =
          else (known_problems := DigestMap.add digest Unknown !known_problems; Unknown)
     end
 
-let rec solve_z3 constraints var =
-  let problems = [constraints] in
-  let z3_file = smtlib_of_constraints ~get_model:true constraints in
+let call_z3 l vars constraints =
+  let t = Profile.start_z3 () in
+  let result = call_z3' l vars constraints in
+  Profile.finish_z3 t;
+  result
+
+let rec solve_z3 l vars constraints var =
+  let z3_file = smtlib_of_constraints ~get_model:true l vars constraints in
 
   (* prerr_endline (Printf.sprintf "SMTLIB2 constraints are: \n%s%!" z3_file); *)
 
@@ -283,62 +250,13 @@ let rec solve_z3 constraints var =
   let z3_output = String.concat " " (input_all z3_chan) in
   let _ = Unix.close_process_in z3_chan in
   Sys.remove input_file;
-  let regexp = {|(define-fun v|} ^ string_of_int var ^ {| () Int[ ]+\([0-9]+\))|} in
+  let regexp = {|(define-fun v|} ^ Util.zencode_string (string_of_kid var) ^ {| () Int[ ]+\([0-9]+\))|} in
   try
     let _ = Str.search_forward (Str.regexp regexp) z3_output 0 in
     let result = Big_int.of_string (Str.matched_group 1 z3_output) in
-    begin match call_z3 (BFun (And, constraints, CFun (NEq, NConstant result, NVar var))) with
+    begin match call_z3 l vars (nc_and constraints (nc_neq (nconstant result) (nvar var))) with
     | Unsat -> Some result
     | _ -> None
     end
   with
     Not_found -> None
-
-let string_of constr = smtlib_of_constraints constr
-
-(* ===== Abstract API for building constraints ===== *)
-
-(* These functions are exported from constraint.mli, and ensure that
-   the internal representation of constraints remains opaque. *)
-
-let implies (x : t) (y : t) : t =
-  BFun (Or, Not x, y)
-
-let conj (x : t) (y : t) : t =
-  BFun (And, x, y)
-
-let disj (x : t) (y : t) : t =
-  BFun (Or, x, y)
-
-let forall (vars : int list) (x : t) : t =
-  if vars = [] then x else Forall (vars, x)
-
-let negate (x : t) : t = Not x
-
-let literal (b : bool) : t = Boolean b
-
-let lt x y : t = CFun (Lt, x, y)
-
-let lteq x y : t = CFun (LtEq, x, y)
-
-let gt x y : t = CFun (Gt, x, y)
-
-let gteq x y : t = CFun (GtEq, x, y)
-
-let eq x y : t = CFun (Eq, x, y)
-
-let neq x y : t = CFun (NEq, x, y)
-
-let pow2 x : nexp = N2n x
-
-let add x y : nexp = NFun ("+", [x; y])
-
-let sub x y : nexp = NFun ("-", [x; y])
-
-let mult x y : nexp = NFun ("*", [x; y])
-
-let app f xs : nexp = NFun (f, xs)
-
-let constant (x : Big_int.num) : nexp = NConstant x
-
-let variable (v : int) : nexp = NVar v
diff --git a/src/constraint.mli b/src/constraint.mli
index df9c8b3a..51088245 100644
--- a/src/constraint.mli
+++ b/src/constraint.mli
@@ -49,40 +49,14 @@
 (**************************************************************************)
 
 module Big_int = Nat_big_num
-
-type nexp
-type t
+open Ast
+open Ast_util
 
 type smt_result = Unknown | Sat | Unsat
 
 val load_digests : unit -> unit
 val save_digests : unit -> unit
 
-val call_z3 : t -> smt_result
-
-val solve_z3 : t -> int -> Big_int.num option
-
-val string_of : t -> string
-
-val implies : t -> t -> t
-val conj : t -> t -> t
-val disj : t -> t -> t
-val negate : t -> t
-val literal : bool -> t
-val forall : int list -> t -> t
-
-val lt : nexp -> nexp -> t
-val lteq : nexp -> nexp -> t
-val gt : nexp -> nexp -> t
-val gteq : nexp -> nexp -> t
-val eq : nexp -> nexp -> t
-val neq : nexp -> nexp -> t
-
-val pow2 : nexp -> nexp
-val add : nexp -> nexp -> nexp
-val sub : nexp -> nexp -> nexp
-val mult : nexp -> nexp -> nexp
-val app : string -> nexp list -> nexp
+val call_z3 : l -> kind_aux KBindings.t -> n_constraint -> smt_result
 
-val constant : Big_int.num -> nexp
-val variable : int -> nexp
+val solve_z3 : l -> kind_aux KBindings.t -> n_constraint -> kid -> Big_int.num option
diff --git a/src/extra_pervasives.ml b/src/extra_pervasives.ml
index a7808a95..8001c647 100644
--- a/src/extra_pervasives.ml
+++ b/src/extra_pervasives.ml
@@ -49,4 +49,4 @@
 (**************************************************************************)
 
 let unreachable l pos msg =
-  raise (Reporting_basic.err_unreachable l pos msg)
+  raise (Reporting.err_unreachable l pos msg)
diff --git a/src/gen_lib/sail2_string.lem b/src/gen_lib/sail2_string.lem
index de7588dc..33a665a0 100644
--- a/src/gen_lib/sail2_string.lem
+++ b/src/gen_lib/sail2_string.lem
@@ -64,10 +64,6 @@ let rec n_leading_spaces s =
          | _ -> 0
       end
     else
-      (* match len with
-   *     (\* | 0 -> 0 *\)
-   * (\* | 1 -> *\) 
-   * | len -> *)
            (* Isabelle generation for pattern matching on characters
               is currently broken, so use an if-expression *)
            if nth s 0 = #' '
diff --git a/src/initial_check.ml b/src/initial_check.ml
index 36c60f2e..7de74a93 100644
--- a/src/initial_check.ml
+++ b/src/initial_check.ml
@@ -51,1035 +51,752 @@
 open Ast
 open Util
 open Ast_util
+open Printf
 module Big_int = Nat_big_num
 
+module P = Parse_ast
+
 (* See mli file for details on what these flags do *)
 let opt_undefined_gen = ref false
 let opt_fast_undefined = ref false
 let opt_magic_hash = ref false
 let opt_enum_casts = ref false
 
-module Envmap = Finite_map.Fmap_map(String)
-module Nameset' = Set.Make(String)
-module Nameset = struct
-  include Nameset'
-  let pp ppf nameset =
-    Format.fprintf ppf "{@[%a@]}"
-      (Pp.lst ",@ " Pp.pp_str)
-      (Nameset'.elements nameset)
-end
-
-type kind = { mutable k : k_aux }
-and k_aux =
-  | K_Typ
-  | K_Nat
-  | K_Ord
-  | K_Efct
-  | K_Val
-  | K_Lam of kind list * kind
-  | K_infer
-
-let rec kind_to_string kind = match kind.k with
-  | K_Nat -> "Nat"
-  | K_Typ -> "Type"
-  | K_Ord -> "Order"
-  | K_Efct -> "Effect"
-  | K_infer -> "Infer"
-  | K_Val -> "Val"
-  | K_Lam (kinds,kind) -> "Lam [" ^ string_of_list ", " kind_to_string kinds ^ "] -> " ^ (kind_to_string kind)
-
-(*Envs is a tuple of used names (currently unused), map from id to kind, default order for vector types and literal vectors *)
-type envs = Nameset.t * kind Envmap.t * order
-type 'a envs_out = 'a * envs
-
-let id_to_string (Id_aux(id,l)) =
-  match id with | Id(x) | DeIid(x) -> x
-
-let var_to_string (Kid_aux(Var v,l)) = v
-
-let typquant_to_quantkinds k_env typquant =
-  match typquant with
-  | TypQ_aux(tq,_) ->
-    (match tq with
-    | TypQ_no_forall -> []
-    | TypQ_tq(qlist) ->
-      List.fold_right
-        (fun (QI_aux(qi,_)) rst ->
-          match qi with
-          | QI_const _ -> rst
-          | QI_id(ki) -> begin
-            match ki with
-            | KOpt_aux(KOpt_none(v),l) | KOpt_aux(KOpt_kind(_,v),l) ->
-              (match Envmap.apply k_env (var_to_string v) with
-              | Some(typ) -> typ::rst
-              | None -> raise (Reporting_basic.err_unreachable l __POS__ "Envmap didn't get an entry during typschm processing"))
-          end)
-        qlist
-        [])
-
-let typ_error l msg opt_id opt_var opt_kind =
-  raise (Reporting_basic.err_typ
-           l
-           (msg ^
-              (match opt_id, opt_var, opt_kind with
-              | Some(id),None,Some(kind) -> (id_to_string id) ^ " of " ^ (kind_to_string kind)
-              | Some(id),None,None -> ": " ^ (id_to_string id)
-              | None,Some(v),Some(kind) -> (var_to_string v) ^ " of " ^ (kind_to_string kind)
-              | None,Some(v),None -> ": " ^ (var_to_string v)
-              | None,None,Some(kind) -> " " ^ (kind_to_string kind)
-              | _ -> "")))
+type ctx = {
+    kinds : kind_aux KBindings.t;
+    type_constructors : (kind_aux list) Bindings.t;
+    scattereds : ctx Bindings.t;
+  }
 
 let string_of_parse_id_aux = function
-  | Parse_ast.Id v -> v
-  | Parse_ast.DeIid v -> v
+  | P.Id v -> v
+  | P.DeIid v -> v
 
-let string_of_parse_id (Parse_ast.Id_aux(id, l)) = string_of_parse_id_aux id
+let string_of_parse_id (P.Id_aux (id, l)) = string_of_parse_id_aux id
 
 let string_contains str char =
   try (ignore (String.index str char); true) with
   | Not_found -> false
 
-let to_ast_id (Parse_ast.Id_aux(id, l)) =
-  if string_contains (string_of_parse_id_aux id) '#' && not (!opt_magic_hash)
-  then typ_error l "Identifier contains hash character" None None None
-  else Id_aux ((match id with
-                | Parse_ast.Id(x) -> Id(x)
-                | Parse_ast.DeIid(x) -> DeIid(x)),
-               l)
-
-let to_ast_var (Parse_ast.Kid_aux(Parse_ast.Var v,l)) = Kid_aux(Var v,l)
+let to_ast_var (P.Kid_aux (P.Var v, l)) = Kid_aux (Var v, l)
 
-let to_ast_base_kind (Parse_ast.BK_aux(k,l')) =
+let to_ast_kind (P.K_aux (k, l)) =
   match k with
-  | Parse_ast.BK_type -> BK_aux(BK_type,l'), { k = K_Typ}
-  | Parse_ast.BK_int -> BK_aux(BK_int,l'), { k = K_Nat }
-  | Parse_ast.BK_order -> BK_aux(BK_order,l'), { k = K_Ord }
-
-let to_ast_kind (k_env : kind Envmap.t) (Parse_ast.K_aux(Parse_ast.K_kind(klst),l)) : (Ast.kind * kind) =
-  match klst with
-  | [] -> raise (Reporting_basic.err_unreachable l __POS__ "Kind with empty kindlist encountered")
-  | [k] -> let k_ast,k_typ = to_ast_base_kind k in
-           K_aux(K_kind([k_ast]),l), k_typ
-  | ks -> let k_pairs = List.map to_ast_base_kind ks in
-          let reverse_typs = List.rev (List.map snd k_pairs) in
-          let ret,args = List.hd reverse_typs, List.rev (List.tl reverse_typs) in
-          match ret.k with
-          | K_Typ -> K_aux(K_kind(List.map fst k_pairs), l), { k = K_Lam(args,ret) }
-          | _ -> typ_error l "Type constructor must have an -> kind ending in Type" None None None
-
-let rec to_ast_typ (k_env : kind Envmap.t) (def_ord : order) (t: Parse_ast.atyp) : Ast.typ =
-  (*  let _ = Printf.eprintf "to_ast_typ\n" in*)
-  match t with
-  | Parse_ast.ATyp_aux(t,l) ->
-     Typ_aux( (match t with
-               | Parse_ast.ATyp_id(id) -> Typ_id (to_ast_id id)
-               | Parse_ast.ATyp_var(v) ->
-                  let v = to_ast_var v in
-                  let mk = Envmap.apply k_env (var_to_string v) in
-                  (match mk with
-                   | Some(k) -> (match k.k with
-                                 | K_Typ -> Typ_var v
-                                 | K_infer -> k.k <- K_Typ; Typ_var v
-                                 | _ -> typ_error l "Required a variable with kind Type, encountered " None (Some v) (Some k))
-                   | None -> typ_error l "Encountered an unbound variable" None (Some v) None)
-               | Parse_ast.ATyp_fn(arg,ret,efct) ->
-                  begin match arg with
-                  | Parse_ast.ATyp_aux (Parse_ast.ATyp_tup args, _) ->
-                     Typ_fn (List.map (to_ast_typ k_env def_ord) args,
-                             (to_ast_typ k_env def_ord ret),
-                             (to_ast_effects k_env efct))
-                  | _ -> Typ_fn ([to_ast_typ k_env def_ord arg],
-                                 (to_ast_typ k_env def_ord ret),
-                                 (to_ast_effects k_env efct))
-                  end
-               | Parse_ast.ATyp_bidir (typ1, typ2) -> Typ_bidir ( (to_ast_typ k_env def_ord typ1),
-                                                                  (to_ast_typ k_env def_ord typ2))
-               | Parse_ast.ATyp_tup(typs) -> Typ_tup( List.map (to_ast_typ k_env def_ord) typs)
-               | Parse_ast.ATyp_app(Parse_ast.Id_aux(Parse_ast.Id "vector_sugar_tb",il), [ b; r; ord ; ti]) ->
-                  let make_r bot top =
-                    match bot,top with
-                    | Parse_ast.ATyp_aux(Parse_ast.ATyp_constant b,_),Parse_ast.ATyp_aux(Parse_ast.ATyp_constant t,l) ->
-                       Parse_ast.ATyp_aux(Parse_ast.ATyp_constant (Big_int.add (Big_int.sub t b) (Big_int.of_int 1)),l)
-                    | bot,(Parse_ast.ATyp_aux(_,l) as top) ->
-                       Parse_ast.ATyp_aux((Parse_ast.ATyp_sum
-                                             ((Parse_ast.ATyp_aux
-                                                 (Parse_ast.ATyp_sum (top,
-                                                                      Parse_ast.ATyp_aux(Parse_ast.ATyp_constant (Big_int.of_int 1),Parse_ast.Unknown)),
-                                                  Parse_ast.Unknown)),
-                                              (Parse_ast.ATyp_aux ((Parse_ast.ATyp_neg bot),Parse_ast.Unknown)))), l) in
-                  let base = to_ast_nexp k_env b in
-                  let rise = match def_ord with
-                    | Ord_aux(Ord_inc,dl) ->  to_ast_nexp k_env (make_r b r)
-                    | Ord_aux(Ord_dec,dl) ->  to_ast_nexp k_env (make_r r b)
-                    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Default order not inc or dec") in
-                  Typ_app(Id_aux(Id "vector",il),
-                          [Typ_arg_aux (Typ_arg_nexp base,Parse_ast.Unknown);
-                           Typ_arg_aux (Typ_arg_nexp rise,Parse_ast.Unknown);
-                           Typ_arg_aux (Typ_arg_order def_ord,Parse_ast.Unknown);
-                           Typ_arg_aux (Typ_arg_typ (to_ast_typ k_env def_ord ti), Parse_ast.Unknown);])
-               | Parse_ast.ATyp_app(Parse_ast.Id_aux(Parse_ast.Id "vector_sugar_r",il), [b;r;ord;ti]) ->
-                  let make_sub_one t =
-                    match t with
-                    | Parse_ast.ATyp_aux(Parse_ast.ATyp_constant t,_) -> Parse_ast.ATyp_aux(Parse_ast.ATyp_constant (Big_int.sub t (Big_int.of_int 1)),l)
-                    | t -> (Parse_ast.ATyp_aux
-                              (Parse_ast.ATyp_sum (t, Parse_ast.ATyp_aux(Parse_ast.ATyp_constant (Big_int.negate (Big_int.of_int 1)),Parse_ast.Unknown)),
-			       Parse_ast.Unknown)) in
-		let (base,rise) = match def_ord with
-		  | Ord_aux(Ord_inc,dl) -> (to_ast_nexp k_env b), (to_ast_nexp k_env r)
-		  | Ord_aux(Ord_dec,dl) -> (to_ast_nexp k_env (make_sub_one r)), (to_ast_nexp k_env r)
-		  | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Default order not inc or dec") in
-		Typ_app(Id_aux(Id "vector",il),
-			[Typ_arg_aux (Typ_arg_nexp base,Parse_ast.Unknown);
-			 Typ_arg_aux (Typ_arg_nexp rise,Parse_ast.Unknown);
-			 Typ_arg_aux (Typ_arg_order def_ord,Parse_ast.Unknown);
-                         Typ_arg_aux (Typ_arg_typ (to_ast_typ k_env def_ord ti), Parse_ast.Unknown);])
-              | Parse_ast.ATyp_app (Parse_ast.Id_aux (Parse_ast.Id "int", il), [n]) ->
-                 Typ_app(Id_aux(Id "atom", il), [Typ_arg_aux (Typ_arg_nexp (to_ast_nexp k_env n), Parse_ast.Unknown)])
-              | Parse_ast.ATyp_app(pid,typs) ->
-                  let id = to_ast_id pid in
-                  let k = Envmap.apply k_env (id_to_string id) in
-                  (match k with
-                   | Some({k = K_Lam(args,t)}) ->
-                      if ((List.length args) = (List.length typs))
-                      then
-                        Typ_app(id,(List.map2 (fun k a -> (to_ast_typ_arg k_env def_ord k a)) args typs))
-                      else typ_error l "Type constructor given incorrect number of arguments" (Some id) None None
-                   | None -> typ_error l "Required a type constructor, encountered an unbound identifier" (Some id) None None
-                   | _ -> typ_error l "Required a type constructor, encountered a base kind variable" (Some id) None None)
-               | Parse_ast.ATyp_exist (kids, nc, atyp) ->
-                  let kids = List.map to_ast_var kids in
-                  let k_env = List.fold_left Envmap.insert k_env (List.map (fun kid -> (var_to_string kid, {k=K_Nat})) kids) in
-                  let exist_typ = to_ast_typ k_env def_ord atyp in
-                  Typ_exist (kids, to_ast_nexp_constraint k_env nc, exist_typ)
-               | _ -> typ_error l "Required an item of kind Type, encountered an illegal form for this kind" None None None
-              ), l)
-
-and to_ast_nexp (k_env : kind Envmap.t) (n: Parse_ast.atyp) : Ast.nexp =
-  match n with
-  | Parse_ast.ATyp_aux(t,l) ->
-    (match t with
-     | Parse_ast.ATyp_id i -> Nexp_aux (Nexp_id (to_ast_id i), l)
-     | Parse_ast.ATyp_var v -> Nexp_aux (Nexp_var (to_ast_var v), l)
-     | Parse_ast.ATyp_constant i -> Nexp_aux (Nexp_constant i, l)
-     | Parse_ast.ATyp_sum (t1, t2) ->
-        let n1 = to_ast_nexp k_env t1 in
-        let n2 = to_ast_nexp k_env t2 in
-        Nexp_aux (Nexp_sum (n1, n2), l)
-     | Parse_ast.ATyp_exp t1 -> Nexp_aux(Nexp_exp(to_ast_nexp k_env t1),l)
-     | Parse_ast.ATyp_neg t1 -> Nexp_aux(Nexp_neg(to_ast_nexp k_env t1),l)
-     | Parse_ast.ATyp_times (t1, t2) ->
-        let n1 = to_ast_nexp k_env t1 in
-        let n2 = to_ast_nexp k_env t2 in
-        Nexp_aux (Nexp_times (n1, n2), l)
-     | Parse_ast.ATyp_minus (t1, t2) ->
-        let n1 = to_ast_nexp k_env t1 in
-        let n2 = to_ast_nexp k_env t2 in
-        Nexp_aux (Nexp_minus (n1, n2), l)
-     | Parse_ast.ATyp_app (id, ts) ->
-        let nexps = List.map (to_ast_nexp k_env) ts in
-        Nexp_aux (Nexp_app (to_ast_id id, nexps), l)
-     | _ -> typ_error l "Required an item of kind Nat, encountered an illegal form for this kind" None None None)
-
-and to_ast_order (k_env : kind Envmap.t) (def_ord : order) (o: Parse_ast.atyp) : Ast.order =
-  match o with
-  | Parse_ast.ATyp_aux(t,l) ->
-    (match t with
-      | Parse_ast.ATyp_var(v) ->
-        let v = to_ast_var v in
-        let mk = Envmap.apply k_env (var_to_string v) in
-        (match mk with
-          | Some(k) -> (match k.k with
-              | K_Ord -> Ord_aux(Ord_var v, l)
-              | K_infer -> k.k <- K_Ord; Ord_aux(Ord_var v,l)
-              | _ -> typ_error l "Required a variable with kind Order, encountered " None (Some v) (Some k))
-          | None -> typ_error l "Encountered an unbound variable" None (Some v) None)
-      | Parse_ast.ATyp_inc -> Ord_aux(Ord_inc,l)
-      | Parse_ast.ATyp_dec -> Ord_aux(Ord_dec,l)
-      | Parse_ast.ATyp_default_ord -> def_ord
-      | _ -> typ_error l "Required an item of kind Order, encountered an illegal form for this kind" None None None
-    )
-
-and to_ast_effects (k_env : kind Envmap.t) (e : Parse_ast.atyp) : Ast.effect =
-  match e with
-  | Parse_ast.ATyp_aux(t,l) ->
-    Effect_aux( (match t with
-               | Parse_ast.ATyp_var(v) ->
-                let v = to_ast_var v in
-                let mk = Envmap.apply k_env (var_to_string v) in
-                (match mk with
-                | Some k -> typ_error l "Required a variable with kind Effect, encountered " None (Some v) (Some k)
-                | None -> typ_error l "Encountered an unbound variable" None (Some v) None)
-               | Parse_ast.ATyp_set(effects) ->
-                 Effect_set( List.map
-                             (fun efct -> match efct with
-                             | Parse_ast.BE_aux(e,l) ->
-                               BE_aux((match e with
-                               | Parse_ast.BE_barr   -> BE_barr
-                               | Parse_ast.BE_rreg   -> BE_rreg
-                               | Parse_ast.BE_wreg   -> BE_wreg
-                               | Parse_ast.BE_rmem   -> BE_rmem
-                               | Parse_ast.BE_rmemt  -> BE_rmemt
-                               | Parse_ast.BE_wmem   -> BE_wmem
-			       | Parse_ast.BE_wmv    -> BE_wmv
-			       | Parse_ast.BE_wmvt   -> BE_wmvt
-			       | Parse_ast.BE_eamem  -> BE_eamem
-			       | Parse_ast.BE_exmem  -> BE_exmem
-			       | Parse_ast.BE_depend -> BE_depend
-                               | Parse_ast.BE_undef  -> BE_undef
-                               | Parse_ast.BE_unspec -> BE_unspec
-                               | Parse_ast.BE_nondet -> BE_nondet
-                               | Parse_ast.BE_escape -> BE_escape
-                               | Parse_ast.BE_config -> BE_config),l))
-                             effects)
-               | _ -> typ_error l "Required an item of kind Effects, encountered an illegal form for this kind" None None None
-    ), l)
-
-and to_ast_typ_arg (k_env : kind Envmap.t) (def_ord : order) (kind : kind) (arg : Parse_ast.atyp) : Ast.typ_arg =
-  let l = (match arg with Parse_ast.ATyp_aux(_,l) -> l) in
-  Typ_arg_aux (
-    (match kind.k with
-    | K_Typ -> Typ_arg_typ (to_ast_typ k_env def_ord arg)
-    | K_Nat  -> Typ_arg_nexp (to_ast_nexp k_env arg)
-    | K_Ord -> Typ_arg_order (to_ast_order k_env def_ord arg)
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("To_ast_typ_arg received Lam kind or infer kind: " ^ kind_to_string kind))),
-    l)
+  | P.K_type  -> K_aux (K_type, l)
+  | P.K_int   -> K_aux (K_int, l)
+  | P.K_order -> K_aux (K_order, l)
+  | P.K_bool  -> K_aux (K_bool, l)
+
+let to_ast_id (P.Id_aux(id, l)) =
+  if string_contains (string_of_parse_id_aux id) '#' && not (!opt_magic_hash) then
+    raise (Reporting.err_general l "Identifier contains hash character and -dmagic_hash is unset")
+  else
+    Id_aux ((match id with
+             | P.Id x -> Id x
+             | P.DeIid x -> DeIid x),
+            l)
+
+let to_ast_var (P.Kid_aux (P.Var v, l)) = Kid_aux (Var v, l)
+
+let to_ast_effects = function
+  | P.ATyp_aux (P.ATyp_set effects, l) ->
+     let to_effect (P.BE_aux (e, l)) =
+       BE_aux ((match e with
+                | P.BE_barr   -> BE_barr
+                | P.BE_rreg   -> BE_rreg
+                | P.BE_wreg   -> BE_wreg
+                | P.BE_rmem   -> BE_rmem
+                | P.BE_rmemt  -> BE_rmemt
+                | P.BE_wmem   -> BE_wmem
+                | P.BE_wmv    -> BE_wmv
+                | P.BE_wmvt   -> BE_wmvt
+                | P.BE_eamem  -> BE_eamem
+                | P.BE_exmem  -> BE_exmem
+                | P.BE_depend -> BE_depend
+                | P.BE_undef  -> BE_undef
+                | P.BE_unspec -> BE_unspec
+                | P.BE_nondet -> BE_nondet
+                | P.BE_escape -> BE_escape
+                | P.BE_config -> BE_config),
+               l)
+     in
+     Effect_aux (Effect_set (List.map to_effect effects), l)
+  | P.ATyp_aux (_, l) ->
+     raise (Reporting.err_typ l "Invalid effect set")
+
+(* Used for error messages involving lists of kinds *)
+let format_kind_aux_list = function
+  | [kind] -> string_of_kind_aux kind
+  | kinds -> "(" ^ Util.string_of_list ", " string_of_kind_aux kinds ^ ")"
+
+let to_ast_kopt ctx (P.KOpt_aux (aux, l)) =
+  let aux, ctx = match aux with
+    | P.KOpt_none v ->
+       let v = to_ast_var v in
+       KOpt_kind (K_aux (K_int, gen_loc l), v), { ctx with kinds = KBindings.add v K_int ctx.kinds }
+    | P.KOpt_kind (k, v) ->
+       let v = to_ast_var v in
+       let k = to_ast_kind k in
+       KOpt_kind (k, v), { ctx with kinds = KBindings.add v (unaux_kind k) ctx.kinds }
+  in
+  KOpt_aux (aux, l), ctx
+
+let rec to_ast_typ ctx (P.ATyp_aux (aux, l)) =
+  let aux = match aux with
+    | P.ATyp_id id -> Typ_id (to_ast_id id)
+    | P.ATyp_var v -> Typ_var (to_ast_var v)
+    | P.ATyp_fn (from_typ, to_typ, effects) ->
+       let from_typs = match from_typ with
+         | P.ATyp_aux (P.ATyp_tup typs, _) ->
+            List.map (to_ast_typ ctx) typs
+         | _ -> [to_ast_typ ctx from_typ]
+       in
+       Typ_fn (from_typs, to_ast_typ ctx to_typ, to_ast_effects effects)
+    | P.ATyp_bidir (typ1, typ2) -> Typ_bidir (to_ast_typ ctx typ1, to_ast_typ ctx typ2)
+    | P.ATyp_tup typs -> Typ_tup (List.map (to_ast_typ ctx) typs)
+    | P.ATyp_app (P.Id_aux (P.Id "int", il), [n]) ->
+       Typ_app (Id_aux (Id "atom", il), [to_ast_typ_arg ctx n K_int])
+    | P.ATyp_app (P.Id_aux (P.Id "bool", il), [n]) ->
+       Typ_app (Id_aux (Id "atom_bool", il), [to_ast_typ_arg ctx n K_bool])
+    | P.ATyp_app (id, args) ->
+       let id = to_ast_id id in
+       begin match Bindings.find_opt id ctx.type_constructors with
+       | None -> raise (Reporting.err_typ l (sprintf "Could not find type constructor %s" (string_of_id id)))
+       | Some kinds when List.length args <> List.length kinds ->
+          raise (Reporting.err_typ l (sprintf "%s : %s -> Type expected %d arguments, given %d"
+                                              (string_of_id id) (format_kind_aux_list kinds)
+                                              (List.length kinds) (List.length args)))
+       | Some kinds ->
+          Typ_app (id, List.map2 (to_ast_typ_arg ctx) args kinds)
+       end
+    | P.ATyp_exist (kopts, nc, atyp) ->
+       let kopts, ctx =
+         List.fold_right (fun kopt (kopts, ctx) -> let kopt, ctx = to_ast_kopt ctx kopt in (kopt :: kopts, ctx)) kopts ([], ctx)
+       in
+       Typ_exist (kopts, to_ast_constraint ctx nc, to_ast_typ ctx atyp)
+    | P.ATyp_base (id, kind, nc) ->
+       raise (Reporting.err_unreachable l __POS__ "TODO")
+    | _ -> raise (Reporting.err_typ l "Invalid type")
+  in
+  Typ_aux (aux, l)
+
+and to_ast_typ_arg ctx (ATyp_aux (_, l) as atyp) = function
+  | K_type  -> A_aux (A_typ (to_ast_typ ctx atyp), l)
+  | K_int   -> A_aux (A_nexp (to_ast_nexp ctx atyp), l)
+  | K_order -> A_aux (A_order (to_ast_order ctx atyp), l)
+  | K_bool  -> A_aux (A_bool (to_ast_constraint ctx atyp), l)
+
+and to_ast_nexp ctx (P.ATyp_aux (aux, l)) =
+  let aux = match aux with
+    | P.ATyp_id id -> Nexp_id (to_ast_id id)
+    | P.ATyp_var v -> Nexp_var (to_ast_var v)
+    | P.ATyp_lit (P.L_aux (P.L_num c, _)) -> Nexp_constant c
+    | P.ATyp_sum (t1, t2) -> Nexp_sum (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+    | P.ATyp_exp t1 -> Nexp_exp (to_ast_nexp ctx t1)
+    | P.ATyp_neg t1 -> Nexp_neg (to_ast_nexp ctx t1)
+    | P.ATyp_times (t1, t2) -> Nexp_times (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+    | P.ATyp_minus (t1, t2) -> Nexp_minus (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+    | P.ATyp_app (id, ts) -> Nexp_app (to_ast_id id, List.map (to_ast_nexp ctx) ts)
+    | _ -> raise (Reporting.err_typ l "Invalid numeric expression in type")
+  in
+  Nexp_aux (aux, l)
 
-and to_ast_nexp_constraint (k_env : kind Envmap.t) (c : Parse_ast.n_constraint) : n_constraint =
-  match c with
-  | Parse_ast.NC_aux(nc,l) ->
-    NC_aux( (match nc with
-             | Parse_ast.NC_equal(t1,t2) ->
-               let n1 = to_ast_nexp k_env t1 in
-               let n2 = to_ast_nexp k_env t2 in
-               NC_equal(n1,n2)
-             | Parse_ast.NC_not_equal(t1,t2) ->
-                let n1 = to_ast_nexp k_env t1 in
-                let n2 = to_ast_nexp k_env t2 in
-                NC_not_equal(n1,n2)
-             | Parse_ast.NC_bounded_ge(t1,t2) ->
-               let n1 = to_ast_nexp k_env t1 in
-               let n2 = to_ast_nexp k_env t2 in
-               NC_bounded_ge(n1,n2)
-             | Parse_ast.NC_bounded_le(t1,t2) ->
-               let n1 = to_ast_nexp k_env t1 in
-               let n2 = to_ast_nexp k_env t2 in
-               NC_bounded_le(n1,n2)
-             | Parse_ast.NC_set(id,bounds) ->
-                NC_set(to_ast_var id, bounds)
-             | Parse_ast.NC_or (nc1, nc2) ->
-                NC_or (to_ast_nexp_constraint k_env nc1, to_ast_nexp_constraint k_env nc2)
-             | Parse_ast.NC_and (nc1, nc2) ->
-                NC_and (to_ast_nexp_constraint k_env nc1, to_ast_nexp_constraint k_env nc2)
-             | Parse_ast.NC_app (id, typs) ->
-                let nexps = List.map (to_ast_nexp k_env) typs in
-                NC_app (to_ast_id id, nexps)
-             | Parse_ast.NC_true -> NC_true
-             | Parse_ast.NC_false -> NC_false
-    ), l)
-
-(* Transforms a typquant while building first the kind environment of declared variables, and also the kind environment in context *)
-let to_ast_typquant (k_env: kind Envmap.t) (tq : Parse_ast.typquant) : typquant * kind Envmap.t * kind Envmap.t =
-  let opt_kind_to_ast k_env local_names local_env (Parse_ast.KOpt_aux(ki,l)) =
-    let v, key, kind, ktyp =
-      match ki with
-      | Parse_ast.KOpt_none(v) ->
-	let v = to_ast_var v in
-	let key = var_to_string v in
-	let kind,ktyp = if (Envmap.in_dom key k_env) then None,(Envmap.apply k_env key) else None,(Some{ k = K_infer }) in
-	v,key,kind, ktyp
-      | Parse_ast.KOpt_kind(k,v) ->
-	let v = to_ast_var v in
-	let key = var_to_string v in
-	let kind,ktyp = to_ast_kind k_env k in
-	v,key,Some(kind),Some(ktyp)
-    in
-    if (Nameset.mem key local_names)
-    then typ_error l "Encountered duplicate name in type scheme" None (Some v) None
-    else
-      let local_names = Nameset.add key local_names in
-      let kopt,k_env,k_env_local = (match kind,ktyp with
-        | Some(k),Some(kt) -> KOpt_kind(k,v), (Envmap.insert k_env (key,kt)), (Envmap.insert local_env (key,kt))
-	| None, Some(kt) -> KOpt_none(v), (Envmap.insert k_env (key,kt)), (Envmap.insert local_env (key,kt))
-	| _ -> raise (Reporting_basic.err_unreachable l __POS__ "Envmap in dom is true but apply gives None")) in
-      KOpt_aux(kopt,l),k_env,local_names,k_env_local
+and to_ast_order ctx (P.ATyp_aux (aux, l)) =
+  match aux with
+  | ATyp_var v -> Ord_aux (Ord_var (to_ast_var v), l)
+  | ATyp_inc -> Ord_aux (Ord_inc, l)
+  | ATyp_dec -> Ord_aux (Ord_dec, l)
+  | _ -> raise (Reporting.err_typ l "Invalid order in type")
+
+and to_ast_constraint ctx (P.ATyp_aux (aux, l) as atyp) =
+  let aux = match aux with
+    | P.ATyp_app (Id_aux (DeIid op, _) as id, [t1; t2]) ->
+       begin match op with
+       | "==" -> NC_equal (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+       | "!=" -> NC_not_equal (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+       | ">=" -> NC_bounded_ge (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+       | "<=" -> NC_bounded_le (to_ast_nexp ctx t1, to_ast_nexp ctx t2)
+       | ">" -> NC_bounded_ge (to_ast_nexp ctx t1, nsum (to_ast_nexp ctx t2) (nint 1))
+       | "<" -> NC_bounded_le (nsum (to_ast_nexp ctx t1) (nint 1), to_ast_nexp ctx t2)
+       | "&" -> NC_and (to_ast_constraint ctx t1, to_ast_constraint ctx t2)
+       | "|" -> NC_or (to_ast_constraint ctx t1, to_ast_constraint ctx t2)
+       | _ ->
+          let id = to_ast_id id in
+          match Bindings.find_opt id ctx.type_constructors with
+          | None -> raise (Reporting.err_typ l (sprintf "Could not find type constructor %s" (string_of_id id)))
+          | Some kinds when List.length kinds <> 2 ->
+             raise (Reporting.err_typ l (sprintf "%s : %s -> Bool expected %d arguments, given 2"
+                                                 (string_of_id id) (format_kind_aux_list kinds)
+                                                 (List.length kinds)))
+          | Some kinds -> NC_app (id, List.map2 (to_ast_typ_arg ctx) [t1; t2] kinds)
+       end
+    | P.ATyp_app (id, args) ->
+       let id = to_ast_id id in
+       begin match Bindings.find_opt id ctx.type_constructors with
+       | None -> raise (Reporting.err_typ l (sprintf "Could not find type constructor %s" (string_of_id id)))
+       | Some kinds when List.length args <> List.length kinds ->
+          raise (Reporting.err_typ l (sprintf "%s : %s -> Bool expected %d arguments, given %d"
+                                              (string_of_id id) (format_kind_aux_list kinds)
+                                              (List.length kinds) (List.length args)))
+       | Some kinds -> NC_app (id, List.map2 (to_ast_typ_arg ctx) args kinds)
+       end
+    | P.ATyp_var v -> NC_var (to_ast_var v)
+    | P.ATyp_lit (P.L_aux (P.L_true, _)) -> NC_true
+    | P.ATyp_lit (P.L_aux (P.L_false, _)) -> NC_false
+    | P.ATyp_nset (id, bounds) -> NC_set (to_ast_var id, bounds)
+    | _ -> raise (Reporting.err_typ l "Invalid constraint")
   in
-  match tq with
-  | Parse_ast.TypQ_aux(tqa,l) ->
-    (match tqa with
-    | Parse_ast.TypQ_no_forall -> TypQ_aux(TypQ_no_forall,l), k_env, Envmap.empty
-    | Parse_ast.TypQ_tq(qlist) ->
-      let rec to_ast_q_items k_env local_names local_env = function
-	| [] -> [],k_env,local_env
-	| q::qs -> (match q with
-	            | Parse_ast.QI_aux(qi,l) ->
-		      (match qi with
-		      | Parse_ast.QI_const(n_const) ->
-			let c = QI_aux(QI_const(to_ast_nexp_constraint k_env n_const),l) in
-			let qis,k_env,local_env = to_ast_q_items k_env local_names local_env qs in
-			(c::qis),k_env,local_env
-		      | Parse_ast.QI_id(kid) ->
-			let kid,k_env,local_names,local_env = opt_kind_to_ast k_env local_names local_env kid in
-			let c = QI_aux(QI_id(kid),l) in
-			let qis,k_env,local_env = to_ast_q_items k_env local_names local_env qs in
-			(c::qis),k_env,local_env))
-      in
-      let lst,k_env,local_env = to_ast_q_items k_env Nameset.empty Envmap.empty qlist in
-      TypQ_aux(TypQ_tq(lst),l), k_env, local_env)
-
-let to_ast_typschm (k_env:kind Envmap.t) (def_ord:order) (tschm:Parse_ast.typschm) :Ast.typschm * kind Envmap.t * kind Envmap.t =
-  match tschm with
-  | Parse_ast.TypSchm_aux(ts,l) ->
-    (match ts with | Parse_ast.TypSchm_ts(tquant,t) ->
-      let tq,k_env,local_env = to_ast_typquant k_env tquant in
-      let typ = to_ast_typ k_env def_ord t in
-      TypSchm_aux(TypSchm_ts(tq,typ),l),k_env,local_env)
-
-let to_ast_lit (Parse_ast.L_aux(lit,l)) : lit =
-  L_aux(
-    (match lit with
-    | Parse_ast.L_unit -> L_unit
-    | Parse_ast.L_zero -> L_zero
-    | Parse_ast.L_one -> L_one
-    | Parse_ast.L_true -> L_true
-    | Parse_ast.L_false -> L_false
-    | Parse_ast.L_undef -> L_undef
-    | Parse_ast.L_num(i) -> L_num(i)
-    | Parse_ast.L_hex(h) -> L_hex(h)
-    | Parse_ast.L_bin(b) -> L_bin(b)
-    | Parse_ast.L_real r -> L_real r
-    | Parse_ast.L_string(s) -> L_string(s))
-    ,l)
-
-let rec to_ast_typ_pat (Parse_ast.ATyp_aux (typ_aux, l)) =
-  match typ_aux with
-  | Parse_ast.ATyp_wild -> TP_aux (TP_wild, l)
-  | Parse_ast.ATyp_var kid -> TP_aux (TP_var (to_ast_var kid), l)
-  | Parse_ast.ATyp_app (Parse_ast.Id_aux (Parse_ast.Id "int", il), typs) ->
-     TP_aux (TP_app (Id_aux (Id "atom", il), List.map to_ast_typ_pat typs), l)
-  | Parse_ast.ATyp_app (f, typs) ->
-     TP_aux (TP_app (to_ast_id f, List.map to_ast_typ_pat typs), l)
-  | _ -> typ_error l "Unexpected type in type pattern" None None None
-
-let rec to_ast_pat (k_env : kind Envmap.t) (def_ord : order) (Parse_ast.P_aux(pat,l) : Parse_ast.pat) : unit pat =
-  P_aux(
-    (match pat with
-    | Parse_ast.P_lit(lit) -> P_lit(to_ast_lit lit)
-    | Parse_ast.P_wild -> P_wild
-    | Parse_ast.P_or(pat1, pat2) ->
-       P_or (to_ast_pat k_env def_ord pat1, to_ast_pat k_env def_ord pat2)
-    | Parse_ast.P_var (pat, Parse_ast.ATyp_aux (Parse_ast.ATyp_id id, _)) ->
-       P_as (to_ast_pat k_env def_ord pat, to_ast_id id)
-    | Parse_ast.P_typ(typ,pat) -> P_typ(to_ast_typ k_env def_ord typ,to_ast_pat k_env def_ord pat)
-    | Parse_ast.P_id(id) -> P_id(to_ast_id id)
-    | Parse_ast.P_var (pat, typ) -> P_var (to_ast_pat k_env def_ord pat, to_ast_typ_pat typ)
-    | Parse_ast.P_app(id, []) -> P_id (to_ast_id id)
-    | Parse_ast.P_app(id, pats) ->
-       if List.length pats == 1 && string_of_parse_id id = "~"
-       then P_not (to_ast_pat k_env def_ord (List.hd pats))
-       else P_app(to_ast_id id, List.map (to_ast_pat k_env def_ord) pats)
-    | Parse_ast.P_record(fpats,_) ->
-      P_record(List.map
-                 (fun (Parse_ast.FP_aux(Parse_ast.FP_Fpat(id,fp),l)) ->
-		      FP_aux(FP_Fpat(to_ast_id id, to_ast_pat k_env def_ord fp),(l,())))
-                 fpats, false)
-    | Parse_ast.P_vector(pats) -> P_vector(List.map (to_ast_pat k_env def_ord) pats)
-    | Parse_ast.P_vector_concat(pats) -> P_vector_concat(List.map (to_ast_pat k_env def_ord) pats)
-    | Parse_ast.P_tup(pats) -> P_tup(List.map (to_ast_pat k_env def_ord) pats)
-    | Parse_ast.P_list(pats) -> P_list(List.map (to_ast_pat k_env def_ord) pats)
-    | Parse_ast.P_cons(pat1, pat2) -> P_cons (to_ast_pat k_env def_ord pat1, to_ast_pat k_env def_ord pat2)
-    | Parse_ast.P_string_append pats -> P_string_append (List.map (to_ast_pat k_env def_ord) pats)
-    ), (l,()))
+  NC_aux (aux, l)
 
+let to_ast_quant_item ctx (P.QI_aux (aux, l)) =
+  match aux with
+  | P.QI_const nc -> QI_aux (QI_const (to_ast_constraint ctx nc), l), ctx
+  | P.QI_id kopt ->
+     let kopt, ctx = to_ast_kopt ctx kopt in
+     QI_aux (QI_id kopt, l), ctx
 
-let rec to_ast_letbind (k_env : kind Envmap.t) (def_ord : order) (Parse_ast.LB_aux(lb,l) : Parse_ast.letbind) : unit letbind =
+let to_ast_typquant ctx (P.TypQ_aux (aux, l)) =
+  match aux with
+  | P.TypQ_no_forall -> TypQ_aux (TypQ_no_forall, l), ctx
+  | P.TypQ_tq quants ->
+     let quants, ctx =
+       List.fold_left (fun (qis, ctx) qi -> let qi', ctx = to_ast_quant_item ctx qi in qi' :: qis, ctx) ([], ctx) quants
+     in
+     TypQ_aux (TypQ_tq (List.rev quants), l), ctx
+
+let to_ast_typschm ctx (P.TypSchm_aux (P.TypSchm_ts (typq, typ), l)) =
+  let typq, ctx = to_ast_typquant ctx typq in
+  let typ = to_ast_typ ctx typ in
+  TypSchm_aux (TypSchm_ts (typq, typ), l), ctx
+
+let to_ast_lit (P.L_aux (lit, l)) =
+  L_aux ((match lit with
+          | P.L_unit -> L_unit
+          | P.L_zero -> L_zero
+          | P.L_one -> L_one
+          | P.L_true -> L_true
+          | P.L_false -> L_false
+          | P.L_undef -> L_undef
+          | P.L_num i -> L_num i
+          | P.L_hex h -> L_hex h
+          | P.L_bin b -> L_bin b
+          | P.L_real r -> L_real r
+          | P.L_string s -> L_string s)
+        ,l)
+
+let rec to_ast_typ_pat (P.ATyp_aux (aux, l)) =
+  match aux with
+  | P.ATyp_wild -> TP_aux (TP_wild, l)
+  | P.ATyp_var kid -> TP_aux (TP_var (to_ast_var kid), l)
+  | P.ATyp_app (P.Id_aux (P.Id "int", il), typs) ->
+     TP_aux (TP_app (Id_aux (Id "atom", il), List.map to_ast_typ_pat typs), l)
+  | P.ATyp_app (f, typs) ->
+     TP_aux (TP_app (to_ast_id f, List.map to_ast_typ_pat typs), l)
+  | _ -> raise (Reporting.err_typ l "Unexpected type in type pattern")
+
+let rec to_ast_pat ctx (P.P_aux (pat, l)) =
+  P_aux ((match pat with
+          | P.P_lit lit -> P_lit (to_ast_lit lit)
+          | P.P_wild -> P_wild
+          | P.P_or (pat1, pat2) ->
+             P_or (to_ast_pat ctx pat1, to_ast_pat ctx pat2)
+          | P.P_var (pat, P.ATyp_aux (P.ATyp_id id, _)) ->
+             P_as (to_ast_pat ctx pat, to_ast_id id)
+          | P.P_typ (typ, pat) -> P_typ (to_ast_typ ctx typ, to_ast_pat ctx pat)
+          | P.P_id id -> P_id (to_ast_id id)
+          | P.P_var (pat, typ) -> P_var (to_ast_pat ctx pat, to_ast_typ_pat typ)
+          | P.P_app (id, []) -> P_id (to_ast_id id)
+          | P.P_app (id, pats) ->
+             if List.length pats == 1 && string_of_parse_id id = "~"
+             then P_not (to_ast_pat ctx (List.hd pats))
+             else P_app (to_ast_id id, List.map (to_ast_pat ctx) pats)
+          | P.P_record(fpats,_) ->
+             P_record(List.map
+                        (fun (P.FP_aux(P.FP_Fpat(id,fp),l)) ->
+                          FP_aux(FP_Fpat(to_ast_id id, to_ast_pat ctx fp),(l,())))
+                        fpats, false)
+          | P.P_vector(pats) -> P_vector(List.map (to_ast_pat ctx) pats)
+          | P.P_vector_concat(pats) -> P_vector_concat(List.map (to_ast_pat ctx) pats)
+          | P.P_tup(pats) -> P_tup(List.map (to_ast_pat ctx) pats)
+          | P.P_list(pats) -> P_list(List.map (to_ast_pat ctx) pats)
+          | P.P_cons(pat1, pat2) -> P_cons (to_ast_pat ctx pat1, to_ast_pat ctx pat2)
+          | P.P_string_append pats -> P_string_append (List.map (to_ast_pat ctx) pats)
+         ), (l,()))
+
+let rec to_ast_letbind ctx (P.LB_aux(lb,l) : P.letbind) : unit letbind =
   LB_aux(
     (match lb with
-    | Parse_ast.LB_val(pat,exp) ->
-      LB_val(to_ast_pat k_env def_ord pat, to_ast_exp k_env def_ord exp)
+    | P.LB_val(pat,exp) ->
+      LB_val(to_ast_pat ctx pat, to_ast_exp ctx exp)
     ), (l,()))
 
-and to_ast_exp (k_env : kind Envmap.t) (def_ord : order) (Parse_ast.E_aux(exp,l) : Parse_ast.exp) : unit exp =
+and to_ast_exp ctx (P.E_aux(exp,l) : P.exp) =
   E_aux(
     (match exp with
-    | Parse_ast.E_block(exps) ->
-      (match to_ast_fexps false k_env def_ord exps with
+    | P.E_block(exps) ->
+      (match to_ast_fexps false ctx exps with
       | Some(fexps) -> E_record(fexps)
-      | None -> E_block(List.map (to_ast_exp k_env def_ord) exps))
-    | Parse_ast.E_nondet(exps) -> E_nondet(List.map (to_ast_exp k_env def_ord) exps)
-    | Parse_ast.E_id(id) -> E_id(to_ast_id id)
-    | Parse_ast.E_ref(id) -> E_ref(to_ast_id id)
-    | Parse_ast.E_lit(lit) -> E_lit(to_ast_lit lit)
-    | Parse_ast.E_cast(typ,exp) -> E_cast(to_ast_typ k_env def_ord typ, to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_app(f,args) ->
-      (match List.map (to_ast_exp k_env def_ord) args with
+      | None -> E_block(List.map (to_ast_exp ctx) exps))
+    | P.E_nondet(exps) -> E_nondet(List.map (to_ast_exp ctx) exps)
+    | P.E_id(id) -> E_id(to_ast_id id)
+    | P.E_ref(id) -> E_ref(to_ast_id id)
+    | P.E_lit(lit) -> E_lit(to_ast_lit lit)
+    | P.E_cast(typ,exp) -> E_cast(to_ast_typ ctx typ, to_ast_exp ctx exp)
+    | P.E_app(f,args) ->
+      (match List.map (to_ast_exp ctx) args with
 	| [] -> E_app(to_ast_id f, [])
         | exps -> E_app(to_ast_id f, exps))
-    | Parse_ast.E_app_infix(left,op,right) ->
-      E_app_infix(to_ast_exp k_env def_ord left, to_ast_id op, to_ast_exp k_env def_ord right)
-    | Parse_ast.E_tuple(exps) -> E_tuple(List.map (to_ast_exp k_env def_ord) exps)
-    | Parse_ast.E_if(e1,e2,e3) -> E_if(to_ast_exp k_env def_ord e1, to_ast_exp k_env def_ord e2, to_ast_exp k_env def_ord e3)
-    | Parse_ast.E_for(id,e1,e2,e3,atyp,e4) ->
-      E_for(to_ast_id id,to_ast_exp k_env def_ord e1, to_ast_exp k_env def_ord e2,
-            to_ast_exp k_env def_ord e3,to_ast_order k_env def_ord atyp, to_ast_exp k_env def_ord e4)
-    | Parse_ast.E_loop (Parse_ast.While, e1, e2) -> E_loop (While, to_ast_exp k_env def_ord e1, to_ast_exp k_env def_ord e2)
-    | Parse_ast.E_loop (Parse_ast.Until, e1, e2) -> E_loop (Until, to_ast_exp k_env def_ord e1, to_ast_exp k_env def_ord e2)
-    | Parse_ast.E_vector(exps) -> E_vector(List.map (to_ast_exp k_env def_ord) exps)
-    | Parse_ast.E_vector_access(vexp,exp) -> E_vector_access(to_ast_exp k_env def_ord vexp, to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_vector_subrange(vex,exp1,exp2) ->
-      E_vector_subrange(to_ast_exp k_env def_ord vex, to_ast_exp k_env def_ord exp1, to_ast_exp k_env def_ord exp2)
-    | Parse_ast.E_vector_update(vex,exp1,exp2) ->
-      E_vector_update(to_ast_exp k_env def_ord vex, to_ast_exp k_env def_ord exp1, to_ast_exp k_env def_ord exp2)
-    | Parse_ast.E_vector_update_subrange(vex,e1,e2,e3) ->
-      E_vector_update_subrange(to_ast_exp k_env def_ord vex, to_ast_exp k_env def_ord e1,
-			       to_ast_exp k_env def_ord e2, to_ast_exp k_env def_ord e3)
-    | Parse_ast.E_vector_append(e1,e2) -> E_vector_append(to_ast_exp k_env def_ord e1,to_ast_exp k_env def_ord e2)
-    | Parse_ast.E_list(exps) -> E_list(List.map (to_ast_exp k_env def_ord) exps)
-    | Parse_ast.E_cons(e1,e2) -> E_cons(to_ast_exp k_env def_ord e1, to_ast_exp k_env def_ord e2)
-    | Parse_ast.E_record fexps ->
-       (match to_ast_fexps true k_env def_ord fexps with
+    | P.E_app_infix(left,op,right) ->
+      E_app_infix(to_ast_exp ctx left, to_ast_id op, to_ast_exp ctx right)
+    | P.E_tuple(exps) -> E_tuple(List.map (to_ast_exp ctx) exps)
+    | P.E_if(e1,e2,e3) -> E_if(to_ast_exp ctx e1, to_ast_exp ctx e2, to_ast_exp ctx e3)
+    | P.E_for(id,e1,e2,e3,atyp,e4) ->
+      E_for(to_ast_id id,to_ast_exp ctx e1, to_ast_exp ctx e2,
+            to_ast_exp ctx e3,to_ast_order ctx atyp, to_ast_exp ctx e4)
+    | P.E_loop (P.While, e1, e2) -> E_loop (While, to_ast_exp ctx e1, to_ast_exp ctx e2)
+    | P.E_loop (P.Until, e1, e2) -> E_loop (Until, to_ast_exp ctx e1, to_ast_exp ctx e2)
+    | P.E_vector(exps) -> E_vector(List.map (to_ast_exp ctx) exps)
+    | P.E_vector_access(vexp,exp) -> E_vector_access(to_ast_exp ctx vexp, to_ast_exp ctx exp)
+    | P.E_vector_subrange(vex,exp1,exp2) ->
+      E_vector_subrange(to_ast_exp ctx vex, to_ast_exp ctx exp1, to_ast_exp ctx exp2)
+    | P.E_vector_update(vex,exp1,exp2) ->
+      E_vector_update(to_ast_exp ctx vex, to_ast_exp ctx exp1, to_ast_exp ctx exp2)
+    | P.E_vector_update_subrange(vex,e1,e2,e3) ->
+      E_vector_update_subrange(to_ast_exp ctx vex, to_ast_exp ctx e1,
+			       to_ast_exp ctx e2, to_ast_exp ctx e3)
+    | P.E_vector_append(e1,e2) -> E_vector_append(to_ast_exp ctx e1,to_ast_exp ctx e2)
+    | P.E_list(exps) -> E_list(List.map (to_ast_exp ctx) exps)
+    | P.E_cons(e1,e2) -> E_cons(to_ast_exp ctx e1, to_ast_exp ctx e2)
+    | P.E_record fexps ->
+       (match to_ast_fexps true ctx fexps with
         | Some fexps -> E_record fexps
-        | None -> raise (Reporting_basic.err_unreachable l __POS__ "to_ast_fexps with true returned none"))
-    | Parse_ast.E_record_update(exp,fexps) ->
-      (match to_ast_fexps true k_env def_ord fexps with
-      | Some(fexps) -> E_record_update(to_ast_exp k_env def_ord exp, fexps)
-      | _ -> raise (Reporting_basic.err_unreachable l __POS__ "to_ast_fexps with true returned none"))
-    | Parse_ast.E_field(exp,id) -> E_field(to_ast_exp k_env def_ord exp, to_ast_id id)
-    | Parse_ast.E_case(exp,pexps) -> E_case(to_ast_exp k_env def_ord exp, List.map (to_ast_case k_env def_ord) pexps)
-    | Parse_ast.E_try (exp, pexps) -> E_try (to_ast_exp k_env def_ord exp, List.map (to_ast_case k_env def_ord) pexps)
-    | Parse_ast.E_let(leb,exp) -> E_let(to_ast_letbind k_env def_ord leb, to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_assign(lexp,exp) -> E_assign(to_ast_lexp k_env def_ord lexp, to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_var(lexp,exp1,exp2) -> E_var(to_ast_lexp k_env def_ord lexp, to_ast_exp k_env def_ord exp1, to_ast_exp k_env def_ord exp2)
-    | Parse_ast.E_sizeof(nexp) -> E_sizeof(to_ast_nexp k_env nexp)
-    | Parse_ast.E_constraint nc -> E_constraint (to_ast_nexp_constraint k_env nc)
-    | Parse_ast.E_exit exp -> E_exit(to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_throw exp -> E_throw (to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_return exp -> E_return(to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_assert(cond,msg) -> E_assert(to_ast_exp k_env def_ord cond, to_ast_exp k_env def_ord msg)
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Unparsable construct in to_ast_exp")
+        | None -> raise (Reporting.err_unreachable l __POS__ "to_ast_fexps with true returned none"))
+    | P.E_record_update(exp,fexps) ->
+      (match to_ast_fexps true ctx fexps with
+      | Some(fexps) -> E_record_update(to_ast_exp ctx exp, fexps)
+      | _ -> raise (Reporting.err_unreachable l __POS__ "to_ast_fexps with true returned none"))
+    | P.E_field(exp,id) -> E_field(to_ast_exp ctx exp, to_ast_id id)
+    | P.E_case(exp,pexps) -> E_case(to_ast_exp ctx exp, List.map (to_ast_case ctx) pexps)
+    | P.E_try (exp, pexps) -> E_try (to_ast_exp ctx exp, List.map (to_ast_case ctx) pexps)
+    | P.E_let(leb,exp) -> E_let(to_ast_letbind ctx leb, to_ast_exp ctx exp)
+    | P.E_assign(lexp,exp) -> E_assign(to_ast_lexp ctx lexp, to_ast_exp ctx exp)
+    | P.E_var(lexp,exp1,exp2) -> E_var(to_ast_lexp ctx lexp, to_ast_exp ctx exp1, to_ast_exp ctx exp2)
+    | P.E_sizeof(nexp) -> E_sizeof(to_ast_nexp ctx nexp)
+    | P.E_constraint nc -> E_constraint (to_ast_constraint ctx nc)
+    | P.E_exit exp -> E_exit(to_ast_exp ctx exp)
+    | P.E_throw exp -> E_throw (to_ast_exp ctx exp)
+    | P.E_return exp -> E_return(to_ast_exp ctx exp)
+    | P.E_assert(cond,msg) -> E_assert(to_ast_exp ctx cond, to_ast_exp ctx msg)
+    | _ -> raise (Reporting.err_unreachable l __POS__ "Unparsable construct in to_ast_exp")
     ), (l,()))
 
-and to_ast_lexp (k_env : kind Envmap.t) (def_ord : order) (Parse_ast.E_aux(exp,l) : Parse_ast.exp) : unit lexp =
+and to_ast_lexp ctx (P.E_aux(exp,l) : P.exp) : unit lexp =
   let lexp = match exp with
-    | Parse_ast.E_id id -> LEXP_id (to_ast_id id)
-    | Parse_ast.E_deref exp -> LEXP_deref (to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_cast (typ, Parse_ast.E_aux (Parse_ast.E_id id, l')) ->
-       LEXP_cast (to_ast_typ k_env def_ord typ, to_ast_id id)
-    | Parse_ast.E_tuple tups ->
-       let ltups = List.map (to_ast_lexp k_env def_ord) tups in
+    | P.E_id id -> LEXP_id (to_ast_id id)
+    | P.E_deref exp -> LEXP_deref (to_ast_exp ctx exp)
+    | P.E_cast (typ, P.E_aux (P.E_id id, l')) ->
+       LEXP_cast (to_ast_typ ctx typ, to_ast_id id)
+    | P.E_tuple tups ->
+       let ltups = List.map (to_ast_lexp ctx) tups in
        let is_ok_in_tup (LEXP_aux (le, (l, _))) =
          match le with
          | LEXP_id _ | LEXP_cast _ | LEXP_vector _ | LEXP_vector_concat _ | LEXP_field _ | LEXP_vector_range _ | LEXP_tup _ -> ()
          | LEXP_memory _ | LEXP_deref _ ->
-            typ_error l "only identifiers, fields, and vectors may be set in a tuple" None None None
+            raise (Reporting.err_typ l "only identifiers, fields, and vectors may be set in a tuple")
        in
        List.iter is_ok_in_tup ltups;
        LEXP_tup ltups
-    | Parse_ast.E_app ((Parse_ast.Id_aux (f, l') as f'), args) ->
+    | P.E_app ((P.Id_aux (f, l') as f'), args) ->
        begin match f with
-       | Parse_ast.Id(id) ->
-          (match List.map (to_ast_exp k_env def_ord) args with
+       | P.Id(id) ->
+          (match List.map (to_ast_exp ctx) args with
            | [E_aux (E_lit (L_aux (L_unit, _)), _)] -> LEXP_memory (to_ast_id f', [])
            | [E_aux (E_tuple exps,_)] -> LEXP_memory (to_ast_id f', exps)
            | args -> LEXP_memory(to_ast_id f', args))
-       | _ -> typ_error l' "memory call on lefthand side of assignment must begin with an id" None None None
+       | _ -> raise (Reporting.err_typ l' "memory call on lefthand side of assignment must begin with an id")
        end
-    | Parse_ast.E_vector_append (exp1, exp2) ->
-       LEXP_vector_concat (to_ast_lexp k_env def_ord exp1 :: to_ast_lexp_vector_concat k_env def_ord exp2)
-    | Parse_ast.E_vector_access (vexp, exp) -> LEXP_vector (to_ast_lexp k_env def_ord vexp, to_ast_exp k_env def_ord exp)
-    | Parse_ast.E_vector_subrange (vexp, exp1, exp2) ->
-       LEXP_vector_range (to_ast_lexp k_env def_ord vexp, to_ast_exp k_env def_ord exp1, to_ast_exp k_env def_ord exp2)
-    | Parse_ast.E_field (fexp, id) -> LEXP_field (to_ast_lexp k_env def_ord fexp, to_ast_id id)
-    | _ -> typ_error l "Only identifiers, cast identifiers, vector accesses, vector slices, and fields can be on the lefthand side of an assignment" None None None
+    | P.E_vector_append (exp1, exp2) ->
+       LEXP_vector_concat (to_ast_lexp ctx exp1 :: to_ast_lexp_vector_concat ctx exp2)
+    | P.E_vector_access (vexp, exp) -> LEXP_vector (to_ast_lexp ctx vexp, to_ast_exp ctx exp)
+    | P.E_vector_subrange (vexp, exp1, exp2) ->
+       LEXP_vector_range (to_ast_lexp ctx vexp, to_ast_exp ctx exp1, to_ast_exp ctx exp2)
+    | P.E_field (fexp, id) -> LEXP_field (to_ast_lexp ctx fexp, to_ast_id id)
+    | _ -> raise (Reporting.err_typ l "Only identifiers, cast identifiers, vector accesses, vector slices, and fields can be on the lefthand side of an assignment")
   in
   LEXP_aux (lexp, (l, ()))
 
-and to_ast_lexp_vector_concat k_env def_ord (Parse_ast.E_aux (exp_aux, l) as exp) =
+and to_ast_lexp_vector_concat ctx (P.E_aux (exp_aux, l) as exp) =
   match exp_aux with
-  | Parse_ast.E_vector_append (exp1, exp2) ->
-     to_ast_lexp k_env def_ord exp1 :: to_ast_lexp_vector_concat k_env def_ord exp2
-  | _ -> [to_ast_lexp k_env def_ord exp]
+  | P.E_vector_append (exp1, exp2) ->
+     to_ast_lexp ctx exp1 :: to_ast_lexp_vector_concat ctx exp2
+  | _ -> [to_ast_lexp ctx exp]
 
-and to_ast_case (k_env : kind Envmap.t) (def_ord : order) (Parse_ast.Pat_aux(pex,l) : Parse_ast.pexp) : unit pexp =
+and to_ast_case ctx (P.Pat_aux(pex,l) : P.pexp) : unit pexp =
   match pex with
-  | Parse_ast.Pat_exp(pat,exp) -> Pat_aux(Pat_exp(to_ast_pat k_env def_ord pat, to_ast_exp k_env def_ord exp),(l,()))
-  | Parse_ast.Pat_when(pat,guard,exp) ->
-     Pat_aux (Pat_when (to_ast_pat k_env def_ord pat, to_ast_exp k_env def_ord guard, to_ast_exp k_env def_ord exp), (l, ()))
+  | P.Pat_exp(pat,exp) -> Pat_aux(Pat_exp(to_ast_pat ctx pat, to_ast_exp ctx exp),(l,()))
+  | P.Pat_when(pat,guard,exp) ->
+     Pat_aux (Pat_when (to_ast_pat ctx pat, to_ast_exp ctx guard, to_ast_exp ctx exp), (l, ()))
 
-and to_ast_fexps (fail_on_error:bool) (k_env:kind Envmap.t) (def_ord:order) (exps : Parse_ast.exp list) : unit fexps option =
+and to_ast_fexps (fail_on_error:bool) ctx (exps : P.exp list) : unit fexp list option =
   match exps with
-  | [] -> Some(FES_aux(FES_Fexps([],false), (Parse_ast.Unknown,())))
-  | fexp::exps -> let maybe_fexp,maybe_error = to_ast_record_try k_env def_ord fexp in
+  | [] -> Some []
+  | fexp::exps -> let maybe_fexp,maybe_error = to_ast_record_try ctx fexp in
                   (match maybe_fexp,maybe_error with
                   | Some(fexp),None ->
-                    (match (to_ast_fexps fail_on_error k_env def_ord exps) with
-                    | Some(FES_aux(FES_Fexps(fexps,_),l)) -> Some(FES_aux(FES_Fexps(fexp::fexps,false),l))
+                    (match (to_ast_fexps fail_on_error ctx exps) with
+                    | Some(fexps) -> Some(fexp::fexps)
                     | _  -> None)
                   | None,Some(l,msg) ->
                     if fail_on_error
-                    then typ_error l msg None None None
+                    then raise (Reporting.err_typ l msg)
                     else None
                   | _ -> None)
 
-and to_ast_record_try (k_env:kind Envmap.t) (def_ord:order) (Parse_ast.E_aux(exp,l):Parse_ast.exp): unit fexp option * (l * string) option =
+and to_ast_record_try ctx (P.E_aux(exp,l):P.exp): unit fexp option * (l * string) option =
   match exp with
-  | Parse_ast.E_app_infix(left,op,r) ->
+  | P.E_app_infix(left,op,r) ->
     (match left, op with
-    | Parse_ast.E_aux(Parse_ast.E_id(id),li), Parse_ast.Id_aux(Parse_ast.Id("="),leq) ->
-      Some(FE_aux(FE_Fexp(to_ast_id id, to_ast_exp k_env def_ord r), (l,()))),None
-    | Parse_ast.E_aux(_,li) , Parse_ast.Id_aux(Parse_ast.Id("="),leq) ->
+    | P.E_aux(P.E_id(id),li), P.Id_aux(P.Id("="),leq) ->
+      Some(FE_aux(FE_Fexp(to_ast_id id, to_ast_exp ctx r), (l,()))),None
+    | P.E_aux(_,li) , P.Id_aux(P.Id("="),leq) ->
       None,Some(li,"Expected an identifier to begin this field assignment")
-    | Parse_ast.E_aux(Parse_ast.E_id(id),li), Parse_ast.Id_aux(_,leq) ->
+    | P.E_aux(P.E_id(id),li), P.Id_aux(_,leq) ->
       None,Some(leq,"Expected a field assignment to be identifier = expression")
-    | Parse_ast.E_aux(_,li),Parse_ast.Id_aux(_,leq) ->
+    | P.E_aux(_,li),P.Id_aux(_,leq) ->
       None,Some(l,"Expected a field assignment to be identifier = expression"))
   | _ ->
-    None,Some(l, "Expected a field assignment to be identifier = expression")
+     None,Some(l, "Expected a field assignment to be identifier = expression")
+
+type 'a ctx_out = 'a * ctx
 
-let to_ast_default (names, k_env, default_order) (default : Parse_ast.default_typing_spec) : default_spec envs_out =
+let to_ast_default ctx (default : P.default_typing_spec) : default_spec ctx_out =
   match default with
-  | Parse_ast.DT_aux(Parse_ast.DT_order(bk,o),l) ->
-     let k,k_typ = to_ast_base_kind bk in
-     (match (k,o) with
-      | (BK_aux(BK_order, _), Parse_ast.ATyp_aux(Parse_ast.ATyp_inc,lo)) ->
-         let default_order = Ord_aux(Ord_inc,lo) in
-         DT_aux(DT_order default_order,l),(names,k_env,default_order)
-      | (BK_aux(BK_order, _), Parse_ast.ATyp_aux(Parse_ast.ATyp_dec,lo)) ->
-         let default_order = Ord_aux(Ord_dec,lo) in
-         DT_aux(DT_order default_order,l),(names,k_env,default_order)
-      | _ -> typ_error l "Inc and Dec must have kind Order" None None None)
-
-let to_ast_spec (names,k_env,default_order) (val_:Parse_ast.val_spec) : (unit val_spec) envs_out =
+  | P.DT_aux(P.DT_order(k,o),l) ->
+     let k = to_ast_kind k in
+     match (k,o) with
+     | K_aux(K_order, _), P.ATyp_aux(P.ATyp_inc,lo) ->
+        let default_order = Ord_aux(Ord_inc,lo) in
+        DT_aux(DT_order default_order,l),ctx
+     | K_aux(K_order, _), P.ATyp_aux(P.ATyp_dec,lo) ->
+        let default_order = Ord_aux(Ord_dec,lo) in
+        DT_aux(DT_order default_order,l),ctx
+     | _ -> raise (Reporting.err_typ l "Inc and Dec must have kind Order")
+
+let to_ast_spec ctx (val_:P.val_spec) : (unit val_spec) ctx_out =
   match val_ with
-  | Parse_ast.VS_aux(vs,l) ->
+  | P.VS_aux(vs,l) ->
     (match vs with
-    | Parse_ast.VS_val_spec(ts,id,ext,is_cast) ->
-      let typsch,_,_ = to_ast_typschm k_env default_order ts in
-      VS_aux(VS_val_spec(typsch,to_ast_id id,ext,is_cast),(l,())),(names,k_env,default_order))
+    | P.VS_val_spec(ts,id,ext,is_cast) ->
+      let typschm, _ = to_ast_typschm ctx ts in
+      VS_aux(VS_val_spec(typschm,to_ast_id id,ext,is_cast),(l,())),ctx)
 
-let to_ast_namescm (Parse_ast.Name_sect_aux(ns,l)) =
+let to_ast_namescm (P.Name_sect_aux(ns,l)) =
   Name_sect_aux(
     (match ns with
-    | Parse_ast.Name_sect_none -> Name_sect_none
-    | Parse_ast.Name_sect_some(s) -> Name_sect_some(s)
+    | P.Name_sect_none -> Name_sect_none
+    | P.Name_sect_some(s) -> Name_sect_some(s)
     ),l)
 
-let rec to_ast_range (Parse_ast.BF_aux(r,l)) = (* TODO add check that ranges are sensible for some definition of sensible *)
+let rec to_ast_range (P.BF_aux(r,l)) = (* TODO add check that ranges are sensible for some definition of sensible *)
   BF_aux(
     (match r with
-    | Parse_ast.BF_single(i) -> BF_single(i)
-    | Parse_ast.BF_range(i1,i2) -> BF_range(i1,i2)
-    | Parse_ast.BF_concat(ir1,ir2) -> BF_concat( to_ast_range ir1, to_ast_range ir2)),
+    | P.BF_single(i) -> BF_single(i)
+    | P.BF_range(i1,i2) -> BF_range(i1,i2)
+    | P.BF_concat(ir1,ir2) -> BF_concat( to_ast_range ir1, to_ast_range ir2)),
     l)
 
-let to_ast_type_union k_env default_order (Parse_ast.Tu_aux (Parse_ast.Tu_ty_id (atyp, id), l)) =
-  let typ = to_ast_typ k_env default_order atyp in
+let to_ast_type_union ctx (P.Tu_aux (P.Tu_ty_id (atyp, id), l)) =
+  let typ = to_ast_typ ctx atyp in
   Tu_aux (Tu_ty_id (typ, to_ast_id id), l)
 
-let to_ast_typedef (names,k_env,def_ord) (td:Parse_ast.type_def) : (unit type_def) envs_out =
-  match td with
-  | Parse_ast.TD_aux(td,l) ->
-  (match td with
-  | Parse_ast.TD_abbrev(id,name_scm_opt,typschm) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let typschm,k_env,_ = to_ast_typschm k_env def_ord typschm in
-    let td_abrv = TD_aux(TD_abbrev(id,to_ast_namescm name_scm_opt,typschm),(l,())) in
-    let typ = (match typschm with
-      | TypSchm_aux(TypSchm_ts(tq,typ), _) ->
-        begin match (typquant_to_quantkinds k_env tq) with
-        | [] -> {k = K_Typ}
-        | typs -> {k= K_Lam(typs,{k=K_Typ})}
-        end) in
-    td_abrv,(names,Envmap.insert k_env (key,typ),def_ord)
-  | Parse_ast.TD_record(id,name_scm_opt,typq,fields,_) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let typq,k_env,_ = to_ast_typquant k_env typq in
-    let fields = List.map (fun (atyp,id) -> (to_ast_typ k_env def_ord atyp),(to_ast_id id)) fields in (* Add check that all arms have unique names locally *)
-    let td_rec = TD_aux(TD_record(id,to_ast_namescm name_scm_opt,typq,fields,false),(l,())) in
-    let typ = (match (typquant_to_quantkinds k_env typq) with
-      | [ ] -> {k = K_Typ}
-      | typs -> {k = K_Lam(typs,{k=K_Typ})}) in
-    td_rec, (names,Envmap.insert k_env (key,typ), def_ord)
-  | Parse_ast.TD_variant(id,name_scm_opt,typq,arms,_) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let typq,k_env,_ = to_ast_typquant k_env typq in
-    let arms = List.map (to_ast_type_union k_env def_ord) arms in (* Add check that all arms have unique names *)
-    let td_var = TD_aux(TD_variant(id,to_ast_namescm name_scm_opt,typq,arms,false),(l,())) in
-    let typ = (match (typquant_to_quantkinds k_env typq) with
-      | [ ] -> {k = K_Typ}
-      | typs -> {k = K_Lam(typs,{k=K_Typ})}) in
-    td_var, (names,Envmap.insert k_env (key,typ), def_ord)
-  | Parse_ast.TD_enum(id,name_scm_opt,enums,_) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let enums = List.map to_ast_id enums in
-    let keys = List.map id_to_string enums in
-    let td_enum = TD_aux(TD_enum(id,to_ast_namescm name_scm_opt,enums,false),(l,())) in (* Add check that all enums have unique names *)
-    let k_env = List.fold_right (fun k k_env -> Envmap.insert k_env (k,{k=K_Nat})) keys (Envmap.insert k_env (key,{k=K_Typ})) in
-    td_enum, (names,k_env,def_ord)
-  | Parse_ast.TD_bitfield(id,typ,ranges) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let typ = to_ast_typ k_env def_ord typ in
-    let ranges = List.map (fun (id, range) -> (to_ast_id id, to_ast_range range)) ranges in
-    TD_aux(TD_bitfield(id,typ,ranges),(l,())), (names,Envmap.insert k_env (key, {k=K_Typ}),def_ord))
-
-let to_ast_kdef (names,k_env,def_ord) (td:Parse_ast.kind_def) : (unit kind_def) envs_out =
+let add_constructor id typq ctx =
+  let kinds = List.map (fun kopt -> unaux_kind (kopt_kind kopt)) (quant_kopts typq) in
+  { ctx with type_constructors = Bindings.add id kinds ctx.type_constructors }
+
+let to_ast_typedef ctx (P.TD_aux (aux, l) : P.type_def) : unit type_def ctx_out =
+  let aux, ctx = match aux with
+    | P.TD_abbrev (id, typq, kind, typ_arg) ->
+       let id = to_ast_id id in
+       let typq, typq_ctx = to_ast_typquant ctx typq in
+       let kind = to_ast_kind kind in
+       let typ_arg = to_ast_typ_arg typq_ctx typ_arg (unaux_kind kind) in
+       TD_abbrev (id, typq, typ_arg),
+       add_constructor id typq ctx
+
+    | P.TD_record (id, namescm_opt, typq, fields, _) ->
+       let id = to_ast_id id in
+       let typq, typq_ctx = to_ast_typquant ctx typq in
+       let fields = List.map (fun (atyp, id) -> to_ast_typ typq_ctx atyp, to_ast_id id) fields in
+       TD_record (id, to_ast_namescm namescm_opt, typq, fields, false),
+       add_constructor id typq ctx
+
+    | P.TD_variant (id, namescm_opt, typq, arms, _) ->
+       let id = to_ast_id id in
+       let typq, typq_ctx = to_ast_typquant ctx typq in
+       let arms = List.map (to_ast_type_union typq_ctx) arms in
+       TD_variant (id, to_ast_namescm namescm_opt, typq, arms, false),
+       add_constructor id typq ctx
+
+    | P.TD_enum (id, namescm_opt, enums, _) ->
+       let id = to_ast_id id in
+       let enums = List.map to_ast_id enums in
+       TD_enum (id, to_ast_namescm namescm_opt, enums, false),
+       { ctx with type_constructors = Bindings.add id [] ctx.type_constructors }
+
+    | P.TD_bitfield (id, typ, ranges) ->
+       let id = to_ast_id id in
+       let typ = to_ast_typ ctx typ in
+       let ranges = List.map (fun (id, range) -> (to_ast_id id, to_ast_range range)) ranges in
+       TD_bitfield (id, typ, ranges),
+       { ctx with type_constructors = Bindings.add id [] ctx.type_constructors }
+  in
+  TD_aux (aux, (l, ())), ctx
+
+let to_ast_kdef ctx (td:P.kind_def) : unit kind_def =
   match td with
-  | Parse_ast.KD_aux(td,l) ->
-  (match td with
-  | Parse_ast.KD_abbrev(kind,id,name_scm_opt,typschm) ->
-    let id = to_ast_id id in
-    let key = id_to_string id in
-    let (kind,k) = to_ast_kind k_env kind in
-    (match k.k with
-     | K_Nat ->
-       let kd_nabrv =
-         (match typschm with
-          | Parse_ast.TypSchm_aux(Parse_ast.TypSchm_ts(Parse_ast.TypQ_aux(tq,_),atyp),_) ->
-            (match tq with
-             | Parse_ast.TypQ_no_forall ->
-               KD_aux(KD_nabbrev(kind,id,to_ast_namescm name_scm_opt, to_ast_nexp k_env atyp), (l,()))
-             | _ -> typ_error l "Def with kind Nat cannot have universal quantification" None None None)) in
-       kd_nabrv,(names,Envmap.insert k_env (key, k),def_ord)
-     | _ -> assert false
-    ))
-
-let to_ast_rec (Parse_ast.Rec_aux(r,l): Parse_ast.rec_opt) : rec_opt =
+  | P.KD_aux (P.KD_nabbrev (kind, id, name_scm_opt, atyp), l) ->
+     let id = to_ast_id id in
+     let kind = to_ast_kind kind in
+     KD_aux (KD_nabbrev (kind, id, to_ast_namescm name_scm_opt, to_ast_nexp ctx atyp), (l, ()))
+
+let to_ast_rec ctx (P.Rec_aux(r,l): P.rec_opt) : unit rec_opt =
   Rec_aux((match r with
-  | Parse_ast.Rec_nonrec -> Rec_nonrec
-  | Parse_ast.Rec_rec -> Rec_rec
+  | P.Rec_nonrec -> Rec_nonrec
+  | P.Rec_rec -> Rec_rec
+  | P.Rec_measure (p,e) ->
+     Rec_measure (to_ast_pat ctx p, to_ast_exp ctx e)
   ),l)
 
-let to_ast_tannot_opt (k_env:kind Envmap.t) (def_ord:order) (Parse_ast.Typ_annot_opt_aux(tp,l)):tannot_opt * kind Envmap.t * kind Envmap.t=
+let to_ast_tannot_opt ctx (P.Typ_annot_opt_aux(tp,l)) : tannot_opt ctx_out =
   match tp with
-  | Parse_ast.Typ_annot_opt_none ->
-     Typ_annot_opt_aux (Typ_annot_opt_none, l), k_env, Envmap.empty
-  | Parse_ast.Typ_annot_opt_some(tq,typ) ->
-    let typq,k_env,k_local = to_ast_typquant k_env tq in
-    Typ_annot_opt_aux(Typ_annot_opt_some(typq,to_ast_typ k_env def_ord typ),l),k_env,k_local
+  | P.Typ_annot_opt_none ->
+     Typ_annot_opt_aux (Typ_annot_opt_none, l), ctx
+  | P.Typ_annot_opt_some(tq,typ) ->
+    let typq, ctx = to_ast_typquant ctx tq in
+    Typ_annot_opt_aux (Typ_annot_opt_some(typq,to_ast_typ ctx typ),l),ctx
 
-let to_ast_typschm_opt (k_env:kind Envmap.t) (def_ord:order) (Parse_ast.TypSchm_opt_aux(aux,l)) : tannot_opt * kind Envmap.t * kind Envmap.t =
+let to_ast_typschm_opt ctx (P.TypSchm_opt_aux(aux,l)) : tannot_opt ctx_out =
   match aux with
-  | Parse_ast.TypSchm_opt_none ->
-     Typ_annot_opt_aux (Typ_annot_opt_none, l), k_env, Envmap.empty
-  | Parse_ast.TypSchm_opt_some (Parse_ast.TypSchm_aux (Parse_ast.TypSchm_ts (tq, typ), l)) ->
-     let typq, k_env, k_local = to_ast_typquant k_env tq in
-     Typ_annot_opt_aux (Typ_annot_opt_some (typq, to_ast_typ k_env def_ord typ), l), k_env, k_local
-
+  | P.TypSchm_opt_none ->
+     Typ_annot_opt_aux (Typ_annot_opt_none, l), ctx
+  | P.TypSchm_opt_some (P.TypSchm_aux (P.TypSchm_ts (tq, typ), l)) ->
+     let typq, ctx = to_ast_typquant ctx tq in
+     Typ_annot_opt_aux (Typ_annot_opt_some (typq, to_ast_typ ctx typ), l), ctx
 
-let to_ast_effects_opt (k_env : kind Envmap.t) (Parse_ast.Effect_opt_aux(e,l)) : effect_opt =
+let to_ast_effects_opt (P.Effect_opt_aux(e,l)) : effect_opt =
   match e with
-  | Parse_ast.Effect_opt_pure -> Effect_opt_aux(Effect_opt_pure,l)
-  | Parse_ast.Effect_opt_effect(typ) -> Effect_opt_aux(Effect_opt_effect(to_ast_effects k_env typ),l)
+  | P.Effect_opt_pure -> Effect_opt_aux(Effect_opt_pure,l)
+  | P.Effect_opt_effect(typ) -> Effect_opt_aux(Effect_opt_effect(to_ast_effects typ),l)
 
-let to_ast_funcl (names,k_env,def_ord) (Parse_ast.FCL_aux(fcl,l) : Parse_ast.funcl) : (unit funcl) =
-  (*let _ = Printf.eprintf "to_ast_funcl\n" in*)
+let to_ast_funcl ctx (P.FCL_aux(fcl,l) : P.funcl) : (unit funcl) =
   match fcl with
-  | Parse_ast.FCL_Funcl(id,pexp) ->
-    FCL_aux(FCL_Funcl(to_ast_id id, to_ast_case k_env def_ord pexp),(l,()))
+  | P.FCL_Funcl(id,pexp) ->
+    FCL_aux(FCL_Funcl(to_ast_id id, to_ast_case ctx pexp),(l,()))
 
-let to_ast_fundef  (names,k_env,def_ord) (Parse_ast.FD_aux(fd,l):Parse_ast.fundef) : (unit fundef) envs_out =
+let to_ast_fundef ctx (P.FD_aux(fd,l):P.fundef) : unit fundef =
   match fd with
-  | Parse_ast.FD_function(rec_opt,tannot_opt,effects_opt,funcls) ->
-    (*let _ = Printf.eprintf "to_ast_fundef\n" in*)
-    let tannot_opt, k_env,_ = to_ast_tannot_opt k_env def_ord tannot_opt in
-    FD_aux(FD_function(to_ast_rec rec_opt, tannot_opt, to_ast_effects_opt k_env effects_opt, List.map (to_ast_funcl (names, k_env, def_ord)) funcls), (l,())), (names,k_env,def_ord)
+  | P.FD_function(rec_opt,tannot_opt,effects_opt,funcls) ->
+    let tannot_opt, ctx = to_ast_tannot_opt ctx tannot_opt in
+    FD_aux(FD_function(to_ast_rec ctx rec_opt, tannot_opt, to_ast_effects_opt effects_opt, List.map (to_ast_funcl ctx) funcls), (l,()))
 
-let rec to_ast_mpat k_env def_ord (Parse_ast.MP_aux(mpat,l)) =
+let rec to_ast_mpat ctx (P.MP_aux(mpat,l)) =
   MP_aux(
     (match mpat with
-    | Parse_ast.MP_lit(lit) -> MP_lit(to_ast_lit lit)
-    | Parse_ast.MP_id(id) -> MP_id(to_ast_id id)
-    | Parse_ast.MP_as (mpat, id) -> MP_as (to_ast_mpat k_env def_ord mpat, to_ast_id id)
-    | Parse_ast.MP_app(id,mpats) ->
+    | P.MP_lit(lit) -> MP_lit(to_ast_lit lit)
+    | P.MP_id(id) -> MP_id(to_ast_id id)
+    | P.MP_as (mpat, id) -> MP_as (to_ast_mpat ctx mpat, to_ast_id id)
+    | P.MP_app(id,mpats) ->
       if mpats = []
       then MP_id (to_ast_id id)
-      else MP_app(to_ast_id id, List.map (to_ast_mpat k_env def_ord) mpats)
-    | Parse_ast.MP_record(mfpats,_) ->
+      else MP_app(to_ast_id id, List.map (to_ast_mpat ctx) mpats)
+    | P.MP_record(mfpats,_) ->
       MP_record(List.map
-                 (fun (Parse_ast.MFP_aux(Parse_ast.MFP_mpat(id,mfp),l)) ->
-              MFP_aux(MFP_mpat(to_ast_id id, to_ast_mpat k_env def_ord mfp),(l,())))
+                 (fun (P.MFP_aux(P.MFP_mpat(id,mfp),l)) ->
+              MFP_aux(MFP_mpat(to_ast_id id, to_ast_mpat ctx mfp),(l,())))
                  mfpats, false)
-    | Parse_ast.MP_vector(mpats) -> MP_vector(List.map (to_ast_mpat k_env def_ord) mpats)
-    | Parse_ast.MP_vector_concat(mpats) -> MP_vector_concat(List.map (to_ast_mpat k_env def_ord) mpats)
-    | Parse_ast.MP_tup(mpats) -> MP_tup(List.map (to_ast_mpat k_env def_ord) mpats)
-    | Parse_ast.MP_list(mpats) -> MP_list(List.map (to_ast_mpat k_env def_ord) mpats)
-    | Parse_ast.MP_cons(pat1, pat2) -> MP_cons (to_ast_mpat k_env def_ord pat1, to_ast_mpat k_env def_ord pat2)
-    | Parse_ast.MP_string_append pats -> MP_string_append (List.map (to_ast_mpat k_env def_ord) pats)
-    | Parse_ast.MP_typ (mpat, typ) -> MP_typ (to_ast_mpat k_env def_ord mpat, to_ast_typ k_env def_ord typ)
+    | P.MP_vector(mpats) -> MP_vector(List.map (to_ast_mpat ctx) mpats)
+    | P.MP_vector_concat(mpats) -> MP_vector_concat(List.map (to_ast_mpat ctx) mpats)
+    | P.MP_tup(mpats) -> MP_tup(List.map (to_ast_mpat ctx) mpats)
+    | P.MP_list(mpats) -> MP_list(List.map (to_ast_mpat ctx) mpats)
+    | P.MP_cons(pat1, pat2) -> MP_cons (to_ast_mpat ctx pat1, to_ast_mpat ctx pat2)
+    | P.MP_string_append pats -> MP_string_append (List.map (to_ast_mpat ctx) pats)
+    | P.MP_typ (mpat, typ) -> MP_typ (to_ast_mpat ctx mpat, to_ast_typ ctx typ)
     ), (l,()))
 
-
-let to_ast_mpexp (names,k_env,def_ord) (Parse_ast.MPat_aux(mpexp, l)) =
+let to_ast_mpexp ctx (P.MPat_aux(mpexp, l)) =
   match mpexp with
-  | Parse_ast.MPat_pat mpat -> MPat_aux (MPat_pat (to_ast_mpat k_env def_ord mpat), (l, ()))
-  | Parse_ast.MPat_when (mpat, exp) -> MPat_aux (MPat_when (to_ast_mpat k_env def_ord mpat, to_ast_exp k_env def_ord exp), (l, ()))
+  | P.MPat_pat mpat -> MPat_aux (MPat_pat (to_ast_mpat ctx mpat), (l, ()))
+  | P.MPat_when (mpat, exp) -> MPat_aux (MPat_when (to_ast_mpat ctx mpat, to_ast_exp ctx exp), (l, ()))
 
-let to_ast_mapcl (names,k_env,def_ord) (Parse_ast.MCL_aux(mapcl, l)) =
+let to_ast_mapcl ctx (P.MCL_aux(mapcl, l)) =
   match mapcl with
-  | Parse_ast.MCL_bidir (mpexp1, mpexp2) -> MCL_aux (MCL_bidir (to_ast_mpexp (names,k_env,def_ord) mpexp1, to_ast_mpexp (names,k_env,def_ord) mpexp2), (l, ()))
-  | Parse_ast.MCL_forwards (mpexp, exp) -> MCL_aux (MCL_forwards (to_ast_mpexp (names,k_env,def_ord) mpexp, to_ast_exp k_env def_ord exp), (l, ()))
-  | Parse_ast.MCL_backwards (mpexp, exp) -> MCL_aux (MCL_backwards (to_ast_mpexp (names,k_env,def_ord) mpexp, to_ast_exp k_env def_ord exp), (l, ()))
+  | P.MCL_bidir (mpexp1, mpexp2) -> MCL_aux (MCL_bidir (to_ast_mpexp ctx mpexp1, to_ast_mpexp ctx mpexp2), (l, ()))
+  | P.MCL_forwards (mpexp, exp) -> MCL_aux (MCL_forwards (to_ast_mpexp ctx mpexp, to_ast_exp ctx exp), (l, ()))
+  | P.MCL_backwards (mpexp, exp) -> MCL_aux (MCL_backwards (to_ast_mpexp ctx mpexp, to_ast_exp ctx exp), (l, ()))
 
-let to_ast_mapdef (names,k_env,def_ord) (Parse_ast.MD_aux(md,l):Parse_ast.mapdef) : (unit mapdef) envs_out =
+let to_ast_mapdef ctx (P.MD_aux(md,l):P.mapdef) : unit mapdef =
   match md with
-  | Parse_ast.MD_mapping(id, typschm_opt, mapcls) ->
-     let tannot_opt, k_env, _ = to_ast_typschm_opt k_env def_ord typschm_opt in
-     MD_aux(MD_mapping(to_ast_id id, tannot_opt, List.map (to_ast_mapcl (names,k_env,def_ord)) mapcls), (l,())), (names,k_env,def_ord)
-
-type def_progress =
-    No_def
-  | Def_place_holder of id * Parse_ast.l
-  | Finished of unit def
-
-type partial_def = ((unit def) * bool) ref * kind Envmap.t
-
-let rec def_in_progress (id : id) (partial_defs : (id * partial_def) list) : partial_def option =
-  match partial_defs with
-  | [] -> None
-  | (n,pd)::defs ->
-    (match n,id with
-    | Id_aux(Id(n),_), Id_aux(Id(i),_) -> if (n = i) then Some(pd) else def_in_progress id defs
-    | _,_ -> def_in_progress id defs)
-
-let to_ast_alias_spec k_env def_ord (Parse_ast.E_aux(e,le)) =
-  AL_aux(
-    (match e with
-      | Parse_ast.E_field(Parse_ast.E_aux(Parse_ast.E_id id,li), field) ->
-	AL_subreg(RI_aux(RI_id (to_ast_id id),(li,())),to_ast_id field)
-      | Parse_ast.E_vector_access(Parse_ast.E_aux(Parse_ast.E_id id,li),range) ->
-	AL_bit(RI_aux(RI_id (to_ast_id id),(li,())),to_ast_exp k_env def_ord range)
-      | Parse_ast.E_vector_subrange(Parse_ast.E_aux(Parse_ast.E_id id,li),base,stop) ->
-	AL_slice(RI_aux(RI_id (to_ast_id id),(li,())),to_ast_exp k_env def_ord base,to_ast_exp k_env def_ord stop)
-      | Parse_ast.E_vector_append(Parse_ast.E_aux(Parse_ast.E_id first,lf),
-				  Parse_ast.E_aux(Parse_ast.E_id second,ls)) ->
-	AL_concat(RI_aux(RI_id (to_ast_id first),(lf,())),
-		  RI_aux(RI_id (to_ast_id second),(ls,())))
-      | _ -> raise (Reporting_basic.err_unreachable le __POS__ "Found an expression not supported by parser in to_ast_alias_spec")
-    ), (le,()))
-
-let to_ast_dec (names,k_env,def_ord) (Parse_ast.DEC_aux(regdec,l)) =
-  DEC_aux(
-    (match regdec with
-      | Parse_ast.DEC_reg(typ,id) ->
-        DEC_reg(to_ast_typ k_env def_ord typ,to_ast_id id)
-      | Parse_ast.DEC_config(id,typ,exp) ->
-        DEC_config(to_ast_id id,to_ast_typ k_env def_ord typ,to_ast_exp k_env def_ord exp)
-      | Parse_ast.DEC_alias(id,e) ->
-	DEC_alias(to_ast_id id,to_ast_alias_spec k_env def_ord e)
-      | Parse_ast.DEC_typ_alias(typ,id,e) ->
-	DEC_typ_alias(to_ast_typ k_env def_ord typ,to_ast_id id,to_ast_alias_spec k_env def_ord e)
-    ),(l,()))
+  | P.MD_mapping(id, typschm_opt, mapcls) ->
+     let tannot_opt, ctx = to_ast_typschm_opt ctx typschm_opt in
+     MD_aux(MD_mapping(to_ast_id id, tannot_opt, List.map (to_ast_mapcl ctx) mapcls), (l,()))
+
+let to_ast_alias_spec ctx (P.E_aux(e, l)) =
+  AL_aux((match e with
+          | P.E_field (P.E_aux (P.E_id id, li), field) ->
+             AL_subreg (RI_aux (RI_id (to_ast_id id), (li, ())), to_ast_id field)
+          | P.E_vector_access (P.E_aux (P.E_id id, li), range) ->
+             AL_bit (RI_aux (RI_id (to_ast_id id), (li, ())), to_ast_exp ctx range)
+          | P.E_vector_subrange(P.E_aux(P.E_id id,li),base,stop) ->
+             AL_slice (RI_aux (RI_id (to_ast_id id), (li,())), to_ast_exp ctx base, to_ast_exp ctx stop)
+          | P.E_vector_append (P.E_aux (P.E_id first, lf), P.E_aux (P.E_id second, ls)) ->
+             AL_concat (RI_aux (RI_id (to_ast_id first), (lf, ())),
+                        RI_aux (RI_id (to_ast_id second), (ls, ())))
+          | _ -> raise (Reporting.err_unreachable l __POS__ "Found an expression not supported by parser in to_ast_alias_spec")
+         ), (l, ()))
+
+let to_ast_dec ctx (P.DEC_aux(regdec,l)) =
+  DEC_aux((match regdec with
+           | P.DEC_reg (typ, id) ->
+              DEC_reg (to_ast_typ ctx typ, to_ast_id id)
+           | P.DEC_config (id, typ, exp) ->
+              DEC_config (to_ast_id id, to_ast_typ ctx typ, to_ast_exp ctx exp)
+           | P.DEC_alias (id,e) ->
+              DEC_alias (to_ast_id id, to_ast_alias_spec ctx e)
+           | P.DEC_typ_alias (typ,id,e) ->
+              DEC_typ_alias (to_ast_typ ctx typ, to_ast_id id, to_ast_alias_spec ctx e)
+          ),(l,()))
+
+let to_ast_scattered ctx (P.SD_aux (aux, l)) =
+  let aux, ctx = match aux with
+    | P.SD_function (rec_opt, tannot_opt, effect_opt, id) ->
+       let tannot_opt, _ = to_ast_tannot_opt ctx tannot_opt in
+       let effect_opt = to_ast_effects_opt effect_opt in
+       SD_function (to_ast_rec ctx rec_opt, tannot_opt, effect_opt, to_ast_id id), ctx
+    | P.SD_funcl funcl ->
+       SD_funcl (to_ast_funcl ctx funcl), ctx
+    | P.SD_variant (id, namescm_opt, typq) ->
+       let id = to_ast_id id in
+       let typq, typq_ctx = to_ast_typquant ctx typq in
+       SD_variant (id, to_ast_namescm namescm_opt, typq),
+       add_constructor id typq { ctx with scattereds = Bindings.add id typq_ctx ctx.scattereds }
+    | P.SD_unioncl (id, tu) ->
+       let id = to_ast_id id in
+       begin match Bindings.find_opt id ctx.scattereds with
+       | Some typq_ctx ->
+          let tu = to_ast_type_union typq_ctx tu in
+          SD_unioncl (id, tu), ctx
+       | None -> raise (Reporting.err_typ l ("No scattered union declaration found for " ^ string_of_id id))
+       end
+    | P.SD_end id -> SD_end (to_ast_id id), ctx
+    | P.SD_mapping (id, tannot_opt) ->
+       let id = to_ast_id id in
+       let tannot_opt, _ = to_ast_tannot_opt ctx tannot_opt in
+       SD_mapping (id, tannot_opt), ctx
+    | P.SD_mapcl (id, mapcl) ->
+       let id = to_ast_id id in
+       let mapcl = to_ast_mapcl ctx mapcl in
+       SD_mapcl (id, mapcl), ctx
+  in
+  SD_aux (aux, (l, ())), ctx
 
 let to_ast_prec = function
-  | Parse_ast.Infix -> Infix
-  | Parse_ast.InfixL -> InfixL
-  | Parse_ast.InfixR -> InfixR
+  | P.Infix -> Infix
+  | P.InfixL -> InfixL
+  | P.InfixR -> InfixR
 
-let to_ast_def (names, k_env, def_ord) partial_defs def : def_progress envs_out * (id * partial_def) list =
-  let envs = (names,k_env,def_ord) in
+let to_ast_def ctx def : unit def ctx_out =
   match def with
-  | Parse_ast.DEF_overload(id,ids) ->
-     ((Finished(DEF_overload(to_ast_id id, List.map to_ast_id ids))),envs),partial_defs
-  | Parse_ast.DEF_fixity (prec, n, op) ->
-     ((Finished(DEF_fixity (to_ast_prec prec, n, to_ast_id op)),envs),partial_defs)
-  | Parse_ast.DEF_kind(k_def) ->
-     let kd,envs = to_ast_kdef envs k_def in
-     ((Finished(DEF_kind(kd))),envs),partial_defs
-  | Parse_ast.DEF_type(t_def) ->
-     let td,envs = to_ast_typedef envs t_def in
-     ((Finished(DEF_type(td))),envs),partial_defs
-  | Parse_ast.DEF_fundef(f_def) ->
-     let fd,envs = to_ast_fundef envs f_def in
-     ((Finished(DEF_fundef(fd))),envs),partial_defs
-  | Parse_ast.DEF_mapdef(m_def) ->
-     let md, envs = to_ast_mapdef envs m_def in
-     ((Finished(DEF_mapdef(md))),envs),partial_defs
-  | Parse_ast.DEF_val(lbind) ->
-     let lb = to_ast_letbind k_env def_ord lbind in
-     ((Finished(DEF_val(lb))),envs),partial_defs
-  | Parse_ast.DEF_spec(val_spec) ->
-     let vs,envs = to_ast_spec envs val_spec in
-     ((Finished(DEF_spec(vs))),envs),partial_defs
-  | Parse_ast.DEF_default(typ_spec) ->
-     let default,envs = to_ast_default envs typ_spec in
-     ((Finished(DEF_default(default))),envs),partial_defs
-  | Parse_ast.DEF_reg_dec(dec) ->
-     let d = to_ast_dec envs dec in
-     ((Finished(DEF_reg_dec(d))),envs),partial_defs
-  | Parse_ast.DEF_constraint (id, kids, nc) ->
-     let id = to_ast_id id in
-     let kids = List.map to_ast_var kids in
-     let nc = to_ast_nexp_constraint k_env nc in
-     ((Finished (DEF_constraint (id, kids, nc))), envs), partial_defs
-  | Parse_ast.DEF_pragma (_, _, l) ->
-     typ_error l "Encountered preprocessor directive in initial check" None None None
-  | Parse_ast.DEF_internal_mutrec _ ->
+  | P.DEF_overload (id, ids) ->
+     DEF_overload (to_ast_id id, List.map to_ast_id ids), ctx
+  | P.DEF_fixity (prec, n, op) ->
+     DEF_fixity (to_ast_prec prec, n, to_ast_id op), ctx
+  | P.DEF_kind k_def ->
+     let kd = to_ast_kdef ctx k_def in
+     DEF_kind kd, ctx
+  | P.DEF_type(t_def) ->
+     let td, ctx = to_ast_typedef ctx t_def in
+     DEF_type td, ctx
+  | P.DEF_fundef(f_def) ->
+     let fd = to_ast_fundef ctx f_def in
+     DEF_fundef fd, ctx
+  | P.DEF_mapdef(m_def) ->
+     let md = to_ast_mapdef ctx m_def in
+     DEF_mapdef md, ctx
+  | P.DEF_val(lbind) ->
+     let lb = to_ast_letbind ctx lbind in
+     DEF_val lb, ctx
+  | P.DEF_spec(val_spec) ->
+     let vs,ctx = to_ast_spec ctx val_spec in
+     DEF_spec vs, ctx
+  | P.DEF_default(typ_spec) ->
+     let default,ctx = to_ast_default ctx typ_spec in
+     DEF_default default, ctx
+  | P.DEF_reg_dec dec ->
+     let d = to_ast_dec ctx dec in
+     DEF_reg_dec d, ctx
+  | P.DEF_pragma (pragma, arg, l) ->
+     DEF_pragma (pragma, arg, l), ctx
+  | P.DEF_internal_mutrec _ ->
      (* Should never occur because of remove_mutrec *)
-     typ_error Parse_ast.Unknown "Internal mutual block found when processing scattered defs" None None None
-  | Parse_ast.DEF_scattered(Parse_ast.SD_aux(sd,l)) ->
-     (match sd with
-      | Parse_ast.SD_scattered_function(rec_opt, tannot_opt, effects_opt, id) ->
-         let rec_opt = to_ast_rec rec_opt in
-         let unit,k_env',k_local = to_ast_tannot_opt k_env def_ord tannot_opt in
-         let effects_opt = to_ast_effects_opt k_env' effects_opt in
-         let id = to_ast_id id in
-         (match (def_in_progress id partial_defs) with
-          | None -> let partial_def = ref ((DEF_fundef(FD_aux(FD_function(rec_opt,unit,effects_opt,[]),(l,())))),false) in
-                    (No_def,envs),((id,(partial_def,k_local))::partial_defs)
-          | Some(d,k) -> typ_error l "Scattered function definition header name already in use by scattered definition" (Some id) None None)
-      | Parse_ast.SD_scattered_mapping (id, tannot_opt) ->
-         let id = to_ast_id id in
-         let unit, k_env ,k_local = to_ast_tannot_opt k_env def_ord tannot_opt in
-         (match (def_in_progress id partial_defs) with
-          | None -> let partial_def = ref ((DEF_mapdef(MD_aux(MD_mapping(id, unit, []), (l, ())))), false) in
-                    (No_def,envs),((id,(partial_def,k_local))::partial_defs)
-          | Some(d,k) -> typ_error l "Scattered mapping definition header name already in use by scattered definition" (Some id) None None)
-
-      | Parse_ast.SD_scattered_mapcl (id, mapcl) ->
-         let id = to_ast_id id in
-         (match (def_in_progress id partial_defs) with
-          | None -> typ_error l "Scattered mapping definition clause does not match any existing mapping definition headers" (Some id) None None
-          | Some (d, k) ->
-             (match !d with
-              | DEF_mapdef(MD_aux(MD_mapping(_,tannot_opt, mcls),ml)),false ->
-                 let (MCL_aux (mapcl_aux, _)) = to_ast_mapcl (names,k_env,def_ord) mapcl in
-                 d := DEF_mapdef(MD_aux(MD_mapping(id, tannot_opt, mcls @ [MCL_aux (mapcl_aux, (l, ()))]), ml)), false;
-                 (No_def,envs),partial_defs
-              | _, true -> typ_error l "Scattered mapping definition clause extends ended definition" (Some id) None None
-              | _ -> typ_error l "Scattered mapping definition doesn't match existing definition header" (Some id) None None))
-
-      | Parse_ast.SD_scattered_funcl(funcl) ->
-         (match funcl with
-          | Parse_ast.FCL_aux(Parse_ast.FCL_Funcl(id,_),_) ->
-             let id = to_ast_id id in
-             (match (def_in_progress id partial_defs) with
-              | None -> typ_error l "Scattered function definition clause does not match any existing function definition headers" (Some id) None None
-              | Some(d,k) ->
-                 (* let _ = Printf.eprintf "SD_scattered_funcl processing\n" in
-      let _ = Envmap.iter (fun v' k -> P   rintf.eprintf "%s -> %s\n" v' (kind_to_string k)) k in
-      let _ = Envmap.iter (fun v' k -> Prin              tf.eprintf "%s -> %s\n" v' (kind_to_string k) ) (Envmap.union k k_env) in *)
-                 (match !d with
-                  | DEF_fundef(FD_aux(FD_function(r,t,e,fcls),fl)),false ->
-                     let (FCL_aux (funcl_aux, _)) = to_ast_funcl (names,Envmap.union k k_env,def_ord) funcl in
-                     d:= DEF_fundef(FD_aux(FD_function(r,t,e,fcls@[FCL_aux (funcl_aux, (l, ()))]),fl)),false;
-                     (No_def,envs),partial_defs
-                  | _,true -> typ_error l "Scattered function definition clauses extends ended definition" (Some id) None None
-                  | _ -> typ_error l "Scattered function definition clause matches an existing scattered type definition header" (Some id) None None)))
-      | Parse_ast.SD_scattered_variant(id,naming_scheme_opt,typquant) ->
-         let id = to_ast_id id in
-         let name = to_ast_namescm naming_scheme_opt in
-         let typq, k_env',_ = to_ast_typquant k_env typquant in
-         let kind = (match (typquant_to_quantkinds k_env' typq) with
-                     | [ ] -> {k = K_Typ}
-                     | typs -> {k = K_Lam(typs,{k=K_Typ})}) in
-         (match (def_in_progress id partial_defs) with
-          | None -> let partial_def = ref ((DEF_type(TD_aux(TD_variant(id,name,typq,[],false),(l,())))),false) in
-                    (Def_place_holder(id,l),(names,Envmap.insert k_env ((id_to_string id),kind),def_ord)),(id,(partial_def,k_env'))::partial_defs
-          | Some(d,k) -> typ_error l "Scattered type definition header name already in use by scattered definition" (Some id) None None)
-      | Parse_ast.SD_scattered_unioncl(id,tu) ->
-         let id = to_ast_id id in
-         (match (def_in_progress id partial_defs) with
-          | None -> typ_error l "Scattered type definition clause does not match any existing type definition headers" (Some id) None None
-          | Some(d,k) ->
-             (match !d with
-              | DEF_type(TD_aux(TD_variant(id,name,typq,arms,false),tl)), false ->
-                 d:= DEF_type(TD_aux(TD_variant(id,name,typq,arms@[to_ast_type_union k def_ord tu],false),tl)),false;
-                 (No_def,envs),partial_defs
-              | _,true -> typ_error l "Scattered type definition clause extends ended definition" (Some id) None None
-              | _ -> typ_error l "Scattered type definition clause matches an existing scattered function definition header" (Some id) None None))
-      | Parse_ast.SD_scattered_end(id) ->
-         let id = to_ast_id id in
-         (match (def_in_progress id partial_defs) with
-          | None -> typ_error l "Scattered definition end does not match any open scattered definitions" (Some id) None None
-          | Some(d,k) ->
-             (match !d with
-              | (DEF_type(_) as def),false ->
-                 d:= (def,true);
-                 (No_def,envs),partial_defs
-              | (DEF_fundef(_) as def),false ->
-                 d:= (def,true);
-                 ((Finished def), envs),partial_defs
-              | (DEF_mapdef(_) as def),false ->
-                 d := (def,true);
-                 ((Finished def), envs),partial_defs
-              | _, true ->
-                 typ_error l "Scattered definition ended multiple times" (Some id) None None
-              | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Something in partial_defs other than fundef and type"))))
-
-let rec to_ast_defs_helper envs partial_defs = function
-  | [] -> ([],envs,partial_defs)
-  | d::ds  -> let ((d', envs), partial_defs) = to_ast_def envs partial_defs d in
-              let (defs,envs,partial_defs) = to_ast_defs_helper envs partial_defs ds in
-              (match d' with
-              | Finished def -> (def::defs,envs, partial_defs)
-              | No_def -> defs,envs,partial_defs
-              | Def_place_holder(id,l) ->
-                (match (def_in_progress id partial_defs) with
-                 | None ->
-                   raise
-                     (Reporting_basic.err_unreachable l __POS__ "Id stored in place holder not retrievable from partial defs")
-                 | Some(d,k) ->
-                   if (snd !d)
-                   then (fst !d) :: defs, envs, partial_defs
-                   else typ_error l "Scattered type definition never ended" (Some id) None None))
+     raise (Reporting.err_unreachable P.Unknown __POS__
+                                      "Internal mutual block found when processing scattered defs")
+  | P.DEF_scattered sdef ->
+     let sdef, ctx = to_ast_scattered ctx sdef in
+     DEF_scattered sdef, ctx
 
 let rec remove_mutrec = function
   | [] -> []
-  | Parse_ast.DEF_internal_mutrec fundefs :: defs ->
-     List.map (fun fdef -> Parse_ast.DEF_fundef fdef) fundefs @ remove_mutrec defs
+  | P.DEF_internal_mutrec fundefs :: defs ->
+     List.map (fun fdef -> P.DEF_fundef fdef) fundefs @ remove_mutrec defs
   | def :: defs ->
      def :: remove_mutrec defs
 
-let to_ast (default_names : Nameset.t) (kind_env : kind Envmap.t) (def_ord : order) (Parse_ast.Defs(defs)) =
+let to_ast ctx (P.Defs(defs)) =
   let defs = remove_mutrec defs in
-  let defs,(_,k_env,def_ord),partial_defs = to_ast_defs_helper (default_names,kind_env,def_ord) [] defs in
-  List.iter
-    (fun (id,(d,k)) ->
-      (match !d with
-      | (d,false) -> typ_error Parse_ast.Unknown "Scattered definition never ended" (Some id) None None
-      | (_, true) -> ()))
-    partial_defs;
-  (Defs defs),k_env,def_ord
-
-let initial_kind_env =
-  Envmap.from_list [
-    ("bool", {k = K_Typ});
-    ("nat", {k = K_Typ});
-    ("int", {k = K_Typ});
-    ("uint8", {k = K_Typ});
-    ("uint16", {k= K_Typ});
-    ("uint32", {k=K_Typ});
-    ("uint64", {k=K_Typ});
-    ("unit", {k = K_Typ});
-    ("bit", {k = K_Typ});
-    ("string", {k = K_Typ});
-    ("real", {k = K_Typ});
-    ("list", {k = K_Lam( [{k = K_Typ}], {k = K_Typ})});
-    ("reg", {k = K_Lam( [{k = K_Typ}], {k= K_Typ})});
-    ("register", {k = K_Lam( [{k = K_Typ}], {k= K_Typ})});
-    ("range", {k = K_Lam( [ {k = K_Nat}; {k= K_Nat}], {k = K_Typ}) });
-    ("vector", {k = K_Lam( [{k = K_Nat}; {k= K_Ord} ; {k=K_Typ}], {k=K_Typ}) } );
-    ("atom", {k = K_Lam( [ {k=K_Nat} ], {k=K_Typ})});
-    ("option", { k = K_Lam( [{k=K_Typ}], {k=K_Typ}) });
-    ("implicit", {k = K_Lam( [{k = K_Nat}], {k=K_Typ})} );
-    ("itself", {k = K_Lam( [ {k=K_Nat} ], {k=K_Typ})});
-  ]
-
-let exp_of_string order str =
+  let defs, ctx =
+    List.fold_left (fun (defs, ctx) def -> let def, ctx = to_ast_def ctx def in (def :: defs, ctx)) ([], ctx) defs
+  in
+  Defs (List.rev defs), ctx
+
+let initial_ctx = {
+    type_constructors =
+      List.fold_left (fun m (k, v) -> Bindings.add (mk_id k) v m) Bindings.empty
+        [ ("bool", []);
+          ("nat", []);
+          ("int", []);
+          ("unit", []);
+          ("bit", []);
+          ("string", []);
+          ("real", []);
+          ("list", [K_type]);
+          ("register", [K_type]);
+          ("range", [K_int; K_int]);
+          ("vector", [K_int; K_order; K_type]);
+          ("atom", [K_int]);
+          ("implicit", [K_int]);
+          ("itself", [K_int]);
+          ("not", [K_bool]);
+        ];
+    kinds = KBindings.empty;
+    scattereds = Bindings.empty;
+  }
+
+let exp_of_string str =
   let exp = Parser.exp_eof Lexer.token (Lexing.from_string str) in
-  to_ast_exp initial_kind_env order exp
+  to_ast_exp initial_ctx exp
 
-let typschm_of_string order str =
+let typschm_of_string str =
   let typschm = Parser.typschm_eof Lexer.token (Lexing.from_string str) in
-  let (typschm, _, _) = to_ast_typschm initial_kind_env order typschm in
+  let typschm, _ = to_ast_typschm initial_ctx typschm in
   typschm
 
-let extern_of_string order id str = mk_val_spec (VS_val_spec (typschm_of_string order str, id, [("_", string_of_id id)], false))
-let val_spec_of_string order id str = mk_val_spec (VS_val_spec (typschm_of_string order str, id, [], false))
+let typ_of_string str =
+  let typ = Parser.typ_eof Lexer.token (Lexing.from_string str) in
+  let typ = to_ast_typ initial_ctx typ in
+  typ
+
+let extern_of_string id str = mk_val_spec (VS_val_spec (typschm_of_string str, id, [("_", string_of_id id)], false))
+let val_spec_of_string id str = mk_val_spec (VS_val_spec (typschm_of_string str, id, [], false))
 
 let val_spec_ids (Defs defs) =
   let val_spec_id (VS_aux (vs_aux, _)) =
@@ -1102,8 +819,8 @@ let quant_item_typ = function
   | QI_aux (QI_id kopt, _) when is_typ_kopt kopt -> [mk_typ (Typ_var (kopt_kid kopt))]
   | _ -> []
 let quant_item_arg = function
-  | QI_aux (QI_id kopt, _) when is_nat_kopt kopt -> [mk_typ_arg (Typ_arg_nexp (nvar (kopt_kid kopt)))]
-  | QI_aux (QI_id kopt, _) when is_typ_kopt kopt -> [mk_typ_arg (Typ_arg_typ (mk_typ (Typ_var (kopt_kid kopt))))]
+  | QI_aux (QI_id kopt, _) when is_nat_kopt kopt -> [mk_typ_arg (A_nexp (nvar (kopt_kid kopt)))]
+  | QI_aux (QI_id kopt, _) when is_typ_kopt kopt -> [mk_typ_arg (A_typ (mk_typ (Typ_var (kopt_kid kopt))))]
   | _ -> []
 let undefined_typschm id typq =
   let qis = quant_items typq in
@@ -1118,7 +835,7 @@ let have_undefined_builtins = ref false
 
 let generate_undefineds vs_ids (Defs defs) =
   let gen_vs id str =
-    if (IdSet.mem id vs_ids) then [] else [extern_of_string dec_ord id str]
+    if (IdSet.mem id vs_ids) then [] else [extern_of_string id str]
   in
   let undefined_builtins =
     if !have_undefined_builtins then
@@ -1153,7 +870,7 @@ let generate_undefineds vs_ids (Defs defs) =
   in
   let undefined_td = function
     | TD_enum (id, _, ids, _) when not (IdSet.mem (prepend_id "undefined_" id) vs_ids) ->
-       let typschm = typschm_of_string dec_ord ("unit -> " ^ string_of_id id ^ " effect {undef}") in
+       let typschm = typschm_of_string ("unit -> " ^ string_of_id id ^ " effect {undef}") in
        [mk_val_spec (VS_val_spec (typschm, prepend_id "undefined_" id, [], false));
         mk_fundef [mk_funcl (prepend_id "undefined_" id)
                             (mk_pat (P_lit (mk_lit L_unit)))
@@ -1167,7 +884,7 @@ let generate_undefineds vs_ids (Defs defs) =
        [mk_val_spec (VS_val_spec (undefined_typschm id typq, prepend_id "undefined_" id, [], false));
         mk_fundef [mk_funcl (prepend_id "undefined_" id)
                             pat
-                            (mk_exp (E_record (mk_fexps (List.map (fun (_, id) -> mk_fexp id (mk_lit_exp L_undef)) fields))))]]
+                            (mk_exp (E_record (List.map (fun (_, id) -> mk_fexp id (mk_lit_exp L_undef)) fields)))]]
     | TD_variant (id, _, typq, tus, _) when not (IdSet.mem (prepend_id "undefined_" id) vs_ids) ->
        let pat = p_tup (quant_items typq |> List.map quant_item_param |> List.concat |> List.map (fun id -> mk_pat (P_id id))) in
        let body =
@@ -1181,7 +898,7 @@ let generate_undefineds vs_ids (Defs defs) =
              | Tu_aux (Tu_ty_id (typ, id), _) -> (id, [typ])
            in
            let record_arg_typs m (_,typs) =
-             let m' = 
+             let m' =
                List.fold_left (fun m typ ->
                  TypMap.add typ (1 + try TypMap.find typ m with Not_found -> 0) m) TypMap.empty typs in
              TypMap.merge (fun _ x y -> match x,y with Some m, Some n -> Some (max m n)
@@ -1237,7 +954,7 @@ let generate_initialize_registers vs_ids (Defs defs) =
   let initialize_registers =
     if IdSet.mem (mk_id "initialize_registers") vs_ids || regs = [] then []
     else
-      [val_spec_of_string dec_ord (mk_id "initialize_registers") "unit -> unit effect {undef, wreg}";
+      [val_spec_of_string (mk_id "initialize_registers") "unit -> unit effect {undef, wreg}";
        mk_fundef [mk_funcl (mk_id "initialize_registers")
                            (mk_pat (P_lit (mk_lit L_unit)))
                            (mk_exp (E_block (List.map (fun (typ, id) -> mk_exp (E_assign (mk_lexp (LEXP_cast (typ, id)), mk_lit_exp L_undef))) regs)))]]
@@ -1274,7 +991,7 @@ let generate_enum_functions vs_ids (Defs defs) =
          if IdSet.mem name vs_ids then []
          else
            [ enum_val_spec name
-              [mk_qi_id BK_int kid; mk_qi_nc (range_constraint kid)]
+              [mk_qi_id K_int kid; mk_qi_nc (range_constraint kid)]
               (function_typ [atom_typ (nvar kid)] (mk_typ (Typ_id id)) no_effect);
              mk_fundef [funcl] ]
        in
@@ -1282,7 +999,7 @@ let generate_enum_functions vs_ids (Defs defs) =
        (* Create a function that converts from an enum to a number. *)
        let from_enum =
          let kid = mk_kid "e" in
-         let to_typ = mk_typ (Typ_exist ([kid], range_constraint kid, atom_typ (nvar kid))) in
+         let to_typ = mk_typ (Typ_exist ([mk_kopt K_int kid], range_constraint kid, atom_typ (nvar kid))) in
          let name = prepend_id "num_of_" id in
          let pexp n id = mk_pexp (Pat_exp (mk_pat (P_id id), mk_lit_exp (L_num (Big_int.of_int n)))) in
          let funcl =
@@ -1302,11 +1019,11 @@ let generate_enum_functions vs_ids (Defs defs) =
   in
   Defs (gen_enums defs)
 
-let incremental_k_env = ref initial_kind_env
+let incremental_ctx = ref initial_ctx
 
 let process_ast order defs =
-  let ast, k_env, _= to_ast Nameset.empty !incremental_k_env order defs in
-  incremental_k_env := k_env;
+  let ast, ctx = to_ast !incremental_ctx defs in
+  incremental_ctx := ctx;
   let vs_ids = val_spec_ids ast in
   if not !opt_undefined_gen then
     generate_enum_functions vs_ids ast
@@ -1318,4 +1035,4 @@ let process_ast order defs =
 
 let ast_of_def_string order str =
   let def = Parser.def_eof Lexer.token (Lexing.from_string str) in
-  process_ast order (Parse_ast.Defs [def])
+  process_ast order (P.Defs [def])
diff --git a/src/initial_check.mli b/src/initial_check.mli
index e6b29216..25187e4c 100644
--- a/src/initial_check.mli
+++ b/src/initial_check.mli
@@ -87,7 +87,8 @@ val process_ast : order -> Parse_ast.defs -> unit defs
 
 val val_spec_ids : 'a defs -> IdSet.t
 
-val extern_of_string : order -> id -> string -> unit def
-val val_spec_of_string : order -> id -> string -> unit def
+val extern_of_string : id -> string -> unit def
+val val_spec_of_string : id -> string -> unit def
 
-val exp_of_string : order -> string -> unit exp
+val exp_of_string : string -> unit exp
+val typ_of_string : string -> typ
diff --git a/src/interpreter.ml b/src/interpreter.ml
index 83f8b14e..74333122 100644
--- a/src/interpreter.ml
+++ b/src/interpreter.ml
@@ -495,13 +495,13 @@ let rec step (E_aux (e_aux, annot) as orig_exp) =
        | _ -> fail ("Couldn't find id " ^ string_of_id id)
      end
 
-  | E_record (FES_aux (FES_Fexps (fexps, flag), fes_annot)) ->
+  | E_record fexps ->
      let evaluated, unevaluated = Util.take_drop is_value_fexp fexps in
      begin
        match unevaluated with
        | FE_aux (FE_Fexp (id, exp), fe_annot) :: fexps ->
           step exp >>= fun exp' ->
-          wrap (E_record (FES_aux (FES_Fexps (evaluated @ FE_aux (FE_Fexp (id, exp'), fe_annot) :: fexps, flag), fes_annot)))
+          wrap (E_record (evaluated @ FE_aux (FE_Fexp (id, exp'), fe_annot) :: fexps))
        | [] ->
           List.map value_of_fexp fexps
           |> List.fold_left (fun record (field, v) -> StringMap.add field v record) StringMap.empty
@@ -512,13 +512,13 @@ let rec step (E_aux (e_aux, annot) as orig_exp) =
 
   | E_record_update (exp, fexps) when not (is_value exp) ->
      step exp >>= fun exp' -> wrap (E_record_update (exp', fexps))
-  | E_record_update (record, FES_aux (FES_Fexps (fexps, flag), fes_annot)) ->
+  | E_record_update (record, fexps) ->
      let evaluated, unevaluated = Util.take_drop is_value_fexp fexps in
      begin
        match unevaluated with
        | FE_aux (FE_Fexp (id, exp), fe_annot) :: fexps ->
           step exp >>= fun exp' ->
-          wrap (E_record_update (record, FES_aux (FES_Fexps (evaluated @ FE_aux (FE_Fexp (id, exp'), fe_annot) :: fexps, flag), fes_annot)))
+          wrap (E_record_update (record, evaluated @ FE_aux (FE_Fexp (id, exp'), fe_annot) :: fexps))
        | [] ->
           List.map value_of_fexp fexps
           |> List.fold_left (fun record (field, v) -> StringMap.add field v record) (coerce_record (value_of_exp record))
@@ -539,7 +539,7 @@ let rec step (E_aux (e_aux, annot) as orig_exp) =
      begin try
          let open Type_check in
          let lexp_exp = infer_exp (env_of_annot annot) (exp_of_lexp (strip_lexp lexp)) in
-         let exp' = E_aux (E_record_update (lexp_exp, FES_aux (FES_Fexps ([FE_aux (FE_Fexp (id, exp), ul)], false), ul)), ul) in
+         let exp' = E_aux (E_record_update (lexp_exp, [FE_aux (FE_Fexp (id, exp), ul)]), ul) in
          wrap (E_assign (lexp, exp'))
        with Failure s -> fail ("Failure: " ^ s)
      end
@@ -699,13 +699,13 @@ and pattern_match env (P_aux (p_aux, (l, _)) as pat) value =
         recursive call that has an empty_tannot we must not use the
         annotation in the whole vector_concat pattern. *)
      let open Type_check in
-     begin match destruct_vector (pat_env_of pat) (pat_typ_of pat) with
+     begin match destruct_vector (env_of_pat pat) (typ_of_pat pat) with
      | Some (Nexp_aux (Nexp_constant n, _), _, _) ->
         let init, rest = Util.take (Big_int.to_int n) (coerce_gv value), Util.drop (Big_int.to_int n) (coerce_gv value) in
         let init_match, init_bind = pattern_match env pat (V_vector init) in
         let rest_match, rest_bind = pattern_match env (P_aux (P_vector_concat pats, (l, empty_tannot))) (V_vector rest) in
         init_match && rest_match, Bindings.merge combine init_bind rest_bind
-     | _ -> failwith ("Bad vector annotation " ^ string_of_typ (Type_check.pat_typ_of pat))
+     | _ -> failwith ("Bad vector annotation " ^ string_of_typ (Type_check.typ_of_pat pat))
      end
   | P_tup [pat] -> pattern_match env pat value
   | P_tup pats | P_list pats ->
@@ -888,7 +888,7 @@ let rec eval_frame' = function
 let eval_frame frame =
   try eval_frame' frame with
   | Type_check.Type_error (l, err) ->
-     raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err))
+     raise (Reporting.err_typ l (Type_error.string_of_type_error err))
 
 let default_effect_interp state eff =
   let lstate, gstate = state in
diff --git a/src/isail.ml b/src/isail.ml
index 863c4b1c..5c578220 100644
--- a/src/isail.ml
+++ b/src/isail.ml
@@ -57,6 +57,7 @@ open Pretty_print_sail
 
 type mode =
   | Evaluation of frame
+  | Bytecode of Value2.vl Bytecode_interpreter.gstate * Value2.vl Bytecode_interpreter.stack
   | Normal
 
 let current_mode = ref Normal
@@ -65,6 +66,7 @@ let prompt () =
   match !current_mode with
   | Normal -> "sail> "
   | Evaluation _ -> "eval> "
+  | Bytecode _ -> "ir> "
 
 let eval_clear = ref true
 
@@ -72,6 +74,7 @@ let mode_clear () =
   match !current_mode with
   | Normal -> ()
   | Evaluation _ -> if !eval_clear then LNoise.clear_screen () else ()
+  | Bytecode _ -> () (* if !eval_clear then LNoise.clear_screen () else () *)
 
 let rec user_input callback =
   match LNoise.linenoise (prompt ()) with
@@ -80,7 +83,7 @@ let rec user_input callback =
      mode_clear ();
      begin
        try callback v with
-       | Reporting_basic.Fatal_error e -> Reporting_basic.report_error e
+       | Reporting.Fatal_error e -> Reporting.report_error e
      end;
      user_input callback
 
@@ -105,16 +108,35 @@ let vs_ids = ref (Initial_check.val_spec_ids !interactive_ast)
 
 let interactive_state = ref (initial_state !interactive_ast !interactive_env Value.primops)
 
+let interactive_bytecode = ref []
+
+let sep = "-----------------------------------------------------" |> Util.blue |> Util.clear
+
 let print_program () =
   match !current_mode with
   | Normal -> ()
   | Evaluation (Step (out, _, _, stack)) ->
-     let sep = "-----------------------------------------------------" |> Util.blue |> Util.clear in
      List.map stack_string stack |> List.rev |> List.iter (fun code -> print_endline (Lazy.force code); print_endline sep);
      print_endline (Lazy.force out)
   | Evaluation (Done (_, v)) ->
      print_endline (Value.string_of_value v |> Util.green |> Util.clear)
   | Evaluation _ -> ()
+  | Bytecode (_, stack) ->
+     let open Bytecode_interpreter in
+     let open Bytecode_util in
+     let pc = stack.top.pc in
+     let instrs = stack.top.instrs in
+     for i = 0 to stack.top.pc - 1 do
+       print_endline ("  " ^ Pretty_print_sail.to_string (pp_instr instrs.(i)))
+     done;
+     print_endline (">>  " ^ Pretty_print_sail.to_string (pp_instr instrs.(stack.top.pc)));
+     for i = stack.top.pc + 1 to Array.length instrs - 1 do
+       print_endline ("  " ^ Pretty_print_sail.to_string (pp_instr instrs.(i)))
+     done;
+     print_endline sep;
+     print_endline (Util.string_of_list ", "
+                     (fun (id, vl) -> Printf.sprintf "%s = %s" (string_of_id id) (string_of_value vl))
+                     (Bindings.bindings stack.top.locals))
 
 let rec run () =
   match !current_mode with
@@ -146,6 +168,7 @@ let rec run () =
           end;
           run ()
      end
+  | Bytecode _ -> ()
 
 let rec run_steps n =
   print_endline ("step " ^ string_of_int n);
@@ -179,6 +202,7 @@ let rec run_steps n =
           end;
           run_steps (n - 1)
      end
+  | Bytecode _ -> ()
 
 let help = function
   | ":t" | ":type" ->
@@ -250,6 +274,8 @@ let handle_input' input =
     | Command (cmd, arg) ->
        begin
          match cmd with
+         | ":n" | ":normal" ->
+            current_mode := Normal
          | ":t" | ":type" ->
             let typq, typ = Type_check.Env.get_val_spec (mk_id arg) !interactive_env in
             pretty_sail stdout (doc_binding (typq, typ));
@@ -258,10 +284,13 @@ let handle_input' input =
             Value.output_close ();
             exit 0
          | ":i" | ":infer" ->
-            let exp = Initial_check.exp_of_string dec_ord arg in
+            let exp = Initial_check.exp_of_string arg in
             let exp = Type_check.infer_exp !interactive_env exp in
             pretty_sail stdout (doc_typ (Type_check.typ_of exp));
             print_newline ()
+         | ":canon" ->
+            let typ = Initial_check.typ_of_string arg in
+            print_endline (string_of_typ (Type_check.canonicalize !interactive_env typ))
          | ":v" | ":verbose" ->
             Type_check.opt_tc_debug := (!Type_check.opt_tc_debug + 1) mod 3;
             print_endline ("Verbosity: " ^ string_of_int !Type_check.opt_tc_debug)
@@ -303,19 +332,26 @@ let handle_input' input =
             interactive_env := env;
             interactive_state := initial_state !interactive_ast !interactive_env Value.primops
          | ":pretty" ->
-            print_endline (Pretty_print_sail.to_string (Latex.latex_defs "sail_latex" !interactive_ast))
-         | ":bytecode" ->
+            print_endline (Pretty_print_sail.to_string (Latex.defs !interactive_ast))
+         | ":compile" ->
             let open PPrint in
             let open C_backend in
             let ast = Process_file.rewrite_ast_c !interactive_env !interactive_ast in
             let ast, env = Specialize.specialize ast !interactive_env in
             let ctx = initial_ctx env in
-            let byte_ast = bytecode_ast ctx (List.map flatten_instrs) ast in
-            let chan = open_out arg in
-            Util.opt_colors := false;
-            Pretty_print_sail.pretty_sail chan (separate_map hardline Bytecode_util.pp_cdef byte_ast);
-            Util.opt_colors := true;
-            close_out chan
+            interactive_bytecode := bytecode_ast ctx (List.map flatten_cdef) ast
+         | ":ir" ->
+            print_endline arg;
+            let open Bytecode in
+            let open Bytecode_util in
+            let open PPrint in
+            let is_cdef = function
+              | CDEF_fundef (id, _, _, _) when Id.compare id (mk_id arg) = 0 -> true
+              | CDEF_spec (id, _, _) when Id.compare id (mk_id arg) = 0 -> true
+              | _ -> false
+            in
+            let cdefs = List.filter is_cdef !interactive_bytecode in
+            print_endline (Pretty_print_sail.to_string (separate_map hardline pp_cdef cdefs))
          | ":ast" ->
             let chan = open_out arg in
             Pretty_print_sail.pp_defs chan !interactive_ast;
@@ -363,72 +399,89 @@ let handle_input' input =
                vs_ids := Initial_check.val_spec_ids !interactive_ast;
                (* See initial_check.mli for an explanation of why we need this. *)
                Initial_check.have_undefined_builtins := false
+            | ":exec" ->
+               let open Bytecode_interpreter in
+               let exp = Type_check.infer_exp !interactive_env (Initial_check.exp_of_string arg) in
+               let anf = Anf.anf exp in
+               let ctx = C_backend.initial_ctx !interactive_env in
+               let ctyp = C_backend.ctyp_of_typ ctx (Type_check.typ_of exp) in
+               let setup, call, cleanup = C_backend.compile_aexp ctx anf in
+               let instrs = C_backend.flatten_instrs (setup @ [call (CL_id (mk_id "interactive#", ctyp))] @ cleanup) in
+               current_mode := Bytecode (new_gstate !interactive_bytecode, new_stack instrs);
+               print_program ()
             | _ -> unrecognised_command cmd
           end
        | Expression str ->
           (* An expression in normal mode is type checked, then puts
              us in evaluation mode. *)
-          let exp = Type_check.infer_exp !interactive_env (Initial_check.exp_of_string Ast_util.dec_ord str) in
+          let exp = Type_check.infer_exp !interactive_env (Initial_check.exp_of_string str) in
           current_mode := Evaluation (eval_frame (Step (lazy "", !interactive_state, return exp, [])));
           print_program ()
        | Empty -> ()
      end
   | Evaluation frame ->
-     begin
-       match input with
-       | Command (cmd, arg) ->
-         (* Evaluation mode commands *)
-         begin
-           match cmd with
-           | ":r" | ":run" ->
-              run ()
-           | ":s" | ":step" ->
-              run_steps (int_of_string arg)
-           | ":n" | ":normal" ->
-              current_mode := Normal
-           | _ -> unrecognised_command cmd
-         end
-       | Expression str ->
-          print_endline "Already evaluating expression"
-       | Empty ->
-          (* Empty input will evaluate one step, or switch back to
+     begin match input with
+     | Command (cmd, arg) ->
+        (* Evaluation mode commands *)
+        begin
+          match cmd with
+          | ":r" | ":run" ->
+             run ()
+          | ":s" | ":step" ->
+             run_steps (int_of_string arg)
+          | _ -> unrecognised_command cmd
+        end
+     | Expression str ->
+        print_endline "Already evaluating expression"
+     | Empty ->
+        (* Empty input will evaluate one step, or switch back to
              normal mode when evaluation is completed. *)
-          begin
-            match frame with
-            | Done (state, v) ->
+        begin match frame with
+        | Done (state, v) ->
+           interactive_state := state;
+           print_endline ("Result = " ^ Value.string_of_value v);
+           current_mode := Normal
+        | Step (out, state, _, stack) ->
+           begin
+             try
                interactive_state := state;
-               print_endline ("Result = " ^ Value.string_of_value v);
-               current_mode := Normal
-            | Step (out, state, _, stack) ->
-               begin
-                 try
-                   interactive_state := state;
-                   current_mode := Evaluation (eval_frame frame);
-                   print_program ()
-                 with
-                 | Failure str -> print_endline str; current_mode := Normal
-               end
-            | Break frame ->
-               print_endline "Breakpoint";
-               current_mode := Evaluation frame
-            | Effect_request (state, eff) ->
-               begin
-                 try
-                   interactive_state := state;
-                   current_mode := Evaluation (Interpreter.default_effect_interp state eff);
-                   print_program ()
-                 with
-                 | Failure str -> print_endline str; current_mode := Normal
-               end
-          end
+               current_mode := Evaluation (eval_frame frame);
+               print_program ()
+             with
+             | Failure str -> print_endline str; current_mode := Normal
+           end
+        | Break frame ->
+           print_endline "Breakpoint";
+           current_mode := Evaluation frame
+        | Effect_request (state, eff) ->
+           begin
+             try
+               interactive_state := state;
+               current_mode := Evaluation (Interpreter.default_effect_interp state eff);
+               print_program ()
+             with
+             | Failure str -> print_endline str; current_mode := Normal
+           end
+        end
      end
-
+  | Bytecode (gstate, stack) ->
+     begin match input with
+     | Command (cmd, arg) ->
+        ()
+     | Expression str ->
+        print_endline "Evaluating IR, cannot evaluate expression"
+     | Empty ->
+        let gstate, stack = Bytecode_interpreter.step (gstate, stack) in
+        current_mode := Bytecode (gstate, stack);
+        print_program ()
+     end
+    
 let handle_input input =
   try handle_input' input with
   | Type_check.Type_error (l, err) ->
      print_endline (Type_error.string_of_type_error err)
-  | Reporting_basic.Fatal_error err ->
-     Reporting_basic.print_error err
+  | Reporting.Fatal_error err ->
+     Reporting.print_error err
   | exn ->
      print_endline (Printexc.to_string exn)
 
diff --git a/src/latex.ml b/src/latex.ml
index 39db43db..2f578f2c 100644
--- a/src/latex.ml
+++ b/src/latex.ml
@@ -51,51 +51,223 @@
 open Ast
 open Ast_util
 open PPrint
+open Printf
 
-let opt_prefix_latex = ref "sail"
+module StringSet = Set.Make(String);;
+
+let opt_prefix = ref "sail"
+let opt_directory = ref "sail_latex"
+
+let rec unique_postfix n =
+  if n < 0 then
+    ""
+  else if n >= 26 then
+    String.make 1 (Char.chr (n mod 26 + 65)) ^ unique_postfix (n - 26)
+  else
+    String.make 1 (Char.chr (n mod 26 + 65))
+
+type latex_state =
+  { mutable noindent : bool;
+    mutable this : id option;
+    mutable norefs : StringSet.t;
+    mutable generated_names : string Bindings.t
+  }
+
+let reset_state state =
+  state.noindent <- false;
+  state.this <- None;
+  state.norefs <- StringSet.empty;
+  state.generated_names <- Bindings.empty
+
+let state =
+  { noindent = false;
+    this = None;
+    norefs = StringSet.empty;
+    generated_names = Bindings.empty
+  }
+
+let rec unique_postfix n =
+  if n < 0 then
+    ""
+  else if n >= 26 then
+    String.make 1 (Char.chr (n mod 26 + 65)) ^ unique_postfix (n - 26)
+  else
+    String.make 1 (Char.chr (n mod 26 + 65))
+
+type id_category =
+  | Function
+  | Val
+  | Overload
+  | FunclCtor of id * int
+  | FunclNum of int
+  | FunclApp of string
 
 let replace_numbers str =
-  str
-  |> Str.global_replace (Str.regexp "0") "zero"
-  |> Str.global_replace (Str.regexp "1") "one"
-  |> Str.global_replace (Str.regexp "2") "two"
-  |> Str.global_replace (Str.regexp "3") "three"
-  |> Str.global_replace (Str.regexp "4") "four"
-  |> Str.global_replace (Str.regexp "5") "five"
-  |> Str.global_replace (Str.regexp "6") "six"
-  |> Str.global_replace (Str.regexp "7") "seven"
-  |> Str.global_replace (Str.regexp "8") "eight"
-  |> Str.global_replace (Str.regexp "9") "nine"
-
-let namecode_string str =
-  let str = Str.global_replace (Str.regexp "_") "" (Util.zencode_string str) in
-  replace_numbers (String.sub str 1 (String.length str - 1))
-
-let namecode_id id = namecode_string (string_of_id id)
+  let replacements =
+    [ ("0", "Zero");
+      ("1", "One");
+      ("2", "Two");
+      ("3", "Three");
+      ("4", "Four");
+      ("5", "Five");
+      ("6", "Six");
+      ("7", "Seven");
+      ("8", "Eight");
+      ("9", "Nine") ]
+  in
+  List.fold_left (fun str (from, into) -> Str.global_replace (Str.regexp_string from) into str) str replacements
+
+let category_name = function
+  | Function -> "fn"
+  | Val -> "val"
+  | Overload -> "overload"
+  | FunclNum n -> "fcl" ^ unique_postfix n
+  | FunclCtor (id, n) ->
+     let str = replace_numbers (Util.zencode_string (string_of_id id)) in
+     "fcl" ^ String.sub str 1 (String.length str - 1) ^ unique_postfix n
+  | FunclApp str -> "fcl" ^ str
+
+let category_name_val = function
+  | Val -> ""
+  | cat -> category_name cat
+
+let category_name_simple = function
+  | Function -> "fn"
+  | Val -> "val"
+  | Overload -> "overload"
+  | FunclNum _ -> "fcl"
+  | FunclCtor (_, _) -> "fcl"
+  | FunclApp _ -> "fcl"
+
+(* Generate a unique latex identifier from a Sail identifier. We store
+   a mapping from identifiers to strings in state so we always return
+   the same latex id for a sail id. *)
+let latex_id id =
+  if Bindings.mem id state.generated_names then
+    Bindings.find id state.generated_names
+  else
+    let str = string_of_id id in
+    let r = Str.regexp {|_\([a-zA-Z0-9]\)|} in
+    let str =
+      (* Convert to CamelCase. OCaml's regexp library is a bit arcane. *)
+      let str = ref str in
+      try
+        while true do
+          ignore (Str.search_forward r !str 0);
+          let replace = (Str.matched_group 0 !str).[1] |> Char.uppercase_ascii |> String.make 1 in
+          str := Str.replace_first r replace !str
+        done; ""
+      with Not_found -> !str
+    in
+    (* If we have any other weird symbols in the id, remove them using Util.zencode_string (removing the z prefix) *)
+    let str = Util.zencode_string str in
+    let str = String.sub str 1 (String.length str - 1) in
+    (* Latex only allows letters in identifiers, so replace all numbers *)
+    let str = replace_numbers str in
+
+    let generated = state.generated_names |> Bindings.bindings |> List.map snd |> StringSet.of_list in
+
+    (* The above makes maps different names to the same name, so we need
+     to keep track of what names we've generated an ensure that they
+     remain unique. *)
+    let rec unique n str =
+      if StringSet.mem (str ^ unique_postfix n) generated then
+        unique (n + 1) str
+      else
+        str ^ unique_postfix n
+    in
+    let str = unique (-1) str in
+    state.generated_names <- Bindings.add id str state.generated_names;
+    str
 
 let refcode_string str =
-  replace_numbers (Str.global_replace (Str.regexp "_") "zy" (Util.zencode_string str))
+  Str.global_replace (Str.regexp "_") "zy" (Util.zencode_string str)
 
 let refcode_id id = refcode_string (string_of_id id)
 
+let inline_code str = sprintf "\\lstinline{%s}" str
+
+let text_code str =
+  str
+  |> Str.global_replace (Str.regexp_string "_") "\\_"
+  |> Str.global_replace (Str.regexp_string ">") "$<$"
+  |> Str.global_replace (Str.regexp_string "<") "$>$"
+
+let replace_this str =
+  match state.this with
+  | Some id ->
+     str
+     |> Str.global_replace (Str.regexp_string "NAME") (text_code (string_of_id id))
+     |> Str.global_replace (Str.regexp_string "THIS") (inline_code (string_of_id id))
+  | None -> str
+
+let latex_of_markdown str =
+  let open Omd in
+  let open Printf in
+
+  let rec format_elem = function
+    | Paragraph elems ->
+       let prepend = if state.noindent then (state.noindent <- false; "\\noindent ") else "" in
+       prepend ^ format elems ^ "\n\n"
+    | Text str -> Str.global_replace (Str.regexp_string "_") "\\_" str
+    | Emph elems -> sprintf "\\emph{%s}" (format elems)
+    | Bold elems -> sprintf "\\textbf{%s}" (format elems)
+    | Ref (r, "THIS", alt, _) ->
+       begin match state.this with
+       | Some id -> sprintf "\\hyperref[%s]{%s}" (refcode_string (string_of_id id)) (replace_this alt)
+       | None -> failwith "Cannot create link to THIS"
+       end
+    | Ref (r, name, alt, _) ->
+       (* special case for [id] (format as code) *)
+       let format_fn = if name = alt then inline_code else replace_this in
+       begin match r#get_ref name with
+       | None -> sprintf "\\hyperref[%s]{%s}" (refcode_string name) (format_fn alt)
+       | Some (link, _) -> sprintf "\\hyperref[%s]{%s}" (refcode_string link) (format_fn alt)
+       end
+    | Url (href, text, "") ->
+       sprintf "\\href{%s}{%s}" href (format text)
+    | Url (href, text, reference) ->
+       sprintf "%s\\footnote{%s~\\url{%s}}" (format text) reference href
+    | Code (_, code) ->
+       sprintf "\\lstinline`%s`" code
+    | Code_block (lang, code) ->
+       let lang = if lang = "" then "sail" else lang in
+       let uid = Digest.string str |> Digest.to_hex in
+       let chan = open_out (Filename.concat !opt_directory (sprintf "block%s.%s" uid lang)) in
+       output_string chan code;
+       close_out chan;
+       sprintf "\\lstinputlisting[language=%s]{%s/block%s.%s}" lang !opt_directory uid lang
+    | Ul list ->
+       "\\begin{itemize}\n\\item "
+       ^ Util.string_of_list "\n\\item " format list
+       ^ "\n\\end{itemize}"
+    | Br -> "\n"
+    | NL -> "\n"
+    | elem -> failwith ("Can't convert to latex: " ^ to_text [elem])
+
+  and format elems =
+    String.concat "" (List.map format_elem elems)
+  in
+
+  replace_this (format (of_string str))
+
 let docstring = function
-  | Parse_ast.Documented (str, _) -> string str
+  | Parse_ast.Documented (str, _) -> string (latex_of_markdown str)
   | _ -> empty
 
 let add_links str =
   let r = Str.regexp {|\([a-zA-Z0-9_]+\)\([ ]*\)(|} in
   let subst s =
-    let module StringSet = Set.Make(String) in
     let keywords = StringSet.of_list
       [ "function"; "forall"; "if"; "then"; "else"; "exit"; "return"; "match"; "vector";
         "assert"; "constraint"; "let"; "in"; "atom"; "range"; "throw"; "sizeof"; "foreach" ]
     in
     let fn = Str.matched_group 1 s in
     let spacing = Str.matched_group 2 s in
-    if StringSet.mem fn keywords then
+    if StringSet.mem fn keywords || StringSet.mem fn state.norefs then
       fn ^ spacing ^ "("
     else
-      Printf.sprintf {|#\hyperref[%s]{%s}#%s(|} (refcode_string fn) (Str.global_replace (Str.regexp "_") {|\_|} fn) spacing
+      Printf.sprintf "#\\hyperref[%s]{%s}#%s(" (refcode_string fn) (Str.global_replace (Str.regexp "_") {|\_|} fn) spacing
   in
   Str.global_substitute r subst str
 
@@ -105,7 +277,7 @@ let latex_loc no_loc l =
      begin
        let using_color = !Util.opt_colors in
        Util.opt_colors := false;
-       let code = Util.split_on_char '\n' (Reporting_basic.loc_to_string l) in
+       let code = Util.split_on_char '\n' (Reporting.loc_to_string l) in
        let doc = match code with
          | _ :: _ :: code -> string (add_links (String.concat "\n" code))
          | _ -> empty
@@ -116,30 +288,30 @@ let latex_loc no_loc l =
 
   | _ -> docstring l ^^ no_loc
 
-module StringSet = Set.Make(String)
-
 let commands = ref StringSet.empty
 
-let rec latex_command ?prefix:(prefix="") ?label:(label=None) dir cmd no_loc ((l, _) as annot) =
-  let labelling = match label with
-    | None -> ""
-    | Some l -> Printf.sprintf "\\label{%s}" l
+let doc_spec_simple (VS_val_spec(ts,id,ext,is_cast)) =
+     Pretty_print_sail.doc_id id ^^ space
+     ^^ colon ^^ space
+     ^^ Pretty_print_sail.doc_typschm ~simple:true ts
+
+let rec latex_command cat id no_loc ((l, _) as annot) =
+  state.this <- Some id;
+  let labelling = match cat with
+    | Val -> sprintf "\\label{%s}" (refcode_id id)
+    | _ -> sprintf "\\label{%s%s}" (category_name cat) (refcode_id id)
   in
-  let cmd = !opt_prefix_latex ^ prefix ^ cmd in
-  let lcmd = String.lowercase_ascii cmd in  (* lowercase to avoid file names differing only by case *)
-  if StringSet.mem lcmd !commands then
-    latex_command ~label:label dir (cmd ^ "v") no_loc annot
-  else
-    begin
-      commands := StringSet.add lcmd !commands;
-      let oc = open_out (Filename.concat dir (cmd ^ ".tex")) in
-      output_string oc (Pretty_print_sail.to_string (latex_loc no_loc l));
-      close_out oc;
-      string (Printf.sprintf "\\newcommand{\\%s}{%s " cmd labelling) ^^ (docstring l) ^^ string (Printf.sprintf "\\lstinputlisting[language=sail]{%s/%s.tex}}" dir cmd)
-    end
+  (* To avoid problems with verbatim environments in commands, we have
+     to put the sail code for each command in a separate file. *)
+  let code_file = category_name cat ^ Util.file_encode_string (string_of_id id) ^ ".tex" in
+  let chan = open_out (Filename.concat !opt_directory code_file) in
+  let doc = if cat = Val then no_loc else latex_loc no_loc l in
+  output_string chan (Pretty_print_sail.to_string doc);
+  close_out chan;
 
-let latex_command_id ?prefix:(prefix="") dir id no_loc annot =
-  latex_command ~prefix:prefix ~label:(Some (refcode_id id)) dir (namecode_id id) no_loc annot
+  ksprintf string "\\newcommand{\\sail%s%s}{\\phantomsection%s\\saildoc%s{" (category_name cat) (latex_id id) labelling (category_name_simple cat)
+  ^^ docstring l ^^ string "}{"
+  ^^ ksprintf string "\\lstinputlisting[language=sail]{%s}}}" (Filename.concat !opt_directory code_file)
 
 let latex_label str id =
   string (Printf.sprintf "\\label{%s:%s}" str (Util.zencode_string (string_of_id id)))
@@ -148,44 +320,134 @@ let counter = ref 0
 
 let rec app_code (E_aux (exp, _)) =
   match exp with
-  | E_app (f, [exp]) -> namecode_id f ^ app_code exp
-  | E_app (f, _) -> namecode_id f
-  | E_id id -> namecode_id id
+  | E_app (f, [exp]) when Id.compare f (mk_id "Some") = 0 -> app_code exp
+  | E_app (f, [exp]) -> latex_id f ^ app_code exp
+  | E_app (f, _) -> latex_id f
+  | E_id id -> latex_id id
   | _ -> ""
 
-let rec latex_funcls dir def =
-  let next funcls = twice hardline ^^ latex_funcls dir def funcls in
-  let funcl_command (FCL_Funcl (id, pexp)) =
-    match pexp with
-    | Pat_aux (Pat_exp (P_aux (P_app (ctor, _), _), _), _) -> namecode_id id ^ namecode_id ctor
-    | Pat_aux (Pat_exp (_, exp), _) -> namecode_id id ^ app_code exp
-    | _ -> (incr counter; namecode_id id ^ String.make 1 (Char.chr (!counter + 64)))
+let latex_funcls def =
+  let module StringMap = Map.Make(String) in
+  let counter = ref 0 in
+  let app_codes = ref StringMap.empty in
+  let ctors = ref Bindings.empty in
+
+  let rec latex_funcls' def =
+    let counter = ref (-1) in
+    let next funcls = twice hardline ^^ latex_funcls' def funcls in
+    let funcl_command (FCL_Funcl (id, pexp)) =
+      match pexp with
+      | Pat_aux (Pat_exp (P_aux (P_app (ctor, _), _), _), _) ->
+         let n = try Bindings.find ctor !ctors with Not_found -> -1 in
+         ctors := Bindings.add ctor (n + 1) !ctors;
+         FunclCtor (ctor, n), id
+      | Pat_aux (Pat_exp (_, exp), _) ->
+         let ac = app_code exp in
+         let n = try StringMap.find ac !app_codes with Not_found -> -1 in
+         app_codes := StringMap.add ac (n + 1) !app_codes;
+         FunclApp (ac ^ unique_postfix n), id
+      | _ -> incr counter; (FunclNum (!counter + 64), id)
+    in
+    function
+    | (FCL_aux (funcl_aux, annot) as funcl) :: funcls ->
+       let cat, id = funcl_command funcl_aux in
+       let first = latex_command cat id (Pretty_print_sail.doc_funcl funcl) annot in
+       first ^^ next funcls
+    | [] -> empty
+  in
+  latex_funcls' def
+
+let process_pragma l command =
+  let n = try String.index command ' ' with Not_found -> String.length command in
+  let cmd = Str.string_before command n in
+  let arg = String.trim (Str.string_after command n) in
+
+  match cmd with
+  | "noindent" ->
+     state.noindent <- true;
+     None
+
+  | "noref" ->
+     state.norefs <- StringSet.add arg state.norefs;
+     None
+
+  | "newcommand" ->
+     let n = try String.index arg ' ' with Not_found -> failwith "No command given" in
+     let name = Str.string_before arg n in
+     let body = String.trim (latex_of_markdown (Str.string_after arg n)) in
+     Some (ksprintf string "\\newcommand{\\%s}{%s}" name body)
+
+  | _ ->
+     Util.warn (Printf.sprintf "Bad latex pragma %s" (Reporting.loc_to_string l));
+     None
+
+let defs (Defs defs) =
+  reset_state state;
+
+  let valspecs = ref IdSet.empty in
+  let fundefs = ref IdSet.empty in
+
+  let latex_def def =
+    match def with
+    | DEF_overload (id, ids) -> None
+                                  (*
+       let doc =
+         string (Printf.sprintf "overload %s = {%s}" (string_of_id id) (Util.string_of_list ", " string_of_id ids))
+       in
+       Some (latex_command Overload id doc (id_loc id, None))
+                                   *)
+
+    | DEF_spec (VS_aux (VS_val_spec (_, id, _, _) as vs, annot)) as def ->
+       valspecs := IdSet.add id !valspecs;
+       Some (latex_command Val id (doc_spec_simple vs) annot)
+
+    | DEF_fundef (FD_aux (FD_function (_, _, _, [FCL_aux (FCL_Funcl (id, _), _)]), annot)) as def ->
+       fundefs := IdSet.add id !fundefs;
+       Some (latex_command Function id (Pretty_print_sail.doc_def def) annot)
+
+    | DEF_fundef (FD_aux (FD_function (_, _, _, funcls), annot)) as def ->
+       Some (latex_funcls def funcls)
+
+    | DEF_pragma ("latex", command, l) ->
+       process_pragma l command
+
+    | _ -> None
+  in
+
+  let rec process_defs = function
+    | [] -> empty
+    | def :: defs ->
+       let tex = match latex_def def with
+         | Some tex -> tex ^^ twice hardline
+         | None -> empty
+       in
+       tex ^^ process_defs defs
   in
-  function
-  | (FCL_aux (funcl_aux, annot) as funcl) :: funcls ->
-     let first = latex_command ~prefix:"fn" dir (funcl_command funcl_aux) (Pretty_print_sail.doc_funcl funcl) annot in
-     first ^^ next funcls
-  | [] -> empty
-
-let rec latex_defs dir (Defs defs) =
-  let next defs = twice hardline ^^ latex_defs dir (Defs defs) in
-  match defs with
-  | DEF_overload (id, ids) :: defs ->
-     let doc =
-       string (Printf.sprintf "overload %s = {%s}" (string_of_id id) (Util.string_of_list ", " string_of_id ids))
-     in
-     latex_command_id dir id doc (Parse_ast.Unknown, None)
-     ^^ next defs
-  | (DEF_type (TD_aux (TD_abbrev (id, _, _), annot)) as def) :: defs ->
-     latex_command_id dir id (Pretty_print_sail.doc_def def) annot ^^ next defs
-  | (DEF_type (TD_aux (TD_record (id, _, _, _, _), annot)) as def) :: defs ->
-     latex_command_id dir id (Pretty_print_sail.doc_def def) annot ^^ next defs
-  | (DEF_type (TD_aux (TD_enum (id, _, _, _), annot)) as def) :: defs ->
-     latex_command_id dir id (Pretty_print_sail.doc_def def) annot ^^ next defs
-  | (DEF_spec (VS_aux (VS_val_spec (_, id, _, _), annot)) as def) :: defs ->
-     latex_command_id dir id (Pretty_print_sail.doc_def def) annot ^^ next defs
-  | (DEF_fundef (FD_aux (FD_function (_, _, _, [FCL_aux (FCL_Funcl (id, _), _)]), annot)) as def) :: defs ->
-     latex_command_id dir ~prefix:"fn" id (Pretty_print_sail.doc_def def) annot ^^ next defs
-  | (DEF_fundef (FD_aux (FD_function (_, _, _, funcls), annot)) as def) :: defs -> latex_funcls dir def funcls ^^ next defs
-  | _ :: defs -> latex_defs dir (Defs defs)
-  | [] -> empty
+
+  let tex = process_defs defs in
+
+  (* Rather than having latex functions that use mangled names, like
+     \sailfnmyFunction for a function my_function, we can write
+     \sailfn{my_function} by generating a latex macro that compares
+     identifiers then outputs the correct mangled command. *)
+  let id_command cat ids =
+    sprintf "\\newcommand{\\%s%s}[1]{\n  " !opt_prefix (category_name cat)
+    ^ Util.string_of_list "%\n  " (fun id -> sprintf "\\ifstrequal{#1}{%s}{\\sail%s%s}{}" (string_of_id id) (category_name cat) (latex_id id))
+                          (IdSet.elements ids)
+    ^ "}"
+    |> string
+  in
+  let ref_command cat ids =
+    sprintf "\\newcommand{\\%sref%s}[2]{\n  " !opt_prefix (category_name cat)
+    ^ Util.string_of_list "%\n  " (fun id -> sprintf "\\ifstrequal{#1}{%s}{\\hyperref[%s%s]{#2}}{}" (string_of_id id) (category_name_val cat) (refcode_id id))
+                          (IdSet.elements ids)
+    ^ "}"
+    |> string
+  in
+
+  tex
+  ^^ separate (twice hardline) [id_command Val !valspecs;
+                                ref_command Val !valspecs;
+                                id_command Function !fundefs;
+                                ref_command Function !fundefs]
+  ^^ hardline
diff --git a/src/lem_interp/sail2_instr_kinds.lem b/src/lem_interp/sail2_instr_kinds.lem
index 3d238676..eadc85bf 100644
--- a/src/lem_interp/sail2_instr_kinds.lem
+++ b/src/lem_interp/sail2_instr_kinds.lem
@@ -155,6 +155,7 @@ type barrier_kind =
   | Barrier_RISCV_rw_r
   | Barrier_RISCV_r_w
   | Barrier_RISCV_w_r
+  | Barrier_RISCV_tso
   | Barrier_RISCV_i
   (* X86 *)
   | Barrier_x86_MFENCE
@@ -184,6 +185,7 @@ instance (Show barrier_kind)
     | Barrier_RISCV_rw_r  -> "Barrier_RISCV_rw_r"
     | Barrier_RISCV_r_w   -> "Barrier_RISCV_r_w"
     | Barrier_RISCV_w_r   -> "Barrier_RISCV_w_r"
+    | Barrier_RISCV_tso   -> "Barrier_RISCV_tso"
     | Barrier_RISCV_i     -> "Barrier_RISCV_i"
     | Barrier_x86_MFENCE  -> "Barrier_x86_MFENCE"
   end
@@ -300,7 +302,8 @@ instance (EnumerationType barrier_kind)
     | Barrier_RISCV_rw_r -> 19
     | Barrier_RISCV_r_w -> 20
     | Barrier_RISCV_w_r -> 21
-    | Barrier_RISCV_i -> 22
-    | Barrier_x86_MFENCE -> 23
+    | Barrier_RISCV_tso -> 22
+    | Barrier_RISCV_i -> 23
+    | Barrier_x86_MFENCE -> 24
   end
 end
diff --git a/src/lexer.mll b/src/lexer.mll
index cbefa601..57580e7a 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -97,8 +97,7 @@ let operators = ref
   (List.fold_left
      (fun r (x, y) -> M.add x y r)
      M.empty
-     [ ("==", mk_operator Infix 4 "==");
-       ("/", mk_operator InfixL 7 "/");
+     [ ("/", mk_operator InfixL 7 "/");
        ("%", mk_operator InfixL 7 "%");
      ])
 
@@ -141,11 +140,13 @@ let kw_table =
      ("ref",                     (fun _ -> Ref));
      ("Int",                     (fun x -> Int));
      ("Order",                   (fun x -> Order));
+     ("Bool",                    (fun x -> Bool));
      ("pure",                    (fun x -> Pure));
      ("register",		 (fun x -> Register));
      ("return",                  (fun x -> Return));
      ("scattered",               (fun x -> Scattered));
      ("sizeof",                  (fun x -> Sizeof));
+     ("constant",                (fun x -> Constant));
      ("constraint",              (fun x -> Constraint));
      ("struct",                  (fun x -> Struct));
      ("then",                    (fun x -> Then));
@@ -163,7 +164,6 @@ let kw_table =
      ("do",                      (fun _ -> Do));
      ("mutual",                  (fun _ -> Mutual));
      ("bitfield",                (fun _ -> Bitfield));
-     ("tuple",                   (fun _ -> Tuple));
      ("where",                   (fun _ -> Where));
 
      ("barr",                    (fun x -> Barr));
@@ -225,9 +225,7 @@ rule token = parse
   | ","                                 { Comma }
   | ".."                                { DotDot }
   | "."                                 { Dot }
-  | "==" as op
-    { try M.find op !operators
-      with Not_found -> raise (LexError ("Operator fixity undeclared " ^ op, Lexing.lexeme_start_p lexbuf)) }
+  | "=="                                { EqEq(r"==") }
   | "="                                 { (Eq(r"=")) }
   | ">"					{ (Gt(r">")) }
   | "-"					{ Minus }
@@ -329,12 +327,12 @@ and string pos b = parse
   | ([^'"''\n''\\']* as i)              { Buffer.add_string b i; string pos b lexbuf }
   | escape_sequence as i                { Buffer.add_string b i; string pos b lexbuf }
   | '\\' '\n' ws                        { Lexing.new_line lexbuf; string pos b lexbuf }
-  | '\\'                                { assert false (*raise (Reporting_basic.Fatal_error (Reporting_basic.Err_syntax (pos,
+  | '\\'                                { assert false (*raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
                                             "illegal backslash escape in string"*) }
   | '"'                                 { let s = unescaped(Buffer.contents b) in
                                           (*try Ulib.UTF8.validate s; s
                                           with Ulib.UTF8.Malformed_code ->
-                                            raise (Reporting_basic.Fatal_error (Reporting_basic.Err_syntax (pos,
+                                            raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
                                               "String literal is not valid utf8"))) *) s }
-  | eof                                 { assert false (*raise (Reporting_basic.Fatal_error (Reporting_basic.Err_syntax (pos,
+  | eof                                 { assert false (*raise (Reporting.Fatal_error (Reporting.Err_syntax (pos,
                                             "String literal not terminated")))*) }
diff --git a/src/monomorphise.ml b/src/monomorphise.ml
index f7a481e6..4bb1876c 100644
--- a/src/monomorphise.ml
+++ b/src/monomorphise.ml
@@ -115,7 +115,7 @@ let rec subst_nc substs (NC_aux (nc,l) as n_constraint) =
        | Nexp_aux (Nexp_constant i,_) ->
           if List.exists (fun j -> Big_int.equal i j) is then re NC_true else re NC_false
        | nexp -> 
-          raise (Reporting_basic.err_general l
+          raise (Reporting.err_general l
                    ("Unable to substitute " ^ string_of_nexp nexp ^
                        " into set constraint " ^ string_of_n_constraint n_constraint))
        | exception Not_found -> n_constraint
@@ -139,15 +139,15 @@ let subst_src_typ substs t =
     | Typ_bidir (t1, t2) -> re (Typ_bidir (s_styp substs t1, s_styp substs t2))
     | Typ_tup ts -> re (Typ_tup (List.map (s_styp substs) ts))
     | Typ_app (id,tas) -> re (Typ_app (id,List.map (s_starg substs) tas))
-    | Typ_exist (kids,nc,t) ->
-       let substs = List.fold_left (fun sub v -> KBindings.remove v sub) substs kids in
-       re (Typ_exist (kids,nc,s_styp substs t))
+    | Typ_exist (kopts,nc,t) ->
+       let substs = List.fold_left (fun sub kopt -> KBindings.remove (kopt_kid kopt) sub) substs kopts in
+       re (Typ_exist (kopts,nc,s_styp substs t))
     | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-  and s_starg substs (Typ_arg_aux (ta,l) as targ) =
+  and s_starg substs (A_aux (ta,l) as targ) =
     match ta with
-    | Typ_arg_nexp ne -> Typ_arg_aux (Typ_arg_nexp (subst_nexp substs ne),l)
-    | Typ_arg_typ t -> Typ_arg_aux (Typ_arg_typ (s_styp substs t),l)
-    | Typ_arg_order _ -> targ
+    | A_nexp ne -> A_aux (A_nexp (subst_nexp substs ne),l)
+    | A_typ t -> A_aux (A_typ (s_styp substs t),l)
+    | A_order _ -> targ
   in s_styp substs t
 
 let make_vector_lit sz i =
@@ -180,7 +180,7 @@ let rec is_value (E_aux (e,(l,annot))) =
   let is_constructor id =
     match destruct_tannot annot with
     | None ->
-       (Reporting_basic.print_err false true l "Monomorphisation"
+       (Reporting.print_err false true l "Monomorphisation"
           ("Missing type information for identifier " ^ string_of_id id);
         false) (* Be conservative if we have no info *)
     | Some (env,_,_) ->
@@ -281,7 +281,7 @@ let extract_set_nc l var nc =
        | None, Some (is,nc2') -> Some (is, re (NC_and (nc1,nc2')))
        | Some (is,nc1'), None -> Some (is, re (NC_and (nc1',nc2)))
        | Some _, Some _ ->
-          raise (Reporting_basic.err_general l ("Multiple set constraints for " ^ string_of_kid var)))
+          raise (Reporting.err_general l ("Multiple set constraints for " ^ string_of_kid var)))
     | NC_or _ ->
        (match aux_or nc_full with
        | Some is -> Some (is, re NC_true)
@@ -290,7 +290,7 @@ let extract_set_nc l var nc =
   in match aux nc with
   | Some is -> is
   | None ->
-     raise (Reporting_basic.err_general l ("No set constraint for " ^ string_of_kid var ^
+     raise (Reporting.err_general l ("No set constraint for " ^ string_of_kid var ^
                                               " in " ^ string_of_n_constraint nc))
 
 let rec peel = function
@@ -315,9 +315,9 @@ let rec inst_src_type insts (Typ_aux (ty,l) as typ) =
   | Typ_var _
     -> insts,typ
   | Typ_fn _ ->
-     raise (Reporting_basic.err_general l "Function type in constructor")
+     raise (Reporting.err_general l "Function type in constructor")
   | Typ_bidir _ ->
-     raise (Reporting_basic.err_general l "Mapping type in constructor")
+     raise (Reporting.err_general l "Mapping type in constructor")
   | Typ_tup ts ->
      let insts,ts = 
        List.fold_right
@@ -330,23 +330,25 @@ let rec inst_src_type insts (Typ_aux (ty,l) as typ) =
          (fun arg (insts,args) -> let insts,arg = inst_src_typ_arg insts arg in insts,arg::args)
          args (insts,[])
      in insts, Typ_aux (Typ_app (id,ts),l)
-  | Typ_exist (kids, nc, t) -> begin
+  | Typ_exist (kopts, nc, t) -> begin
+      (* TODO handle non-integer existentials *)
+     let kids = List.map kopt_kid kopts in
      let kid_insts, insts' = peel (kids,insts) in
      let kids', t' = apply_kid_insts kid_insts t in
      (* TODO: subst in nc *)
      match kids' with
      | [] -> insts', t'
-     | _ -> insts', Typ_aux (Typ_exist (kids', nc, t'), l)
+     | _ -> insts', Typ_aux (Typ_exist (List.map (mk_kopt K_int) kids', nc, t'), l)
     end
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and inst_src_typ_arg insts (Typ_arg_aux (ta,l) as tyarg) =
+and inst_src_typ_arg insts (A_aux (ta,l) as tyarg) =
   match ta with
-  | Typ_arg_nexp _
-  | Typ_arg_order _
+  | A_nexp _
+  | A_order _
       -> insts, tyarg
-  | Typ_arg_typ typ ->
+  | A_typ typ ->
      let insts', typ' = inst_src_type insts typ in
-     insts', Typ_arg_aux (Typ_arg_typ typ',l)
+     insts', A_aux (A_typ typ',l)
 
 let rec contains_exist (Typ_aux (ty,l)) =
   match ty with
@@ -359,12 +361,12 @@ let rec contains_exist (Typ_aux (ty,l)) =
   | Typ_app (_,args) -> List.exists contains_exist_arg args
   | Typ_exist _ -> true
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and contains_exist_arg (Typ_arg_aux (arg,_)) =
+and contains_exist_arg (A_aux (arg,_)) =
   match arg with
-  | Typ_arg_nexp _
-  | Typ_arg_order _
+  | A_nexp _
+  | A_order _
       -> false
-  | Typ_arg_typ typ -> contains_exist typ
+  | A_typ typ -> contains_exist typ
 
 let rec size_nvars_nexp (Nexp_aux (ne,_)) =
   match ne with
@@ -393,22 +395,24 @@ let split_src_type id ty (TypQ_aux (q,ql)) =
     | Typ_var _
       -> (KidSet.empty,[[],typ])
     | Typ_fn _ ->
-       raise (Reporting_basic.err_general l ("Function type in constructor " ^ i))
+       raise (Reporting.err_general l ("Function type in constructor " ^ i))
     | Typ_bidir _ ->
-       raise (Reporting_basic.err_general l ("Mapping type in constructor " ^ i))
+       raise (Reporting.err_general l ("Mapping type in constructor " ^ i))
     | Typ_tup ts ->
        let (vars,tys) = List.split (List.map size_nvars_ty ts) in
        let insttys = List.map (fun x -> let (insts,tys) = List.split x in
                                         List.concat insts, Typ_aux (Typ_tup tys,l)) (cross' tys) in
        (kidset_bigunion vars, insttys)
     | Typ_app (Id_aux (Id "vector",_),
-               [Typ_arg_aux (Typ_arg_nexp sz,_);
-                _;Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
+               [A_aux (A_nexp sz,_);
+                _;A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
        (KidSet.of_list (size_nvars_nexp sz), [[],typ])
     | Typ_app (_, tas) ->
        (KidSet.empty,[[],typ])  (* We only support sizes for bitvectors mentioned explicitly, not any buried
                       inside another type *)
-    | Typ_exist (kids, nc, t) ->
+    | Typ_exist (kopts, nc, t) ->
+       (* TODO handle non integer existentials *)
+       let kids = List.map kopt_kid kopts in
        let (vars,tys) = size_nvars_ty t in
        let find_insts k (insts,nc) =
          let inst,nc' =
@@ -426,7 +430,7 @@ let split_src_type id ty (TypQ_aux (q,ql)) =
            (* Typ_exist is not allowed an empty list of kids *)
            match kids with
            | [] -> ty
-           | _ -> Typ_aux (Typ_exist (kids, nc', ty),l)
+           | _ -> Typ_aux (Typ_exist (List.map (mk_kopt K_int) kids, nc', ty),l)
          in inst@inst0, ty
        in
        let tys = List.concat (List.map (fun instty -> List.map (ty_and_inst instty) insts) tys) in
@@ -450,10 +454,10 @@ let split_src_type id ty (TypQ_aux (q,ql)) =
                 | Typ_aux (Typ_tup _,_) -> Typ_aux (Typ_tup [ty],Unknown)
                 | _ -> ty) tys in
             if contains_exist t then
-              raise (Reporting_basic.err_general l
+              raise (Reporting.err_general l
                        "Only prenex types in unions are supported by monomorphisation")
             else if List.length kids > 1 then
-              raise (Reporting_basic.err_general l
+              raise (Reporting.err_general l
                        "Only single-variable existential types in unions are currently supported by monomorphisation")
             else tys
        end
@@ -465,7 +469,7 @@ let split_src_type id ty (TypQ_aux (q,ql)) =
   | [] -> None
   | sample::__ ->
      let () = if List.length variants > size_set_limit then
-         raise (Reporting_basic.err_general ql
+         raise (Reporting.err_general ql
                   (string_of_int (List.length variants) ^ "variants for constructor " ^ i ^
                      "bigger than limit " ^ string_of_int size_set_limit)) else ()
      in
@@ -490,7 +494,7 @@ let reduce_nexp subst ne =
     | Nexp_exp n -> Big_int.shift_left (eval n) 1
     | Nexp_neg n -> Big_int.negate (eval n)
     | _ ->
-       raise (Reporting_basic.err_general Unknown ("Couldn't turn nexp " ^
+       raise (Reporting.err_general Unknown ("Couldn't turn nexp " ^
                                                       string_of_nexp nexp ^ " into concrete value"))
   in eval ne
 
@@ -522,10 +526,12 @@ let refine_constructor refinements l env id args =
     (* A constructor should always have a single argument. *)
     | Typ_aux (Typ_fn ([constr_ty],_,_),_) -> begin
        let arg_ty = typ_of_args args in
-       match Type_check.destruct_exist env constr_ty with
+       match Type_check.destruct_exist (Type_check.Env.expand_synonyms env constr_ty) with
        | None -> None
-       | Some (kids,nc,constr_ty) ->
-          let (bindings,_,_) = Type_check.unify l env constr_ty arg_ty in
+       | Some (kopts,nc,constr_ty) ->
+          (* TODO: Handle non-integer existentials *)
+          let kids = List.map kopt_kid kopts in
+          let bindings = Type_check.unify l env (tyvars_of_typ constr_ty) constr_ty arg_ty  in
           let find_kid kid = try Some (KBindings.find kid bindings) with Not_found -> None in
           let bindings = List.map find_kid kids in
           let matches_refinement (mapping,_,_) =
@@ -533,13 +539,13 @@ let refine_constructor refinements l env id args =
               (fun v (_,w) ->
                 match v,w with
                 | _,None -> true
-                | Some (U_nexp (Nexp_aux (Nexp_constant n, _))),Some m -> Big_int.equal n m
+                | Some (A_aux (A_nexp (Nexp_aux (Nexp_constant n, _)), _)),Some m -> Big_int.equal n m
                 | _,_ -> false) bindings mapping
           in
           match List.find matches_refinement irefinements with
           | (_,new_id,_) -> Some (E_app (new_id,args))
           | exception Not_found ->
-             (Reporting_basic.print_err false true l "Monomorphisation"
+             (Reporting.print_err false true l "Monomorphisation"
                 ("Unable to refine constructor " ^ string_of_id id);
               None)
     end
@@ -615,8 +621,8 @@ let nexp_subst_fns substs =
       | E_vector_append (e1,e2) -> re (E_vector_append (s_exp e1,s_exp e2))
       | E_list es -> re (E_list (List.map s_exp es))
       | E_cons (e1,e2) -> re (E_cons (s_exp e1,s_exp e2))
-      | E_record fes -> re (E_record (s_fexps fes))
-      | E_record_update (e,fes) -> re (E_record_update (s_exp e, s_fexps fes))
+      | E_record fes -> re (E_record (List.map s_fexp fes))
+      | E_record_update (e,fes) -> re (E_record_update (s_exp e, List.map s_fexp fes))
       | E_field (e,id) -> re (E_field (s_exp e,id))
       | E_case (e,cases) -> re (E_case (s_exp e, List.map s_pexp cases))
       | E_let (lb,e) -> re (E_let (s_letbind lb, s_exp e))
@@ -629,8 +635,6 @@ let nexp_subst_fns substs =
       | E_internal_return e -> re (E_internal_return (s_exp e))
       | E_throw e -> re (E_throw (s_exp e))
       | E_try (e,cases) -> re (E_try (s_exp e, List.map s_pexp cases))
-    and s_fexps (FES_aux (FES_Fexps (fes,flag), (l,annot))) =
-      FES_aux (FES_Fexps (List.map s_fexp fes, flag), (l,s_tannot annot))
     and s_fexp (FE_aux (FE_Fexp (id,e), (l,annot))) =
       FE_aux (FE_Fexp (id,s_exp e),(l,s_tannot annot))
     and s_pexp = function
@@ -701,42 +705,43 @@ let fabricate_nexp_exist env l typ kids nc typ' =
   match kids,nc,Env.expand_synonyms env typ' with
   | ([kid],NC_aux (NC_set (kid',i::_),_),
      Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                       [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid'',_)),_)]),_))
+                       [A_aux (A_nexp (Nexp_aux (Nexp_var kid'',_)),_)]),_))
       when Kid.compare kid kid' = 0 && Kid.compare kid kid'' = 0 ->
      Nexp_aux (Nexp_constant i,Unknown)
   | ([kid],NC_aux (NC_true,_),
      Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                       [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid'',_)),_)]),_))
+                       [A_aux (A_nexp (Nexp_aux (Nexp_var kid'',_)),_)]),_))
       when Kid.compare kid kid'' = 0 ->
      nint 32
   | ([kid],NC_aux (NC_set (kid',i::_),_),
      Typ_aux (Typ_app (Id_aux (Id "range",_),
-                       [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid'',_)),_);
-                        Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid''',_)),_)]),_))
+                       [A_aux (A_nexp (Nexp_aux (Nexp_var kid'',_)),_);
+                        A_aux (A_nexp (Nexp_aux (Nexp_var kid''',_)),_)]),_))
       when Kid.compare kid kid' = 0 && Kid.compare kid kid'' = 0 &&
         Kid.compare kid kid''' = 0 ->
      Nexp_aux (Nexp_constant i,Unknown)
   | ([kid],NC_aux (NC_true,_),
      Typ_aux (Typ_app (Id_aux (Id "range",_),
-                       [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid'',_)),_);
-                        Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid''',_)),_)]),_))
+                       [A_aux (A_nexp (Nexp_aux (Nexp_var kid'',_)),_);
+                        A_aux (A_nexp (Nexp_aux (Nexp_var kid''',_)),_)]),_))
       when Kid.compare kid kid'' = 0 &&
         Kid.compare kid kid''' = 0 ->
      nint 32
-  | _ -> raise (Reporting_basic.err_general l
+  | _ -> raise (Reporting.err_general l
                   ("Undefined value at unsupported type " ^ string_of_typ typ))
 
 let fabricate_nexp l tannot =
   match destruct_tannot tannot with
   | None -> nint 32
   | Some (env,typ,_) ->
-     match Type_check.destruct_exist env typ with
+     match Type_check.destruct_exist (Type_check.Env.expand_synonyms env typ) with
      | None -> nint 32
-     | Some (kids,nc,typ') -> fabricate_nexp_exist env l typ kids nc typ'
+     (* TODO: check this *)
+     | Some (kopts,nc,typ') -> fabricate_nexp_exist env l typ (List.map kopt_kid kopts) nc typ'
 
 let atom_typ_kid kid = function
   | Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                      [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid',_)),_)]),_) ->
+                      [A_aux (A_nexp (Nexp_aux (Nexp_var kid',_)),_)]),_) ->
      Kid.compare kid kid' = 0
   | _ -> false
 
@@ -747,24 +752,24 @@ let atom_typ_kid kid = function
 let reduce_cast typ exp l annot =
   let env = env_of_annot (l,annot) in
   let typ' = Env.base_typ_of env typ in
-  match exp, destruct_exist env typ' with
-  | E_aux (E_lit (L_aux (L_num n,_)),_), Some ([kid],nc,typ'') when atom_typ_kid kid typ'' ->
-     let nc_env = Env.add_typ_var l kid BK_int env in
-     let nc_env = Env.add_constraint (nc_eq (nvar kid) (nconstant n)) nc_env in
+  match exp, destruct_exist (Env.expand_synonyms env typ') with
+  | E_aux (E_lit (L_aux (L_num n,_)),_), Some ([kopt],nc,typ'') when atom_typ_kid (kopt_kid kopt) typ'' ->
+     let nc_env = Env.add_typ_var l kopt env in
+     let nc_env = Env.add_constraint (nc_eq (nvar (kopt_kid kopt)) (nconstant n)) nc_env in
      if prove nc_env nc
      then exp
-     else raise (Reporting_basic.err_unreachable l __POS__
+     else raise (Reporting.err_unreachable l __POS__
                    ("Constant propagation error: literal " ^ Big_int.to_string n ^
                        " does not satisfy constraint " ^ string_of_n_constraint nc))
-  | E_aux (E_lit (L_aux (L_undef,_)),_), Some ([kid],nc,typ'') when atom_typ_kid kid typ'' ->
-     let nexp = fabricate_nexp_exist env Unknown typ [kid] nc typ'' in
-     let newtyp = subst_src_typ (KBindings.singleton kid nexp) typ'' in
+  | E_aux (E_lit (L_aux (L_undef,_)),_), Some ([kopt],nc,typ'') when atom_typ_kid (kopt_kid kopt) typ'' ->
+     let nexp = fabricate_nexp_exist env Unknown typ [kopt_kid kopt] nc typ'' in
+     let newtyp = subst_src_typ (KBindings.singleton (kopt_kid kopt) nexp) typ'' in
      E_aux (E_cast (newtyp, exp), (Generated l,replace_typ newtyp annot))
   | E_aux (E_cast (_,
                    (E_aux (E_lit (L_aux (L_undef,_)),_) as exp)),_),
-     Some ([kid],nc,typ'') when atom_typ_kid kid typ'' ->
-     let nexp = fabricate_nexp_exist env Unknown typ [kid] nc typ'' in
-     let newtyp = subst_src_typ (KBindings.singleton kid nexp) typ'' in
+     Some ([kopt],nc,typ'') when atom_typ_kid (kopt_kid kopt) typ'' ->
+     let nexp = fabricate_nexp_exist env Unknown typ [kopt_kid kopt] nc typ'' in
+     let newtyp = subst_src_typ (KBindings.singleton (kopt_kid kopt) nexp) typ'' in
      E_aux (E_cast (newtyp, exp), (Generated l,replace_typ newtyp annot))
   | _ -> E_aux (E_cast (typ,exp),(l,annot))
 
@@ -852,7 +857,7 @@ let try_app (l,ann) (id,args) =
        E_aux (E_lit L_aux (L_num i,_), _);
        E_aux (E_lit L_aux (L_num len,_), _)] ->
        (match Env.base_typ_of (env_of_annot annot) (typ_of_annot annot) with
-       | Typ_aux (Typ_app (_,[_;Typ_arg_aux (Typ_arg_order ord,_);_]),_) ->
+       | Typ_aux (Typ_app (_,[_;A_aux (A_order ord,_);_]),_) ->
           (match slice_lit lit i len ord with
           | Some lit' -> Some (E_aux (E_lit lit',(l,ann)))
           | None -> None)
@@ -954,7 +959,7 @@ let referenced_vars exp =
          { (compute_exp_alg IdSet.empty IdSet.union) with
            e_ref = (fun id -> IdSet.singleton id, E_ref id) } exp)
 
-let assigned_vars_in_fexps (FES_aux (FES_Fexps (fes,_), _)) =
+let assigned_vars_in_fexps fes =
   List.fold_left
     (fun vs (FE_aux (FE_Fexp (_,e),_)) -> IdSet.union vs (assigned_vars e))
     IdSet.empty
@@ -1154,10 +1159,10 @@ let apply_pat_choices choices =
           List.fold_left (fun e (id,e') ->
             E_let (LB_aux (LB_val (P_aux (P_id id, dummyannot),e'),dummyannot),E_aux (e,dummyannot))) e subst
        | Pat_aux (Pat_when _,(l,_)) ->
-          raise (Reporting_basic.err_unreachable l __POS__
+          raise (Reporting.err_unreachable l __POS__
                    "Pattern acquired a guard after analysis!")
        | exception Not_found ->
-          raise (Reporting_basic.err_unreachable (exp_loc e) __POS__
+          raise (Reporting.err_unreachable (exp_loc e) __POS__
                    "Unable to find case I found earlier!"))
     | exception Not_found -> E_case (e,cases)
   in
@@ -1458,10 +1463,10 @@ let split_defs all_errors splits defs =
     | E_internal_plet _
     | E_internal_return _
     | E_internal_value _
-      -> raise (Reporting_basic.err_unreachable l __POS__
+      -> raise (Reporting.err_unreachable l __POS__
                   ("Unexpected expression encountered in monomorphisation: " ^ string_of_exp exp))
-  and const_prop_fexps ref_vars substs assigns (FES_aux (FES_Fexps (fes,flag), annot)) =
-    FES_aux (FES_Fexps (List.map (const_prop_fexp ref_vars substs assigns) fes, flag), annot)
+  and const_prop_fexps ref_vars substs assigns fes =
+    List.map (const_prop_fexp ref_vars substs assigns) fes
   and const_prop_fexp ref_vars substs assigns (FE_aux (FE_Fexp (id,e), annot)) =
     FE_aux (FE_Fexp (id,fst (const_prop_exp ref_vars substs assigns e)),annot)
   and const_prop_pexp ref_vars substs assigns = function
@@ -1528,7 +1533,7 @@ let split_defs all_errors splits defs =
 
   and can_match_with_env ref_vars env (E_aux (e,(l,annot)) as exp0) cases (substs,ksubsts) assigns =
     let rec findpat_generic check_pat description assigns = function
-      | [] -> (Reporting_basic.print_err false true l "Monomorphisation"
+      | [] -> (Reporting.print_err false true l "Monomorphisation"
                  ("Failed to find a case for " ^ description); None)
       | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[],[])
       | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl ->
@@ -1575,7 +1580,7 @@ let split_defs all_errors splits defs =
             | P_aux (P_app (id',[]),_) ->
                if Id.compare id id' = 0 then DoesMatch ([],[]) else DoesNotMatch
             | P_aux (_,(l',_)) ->
-               (Reporting_basic.print_err false true l' "Monomorphisation"
+               (Reporting.print_err false true l' "Monomorphisation"
                   "Unexpected kind of pattern for enumeration"; GiveUp)
           in findpat_generic checkpat (string_of_id id) assigns cases
        | _ -> None)
@@ -1598,11 +1603,11 @@ let split_defs all_errors splits defs =
                  DoesMatch ([id, E_aux (E_cast (typ,E_aux (e,(l,empty_tannot))),(l,empty_tannot))],
                             [kid,nexp])
               | _ ->
-                 (Reporting_basic.print_err false true lit_l "Monomorphisation"
+                 (Reporting.print_err false true lit_l "Monomorphisation"
                     "Unexpected kind of literal for var match"; GiveUp)
             end
          | P_aux (_,(l',_)) ->
-            (Reporting_basic.print_err false true l' "Monomorphisation"
+            (Reporting.print_err false true l' "Monomorphisation"
                "Unexpected kind of pattern for literal"; GiveUp)
        in findpat_generic checkpat "literal" assigns cases
     | E_vector es when List.for_all (function (E_aux (E_lit _,_)) -> true | _ -> false) es ->
@@ -1622,11 +1627,11 @@ let split_defs all_errors splits defs =
               | _ -> DoesNotMatch) (DoesMatch ([],[])) matches in
             (match final with
             | GiveUp ->
-               (Reporting_basic.print_err false true l "Monomorphisation"
+               (Reporting.print_err false true l "Monomorphisation"
                   "Unexpected kind of pattern for vector literal"; GiveUp)
             | _ -> final)
          | _ ->
-            (Reporting_basic.print_err false true l "Monomorphisation"
+            (Reporting.print_err false true l "Monomorphisation"
                "Unexpected kind of pattern for vector literal"; GiveUp)
        in findpat_generic checkpat "vector literal" assigns cases
 
@@ -1644,7 +1649,7 @@ let split_defs all_errors splits defs =
             DoesMatch ([id, E_aux (E_cast (typ,e_undef),(l,empty_tannot))],
                        KBindings.bindings ksubst)
          | P_aux (_,(l',_)) ->
-            (Reporting_basic.print_err false true l' "Monomorphisation"
+            (Reporting.print_err false true l' "Monomorphisation"
                "Unexpected kind of pattern for literal"; GiveUp)
        in findpat_generic checkpat "literal" assigns cases
     | _ -> None
@@ -1670,7 +1675,7 @@ let split_defs all_errors splits defs =
     let new_l = Generated l in
     let renew_id (Id_aux (id,l)) = Id_aux (id,new_l) in
     let cannot msg =
-      let open Reporting_basic in
+      let open Reporting in
       let error =
         Err_general (pat_l,
                      ("Cannot split type " ^ string_of_typ typ ^ " for variable " ^ v ^ ": " ^ msg))
@@ -1700,7 +1705,7 @@ let split_defs all_errors splits defs =
               [L_zero; L_one]
          | _ -> cannot ("don't know about type " ^ string_of_id id))
 
-    | Typ_app (Id_aux (Id "vector",_), [Typ_arg_aux (Typ_arg_nexp len,_);_;Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
+    | Typ_app (Id_aux (Id "vector",_), [A_aux (A_nexp len,_);_;A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
        (match len with
        | Nexp_aux (Nexp_constant sz,_) ->
           let lits = make_vectors (Big_int.to_int sz) in
@@ -1711,7 +1716,7 @@ let split_defs all_errors splits defs =
           cannot ("length not constant, " ^ string_of_nexp len)
        )
     (* set constrained numbers *)
-    | Typ_app (Id_aux (Id "atom",_), [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (value,_) as nexp),_)]) ->
+    | Typ_app (Id_aux (Id "atom",_), [A_aux (A_nexp (Nexp_aux (value,_) as nexp),_)]) ->
        begin
          let mk_lit kid i =
             let lit = L_aux (L_num i,new_l) in
@@ -1726,7 +1731,7 @@ let split_defs all_errors splits defs =
            let nc = List.fold_left nc_and nc_true ncs in
            (match extract_set_nc l kvar nc with
            | (is,_) -> List.map (mk_lit (Some kvar)) is
-           | exception Reporting_basic.Fatal_error (Reporting_basic.Err_general (_,msg)) -> cannot msg)
+           | exception Reporting.Fatal_error (Reporting.Err_general (_,msg)) -> cannot msg)
          | _ -> cannot ("unsupport atom nexp " ^ string_of_nexp nexp)
        end
     | _ -> cannot ("unsupported type " ^ string_of_typ typ)
@@ -1737,8 +1742,8 @@ let split_defs all_errors splits defs =
 
   let map_locs ls (Defs defs) =
     let rec match_l = function
-      | Unknown
-      | Int _ -> []
+      | Unknown -> []
+      | Unique (_, l) -> match_l l
       | Generated l -> [] (* Could do match_l l, but only want to split user-written patterns *)
       | Documented (_,l) -> match_l l
       | Range (p,q) ->
@@ -1799,10 +1804,10 @@ let split_defs all_errors splits defs =
         | P_not p ->
            (* todo: not sure that I can't split - but can't figure out how at
             * the moment *)
-           raise (Reporting_basic.err_general l
+           raise (Reporting.err_general l
                     ("Cannot split on 'not' pattern"))
         | P_as (p',id) when id_match id <> None ->
-           raise (Reporting_basic.err_general l
+           raise (Reporting.err_general l
                     ("Cannot split " ^ string_of_id id ^ " on 'as' pattern"))
         | P_as (p',id) ->
            re (fun p -> P_as (p,id)) p'
@@ -1811,7 +1816,7 @@ let split_defs all_errors splits defs =
            (match spl p' with
            | None -> None
            | Some ps ->
-              let kids = equal_kids (pat_env_of p') kid in
+              let kids = equal_kids (env_of_pat p') kid in
               Some (List.map (fun (p,sub,pchoices,ksub) ->
                 P_aux (P_var (p,tp),(l,annot)), sub, pchoices,
                 List.concat
@@ -1846,7 +1851,7 @@ let split_defs all_errors splits defs =
                    let kid_subst = match orig_typ with
                      | Typ_aux
                          (Typ_app (Id_aux (Id "atom",_),
-                                   [Typ_arg_aux (Typ_arg_nexp
+                                   [A_aux (A_nexp
                                                    (Nexp_aux (Nexp_var var,_)),_)]),_) ->
                         [var,nconstant j]
                      | _ -> []
@@ -1907,7 +1912,7 @@ let split_defs all_errors splits defs =
                    match args with
                    | [P_aux (P_var (_, TP_aux (TP_var kid, _)),ann)] -> kid,ann
                    | _ -> 
-                      raise (Reporting_basic.err_general l
+                      raise (Reporting.err_general l
                                "Pattern match not currently supported by monomorphisation")
                  in
                  let map_inst (insts,id',_) =
@@ -1941,7 +1946,7 @@ let split_defs all_errors splits defs =
          let overlap = List.exists (fun (v,_) -> List.mem v pvs) lvs in
          let () =
            if overlap then
-             Reporting_basic.print_err false true l "Monomorphisation"
+             Reporting.print_err false true l "Monomorphisation"
                "Splitting a singleton pattern is not possible"
          in p
     in
@@ -1949,7 +1954,7 @@ let split_defs all_errors splits defs =
     let check_split_size lst l =
       let size = List.length lst in
       if size > size_set_limit then
-        let open Reporting_basic in
+        let open Reporting in
         let error =
           Err_general (l, "Case split is too large (" ^ string_of_int size ^
             " > limit " ^ string_of_int size_set_limit ^ ")")
@@ -1995,8 +2000,8 @@ let split_defs all_errors splits defs =
         | E_vector_append (e1,e2) -> re (E_vector_append (map_exp e1,map_exp e2))
         | E_list es -> re (E_list (List.map map_exp es))
         | E_cons (e1,e2) -> re (E_cons (map_exp e1,map_exp e2))
-        | E_record fes -> re (E_record (map_fexps fes))
-        | E_record_update (e,fes) -> re (E_record_update (map_exp e, map_fexps fes))
+        | E_record fes -> re (E_record (List.map map_fexp fes))
+        | E_record_update (e,fes) -> re (E_record_update (map_exp e, List.map map_fexp fes))
         | E_field (e,id) -> re (E_field (map_exp e,id))
         | E_case (e,cases) -> re (E_case (map_exp e, List.concat (List.map map_pexp cases)))
         | E_let (lb,e) -> re (E_let (map_letbind lb, map_exp e))
@@ -2009,8 +2014,6 @@ let split_defs all_errors splits defs =
         | E_var (le,e1,e2) -> re (E_var (map_lexp le, map_exp e1, map_exp e2))
         | E_internal_plet (p,e1,e2) -> re (E_internal_plet (check_single_pat p, map_exp e1, map_exp e2))
         | E_internal_return e -> re (E_internal_return (map_exp e))
-      and map_fexps (FES_aux (FES_Fexps (fes,flag), annot)) =
-        FES_aux (FES_Fexps (List.map map_fexp fes, flag), annot)
       and map_fexp (FE_aux (FE_Fexp (id,e), annot)) =
         FE_aux (FE_Fexp (id,map_exp e),annot)
       and map_pexp = function
@@ -2100,8 +2103,8 @@ let split_defs all_errors splits defs =
     in
     let map_scattered_def sd =
       match sd with
-      | SD_aux (SD_scattered_funcl fcl, annot) ->
-         List.map (fun fcl' -> SD_aux (SD_scattered_funcl fcl', annot)) (map_funcl fcl)
+      | SD_aux (SD_funcl fcl, annot) ->
+         List.map (fun fcl' -> SD_aux (SD_funcl fcl', annot)) (map_funcl fcl)
       | _ -> [sd]
     in
     let map_def d =
@@ -2113,6 +2116,7 @@ let split_defs all_errors splits defs =
       | DEF_reg_dec _
       | DEF_overload _
       | DEF_fixity _
+      | DEF_pragma _
       | DEF_internal_mutrec _
         -> [d]
       | DEF_fundef fd -> [DEF_fundef (map_fundef fd)]
@@ -2184,25 +2188,25 @@ let rec sizes_of_typ (Typ_aux (t,l)) =
   | Typ_id _
   | Typ_var _
     -> KidSet.empty
-  | Typ_fn _ -> raise (Reporting_basic.err_general l
+  | Typ_fn _ -> raise (Reporting.err_general l
                          "Function type on expression")
-  | Typ_bidir _ -> raise (Reporting_basic.err_general l "Mapping type on expression")
+  | Typ_bidir _ -> raise (Reporting.err_general l "Mapping type on expression")
   | Typ_tup typs -> kidset_bigunion (List.map sizes_of_typ typs)
-  | Typ_exist (kids,_,typ) ->
-     List.fold_left (fun s k -> KidSet.remove k s) (sizes_of_typ typ) kids
+  | Typ_exist (kopts,_,typ) ->
+     List.fold_left (fun s k -> KidSet.remove (kopt_kid k) s) (sizes_of_typ typ) kopts
   | Typ_app (Id_aux (Id "vector",_),
-             [Typ_arg_aux (Typ_arg_nexp size,_);
-              _;Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
+             [A_aux (A_nexp size,_);
+              _;A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]) ->
      KidSet.of_list (size_nvars_nexp size)
   | Typ_app (_,tas) ->
      kidset_bigunion (List.map sizes_of_typarg tas)
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and sizes_of_typarg (Typ_arg_aux (ta,_)) =
+and sizes_of_typarg (A_aux (ta,_)) =
   match ta with
-    Typ_arg_nexp _
-  | Typ_arg_order _
+    A_nexp _
+  | A_order _
     -> KidSet.empty
-  | Typ_arg_typ typ -> sizes_of_typ typ
+  | A_typ typ -> sizes_of_typ typ
 
 let sizes_of_annot (l, tannot) =
   match destruct_tannot tannot with
@@ -2221,7 +2225,7 @@ let change_parameter_pat i = function
                            mk_id "==",
                            E_aux (E_lit lit,annot)), annot) in
      P_aux (P_id var, (l,empty_tannot)), ([],[test])
-  | P_aux (_,(l,_)) -> raise (Reporting_basic.err_unreachable l __POS__
+  | P_aux (_,(l,_)) -> raise (Reporting.err_unreachable l __POS__
                                 "Expected variable pattern")
 
 (* TODO: make more precise, preferably with a proper free variables function
@@ -2265,33 +2269,33 @@ let replace_with_the_value bound_nexps (E_aux (_,(l,_)) as exp) =
   let mk_exp nexp l l' =
     let nexp = replace_size nexp in
     E_aux (E_cast (wrap (Typ_aux (Typ_app (Id_aux (Id "itself",Generated Unknown),
-                                           [Typ_arg_aux (Typ_arg_nexp nexp,l')]),Generated Unknown)),
+                                           [A_aux (A_nexp nexp,l')]),Generated Unknown)),
                    E_aux (E_app (Id_aux (Id "make_the_value",Generated Unknown),[exp]),(Generated l,empty_tannot))),
            (Generated l,empty_tannot))
   in
   match typ with
   | Typ_aux (Typ_app (Id_aux (Id "range",_),
-                      [Typ_arg_aux (Typ_arg_nexp nexp,l');Typ_arg_aux (Typ_arg_nexp nexp',_)]),_)
+                      [A_aux (A_nexp nexp,l');A_aux (A_nexp nexp',_)]),_)
     when nexp_identical nexp nexp' ->
      mk_exp nexp l l'
   | Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                      [Typ_arg_aux (Typ_arg_nexp nexp,l')]),_) ->
+                      [A_aux (A_nexp nexp,l')]),_) ->
      mk_exp nexp l l'
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__
+  | _ -> raise (Reporting.err_unreachable l __POS__
                   "atom stopped being an atom?")
 
 let replace_type env typ =
   let Typ_aux (t,l) = Env.expand_synonyms env typ in
   match t with
   | Typ_app (Id_aux (Id "range",_),
-             [Typ_arg_aux (Typ_arg_nexp nexp,l');Typ_arg_aux (Typ_arg_nexp _,_)]) ->
+             [A_aux (A_nexp nexp,l');A_aux (A_nexp _,_)]) ->
      Typ_aux (Typ_app (Id_aux (Id "itself",Generated Unknown),
-                       [Typ_arg_aux (Typ_arg_nexp nexp,l')]),Generated l)
+                       [A_aux (A_nexp nexp,l')]),Generated l)
   | Typ_app (Id_aux (Id "atom",_),
-                      [Typ_arg_aux (Typ_arg_nexp nexp,l')]) ->
+                      [A_aux (A_nexp nexp,l')]) ->
      Typ_aux (Typ_app (Id_aux (Id "itself",Generated Unknown),
-                       [Typ_arg_aux (Typ_arg_nexp nexp,l')]),Generated l)
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__
+                       [A_aux (A_nexp nexp,l')]),Generated l)
+  | _ -> raise (Reporting.err_unreachable l __POS__
                   "atom stopped being an atom?")
 
 
@@ -2305,18 +2309,18 @@ let rewrite_size_parameters env (Defs defs) =
     let _, typ = Env.get_val_spec_orig id env in
     let types = match typ with
       | Typ_aux (Typ_fn (arg_typs,_,_),_) -> List.map (Env.expand_synonyms env) arg_typs
-      | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Function clause does not have a function type")
+      | _ -> raise (Reporting.err_unreachable l __POS__ "Function clause does not have a function type")
     in
     let add_parameter (i,nmap) typ =
       let nmap =
         match Env.base_typ_of env typ with
           Typ_aux (Typ_app(Id_aux (Id "range",_),
-                           [Typ_arg_aux (Typ_arg_nexp nexp,_);
-                            Typ_arg_aux (Typ_arg_nexp nexp',_)]),_)
+                           [A_aux (A_nexp nexp,_);
+                            A_aux (A_nexp nexp',_)]),_)
             when Nexp.compare nexp nexp' = 0 && not (NexpMap.mem nexp nmap) ->
               NexpMap.add nexp i nmap
         | Typ_aux (Typ_app(Id_aux (Id "atom", _),
-                           [Typ_arg_aux (Typ_arg_nexp nexp,_)]), _)
+                           [A_aux (A_nexp nexp,_)]), _)
             when not (NexpMap.mem nexp nmap) ->
            NexpMap.add nexp i nmap
         | _ -> nmap
@@ -2325,7 +2329,7 @@ let rewrite_size_parameters env (Defs defs) =
     let (_,nexp_map) = List.fold_left add_parameter (0,NexpMap.empty) types in
     let nexp_list = NexpMap.bindings nexp_map in
 (* let () =
- print_endline ("Type of pattern for " ^ string_of_id id ^": " ^string_of_typ (pat_typ_of pat));
+ print_endline ("Type of pattern for " ^ string_of_id id ^": " ^string_of_typ (typ_of_pat pat));
  print_endline ("Types : " ^ String.concat ", " (List.map string_of_typ types));
  print_endline ("Nexp map for " ^ string_of_id id);
  List.iter (fun (nexp, i) -> print_endline ("  " ^ string_of_nexp nexp ^ " -> " ^ string_of_int i)) nexp_list
@@ -2334,7 +2338,7 @@ in *)
       match destruct_tannot tannot with
       | Some (env,typ,_) ->
          begin match Env.base_typ_of env typ with
-         | Typ_aux (Typ_app (Id_aux (Id "vector",_), [Typ_arg_aux (Typ_arg_nexp size,_);_;_]),_)
+         | Typ_aux (Typ_app (Id_aux (Id "vector",_), [A_aux (A_nexp size,_);_;_]),_)
              when not (is_nexp_constant size) ->
             begin
               match NexpMap.find size nexp_map with
@@ -2602,8 +2606,7 @@ let string_of_lx lx =
 
 let rec simple_string_of_loc = function
   | Parse_ast.Unknown -> "Unknown"
-  | Parse_ast.Int (s,None) -> "Int(" ^ s ^ ",None)"
-  | Parse_ast.Int (s,Some l) -> "Int(" ^ s ^ ",Some("^simple_string_of_loc l^"))"
+  | Parse_ast.Unique (n, l) -> "Unique(" ^ string_of_int n ^ ", " ^ simple_string_of_loc l ^ ")"
   | Parse_ast.Generated l -> "Generated(" ^ simple_string_of_loc l ^ ")"
   | Parse_ast.Range (lx1,lx2) -> "Range(" ^ string_of_lx lx1 ^ "->" ^ string_of_lx lx2 ^ ")"
   | Parse_ast.Documented (_,l) -> "Documented(_," ^ simple_string_of_loc l ^ ")"
@@ -2628,7 +2631,7 @@ let string_of_callerkidset s =
 let string_of_dep = function
   | Have (args,extras) ->
      "Have (" ^ string_of_argsplits args ^ ";" ^ string_of_extra_splits extras ^ ")"
-  | Unknown (l,msg) -> "Unknown " ^ msg ^ " at " ^ Reporting_basic.loc_to_string l
+  | Unknown (l,msg) -> "Unknown " ^ msg ^ " at " ^ Reporting.loc_to_string l
 
 (* If a callee uses a type variable as a size, does it need to be split in the
    current function, or is it also a parameter?  (Note that there may be multiple
@@ -2774,7 +2777,7 @@ let update_env_new_kids env deps typ_env_pre typ_env_post =
   let kbound =
     KBindings.merge (fun k x y ->
       match x,y with
-      | Some bk, None -> Some bk
+      | Some k, None -> Some k
       | _ -> None)
       (Env.get_typ_vars typ_env_post)
       (Env.get_typ_vars typ_env_pre)
@@ -2849,14 +2852,16 @@ let rec deps_of_nc kid_deps (NC_aux (nc,l)) =
 let deps_of_typ l kid_deps arg_deps typ =
   deps_of_tyvars l kid_deps arg_deps (tyvars_of_typ typ)
 
-let deps_of_uvar l fn_id env arg_deps = function
-  | U_nexp (Nexp_aux (Nexp_var kid,_))
+let deps_of_typ_arg l fn_id env arg_deps (A_aux (aux, _)) =
+  match aux with
+  | A_nexp (Nexp_aux (Nexp_var kid,_))
       when List.exists (fun k -> Kid.compare kid k == 0) env.top_kids ->
      Parents (CallerKidSet.singleton (fn_id,kid))
-  | U_nexp nexp -> InFun (deps_of_nexp l env.kid_deps arg_deps nexp)
-  | U_order _ -> InFun dempty
-  | U_typ typ -> InFun (deps_of_typ l env.kid_deps arg_deps typ)
-
+  | A_nexp nexp -> InFun (deps_of_nexp l env.kid_deps arg_deps nexp)
+  | A_order _ -> InFun dempty
+  | A_typ typ -> InFun (deps_of_typ l env.kid_deps arg_deps typ)
+  | A_bool nc -> InFun (deps_of_nc env.kid_deps nc)
+                     
 let mk_subrange_pattern vannot vstart vend =
   let (len,ord,typ) = vector_typ_args_of (Env.base_typ_of (env_of_annot vannot) (typ_of_annot vannot)) in
   match ord with
@@ -2871,7 +2876,7 @@ let mk_subrange_pattern vannot vstart vend =
           let end_len = Big_int.pred (Big_int.sub len vend) in
           (* Wrap pat in its type; in particular the type checker won't
              manage P_wild in the middle of a P_vector_concat *)
-          let pat = P_aux (P_typ (pat_typ_of pat, pat),(Generated (pat_loc pat),empty_tannot)) in
+          let pat = P_aux (P_typ (typ_of_pat pat, pat),(Generated (pat_loc pat),empty_tannot)) in
           let pats = if Big_int.greater end_len Big_int.zero then
               [pat;P_aux (P_typ (vector_typ (nconstant end_len) ord typ,
                                  P_aux (P_wild,(dummyl,empty_tannot))),(dummyl,empty_tannot))]
@@ -2902,8 +2907,8 @@ let refine_dependency env (E_aux (e,(l,annot)) as exp) pexps =
           with
           | Some pats ->
              if l = Parse_ast.Unknown then
-               (Reporting_basic.print_error
-                  (Reporting_basic.Err_general
+               (Reporting.print_error
+                  (Reporting.Err_general
                      (l, "No location for pattern match: " ^ string_of_exp exp));
                 None)
              else
@@ -2941,8 +2946,8 @@ let simplify_size_nexp env typ_env (Nexp_aux (ne,l) as nexp) =
         | kid -> Nexp_aux (Nexp_var kid,Generated l)
         | exception Not_found -> nexp
 
-let simplify_size_uvar env typ_env = function
-  | U_nexp nexp -> U_nexp (simplify_size_nexp env typ_env nexp)
+let simplify_size_typ_arg env typ_env = function
+  | A_aux (A_nexp nexp, l) -> A_aux (A_nexp (simplify_size_nexp env typ_env nexp), l)
   | x -> x
 
 (* Takes an environment of dependencies on vars, type vars, and flow control,
@@ -3034,10 +3039,10 @@ let rec analyse_exp fn_id env assigns (E_aux (e,(l,annot)) as exp) =
          | _ -> Unknown (l, "Effects from function application")
        in
        let kid_inst = instantiation_of exp in
-       let kid_inst = KBindings.map (simplify_size_uvar env typ_env) kid_inst in
+       let kid_inst = KBindings.map (simplify_size_typ_arg env typ_env) kid_inst in
        (* Change kids in instantiation to the canonical ones from the type signature *)
        let kid_inst = KBindings.fold (fun kid -> KBindings.add (orig_kid kid)) kid_inst KBindings.empty in
-       let kid_deps = KBindings.map (deps_of_uvar l fn_id env deps) kid_inst in
+       let kid_deps = KBindings.map (deps_of_typ_arg l fn_id env deps) kid_inst in
        let rdep,r' =
          if Id.compare fn_id id == 0 then
            let bad = Unknown (l,"Recursive call of " ^ string_of_id id) in
@@ -3087,11 +3092,11 @@ let rec analyse_exp fn_id env assigns (E_aux (e,(l,annot)) as exp) =
     | E_vector_update_subrange (e1,e2,e3,e4) ->
        let ds, assigns, r = non_det [e1;e2;e3;e4] in
        (merge_deps ds, assigns, r)
-    | E_record (FES_aux (FES_Fexps (fexps,_),_)) ->
+    | E_record fexps ->
        let es = List.map (function (FE_aux (FE_Fexp (_,e),_)) -> e) fexps in
        let ds, assigns, r = non_det es in
        (merge_deps ds, assigns, r)
-    | E_record_update (e,FES_aux (FES_Fexps (fexps,_),_)) ->
+    | E_record_update (e,fexps) ->
        let es = List.map (function (FE_aux (FE_Fexp (_,e),_)) -> e) fexps in
        let ds, assigns, r = non_det (e::es) in
        (merge_deps ds, assigns, r)
@@ -3165,7 +3170,7 @@ let rec analyse_exp fn_id env assigns (E_aux (e,(l,annot)) as exp) =
     | E_internal_plet _
     | E_internal_return _
     | E_internal_value _
-      -> raise (Reporting_basic.err_unreachable l __POS__
+      -> raise (Reporting.err_unreachable l __POS__
                   ("Unexpected expression encountered in monomorphisation: " ^ string_of_exp exp))
 
     | E_var (lexp,e1,e2) ->
@@ -3184,13 +3189,13 @@ let rec analyse_exp fn_id env assigns (E_aux (e,(l,annot)) as exp) =
     | Some (tenv,typ,_) ->
        let typ = Env.base_typ_of tenv typ in
        let env, tenv, typ =
-         match destruct_exist tenv typ with
+         match destruct_exist (Env.expand_synonyms tenv typ) with
          | None -> env, tenv, typ
-         | Some (kids, nc, typ) ->
+         | Some (kopts, nc, typ) ->
             { env with kid_deps =
-                List.fold_left (fun kds kid -> KBindings.add kid deps kds) env.kid_deps kids },
+                List.fold_left (fun kds kopt -> KBindings.add (kopt_kid kopt) deps kds) env.kid_deps kopts },
            Env.add_constraint nc
-             (List.fold_left (fun tenv kid -> Env.add_typ_var l kid BK_int tenv) tenv kids),
+             (List.fold_left (fun tenv kopt -> Env.add_typ_var l kopt tenv) tenv kopts),
            typ
        in
        if is_bitvector_typ typ then
@@ -3269,7 +3274,7 @@ let initial_env fn_id fn_l (TypQ_aux (tq,_)) pat body set_assertions =
     let env = env_of_annot annot in
     let Typ_aux (typ,_) = Env.base_typ_of env (typ_of_annot annot) in
     match typ with
-    | Typ_app (Id_aux (Id "atom",_),[Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid,_)),_)]) ->
+    | Typ_app (Id_aux (Id "atom",_),[A_aux (A_nexp (Nexp_aux (Nexp_var kid,_)),_)]) ->
        equal_kids env kid
     | _ -> KidSet.empty
   in
@@ -3291,7 +3296,7 @@ let initial_env fn_id fn_l (TypQ_aux (tq,_)) pat body set_assertions =
   in
   let eqn_instantiations = Type_check.instantiate_simple_equations qs in
   let eqn_kid_deps = KBindings.map (function
-    | U_nexp nexp -> Some (nexp_frees nexp)
+    | A_aux (A_nexp nexp, _) -> Some (nexp_frees nexp)
     | _ -> None) eqn_instantiations
   in
   let arg i pat =
@@ -3360,7 +3365,7 @@ let initial_env fn_id fn_l (TypQ_aux (tq,_)) pat body set_assertions =
     in aux pat
   in
   let quant = function
-    | QI_aux (QI_id (KOpt_aux ((KOpt_none kid | KOpt_kind (_,kid)),_)),_) ->
+    | QI_aux (QI_id (KOpt_aux (KOpt_kind (_,kid),_)),_) ->
        Some kid
     | QI_aux (QI_const _,_) -> None
   in
@@ -3373,7 +3378,7 @@ let initial_env fn_id fn_l (TypQ_aux (tq,_)) pat body set_assertions =
     else
       (* When there's no argument to case split on for a kid, we'll add a
          case expression instead *)
-      let env = pat_env_of pat in
+      let env = env_of_pat pat in
       let split = default_split (mk_tannot env int_typ no_effect) (KidSet.singleton kid) in
       let extra_splits = ExtraSplits.singleton (fn_id, fn_l)
         (KBindings.singleton kid split) in
@@ -3500,7 +3505,7 @@ let print_result r =
   let _ = print_endline ("  kid_in_caller: " ^ string_of_callerkidset r.kid_in_caller) in
   let _ = print_endline ("  failures: \n    " ^
                             (String.concat "\n    "
-                               (List.map (fun (l,s) -> Reporting_basic.loc_to_string l ^ ":\n     " ^
+                               (List.map (fun (l,s) -> Reporting.loc_to_string l ^ ":\n     " ^
                                  String.concat "\n      " (StringSet.elements s))
                                   (Failures.bindings r.failures)))) in
   ()
@@ -3585,7 +3590,7 @@ let analyse_defs debug env (Defs defs) =
   then (true,splits,extras) else
     begin
       Failures.iter (fun l msgs ->
-        Reporting_basic.print_err false false l "Monomorphisation" (String.concat "\n" (StringSet.elements msgs)))
+        Reporting.print_err false false l "Monomorphisation" (String.concat "\n" (StringSet.elements msgs)))
         fails;
       (false, splits,extras)
     end
@@ -3610,7 +3615,7 @@ let add_extra_splits extras (Defs defs) =
          let loc = match Analysis.translate_loc l with
            | Some l -> l
            | None ->
-              (Reporting_basic.print_err false false l "Monomorphisation"
+              (Reporting.print_err false false l "Monomorphisation"
                  "Internal error: bad location for added case";
                ("",0))
          in
@@ -3663,6 +3668,11 @@ let is_constant_vec_typ env typ =
 
 let rewrite_app env typ (id,args) =
   let is_append = is_id env (Id "append") in
+  let is_zero_extend =
+    is_id env (Id "Extend") id || is_id env (Id "ZeroExtend") id ||
+    is_id env (Id "zero_extend") id || is_id env (Id "sail_zero_extend") id ||
+    is_id env (Id "mips_zero_extend") id
+  in
   let try_cast_to_typ (E_aux (e,_) as exp) =
     let (size,order,bittyp) = vector_typ_args_of (Env.base_typ_of env typ) in
     match size with
@@ -3819,7 +3829,7 @@ let rewrite_app env typ (id,args) =
               [vector1; start1; end1])
     | _ -> E_app (id,args)
 
-  else if is_id env (Id "Extend") id || is_id env (Id "ZeroExtend") id || is_id env (Id "zero_extend") id then
+  else if is_zero_extend then
     let is_subrange = is_id env (Id "vector_subrange") in
     let is_slice = is_id env (Id "slice") in
     let is_zeros = is_id env (Id "Zeros") in
@@ -3841,11 +3851,16 @@ let rewrite_app env typ (id,args) =
       -> E_app (mk_id "place_slice",
                 [vector1; start1; length1; length2])
 
-    (* If we've already rewritten to slice_slice_concat, we can just drop the
-       zero extension because it can do it *)
-    | (E_aux (E_cast (_, (E_aux (E_app (Id_aux (Id "slice_slice_concat",_), args),_))),_))::
+    (* If we've already rewritten to slice_slice_concat or subrange_subrange_concat,
+       we can just drop the zero extension because those functions can do it
+       themselves *)
+    | (E_aux (E_cast (_, (E_aux (E_app (Id_aux ((Id "slice_slice_concat" | Id "subrange_subrange_concat"),_) as op, args),_))),_))::
+        ([] | [_;E_aux (E_id (Id_aux (Id "unsigned",_)),_)])
+      -> E_app (op, args)
+
+    | (E_aux (E_app (Id_aux ((Id "slice_slice_concat" | Id "subrange_subrange_concat"),_) as op, args),_))::
         ([] | [_;E_aux (E_id (Id_aux (Id "unsigned",_)),_)])
-      -> E_app (mk_id "slice_slice_concat", args)
+      -> E_app (op, args)
 
     | [E_aux (E_app (slice1, [vector1; start1; length1]),_)]
         when is_slice slice1 && not (is_constant length1) ->
@@ -3948,15 +3963,15 @@ let make_bitvector_cast_fns cast_name env quant_kids src_typ target_typ =
        P_aux (P_typ (src_typ, P_aux (P_tup ps,(Generated src_l, src_ann))),(Generated src_l, src_ann)),
        E_aux (E_tuple es,(Generated tar_l, tar_ann))
     | Typ_app (Id_aux (Id "vector",_),
-               [Typ_arg_aux (Typ_arg_nexp size,_); _;
-                Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]),
+               [A_aux (A_nexp size,_); _;
+                A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)]),
       Typ_app (Id_aux (Id "vector",_) as t_id,
-               [Typ_arg_aux (Typ_arg_nexp size',l_size'); t_ord;
-                Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_) as t_bit]) -> begin
+               [A_aux (A_nexp size',l_size'); t_ord;
+                A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_) as t_bit]) -> begin
        match simplify_size_nexp env quant_kids size, simplify_size_nexp env quant_kids size' with
        | Some size, Some size' when Nexp.compare size size' <> 0 ->
           let var = fresh () in
-          let tar_typ' = Typ_aux (Typ_app (t_id, [Typ_arg_aux (Typ_arg_nexp size',l_size');t_ord;t_bit]),
+          let tar_typ' = Typ_aux (Typ_app (t_id, [A_aux (A_nexp size',l_size');t_ord;t_bit]),
                                   tar_l) in
           let () = at_least_one := Some tar_typ' in
           P_aux (P_id var,(Generated src_l,src_ann)),
@@ -4031,9 +4046,9 @@ let fill_in_type env typ =
   let tyvars = tyvars_of_typ typ in
   let subst = KidSet.fold (fun kid subst ->
     match Env.get_typ_var kid env with
-    | BK_type
-    | BK_order -> subst
-    | BK_int ->
+    | K_type
+    | K_order -> subst
+    | K_int ->
        (match solve env (nvar kid) with
        | None -> subst
        | Some n -> KBindings.add kid (nconstant n) subst)) tyvars KBindings.empty in
@@ -4056,7 +4071,7 @@ let add_bitvector_casts (Defs defs) =
         let matched_typ = Env.base_typ_of env (typ_of_annot ann') in
         match e',matched_typ with
         | E_sizeof (Nexp_aux (Nexp_var kid,_)), _
-        | _, Typ_aux (Typ_app (Id_aux (Id "atom",_), [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid,_)),_)]),_) ->
+        | _, Typ_aux (Typ_app (Id_aux (Id "atom",_), [A_aux (A_nexp (Nexp_aux (Nexp_var kid,_)),_)]),_) ->
            let map_case pexp =
              let pat,guard,body,ann = destruct_pexp pexp in
              let body = match pat, guard with
@@ -4134,7 +4149,7 @@ let add_bitvector_casts (Defs defs) =
       match typ with
       | Typ_aux (Typ_fn (_,ret,_),_) -> ret
       | Typ_aux (_,l) as typ ->
-         raise (Reporting_basic.err_unreachable l __POS__
+         raise (Reporting.err_unreachable l __POS__
                   ("Function clause must have function type: " ^ string_of_typ typ ^
                       " is not a function type"))
     in
@@ -4180,16 +4195,16 @@ let replace_nexp_in_typ env typ orig new_nexp =
        let fs, targs = List.split (List.map aux_targ targs) in
        List.exists (fun x -> x) fs, Typ_aux (Typ_app (id, targs),l)
     | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-  and aux_targ (Typ_arg_aux (ta,l) as typ_arg) =
+  and aux_targ (A_aux (ta,l) as typ_arg) =
     match ta with
-    | Typ_arg_nexp nexp ->
+    | A_nexp nexp ->
        if prove env (nc_eq nexp orig)
-       then true, Typ_arg_aux (Typ_arg_nexp new_nexp,l)
+       then true, A_aux (A_nexp new_nexp,l)
        else false, typ_arg
-    | Typ_arg_typ typ ->
+    | A_typ typ ->
        let f, typ = aux typ in
-       f, Typ_arg_aux (Typ_arg_typ typ,l)
-    | Typ_arg_order _ -> false, typ_arg
+       f, A_aux (A_typ typ,l)
+    | A_order _ -> false, typ_arg
   in aux typ
 
 let fresh_nexp_kid nexp =
@@ -4266,7 +4281,7 @@ let rewrite_toplevel_nexps (Defs defs) =
        match nexp_map with
        | [] -> None
        | _ ->
-          let new_vars = List.map (fun (kid,nexp) -> QI_aux (QI_id (KOpt_aux (KOpt_none kid,Generated Unknown)), Generated tq_l)) nexp_map in
+          let new_vars = List.map (fun (kid,nexp) -> QI_aux (QI_id (mk_kopt K_int kid), Generated tq_l)) nexp_map in
           let new_constraints = List.map (fun (kid,nexp) -> QI_aux (QI_const (nc_eq (nvar kid) nexp), Generated tq_l)) nexp_map in
           let tqs = TypQ_aux (TypQ_tq (qs @ new_vars @ new_constraints),tq_l) in
           let vs =
@@ -4281,13 +4296,13 @@ let rewrite_toplevel_nexps (Defs defs) =
        Typ_aux (Typ_exist (kids,(* TODO? *) nc, aux typ'),l)
     | Typ_app (id,targs) -> Typ_aux (Typ_app (id,List.map aux_targ targs),l)
     | _ -> typ_full
-    and aux_targ (Typ_arg_aux (ta,l) as ta_full) =
+    and aux_targ (A_aux (ta,l) as ta_full) =
       match ta with
-      | Typ_arg_typ typ -> Typ_arg_aux (Typ_arg_typ (aux typ),l)
-      | Typ_arg_order _ -> ta_full
-      | Typ_arg_nexp nexp ->
+      | A_typ typ -> A_aux (A_typ (aux typ),l)
+      | A_order _ -> ta_full
+      | A_nexp nexp ->
          match find_nexp env nexp_map nexp with
-         | (kid,_) -> Typ_arg_aux (Typ_arg_nexp (nvar kid),l)
+         | (kid,_) -> A_aux (A_nexp (nvar kid),l)
          | exception Not_found -> ta_full
     in aux typ
   in
@@ -4356,19 +4371,19 @@ let monomorphise opts splits defs =
       let f,r,ex = Analysis.analyse_defs opts.debug_analysis env defs in
       if f || opts.all_split_errors || opts.continue_anyway
       then f, r, ex
-      else raise (Reporting_basic.err_general Unknown "Unable to monomorphise program")
+      else raise (Reporting.err_general Unknown "Unable to monomorphise program")
     else true, [], Analysis.ExtraSplits.empty in
   let splits = new_splits @ (List.map (fun (loc,id) -> (loc,id,None)) splits) in
   let ok_extras, defs, extra_splits = add_extra_splits extra_splits defs in
   let splits = splits @ extra_splits in
   let () = if ok_extras || opts.all_split_errors || opts.continue_anyway
       then ()
-      else raise (Reporting_basic.err_general Unknown "Unable to monomorphise program")
+      else raise (Reporting.err_general Unknown "Unable to monomorphise program")
   in
   let ok_split, defs = split_defs opts.all_split_errors splits defs in
   let () = if (ok_analysis && ok_extras && ok_split) || opts.continue_anyway
       then ()
-      else raise (Reporting_basic.err_general Unknown "Unable to monomorphise program")
+      else raise (Reporting.err_general Unknown "Unable to monomorphise program")
   in defs
 
 let add_bitvector_casts = BitvectorSizeCasts.add_bitvector_casts
diff --git a/src/nl_flow.ml b/src/nl_flow.ml
new file mode 100644
index 00000000..e38e5fa5
--- /dev/null
+++ b/src/nl_flow.ml
@@ -0,0 +1,118 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+
+let opt_nl_flow = ref false
+
+let rec escapes (E_aux (aux, _)) =
+  match aux with
+  | E_throw _ -> true
+  | E_block [] -> false
+  | E_block exps -> escapes (List.hd (List.rev exps))
+  | _ -> false
+
+let is_bitvector_literal (L_aux (aux, _)) =
+  match aux with
+  | L_bin _ | L_hex _ -> true
+  | _ -> false
+
+let bitvector_unsigned (L_aux (aux, _)) =
+  let open Sail_lib in
+  match aux with
+  | L_bin str -> uint (List.map bin_char (Util.string_to_list str))
+  | L_hex str -> uint (bits_of_string str)
+  | _ -> assert false
+
+let rec pat_id (P_aux (aux, _)) =
+  match aux with
+  | P_id id -> Some id
+  | P_as (_, id) -> Some id
+  | P_var (pat, _) -> pat_id pat
+  | _ -> None
+
+let add_assert cond (E_aux (aux, (l, ())) as exp) =
+  let msg = mk_lit_exp (L_string "") in
+  let assertion = locate (fun _ -> gen_loc l) (mk_exp (E_assert (cond, msg))) in
+  match aux with
+  | E_block exps -> E_aux (E_block (assertion :: exps), (l, ()))
+  | _ -> E_aux (E_block (assertion :: [exp]), (l, ()))
+
+(* If we know that x != bitv, then after any let y = unsigned(x) we
+   will also know that y != unsigned(bitv) *)
+let modify_unsigned id value (E_aux (aux, annot) as exp) =
+  match aux with
+  | E_let (LB_aux (LB_val (pat, E_aux (E_app (f, [E_aux (E_id id', _)]), _)), _) as lb, exp')
+       when string_of_id f = "unsigned" && Id.compare id id' = 0 ->
+     begin match pat_id pat with
+     | None -> exp
+     | Some uid ->
+        E_aux (E_let (lb,
+                      add_assert (mk_exp (E_app_infix (mk_exp (E_id uid), mk_id "!=", mk_lit_exp (L_num value)))) exp'),
+               annot)
+     end
+  | _ -> exp
+
+let analyze' exps =
+  match exps with
+  | E_aux (E_if (cond, then_exp, _), _) :: rest when escapes then_exp ->
+     begin match cond with
+     | E_aux (E_app_infix (E_aux (E_id id, _), op, E_aux (E_lit lit, _)), _)
+     | E_aux (E_app_infix (E_aux (E_lit lit, _), op, E_aux (E_id id, _)), _)
+          when string_of_id op = "==" && is_bitvector_literal lit ->
+        let value = bitvector_unsigned lit in
+        List.map (modify_unsigned id value) exps
+     | _ -> exps
+     end
+  | _ -> exps
+
+let analyze exps =
+  if !opt_nl_flow then analyze' exps else exps
diff --git a/src/nl_flow.mli b/src/nl_flow.mli
new file mode 100644
index 00000000..f2bf0035
--- /dev/null
+++ b/src/nl_flow.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+
+(** [opt_nl_flow] must be true for [analyze] to do anything. *)
+val opt_nl_flow : bool ref
+
+(** Analyze a basic block for flow typing properties that do not
+   follow the lexical structure of the code (and therefore the
+   syntax-directed typing rules), and insert assertions for discovered
+   constraints *)
+val analyze : unit exp list -> unit exp list
diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml
index 2a1fae15..09be449d 100644
--- a/src/ocaml_backend.ml
+++ b/src/ocaml_backend.ml
@@ -103,10 +103,10 @@ let rec ocaml_string_typ (Typ_aux (typ_aux, l)) arg =
   | Typ_id id when string_of_id id = "exception" -> string "Printexc.to_string" ^^ space ^^ arg
   | Typ_id id -> ocaml_string_of id ^^ space ^^ arg
   | Typ_app (id, []) -> ocaml_string_of id ^^ space ^^ arg
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id eid, _)), _)])
+  | Typ_app (id, [A_aux (A_typ (Typ_aux (Typ_id eid, _)), _)])
        when string_of_id id = "list" && string_of_id eid = "bit" ->
      string "string_of_bits" ^^ space ^^ arg
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) when string_of_id id = "list" ->
+  | Typ_app (id, [A_aux (A_typ typ, _)]) when string_of_id id = "list" ->
      let farg = gensym () in
      separate space [string "string_of_list \", \""; parens (separate space [string "fun"; farg; string "->"; ocaml_string_typ typ farg]); arg]
   | Typ_app (_, _) -> string "\"APP\""
@@ -121,7 +121,7 @@ let rec ocaml_string_typ (Typ_aux (typ_aux, l)) arg =
   | Typ_bidir (t1, t2) -> string "\"BIDIR\""
   | Typ_var kid -> string "\"VAR\""
   | Typ_exist _ -> assert false
-  | Typ_internal_unknown -> raise (Reporting_basic.err_unreachable l __POS__ "escaped Typ_internal_unknown")
+  | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
 
 let ocaml_typ_id ctx = function
   | id when Id.compare id (mk_id "string") = 0 -> string "string"
@@ -143,13 +143,13 @@ let rec ocaml_typ ctx (Typ_aux (typ_aux, l)) =
   | Typ_app (id, typs) -> parens (separate_map (string ", ") (ocaml_typ_arg ctx) typs) ^^ space ^^ ocaml_typ_id ctx id
   | Typ_tup typs -> parens (separate_map (string " * ") (ocaml_typ ctx) typs)
   | Typ_fn (typs, typ, _) -> separate space [ocaml_typ ctx (Typ_aux (Typ_tup typs, l)); string "->"; ocaml_typ ctx typ]
-  | Typ_bidir (t1, t2) -> raise (Reporting_basic.err_general l "Ocaml doesn't support bidir types")
+  | Typ_bidir (t1, t2) -> raise (Reporting.err_general l "Ocaml doesn't support bidir types")
   | Typ_var kid -> zencode_kid kid
   | Typ_exist _ -> assert false
-  | Typ_internal_unknown -> raise (Reporting_basic.err_unreachable l __POS__ "escaped Typ_internal_unknown")
-and ocaml_typ_arg ctx (Typ_arg_aux (typ_arg_aux, _) as typ_arg) =
+  | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
+and ocaml_typ_arg ctx (A_aux (typ_arg_aux, _) as typ_arg) =
   match typ_arg_aux with
-  | Typ_arg_typ typ -> ocaml_typ ctx typ
+  | A_typ typ -> ocaml_typ ctx typ
   | _ -> failwith ("OCaml: unexpected type argument " ^ string_of_typ_arg typ_arg)
 
 let ocaml_typquant typq =
@@ -187,7 +187,7 @@ let rec ocaml_pat ctx (P_aux (pat_aux, _) as pat) =
   match pat_aux with
   | P_id id ->
      begin
-       match Env.lookup_id id (pat_env_of pat) with
+       match Env.lookup_id id (env_of_pat pat) with
        | Local (_, _) | Unbound -> zencode ctx id
        | Enum _ -> zencode_upper ctx id
        | _ -> failwith ("Ocaml: Cannot pattern match on register: " ^ string_of_pat pat)
@@ -242,9 +242,9 @@ let rec ocaml_exp ctx (E_aux (exp_aux, _) as exp) =
   | E_if (c, t, e) -> separate space [string "if"; ocaml_atomic_exp ctx c;
                                       string "then"; ocaml_atomic_exp ctx t;
                                       string "else"; ocaml_atomic_exp ctx e]
-  | E_record (FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record fexps ->
      enclose lbrace rbrace (group (separate_map (semi ^^ break 1) (ocaml_fexp ctx) fexps))
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, _), _)) ->
+  | E_record_update (exp, fexps) ->
      enclose lbrace rbrace (separate space [ocaml_atomic_exp ctx exp;
                                             string "with";
                                             separate_map (semi ^^ space) (ocaml_fexp ctx) fexps])
@@ -359,10 +359,10 @@ and ocaml_assignment ctx (LEXP_aux (lexp_aux, _) as lexp) exp =
             else ocaml_atomic_exp ctx exp
           in
           separate space [zencode ctx id; string ":="; traced_exp]
-       | _ -> separate space [zencode ctx id; string ":="; ocaml_exp ctx exp]
+       | _ -> separate space [zencode ctx id; string ":="; parens (ocaml_exp ctx exp)]
      end
   | LEXP_deref ref_exp ->
-     separate space [ocaml_atomic_exp ctx ref_exp; string ":="; ocaml_exp ctx exp]
+     separate space [ocaml_atomic_exp ctx ref_exp; string ":="; parens (ocaml_exp ctx exp)]
   | _ -> string ("LEXP<" ^ string_of_lexp lexp ^ ">")
 and ocaml_lexp ctx (LEXP_aux (lexp_aux, _) as lexp) =
   match lexp_aux with
@@ -608,7 +608,7 @@ let ocaml_typedef ctx (TD_aux (td_aux, _)) =
       ^//^ (bar ^^ space ^^ ocaml_enum ctx ids))
      ^^ ocaml_def_end
      ^^ ocaml_string_of_enum ctx id ids
-  | TD_abbrev (id, _, TypSchm_aux (TypSchm_ts (typq, typ), _)) ->
+  | TD_abbrev (id, typq, A_aux (A_typ typ, _)) ->
      separate space [string "type"; ocaml_typquant typq; zencode ctx id; equals; ocaml_typ ctx typ]
      ^^ ocaml_def_end
      ^^ ocaml_string_of_abbrev ctx id typq typ
@@ -680,7 +680,7 @@ let ocaml_pp_generators ctx defs orig_types required =
        if Bindings.mem id Type_check.Env.builtin_typs
        then IdSet.add id required
        else
-         raise (Reporting_basic.err_unreachable (id_loc id) __POS__
+         raise (Reporting.err_unreachable (id_loc id) __POS__
                   ("Required generator of unknown type " ^ string_of_id id))
   and add_req_from_id required id =
     if IdSet.mem id required then required
@@ -693,26 +693,26 @@ let ocaml_pp_generators ctx defs orig_types required =
     | Typ_internal_unknown
     | Typ_fn _
     | Typ_bidir _
-      -> raise (Reporting_basic.err_unreachable (typ_loc full_typ) __POS__
+      -> raise (Reporting.err_unreachable (typ_loc full_typ) __POS__
                   ("Required generator for type that should not appear: " ^
                      string_of_typ full_typ))
     | Typ_tup typs ->
        List.fold_left add_req_from_typ required typs
     | Typ_exist _ ->
-       raise (Reporting_basic.err_todo (typ_loc full_typ)
+       raise (Reporting.err_todo (typ_loc full_typ)
                 ("Generators for existential types not yet supported: " ^
                    string_of_typ full_typ))
     | Typ_app (id,args) ->
        List.fold_left add_req_from_typarg (add_req_from_id required id) args
-  and add_req_from_typarg required (Typ_arg_aux (arg,_)) =
+  and add_req_from_typarg required (A_aux (arg,_)) =
     match arg with
-    | Typ_arg_typ typ -> add_req_from_typ required typ
-    | Typ_arg_nexp _
-    | Typ_arg_order _
+    | A_typ typ -> add_req_from_typ required typ
+    | A_nexp _
+    | A_order _
       -> required
   and add_req_from_td required (TD_aux (td,(l,_))) =
     match td with
-    | TD_abbrev (_, _, TypSchm_aux (TypSchm_ts (_,typ),_)) ->
+    | TD_abbrev (_, _, A_aux (A_typ typ, _)) ->
        add_req_from_typ required typ
     | TD_record (_, _, _, fields, _) ->
        List.fold_left (fun req (typ,_) -> add_req_from_typ req typ) required fields
@@ -720,7 +720,7 @@ let ocaml_pp_generators ctx defs orig_types required =
        List.fold_left (fun req (Tu_aux (Tu_ty_id (typ,_),_)) ->
            add_req_from_typ req typ) required variants
     | TD_enum _ -> required
-    | TD_bitfield _ -> raise (Reporting_basic.err_todo l "Generators for bitfields not yet supported")
+    | TD_bitfield _ -> raise (Reporting.err_todo l "Generators for bitfields not yet supported")
   in
   let required = IdSet.fold (fun id req -> always_add_req_from_id req id) required required in
   let type_name id = zencode_string (string_of_id id) in
@@ -729,10 +729,11 @@ let ocaml_pp_generators ctx defs orig_types required =
       match Bindings.find id typemap with
       | TD_aux (td,_) ->
          (match td with
-          | TD_abbrev (_,_,TypSchm_aux (TypSchm_ts (tqs,typ),_)) -> tqs
+          | TD_abbrev (_,tqs,A_aux (A_typ _, _)) -> tqs
           | TD_record (_,_,tqs,_,_) -> tqs
           | TD_variant (_,_,tqs,_,_) -> tqs
           | TD_enum _ -> TypQ_aux (TypQ_no_forall,Unknown)
+          | TD_abbrev (_, _, _) -> assert false
           | TD_bitfield _ -> assert false)
       | exception Not_found ->
          Bindings.find id Type_check.Env.builtin_typs
@@ -748,10 +749,10 @@ let ocaml_pp_generators ctx defs orig_types required =
     let name = "gen_" ^ type_name id in
     let make_tyarg kindedid =
       if is_nat_kopt kindedid
-      then mk_typ_arg (Typ_arg_nexp (nvar (kopt_kid kindedid)))
+      then mk_typ_arg (A_nexp (nvar (kopt_kid kindedid)))
       else if is_order_kopt kindedid
-      then mk_typ_arg (Typ_arg_order (mk_ord (Ord_var (kopt_kid kindedid))))
-      else mk_typ_arg (Typ_arg_typ (mk_typ (Typ_var (kopt_kid kindedid))))
+      then mk_typ_arg (A_order (mk_ord (Ord_var (kopt_kid kindedid))))
+      else mk_typ_arg (A_typ (mk_typ (Typ_var (kopt_kid kindedid))))
     in
     let targs = List.map make_tyarg tquants in
     let gen_tyvars_pp, out_typ = match gen_tyvars with
@@ -776,34 +777,34 @@ let ocaml_pp_generators ctx defs orig_types required =
         let typ_str, args_pp = match typ with
           | Typ_id id -> type_name id, [string "g"]
           | Typ_app (id,args) -> type_name id, string "g"::List.map typearg args
-          | _ -> raise (Reporting_basic.err_todo l
+          | _ -> raise (Reporting.err_todo l
                           ("Unsupported type for generators: " ^ string_of_typ full_typ))
         in
         let args_pp = match args_pp with [] -> empty
                                        | _ -> space ^^ separate space args_pp
         in
         string ("g.gen_" ^ typ_str) ^^ args_pp
-      and typearg (Typ_arg_aux (arg,_)) =
+      and typearg (A_aux (arg,_)) =
         match arg with
-        | Typ_arg_nexp (Nexp_aux (nexp,l) as full_nexp) ->
+        | A_nexp (Nexp_aux (nexp,l) as full_nexp) ->
            (match nexp with
             | Nexp_constant c -> string (Big_int.to_string c) (* TODO: overflow *)
             | Nexp_var v -> mk_arg v
-            | _ -> raise (Reporting_basic.err_todo l
+            | _ -> raise (Reporting.err_todo l
                             ("Unsupported nexp for generators: " ^ string_of_nexp full_nexp)))
-        | Typ_arg_order (Ord_aux (ord,_)) ->
+        | A_order (Ord_aux (ord,_)) ->
            (match ord with
             | Ord_var v -> mk_arg v
             | Ord_inc -> string "true"
             | Ord_dec -> string "false")
-        | Typ_arg_typ typ -> parens (string "fun g -> " ^^ gen_type typ)
+        | A_typ typ -> parens (string "fun g -> " ^^ gen_type typ)
       in
       let make_subgen (Typ_aux (typ,l) as full_typ) =
         let typ_str, args_pp =
           match typ with
           | Typ_id id -> type_name id, []
           | Typ_app (id,args) -> type_name id, List.map typearg args
-          | _ -> raise (Reporting_basic.err_todo l
+          | _ -> raise (Reporting.err_todo l
                           ("Unsupported type for generators: " ^ string_of_typ full_typ))
         in
         let args_pp = match args_pp with [] -> empty
@@ -836,6 +837,9 @@ let ocaml_pp_generators ctx defs orig_types required =
         separate space [bar; dquotes (string (string_of_id id)); string "->";
                         zencode_upper ctx id]
       in
+      let rand_field (typ,id) =
+        zencode ctx id ^^ space ^^ equals ^^ space ^^ make_subgen typ
+      in
       let make_args tqs =
         string "g" ^^
         match quant_kopts tqs with
@@ -847,7 +851,7 @@ let ocaml_pp_generators ctx defs orig_types required =
       let tqs, body, constructors, builders =
         let TD_aux (td,(l,_)) = Bindings.find id typemap in
         match td with
-        | TD_abbrev (_,_,TypSchm_aux (TypSchm_ts (tqs,typ),_)) ->
+        | TD_abbrev (_,tqs,A_aux (A_typ typ, _)) ->
            tqs, gen_type typ, None, None
         | TD_variant (_,_,tqs,variants,_) ->
            tqs,
@@ -865,8 +869,10 @@ let ocaml_pp_generators ctx defs orig_types required =
                string "]",
            Some (separate_map (string ";" ^^ break 1) enum_constructor variants),
            Some (separate_map (break 1) build_enum_constructor variants)
+        | TD_record (_,_,tqs,fields,_) ->
+           tqs, braces (separate_map (string ";" ^^ break 1) rand_field fields), None, None
         | _ ->
-           raise (Reporting_basic.err_todo l "Generators for records and bitfields not yet supported")
+           raise (Reporting.err_todo l "Generators for bitfields not yet supported")
       in
       let name = type_name id in
       let constructors_pp = match constructors with
@@ -939,7 +945,7 @@ let ocaml_main spec sail_dir =
    @ [ "  zinitializze_registers ();";
        if !opt_trace_ocaml then "  Sail_lib.opt_trace := true;" else "  ();";
        "  Printexc.record_backtrace true;";
-       "  try zmain () with _ -> prerr_endline(\"Exiting due to uncaught exception\")\n";])
+       "  try zmain () with exn -> prerr_endline(\"Exiting due to uncaught exception:\\n\" ^ Printexc.to_string exn)\n";])
   |> String.concat "\n"
 
 let ocaml_pp_defs f defs generator_types =
@@ -978,7 +984,7 @@ let ocaml_compile spec defs generator_types =
   let tags_file = if !opt_ocaml_coverage then "_tags_coverage" else "_tags" in
   let _ = Unix.system ("cp -r " ^ sail_dir ^ "/lib/" ^ tags_file ^ " _tags") in
   let out_chan = open_out (spec ^ ".ml") in
-  if !opt_ocaml_coverage then 
+  if !opt_ocaml_coverage then
     ignore(Unix.system ("cp -r " ^ sail_dir ^ "/lib/myocamlbuild_coverage.ml myocamlbuild.ml"));
   ocaml_pp_defs out_chan defs generator_types;
   close_out out_chan;
diff --git a/src/parse_ast.ml b/src/parse_ast.ml
index db8f9939..f3bb28db 100644
--- a/src/parse_ast.ml
+++ b/src/parse_ast.ml
@@ -56,7 +56,7 @@ type text = string
 
 type l =
   | Unknown
-  | Int of string * l option
+  | Unique of int * l
   | Generated of l
   | Range of Lexing.position * Lexing.position
   | Documented of string * l
@@ -70,15 +70,16 @@ type x = text (* identifier *)
 type ix = text (* infix identifier *)
 
 type 
-base_kind_aux =  (* base kind *)
-   BK_type (* kind of types *)
- | BK_int (* kind of natural number size expressions *)
- | BK_order (* kind of vector order specifications *)
+kind_aux =  (* base kind *)
+   K_type (* kind of types *)
+ | K_int (* kind of natural number size expressions *)
+ | K_order (* kind of vector order specifications *)
+ | K_bool (* kind of constraints *)
 
 
 type 
-base_kind = 
-   BK_aux of base_kind_aux * l
+kind =
+   K_aux of kind_aux * l
 
 
 type 
@@ -110,13 +111,7 @@ id_aux =  (* Identifier *)
    Id of x
  | DeIid of x (* remove infix status *)
 
-
-type 
-kind_aux =  (* kinds *)
-   K_kind of (base_kind) list
-
-
-type 
+type
 base_effect = 
    BE_aux of base_effect_aux * l
 
@@ -128,19 +123,32 @@ kid =
 
 type 
 id = 
-   Id_aux of id_aux * l
+  Id_aux of id_aux * l
 
+type
+lit_aux =  (* Literal constant *)
+   L_unit (* $() : _$ *)
+ | L_zero (* $_ : _$ *)
+ | L_one (* $_ : _$ *)
+ | L_true (* $_ : _$ *)
+ | L_false (* $_ : _$ *)
+ | L_num of Big_int.num (* natural number constant *)
+ | L_hex of string (* bit vector constant, C-style *)
+ | L_bin of string (* bit vector constant, C-style *)
+ | L_undef (* undefined value *)
+ | L_string of string (* string constant *)
+ | L_real of string
 
-type 
-kind = 
-   K_aux of kind_aux * l
-
+type
+lit =
+   L_aux of lit_aux * l
 
-type 
+type
 atyp_aux =  (* expressions of all kinds, to be translated to types, nats, orders, and effects after parsing *)
    ATyp_id of id (* identifier *)
  | ATyp_var of kid (* ticked variable *)
- | ATyp_constant of Big_int.num (* constant *)
+ | ATyp_lit of lit (* literal *)
+ | ATyp_nset of kid * (Big_int.num) list (* set type *)
  | ATyp_times of atyp * atyp (* product *)
  | ATyp_sum of atyp * atyp (* sum *)
  | ATyp_minus of atyp * atyp (* subtraction *)
@@ -155,7 +163,8 @@ atyp_aux =  (* expressions of all kinds, to be translated to types, nats, orders
  | ATyp_wild
  | ATyp_tup of (atyp) list (* Tuple type *)
  | ATyp_app of id * (atyp) list (* type constructor application *)
- | ATyp_exist of kid list * n_constraint * atyp
+ | ATyp_exist of kinded_id list * atyp * atyp
+ | ATyp_base of id * atyp * atyp
 
 and atyp = 
    ATyp_aux of atyp_aux * l
@@ -166,32 +175,14 @@ kinded_id_aux =  (* optionally kind-annotated identifier *)
    KOpt_none of kid (* identifier *)
  | KOpt_kind of kind * kid (* kind-annotated variable *)
 
-
-and 
-n_constraint_aux =  (* constraint over kind $_$ *)
-   NC_equal of atyp * atyp
- | NC_bounded_ge of atyp * atyp
- | NC_bounded_le of atyp * atyp
- | NC_not_equal of atyp * atyp
- | NC_set of kid * (Big_int.num) list
- | NC_or of n_constraint * n_constraint
- | NC_and of n_constraint * n_constraint
- | NC_app of id * atyp list
- | NC_true
- | NC_false
-
 and
-n_constraint = 
-   NC_aux of n_constraint_aux * l
-
-type 
 kinded_id = 
    KOpt_aux of kinded_id_aux * l
 
 type
 quant_item_aux =  (* Either a kinded identifier or a nexp constraint for a typquant *)
    QI_id of kinded_id (* An optionally kinded identifier *)
- | QI_const of n_constraint (* A constraint for this type *)
+ | QI_const of atyp (* A constraint for this type *)
 
 
 type 
@@ -209,32 +200,12 @@ type
 typquant = 
    TypQ_aux of typquant_aux * l
 
-
-type 
-lit_aux =  (* Literal constant *)
-   L_unit (* $() : _$ *)
- | L_zero (* $_ : _$ *)
- | L_one (* $_ : _$ *)
- | L_true (* $_ : _$ *)
- | L_false (* $_ : _$ *)
- | L_num of Big_int.num (* natural number constant *)
- | L_hex of string (* bit vector constant, C-style *)
- | L_bin of string (* bit vector constant, C-style *)
- | L_undef (* undefined value *)
- | L_string of string (* string constant *)
- | L_real of string
-
-type 
+type
 typschm_aux =  (* type scheme *)
    TypSchm_ts of typquant * atyp
 
 
 type 
-lit = 
-   L_aux of lit_aux * l
-
-
-type 
 typschm = 
    TypSchm_aux of typschm_aux * l
 
@@ -297,7 +268,7 @@ exp_aux =  (* Expression *)
  | E_let of letbind * exp (* let expression *)
  | E_assign of exp * exp (* imperative assignment *)
  | E_sizeof of atyp
- | E_constraint of n_constraint
+ | E_constraint of atyp
  | E_exit of exp
  | E_throw of exp
  | E_try of exp * pexp list
@@ -314,12 +285,6 @@ and fexp_aux =  (* Field-expression *)
 and fexp = 
    FE_aux of fexp_aux * l
 
-and fexps_aux =  (* Field-expression list *)
-   FES_Fexps of (fexp) list * bool
-
-and fexps = 
-   FES_aux of fexps_aux * l
-
 and opt_default_aux =  (* Optional default value for indexed vectors, to define a defualt value for any unspecified positions in a sparse map *)
    Def_val_empty
  | Def_val_dec of exp
@@ -365,6 +330,7 @@ type
 rec_opt_aux =  (* Optional recursive annotation for functions *)
    Rec_nonrec (* non-recursive *)
  | Rec_rec (* recursive *)
+ | Rec_measure of pat * exp (* recursive with termination measure *)
 
 
 type 
@@ -425,7 +391,7 @@ name_scm_opt =
 
 type 
 default_typing_spec_aux =  (* Default kinding or typing assumption, and default order for literal vectors and vector shorthands *)
-   DT_order of base_kind * atyp
+   DT_order of kind * atyp
 
 
 type mpat_aux =  (* Mapping pattern. Mostly the same as normal patterns but only constructible parts *)
@@ -480,7 +446,7 @@ fundef_aux =  (* Function definition *)
 
 type 
 type_def_aux =  (* Type definition body *)
-   TD_abbrev of id * name_scm_opt * typschm (* type abbreviation *)
+   TD_abbrev of id * typquant * kind * atyp (* type abbreviation *)
  | TD_record of id * name_scm_opt * typquant * ((atyp * id)) list * bool (* struct type definition *)
  | TD_variant of id * name_scm_opt * typquant * (type_union) list * bool (* union type definition *)
  | TD_enum of id * name_scm_opt * (id) list * bool (* enumeration type definition *)
@@ -493,7 +459,7 @@ val_spec_aux =  (* Value type specification *)
 
 type 
 kind_def_aux =  (* Definition body for elements of kind; many are shorthands for type\_defs *)
-   KD_abbrev of kind * id * name_scm_opt * typschm (* type abbreviation *)
+   KD_nabbrev of kind * id * name_scm_opt * atyp (* type abbreviation *)
 
 type 
 dec_spec_aux =  (* Register declarations *)
@@ -506,13 +472,13 @@ dec_spec_aux =  (* Register declarations *)
 type 
 scattered_def_aux =  (* Function and type union definitions that can be spread across
          a file. Each one must end in $_$ *)
-   SD_scattered_function of rec_opt * tannot_opt * effect_opt * id (* scattered function definition header *)
- | SD_scattered_funcl of funcl (* scattered function definition clause *)
- | SD_scattered_variant of id * name_scm_opt * typquant (* scattered union definition header *)
- | SD_scattered_unioncl of id * type_union (* scattered union definition member *)
- | SD_scattered_mapping of id * tannot_opt
- | SD_scattered_mapcl of id * mapcl
- | SD_scattered_end of id (* scattered definition end *)
+   SD_function of rec_opt * tannot_opt * effect_opt * id (* scattered function definition header *)
+ | SD_funcl of funcl (* scattered function definition clause *)
+ | SD_variant of id * name_scm_opt * typquant (* scattered union definition header *)
+ | SD_unioncl of id * type_union (* scattered union definition member *)
+ | SD_mapping of id * tannot_opt
+ | SD_mapcl of id * mapcl
+ | SD_end of id (* scattered definition end *)
 
 
 type 
@@ -567,7 +533,6 @@ def =  (* Top-level definition *)
  | DEF_scattered of scattered_def (* scattered definition *)
  | DEF_reg_dec of dec_spec (* register declaration *)
  | DEF_pragma of string * string * l
- | DEF_constraint of id * kid list * n_constraint
  | DEF_internal_mutrec of fundef list
 
 
diff --git a/src/parser.mly b/src/parser.mly
index 0fe99280..9fdf27b7 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -78,6 +78,8 @@ let prepend_id str1 = function
 let mk_id i n m = Id_aux (i, loc n m)
 let mk_kid str n m = Kid_aux (Var str, loc n m)
 
+let mk_kopt k n m = KOpt_aux (k, loc n m)
+
 let id_of_kid = function
   | Kid_aux (Var v, l) -> Id_aux (Id (String.sub v 1 (String.length v - 1)), l)
 
@@ -103,7 +105,6 @@ let mk_typschm_opt ts n m = TypSchm_opt_aux (
 
 let mk_typschm_opt_none = TypSchm_opt_aux (TypSchm_opt_none, Unknown)
 
-let mk_nc nc n m = NC_aux (nc, loc n m)
 let mk_sd s n m = SD_aux (s, loc n m)
 let mk_sd_doc s str n m = SD_aux (s, Documented (str, loc n m))
 let mk_ir r n m = BF_aux (r, loc n m)
@@ -126,6 +127,8 @@ let doc_vs doc (VS_aux (v, l)) = VS_aux (v, Documented (doc, l))
 
 let qi_id_of_kopt (KOpt_aux (kopt_aux, l) as kopt) = QI_aux (QI_id kopt, l)
 
+let mk_recr r n m = (Rec_aux(r, loc n m))
+
 let mk_recn = (Rec_aux((Rec_nonrec), Unknown))
 let mk_typqn = (TypQ_aux(TypQ_no_forall,Unknown))
 let mk_tannotn = Typ_annot_opt_aux(Typ_annot_opt_none,Unknown)
@@ -133,23 +136,25 @@ let mk_tannot typq typ n m = Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ), l
 let mk_eannotn = Effect_opt_aux(Effect_opt_pure,Unknown)
 let mk_namesectn = Name_sect_aux(Name_sect_none,Unknown)
 
+let mk_typq kopts nc n m = TypQ_aux (TypQ_tq (List.map qi_id_of_kopt kopts @ nc), loc n m)
+
 type lchain =
   LC_lt
 | LC_lteq
 | LC_nexp of atyp
 
+let tyop op t1 t2 s e = mk_typ (ATyp_app (Id_aux (DeIid op, loc s e), [t1; t2])) s e
+
 let rec desugar_lchain chain s e =
   match chain with
-  | [LC_nexp n1; LC_lteq; LC_nexp n2] ->
-    mk_nc (NC_bounded_le (n1, n2)) s e
-  | [LC_nexp n1; LC_lt; LC_nexp n2] ->
-    mk_nc (NC_bounded_le (mk_typ (ATyp_sum (n1, mk_typ (ATyp_constant (Big_int.of_int 1)) s e)) s e, n2)) s e
+  | [LC_nexp n1; LC_lteq; LC_nexp n2] -> tyop "<=" n1 n2 s e
+  | [LC_nexp n1; LC_lt; LC_nexp n2] -> tyop "<" n1 n2 s e
   | (LC_nexp n1 :: LC_lteq :: LC_nexp n2 :: chain) ->
-    let nc1 = mk_nc (NC_bounded_le (n1, n2)) s e in
-    mk_nc (NC_and (nc1, desugar_lchain (LC_nexp n2 :: chain) s e)) s e
+     let nc1 = tyop "<=" n1 n2 s e in
+     tyop "&" nc1 (desugar_lchain (LC_nexp n2 :: chain) s e) s e
   | (LC_nexp n1 :: LC_lt :: LC_nexp n2 :: chain) ->
-    let nc1 = mk_nc (NC_bounded_le (mk_typ (ATyp_sum (n1, mk_typ (ATyp_constant (Big_int.of_int 1)) s e)) s e, n2)) s e in
-    mk_nc (NC_and (nc1, desugar_lchain (LC_nexp n2 :: chain) s e)) s e
+     let nc1 = tyop "<" n1 n2 s e in
+     tyop "&" nc1 (desugar_lchain (LC_nexp n2 :: chain) s e) s e
   | _ -> assert false
 
 type rchain =
@@ -159,26 +164,24 @@ type rchain =
 
 let rec desugar_rchain chain s e =
   match chain with
-  | [RC_nexp n1; RC_gteq; RC_nexp n2] ->
-    mk_nc (NC_bounded_ge (n1, n2)) s e
-  | [RC_nexp n1; RC_gt; RC_nexp n2] ->
-    mk_nc (NC_bounded_ge (n1, mk_typ (ATyp_sum (n2, mk_typ (ATyp_constant (Big_int.of_int 1)) s e)) s e)) s e
+  | [RC_nexp n1; RC_gteq; RC_nexp n2] -> tyop ">=" n1 n2 s e
+  | [RC_nexp n1; RC_gt; RC_nexp n2] -> tyop ">" n1 n2 s e
   | (RC_nexp n1 :: RC_gteq :: RC_nexp n2 :: chain) ->
-    let nc1 = mk_nc (NC_bounded_ge (n1, n2)) s e in
-    mk_nc (NC_and (nc1, desugar_rchain (RC_nexp n2 :: chain) s e)) s e
+     let nc1 = tyop ">=" n1 n2 s e in
+     tyop "&" nc1 (desugar_rchain (RC_nexp n2 :: chain) s e) s e
   | (RC_nexp n1 :: RC_gt :: RC_nexp n2 :: chain) ->
-    let nc1 = mk_nc (NC_bounded_ge (n1, mk_typ (ATyp_sum (n2, mk_typ (ATyp_constant (Big_int.of_int 1)) s e)) s e)) s e in
-    mk_nc (NC_and (nc1, desugar_rchain (RC_nexp n2 :: chain) s e)) s e
+     let nc1 = tyop ">" n1 n2 s e in
+     tyop "&" nc1 (desugar_rchain (RC_nexp n2 :: chain) s e) s e
   | _ -> assert false
 
 %}
 
 /*Terminals with no content*/
 
-%token And As Assert Bitzero Bitone By Match Clause Dec Default Effect End Op Tuple Where
-%token Enum Else False Forall Foreach Overload Function_ Mapping If_ In Inc Let_ Int Order Cast
+%token And As Assert Bitzero Bitone By Match Clause Dec Default Effect End Op Where
+%token Enum Else False Forall Foreach Overload Function_ Mapping If_ In Inc Let_ Int Order Bool Cast
 %token Pure Register Return Scattered Sizeof Struct Then True TwoCaret TYPE Typedef
-%token Undefined Union Newtype With Val Constraint Throw Try Catch Exit Bitfield
+%token Undefined Union Newtype With Val Constant Constraint Throw Try Catch Exit Bitfield
 %token Barr Depend Rreg Wreg Rmem Rmemt Wmem Wmv Wmvt Eamem Exmem Undef Unspec Nondet Escape
 %token Repeat Until While Do Mutual Var Ref Configuration
 
@@ -196,7 +199,8 @@ let rec desugar_rchain chain s e =
 %token <string> String Bin Hex Real
 
 %token <string> Amp At Caret Eq Gt Lt Plus Star EqGt Unit
-%token <string> Colon ColonColon (* CaretCaret *) TildeTilde ExclEq
+%token <string> Colon ColonColon TildeTilde ExclEq
+%token <string> EqEq
 %token <string> GtEq
 %token <string> LtEq
 
@@ -212,9 +216,11 @@ let rec desugar_rchain chain s e =
 
 %start file
 %start typschm_eof
+%start typ_eof
 %start exp_eof
 %start def_eof
 %type <Parse_ast.typschm> typschm_eof
+%type <Parse_ast.atyp> typ_eof
 %type <Parse_ast.exp> exp_eof
 %type <Parse_ast.def> def_eof
 %type <Parse_ast.defs> file
@@ -260,6 +266,7 @@ id:
   | Op Plus { mk_id (DeIid "+") $startpos $endpos }
   | Op Minus { mk_id (DeIid "-") $startpos $endpos }
   | Op Star { mk_id (DeIid "*") $startpos $endpos }
+  | Op EqEq { mk_id (DeIid "==") $startpos $endpos }
   | Op ExclEq { mk_id (DeIid "!=") $startpos $endpos }
   | Op Lt { mk_id (DeIid "<") $startpos $endpos }
   | Op Gt { mk_id (DeIid ">") $startpos $endpos }
@@ -312,70 +319,40 @@ kid:
   | TyVar
     { mk_kid $1 $startpos $endpos }
 
-kid_list:
-  | kid
-    { [$1] }
-  | kid kid_list
-    { $1 :: $2 }
-
-nc:
-  | nc Bar nc_and
-    { mk_nc (NC_or ($1, $3)) $startpos $endpos }
-  | nc_and
-    { $1 }
-
-nc_and:
-  | nc_and Amp atomic_nc
-    { mk_nc (NC_and ($1, $3)) $startpos $endpos }
-  | atomic_nc
-    { $1 }
-
-atomic_nc:
-  | Where id Lparen typ_list Rparen
-    { mk_nc (NC_app ($2, $4)) $startpos $endpos }
-  | True
-    { mk_nc NC_true $startpos $endpos }
-  | False
-    { mk_nc NC_false $startpos $endpos }
-  | typ Eq typ
-    { mk_nc (NC_equal ($1, $3)) $startpos $endpos }
-  | typ ExclEq typ
-    { mk_nc (NC_not_equal ($1, $3)) $startpos $endpos }
-  | nc_lchain
-    { desugar_lchain $1 $startpos $endpos }
-  | nc_rchain
-    { desugar_rchain $1 $startpos $endpos }
-  | Lparen nc Rparen
-    { $2 }
-  | kid In Lcurly num_list Rcurly
-    { mk_nc (NC_set ($1, $4)) $startpos $endpos }
-
 num_list:
   | Num
     { [$1] }
   | Num Comma num_list
     { $1 :: $3 }
 
-nc_lchain:
-  | typ LtEq typ
+lchain:
+  | typ5 LtEq typ5
     { [LC_nexp $1; LC_lteq; LC_nexp $3] }
-  | typ Lt typ
+  | typ5 Lt typ5
     { [LC_nexp $1; LC_lt; LC_nexp $3] }
-  | typ LtEq nc_lchain
+  | typ5 LtEq lchain
     { LC_nexp $1 :: LC_lteq :: $3 }
-  | typ Lt nc_lchain
+  | typ5 Lt lchain
     { LC_nexp $1 :: LC_lt :: $3 }
 
-nc_rchain:
-  | typ GtEq typ
+rchain:
+  | typ5 GtEq typ5
     { [RC_nexp $1; RC_gteq; RC_nexp $3] }
-  | typ Gt typ
+  | typ5 Gt typ5
     { [RC_nexp $1; RC_gt; RC_nexp $3] }
-  | typ GtEq nc_rchain
+  | typ5 GtEq rchain
     { RC_nexp $1 :: RC_gteq :: $3 }
-  | typ Gt nc_rchain
+  | typ5 Gt rchain
     { RC_nexp $1 :: RC_gt :: $3 }
 
+tyarg:
+  | Lparen typ_list Rparen
+    { [], $2 }
+
+typ_eof:
+  | typ Eof
+    { $1 }
+
 typ:
   | typ0
     { $1 }
@@ -415,6 +392,7 @@ typ2:
   | typ3 op2 typ3 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ2l op2l typ3 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ3 op2r typ2r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
+  | typ3 Bar typ2r { mk_typ (ATyp_app (deinfix (mk_id (Id "|") $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
   | typ3 { $1 }
 typ2l:
   | typ3 op2 typ3 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
@@ -423,12 +401,14 @@ typ2l:
 typ2r:
   | typ3 op2 typ3 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ3 op2r typ2r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
+  | typ3 Bar typ2r { mk_typ (ATyp_app (deinfix (mk_id (Id "|") $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
   | typ3 { $1 }
 
 typ3:
   | typ4 op3 typ4 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ3l op3l typ4 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ4 op3r typ3r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
+  | typ4 Amp typ3r { mk_typ (ATyp_app (deinfix (mk_id (Id "&") $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
   | typ4 { $1 }
 typ3l:
   | typ4 op3 typ4 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
@@ -437,12 +417,17 @@ typ3l:
 typ3r:
   | typ4 op3 typ4 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ4 op3r typ3r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
+  | typ4 Amp typ3r { mk_typ (ATyp_app (deinfix (mk_id (Id "&") $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
   | typ4 { $1 }
 
 typ4:
   | typ5 op4 typ5 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ4l op4l typ5 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ5 op4r typ4r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
+  | lchain { desugar_lchain $1 $startpos $endpos }
+  | rchain { desugar_rchain $1 $startpos $endpos }
+  | typ5 EqEq typ5 { mk_typ (ATyp_app (deinfix (mk_id (Id $2) $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
+  | typ5 ExclEq typ5 { mk_typ (ATyp_app (deinfix (mk_id (Id $2) $startpos($2) $endpos($2)), [$1; $3])) $startpos $endpos }
   | typ5 { $1 }
 typ4l:
   | typ5 op4 typ5 { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
@@ -522,6 +507,8 @@ typ8r:
   | typ9 { $1 }
 
 typ9:
+  | kid In Lcurly num_list Rcurly
+    { mk_typ (ATyp_nset ($1, $4)) $startpos $endpos }
   | atomic_typ op9 atomic_typ { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | typ9l op9l atomic_typ { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
   | atomic_typ op9r typ9r { mk_typ (ATyp_app (deinfix $2, [$1; $3])) $startpos $endpos }
@@ -542,14 +529,14 @@ atomic_typ:
     { mk_typ ATyp_wild $startpos $endpos }
   | kid
     { mk_typ (ATyp_var $1) $startpos $endpos }
-  | Num
-    { mk_typ (ATyp_constant $1) $startpos $endpos }
+  | lit
+    { mk_typ (ATyp_lit $1) $startpos $endpos }
   | Dec
     { mk_typ ATyp_dec $startpos $endpos }
   | Inc
     { mk_typ ATyp_inc $startpos $endpos }
-  | id Lparen typ_list Rparen
-    { mk_typ (ATyp_app ($1, $3)) $startpos $endpos }
+  | id tyarg
+    { mk_typ (ATyp_app ($1, snd $2 @ fst $2)) $startpos $endpos }
   | Register Lparen typ Rparen
     { let register_id = mk_id (Id "register") $startpos($1) $endpos($1) in
       mk_typ (ATyp_app (register_id, [$3])) $startpos $endpos }
@@ -561,11 +548,13 @@ atomic_typ:
     { let v = mk_kid "n" $startpos $endpos in
       let atom_id = mk_id (Id "atom") $startpos $endpos in
       let atom_of_v = mk_typ (ATyp_app (atom_id, [mk_typ (ATyp_var v) $startpos $endpos])) $startpos $endpos in
-      mk_typ (ATyp_exist ([v], NC_aux (NC_set (v, $2), loc $startpos($2) $endpos($2)), atom_of_v)) $startpos $endpos }
-  | Lcurly kid_list Dot typ Rcurly
-    { mk_typ (ATyp_exist ($2, NC_aux (NC_true, loc $startpos $endpos), $4)) $startpos $endpos }
-  | Lcurly kid_list Comma nc Dot typ Rcurly
+      mk_typ (ATyp_exist ([mk_kopt (KOpt_none v) $startpos $endpos], ATyp_aux (ATyp_nset (v, $2), loc $startpos($2) $endpos($2)), atom_of_v)) $startpos $endpos }
+  | Lcurly kopt_list Dot typ Rcurly
+    { mk_typ (ATyp_exist ($2, ATyp_aux (ATyp_lit (L_aux (L_true, loc $startpos $endpos)), loc $startpos $endpos), $4)) $startpos $endpos }
+  | Lcurly kopt_list Comma typ Dot typ Rcurly
     { mk_typ (ATyp_exist ($2, $4, $6)) $startpos $endpos }
+  | Lcurly id Colon typ Dot typ Rcurly
+    { mk_typ (ATyp_base ($2, $4, $6)) $startpos $endpos }
 
 typ_list:
   | typ
@@ -573,17 +562,15 @@ typ_list:
   | typ Comma typ_list
     { $1 :: $3 }
 
-base_kind:
+kind:
   | Int
-    { BK_aux (BK_int, loc $startpos $endpos) }
+    { K_aux (K_int, loc $startpos $endpos) }
   | TYPE
-    { BK_aux (BK_type, loc $startpos $endpos) }
+    { K_aux (K_type, loc $startpos $endpos) }
   | Order
-    { BK_aux (BK_order, loc $startpos $endpos) }
-
-kind:
-  | base_kind
-    { K_aux (K_kind [$1], loc $startpos $endpos) }
+    { K_aux (K_order, loc $startpos $endpos) }
+  | Bool
+    { K_aux (K_bool, loc $startpos $endpos) }
 
 kopt:
   | Lparen kid Colon kind Rparen
@@ -598,7 +585,7 @@ kopt_list:
     { $1 :: $2 }
 
 typquant:
-  | kopt_list Comma nc
+  | kopt_list Comma typ
     { let qi_nc = QI_aux (QI_const $3, loc $startpos($3) $endpos($3)) in
       TypQ_aux (TypQ_tq (List.map qi_id_of_kopt $1 @ [qi_nc]), loc $startpos $endpos) }
   | kopt_list
@@ -677,8 +664,8 @@ pat_string_append:
 pat1:
   | atomic_pat
     { $1 }
-  | atomic_pat Bar pat1
-    { mk_pat (P_or ($1, $3)) $startpos $endpos }
+  (* | atomic_pat Bar pat1
+    { mk_pat (P_or ($1, $3)) $startpos $endpos } *)
   | atomic_pat At pat_concat
     { mk_pat (P_vector_concat ($1 :: $3)) $startpos $endpos }
   | atomic_pat ColonColon pat1
@@ -890,6 +877,7 @@ exp4:
   | exp5 LtEq exp5 { mk_exp (E_app_infix ($1, mk_id (Id "<=") $startpos($2) $endpos($2), $3)) $startpos $endpos }
   | exp5 GtEq exp5 { mk_exp (E_app_infix ($1, mk_id (Id ">=") $startpos($2) $endpos($2), $3)) $startpos $endpos }
   | exp5 ExclEq exp5 { mk_exp (E_app_infix ($1, mk_id (Id "!=") $startpos($2) $endpos($2), $3)) $startpos $endpos }
+  | exp5 EqEq exp5 { mk_exp (E_app_infix ($1, mk_id (Id "==") $startpos($2) $endpos($2), $3)) $startpos $endpos }
   | exp4l op4l exp5 { mk_exp (E_app_infix ($1, $2, $3)) $startpos $endpos }
   | exp5 op4r exp4r { mk_exp (E_app_infix ($1, $2, $3)) $startpos $endpos }
   | exp5 { $1 }
@@ -1046,7 +1034,7 @@ atomic_exp:
     { mk_exp (E_exit $3) $startpos $endpos }
   | Sizeof Lparen typ Rparen
     { mk_exp (E_sizeof $3) $startpos $endpos }
-  | Constraint Lparen nc Rparen
+  | Constraint Lparen typ Rparen
     { mk_exp (E_constraint $3) $startpos $endpos }
   | Assert Lparen exp Rparen
     { mk_exp (E_assert ($3, mk_lit_exp (L_string "") $startpos($4) $endpos($4))) $startpos $endpos }
@@ -1104,12 +1092,14 @@ funcl_patexp:
 funcl_patexp_typ:
   | pat Eq exp
     { (mk_pexp (Pat_exp ($1, $3)) $startpos $endpos, mk_tannotn) }
-  | pat MinusGt funcl_typ Eq exp
-    { (mk_pexp (Pat_exp ($1, $5)) $startpos $endpos, $3) }
+  | pat MinusGt typ Eq exp
+    { (mk_pexp (Pat_exp ($1, $5)) $startpos $endpos, mk_tannot mk_typqn $3 $startpos $endpos($3)) }
+  | Forall typquant Dot pat MinusGt typ Eq exp
+    { (mk_pexp (Pat_exp ($4, $8)) $startpos $endpos, mk_tannot $2 $6 $startpos $endpos($6)) }
   | Lparen pat If_ exp Rparen Eq exp
     { (mk_pexp (Pat_when ($2, $4, $7)) $startpos $endpos, mk_tannotn) }
-  | Lparen pat If_ exp Rparen MinusGt funcl_typ Eq exp
-    { (mk_pexp (Pat_when ($2, $4, $9)) $startpos $endpos, $7) }
+  | Forall typquant Dot Lparen pat If_ exp Rparen MinusGt typ Eq exp
+    { (mk_pexp (Pat_when ($5, $7, $12)) $startpos $endpos, mk_tannot $2 $10 $startpos $endpos($10)) }
 
 funcl:
   | id funcl_patexp
@@ -1151,14 +1141,37 @@ r_def_body:
   | r_id_def Comma r_def_body
     { $1 :: $3 }
 
+param_kopt:
+  | kid Colon kind
+    { KOpt_aux (KOpt_kind ($3, $1), loc $startpos $endpos) }
+  | kid
+    { KOpt_aux (KOpt_none $1, loc $startpos $endpos) }
+
+param_kopt_list:
+  | param_kopt
+    { [$1] }
+  | param_kopt Comma param_kopt_list
+    { $1 :: $3 }
+
+typaram:
+  | Lparen param_kopt_list Rparen Comma typ
+    { let qi_nc = QI_aux (QI_const $5, loc $startpos($5) $endpos($5)) in
+      mk_typq $2 [qi_nc] $startpos $endpos }
+  | Lparen param_kopt_list Rparen
+    { mk_typq $2 [] $startpos $endpos }
+
 type_def:
-  | Typedef id typquant Eq typ
-    { mk_td (TD_abbrev ($2, mk_namesectn, mk_typschm $3 $5 $startpos($3) $endpos)) $startpos $endpos }
+  | Typedef id typaram Eq typ
+    { mk_td (TD_abbrev ($2, $3, K_aux (K_type, Parse_ast.Unknown), $5)) $startpos $endpos }
   | Typedef id Eq typ
-    { mk_td (TD_abbrev ($2, mk_namesectn, mk_typschm mk_typqn $4 $startpos($4) $endpos)) $startpos $endpos }
+    { mk_td (TD_abbrev ($2, mk_typqn, K_aux (K_type, Parse_ast.Unknown), $4)) $startpos $endpos }
+  | Typedef id typaram MinusGt kind Eq typ
+    { mk_td (TD_abbrev ($2, $3, $5, $7)) $startpos $endpos }
+  | Typedef id Colon kind Eq typ
+    { mk_td (TD_abbrev ($2, mk_typqn, $4, $6)) $startpos $endpos }
   | Struct id Eq Lcurly struct_fields Rcurly
     { mk_td (TD_record ($2, mk_namesectn, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), $5, false)) $startpos $endpos }
-  | Struct id typquant Eq Lcurly struct_fields Rcurly
+  | Struct id typaram Eq Lcurly struct_fields Rcurly
     { mk_td (TD_record ($2, mk_namesectn, $3, $6, false)) $startpos $endpos }
   | Enum id Eq enum_bar
     { mk_td (TD_enum ($2, mk_namesectn, $4, false)) $startpos $endpos }
@@ -1166,11 +1179,11 @@ type_def:
     { mk_td (TD_enum ($2, mk_namesectn, $5, false)) $startpos $endpos }
   | Newtype id Eq type_union
     { mk_td (TD_variant ($2, mk_namesectn, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), [$4], false)) $startpos $endpos }
-  | Newtype id typquant Eq type_union
+  | Newtype id typaram Eq type_union
     { mk_td (TD_variant ($2, mk_namesectn, $3, [$5], false)) $startpos $endpos }
   | Union id Eq Lcurly type_unions Rcurly
     { mk_td (TD_variant ($2, mk_namesectn, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), $5, false)) $startpos $endpos }
-  | Union id typquant Eq Lcurly type_unions Rcurly
+  | Union id typaram Eq Lcurly type_unions Rcurly
     { mk_td (TD_variant ($2, mk_namesectn, $3, $6, false)) $startpos $endpos }
   | Bitfield id Colon typ Eq Lcurly r_def_body Rcurly
     { mk_td (TD_bitfield ($2, $4, $7)) $startpos $endpos }
@@ -1215,9 +1228,15 @@ type_unions:
   | type_union Comma type_unions
     { $1 :: $3 }
 
+rec_measure:
+  | Lcurly pat EqGt exp Rcurly
+    { mk_recr (Rec_measure ($2, $4)) $startpos $endpos }
+
 fun_def:
   | Function_ funcls
     { let funcls, tannot = $2 in mk_fun (FD_function (mk_recn, tannot, mk_eannotn, funcls)) $startpos $endpos }
+  | Function_ rec_measure funcls
+    { let funcls, tannot = $3 in mk_fun (FD_function ($2, tannot, mk_eannotn, funcls)) $startpos $endpos }
 
 fun_def_list:
   | fun_def
@@ -1349,28 +1368,28 @@ register_def:
     { mk_reg_dec (DEC_config ($3, $5, $7)) $startpos $endpos }
 
 default_def:
-  | Default base_kind Inc
+  | Default kind Inc
     { mk_default (DT_order ($2, mk_typ ATyp_inc $startpos($3) $endpos)) $startpos $endpos }
-  | Default base_kind Dec
+  | Default kind Dec
     { mk_default (DT_order ($2, mk_typ ATyp_dec $startpos($3) $endpos)) $startpos $endpos }
 
 scattered_def:
-  | Union id typquant
-    { mk_sd (SD_scattered_variant($2, mk_namesectn, $3)) $startpos $endpos }
+  | Union id typaram
+    { mk_sd (SD_variant($2, mk_namesectn, $3)) $startpos $endpos }
   | Union id
-    { mk_sd (SD_scattered_variant($2, mk_namesectn, mk_typqn)) $startpos $endpos }
+    { mk_sd (SD_variant($2, mk_namesectn, mk_typqn)) $startpos $endpos }
   | Function_ id
-    { mk_sd (SD_scattered_function(mk_recn, mk_tannotn, mk_eannotn, $2)) $startpos $endpos }
+    { mk_sd (SD_function(mk_recn, mk_tannotn, mk_eannotn, $2)) $startpos $endpos }
   | Mapping id
-    { mk_sd (SD_scattered_mapping ($2, mk_tannotn)) $startpos $endpos }
+    { mk_sd (SD_mapping ($2, mk_tannotn)) $startpos $endpos }
   | Mapping id Colon funcl_typ
-    { mk_sd (SD_scattered_mapping ($2, $4)) $startpos $endpos }
+    { mk_sd (SD_mapping ($2, $4)) $startpos $endpos }
 
 scattered_clause:
   | Doc Function_ Clause funcl
-    { mk_sd_doc (SD_scattered_funcl $4) $1 $startpos($2) $endpos }
+    { mk_sd_doc (SD_funcl $4) $1 $startpos($2) $endpos }
   | Function_ Clause funcl
-    { mk_sd (SD_scattered_funcl $3) $startpos $endpos }
+    { mk_sd (SD_funcl $3) $startpos $endpos }
 
 
 def:
@@ -1397,15 +1416,16 @@ def:
   | scattered_clause
     { DEF_scattered $1 }
   | Union Clause id Eq type_union
-    { DEF_scattered (mk_sd (SD_scattered_unioncl ($3, $5)) $startpos $endpos) }
+    { DEF_scattered (mk_sd (SD_unioncl ($3, $5)) $startpos $endpos) }
   | Mapping Clause id Eq mapcl
-    { DEF_scattered (mk_sd (SD_scattered_mapcl ($3, $5)) $startpos $endpos) }
+    { DEF_scattered (mk_sd (SD_mapcl ($3, $5)) $startpos $endpos) }
   | End id
-    { DEF_scattered (mk_sd (SD_scattered_end $2) $startpos $endpos) }
+    { DEF_scattered (mk_sd (SD_end $2) $startpos $endpos) }
   | default_def
     { DEF_default $1 }
-  | Constraint id Lparen kid_list Rparen Eq nc
-    { DEF_constraint ($2, $4, $7) }
+  | Constant id Eq typ
+    { DEF_kind (KD_aux (KD_nabbrev (K_aux (K_int, loc $startpos($1) $endpos($1)), $2, mk_namesectn, $4),
+			loc $startpos $endpos)) }
   | Mutual Lcurly fun_def_list Rcurly
     { DEF_internal_mutrec $3 }
   | Pragma
diff --git a/src/pattern_completeness.ml b/src/pattern_completeness.ml
index d54bbd3f..514eb5c0 100644
--- a/src/pattern_completeness.ml
+++ b/src/pattern_completeness.ml
@@ -269,7 +269,7 @@ let combine ctx gpat (l, pat) =
      (* This warning liable to false positives as join returns a
         pattern that overapproximates what can match, so we only
         report when the second match is a constructor. *)
-     Util.warn (Printf.sprintf "Possible redundant pattern match at %s\n" (Reporting_basic.loc_to_string l));
+     Util.warn (Printf.sprintf "Possible redundant pattern match at %s\n" (Reporting.loc_to_string l));
      GP_wild
   | _, gpat' -> join ctx gpat gpat'
 
@@ -287,7 +287,7 @@ let shrink_loc = function
 
 let check l ctx cases =
   match cases_to_pats cases with
-  | [] -> Util.warn (Printf.sprintf "No non-guarded patterns at %s\n" (Reporting_basic.loc_to_string (shrink_loc l)))
+  | [] -> Util.warn (Printf.sprintf "No non-guarded patterns at %s\n" (Reporting.loc_to_string (shrink_loc l)))
   | (_, pat) :: pats ->
      let top_pat = List.fold_left (combine ctx) (generalize ctx pat) pats in
      if is_wild top_pat then
@@ -295,7 +295,7 @@ let check l ctx cases =
      else
        let message =
          Printf.sprintf "Possible incomplete pattern match at %s\n\nMost general matched pattern is %s\n"
-                        (Reporting_basic.loc_to_string (shrink_loc l))
+                        (Reporting.loc_to_string (shrink_loc l))
                         (string_of_gpat top_pat |> Util.cyan |> Util.clear)
        in
        Util.warn message
diff --git a/src/pretty_print_common.ml b/src/pretty_print_common.ml
index 1fb35158..c01896ac 100644
--- a/src/pretty_print_common.ml
+++ b/src/pretty_print_common.ml
@@ -94,133 +94,5 @@ let rec doc_range (BF_aux(r,_)) = match r with
   | BF_range(i1,i2) -> doc_op dotdot (doc_int i1) (doc_int i2)
   | BF_concat(ir1,ir2) -> (doc_range ir1) ^^ comma ^^ (doc_range ir2)
 
-let doc_effect (BE_aux (e,_)) =
-  string (match e with
-  | BE_rreg -> "rreg"
-  | BE_wreg -> "wreg"
-  | BE_rmem -> "rmem"
-  | BE_rmemt -> "rmemt"
-  | BE_wmem -> "wmem"
-  | BE_wmv  -> "wmv"
-  | BE_wmvt  -> "wmvt"
-  (*| BE_lset -> "lset"
-  | BE_lret -> "lret"*)
-  | BE_eamem -> "eamem"
-  | BE_exmem -> "exmem"
-  | BE_barr -> "barr"
-  | BE_depend -> "depend"
-  | BE_escape -> "escape"
-  | BE_undef -> "undef"
-  | BE_unspec -> "unspec"
-  | BE_nondet -> "nondet"
-  | BE_config -> "config")
-
-let doc_effects (Effect_aux(e,_)) = match e with
-  | Effect_set [] -> string "pure"
-  | Effect_set s -> braces (separate_map comma_sp doc_effect s)
-
-let doc_ord (Ord_aux(o,_)) = match o with
-  | Ord_var v -> doc_var v
-  | Ord_inc -> string "inc"
-  | Ord_dec -> string "dec"
-
-let doc_typ, doc_atomic_typ, doc_nexp, doc_nexp_constraint =
-  (* following the structure of parser for precedence *)
-  let rec typ ty = fn_typ ty
-  and fn_typ ((Typ_aux (t, _)) as ty) = match t with
-  | Typ_fn(args,ret,efct) ->
-     separate space [parens (separate_map (comma ^^ space) tup_typ args); arrow; fn_typ ret; string "effect"; doc_effects efct]
-  | Typ_bidir (t1, t2) ->
-     separate space [tup_typ t1; bidir; tup_typ t2]
-  | _ -> tup_typ ty
-  and tup_typ ((Typ_aux (t, _)) as ty) = match t with
-  | Typ_exist (kids, nc, ty) ->
-     separate space [string "exist"; separate_map space doc_var kids ^^ comma; nexp_constraint nc ^^ dot; typ ty]
-  | Typ_tup typs -> parens (separate_map comma_sp app_typ typs)
-  | _ -> app_typ ty
-  and app_typ ((Typ_aux (t, _)) as ty) = match t with
-  | Typ_app(Id_aux (Id "range", _), [
-    Typ_arg_aux(Typ_arg_nexp (Nexp_aux(Nexp_constant n, _)), _);
-    Typ_arg_aux(Typ_arg_nexp m, _);]) ->
-    (squarebars (if Big_int.equal n Big_int.zero then nexp m else doc_op colon (doc_int n) (nexp m)))
-  | Typ_app(Id_aux (Id "atom", _), [Typ_arg_aux(Typ_arg_nexp n,_)]) ->
-     (squarecolons (nexp n))
-  | Typ_app(id,args) ->
-      (* trailing space to avoid >> token in case of nested app types *)
-      (doc_id id) ^^ (angles (separate_map comma_sp doc_typ_arg args)) ^^ space
-  | _ -> atomic_typ ty (* for simplicity, skip vec_typ - which is only sugar *)
-  and atomic_typ ((Typ_aux (t, _)) as ty) = match t with
-  | Typ_id id  -> doc_id id
-  | Typ_var v  -> doc_var v
-  | Typ_app _ | Typ_tup _ | Typ_fn _ | Typ_bidir _ | Typ_exist _ ->
-      (* exhaustiveness matters here to avoid infinite loops
-       * if we add a new Typ constructor *)
-     group (parens (typ ty))
-  | Typ_internal_unknown -> string "UNKNOWN"
-
-  and doc_typ_arg (Typ_arg_aux(t,_)) = match t with
-  (* Be careful here because typ_arg is implemented as nexp in the
-   * parser - in practice falling through app_typ after all the proper nexp
-   * cases; so Typ_arg_typ has the same precedence as a Typ_app *)
-  | Typ_arg_typ t -> app_typ t
-  | Typ_arg_nexp n -> nexp n
-  | Typ_arg_order o -> doc_ord o
-
-  (* same trick to handle precedence of nexp *)
-  and nexp ne = sum_typ ne
-  and sum_typ ((Nexp_aux(n,_)) as ne) = match n with
-  | Nexp_sum(n1,n2) -> doc_op plus (sum_typ n1) (star_typ n2)
-  | Nexp_minus(n1,n2) -> doc_op minus (sum_typ n1) (star_typ n2)
-  | _ -> star_typ ne
-  and star_typ ((Nexp_aux(n,_)) as ne) = match n with
-  | Nexp_times(n1,n2) -> doc_op star (star_typ n1) (exp_typ n2)
-  | _ -> exp_typ ne
-  and exp_typ ((Nexp_aux(n,_)) as ne) = match n with
-  | Nexp_exp n1 -> doc_unop (string "2**") (atomic_nexp_typ n1)
-  | _ -> neg_typ ne
-  and neg_typ ((Nexp_aux(n,_)) as ne) = match n with
-  | Nexp_neg n1 ->
-      (* XXX this is not valid Sail, only an internal representation -
-       * work around by commenting it *)
-      let minus = concat [string "(*"; minus; string "*)"] in
-      minus ^^ (atomic_nexp_typ n1)
-  | _ -> atomic_nexp_typ ne
-  and atomic_nexp_typ ((Nexp_aux(n,_)) as ne) = match n with
-    | Nexp_var v -> doc_var v
-    | Nexp_id i  -> braces (doc_id i)
-    | Nexp_app (op, args) -> doc_id op ^^ parens (separate_map (comma ^^ space) nexp args)
-    | Nexp_constant i -> if Big_int.less i Big_int.zero then parens(doc_int i) else doc_int i
-    | Nexp_neg _ | Nexp_exp _ | Nexp_times _ | Nexp_sum _ | Nexp_minus _->
-      group (parens (nexp ne))
-
-  and nexp_constraint (NC_aux(nc,_)) = match nc with
-    | NC_equal(n1,n2) -> doc_op equals (nexp n1) (nexp n2)
-    | NC_not_equal (n1, n2) -> doc_op (string "!=") (nexp n1) (nexp n2)
-    | NC_bounded_ge(n1,n2) -> doc_op (string ">=") (nexp n1) (nexp n2)
-    | NC_bounded_le(n1,n2) -> doc_op (string "<=") (nexp n1) (nexp n2)
-    | NC_set(v,bounds) ->
-       doc_op (string "IN") (doc_var v)
-              (braces (separate_map comma_sp doc_int bounds))
-    | NC_or (nc1, nc2) ->
-       parens (separate space [nexp_constraint nc1; string "|"; nexp_constraint nc2])
-    | NC_and (nc1, nc2) ->
-       separate space [nexp_constraint nc1; string "&"; nexp_constraint nc2]
-    | NC_true -> string "true"
-    | NC_false -> string "false"
-
-  (* expose doc_typ, doc_atomic_typ, doc_nexp and doc_nexp_constraint *)
-  in typ, atomic_typ, nexp, nexp_constraint
-
-let pp_format_id (Id_aux(i,_)) =
-  match i with
-  | Id(i) -> i
-  | DeIid(x) -> "(deinfix " ^ x ^ ")"
-
-let rec list_format (sep : string) (fmt : 'a -> string) (ls : 'a list) : string =
-  match ls with
-  | [] -> ""
-  | [a] -> fmt a
-  | a::ls -> (fmt a) ^ sep ^ (list_format sep fmt ls)
-
 let print ?(len=100) channel doc = ToChannel.pretty 1. len channel doc
 let to_buf ?(len=100) buf doc = ToBuffer.pretty 1. len buf doc
diff --git a/src/pretty_print_coq.ml b/src/pretty_print_coq.ml
index ccbde5cd..279a8182 100644
--- a/src/pretty_print_coq.ml
+++ b/src/pretty_print_coq.ml
@@ -65,12 +65,27 @@ let opt_debug_on : string list ref = ref []
  * PPrint-based sail-to-coq pprinter
 ****************************************************************************)
 
+(* Data representation:
+ *
+ * In pure computations we keep values with top level existential types
+ * (including ranges and nats) separate from the proofs of the accompanying
+ * constraints, which keeps the terms shorter and more manageable.
+ * Existentials embedded in types (e.g., in tuples or datatypes) are dependent
+ * pairs.
+ *
+ * Monadic values always includes the proof in a dependent pair because the
+ * constraint solving tactic won't see the term that defined the value, and
+ * must rely entirely on the type (like the Sail type checker).
+ *)
+
+
 type context = {
   early_ret : bool;
   kid_renames : kid KBindings.t; (* Plain tyvar -> tyvar renames *)
   kid_id_renames : id KBindings.t; (* tyvar -> argument renames *)
   bound_nvars : KidSet.t;
   build_ex_return : bool;
+  recursive_ids : IdSet.t;
   debug : bool;
 }
 let empty_ctxt = {
@@ -79,6 +94,7 @@ let empty_ctxt = {
   kid_id_renames = KBindings.empty;
   bound_nvars = KidSet.empty;
   build_ex_return = false;
+  recursive_ids = IdSet.empty;
   debug = false;
 }
 
@@ -240,7 +256,7 @@ let doc_nexp ctx ?(skip_vars=KidSet.empty) nexp =
     | Nexp_app (Id_aux (Id "abs_atom",_), [_])
         -> parens (plussub nexp)
     | _ ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
                 ("cannot pretty-print nexp \"" ^ string_of_nexp nexp ^ "\""))
   in atomic nexp
 
@@ -268,7 +284,7 @@ let rec coq_nvars_of_typ (Typ_aux (t,l)) =
   | Typ_tup ts ->
      List.fold_left (fun s t -> KidSet.union s (trec t))
        KidSet.empty ts
-  | Typ_app(Id_aux (Id "register", _), [Typ_arg_aux (Typ_arg_typ etyp, _)]) ->
+  | Typ_app(Id_aux (Id "register", _), [A_aux (A_typ etyp, _)]) ->
      trec etyp
   | Typ_app(Id_aux (Id "implicit", _),_)
   (* TODO: update when complex atom types are sorted out *)
@@ -277,14 +293,14 @@ let rec coq_nvars_of_typ (Typ_aux (t,l)) =
      List.fold_left (fun s ta -> KidSet.union s (coq_nvars_of_typ_arg ta))
        KidSet.empty tas
   (* TODO: remove appropriate bound variables *)
-  | Typ_exist (kids,_,t) -> trec t
+  | Typ_exist (_,_,t) -> trec t
   | Typ_bidir _ -> unreachable l __POS__ "Coq doesn't support bidir types"
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and coq_nvars_of_typ_arg (Typ_arg_aux (ta,_)) =
+and coq_nvars_of_typ_arg (A_aux (ta,_)) =
   match ta with
-  | Typ_arg_nexp nexp -> tyvars_of_nexp (orig_nexp nexp)
-  | Typ_arg_typ typ -> coq_nvars_of_typ typ
-  | Typ_arg_order _ -> KidSet.empty
+  | A_nexp nexp -> tyvars_of_nexp (orig_nexp nexp)
+  | A_typ typ -> coq_nvars_of_typ typ
+  | A_order _ -> KidSet.empty
 
 (* Follows Coq precedence levels *)
 let rec doc_nc_prop ctx nc =
@@ -353,17 +369,17 @@ let doc_nc_exp ctx nc =
 
 let maybe_expand_range_type (Typ_aux (typ,l) as full_typ) =
   match typ with
-  | Typ_app(Id_aux (Id "range", _), [Typ_arg_aux(Typ_arg_nexp low,_);
-                                     Typ_arg_aux(Typ_arg_nexp high,_)]) ->
+  | Typ_app(Id_aux (Id "range", _), [A_aux(A_nexp low,_);
+                                     A_aux(A_nexp high,_)]) ->
          (* TODO: avoid name clashes *)
      let kid = mk_kid "rangevar" in
      let var = nvar kid in
      let nc = nc_and (nc_lteq low var) (nc_lteq var high) in
-     Some (Typ_aux (Typ_exist ([kid], nc, atom_typ var),Parse_ast.Generated l))
+     Some (Typ_aux (Typ_exist ([mk_kopt K_int kid], nc, atom_typ var),Parse_ast.Generated l))
   | Typ_id (Id_aux (Id "nat",_)) ->
      let kid = mk_kid "n" in
      let var = nvar kid in
-     Some (Typ_aux (Typ_exist ([kid], nc_gteq var (nconstant Nat_big_num.zero), atom_typ var),
+     Some (Typ_aux (Typ_exist ([mk_kopt K_int kid], nc_gteq var (nconstant Nat_big_num.zero), atom_typ var),
                     Parse_ast.Generated l))
   | _ -> None
 
@@ -411,26 +427,26 @@ let doc_typ, doc_atomic_typ =
       | _ -> app_typ atyp_needed ty
     and app_typ atyp_needed ((Typ_aux (t, l)) as ty) = match t with
       | Typ_app(Id_aux (Id "vector", _), [
-          Typ_arg_aux (Typ_arg_nexp m, _);
-          Typ_arg_aux (Typ_arg_order ord, _);
-          Typ_arg_aux (Typ_arg_typ elem_typ, _)]) ->
+          A_aux (A_nexp m, _);
+          A_aux (A_order ord, _);
+          A_aux (A_typ elem_typ, _)]) ->
          (* TODO: remove duplication with exists, below *)
          let tpp = match elem_typ with
            | Typ_aux (Typ_id (Id_aux (Id "bit",_)),_) -> (* TODO: coq-compatible simplification *)
              string "mword " ^^ doc_nexp ctx m
            | _ -> string "vec" ^^ space ^^ typ elem_typ ^^ space ^^ doc_nexp ctx m in
          if atyp_needed then parens tpp else tpp
-      | Typ_app(Id_aux (Id "register", _), [Typ_arg_aux (Typ_arg_typ etyp, _)]) ->
+      | Typ_app(Id_aux (Id "register", _), [A_aux (A_typ etyp, _)]) ->
          let tpp = string "register_ref regstate register_value " ^^ typ etyp in
          if atyp_needed then parens tpp else tpp
       | Typ_app(Id_aux (Id "range", _), _)
       | Typ_id (Id_aux (Id "nat", _)) ->
          (match maybe_expand_range_type ty with
          | Some typ -> atomic_typ atyp_needed typ
-         | None -> raise (Reporting_basic.err_unreachable l __POS__ "Bad range type"))
+         | None -> raise (Reporting.err_unreachable l __POS__ "Bad range type"))
       | Typ_app(Id_aux (Id "implicit", _),_) ->
          (string "Z")
-      | Typ_app(Id_aux (Id "atom", _), [Typ_arg_aux(Typ_arg_nexp n,_)]) ->
+      | Typ_app(Id_aux (Id "atom", _), [A_aux(A_nexp n,_)]) ->
          (string "Z")
       | Typ_app(id,args) ->
          let tpp = (doc_id_type id) ^^ space ^^ (separate_map space doc_typ_arg args) in
@@ -449,32 +465,33 @@ let doc_typ, doc_atomic_typ =
           * if we add a new Typ constructor *)
          let tpp = typ ty in
          if atyp_needed then parens tpp else tpp
-      | Typ_exist (kids,nc,ty') -> begin
-          let kids,nc,ty' = match maybe_expand_range_type ty' with
-            | Some (Typ_aux (Typ_exist (kids',nc',ty'),_)) ->
-               kids'@kids,nc_and nc nc',ty'
-            | _ -> kids,nc,ty'
+      (* TODO: handle non-integer kopts *)
+      | Typ_exist (kopts,nc,ty') -> begin
+          let kopts,nc,ty' = match maybe_expand_range_type ty' with
+            | Some (Typ_aux (Typ_exist (kopts',nc',ty'),_)) ->
+               kopts'@kopts,nc_and nc nc',ty'
+            | _ -> kopts,nc,ty'
           in
           match ty' with
           | Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                              [Typ_arg_aux (Typ_arg_nexp nexp,_)]),_) ->
-             begin match nexp, kids with
-             | (Nexp_aux (Nexp_var kid,_)), [kid'] when Kid.compare kid kid' == 0 ->
+                              [A_aux (A_nexp nexp,_)]),_) ->
+             begin match nexp, kopts with
+             | (Nexp_aux (Nexp_var kid,_)), [kopt] when Kid.compare kid (kopt_kid kopt) == 0 ->
                 braces (separate space [doc_var ctx kid; colon; string "Z";
                                         ampersand; doc_arithfact ctx nc])
              | _ ->
                 let var = mk_kid "_atom" in (* TODO collision avoid *)
                 let nc = nice_and (nc_eq (nvar var) nexp) nc in
                 braces (separate space [doc_var ctx var; colon; string "Z";
-                                        ampersand; doc_arithfact ctx ~exists:kids nc])
+                                        ampersand; doc_arithfact ctx ~exists:(List.map kopt_kid kopts) nc])
              end
           | Typ_aux (Typ_app (Id_aux (Id "vector",_),
-                              [Typ_arg_aux (Typ_arg_nexp m, _);
-                               Typ_arg_aux (Typ_arg_order ord, _);
-                               Typ_arg_aux (Typ_arg_typ elem_typ, _)]),_) ->
+                              [A_aux (A_nexp m, _);
+                               A_aux (A_order ord, _);
+                               A_aux (A_typ elem_typ, _)]),_) ->
              (* TODO: proper handling of m, complex elem type, dedup with above *)
              let var = mk_kid "_vec" in (* TODO collision avoid *)
-             let kid_set = KidSet.of_list kids in
+             let kid_set = KidSet.of_list (List.map kopt_kid kopts) in
              let m_pp = doc_nexp ctx ~skip_vars:kid_set m in
              let tpp, len_pp = match elem_typ with
                | Typ_aux (Typ_id (Id_aux (Id "bit",_)),_) ->
@@ -489,9 +506,9 @@ let doc_typ, doc_atomic_typ =
              braces (separate space
                        [doc_var ctx var; colon; tpp;
                         ampersand;
-                        doc_arithfact ctx ~exists:kids ?extra:length_constraint_pp nc])
+                        doc_arithfact ctx ~exists:(List.map kopt_kid kopts) ?extra:length_constraint_pp nc])
           | _ ->
-             raise (Reporting_basic.err_todo l
+             raise (Reporting.err_todo l
                   ("Non-atom existential type not yet supported in Coq: " ^
                      string_of_typ ty))
         end
@@ -515,10 +532,10 @@ let doc_typ, doc_atomic_typ =
         end*)
       | Typ_bidir _ -> unreachable l __POS__ "Coq doesn't support bidir types"
       | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-    and doc_typ_arg (Typ_arg_aux(t,_)) = match t with
-      | Typ_arg_typ t -> app_typ true t
-      | Typ_arg_nexp n -> doc_nexp ctx n
-      | Typ_arg_order o -> empty
+    and doc_typ_arg (A_aux(t,_)) = match t with
+      | A_typ t -> app_typ true t
+      | A_nexp n -> doc_nexp ctx n
+      | A_order o -> empty
   in typ', atomic_typ
   in (fun ctx -> (fst (fns ctx))), (fun ctx -> (snd (fns ctx)))
 
@@ -530,10 +547,10 @@ let contains_t_pp_var ctxt (Typ_aux (t,a) as typ) =
 (* TODO: should we resurrect this?
 let replace_typ_size ctxt env (Typ_aux (t,a)) =
   match t with
-  | Typ_app (Id_aux (Id "vector",_) as id, [Typ_arg_aux (Typ_arg_nexp size,_);ord;typ']) ->
+  | Typ_app (Id_aux (Id "vector",_) as id, [A_aux (A_nexp size,_);ord;typ']) ->
      begin
        let mk_typ nexp =
-         Some (Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp,Parse_ast.Unknown);ord;typ']),a))
+         Some (Typ_aux (Typ_app (id, [A_aux (A_nexp nexp,Parse_ast.Unknown);ord;typ']),a))
        in
        match Type_check.solve env size with
        | Some n -> mk_typ (nconstant n)
@@ -556,6 +573,10 @@ let doc_tannot ctxt env eff typ =
     else string " : " ^^ ta
   in of_typ typ
 
+(* Only double-quotes need escaped - by doubling them. *)
+let coq_escape_string s =
+  Str.global_replace (Str.regexp "\"") "\"\"" s
+   
 let doc_lit (L_aux(lit,l)) =
   match lit with
   | L_unit  -> utf8string "tt"
@@ -570,7 +591,7 @@ let doc_lit (L_aux(lit,l)) =
   | L_bin n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0b" ^ n) ^ ")" (*shouldn't happen*)*)
   | L_undef ->
      utf8string "(Fail \"undefined value of unsupported type\")"
-  | L_string s -> utf8string ("\"" ^ s ^ "\"")
+  | L_string s -> utf8string ("\"" ^ (coq_escape_string s) ^ "\"")
   | L_real s ->
     (* Lem does not support decimal syntax, so we translate a string
        of the form "x.y" into the ratio (x * 10^len(y) + y) / 10^len(y).
@@ -584,24 +605,31 @@ let doc_lit (L_aux(lit,l)) =
       let denom = Big_int.pow_int_positive 10 (String.length f) in
       (Big_int.add (Big_int.mul (Big_int.of_string i) denom) (Big_int.of_string f), denom)
     | _ ->
-      raise (Reporting_basic.Fatal_error
-        (Reporting_basic.Err_syntax_locn (l, "could not parse real literal"))) in
+      raise (Reporting.Fatal_error
+        (Reporting.Err_syntax_locn (l, "could not parse real literal"))) in
     parens (separate space (List.map string [
       "realFromFrac"; Big_int.to_string num; Big_int.to_string denom]))
 
 let doc_quant_item_id ctx delimit (QI_aux (qi,_)) =
   match qi with
-  | QI_id (KOpt_aux (KOpt_none kid,_)) ->
-     if KBindings.mem kid ctx.kid_id_renames then None else
-     Some (delimit (separate space [doc_var ctx kid; colon; string "Z"]))
-  | QI_id (KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (kind,_)],_),kid),_)) -> begin
+  | QI_id (KOpt_aux (KOpt_kind (K_aux (kind,_),kid),_)) -> begin
     if KBindings.mem kid ctx.kid_id_renames then None else
     match kind with
-    | BK_type -> Some (delimit (separate space [doc_var ctx kid; colon; string "Type"]))
-    | BK_int -> Some (delimit (separate space [doc_var ctx kid; colon; string "Z"]))
-    | BK_order -> None
+    | K_type -> Some (delimit (separate space [doc_var ctx kid; colon; string "Type"]))
+    | K_int -> Some (delimit (separate space [doc_var ctx kid; colon; string "Z"]))
+    | K_order -> None
+  end
+  | QI_const nc -> None
+
+let quant_item_id_name ctx (QI_aux (qi,_)) =
+  match qi with
+  | QI_id (KOpt_aux (KOpt_kind (K_aux (kind,_),kid),_)) -> begin
+    if KBindings.mem kid ctx.kid_id_renames then None else
+    match kind with
+    | K_type -> Some (doc_var ctx kid)
+    | K_int -> Some (doc_var ctx kid)
+    | K_order -> None
   end
-  | QI_id _ -> failwith "Quantifier with multiple kinds"
   | QI_const nc -> None
 
 let doc_quant_item_constr ctx delimit (QI_aux (qi,_)) =
@@ -609,6 +637,13 @@ let doc_quant_item_constr ctx delimit (QI_aux (qi,_)) =
   | QI_id  _ -> None
   | QI_const nc -> Some (bquote ^^ braces (doc_arithfact ctx nc))
 
+(* At the moment these are all anonymous - when used we rely on Coq to fill
+   them in. *)
+let quant_item_constr_name ctx (QI_aux (qi,_)) =
+  match qi with
+  | QI_id  _ -> None
+  | QI_const nc -> Some underscore
+
 let doc_typquant_items ctx delimit (TypQ_aux (tq,_)) =
   match tq with
   | TypQ_tq qis ->
@@ -623,6 +658,14 @@ let doc_typquant_items_separate ctx delimit (TypQ_aux (tq,_)) =
      Util.map_filter (doc_quant_item_constr ctx delimit) qis
   | TypQ_no_forall -> [], []
 
+let typquant_names_separate ctx (TypQ_aux (tq,_)) =
+  match tq with
+  | TypQ_tq qis ->
+     Util.map_filter (quant_item_id_name ctx) qis,
+     Util.map_filter (quant_item_constr_name ctx) qis
+  | TypQ_no_forall -> [], []
+
+
 let doc_typquant ctx (TypQ_aux(tq,_)) typ = match tq with
 | TypQ_tq ((_ :: _) as qs) ->
    string "forall " ^^ separate_opt space (doc_quant_item_id ctx braces) qs ^/^
@@ -641,10 +684,10 @@ let rec typeclass_nexps (Typ_aux(t,l)) =
   | Typ_fn (t1,t2,_) -> List.fold_left NexpSet.union (typeclass_nexps t2) (List.map typeclass_nexps t1)
   | Typ_tup ts -> List.fold_left NexpSet.union NexpSet.empty (List.map typeclass_nexps ts)
   | Typ_app (Id_aux (Id "vector",_),
-             [Typ_arg_aux (Typ_arg_nexp size_nexp,_);
-              _;Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)])
+             [A_aux (A_nexp size_nexp,_);
+              _;A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)])
   | Typ_app (Id_aux (Id "itself",_),
-             [Typ_arg_aux (Typ_arg_nexp size_nexp,_)]) ->
+             [A_aux (A_nexp size_nexp,_)]) ->
      let size_nexp = nexp_simp size_nexp in
      if is_nexp_constant size_nexp then NexpSet.empty else
        NexpSet.singleton (orig_nexp size_nexp)
@@ -663,7 +706,7 @@ let is_ctor env id = match Env.lookup_id id env with
 
 let is_auto_decomposed_exist env typ =
   let typ = expand_range_type typ in
-  match destruct_exist env typ with
+  match destruct_exist_plain (Env.expand_synonyms env typ) with
   | Some (_, _, typ') -> Some typ'
   | _ -> None
 
@@ -689,8 +732,7 @@ let rec doc_pat ctxt apat_needed exists_as_pairs (P_aux (p,(l,annot)) as pat, ty
        let arg_typs =
          match Env.expand_synonyms env ctor_typ with
          | Typ_aux (Typ_fn (arg_typs, ret_typ, _), _) ->
-            (* The FIXME comes from the typechecker code, not sure what it's about... *)
-            let unifiers, _, _ (* FIXME! *) = unify l env ret_typ typ in
+            let unifiers = unify l env (tyvars_of_typ ret_typ) ret_typ typ in
             List.map (subst_unifiers unifiers) arg_typs
          | _ -> assert false
        in
@@ -720,34 +762,34 @@ let rec doc_pat ctxt apat_needed exists_as_pairs (P_aux (p,(l,annot)) as pat, ty
         let el_typ =
           match destruct_vector env typ with
           | Some (_,_,t) -> t
-          | None -> raise (Reporting_basic.err_unreachable l __POS__ "vector pattern doesn't have vector type")
+          | None -> raise (Reporting.err_unreachable l __POS__ "vector pattern doesn't have vector type")
         in
         let ppp = brackets (separate_map semi (fun p -> doc_pat ctxt true exists_as_pairs (p,el_typ)) pats) in
         if apat_needed then parens ppp else ppp
      | P_vector_concat pats ->
-        raise (Reporting_basic.err_unreachable l __POS__
+        raise (Reporting.err_unreachable l __POS__
                  "vector concatenation patterns should have been removed before pretty-printing")
      | P_tup pats  ->
         let typs = match typ with
           | Typ_aux (Typ_tup typs, _) -> typs
-          | _ -> raise (Reporting_basic.err_unreachable l __POS__ "tuple pattern doesn't have tuple type")
+          | _ -> raise (Reporting.err_unreachable l __POS__ "tuple pattern doesn't have tuple type")
         in
         (match pats, typs with
-        | [p], [typ'] -> doc_pat ctxt apat_needed exists_as_pairs (p, typ')
-        | [_], _ -> raise (Reporting_basic.err_unreachable l __POS__ "tuple pattern length does not match tuple type length")
-        | _ -> parens (separate_map comma_sp (doc_pat ctxt false exists_as_pairs) (List.combine pats typs)))
+        | [p], [typ'] -> doc_pat ctxt apat_needed true (p, typ')
+        | [_], _ -> raise (Reporting.err_unreachable l __POS__ "tuple pattern length does not match tuple type length")
+        | _ -> parens (separate_map comma_sp (doc_pat ctxt false true) (List.combine pats typs)))
      | P_list pats ->
         let el_typ = match typ with
-          | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ el_typ,_)]),_)
+          | Typ_aux (Typ_app (f, [A_aux (A_typ el_typ,_)]),_)
               when Id.compare f (mk_id "list") = 0 -> el_typ
-          | _ -> raise (Reporting_basic.err_unreachable l __POS__ "list pattern not a list")
+          | _ -> raise (Reporting.err_unreachable l __POS__ "list pattern not a list")
         in
         brackets (separate_map semi (fun p -> doc_pat ctxt false true (p, el_typ)) pats)
      | P_cons (p,p') ->
         let el_typ = match typ with
-          | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ el_typ,_)]),_)
+          | Typ_aux (Typ_app (f, [A_aux (A_typ el_typ,_)]),_)
               when Id.compare f (mk_id "list") = 0 -> el_typ
-          | _ -> raise (Reporting_basic.err_unreachable l __POS__ "list pattern not a list")
+          | _ -> raise (Reporting.err_unreachable l __POS__ "list pattern not a list")
         in
         doc_op (string "::") (doc_pat ctxt true true (p, el_typ)) (doc_pat ctxt true true (p', typ))
      | P_string_append _ -> unreachable l __POS__
@@ -772,10 +814,10 @@ let find_e_ids exp =
 
 let typ_id_of (Typ_aux (typ, l)) = match typ with
   | Typ_id id -> id
-  | Typ_app (register, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id id, _)), _)])
+  | Typ_app (register, [A_aux (A_typ (Typ_aux (Typ_id id, _)), _)])
     when string_of_id register = "register" -> id
   | Typ_app (id, _) -> id
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__ "failed to get type id")
+  | _ -> raise (Reporting.err_unreachable l __POS__ "failed to get type id")
 
 (* TODO: maybe Nexp_exp, division? *)
 (* Evaluation of constant nexp subexpressions, because Coq will be able to do those itself *)
@@ -800,11 +842,18 @@ let rec nexp_const_eval (Nexp_aux (n,l) as nexp) =
 
 (* Decide whether two nexps used in a vector size are similar; if not
    a cast will be inserted *)
-let similar_nexps env n1 n2 =
+let similar_nexps ctxt env n1 n2 =
   let rec same_nexp_shape (Nexp_aux (n1,_)) (Nexp_aux (n2,_)) =
     match n1, n2 with
     | Nexp_id _, Nexp_id _ -> true
-    | Nexp_var k1, Nexp_var k2 -> prove env (nc_eq (nvar k1) (nvar k2))
+    (* TODO: this is really just an approximation to what we really want:
+       will the Coq types have the same names?  We could probably do better
+       by tracking which existential kids are equal to bound kids. *)
+    | Nexp_var k1, Nexp_var k2 ->
+       Kid.compare k1 k2 == 0 ||
+         (prove env (nc_eq (nvar k1) (nvar k2)) && (
+            not (KidSet.mem k1 ctxt.bound_nvars) ||
+              not (KidSet.mem k2 ctxt.bound_nvars)))
     | Nexp_constant c1, Nexp_constant c2 -> Nat_big_num.equal c1 c2
     | Nexp_app (f1,args1), Nexp_app (f2,args2) ->
        Id.compare f1 f2 == 0 && List.for_all2 same_nexp_shape args1 args2
@@ -850,16 +899,16 @@ let is_no_Z_proof_fn env id =
 let replace_atom_return_type ret_typ =
   (* TODO: more complex uses of atom *)
   match ret_typ with
-  | Typ_aux (Typ_app (Id_aux (Id "atom",_), [Typ_arg_aux (Typ_arg_nexp nexp,_)]),l) ->
+  | Typ_aux (Typ_app (Id_aux (Id "atom",_), [A_aux (A_nexp nexp,_)]),l) ->
      let kid = mk_kid "_retval" in (* TODO: collision avoidance *)
-     true, Typ_aux (Typ_exist ([kid], nc_eq (nvar kid) nexp, atom_typ (nvar kid)),Parse_ast.Generated l)
+     true, Typ_aux (Typ_exist ([mk_kopt K_int kid], nc_eq (nvar kid) nexp, atom_typ (nvar kid)),Parse_ast.Generated l)
   | _ -> false, ret_typ
 
 let is_range_from_atom env (Typ_aux (argty,_)) (Typ_aux (fnty,_)) =
   match argty, fnty with
-  | Typ_app(Id_aux (Id "atom", _), [Typ_arg_aux (Typ_arg_nexp nexp,_)]),
-    Typ_app(Id_aux (Id "range", _), [Typ_arg_aux(Typ_arg_nexp low,_);
-                                     Typ_arg_aux(Typ_arg_nexp high,_)]) ->
+  | Typ_app(Id_aux (Id "atom", _), [A_aux (A_nexp nexp,_)]),
+    Typ_app(Id_aux (Id "range", _), [A_aux(A_nexp low,_);
+                                     A_aux(A_nexp high,_)]) ->
      Type_check.prove env (nc_and (nc_eq nexp low) (nc_eq nexp high))
   | _ -> false
 
@@ -872,8 +921,13 @@ let general_typ_of_annot annot =
 
 let general_typ_of (E_aux (_,annot)) = general_typ_of_annot annot
 
+let is_prefix s s' =
+  let l = String.length s in
+  String.length s' >= l &&
+  String.sub s' 0 l = s
+
 let prefix_recordtype = true
-let report = Reporting_basic.err_unreachable
+let report = Reporting.err_unreachable
 let doc_exp, doc_let =
   let rec top_exp (ctxt : context) (aexp_needed : bool)
     (E_aux (e, (l,annot)) as full_exp) =
@@ -895,7 +949,7 @@ let doc_exp, doc_let =
         debug ctxt (lazy (" at type " ^ string_of_typ typ))
       in
       let typ = expand_range_type typ in
-      match destruct_exist env typ with
+      match destruct_exist_plain typ with
       | None -> epp
       | Some _ ->
          let epp = string "build_ex" ^/^ epp in
@@ -911,19 +965,19 @@ let doc_exp, doc_let =
         | _ ->
            let typ' = expand_range_type (Env.expand_synonyms (env_of exp) typ) in
            let build_ex, out_typ =
-             match destruct_exist env typ' with
+             match destruct_exist_plain typ' with
              | Some (_,_,t) -> true, t
              | None -> false, typ'
            in
            let in_typ = expand_range_type (Env.expand_synonyms (env_of exp) (typ_of exp)) in
-           let in_typ = match destruct_exist env in_typ with Some (_,_,t) -> t | None -> in_typ in
+           let in_typ = match destruct_exist_plain in_typ with Some (_,_,t) -> t | None -> in_typ in
            let autocast =
              (* Avoid using helper functions which simplify the nexps *)
              is_bitvector_typ in_typ && is_bitvector_typ out_typ &&
                match in_typ, out_typ with
-               | Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n1,_);_;_]),_),
-                 Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n2,_);_;_]),_) ->
-                  not (similar_nexps (env_of exp) n1 n2)
+               | Typ_aux (Typ_app (_,[A_aux (A_nexp n1,_);_;_]),_),
+                 Typ_aux (Typ_app (_,[A_aux (A_nexp n2,_);_;_]),_) ->
+                  not (similar_nexps ctxt (env_of exp) n1 n2)
                | _ -> false
            in
            let exp_pp = expV (want_parens || autocast || build_ex) exp in
@@ -1002,7 +1056,7 @@ let doc_exp, doc_let =
         | _ ->
            liftR ((prefix 2 1) (string "write_reg") (doc_lexp_deref ctxt le ^/^ expY e)))
     | E_vector_append(le,re) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
         "E_vector_append should have been rewritten before pretty-printing")
     | E_cons(le,re) -> doc_op (group (colon^^colon)) (expY le) (expY re)
     | E_if(c,t,e) ->
@@ -1036,11 +1090,11 @@ let doc_exp, doc_let =
                      | (P_aux (P_var (P_aux (P_id id, _), _), _))
                      | (P_aux (P_id id, _))), _), _),
                      body), _), _), _)), _)), _) -> id, body
-                 | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("Unable to find loop variable in " ^ string_of_exp body)) in
+                 | _ -> raise (Reporting.err_unreachable l __POS__ ("Unable to find loop variable in " ^ string_of_exp body)) in
                let dir = match ord_exp with
                  | E_aux (E_lit (L_aux (L_false, _)), _) -> "_down"
                  | E_aux (E_lit (L_aux (L_true, _)), _) -> "_up"
-                 | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("Unexpected loop direction " ^ string_of_exp ord_exp))
+                 | _ -> raise (Reporting.err_unreachable l __POS__ ("Unexpected loop direction " ^ string_of_exp ord_exp))
                in
                let combinator = if effectful (effect_of body) then "foreach_ZM" else "foreach_Z" in
                let combinator = combinator ^ dir in
@@ -1069,7 +1123,7 @@ let doc_exp, doc_let =
                         (prefix 2 1 (group body_lambda) (expN body))
                      )
                  )
-          | _ -> raise (Reporting_basic.err_unreachable l __POS__
+          | _ -> raise (Reporting.err_unreachable l __POS__
              "Unexpected number of arguments for loop combinator")
           end
        | Id_aux (Id (("while" | "until") as combinator), _) ->
@@ -1106,7 +1160,7 @@ let doc_exp, doc_let =
                        (parens (prefix 2 1 (group lambda) (expN cond)))
                        (parens (prefix 2 1 (group lambda) (expN body))))
                  )
-            | _ -> raise (Reporting_basic.err_unreachable l __POS__
+            | _ -> raise (Reporting.err_unreachable l __POS__
                "Unexpected number of arguments for loop combinator")
           end
        | Id_aux (Id "early_return", _) ->
@@ -1129,24 +1183,52 @@ let doc_exp, doc_let =
                      doc_atomic_typ ctxt false (typ_of exp)] in
                    true, doc_op colon epp tannot in
                if aexp_needed then parens tepp else tepp
-            | _ -> raise (Reporting_basic.err_unreachable l __POS__
+            | _ -> raise (Reporting.err_unreachable l __POS__
                "Unexpected number of arguments for early_return builtin")
           end
        | _ ->
           let env = env_of_annot (l,annot) in
           let () = debug ctxt (lazy ("Function application " ^ string_of_id f)) in
-          let call, is_extern, is_ctor =
-            if Env.is_union_constructor f env then doc_id_ctor f, false, true else
+          let call, is_extern, is_ctor, is_rec =
+            if Env.is_union_constructor f env then doc_id_ctor f, false, true, false else
             if Env.is_extern f env "coq"
-            then string (Env.get_extern f env "coq"), true, false
-            else doc_id f, false, false in
-          let (tqs,fn_ty) = Env.get_val_spec_orig f env in
+            then string (Env.get_extern f env "coq"), true, false, false
+            else if IdSet.mem f ctxt.recursive_ids
+            then doc_id f, false, false, true
+            else doc_id f, false, false, false in
+          let (tqs,fn_ty) = Env.get_val_spec f env in
+          (* Calculate the renaming *)
+          let tqs_map = List.fold_left
+                          (fun m k ->
+                            let kid = kopt_kid k in
+                            KBindings.add (orig_kid kid) kid m)
+                          KBindings.empty (quant_kopts tqs) in
           let arg_typs, ret_typ, eff = match fn_ty with
             | Typ_aux (Typ_fn (arg_typs,ret_typ,eff),_) -> arg_typs, ret_typ, eff
-            | _ -> raise (Reporting_basic.err_unreachable l __POS__ "Function not a function type")
+            | _ -> raise (Reporting.err_unreachable l __POS__ "Function not a function type")
           in
           let inst =
-            match instantiation_of_without_type full_exp with
+            (* We attempt to get an instantiation of the function signature's
+               type variables which agrees with Coq by
+               1. using dummy variables with the expected type of each argument
+                  (avoiding the inferred type, which might have (e.g.) stripped
+                  out an existential quantifier)
+               2. calculating the instantiation without using the expected
+                  return type, so that we can work out if we need a cast around
+                  the function call. *)
+            let dummy_args =
+              Util.list_mapi (fun i exp -> mk_id ("#coq#arg" ^ string_of_int i),
+                                           general_typ_of exp) args
+            in
+            let dummy_exp = mk_exp (E_app (f, List.map (fun (id,_) -> mk_exp (E_id id)) dummy_args)) in
+            let dummy_env = List.fold_left (fun env (id,typ) -> Env.add_local id (Immutable,typ) env) env dummy_args in
+            let inst_exp =
+              try infer_exp dummy_env dummy_exp
+              with ex ->
+                debug ctxt (lazy (" cannot infer dummy application " ^ Printexc.to_string ex));
+                full_exp
+            in
+            match instantiation_of_without_type inst_exp with
             | x -> x
             (* Not all function applications can be inferred, so try falling back to the
                type inferred when we know the target type.
@@ -1154,7 +1236,8 @@ let doc_exp, doc_let =
                to cast. *)
             | exception _ -> instantiation_of full_exp
           in
-          let inst = KBindings.fold (fun k u m -> KBindings.add (orig_kid k) u m) inst KBindings.empty in
+          let inst = KBindings.fold (fun k u m -> KBindings.add (KBindings.find (orig_kid k) tqs_map) u m) inst KBindings.empty in
+          let () = debug ctxt (lazy (" instantiations: " ^ String.concat ", " (List.map (fun (kid,tyarg) -> string_of_kid kid ^ " => " ^ string_of_typ_arg tyarg) (KBindings.bindings inst)))) in
 
           (* Insert existential packing of arguments where necessary *)
           let doc_arg want_parens arg typ_from_fn =
@@ -1174,24 +1257,48 @@ let doc_exp, doc_let =
               (* Avoid using helper functions which simplify the nexps *)
               is_bitvector_typ typ_of_arg' && is_bitvector_typ typ_from_fn' &&
               match typ_of_arg', typ_from_fn' with
-              | Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n1,_);_;_]),_),
-                Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n2,_);_;_]),_) ->
-                 not (similar_nexps env n1 n2)
+              | Typ_aux (Typ_app (_,[A_aux (A_nexp n1,_);_;_]),_),
+                Typ_aux (Typ_app (_,[A_aux (A_nexp n2,_);_;_]),_) ->
+                 not (similar_nexps ctxt env n1 n2)
               | _ -> false
             in
-            let want_parens1 = want_parens || autocast in
-            let arg_pp =
-              construct_dep_pairs env want_parens1 arg typ_from_fn
+            (* If the argument is an integer that can be inferred from the
+               context in a different form, let Coq fill it in.  E.g.,
+               when "64" is really "8 * width".  Avoid cases where the
+               type checker has introduced a phantom type variable while
+               calculating the instantiations. *)
+            let vars_in_env n =
+              let ekids = Env.get_typ_vars env in
+              KidSet.for_all (fun kid -> KBindings.mem kid ekids) (nexp_frees n)
             in
-            if autocast && false
-            then let arg_pp = string "autocast" ^^ space ^^ arg_pp in
-                 if want_parens then parens arg_pp else arg_pp
-            else arg_pp
+            match typ_of_arg, typ_from_fn with
+            | Typ_aux (Typ_app (Id_aux (Id "atom",_),[A_aux (A_nexp n1,_)]),_),
+              Typ_aux (Typ_app (Id_aux (Id "atom",_),[A_aux (A_nexp n2,_)]),_)
+                 when vars_in_env n2 && not (similar_nexps ctxt env n1 n2) ->
+               underscore
+            | _ ->
+               let want_parens1 = want_parens || autocast in
+               let arg_pp =
+                 construct_dep_pairs env want_parens1 arg typ_from_fn
+               in
+               if autocast && false
+               then let arg_pp = string "autocast" ^^ space ^^ arg_pp in
+                    if want_parens then parens arg_pp else arg_pp
+               else arg_pp
           in
           let epp =
             if is_ctor
             then hang 2 (call ^^ break 1 ^^ parens (flow (comma ^^ break 1) (List.map2 (doc_arg false) args arg_typs)))
-            else hang 2 (flow (break 1) (call :: List.map2 (doc_arg true) args arg_typs)) in
+            else
+              let main_call = call :: List.map2 (doc_arg true) args arg_typs in
+              let all =
+                if is_rec then main_call @
+                                 [parens (string "_limit_reduces _acc")]
+                else match f with
+                     | Id_aux (Id x,_) when is_prefix "#rec#" x ->
+                        main_call @ [parens (string "Zwf_well_founded _ _")]
+                     | _ ->  main_call
+              in hang 2 (flow (break 1) all) in
 
           (* Decide whether to unpack an existential result, pack one, or cast.
              To do this we compare the expected type stored in the checked expression
@@ -1224,9 +1331,9 @@ let doc_exp, doc_let =
               (* Avoid using helper functions which simplify the nexps *)
               is_bitvector_typ in_typ && is_bitvector_typ out_typ &&
               match in_typ, out_typ with
-              | Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n1,_);_;_]),_),
-                Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n2,_);_;_]),_) ->
-                 not (similar_nexps env n1 n2)
+              | Typ_aux (Typ_app (_,[A_aux (A_nexp n1,_);_;_]),_),
+                Typ_aux (Typ_app (_,[A_aux (A_nexp n2,_);_;_]),_) ->
+                 not (similar_nexps ctxt env n1 n2)
               | _ -> false
             in pack,unpack,autocast
           in
@@ -1244,10 +1351,10 @@ let doc_exp, doc_let =
           liftR (if aexp_needed then parens (align epp) else epp)
        end
     | E_vector_access (v,e) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
         "E_vector_access should have been rewritten before pretty-printing")
     | E_vector_subrange (v,e1,e2) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
         "E_vector_subrange should have been rewritten before pretty-printing")
     | E_field((E_aux(_,(l,fannot)) as fexp),id) ->
        (match destruct_tannot fannot with
@@ -1322,9 +1429,9 @@ let doc_exp, doc_let =
                 (* Avoid using helper functions which simplify the nexps *)
          is_bitvector_typ outer_typ' && is_bitvector_typ cast_typ' &&
            match outer_typ', cast_typ' with
-           | Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n1,_);_;_]),_),
-         Typ_aux (Typ_app (_,[Typ_arg_aux (Typ_arg_nexp n2,_);_;_]),_) ->
-              not (similar_nexps env n1 n2)
+           | Typ_aux (Typ_app (_,[A_aux (A_nexp n1,_);_;_]),_),
+         Typ_aux (Typ_app (_,[A_aux (A_nexp n2,_);_;_]),_) ->
+              not (similar_nexps ctxt env n1 n2)
            | _ -> false
        in
        let effects = effectful (effect_of e) in
@@ -1332,7 +1439,11 @@ let doc_exp, doc_let =
          if effects then
            if inner_ex then
              if cast_ex
-             then string "derive_m" ^^ space ^^ epp
+             (* If the types are the same use the cast as a hint to Coq,
+                otherwise derive the new type from the old one. *)
+             then if alpha_equivalent env inner_typ cast_typ
+                  then epp
+                  else string "derive_m" ^^ space ^^ epp
              else string "projT1_m" ^^ space ^^ epp
            else if cast_ex
            then string "build_ex_m" ^^ space ^^ epp
@@ -1358,8 +1469,8 @@ let doc_exp, doc_let =
        in
        if aexp_needed then parens epp else epp
     | E_tuple exps ->
-       parens (align (group (separate_map (comma ^^ break 1) expN exps)))
-    | E_record(FES_aux(FES_Fexps(fexps,_),_)) ->
+       construct_dep_pairs (env_of_annot (l,annot)) true full_exp (general_typ_of full_exp)
+    | E_record fexps ->
        let recordtyp = match destruct_tannot annot with
          | Some (env, Typ_aux (Typ_id tid,_), _)
          | Some (env, Typ_aux (Typ_app (tid, _), _), _) ->
@@ -1370,7 +1481,7 @@ let doc_exp, doc_let =
                                           (semi_sp ^^ break 1)
                                           (doc_fexp ctxt recordtyp) fexps)) in
        if aexp_needed then parens epp else epp
-    | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
+    | E_record_update(e, fexps) ->
        let recordtyp, env = match destruct_tannot annot with
          | Some (env, Typ_aux (Typ_id tid,_), _)
          | Some (env, Typ_aux (Typ_app (tid, _), _), _)
@@ -1402,7 +1513,7 @@ let doc_exp, doc_let =
        let t = Env.base_typ_of (env_of full_exp) (typ_of full_exp) in
        let start, (len, order, etyp) =
          if is_vector_typ t then vector_start_index t, vector_typ_args_of t
-         else raise (Reporting_basic.err_unreachable l __POS__
+         else raise (Reporting.err_unreachable l __POS__
            "E_vector of non-vector type") in
        let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
        let expspp =
@@ -1427,10 +1538,10 @@ let doc_exp, doc_let =
            (vepp,aexp_needed) in
        if aexp_needed then parens (align epp) else epp
     | E_vector_update(v,e1,e2) ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
          "E_vector_update should have been rewritten before pretty-printing")
     | E_vector_update_subrange(v,e1,e2,e3) ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
         "E_vector_update should have been rewritten before pretty-printing")
     | E_list exps ->
        brackets (separate_map semi (expN) exps)
@@ -1451,7 +1562,7 @@ let doc_exp, doc_let =
                       (string "end)")) in
          if aexp_needed then parens (align epp) else align epp
        else
-         raise (Reporting_basic.err_todo l "Warning: try-block around pure expression")
+         raise (Reporting.err_todo l "Warning: try-block around pure expression")
     | E_throw e ->
        let epp = liftR (separate space [string "throw"; expY e]) in
        if aexp_needed then parens (align epp) else align epp
@@ -1460,7 +1571,7 @@ let doc_exp, doc_let =
        let epp = liftR (separate space [string "assert_exp"; expY e1; expY e2]) in
        if aexp_needed then parens (align epp) else align epp
     | E_app_infix (e1,id,e2) ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
          "E_app_infix should have been rewritten before pretty-printing")
     | E_var(lexp, eq_exp, in_exp) ->
        raise (report l __POS__ "E_vars should have been removed before pretty-printing")
@@ -1518,7 +1629,7 @@ let doc_exp, doc_let =
                 | P_aux (P_var (P_aux (P_typ (typ, P_aux (P_id id,_)),_),_),_)
                     when not (is_enum (env_of e1) id) ->
                       let full_typ = (expand_range_type typ) in
-                      let binder = match destruct_exist (env_of e1) full_typ with
+                      let binder = match destruct_exist_plain (Env.expand_synonyms (env_of e1) full_typ) with
                         | Some _ ->
                            squote ^^ parens (separate space [string "existT"; underscore; doc_id id; underscore; colon; doc_typ ctxt typ])
                         | _ ->
@@ -1548,7 +1659,7 @@ let doc_exp, doc_let =
       (match nexp_simp nexp with
         | Nexp_aux (Nexp_constant i, _) -> doc_lit (L_aux (L_num i, l))
         | _ ->
-          raise (Reporting_basic.err_unreachable l __POS__
+          raise (Reporting.err_unreachable l __POS__
             "pretty-printing non-constant sizeof expressions to Lem not supported"))
     | E_return r ->
       let ret_monad = " : MR" in
@@ -1567,7 +1678,7 @@ let doc_exp, doc_let =
       align (parens (string "early_return" ^//^ exp_pp ^//^ ta))
     | E_constraint nc -> wrap_parens (doc_nc_exp ctxt nc)
     | E_internal_value _ ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
         "unsupported internal expression encountered while pretty-printing")
   and if_exp ctxt (elseif : bool) c t e =
     let if_pp = string (if elseif then "else if" else "if") in
@@ -1620,7 +1731,7 @@ let doc_exp, doc_let =
     group (prefix 3 1 (separate space [pipe; doc_pat ctxt false false (pat,typ);bigarrow])
                   (group (top_exp ctxt false e)))
   | Pat_aux(Pat_when(_,_,_),(l,_)) ->
-    raise (Reporting_basic.err_unreachable l __POS__
+    raise (Reporting.err_unreachable l __POS__
      "guarded pattern expression should have been rewritten before pretty-printing")
 
   and doc_lexp_deref ctxt ((LEXP_aux(lexp,(l,annot)))) = match lexp with
@@ -1630,10 +1741,66 @@ let doc_exp, doc_let =
     | LEXP_cast (typ,id) -> doc_id (append_id id "_ref")
     | LEXP_tup lexps -> parens (separate_map comma_sp (doc_lexp_deref ctxt) lexps)
     | _ ->
-       raise (Reporting_basic.err_unreachable l __POS__ ("doc_lexp_deref: Unsupported lexp"))
+       raise (Reporting.err_unreachable l __POS__ ("doc_lexp_deref: Unsupported lexp"))
              (* expose doc_exp and doc_let *)
   in top_exp, let_exp
 
+(* FIXME: A temporary definition of List.init until 4.06 is more standard *)
+let list_init n f = Array.to_list (Array.init n f)
+
+let types_used_with_generic_eq defs =
+  let rec add_typ idset (Typ_aux (typ,_)) =
+    match typ with
+    | Typ_id id -> IdSet.add id idset
+    | Typ_app (id,args) ->
+       List.fold_left add_typ_arg (IdSet.add id idset) args
+    | Typ_tup ts -> List.fold_left add_typ idset ts
+    | _ -> idset
+  and add_typ_arg idset (A_aux (ta,_)) =
+    match ta with
+    | A_typ typ -> add_typ idset typ
+    | _ -> idset
+  in
+  let alg =
+    { (Rewriter.compute_exp_alg IdSet.empty IdSet.union) with
+      Rewriter.e_aux = fun ((typs,exp),annot) ->
+        let typs' =
+          match exp with
+          | E_app (f,[arg1;_]) ->
+             if Env.is_extern f (env_of_annot annot) "coq" then
+               let f' = Env.get_extern f (env_of_annot annot) "coq" in
+               if f' = "generic_eq" || f' = "generic_neq" then
+                 add_typ typs (Env.expand_synonyms (env_of arg1) (typ_of arg1))
+               else typs
+             else typs
+          | _ -> typs
+        in typs', E_aux (exp,annot) }
+  in
+  let typs_req_funcl (FCL_aux (FCL_Funcl (_,pexp), _)) =
+    fst (Rewriter.fold_pexp alg pexp)
+  in
+  let typs_req_def = function
+    | DEF_kind _
+    | DEF_type _
+    | DEF_spec _
+    | DEF_fixity _
+    | DEF_overload _
+    | DEF_default _
+    | DEF_pragma _
+    | DEF_reg_dec _
+      -> IdSet.empty
+    | DEF_fundef (FD_aux (FD_function (_,_,_,fcls),_)) ->
+       List.fold_left IdSet.union IdSet.empty (List.map typs_req_funcl fcls)
+    | DEF_mapdef (MD_aux (_,(l,_)))
+    | DEF_scattered (SD_aux (_,(l,_)))
+      -> unreachable l __POS__ "Internal definition found in the Coq back-end"
+    | DEF_internal_mutrec _
+      -> unreachable Unknown __POS__ "Internal definition found in the Coq back-end"
+    | DEF_val lb ->
+       fst (Rewriter.fold_letbind alg lb)
+  in
+  List.fold_left IdSet.union IdSet.empty (List.map typs_req_def defs)
+
 let doc_type_union ctxt typ_name (Tu_aux(Tu_ty_id(typ,id),_)) =
   separate space [doc_id_ctor id; colon;
                   doc_typ ctxt typ; arrow; typ_name]
@@ -1643,8 +1810,9 @@ let rec doc_range (BF_aux(r,_)) = match r with
   | 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 (TD_aux(td, (l, annot))) = match td with
-  | TD_abbrev(id,nm,(TypSchm_aux (TypSchm_ts (typq, _), _) as typschm)) ->
+let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
+  | TD_abbrev(id,typq,A_aux (A_typ typ, _)) ->
+     let typschm = TypSchm_aux (TypSchm_ts (typq, typ), l) in
      doc_op coloneq
        (separate space [string "Definition"; doc_id_type id;
                         doc_typquant_items empty_ctxt parens typq;
@@ -1659,9 +1827,8 @@ let doc_typdef (TD_aux(td, (l, annot))) = match td with
     let rectyp = match typq with
       | TypQ_aux (TypQ_tq qs, _) ->
         let quant_item = function
-          | QI_aux (QI_id (KOpt_aux (KOpt_none kid, _)), l)
           | QI_aux (QI_id (KOpt_aux (KOpt_kind (_, kid), _)), l) ->
-            [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid, l)), l)]
+            [A_aux (A_nexp (Nexp_aux (Nexp_var kid, l)), l)]
           | _ -> [] in
         let targs = List.concat (List.map quant_item qs) in
         mk_typ (Typ_app (id, targs))
@@ -1679,41 +1846,31 @@ let doc_typdef (TD_aux(td, (l, annot))) = match td with
         space ^^ string "|})."
     in
     let updates_pp = separate hardline (List.map doc_update_field fs) in
-    (* let doc_field (ftyp, fid) =
-      let reftyp =
-        mk_typ (Typ_app (Id_aux (Id "field_ref", Parse_ast.Unknown),
-          [mk_typ_arg (Typ_arg_typ rectyp);
-           mk_typ_arg (Typ_arg_typ ftyp)])) in
-      let rfannot = doc_tannot empty_ctxt env false reftyp in
-      let get, set =
-        string "rec_val" ^^ dot ^^ fname fid,
-        anglebars (space ^^ string "rec_val with " ^^
-          (doc_op equals (fname fid) (string "v")) ^^ space) in
-      let base_ftyp = match annot with
-        | Some (env, _, _) -> Env.base_typ_of env ftyp
-        | _ -> ftyp in
-      let (start, is_inc) =
-        try
-          let start, (_, ord, _) = vector_start_index base_ftyp, vector_typ_args_of base_ftyp in
-          match nexp_simp start with
-          | Nexp_aux (Nexp_constant i, _) -> (i, is_order_inc ord)
-          | _ ->
-            raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__
-             ("register " ^ string_of_id id ^ " has non-constant start index " ^ string_of_nexp start))
-        with
-        | _ -> (Big_int.zero, true) in
-      doc_op equals
-        (concat [string "let "; parens (concat [doc_id id; underscore; doc_id fid; rfannot])])
-        (anglebars (concat [space;
-          doc_op equals (string "field_name") (string_lit (doc_id fid)); semi_sp;
-          doc_op equals (string "field_start") (string (Big_int.to_string start)); semi_sp;
-          doc_op equals (string "field_is_inc") (string (if is_inc then "true" else "false")); semi_sp;
-          doc_op equals (string "get_field") (parens (doc_op arrow (string "fun rec_val") get)); semi_sp;
-          doc_op equals (string "set_field") (parens (doc_op arrow (string "fun rec_val v") set)); space])) in *)
+    let id_pp = doc_id_type id in
+    let numfields = List.length fs in
+    let intros_pp s =
+      string " intros [" ^^
+      separate space (list_init numfields (fun n -> string (s ^ string_of_int n))) ^^
+      string "]." ^^ hardline
+    in
+    let eq_pp =
+      if IdSet.mem id generic_eq_types then
+        string "Instance Decidable_eq_" ^^ id_pp ^^ space ^^ colon ^/^
+        string "forall (x y : " ^^ id_pp ^^ string "), Decidable (x = y)." ^^
+        hardline ^^ intros_pp "x" ^^ intros_pp "y" ^^
+        separate hardline (list_init numfields
+                             (fun n ->
+                               let ns = string_of_int n in
+                               string ("cmp_record_field x" ^ ns ^ " y" ^ ns ^ "."))) ^^
+        hardline ^^
+        string "refine (Build_Decidable _ true _). subst. split; reflexivity." ^^ hardline ^^
+        string "Defined." ^^ hardline
+      else empty
+    in
     doc_op coloneq
-           (separate space [string "Record"; doc_id_type id; doc_typquant_items empty_ctxt parens typq])
+           (separate space [string "Record"; id_pp; doc_typquant_items empty_ctxt parens typq])
            ((*doc_typquant typq*) (braces (space ^^ align fs_doc ^^ space))) ^^
-      dot ^^ hardline ^^ updates_pp
+      dot ^^ hardline ^^ eq_pp ^^ updates_pp
   | TD_variant(id,nm,typq,ar,_) ->
      (match id with
       | Id_aux ((Id "read_kind"),_) -> empty
@@ -1755,11 +1912,11 @@ let doc_typdef (TD_aux(td, (l, annot))) = match td with
                         (concat [string "Inductive"; space; id_pp])
                         (enums_doc) in
          let eq1_pp = string "Scheme Equality for" ^^ space ^^ id_pp ^^ dot in
-         let eq2_pp = string "Instance Decidable_eq_" ^^ id_pp ^^ space ^^ colon ^^ space ^^
+         let eq2_pp = string "Instance Decidable_eq_" ^^ id_pp ^^ space ^^ colon ^/^
            string "forall (x y : " ^^ id_pp ^^ string "), Decidable (x = y) :=" ^/^
            string "Decidable_eq_from_dec " ^^ id_pp ^^ string "_eq_dec." in
           typ_pp ^^ dot ^^ hardline ^^ eq1_pp ^^ hardline ^^ eq2_pp ^^ hardline)
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "register with non-constant indices")
+    | _ -> raise (Reporting.err_unreachable l __POS__ "register with non-constant indices")
 
 let args_of_typ l env typs =
   let arg i typ =
@@ -1768,6 +1925,12 @@ let args_of_typ l env typs =
     E_aux (E_id id, (l, mk_tannot env typ no_effect)) in
   List.split (List.mapi arg typs)
 
+(* Sail currently has a single pattern to match against a list of
+   argument types.  We need to tweak everything to match up,
+   especially so that the function is presented in curried form.  In
+   particular, if there's a single binder for multiple arguments
+   (which rewriting can currently introduce) then we need to turn it
+   into multiple binders and reconstruct it in the function body. *)
 let rec untuple_args_pat typs (P_aux (paux, ((l, _) as annot)) as pat) =
   let env = env_of_annot annot in
   let identity = (fun body -> body) in
@@ -1791,10 +1954,6 @@ let rec untuple_args_pat typs (P_aux (paux, ((l, _) as annot)) as pat) =
   | _, _ ->
      unreachable l __POS__ "Unexpected pattern/type combination"
 
-let doc_rec (Rec_aux(r,_)) = match r with
-  | Rec_nonrec -> string "Definition"
-  | Rec_rec -> string "Fixpoint"
-
 let doc_fun_body ctxt exp =
   let doc_exp = doc_exp ctxt false exp in
   if ctxt.early_ret
@@ -1813,15 +1972,37 @@ let demote_as_pattern i (P_aux (_,p_annot) as pat,typ) =
       E_aux (E_let (LB_aux (LB_val (pat, E_aux (E_id id, p_annot)),p_annot),e),e_ann)
   else (pat,typ), fun e -> e
 
+let pat_is_plain_binder env (P_aux (p,_)) =
+  match p with
+  | P_id id
+  | P_typ (_,P_aux (P_id id,_))
+  when not (is_enum env id) -> Some id
+  | _ -> None
+
+let demote_all_patterns env i (P_aux (p,p_annot) as pat,typ) =
+  match pat_is_plain_binder env pat with
+  | Some id ->
+     if Util.is_none (is_auto_decomposed_exist env typ)
+     then (pat,typ), fun e -> e
+     else
+       (P_aux (P_id id, p_annot),typ),
+       fun (E_aux (_,e_ann) as e) ->
+       E_aux (E_let (LB_aux (LB_val (pat, E_aux (E_id id, p_annot)),p_annot),e),e_ann)
+  | None ->
+    let id = mk_id ("arg" ^ string_of_int i) in (* TODO: name conflicts *)
+    (P_aux (P_id id, p_annot),typ),
+    fun (E_aux (_,e_ann) as e) ->
+      E_aux (E_let (LB_aux (LB_val (pat, E_aux (E_id id, p_annot)),p_annot),e),e_ann)
+
 (* Add equality constraints between arguments and nexps, except in the case
    that they've been merged. *)
 
 let rec atom_constraint ctxt (pat, typ) =
-  let typ = Env.base_typ_of (pat_env_of pat) typ in
+  let typ = Env.base_typ_of (env_of_pat pat) typ in
   match pat, typ with
   | P_aux (P_id id, _),
       Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                        [Typ_arg_aux (Typ_arg_nexp nexp,_)]),_) ->
+                        [A_aux (A_nexp nexp,_)]),_) ->
      (match nexp with
        (* When the kid is mapped to the id, we don't need a constraint *)
      | Nexp_aux (Nexp_var kid,_)
@@ -1888,7 +2069,7 @@ let merge_kids_atoms pats =
       | Some (Nexp_aux (Nexp_var kid,l)) ->
          if KidSet.mem kid seen then
            let () = 
-             Reporting_basic.print_err false true l "merge_kids_atoms"
+             Reporting.print_err false true l "merge_kids_atoms"
                ("want to merge tyvar and argument for " ^ string_of_kid kid ^
                    " but rearranging arguments isn't supported yet") in
            gone,map,seen
@@ -1910,7 +2091,7 @@ let merge_var_patterns map pats =
     | _ -> map, (pat,typ)::pats) (map,[]) pats
   in map, List.rev pats
 
-let doc_funcl (FCL_aux(FCL_Funcl(id, pexp), annot)) =
+let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
   let env = env_of_annot annot in
   let (tq,typ) = Env.get_val_spec_orig id env in
   let (arg_typs, ret_typ, eff) = match typ with
@@ -1918,24 +2099,38 @@ let doc_funcl (FCL_aux(FCL_Funcl(id, pexp), annot)) =
     | _ -> failwith ("Function " ^ string_of_id id ^ " does not have function type")
   in
   let build_ex, ret_typ = replace_atom_return_type ret_typ in
-  let build_ex = match destruct_exist env (expand_range_type ret_typ) with
+  let build_ex = match destruct_exist_plain (Env.expand_synonyms env (expand_range_type ret_typ)) with
     | Some _ -> true
     | _ -> build_ex
   in
   let ids_to_avoid = all_ids pexp in
   let bound_kids = tyvars_of_typquant tq in
   let pat,guard,exp,(l,_) = destruct_pexp pexp in
-  let pats, bind = untuple_args_pat arg_typs pat in (* FIXME is this needed any more? *)
-  let pats, binds = List.split (Util.list_mapi demote_as_pattern pats) in
+  let pats, bind = untuple_args_pat arg_typs pat in
+  (* Fixpoint definitions can only use simple binders, but even Definitions
+     can't handle as patterns *)
+  let pattern_elim =
+    match rec_opt with
+    | Rec_aux (Rec_nonrec,_) -> demote_as_pattern
+    | _ -> demote_all_patterns env
+  in
+  let pats, binds = List.split (Util.list_mapi pattern_elim pats) in
   let eliminated_kids, kid_to_arg_rename = merge_kids_atoms pats in
   let kid_to_arg_rename, pats = merge_var_patterns kid_to_arg_rename pats in
   let kids_used = KidSet.diff bound_kids eliminated_kids in
+  let is_measured, recursive_ids = match rec_opt with
+    (* No mutual recursion in this backend yet; only change recursive
+       definitions where we have a measure *)
+    | Rec_aux (Rec_measure _,_) -> true, IdSet.singleton id
+    | _ -> false, IdSet.empty
+  in
   let ctxt =
     { early_ret = contains_early_return exp;
       kid_renames = mk_kid_renames ids_to_avoid kids_used;
       kid_id_renames = kid_to_arg_rename;
       bound_nvars = bound_kids;
       build_ex_return = effectful eff && build_ex;
+      recursive_ids = recursive_ids;
       debug = List.mem (string_of_id id) (!opt_debug_on)
     } in
   let () =
@@ -1956,48 +2151,32 @@ let doc_funcl (FCL_aux(FCL_Funcl(id, pexp), annot)) =
       debug ctxt (lazy (" pattern " ^ string_of_pat pat));
       debug ctxt (lazy (" with expanded type " ^ string_of_typ exp_typ))
     in
-    match p with
-    | P_id id
-    | P_typ (_,P_aux (P_id id,_))
-         when Util.is_none (is_auto_decomposed_exist env exp_typ) &&
-              not (is_enum env id) ->
-       parens (separate space [doc_id id; colon; doc_typ ctxt typ])
-(*    | P_id id
-    | P_typ (_,P_aux (P_id id,_))
-         when not (is_enum env id) -> begin
-       match destruct_exist env (expand_range_type exp_typ) with
-       | Some (kids, NC_aux (NC_true,_), typ) ->
-          parens (separate space [doc_id id; colon; doc_typ ctxt typ])
-       | Some (kids, nc, typ) ->
-          parens (separate space [doc_id id; colon; doc_typ ctxt typ]) ^^ space ^^
-          bquote ^^ braces (doc_arithfact ctxt nc)
-       | None ->
-          parens (separate space [doc_id id; colon; doc_typ ctxt typ])
-         end*)
-    | P_id id
-    | P_typ (_,P_aux (P_id id,_))
-         when not (is_enum env id) -> begin
+    match pat_is_plain_binder env pat with
+    | Some id ->
+       if Util.is_none (is_auto_decomposed_exist env exp_typ) then
+         parens (separate space [doc_id id; colon; doc_typ ctxt typ])
+       else begin
            let full_typ = (expand_range_type exp_typ) in
-           match destruct_exist env full_typ with
-           | Some ([kid], NC_aux (NC_true,_),
+           match destruct_exist_plain (Env.expand_synonyms env full_typ) with
+           | Some ([kopt], NC_aux (NC_true,_),
                    Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                                     [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid',_)),_)]),_))
-               when Kid.compare kid kid' == 0 ->
+                                     [A_aux (A_nexp (Nexp_aux (Nexp_var kid,_)),_)]),_))
+               when Kid.compare (kopt_kid kopt) kid == 0 ->
               parens (separate space [doc_id id; colon; string "Z"])
-           | Some ([kid], nc,
+           | Some ([kopt], nc,
                    Typ_aux (Typ_app (Id_aux (Id "atom",_),
-                                     [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid',_)),_)]),_))
-               when Kid.compare kid kid' == 0 ->
+                                     [A_aux (A_nexp (Nexp_aux (Nexp_var kid,_)),_)]),_))
+               when Kid.compare (kopt_kid kopt) kid == 0 && not is_measured ->
               (used_a_pattern := true;
                squote ^^ parens (separate space [string "existT"; underscore; doc_id id; underscore; colon; doc_typ ctxt typ]))
            | _ ->
               parens (separate space [doc_id id; colon; doc_typ ctxt typ])
          end
-    | _ ->
+    | None ->
        (used_a_pattern := true;
         squote ^^ parens (separate space [doc_pat ctxt true true (pat, exp_typ); colon; doc_typ ctxt typ]))
   in
-  let patspp = separate_map space doc_binder pats in
+  let patspp = flow_map (break 1) doc_binder pats in
   let atom_constrs = Util.map_filter (atom_constraint ctxt) pats in
   let atom_constr_pp = separate space atom_constrs in
   let retpp =
@@ -2006,6 +2185,31 @@ let doc_funcl (FCL_aux(FCL_Funcl(id, pexp), annot)) =
     else doc_typ ctxt ret_typ
   in
   let idpp = doc_id id in
+  let intropp, accpp, measurepp, fixupspp = match rec_opt with
+    | Rec_aux (Rec_measure _,_) ->
+       let fixupspp =
+         Util.map_filter (fun (pat,typ) ->
+             match pat_is_plain_binder env pat with
+             | Some id -> begin
+                 match destruct_exist_plain (Env.expand_synonyms env (expand_range_type typ)) with
+                 | Some (_, NC_aux (NC_true,_), _) -> None
+                 | Some ([KOpt_aux (KOpt_kind (_, kid), _)], nc,
+                         Typ_aux (Typ_app (Id_aux (Id "atom",_),
+                           [A_aux (A_nexp (Nexp_aux (Nexp_var kid',_)),_)]),_))
+                      when Kid.compare kid kid' == 0 ->
+                    Some (string "let " ^^ doc_id id ^^ string " := projT1 " ^^ doc_id id ^^ string " in")
+                 | _ -> None
+               end
+             | None -> None) pats
+       in
+       string "Fixpoint",
+       [parens (string "_acc : Acc (Zwf 0) _reclimit")],
+       [string "{struct _acc}"],
+       fixupspp
+    | Rec_aux (r,_) ->
+       let d = match r with Rec_nonrec -> "Definition" | _ -> "Fixpoint" in
+       string d, [], [], []
+  in
   (* Work around Coq bug 7975 about pattern binders followed by implicit arguments *)
   let implicitargs =
     if !used_a_pattern && List.length constrspp + List.length atom_constrs > 0 then
@@ -2021,13 +2225,14 @@ let doc_funcl (FCL_aux(FCL_Funcl(id, pexp), annot)) =
   let _ = match guard with
     | None -> ()
     | _ ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
                "guarded pattern expression should have been rewritten before pretty-printing") in
   let bodypp = doc_fun_body ctxt exp in
   let bodypp = if effectful eff || not build_ex then bodypp else string "build_ex" ^^ parens bodypp in
+  let bodypp = separate (break 1) fixupspp ^/^ bodypp in
   group (prefix 3 1
-    (separate space ([idpp] @ quantspp @ [patspp] @ constrspp @ [atom_constr_pp]) ^/^
-       separate space [colon; retpp; coloneq])
+    (flow (break 1) ([intropp; idpp] @ quantspp @ [patspp] @ constrspp @ [atom_constr_pp] @ accpp) ^/^
+       flow (break 1) (measurepp @ [colon; retpp; coloneq]))
     (bodypp ^^ dot)) ^^ implicitargs
 
 let get_id = function
@@ -2038,7 +2243,7 @@ let get_id = function
    joined by "and", although it has worked for Isabelle before.  However, all
    the funcls should have been merged by the merge_funcls rewrite now. *)   
 let doc_fundef_rhs (FD_aux(FD_function(r, typa, efa, funcls),fannot)) =
-  separate_map (hardline ^^ string "and ") doc_funcl funcls
+  separate_map (hardline ^^ string "and ") (doc_funcl r) funcls
 
 let doc_mutrec = function
   | [] -> failwith "DEF_internal_mutrec with empty function list"
@@ -2051,7 +2256,7 @@ let rec doc_fundef (FD_aux(FD_function(r, typa, efa, fcls),fannot)) =
   | [] -> failwith "FD_function with empty function list"
   | [FCL_aux (FCL_Funcl(id,_),annot) as funcl]
     when not (Env.is_extern id (env_of_annot annot) "coq") ->
-    (doc_rec r) ^^ space ^^ (doc_funcl funcl)
+     doc_funcl r funcl
   | [_] -> empty (* extern *)
   | _ -> failwith "FD_function with more than one clause"
 
@@ -2076,8 +2281,8 @@ let doc_dec (DEC_aux (reg, ((l, _) as annot))) =
                                        string o;
                                        string "[]"]))
            ^/^ hardline
-         else raise (Reporting_basic.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ))
-       else raise (Reporting_basic.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ)) *)
+         else raise (Reporting.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ))
+       else raise (Reporting.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ)) *)
   | DEC_config _ -> empty
   | DEC_alias(id,alspec) -> empty
   | DEC_typ_alias(typ,id,alspec) -> empty
@@ -2094,7 +2299,7 @@ let is_field_accessor regtypes fdef =
 let doc_regtype_fields (tname, (n1, n2, fields)) =
   let i1, i2 = match n1, n2 with
     | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) -> i1, i2
-    | _ -> raise (Reporting_basic.err_typ Parse_ast.Unknown
+    | _ -> raise (Reporting.err_typ Parse_ast.Unknown
        ("Non-constant indices in register type " ^ tname)) in
   let dir_b = i1 < i2 in
   let dir = (if dir_b then "true" else "false") in
@@ -2102,7 +2307,7 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
     let i, j = match fr with
     | BF_aux (BF_single i, _) -> (i, i)
     | BF_aux (BF_range (i, j), _) -> (i, j)
-    | _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__
+    | _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__
         ("Unsupported type in field " ^ string_of_id fid ^ " of " ^ tname)) in
     let fsize = Big_int.succ (Big_int.abs (Big_int.sub i j)) in
     (* TODO Assumes normalised, decreasing bitvector slices; however, since
@@ -2111,8 +2316,8 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
     let ftyp = vector_typ (nconstant fsize) dec_ord bit_typ in
     let reftyp =
       mk_typ (Typ_app (Id_aux (Id "field_ref", Parse_ast.Unknown),
-        [mk_typ_arg (Typ_arg_typ (mk_id_typ (mk_id tname)));
-         mk_typ_arg (Typ_arg_typ ftyp)])) in
+        [mk_typ_arg (A_typ (mk_id_typ (mk_id tname)));
+         mk_typ_arg (A_typ ftyp)])) in
     let rfannot = doc_tannot empty_ctxt Env.empty false reftyp in
     doc_op equals
      (concat [string "let "; parens (concat [string tname; underscore; doc_id fid; rfannot])])
@@ -2184,7 +2389,7 @@ let doc_val pat exp =
        id, None
     | P_aux (P_typ (typ, P_aux (P_var (P_aux (P_id id, _), TP_aux (TP_var kid, _)),_)),_) when Id.compare id (id_of_kid kid) == 0 ->
        id, Some typ
-    | _ -> raise (Reporting_basic.err_todo (pat_loc pat)
+    | _ -> raise (Reporting.err_todo (pat_loc pat)
                     "Top-level value definition with complex pattern not supported for Coq yet")
   in
   let typpp = match pat_typ with
@@ -2198,7 +2403,7 @@ let doc_val pat exp =
     | None -> typpp, exp
     | Some typ ->
        let typ = expand_range_type (Env.expand_synonyms env typ) in
-       match destruct_exist env typ with
+       match destruct_exist_plain typ with
        | None -> typpp, exp
        | Some _ ->
           empty, match exp with
@@ -2210,13 +2415,13 @@ let doc_val pat exp =
   group (string "Definition" ^^ space ^^ idpp ^^ typpp ^^ space ^^ coloneq ^/^ base_pp) ^^ hardline ^^
   group (separate space [string "Hint Unfold"; idpp; colon; string "sail."]) ^^ hardline
 
-let rec doc_def unimplemented def =
+let rec doc_def unimplemented generic_eq_types def =
   (* let _ = Pretty_print_sail.pp_defs stderr (Defs [def]) in *)
   match def with
   | DEF_spec v_spec -> doc_val_spec unimplemented v_spec
   | DEF_fixity _ -> empty
   | DEF_overload _ -> empty
-  | DEF_type t_def -> group (doc_typdef t_def) ^/^ hardline
+  | DEF_type t_def -> group (doc_typdef generic_eq_types t_def) ^/^ hardline
   | DEF_reg_dec dec -> group (doc_dec dec)
 
   | DEF_default df -> empty
@@ -2226,6 +2431,7 @@ let rec doc_def unimplemented def =
   | DEF_scattered sdef -> failwith "doc_def: shoulnd't have DEF_scattered at this point"
   | DEF_mapdef (MD_aux (_, (l,_))) -> unreachable l __POS__ "Coq doesn't support mappings"
   | DEF_kind _ -> empty
+  | DEF_pragma _ -> empty
 
 let find_exc_typ defs =
   let is_exc_typ_def = function
@@ -2271,8 +2477,10 @@ try
   let statedefs, defs = List.partition is_state_def defs in
   let register_refs = State.register_refs_coq (State.find_registers defs) in
   let unimplemented = find_unimplemented defs in
+  let generic_eq_types = types_used_with_generic_eq defs in
+  let doc_def = doc_def unimplemented generic_eq_types in
   let () = if !opt_undef_axioms || IdSet.is_empty unimplemented then () else
-      Reporting_basic.print_err false false Parse_ast.Unknown "Warning"
+      Reporting.print_err false false Parse_ast.Unknown "Warning"
         ("The following functions were declared but are undefined:\n" ^
             String.concat "\n" (List.map string_of_id (IdSet.elements unimplemented)))
   in
@@ -2281,9 +2489,9 @@ try
        [string "(*" ^^ (string top_line) ^^ string "*)";hardline;
         (separate_map hardline)
           (fun lib -> separate space [string "Require Import";string lib] ^^ dot) types_modules;hardline;
-        separate empty (List.map (doc_def unimplemented) typdefs); hardline;
+        separate empty (List.map doc_def typdefs); hardline;
         hardline;
-        separate empty (List.map (doc_def unimplemented) statedefs); hardline;
+        separate empty (List.map doc_def statedefs); hardline;
         hardline;
         register_refs; hardline;
         concat [
@@ -2305,7 +2513,7 @@ try
         string "Section Content.";
         hardline;
         hardline;
-        separate empty (List.map (doc_def unimplemented) defs);
+        separate empty (List.map doc_def defs);
         hardline;
         string "End Content.";
         hardline])
@@ -2316,4 +2524,4 @@ with Type_check.Type_error (l,err) ->
     then "\n" ^ Printexc.get_backtrace ()
     else "(backtracing unavailable)"
   in
-  raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err ^ extra))
+  raise (Reporting.err_typ l (Type_error.string_of_type_error err ^ extra))
diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml
index ba2b797b..a3bd1bba 100644
--- a/src/pretty_print_lem.ml
+++ b/src/pretty_print_lem.ml
@@ -194,7 +194,7 @@ let doc_nexp_lem nexp =
        | Nexp_exp n -> "exp_" ^ mangle_nexp n
        | Nexp_neg n -> "neg_" ^ mangle_nexp n
        | _ ->
-          raise (Reporting_basic.err_unreachable l __POS__
+          raise (Reporting.err_unreachable l __POS__
                   ("cannot pretty-print nexp \"" ^ string_of_nexp full_nexp ^ "\"")) 
      end in
      string ("'" ^ mangle_nexp full_nexp)
@@ -224,14 +224,14 @@ let rec lem_nexps_of_typ (Typ_aux (t,l)) =
      List.fold_left (fun s t -> NexpSet.union s (trec t))
        NexpSet.empty ts
   | Typ_app(Id_aux (Id "vector", _), [
-    Typ_arg_aux (Typ_arg_nexp m, _);
-    Typ_arg_aux (Typ_arg_order ord, _);
-    Typ_arg_aux (Typ_arg_typ elem_typ, _)]) ->
+    A_aux (A_nexp m, _);
+    A_aux (A_order ord, _);
+    A_aux (A_typ elem_typ, _)]) ->
      let m = nexp_simp m in
      if !opt_mwords && is_bit_typ elem_typ && not (is_nexp_constant m) then
        NexpSet.singleton (orig_nexp m)
      else trec elem_typ
-  | Typ_app(Id_aux (Id "register", _), [Typ_arg_aux (Typ_arg_typ etyp, _)]) ->
+  | Typ_app(Id_aux (Id "register", _), [A_aux (A_typ etyp, _)]) ->
      trec etyp
   | Typ_app(Id_aux (Id "range", _),_)
   | Typ_app(Id_aux (Id "implicit", _),_)
@@ -240,13 +240,14 @@ let rec lem_nexps_of_typ (Typ_aux (t,l)) =
      List.fold_left (fun s ta -> NexpSet.union s (lem_nexps_of_typ_arg ta))
        NexpSet.empty tas
   | Typ_exist (kids,_,t) -> trec t
-  | Typ_bidir _ -> raise (Reporting_basic.err_unreachable l __POS__ "Lem doesn't support bidir types")
-  | Typ_internal_unknown -> raise (Reporting_basic.err_unreachable l __POS__ "escaped Typ_internal_unknown")
-and lem_nexps_of_typ_arg (Typ_arg_aux (ta,_)) =
+  | Typ_bidir _ -> raise (Reporting.err_unreachable l __POS__ "Lem doesn't support bidir types")
+  | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
+and lem_nexps_of_typ_arg (A_aux (ta,_)) =
   match ta with
-  | Typ_arg_nexp nexp -> NexpSet.singleton (nexp_simp (orig_nexp nexp))
-  | Typ_arg_typ typ -> lem_nexps_of_typ typ
-  | Typ_arg_order _ -> NexpSet.empty
+  | A_nexp nexp -> NexpSet.singleton (nexp_simp (orig_nexp nexp))
+  | A_typ typ -> lem_nexps_of_typ typ
+  | A_order _ -> NexpSet.empty
+  | A_bool _ -> NexpSet.empty
 
 let lem_tyvars_of_typ typ =
   NexpSet.fold (fun nexp ks -> KidSet.union ks (tyvars_of_nexp nexp))
@@ -274,28 +275,30 @@ let doc_typ_lem, doc_atomic_typ_lem =
       | _ -> app_typ atyp_needed ty
     and app_typ atyp_needed ((Typ_aux (t, l)) as ty) = match t with
       | Typ_app(Id_aux (Id "vector", _), [
-          Typ_arg_aux (Typ_arg_nexp m, _);
-          Typ_arg_aux (Typ_arg_order ord, _);
-          Typ_arg_aux (Typ_arg_typ elem_typ, _)]) ->
+          A_aux (A_nexp m, _);
+          A_aux (A_order ord, _);
+          A_aux (A_typ elem_typ, _)]) ->
          let tpp = match elem_typ with
            | Typ_aux (Typ_id (Id_aux (Id "bit",_)),_) when !opt_mwords ->
              string "mword " ^^ doc_nexp_lem (nexp_simp m)
              (* (match nexp_simp m with
                | (Nexp_aux(Nexp_constant i,_)) -> string "bitvector ty" ^^ doc_int i
                | (Nexp_aux(Nexp_var _, _)) -> separate space [string "bitvector"; doc_nexp m]
-               | _ -> raise (Reporting_basic.err_unreachable l __POS__
+               | _ -> raise (Reporting.err_unreachable l __POS__
                 "cannot pretty-print bitvector type with non-constant length")) *)
            | _ -> string "list" ^^ space ^^ typ elem_typ in
          if atyp_needed then parens tpp else tpp
-      | Typ_app(Id_aux (Id "register", _), [Typ_arg_aux (Typ_arg_typ etyp, _)]) ->
+      | Typ_app(Id_aux (Id "register", _), [A_aux (A_typ etyp, _)]) ->
          let tpp = string "register_ref regstate register_value " ^^ typ etyp in
          if atyp_needed then parens tpp else tpp
       | 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,_)]) ->
+      | Typ_app(Id_aux (Id "atom", _), [A_aux(A_nexp n,_)]) ->
          (string "integer")
+      | Typ_app(Id_aux (Id "atom_bool", _), [A_aux(A_bool nc,_)]) ->
+         (string "bool")
       | Typ_app(id,args) ->
          let tpp = (doc_id_lem_type id) ^^ space ^^ (separate_map space doc_typ_arg_lem args) in
          if atyp_needed then parens tpp else tpp
@@ -313,22 +316,25 @@ let doc_typ_lem, doc_atomic_typ_lem =
           * if we add a new Typ constructor *)
          let tpp = typ ty in
          if atyp_needed then parens tpp else tpp
-      | Typ_exist (kids,_,ty) -> begin
+      | Typ_exist (kopts,_,ty) when List.for_all is_nat_kopt kopts -> begin
+         let kids = List.map kopt_kid kopts in
          let tpp = typ ty in
          let visible_vars = lem_tyvars_of_typ ty in
          match List.filter (fun kid -> KidSet.mem kid visible_vars) kids with
          | [] -> if atyp_needed then parens tpp else tpp
-         | bad -> raise (Reporting_basic.err_general l
+         | bad -> raise (Reporting.err_general l
                            ("Existential type variable(s) " ^
                                String.concat ", " (List.map string_of_kid bad) ^
                                " escape into Lem"))
         end
+      | Typ_exist _ -> unreachable l __POS__ "Non-integer existentials currently unsupported in Lem" (* TODO *)
       | Typ_bidir _ -> unreachable l __POS__ "Lem doesn't support bidir types"
       | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-    and doc_typ_arg_lem (Typ_arg_aux(t,_)) = match t with
-      | Typ_arg_typ t -> app_typ true t
-      | Typ_arg_nexp n -> doc_nexp_lem (nexp_simp n)
-      | Typ_arg_order o -> empty
+    and doc_typ_arg_lem (A_aux(t,_)) = match t with
+      | A_typ t -> app_typ true t
+      | A_nexp n -> doc_nexp_lem (nexp_simp n)
+      | A_order o -> empty
+      | A_bool _ -> empty
   in typ', atomic_typ
 
 (* Check for variables in types that would be pretty-printed. *)
@@ -338,10 +344,10 @@ let contains_t_pp_var ctxt (Typ_aux (t,a) as typ) =
 
 let replace_typ_size ctxt env (Typ_aux (t,a)) =
   match t with
-  | Typ_app (Id_aux (Id "vector",_) as id, [Typ_arg_aux (Typ_arg_nexp size,_);ord;typ']) ->
+  | Typ_app (Id_aux (Id "vector",_) as id, [A_aux (A_nexp size,_);ord;typ']) ->
      begin
        let mk_typ nexp =
-         Some (Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp,Parse_ast.Unknown);ord;typ']),a))
+         Some (Typ_aux (Typ_app (id, [A_aux (A_nexp nexp,Parse_ast.Unknown);ord;typ']),a))
        in
        match Type_check.solve env size with
        | Some n -> mk_typ (nconstant n)
@@ -391,7 +397,7 @@ let doc_lit_lem (L_aux(lit,l)) =
   | L_bin n -> failwith "Shouldn't happen" (*"(num_to_vec " ^ ("0b" ^ n) ^ ")" (*shouldn't happen*)*)
   | L_undef ->
      utf8string "(return (failwith \"undefined value of unsupported type\"))"
-  | L_string s -> utf8string ("\"" ^ s ^ "\"")
+  | L_string s -> utf8string ("\"" ^ (String.escaped s) ^ "\"")
   | L_real s ->
     (* Lem does not support decimal syntax, so we translate a string
        of the form "x.y" into the ratio (x * 10^len(y) + y) / 10^len(y).
@@ -405,14 +411,13 @@ let doc_lit_lem (L_aux(lit,l)) =
       let denom = Big_int.pow_int_positive 10 (String.length f) in
       (Big_int.add (Big_int.mul (Big_int.of_string i) denom) (Big_int.of_string f), denom)
     | _ ->
-      raise (Reporting_basic.Fatal_error
-        (Reporting_basic.Err_syntax_locn (l, "could not parse real literal"))) in
+      raise (Reporting.Fatal_error
+        (Reporting.Err_syntax_locn (l, "could not parse real literal"))) in
     parens (separate space (List.map string [
       "realFromFrac"; Big_int.to_string num; Big_int.to_string denom]))
 
 (* typ_doc is the doc for the type being quantified *)
 let doc_quant_item vars_included (QI_aux (qi, _)) = match qi with
-| QI_id (KOpt_aux (KOpt_none kid, _))
 | QI_id (KOpt_aux (KOpt_kind (_, kid), _)) ->
    (match vars_included with
      None -> doc_var kid
@@ -443,16 +448,16 @@ let rec typeclass_nexps (Typ_aux(t,l)) =
     | Typ_fn (ts,t,_) -> List.fold_left NexpSet.union (typeclass_nexps t) (List.map typeclass_nexps ts)
     | Typ_tup ts -> List.fold_left NexpSet.union NexpSet.empty (List.map typeclass_nexps ts)
     | Typ_app (Id_aux (Id "vector",_),
-               [Typ_arg_aux (Typ_arg_nexp size_nexp,_);
-                _;Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)])
+               [A_aux (A_nexp size_nexp,_);
+                _;A_aux (A_typ (Typ_aux (Typ_id (Id_aux (Id "bit",_)),_)),_)])
     | Typ_app (Id_aux (Id "itself",_),
-               [Typ_arg_aux (Typ_arg_nexp size_nexp,_)]) ->
+               [A_aux (A_nexp size_nexp,_)]) ->
        let size_nexp = nexp_simp size_nexp in
        if is_nexp_constant size_nexp then NexpSet.empty else
        NexpSet.singleton (orig_nexp size_nexp)
     | Typ_app (id, args) ->
        let add_arg_nexps nexps = function
-         | Typ_arg_aux (Typ_arg_typ typ, _) ->
+         | A_aux (A_typ typ, _) ->
             NexpSet.union nexps (typeclass_nexps typ)
          | _ -> nexps
        in
@@ -513,7 +518,7 @@ let rec doc_pat_lem ctxt apat_needed (P_aux (p,(l,annot)) as pa) = match p with
      let ppp = brackets (separate_map semi (doc_pat_lem ctxt true) pats) in
      if apat_needed then parens ppp else ppp
   | P_vector_concat pats ->
-     raise (Reporting_basic.err_unreachable l __POS__
+     raise (Reporting.err_unreachable l __POS__
       "vector concatenation patterns should have been removed before pretty-printing")
   | P_tup pats  ->
      (match pats with
@@ -529,12 +534,13 @@ let rec typ_needs_printed (Typ_aux (t,_) as typ) = match t with
   | Typ_app (Id_aux (Id "itself",_),_) -> true
   | Typ_app (_, targs) -> is_bitvector_typ typ || List.exists typ_needs_printed_arg targs
   | Typ_fn (ts,t,_) -> List.exists typ_needs_printed ts || typ_needs_printed t
-  | Typ_exist (kids,_,t) ->
+  | Typ_exist (kopts,_,t) ->
+     let kids = List.map kopt_kid kopts in (* TODO: Check this *)
      let visible_kids = KidSet.inter (KidSet.of_list kids) (lem_tyvars_of_typ t) in
      typ_needs_printed t && KidSet.is_empty visible_kids
   | _ -> false
-and typ_needs_printed_arg (Typ_arg_aux (targ, _)) = match targ with
-  | Typ_arg_typ t -> typ_needs_printed t
+and typ_needs_printed_arg (A_aux (targ, _)) = match targ with
+  | A_typ t -> typ_needs_printed t
   | _ -> false
 
 let contains_early_return exp =
@@ -553,13 +559,13 @@ let find_e_ids exp =
 
 let typ_id_of (Typ_aux (typ, l)) = match typ with
   | Typ_id id -> id
-  | Typ_app (register, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id id, _)), _)])
+  | Typ_app (register, [A_aux (A_typ (Typ_aux (Typ_id id, _)), _)])
     when string_of_id register = "register" -> id
   | Typ_app (id, _) -> id
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__ "failed to get type id")
+  | _ -> raise (Reporting.err_unreachable l __POS__ "failed to get type id")
 
 let prefix_recordtype = true
-let report = Reporting_basic.err_unreachable
+let report = Reporting.err_unreachable
 let doc_exp_lem, doc_let_lem =
   let rec top_exp (ctxt : context) (aexp_needed : bool)
     (E_aux (e, (l,annot)) as full_exp) =
@@ -632,7 +638,7 @@ let doc_exp_lem, doc_let_lem =
         | _ ->
            liftR ((prefix 2 1) (string "write_reg") (doc_lexp_deref_lem ctxt le ^/^ expY e)))
     | E_vector_append(le,re) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
        "E_vector_append should have been rewritten before pretty-printing")
     | E_cons(le,re) -> doc_op (group (colon^^colon)) (expY le) (expY re)
     | E_if(c,t,e) -> wrap_parens (align (if_exp ctxt false c t e))
@@ -663,7 +669,7 @@ let doc_exp_lem, doc_let_lem =
                      | (P_aux (P_var (P_aux (P_id id, _), _), _))
                      | (P_aux (P_id id, _))), _), _),
                      body), _), _), _)), _)), _) -> id, body
-                 | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("Unable to find loop variable in " ^ string_of_exp body)) in
+                 | _ -> raise (Reporting.err_unreachable l __POS__ ("Unable to find loop variable in " ^ string_of_exp body)) in
                let step = match ord_exp with
                  | E_aux (E_lit (L_aux (L_false, _)), _) ->
                     parens (separate space [string "integerNegate"; expY exp3])
@@ -694,7 +700,7 @@ let doc_exp_lem, doc_let_lem =
                         (prefix 2 1 (group body_lambda) (expN body))
                      )
                  )
-          | _ -> raise (Reporting_basic.err_unreachable l __POS__
+          | _ -> raise (Reporting.err_unreachable l __POS__
             "Unexpected number of arguments for loop combinator")
           end
        | Id_aux (Id (("while" | "until") as combinator), _) ->
@@ -731,7 +737,7 @@ let doc_exp_lem, doc_let_lem =
                        (parens (prefix 2 1 (group lambda) (expN cond)))
                        (parens (prefix 2 1 (group lambda) (expN body))))
                  )
-            | _ -> raise (Reporting_basic.err_unreachable l __POS__
+            | _ -> raise (Reporting.err_unreachable l __POS__
               "Unexpected number of arguments for loop combinator")
           end
        | Id_aux (Id "early_return", _) ->
@@ -751,7 +757,7 @@ let doc_exp_lem, doc_let_lem =
                    | _ -> aexp_needed, epp
                in
                if aexp_needed then parens tepp else tepp
-            | _ -> raise (Reporting_basic.err_unreachable l __POS__
+            | _ -> raise (Reporting.err_unreachable l __POS__
               "Unexpected number of arguments for early_return builtin")
           end
        | _ ->
@@ -787,10 +793,10 @@ let doc_exp_lem, doc_let_lem =
           end
        end
     | E_vector_access (v,e) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
        "E_vector_access should have been rewritten before pretty-printing")
     | E_vector_subrange (v,e1,e2) ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
        "E_vector_subrange should have been rewritten before pretty-printing")
     | E_field((E_aux(_,(l,fannot)) as fexp),id) ->
        let ft = typ_of_annot (l,fannot) in
@@ -825,7 +831,7 @@ let doc_exp_lem, doc_let_lem =
     | E_cast(typ,e) -> expV aexp_needed e
     | E_tuple exps ->
        parens (align (group (separate_map (comma ^^ break 1) expN exps)))
-    | E_record(FES_aux(FES_Fexps(fexps,_),_)) ->
+    | E_record fexps ->
        let recordtyp = match destruct_tannot annot with
          | Some (env, Typ_aux (Typ_id tid,_), _)
          | Some (env, Typ_aux (Typ_app (tid, _), _), _) ->
@@ -835,7 +841,7 @@ let doc_exp_lem, doc_let_lem =
        wrap_parens (anglebars (space ^^ (align (separate_map
                                         (semi_sp ^^ break 1)
                                         (doc_fexp ctxt recordtyp) fexps)) ^^ space))
-    | E_record_update(e,(FES_aux(FES_Fexps(fexps,_),_))) ->
+    | E_record_update(e, fexps) ->
        let recordtyp = match destruct_tannot annot with
          | Some (env, Typ_aux (Typ_id tid,_), _)
          | Some (env, Typ_aux (Typ_app (tid, _), _), _)
@@ -847,7 +853,7 @@ let doc_exp_lem, doc_let_lem =
        let t = Env.base_typ_of (env_of full_exp) (typ_of full_exp) in
        let start, (len, order, etyp) =
          if is_vector_typ t then vector_start_index t, vector_typ_args_of t
-         else raise (Reporting_basic.err_unreachable l __POS__
+         else raise (Reporting.err_unreachable l __POS__
           "E_vector of non-vector type") in
        let dir,dir_out = if is_order_inc order then (true,"true") else (false, "false") in
        let start = match nexp_simp start with
@@ -874,10 +880,10 @@ let doc_exp_lem, doc_let_lem =
          else (epp,aexp_needed) in
        if aexp_needed then parens (align epp) else epp
     | E_vector_update(v,e1,e2) ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
         "E_vector_update should have been rewritten before pretty-printing")
     | E_vector_update_subrange(v,e1,e2,e3) ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
        "E_vector_update should have been rewritten before pretty-printing")
     | E_list exps ->
        brackets (separate_map semi (expN) exps)
@@ -895,7 +901,7 @@ let doc_exp_lem, doc_let_lem =
                    (separate_map (break 1) (doc_case ctxt) pexps) ^/^
                    (string "end)")))
        else
-         raise (Reporting_basic.err_todo l "Warning: try-block around pure expression")
+         raise (Reporting.err_todo l "Warning: try-block around pure expression")
     | E_throw e ->
        align (liftR (separate space [string "throw"; expY e]))
     | E_exit e -> liftR (separate space [string "exit"; expY e])
@@ -932,7 +938,7 @@ let doc_exp_lem, doc_let_lem =
       (match nexp_simp nexp with
         | Nexp_aux (Nexp_constant i, _) -> doc_lit_lem (L_aux (L_num i, l))
         | _ ->
-          raise (Reporting_basic.err_unreachable l __POS__
+          raise (Reporting.err_unreachable l __POS__
            "pretty-printing non-constant sizeof expressions to Lem not supported"))
     | E_return r ->
       let ta =
@@ -948,7 +954,7 @@ let doc_exp_lem, doc_let_lem =
       align (parens (string "early_return" ^//^ expV true r ^//^ ta))
     | E_constraint _ -> string "true"
     | E_internal_value _ ->
-      raise (Reporting_basic.err_unreachable l __POS__
+      raise (Reporting.err_unreachable l __POS__
        "unsupported internal expression encountered while pretty-printing")
   and if_exp ctxt (elseif : bool) c t e =
     let if_pp = string (if elseif then "else if" else "if") in
@@ -981,7 +987,7 @@ let doc_exp_lem, doc_let_lem =
     group (prefix 3 1 (separate space [pipe; doc_pat_lem ctxt false pat;arrow])
                   (group (top_exp ctxt false e)))
   | Pat_aux(Pat_when(_,_,_),(l,_)) ->
-    raise (Reporting_basic.err_unreachable l __POS__
+    raise (Reporting.err_unreachable l __POS__
      "guarded pattern expression should have been rewritten before pretty-printing")
 
   and doc_lexp_deref_lem ctxt ((LEXP_aux(lexp,(l,annot))) as le) = match lexp with
@@ -991,7 +997,7 @@ let doc_exp_lem, doc_let_lem =
     | LEXP_cast (typ,id) -> doc_id_lem (append_id id "_ref")
     | LEXP_tup lexps -> parens (separate_map comma_sp (doc_lexp_deref_lem ctxt) lexps)
     | _ ->
-       raise (Reporting_basic.err_unreachable l __POS__ ("doc_lexp_deref_lem: Unsupported lexp"))
+       raise (Reporting.err_unreachable l __POS__ ("doc_lexp_deref_lem: Unsupported lexp"))
              (* expose doc_exp_lem and doc_let *)
   in top_exp, let_exp
 
@@ -1006,10 +1012,12 @@ let rec doc_range_lem (BF_aux(r,_)) = match r with
   | BF_concat(ir1,ir2) -> (doc_range ir1) ^^ comma ^^ (doc_range ir2)
 
 let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
-  | TD_abbrev(id,nm,(TypSchm_aux (TypSchm_ts (typq, _), _) as typschm)) ->
+  | TD_abbrev(id,typq,A_aux (A_typ typ, _)) ->
+     let typschm = TypSchm_aux (TypSchm_ts (typq, typ), l) in
      doc_op equals
        (separate space [string "type"; doc_id_lem_type id; doc_typquant_items_lem None typq])
        (doc_typschm_lem false typschm)
+  | TD_abbrev _ -> empty
   | TD_record(id,nm,typq,fs,_) ->
     let fname fid = if prefix_recordtype && string_of_id id <> "regstate"
                     then concat [doc_id_lem id;string "_";doc_id_lem_type fid;]
@@ -1019,9 +1027,8 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
     let rectyp = match typq with
       | TypQ_aux (TypQ_tq qs, _) ->
         let quant_item = function
-          | QI_aux (QI_id (KOpt_aux (KOpt_none kid, _)), l)
           | QI_aux (QI_id (KOpt_aux (KOpt_kind (_, kid), _)), l) ->
-            [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid, l)), l)]
+            [A_aux (A_nexp (Nexp_aux (Nexp_var kid, l)), l)]
           | _ -> [] in
         let targs = List.concat (List.map quant_item qs) in
         mk_typ (Typ_app (id, targs))
@@ -1030,8 +1037,8 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
     (* let doc_field (ftyp, fid) =
       let reftyp =
         mk_typ (Typ_app (Id_aux (Id "field_ref", Parse_ast.Unknown),
-          [mk_typ_arg (Typ_arg_typ rectyp);
-           mk_typ_arg (Typ_arg_typ ftyp)])) in
+          [mk_typ_arg (A_typ rectyp);
+           mk_typ_arg (A_typ ftyp)])) in
       let rfannot = doc_tannot_lem empty_ctxt env false reftyp in
       let get, set =
         string "rec_val" ^^ dot ^^ fname fid,
@@ -1046,7 +1053,7 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
           match nexp_simp start with
           | Nexp_aux (Nexp_constant i, _) -> (i, is_order_inc ord)
           | _ ->
-            raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__
+            raise (Reporting.err_unreachable Parse_ast.Unknown __POS__
              ("register " ^ string_of_id id ^ " has non-constant start index " ^ string_of_nexp start))
         with
         | _ -> (Big_int.zero, true) in
@@ -1226,7 +1233,7 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
               fromInterpValuePP ^^ hardline ^^ hardline ^^
                 fromToInterpValuePP ^^ hardline
             else empty)
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "register with non-constant indices")
+    | _ -> raise (Reporting.err_unreachable l __POS__ "register with non-constant indices")
 
 let args_of_typs l env typs =
   let arg i typ =
@@ -1242,26 +1249,24 @@ let rec untuple_args_pat (P_aux (paux, ((l, _) as annot)) as pat) arg_typs =
   | P_tup [], _ ->
      let annot = (l, mk_tannot Env.empty unit_typ no_effect) in
      [P_aux (P_lit (mk_lit L_unit), annot)], identity
-  | P_wild, [Typ_aux (Typ_tup typs, _)] ->
+  | P_wild, (_::_::_) ->
      let wild typ = P_aux (P_wild, (l, mk_tannot env typ no_effect)) in
-     List.map wild typs, identity
+     List.map wild arg_typs, identity
   | P_typ (_, pat), _ -> untuple_args_pat pat arg_typs
-  | P_as _, [Typ_aux (Typ_tup _, _)]
-    | P_id _, [Typ_aux (Typ_tup _, _)]
-    | P_tup _, [Typ_aux (Typ_tup _, _)] ->
+  | P_as _, (_::_::_)
+  | P_id _, (_::_::_) ->
      let argpats, argexps = args_of_typs l env arg_typs in
      let argexp = E_aux (E_tuple argexps, annot) in
      let bindargs (E_aux (_, bannot) as body) =
        E_aux (E_let (LB_aux (LB_val (pat, argexp), annot), body), bannot) in
      argpats, bindargs
+  (* The type checker currently has a special case for a single arg type; if
+     that is removed, then remove the next case. *)
+  | P_tup pats, [_] -> [pat], identity
   | P_tup pats, _ -> pats, identity
   | _, _ ->
      [pat], identity
 
-let doc_rec_lem force_rec (Rec_aux(r,_)) = match r with
-  | Rec_nonrec when not force_rec -> space
-  | _ -> space ^^ string "rec" ^^ space
-
 let doc_tannot_opt_lem (Typ_annot_opt_aux(t,_)) = match t with
   | Typ_annot_opt_some(tq,typ) -> (*doc_typquant_lem tq*) (doc_typ_lem typ)
   | Typ_annot_opt_none -> empty
@@ -1288,7 +1293,7 @@ let doc_funcl_lem (FCL_aux(FCL_Funcl(id, pexp), annot)) =
   let _ = match guard with
     | None -> ()
     | _ ->
-       raise (Reporting_basic.err_unreachable l __POS__
+       raise (Reporting.err_unreachable l __POS__
                "guarded pattern expression should have been rewritten before pretty-printing") in
   group (prefix 3 1
     (separate space [doc_id_lem id; patspp; equals])
@@ -1315,9 +1320,19 @@ let doc_mutrec_lem = function
 let rec doc_fundef_lem (FD_aux(FD_function(r, typa, efa, fcls),fannot) as fd) =
   match fcls with
   | [] -> failwith "FD_function with empty function list"
-  | FCL_aux (FCL_Funcl(id,_),annot) :: _
-    when not (Env.is_extern id (env_of_annot annot) "lem") ->
-    string "let" ^^ (doc_rec_lem (List.length fcls > 1) r) ^^ (doc_fundef_rhs_lem fd)
+  | FCL_aux (FCL_Funcl(id, pexp),annot) :: _
+     when not (Env.is_extern id (env_of_annot annot) "lem") ->
+    (* Output "rec" modifier if function calls itself.  Mutually recursive
+       functions are handled separately by doc_mutrec_lem. *)
+    let is_funcl_rec =
+      fold_pexp
+        { (pure_exp_alg false (||)) with
+          e_app = (fun (id', args) -> List.fold_left (||) (Id.compare id id' = 0) args);
+          e_app_infix = (fun (l, id', r) -> l || (Id.compare id id' = 0) || r) }
+        pexp
+    in
+    let doc_rec = if is_funcl_rec then [string "rec"] else [] in
+    separate space ([string "let"] @ doc_rec @ [doc_fundef_rhs_lem fd])
   | _ -> empty
 
 
@@ -1342,8 +1357,8 @@ let doc_dec_lem (DEC_aux (reg, ((l, _) as annot))) =
                                        string o;
                                        string "[]"]))
            ^/^ hardline
-         else raise (Reporting_basic.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ))
-       else raise (Reporting_basic.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ)) *)
+         else raise (Reporting.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ))
+       else raise (Reporting.err_unreachable l __POS__ ("can't deal with register type " ^ string_of_typ typ)) *)
   | DEC_alias(id,alspec) -> empty
   | DEC_typ_alias(typ,id,alspec) -> empty
 
@@ -1369,7 +1384,7 @@ let is_field_accessor regtypes fdef =
 let doc_regtype_fields (tname, (n1, n2, fields)) =
   let i1, i2 = match n1, n2 with
     | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) -> i1, i2
-    | _ -> raise (Reporting_basic.err_typ Parse_ast.Unknown
+    | _ -> raise (Reporting.err_typ Parse_ast.Unknown
        ("Non-constant indices in register type " ^ tname)) in
   let dir_b = i1 < i2 in
   let dir = (if dir_b then "true" else "false") in
@@ -1377,7 +1392,7 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
     let i, j = match fr with
     | BF_aux (BF_single i, _) -> (i, i)
     | BF_aux (BF_range (i, j), _) -> (i, j)
-    | _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__
+    | _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__
        ("Unsupported type in field " ^ string_of_id fid ^ " of " ^ tname)) in
     let fsize = Big_int.succ (Big_int.abs (Big_int.sub i j)) in
     (* TODO Assumes normalised, decreasing bitvector slices; however, since
@@ -1386,8 +1401,8 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
     let ftyp = vector_typ (nconstant fsize) dec_ord bit_typ in
     let reftyp =
       mk_typ (Typ_app (Id_aux (Id "field_ref", Parse_ast.Unknown),
-        [mk_typ_arg (Typ_arg_typ (mk_id_typ (mk_id tname)));
-         mk_typ_arg (Typ_arg_typ ftyp)])) in
+        [mk_typ_arg (A_typ (mk_id_typ (mk_id tname)));
+         mk_typ_arg (A_typ ftyp)])) in
     let rfannot = doc_tannot_lem empty_ctxt Env.empty false reftyp in
     doc_op equals
      (concat [string "let "; parens (concat [string tname; underscore; doc_id_lem fid; rfannot])])
@@ -1418,6 +1433,7 @@ let rec doc_def_lem def =
 
   | DEF_kind _ -> empty
   | DEF_mapdef (MD_aux (_, (l, _))) -> unreachable l __POS__ "Lem doesn't support mappings"
+  | DEF_pragma _ -> empty
 
 let find_exc_typ defs =
   let is_exc_typ_def = function
diff --git a/src/pretty_print_sail.ml b/src/pretty_print_sail.ml
index 179ef208..3d4f77e6 100644
--- a/src/pretty_print_sail.ml
+++ b/src/pretty_print_sail.ml
@@ -52,6 +52,8 @@ open Ast
 open Ast_util
 open PPrint
 
+let opt_use_heuristics = ref false
+
 module Big_int = Nat_big_num
 
 let doc_op symb a b = infix 2 1 symb a b
@@ -63,10 +65,16 @@ let doc_id (Id_aux (id_aux, _)) =
 
 let doc_kid kid = string (Ast_util.string_of_kid kid)
 
+let doc_kopt = function
+  | kopt when is_nat_kopt kopt -> doc_kid (kopt_kid kopt)
+  | kopt when is_typ_kopt kopt -> parens (separate space [doc_kid (kopt_kid kopt); colon; string "Type"])
+  | kopt when is_order_kopt kopt -> parens (separate space [doc_kid (kopt_kid kopt); colon; string "Order"])
+  | kopt -> parens (separate space [doc_kid (kopt_kid kopt); colon; string "Bool"])
+
 let doc_int n = string (Big_int.to_string n)
 
 let docstring (l, _) = match l with
-  | Parse_ast.Documented (str, _) -> string "/**" ^^ string str ^^ string "*/" ^^ hardline
+  | Parse_ast.Documented (str, _) -> string "/*!" ^^ string str ^^ string "*/" ^^ hardline
   | _ -> empty
 
 let doc_ord (Ord_aux(o,_)) = match o with
@@ -111,63 +119,85 @@ let rec doc_nexp =
   in
   nexp0
 
-let doc_nc =
+let rec doc_nc nc =
   let nc_op op n1 n2 = separate space [doc_nexp n1; string op; doc_nexp n2] in
   let rec atomic_nc (NC_aux (nc_aux, _) as nc) =
     match nc_aux with
     | NC_true -> string "true"
     | NC_false -> string "false"
-    | NC_equal (n1, n2) -> nc_op "=" n1 n2
+    | NC_equal (n1, n2) -> nc_op "==" n1 n2
     | NC_not_equal (n1, n2) -> nc_op "!=" n1 n2
     | NC_bounded_ge (n1, n2) -> nc_op ">=" n1 n2
     | NC_bounded_le (n1, n2) -> nc_op "<=" n1 n2
     | NC_set (kid, ints) ->
        separate space [doc_kid kid; string "in"; braces (separate_map (comma ^^ space) doc_int ints)]
-    | NC_app (id, nexps) -> string "where" ^^ space ^^ doc_id id ^^ parens (separate_map (comma ^^ space) doc_nexp nexps)
-    | _ -> parens (nc0 nc)
-  and nc0 (NC_aux (nc_aux, _) as nc) =
-    match nc_aux with
-    | NC_or (c1, c2) -> separate space [nc0 c1; string "|"; nc1 c2]
-    | _ -> nc1 nc
+    | NC_app (id, args) ->
+       doc_id id ^^ parens (separate_map (comma ^^ space) doc_typ_arg args)
+    | NC_var kid -> doc_kid kid
+    | NC_or _ | NC_and _ -> nc0 ~parenthesize:true nc
+  and nc0 ?parenthesize:(parenthesize=false) (NC_aux (nc_aux, _) as nc) =
+    (* Rather than parens (nc0 x) we use nc0 ~parenthesize:true x, because if
+       we rewrite a disjunction as a set constraint, then we can
+       always omit the parens. *)
+    let parens' = if parenthesize then parens else (fun x -> x) in
+    let disjs = constraint_disj nc in
+    let collect_constants kid = function
+      | NC_aux (NC_equal (Nexp_aux (Nexp_var kid', _), Nexp_aux (Nexp_constant c, _)), _) when Kid.compare kid kid' = 0 -> Some c
+      | _ -> None
+    in
+    match disjs with
+    | NC_aux (NC_equal (Nexp_aux (Nexp_var kid, _), Nexp_aux (Nexp_constant c, _)), _) :: ncs ->
+       let constants = List.map (collect_constants kid) ncs in
+       begin match Util.option_all (List.map (collect_constants kid) ncs) with
+       | None | Some [] -> parens' (separate_map (space ^^ bar ^^ space) nc1 disjs)
+       | Some cs ->
+          separate space [doc_kid kid; string "in"; braces (separate_map (comma ^^ space) doc_int (c :: cs))]
+       end
+    | _ -> parens' (separate_map (space ^^ bar ^^ space) nc1 disjs)
   and nc1 (NC_aux (nc_aux, _) as nc) =
-    match nc_aux with
-    | NC_and (c1, c2) -> separate space [nc1 c1; string "&"; atomic_nc c2]
-    | _ -> atomic_nc nc
+    let conjs = constraint_conj nc in
+    separate_map (space ^^ string "&" ^^ space) atomic_nc conjs
   in
-  nc0
+  atomic_nc (constraint_simp nc)
 
-let rec doc_typ (Typ_aux (typ_aux, l)) =
+and doc_typ ?(simple=false) (Typ_aux (typ_aux, l)) =
   match typ_aux with
   | Typ_id id -> doc_id id
   | Typ_app (id, []) -> doc_id id
   | Typ_app (Id_aux (DeIid str, _), [x; y]) ->
      separate space [doc_typ_arg x; doc_typ_arg y]
-              (*
-  | Typ_app (id, [_; len; _; Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id tid, _)), _)]) when Id.compare (mk_id "vector") id == 0 && Id.compare (mk_id "bit") tid == 0->
-     string "bits" ^^ parens (doc_typ_arg len)
-               *)
+  | Typ_app (id, typs) when Id.compare id (mk_id "atom") = 0 ->
+     string "int" ^^ parens (separate_map (string ", ") doc_typ_arg typs)
+  | Typ_app (id, typs) when Id.compare id (mk_id "atom_bool") = 0 ->
+     string "bool" ^^ parens (separate_map (string ", ") doc_typ_arg typs)
   | Typ_app (id, typs) -> doc_id id ^^ parens (separate_map (string ", ") doc_typ_arg typs)
   | Typ_tup typs -> parens (separate_map (string ", ") doc_typ typs)
   | Typ_var kid -> doc_kid kid
   (* Resugar set types like {|1, 2, 3|} *)
-  | Typ_exist ([kid1], NC_aux (NC_set (kid2, ints), _), Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid3, _)), _)]), _))
-         when Kid.compare kid1 kid2 == 0 && Kid.compare kid2 kid3 == 0 && Id.compare (mk_id "atom") id == 0 ->
+  | Typ_exist ([kopt],
+               NC_aux (NC_set (kid1, ints), _),
+               Typ_aux (Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var kid2, _)), _)]), _))
+         when Kid.compare (kopt_kid kopt) kid1 == 0 && Kid.compare kid1 kid2 == 0 && Id.compare (mk_id "atom") id == 0 ->
      enclose (string "{|") (string "|}") (separate_map (string ", ") doc_int ints)
-  | Typ_exist (kids, nc, typ) ->
-     braces (separate_map space doc_kid kids ^^ comma ^^ space ^^ doc_nc nc ^^ dot ^^ space ^^ doc_typ typ)
+  | Typ_exist (kopts, nc, typ) ->
+     braces (separate_map space doc_kopt kopts ^^ comma ^^ space ^^ doc_nc nc ^^ dot ^^ space ^^ doc_typ typ)
   | Typ_fn (typs, typ, Effect_aux (Effect_set [], _)) ->
      separate space [doc_arg_typs typs; string "->"; doc_typ typ]
   | Typ_fn (typs, typ, Effect_aux (Effect_set effs, _)) ->
      let ocaml_eff = braces (separate (comma ^^ space) (List.map (fun be -> string (string_of_base_effect be)) effs)) in
-     separate space [doc_arg_typs typs; string "->"; doc_typ typ; string "effect"; ocaml_eff]
+     if simple then
+       separate space [doc_arg_typs typs; string "->"; doc_typ ~simple:simple typ]
+     else
+       separate space [doc_arg_typs typs; string "->"; doc_typ typ; string "effect"; ocaml_eff]
   | Typ_bidir (typ1, typ2) ->
      separate space [doc_typ typ1; string "<->"; doc_typ typ2]
-  | Typ_internal_unknown -> raise (Reporting_basic.err_unreachable l __POS__ "escaped Typ_internal_unknown")
-and doc_typ_arg (Typ_arg_aux (ta_aux, _)) =
+  | Typ_internal_unknown -> raise (Reporting.err_unreachable l __POS__ "escaped Typ_internal_unknown")
+and doc_typ_arg (A_aux (ta_aux, _)) =
   match ta_aux with
-  | Typ_arg_typ typ -> doc_typ typ
-  | Typ_arg_nexp nexp -> doc_nexp nexp
-  | Typ_arg_order o -> doc_ord o
+  | A_typ typ -> doc_typ typ
+  | A_nexp nexp -> doc_nexp nexp
+  | A_order o -> doc_ord o
+  | A_bool nc -> doc_nc nc
 and doc_arg_typs = function
   | [typ] -> doc_typ typ
   | typs -> parens (separate_map (comma ^^ space) doc_typ typs)
@@ -175,9 +205,9 @@ and doc_arg_typs = function
 let doc_quants quants =
   let doc_qi_kopt (QI_aux (qi_aux, _)) =
     match qi_aux with
-    | QI_id (KOpt_aux (KOpt_none kid, _)) -> [doc_kid kid]
     | QI_id kopt when is_nat_kopt kopt -> [parens (separate space [doc_kid (kopt_kid kopt); colon; string "Int"])]
     | QI_id kopt when is_typ_kopt kopt -> [parens (separate space [doc_kid (kopt_kid kopt); colon; string "Type"])]
+    | QI_id kopt when is_bool_kopt kopt -> [parens (separate space [doc_kid (kopt_kid kopt); colon; string "Bool"])]
     | QI_id kopt -> [parens (separate space [doc_kid (kopt_kid kopt); colon; string "Order"])]
     | QI_const nc -> []
   in
@@ -193,24 +223,53 @@ let doc_quants quants =
   | [nc] -> kdoc ^^ comma ^^ space ^^ doc_nc nc
   | nc :: ncs -> kdoc ^^ comma ^^ space ^^ doc_nc (List.fold_left nc_and nc ncs)
 
+let doc_param_quants quants =
+  let doc_qi_kopt (QI_aux (qi_aux, _)) =
+    match qi_aux with
+    | QI_id kopt when is_nat_kopt kopt -> [doc_kid (kopt_kid kopt) ^^ colon ^^ space ^^ string "Int"]
+    | QI_id kopt when is_typ_kopt kopt -> [doc_kid (kopt_kid kopt) ^^ colon ^^ space ^^ string "Type"]
+    | QI_id kopt when is_bool_kopt kopt -> [doc_kid (kopt_kid kopt) ^^ colon ^^ space ^^ string "Bool"]
+    | QI_id kopt -> [doc_kid (kopt_kid kopt) ^^ colon ^^ space ^^ string "Order"]
+    | QI_const nc -> []
+  in
+  let qi_nc (QI_aux (qi_aux, _)) =
+    match qi_aux with
+    | QI_const nc -> [nc]
+    | _ -> []
+  in
+  let kdoc = separate (comma ^^ space) (List.concat (List.map doc_qi_kopt quants)) in
+  let ncs = List.concat (List.map qi_nc quants) in
+  match ncs with
+  | [] -> parens kdoc
+  | [nc] -> parens kdoc ^^ comma ^^ space ^^ doc_nc nc
+  | nc :: ncs -> parens kdoc ^^ comma ^^ space ^^ doc_nc (List.fold_left nc_and nc ncs)
 
-
-let doc_binding (TypQ_aux (tq_aux, _), typ) =
+let doc_binding ?(simple=false) ((TypQ_aux (tq_aux, _) as typq), typ) =
   match tq_aux with
-  | TypQ_no_forall -> doc_typ typ
-  | TypQ_tq [] -> doc_typ typ
+  | TypQ_no_forall -> doc_typ ~simple:simple typ
+  | TypQ_tq [] -> doc_typ ~simple:simple typ
   | TypQ_tq qs ->
-     string "forall" ^^ space ^^ doc_quants qs ^^ dot ^//^ doc_typ typ
-
-let doc_typschm (TypSchm_aux (TypSchm_ts (typq, typ), _)) = doc_binding (typq, typ)
+     if !opt_use_heuristics && String.length (string_of_typquant typq) > 60 then
+       let kopts, ncs = quant_split typq in
+       if ncs = [] then
+         string "forall" ^^ space ^^ separate_map space doc_kopt kopts ^^ dot
+         ^//^ doc_typ ~simple:simple typ
+       else
+         string "forall" ^^ space ^^ separate_map space doc_kopt kopts ^^ comma
+         ^//^ (separate_map (space ^^ string "&" ^^ space) doc_nc ncs ^^ dot
+               ^^ hardline ^^ doc_typ ~simple:simple typ)
+     else
+       string "forall" ^^ space ^^ doc_quants qs ^^ dot ^//^ doc_typ ~simple:simple typ
+
+let doc_typschm ?(simple=false) (TypSchm_aux (TypSchm_ts (typq, typ), _)) = doc_binding ~simple:simple (typq, typ)
 
 let doc_typschm_typ (TypSchm_aux (TypSchm_ts (TypQ_aux (tq_aux, _), typ), _)) = doc_typ typ
 
-let doc_typschm_quants (TypSchm_aux (TypSchm_ts (TypQ_aux (tq_aux, _), typ), _)) =
+let doc_typquant (TypQ_aux (tq_aux, _)) =
   match tq_aux with
   | TypQ_no_forall -> None
   | TypQ_tq [] -> None
-  | TypQ_tq qs -> Some (doc_quants qs)
+  | TypQ_tq qs -> Some (doc_param_quants qs)
 
 let doc_lit (L_aux(l,_)) =
   utf8string (match l with
@@ -226,7 +285,7 @@ let doc_lit (L_aux(l,_)) =
   | L_undef -> "undefined"
   | L_string s -> "\"" ^ String.escaped s ^ "\"")
 
-let rec doc_pat (P_aux (p_aux, _) as pat) =
+let rec doc_pat (P_aux (p_aux, (l, _)) as pat) =
   match p_aux with
   | P_id id -> doc_id id
   | P_or (pat1, pat2) -> parens (doc_pat pat1 ^^ string " | " ^^ doc_pat pat2)
@@ -237,14 +296,18 @@ let rec doc_pat (P_aux (p_aux, _) as pat) =
   (* P_var short form sugar *)
   | P_var (P_aux (P_id id, _), TP_aux (TP_var kid, _)) when Id.compare (id_of_kid kid) id == 0 ->
      doc_kid kid
-  | P_var (pat, tpat) -> separate space [doc_pat pat; string "as"; doc_typ_pat tpat]
+  | P_var (pat, tpat) -> parens (separate space [doc_pat pat; string "as"; doc_typ_pat tpat])
   | P_vector pats -> brackets (separate_map (comma ^^ space) doc_pat pats)
   | P_vector_concat pats -> separate_map (space ^^ string "@" ^^ space) doc_pat pats
   | P_wild -> string "_"
   | P_as (pat, id) -> parens (separate space [doc_pat pat; string "as"; doc_id id])
   | P_app (id, pats) -> doc_id id ^^ parens (separate_map (comma ^^ space) doc_pat pats)
   | P_list pats -> string "[|" ^^ separate_map (comma ^^ space) doc_pat pats ^^ string "|]"
-  | _ -> string (string_of_pat pat)
+  | P_cons (hd_pat, tl_pat) -> separate space [doc_pat hd_pat; string "::"; doc_pat tl_pat]
+  | P_string_append [] -> string "\"\""
+  | P_string_append pats ->
+     parens (separate_map (string " ^ ") doc_pat pats)
+  | P_record _ -> raise (Reporting.err_unreachable l __POS__ "P_record passed to doc_pat")
 
 (* if_block_x is true if x should be printed like a block, i.e. with
    newlines. Blocks are automatically printed as blocks, so this
@@ -286,8 +349,8 @@ let fixities =
 let rec doc_exp (E_aux (e_aux, _) as exp) =
   match e_aux with
   | E_block [] -> string "()"
-  | E_block [exp] -> doc_exp exp
-  | E_block exps -> surround 2 0 lbrace (doc_block exps) rbrace
+  | E_block exps ->
+     group (lbrace ^^ nest 4 (hardline ^^ doc_block exps) ^^ hardline ^^ rbrace)
   | E_nondet exps -> assert false
   (* This is mostly for the -convert option *)
   | E_app_infix (x, id, y) when Id.compare (mk_id "quot") id == 0 ->
@@ -336,21 +399,16 @@ let rec doc_exp (E_aux (e_aux, _) as exp) =
   | E_assign (lexp, exp) ->
      separate space [doc_lexp lexp; equals; doc_exp exp]
   | E_for (id, exp1, exp2, exp3, order, exp4) ->
-     begin
-       let header =
-         string "foreach" ^^ space ^^
-           group (parens (separate (break 1)
-                                   [ doc_id id;
-                                     string "from " ^^ doc_atomic_exp exp1;
-                                     string "to " ^^ doc_atomic_exp exp2;
-                                     string "by " ^^ doc_atomic_exp exp3;
-                                     string "in " ^^ doc_ord order ]))
-       in
-       match exp4 with
-       | E_aux (E_block [_], _) -> header ^//^ doc_exp exp4
-       | E_aux (E_block _, _) -> header ^^ space ^^ doc_exp exp4
-       | _ -> header ^//^ doc_exp exp4
-     end
+     let header =
+       string "foreach" ^^ space ^^
+         group (parens (separate (break 1)
+                                 [ doc_id id;
+                                   string "from " ^^ doc_atomic_exp exp1;
+                                   string "to " ^^ doc_atomic_exp exp2;
+                                   string "by " ^^ doc_atomic_exp exp3;
+                                   string "in " ^^ doc_ord order ]))
+     in
+     header ^^ space ^^ doc_exp exp4
   (* Resugar an assert with an empty message *)
   | E_throw exp -> string "throw" ^^ parens (doc_exp exp)
   | E_try (exp, pexps) ->
@@ -404,7 +462,7 @@ and doc_atomic_exp (E_aux (e_aux, _) as exp) =
      brackets (separate space [doc_exp exp1; string "with"; doc_atomic_exp exp2; string ".."; doc_atomic_exp exp3; equals; doc_exp exp4])
   | E_internal_value v -> string (Value.string_of_value v |> Util.green |> Util.clear)
   | _ -> parens (doc_exp exp)
-and doc_fexps (FES_aux (FES_Fexps (fexps, _), _)) =
+and doc_fexps fexps =
   separate_map (comma ^^ space) doc_fexp fexps
 and doc_fexp (FE_aux (FE_Fexp (id, exp), _)) =
   separate space [doc_id id; equals; doc_exp exp]
@@ -451,13 +509,21 @@ let doc_funcl (FCL_aux (FCL_Funcl (id, Pat_aux (pexp,_)), _)) =
 
 let doc_default (DT_aux (DT_order ord, _)) = separate space [string "default"; string "Order"; doc_ord ord]
 
-let doc_fundef (FD_aux (FD_function (r, typa, efa, funcls), _)) =
-  match funcls with
-  | [] -> failwith "Empty function list"
-  | _ ->
-     let sep = hardline ^^ string "and" ^^ space in
-     let clauses = separate_map sep doc_funcl funcls in
-     string "function" ^^ space ^^ clauses
+let doc_rec (Rec_aux (r,_)) =
+  match r with
+  | Rec_nonrec
+  | Rec_rec -> empty
+  | Rec_measure (pat,exp) -> braces (doc_pat pat ^^ string " => " ^^ doc_exp exp) ^^ space
+
+let doc_fundef (FD_aux (FD_function (r, typa, efa, funcls), annot)) =
+  docstring annot
+  ^^ match funcls with
+     | [] -> failwith "Empty function list"
+     | _ ->
+        let rec_pp = doc_rec r in
+        let sep = hardline ^^ string "and" ^^ space in
+        let clauses = separate_map sep doc_funcl funcls in
+        string "function" ^^ space ^^ rec_pp ^^ clauses
 
 let rec doc_mpat (MP_aux (mp_aux, _) as mpat) =
   match mp_aux with
@@ -512,38 +578,45 @@ let doc_field (typ, id) =
 
 let doc_union (Tu_aux (Tu_ty_id (typ, id), l)) = separate space [doc_id id; colon; doc_typ typ]
 
+let doc_typ_arg_kind (A_aux (aux, _)) =
+  match aux with
+  | A_nexp _ -> space ^^ string "->" ^^ space ^^string "Int"
+  | A_bool _ -> space ^^ string "->" ^^ space ^^ string "Bool"
+  | A_order  _ -> space ^^ string "->" ^^ space ^^ string "Order"
+  | A_typ _ -> empty
+
 let doc_typdef (TD_aux(td,_)) = match td with
-  | TD_abbrev (id, _, typschm) ->
+  | TD_abbrev (id, typq, typ_arg) ->
      begin
-       match doc_typschm_quants typschm with
+       match doc_typquant typq with
        | Some qdoc ->
-          doc_op equals (concat [string "type"; space; doc_id id; space; qdoc]) (doc_typschm_typ typschm)
+          doc_op equals (concat [string "type"; space; doc_id id; qdoc; doc_typ_arg_kind typ_arg]) (doc_typ_arg typ_arg)
        | None ->
-          doc_op equals (concat [string "type"; space; doc_id id]) (doc_typschm_typ typschm)
+          doc_op equals (concat [string "type"; space; doc_id id; doc_typ_arg_kind typ_arg]) (doc_typ_arg typ_arg)
      end
   | TD_enum (id, _, ids, _) ->
      separate space [string "enum"; doc_id id; equals; surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_id ids) rbrace]
   | TD_record (id, _, TypQ_aux (TypQ_no_forall, _), fields, _) | TD_record (id, _, TypQ_aux (TypQ_tq [], _), fields, _) ->
      separate space [string "struct"; doc_id id; equals; surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_field fields) rbrace]
   | TD_record (id, _, TypQ_aux (TypQ_tq qs, _), fields, _) ->
-     separate space [string "struct"; doc_id id; doc_quants qs; equals;
+     separate space [string "struct"; doc_id id; doc_param_quants qs; equals;
                      surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_field fields) rbrace]
   | TD_variant (id, _, TypQ_aux (TypQ_no_forall, _), unions, _) | TD_variant (id, _, TypQ_aux (TypQ_tq [], _), unions, _) ->
      separate space [string "union"; doc_id id; equals; surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_union unions) rbrace]
   | TD_variant (id, _, TypQ_aux (TypQ_tq qs, _), unions, _) ->
-     separate space [string "union"; doc_id id; doc_quants qs; equals;
+     separate space [string "union"; doc_id id; doc_param_quants qs; equals;
                      surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_union unions) rbrace]
   | _ -> string "TYPEDEF"
 
 
-let doc_spec (VS_aux (v, annot)) =
+let doc_spec ?comment:(comment=false) (VS_aux (v, annot)) =
   let doc_extern ext =
     let docs = List.map (fun (backend, rep) -> string (backend ^ ":") ^^ space ^^ utf8string ("\"" ^ String.escaped rep ^ "\"")) ext in
     if docs = [] then empty else equals ^^ space ^^ braces (separate (comma ^^ space) docs)
   in
   match v with
   | VS_val_spec(ts,id,ext,is_cast) ->
-     docstring annot
+     if comment then docstring annot else empty
      ^^ string "val" ^^ space
      ^^ (if is_cast then (string "cast" ^^ space) else empty)
      ^^ doc_id id ^^ space
@@ -561,13 +634,18 @@ let doc_kind_def (KD_aux (KD_nabbrev (_, id, _, nexp), _)) =
 
 let rec doc_scattered (SD_aux (sd_aux, _)) =
   match sd_aux with
-  | SD_scattered_function (_, _, _, id) ->
+  | SD_function (_, _, _, id) ->
      string "scattered" ^^ space ^^ string "function" ^^ space ^^ doc_id id
-  | SD_scattered_funcl funcl ->
+  | SD_funcl funcl ->
      string "function" ^^ space ^^ string "clause" ^^ space ^^ doc_funcl funcl
-  | SD_scattered_end id ->
+  | SD_end id ->
      string "end" ^^ space ^^ doc_id id
-  | _ -> string "SCATTERED"
+  | SD_variant (id, _, TypQ_aux (TypQ_no_forall, _)) ->
+     string "scattered" ^^ space ^^ string "union" ^^ space ^^ doc_id id
+  | SD_variant (id, _, TypQ_aux (TypQ_tq quants, _)) ->
+     string "scattered" ^^ space ^^ string "union" ^^ space ^^ doc_id id ^^ doc_param_quants quants
+  | SD_unioncl (id, tu) ->
+     separate space [string "union clause"; doc_id id; equals; doc_union tu]
 
 let rec doc_def def = group (match def with
   | DEF_default df -> doc_default df
@@ -582,11 +660,11 @@ let rec doc_def def = group (match def with
      ^^ hardline ^^ string "}"
   | DEF_reg_dec dec -> doc_dec dec
   | DEF_scattered sdef -> doc_scattered sdef
+  | DEF_pragma (pragma, arg, l) ->
+     string ("$" ^ pragma ^ " " ^ arg)
   | DEF_fixity (prec, n, id) ->
      fixities := Bindings.add id (prec, Big_int.to_int n) !fixities;
      separate space [doc_prec prec; doc_int n; doc_id id]
-  | DEF_constraint (id, kids, nc) ->
-     separate space [string "constraint"; doc_id id; parens (separate_map (comma ^^ space) doc_kid kids); equals; doc_nc nc]
   | DEF_overload (id, ids) ->
      separate space [string "overload"; doc_id id; equals; surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_id ids) rbrace]
   ) ^^ hardline
diff --git a/src/process_file.ml b/src/process_file.ml
index 344c7921..87acd83a 100644
--- a/src/process_file.ml
+++ b/src/process_file.ml
@@ -65,7 +65,7 @@ let get_lexbuf f =
   lexbuf, in_chan
 
 let parse_file ?loc:(l=Parse_ast.Unknown) (f : string) : Parse_ast.defs =
-  let open Reporting_basic in
+  let open Reporting in
   try
     let lexbuf, in_chan = get_lexbuf f in
     begin
@@ -75,7 +75,8 @@ let parse_file ?loc:(l=Parse_ast.Unknown) (f : string) : Parse_ast.defs =
       with
       | Parser.Error ->
          let pos = Lexing.lexeme_start_p lexbuf in
-         raise (Fatal_error (Err_syntax (pos, "no information")))
+         let tok = Lexing.lexeme lexbuf in
+         raise (Fatal_error (Err_syntax (pos, "current token: " ^ tok)))
       | Lexer.LexError(s,p) ->
          raise (Fatal_error (Err_lex (p, s)))
     end
@@ -111,7 +112,7 @@ let cond_pragma l defs =
        decr depth; push_def def; scan defs
     | def :: defs ->
        push_def def; scan defs
-    | [] -> raise (Reporting_basic.err_general l "$ifdef or $ifndef never ended by $endif")
+    | [] -> raise (Reporting.err_general l "$ifdef or $ifndef never ended by $endif")
   in
   scan defs
 
@@ -123,19 +124,24 @@ let parseid_to_string (Parse_ast.Id_aux (id, _)) =
   match id with
   | Parse_ast.Id x | Parse_ast.DeIid x -> x
 
-let rec realise_union_anon_rec_types (Parse_ast.TD_variant (union_id, name_scm_opt, typq, _, flag) as orig_union) arms =
-  match arms with
-  | [] -> []
-  | arm :: arms ->
-     match arm with
-     | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_id _), _)) -> (None, arm) :: realise_union_anon_rec_types orig_union arms
-     | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_anon_rec (fields, id)), l)) ->
-        let open Parse_ast in
-        let record_str = "_" ^ parseid_to_string union_id ^ "_" ^ parseid_to_string id ^ "_record" in
-        let record_id = Id_aux (Id record_str, Generated l) in
-        let new_arm = Tu_aux ((Tu_ty_id ((ATyp_aux (ATyp_id record_id, Generated l)), id)), Generated l) in
-        let new_rec_def = DEF_type (TD_aux (TD_record (record_id, name_scm_opt, typq, fields, flag), Generated l)) in
-        (Some new_rec_def, new_arm) :: (realise_union_anon_rec_types orig_union arms)
+let rec realise_union_anon_rec_types orig_union arms =
+  match orig_union with
+  | Parse_ast.TD_variant (union_id, name_scm_opt, typq, _, flag) ->
+     begin match arms with
+     | [] -> []
+     | arm :: arms ->
+        match arm with
+        | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_id _), _)) -> (None, arm) :: realise_union_anon_rec_types orig_union arms
+        | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_anon_rec (fields, id)), l)) ->
+           let open Parse_ast in
+           let record_str = "_" ^ parseid_to_string union_id ^ "_" ^ parseid_to_string id ^ "_record" in
+           let record_id = Id_aux (Id record_str, Generated l) in
+           let new_arm = Tu_aux ((Tu_ty_id ((ATyp_aux (ATyp_id record_id, Generated l)), id)), Generated l) in
+           let new_rec_def = DEF_type (TD_aux (TD_record (record_id, name_scm_opt, typq, fields, flag), Generated l)) in
+           (Some new_rec_def, new_arm) :: (realise_union_anon_rec_types orig_union arms)
+     end
+  | _ ->
+     raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Non union type-definition passed to realise_union_anon_rec_typs")
 
 let rec preprocess opts = function
   | [] -> []
@@ -149,11 +155,10 @@ let rec preprocess opts = function
          let args = Str.split (Str.regexp " +") command in
          Arg.parse_argv ~current:(ref 0) (Array.of_list ("sail" :: args)) opts (fun _ -> ()) "";
        with
-       | Arg.Bad message | Arg.Help message -> raise (Reporting_basic.err_general l message)
+       | Arg.Bad message | Arg.Help message -> raise (Reporting.err_general l message)
      end;
      preprocess opts defs
 
-
   | Parse_ast.DEF_pragma ("ifndef", symbol, l) :: defs ->
      let then_defs, else_defs, defs = cond_pragma l defs in
      if not (StringSet.mem symbol !symbols) then
@@ -200,8 +205,8 @@ let rec preprocess opts = function
        let help = "Make sure the filename is surrounded by quotes or angle brackets" in
        (Util.warn ("Skipping bad $include " ^ file ^ ". " ^ help); preprocess opts defs)
 
-  | Parse_ast.DEF_pragma (p, arg, _) :: defs ->
-     (Util.warn ("Bad pragma $" ^ p ^ " " ^ arg); preprocess opts defs)
+  | Parse_ast.DEF_pragma (p, arg, l) :: defs ->
+     Parse_ast.DEF_pragma (p, arg, l) :: preprocess opts defs
 
   (* realise any anonymous record arms of variants *)
   | Parse_ast.DEF_type (Parse_ast.TD_aux
@@ -309,7 +314,7 @@ let output_lem filename libs defs =
     open_output_with_check_unformatted (filename ^ ".lem") in
   (Pretty_print.pp_defs_lem
      (ot, base_imports)
-     (o, base_imports @ (String.capitalize types_module :: libs))
+     (o, base_imports @ (String.capitalize_ascii types_module :: libs))
      defs generated_line);
   close_output_with_check ext_ot;
   close_output_with_check ext_o;
@@ -360,8 +365,10 @@ let output libpath out_arg files =
       output1 libpath out_arg f defs)
     files
 
-let rewrite_step defs (name,rewriter) =
+let rewrite_step defs (name, rewriter) =
+  let t = Profile.start () in
   let defs = rewriter defs in
+  Profile.finish ("rewrite " ^ name) t;
   let _ = match !(opt_ddump_rewrite_ast) with
     | Some (f, i) ->
       begin
@@ -378,10 +385,9 @@ let rewrite_step defs (name,rewriter) =
 let rewrite rewriters env defs =
   try List.fold_left rewrite_step defs rewriters with
   | Type_check.Type_error (l, err) ->
-     raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err))
+     raise (Reporting.err_typ l (Type_error.string_of_type_error err))
 
 let rewrite_ast = rewrite [("initial", Rewriter.rewrite_defs)]
-let rewrite_undefined bitvectors = rewrite [("undefined", fun x -> Rewrites.rewrite_undefined bitvectors x)]
 let rewrite_ast_lem = rewrite Rewrites.rewrite_defs_lem
 let rewrite_ast_coq = rewrite Rewrites.rewrite_defs_coq
 let rewrite_ast_ocaml = rewrite Rewrites.rewrite_defs_ocaml
diff --git a/src/process_file.mli b/src/process_file.mli
index 7862c121..7b860a73 100644
--- a/src/process_file.mli
+++ b/src/process_file.mli
@@ -56,7 +56,6 @@ val convert_ast : Ast.order -> Parse_ast.defs -> unit Ast.defs
 val preprocess_ast : (Arg.key * Arg.spec * Arg.doc) list -> Parse_ast.defs -> Parse_ast.defs
 val check_ast: Type_check.Env.t -> unit Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t
 val rewrite_ast: Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs
-val rewrite_undefined: bool -> Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs
 val rewrite_ast_lem : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs
 val rewrite_ast_coq : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs
 val rewrite_ast_ocaml : Type_check.Env.t -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs
diff --git a/src/profile.ml b/src/profile.ml
new file mode 100644
index 00000000..cb374403
--- /dev/null
+++ b/src/profile.ml
@@ -0,0 +1,91 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+let opt_profile = ref false
+
+type profile = {
+    z3_calls : int;
+    z3_time : float
+  }
+
+let new_profile = {
+    z3_calls = 0;
+    z3_time = 0.0
+  }
+
+let profile_stack = ref []
+
+let update_profile f =
+  match !profile_stack with
+  | [] -> ()
+  | (p :: ps) ->
+     profile_stack := f p :: ps
+
+let start_z3 () =
+  update_profile (fun p -> { p with z3_calls = p.z3_calls + 1 });
+  Sys.time ()
+
+let finish_z3 t =
+  update_profile (fun p -> { p with z3_time = p.z3_time +. (Sys.time () -. t) })
+
+let start () =
+  profile_stack := new_profile :: !profile_stack;
+  Sys.time ()
+
+let finish msg t =
+  if !opt_profile then
+    begin match !profile_stack with
+    | p :: ps ->
+       prerr_endline (Printf.sprintf "%s %s: %fs" Util.("Profile" |> magenta |> clear) msg (Sys.time () -. t));
+       prerr_endline (Printf.sprintf "  Z3 calls: %d, Z3 time: %fs" p.z3_calls p.z3_time);
+       profile_stack := ps
+    | [] -> ()
+    end
+  else ()
diff --git a/src/reporting_basic.ml b/src/reporting.ml
index a90c2bcd..858e5c41 100644
--- a/src/reporting_basic.ml
+++ b/src/reporting.ml
@@ -169,6 +169,14 @@ let format_pos2 ff p1 p2 =
     Format.pp_print_flush ff ()
   end
 
+let format_just_pos ff p1 p2 =
+  let open Lexing in
+  Format.fprintf ff "file \"%s\", line %d, character %d to line %d, character %d"
+                 p1.pos_fname
+                 p1.pos_lnum (p1.pos_cnum - p1.pos_bol + 1)
+                 p2.pos_lnum (p2.pos_cnum - p2.pos_bol);
+  Format.pp_print_flush ff ()
+
 (* reads the part between p1 and p2 from the file *)
 
 let read_from_file_pos2 p1 p2 =
@@ -187,36 +195,29 @@ let read_from_file_pos2 p1 p2 =
   let _ = close_in ic in
   (buf, not (multi = None))
 
-(* Destruct a location by splitting all the Internal strings except possibly the
-   last one into a string list and keeping only the last location *)
-let dest_loc (l : Parse_ast.l) : (Parse_ast.l * string list) = 
-  let rec aux acc l = match l with
-    | Parse_ast.Int(s, Some l') -> aux (s::acc) l'
-    | _ -> (l, acc)
-  in
-  aux [] l
-
-let rec format_loc_aux ff l =
-  let (l_org, mod_s) = dest_loc l in
-  let _ = match l_org with
-    | Parse_ast.Unknown -> Format.fprintf ff "no location information available"
-    | Parse_ast.Generated l -> Format.fprintf ff "code generated: original nearby source is "; (format_loc_aux ff l)
-    | Parse_ast.Range(p1,p2) -> format_pos2 ff p1 p2
-    | Parse_ast.Int(s,_) -> Format.fprintf ff "code in lib from: %s" s
-    | Parse_ast.Documented(_, l) -> format_loc_aux ff l
-  in
-  ()
+let rec format_loc_aux ?code:(code=true) ff = function
+  | Parse_ast.Unknown ->
+     Format.fprintf ff "no location information available"
+  | Parse_ast.Generated l ->
+     Format.fprintf ff "code generated: original nearby source is ";
+     format_loc_aux ~code:code ff l
+  | Parse_ast.Unique (n, l) ->
+     Format.fprintf ff "code unique (%d): original nearby source is " n;
+     format_loc_aux ~code:code ff l
+  | Parse_ast.Range (p1, p2) when code ->
+     format_pos2 ff p1 p2
+  | Parse_ast.Range (p1, p2) ->
+     format_just_pos ff p1 p2
+  | Parse_ast.Documented (_, l) ->
+     format_loc_aux ~code:code ff l
 
-let format_loc_source ff l = 
-  match dest_loc l with 
-  | (Parse_ast.Range (p1, p2), _) -> 
-    begin
-      let (s, multi_line) = read_from_file_pos2 p1 p2 in
-      if multi_line then 
-        Format.fprintf ff "  original input:\n%s\n" (Bytes.to_string s)
-      else
-        Format.fprintf ff "  original input: \"%s\"\n" (Bytes.to_string s)
-    end
+let format_loc_source ff = function
+  | Parse_ast.Range (p1, p2) ->
+     let (s, multi_line) = read_from_file_pos2 p1 p2 in
+     if multi_line then
+       Format.fprintf ff "  original input:\n%s\n" (Bytes.to_string s)
+     else
+       Format.fprintf ff "  original input: \"%s\"\n" (Bytes.to_string s)
   | _ -> ()
 
 let format_loc ff l =
@@ -231,9 +232,9 @@ let print_err_loc l =
 let print_pos p = format_pos Format.std_formatter p
 let print_err_pos p = format_pos Format.err_formatter p
 
-let loc_to_string l =
+let loc_to_string ?code:(code=true) l =
   let _ = Format.flush_str_formatter () in
-  let _ = format_loc_aux Format.str_formatter l in
+  let _ = format_loc_aux ~code:code Format.str_formatter l in
   let s = Format.flush_str_formatter () in
   s
 
@@ -265,9 +266,12 @@ type error =
   | Err_type of Parse_ast.l * string
   | Err_type_dual of Parse_ast.l * Parse_ast.l * string
 
+let issues = "\n\nPlease report this as an issue on GitHub at https://github.com/rems-project/sail/issues"
+
 let dest_err = function
   | Err_general (l, m) -> ("Error", false, Loc l, m)
-  | Err_unreachable (l, (file, line, _, _), m) -> ((Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line), false, Loc l, m)
+  | Err_unreachable (l, (file, line, _, _), m) ->
+     ((Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line), false, Loc l, m ^ issues)
   | Err_todo (l, m) -> ("Todo" ^ m, false, Loc l, "")
   | Err_syntax (p, m) -> ("Syntax error", false, Pos p, m)
   | Err_syntax_locn (l, m) -> ("Syntax error", false, Loc l, m)
@@ -284,7 +288,7 @@ let err_general l m = Fatal_error (Err_general (l, m))
 let err_typ l m = Fatal_error (Err_type (l,m))
 let err_typ_dual l1 l2 m = Fatal_error (Err_type_dual (l1,l2,m))
 
-let report_error e = 
+let report_error e =
   let (m1, verb_pos, pos_l, m2) = dest_err e in
   (print_err_internal verb_pos false pos_l m1 m2; exit 1)
 
diff --git a/src/reporting_basic.mli b/src/reporting.mli
index 39ac32f0..63ed3eee 100644
--- a/src/reporting_basic.mli
+++ b/src/reporting.mli
@@ -50,7 +50,7 @@
 
 (** Basic error reporting
 
-  [Reporting_basic] contains functions to report errors and warnings. 
+  [Reporting] contains functions to report errors and warnings. 
   It contains functions to print locations ([Parse_ast.l] and [Ast.l]) and lexing positions.
 
   The main functionality is reporting errors. This is done by raising a
@@ -62,7 +62,8 @@
 
 (** {2 Auxiliary Functions } *)
 
-val loc_to_string : Parse_ast.l -> string
+(** [loc_to_string] includes code from file if code optional argument is true (default) *)
+val loc_to_string : ?code:bool -> Parse_ast.l -> string
 
 (** [print_err fatal print_loc_source l head mes] prints an error / warning message to
     std-err. It starts with printing location information stored in [l]
diff --git a/src/return_analysis.ml b/src/return_analysis.ml
new file mode 100644
index 00000000..256f97cf
--- /dev/null
+++ b/src/return_analysis.ml
@@ -0,0 +1,182 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+open Type_check
+
+let analyze_exp_returns exp =
+  let returns = ref [] in
+  let add_return annot = returns := annot :: !returns in
+
+  print_endline ("\nAnalyzing " ^ string_of_exp exp);
+
+  let rec analyze last (E_aux (e_aux, annot)) =
+    let env = env_of_annot annot in
+    match e_aux with
+    | E_block exps ->
+       begin match List.rev exps with
+       | [] -> ()
+       | (exp :: exps) ->
+          List.iter (analyze false) exps;
+          analyze last exp
+       end
+
+    | E_nondet exps -> List.iter (analyze last) exps
+
+    | E_id id ->
+       if last then
+         add_return annot
+       else
+         ()
+
+    | E_lit _ when last ->
+       add_return annot
+
+    | E_app _  when last ->
+       add_return annot
+    | E_app (_, exps) ->
+       List.iter (analyze false) exps
+
+    | E_if (_, then_exp, else_exp) ->
+       analyze last then_exp; analyze last else_exp
+
+    | E_return (E_aux (_, annot)) ->
+       add_return annot
+
+    | E_for (_, exp1, exp2, exp3, _, body) ->
+       analyze false exp1; analyze false exp2; analyze false exp3;
+       analyze last body
+
+    | _ -> ()
+  in
+  analyze true exp;
+
+  !returns
+
+type existential =
+  | Equal of nexp
+  | Constraint of (kid -> n_constraint)
+  | Anything
+
+let existentialize_annot funcl_annot annot =
+  let funcl_env = env_of_annot funcl_annot in
+  let env = env_of_annot annot in
+  match Env.expand_synonyms env (typ_of_annot annot) with
+  | (Typ_aux (Typ_app (ty_id, [A_aux (A_nexp nexp, _)]), _) as typ)
+       when Id.compare ty_id (mk_id "atom") = 0 ->
+     let tyvars = Env.get_typ_vars funcl_env |> KBindings.bindings in
+     let toplevel_kids =
+       List.filter (fun (kid, k) -> match k with K_int -> true | _ -> false) tyvars |> List.map fst |> KidSet.of_list
+     in
+     let new_kids = KidSet.diff (tyvars_of_nexp nexp) toplevel_kids in
+
+     if KidSet.cardinal new_kids = 0 then
+       Some (Equal nexp)
+     else if KidSet.cardinal new_kids = 1 then
+       let ex_kid = KidSet.min_elt new_kids in
+       (* Now we search for constraints that involve the existential
+          kid, and only reference toplevel type variables. *)
+       let constraints = List.concat (List.map constraint_conj (Env.get_constraints env)) in
+       let constraints = List.filter (fun nc -> KidSet.mem ex_kid (tyvars_of_constraint nc)) constraints in
+       let constraints =
+         List.filter (fun nc -> KidSet.subset (tyvars_of_constraint nc) (KidSet.add ex_kid toplevel_kids)) constraints
+       in
+
+       match constraints with
+       | c :: cs ->
+          Some (Constraint (fun kid -> nc_subst_nexp ex_kid (Nexp_var kid) (List.fold_left nc_and c cs)))
+       | [] ->
+          Some Anything
+     else
+       Some Anything
+  | _ ->
+     None
+
+let union_existential ex1 ex2 =
+  match ex1, ex2 with
+  | Equal nexp1, Equal nexp2 ->
+     Constraint (fun kid -> nc_or (nc_eq (nvar kid) nexp1) (nc_eq (nvar kid) nexp2))
+
+  | Equal nexp, Constraint c ->
+     Constraint (fun kid -> nc_or (nc_eq (nvar kid) nexp) (c kid))
+
+  | Constraint c, Equal nexp ->
+     Constraint (fun kid -> nc_or (c kid) (nc_eq (nvar kid) nexp))
+
+  | _, _ -> Anything
+
+let typ_of_existential = function
+  | Anything -> int_typ
+  | Equal nexp -> atom_typ nexp
+  | Constraint c -> exist_typ c (fun kid -> atom_typ (nvar kid))
+
+let analyze_def_returns = function
+  | DEF_fundef (FD_aux (FD_function (_, _, _, funcls), _)) ->
+     let analyze_funcls = function
+       | FCL_aux (FCL_Funcl (id, Pat_aux (Pat_exp (pat, exp), _)), funcl_annot) ->
+          let return_exs =
+            List.map (fun annot -> existentialize_annot funcl_annot annot) (analyze_exp_returns exp)
+          in
+          begin match Util.option_all return_exs with
+          | Some [] -> ()
+          | Some (ex :: exs) ->
+             print_endline (string_of_typ (typ_of_existential (List.fold_left union_existential ex exs)))
+          | None -> ()
+          end
+
+       | _ -> ()
+     in
+     List.iter analyze_funcls funcls
+
+  | def -> ()
+
+let analyze_returns (Defs defs) = List.iter analyze_def_returns defs
+
diff --git a/src/rewriter.ml b/src/rewriter.ml
index a7505ca7..a70f6fab 100644
--- a/src/rewriter.ml
+++ b/src/rewriter.ml
@@ -64,11 +64,10 @@ type 'a rewriters = {
     rewrite_defs : 'a rewriters -> 'a defs -> 'a defs;
   }
 
-
 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,_),_)) =
+let effect_of_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
 (* The typechecker does not seem to annotate pexps themselves *)
@@ -95,7 +94,7 @@ let lookup_generated_kid env kid =
 let generated_kids typ = KidSet.filter is_kid_generated (tyvars_of_typ typ)
 
 let resolve_generated_kids env typ =
-  let subst_kid kid typ = typ_subst_kid kid (lookup_generated_kid env kid) typ in
+  let subst_kid kid typ = subst_kid typ_subst kid (lookup_generated_kid env kid) typ in
   KidSet.fold subst_kid (generated_kids typ) typ
 
 let rec remove_p_typ = function
@@ -103,7 +102,7 @@ let rec remove_p_typ = function
   | pat -> pat
 
 let add_p_typ typ (P_aux (paux, annot) as pat) =
-  let typ' = resolve_generated_kids (pat_env_of pat) typ in
+  let typ' = resolve_generated_kids (env_of_pat pat) typ in
   if KidSet.is_empty (generated_kids typ') then
     P_aux (P_typ (typ', remove_p_typ pat), annot)
   else pat
@@ -295,16 +294,14 @@ let rewrite_exp rewriters (E_aux (exp,(l,annot)) as orig_exp) =
   | 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)) ->
+  | E_record fexps ->
     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))) ->
+              (List.map (fun (FE_aux(FE_Fexp(id,e),fannot)) ->
+                   FE_aux(FE_Fexp(id,rewrite e),fannot)) fexps))
+  | E_record_update (re, fexps) ->
     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))))
+                             (List.map (fun (FE_aux(FE_Fexp(id,e),fannot)) ->
+                                  FE_aux(FE_Fexp(id,rewrite e),fannot)) fexps)))
   | E_field(exp,id) -> rewrap (E_field(rewrite exp,id))
   | E_case (exp,pexps) ->
     rewrap (E_case (rewrite exp, List.map (rewrite_pexp rewriters) pexps))
@@ -319,8 +316,8 @@ let rewrite_exp rewriters (E_aux (exp,(l,annot)) as orig_exp) =
   | E_assert(e1,e2) -> rewrap (E_assert(rewrite e1,rewrite e2))
   | E_var (lexp, e1, e2) ->
      rewrap (E_var (rewriters.rewrite_lexp rewriters lexp, rewriters.rewrite_exp rewriters e1, rewriters.rewrite_exp rewriters e2))
-  | E_internal_return _ -> raise (Reporting_basic.err_unreachable l __POS__ "Internal return found before it should have been introduced")
-  | E_internal_plet _ -> raise (Reporting_basic.err_unreachable l __POS__ " Internal plet found before it should have been introduced")
+  | E_internal_return _ -> raise (Reporting.err_unreachable l __POS__ "Internal return found before it should have been introduced")
+  | E_internal_plet _ -> raise (Reporting.err_unreachable l __POS__ " Internal plet found before it should have been introduced")
   | _ -> rewrap exp
 
 let rewrite_let rewriters (LB_aux(letbind,(l,annot))) =
@@ -349,7 +346,14 @@ let rewrite_lexp rewriters (LEXP_aux(lexp,(l,annot))) =
 let rewrite_fun rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))) = 
   let rewrite_funcl (FCL_aux (FCL_Funcl(id,pexp),(l,annot))) =
     (FCL_aux (FCL_Funcl (id, rewrite_pexp rewriters pexp),(l,annot)))
-  in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
+  in
+  let recopt = match recopt with
+    | Rec_aux (Rec_nonrec, l) -> Rec_aux (Rec_nonrec, l)
+    | Rec_aux (Rec_rec, l) -> Rec_aux (Rec_rec, l)
+    | Rec_aux (Rec_measure (pat,exp),l) ->
+       Rec_aux (Rec_measure (rewrite_pat rewriters pat, rewrite_exp rewriters exp),l)
+  in
+  FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
 
 let rewrite_def rewriters d = match d with
   | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), annot)) ->
@@ -358,7 +362,8 @@ let rewrite_def rewriters d = match d with
   | DEF_fundef fdef -> DEF_fundef (rewriters.rewrite_fun rewriters fdef)
   | DEF_internal_mutrec fdefs -> DEF_internal_mutrec (List.map (rewriters.rewrite_fun rewriters) fdefs)
   | DEF_val letbind -> DEF_val (rewriters.rewrite_let rewriters letbind)
-  | DEF_scattered _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__ "DEF_scattered survived to rewritter")
+  | DEF_pragma (pragma, arg, l) -> DEF_pragma (pragma, arg, l)
+  | DEF_scattered _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "DEF_scattered survived to rewritter")
 
 let rewrite_defs_base rewriters (Defs defs) =
   let rec rewrite ds = match ds with
@@ -474,9 +479,9 @@ let id_pat_alg : ('a,'a pat, 'a pat_aux, 'a fpat, 'a fpat_aux) pat_alg =
   ; fP_Fpat          = (fun (id,pat) -> FP_Fpat (id,pat))
   }
 
-type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
-      'pat,'pat_aux,'fpat,'fpat_aux) exp_alg = 
+      '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
@@ -497,8 +502,8 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_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_record                 : 'fexp list -> 'exp_aux
+  ; e_record_update          : 'exp * 'fexp list -> 'exp_aux
   ; e_field                  : 'exp * id -> 'exp_aux
   ; e_case                   : 'exp * 'pexp list -> 'exp_aux
   ; e_try                    : 'exp * 'pexp list -> 'exp_aux
@@ -527,8 +532,6 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_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
@@ -566,8 +569,8 @@ let rec fold_exp_aux alg = function
   | 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_record fexps -> alg.e_record (List.map (fold_fexp alg) fexps)
+  | E_record_update (e,fexps) -> alg.e_record_update (fold_exp alg e, List.map (fold_fexp 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_try (e,pexps) -> alg.e_try (fold_exp alg e, List.map (fold_pexp alg) pexps)
@@ -601,8 +604,6 @@ 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)
@@ -673,8 +674,6 @@ let id_exp_alg =
   ; 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))
@@ -741,8 +740,12 @@ let compute_exp_alg bot join =
   ; e_vector_append = (fun ((v1,e1),(v2,e2)) -> (join v1 v2, E_vector_append (e1,e2)))
   ; e_list = split_join (fun es -> E_list es)
   ; e_cons = (fun ((v1,e1),(v2,e2)) -> (join v1 v2, E_cons (e1,e2)))
-  ; e_record = (fun (vs,fexps) -> (vs, E_record fexps))
-  ; e_record_update = (fun ((v1,e1),(vf,fexp)) -> (join v1 vf, E_record_update (e1,fexp)))
+  ; e_record = (fun fexps ->
+    let vs, fexps = List.split fexps in
+    (join_list vs, E_record fexps))
+  ; e_record_update = (fun ((v1,e1),fexps) ->
+    let (vps,fexps) = List.split fexps in
+    (join_list (v1::vps), E_record_update (e1,fexps)))
   ; e_field = (fun ((v1,e1),id) -> (v1, E_field (e1,id)))
   ; e_case = (fun ((v1,e1),pexps) ->
     let (vps,pexps) = List.split pexps in
@@ -782,10 +785,6 @@ let compute_exp_alg bot join =
   ; lEXP_aux = (fun ((vl,lexp),annot) -> (vl, LEXP_aux (lexp,annot)))
   ; fE_Fexp = (fun (id,(v,e)) -> (v, FE_Fexp (id,e)))
   ; fE_aux = (fun ((vf,fexp),annot) -> (vf, FE_aux (fexp,annot)))
-  ; fES_Fexps = (fun (fexps,b) ->
-    let (vs,fexps) = List.split fexps in
-    (join_list vs, FES_Fexps (fexps,b)))
-  ; fES_aux = (fun ((vf,fexp),annot) -> (vf, FES_aux (fexp,annot)))
   ; def_val_empty = (bot, Def_val_empty)
   ; def_val_dec = (fun (v,e) -> (v, Def_val_dec e))
   ; def_val_aux = (fun ((v,defval),aux) -> (v, Def_val_aux (defval,aux)))
@@ -842,8 +841,8 @@ let pure_exp_alg bot join =
   ; e_vector_append = (fun (v1,v2) -> join v1 v2)
   ; e_list = join_list
   ; e_cons = (fun (v1,v2) -> join v1 v2)
-  ; e_record = (fun vs -> vs)
-  ; e_record_update = (fun (v1,vf) -> join v1 vf)
+  ; e_record = (fun vs -> join_list vs)
+  ; e_record_update = (fun (v1,vf) -> join_list (v1::vf))
   ; e_field = (fun (v1,id) -> v1)
   ; e_case = (fun (v1,vps) -> join_list (v1::vps))
   ; e_try = (fun (v1,vps) -> join_list (v1::vps))
@@ -872,8 +871,6 @@ let pure_exp_alg bot join =
   ; lEXP_aux = (fun (vl,annot) -> vl)
   ; fE_Fexp = (fun (id,v) -> v)
   ; fE_aux = (fun (vf,annot) -> vf)
-  ; fES_Fexps = (fun (vs,b) -> join_list vs)
-  ; fES_aux = (fun (vf,annot) -> vf)
   ; def_val_empty = bot
   ; def_val_dec = (fun v -> v)
   ; def_val_aux = (fun (v,aux) -> v)
diff --git a/src/rewriter.mli b/src/rewriter.mli
index 15e704df..9da94a99 100644
--- a/src/rewriter.mli
+++ b/src/rewriter.mli
@@ -107,7 +107,7 @@ type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
 (* 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,
+type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_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
@@ -130,8 +130,8 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_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_record                 : 'fexp list -> 'exp_aux
+ ; e_record_update          : 'exp * 'fexp list -> 'exp_aux
  ; e_field                  : 'exp * id -> 'exp_aux
  ; e_case                   : 'exp * 'pexp list -> 'exp_aux
  ; e_try                    : 'exp * 'pexp list -> 'exp_aux
@@ -160,8 +160,6 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_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
@@ -177,34 +175,34 @@ type ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
 val fold_pat : ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg -> 'a pat -> 'pat
 
 (* fold over expressions *)
-val fold_exp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_exp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a exp -> 'exp
 
-val fold_letbind : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_letbind : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a letbind -> 'letbind
 
-val fold_pexp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_pexp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a pexp -> 'pexp
 
-val fold_pexp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_pexp : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a pexp -> 'pexp
 
-val fold_funcl : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_funcl : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default,'a pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a funcl -> 'a funcl
 
-val fold_function : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,'fexps,'fexps_aux,
+val fold_function : ('a,'exp,'exp_aux,'lexp,'lexp_aux,'fexp,'fexp_aux,
       'opt_default_aux,'opt_default, 'a pexp,'pexp_aux,'letbind_aux,'letbind,
       'pat,'pat_aux,'fpat,'fpat_aux) exp_alg -> 'a fundef -> 'a fundef
 
 val id_pat_alg : ('a,'a pat, 'a pat_aux, 'a fpat, 'a fpat_aux) pat_alg
 val id_exp_alg :
   ('a,'a exp,'a exp_aux,'a lexp,'a lexp_aux,'a fexp,
-  'a fexp_aux,'a fexps,'a fexps_aux,
+  'a fexp_aux,
   'a opt_default_aux,'a opt_default,'a pexp,'a pexp_aux,
   'a letbind_aux,'a letbind,
   'a pat,'a pat_aux,'a fpat,'a fpat_aux) exp_alg
@@ -214,7 +212,7 @@ val compute_pat_alg : 'b -> ('b -> 'b -> 'b) ->
 
 val compute_exp_alg : 'b -> ('b -> 'b -> 'b) ->
   ('a,('b * 'a exp),('b * 'a exp_aux),('b * 'a lexp),('b * 'a lexp_aux),('b * 'a fexp),
-  ('b * 'a fexp_aux),('b * 'a fexps),('b * 'a fexps_aux),
+  ('b * 'a fexp_aux),
   ('b * 'a opt_default_aux),('b * 'a opt_default),('b * 'a pexp),('b * 'a pexp_aux),
   ('b * 'a letbind_aux),('b * 'a letbind),
   ('b * 'a pat),('b * 'a pat_aux),('b * 'a fpat),('b * 'a fpat_aux)) exp_alg
@@ -224,7 +222,7 @@ val pure_pat_alg : 'b -> ('b -> 'b -> 'b) -> ('a,'b,'b,'b,'b) pat_alg
 val pure_exp_alg : 'b -> ('b -> 'b -> 'b) ->
   ('a,'b,'b,'b,'b,'b,
   'b,'b,'b,
-  'b,'b,'b,'b,
+  'b,'b,
   'b,'b,
   'b,'b,'b,'b) exp_alg
 
@@ -248,6 +246,4 @@ val fix_eff_pexp : tannot pexp -> tannot pexp
 
 val fix_eff_fexp : tannot fexp -> tannot fexp
 
-val fix_eff_fexps : tannot fexps -> tannot fexps
-
 val fix_eff_opt_default : tannot opt_default -> tannot opt_default
diff --git a/src/rewrites.ml b/src/rewrites.ml
index f1d22720..10bc4f44 100644
--- a/src/rewrites.ml
+++ b/src/rewrites.ml
@@ -82,7 +82,7 @@ let fresh_id_pat pre ((l,annot)) =
 
 let get_loc_exp (E_aux (_,(l,_))) = l
 
-let gen_vs (id, spec) = Initial_check.extern_of_string dec_ord (mk_id id) spec
+let gen_vs (id, spec) = Initial_check.extern_of_string (mk_id id) spec
 
 let annot_exp_effect e_aux l env typ effect = E_aux (e_aux, (l, mk_tannot env typ effect))
 let annot_exp e_aux l env typ = annot_exp_effect e_aux l env typ no_effect
@@ -169,16 +169,16 @@ let vector_string_to_bit_list l lit =
     | 'D' -> ['1';'1';'0';'1']
     | 'E' -> ['1';'1';'1';'0']
     | 'F' -> ['1';'1';'1';'1']
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "hexchar_to_binlist given unrecognized character") in
+    | _ -> raise (Reporting.err_unreachable l __POS__ "hexchar_to_binlist given unrecognized character") in
 
   let s_bin = match lit with
     | L_hex s_hex -> List.flatten (List.map hexchar_to_binlist (explode (String.uppercase_ascii s_hex)))
     | L_bin s_bin -> explode s_bin
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "s_bin given non vector literal") in
+    | _ -> raise (Reporting.err_unreachable l __POS__ "s_bin given non vector literal") in
 
   List.map (function '0' -> L_aux (L_zero, gen_loc l)
                    | '1' -> L_aux (L_one, gen_loc l)
-                   | _ -> raise (Reporting_basic.err_unreachable (gen_loc l) __POS__ "binary had non-zero or one")) s_bin
+                   | _ -> raise (Reporting.err_unreachable (gen_loc l) __POS__ "binary had non-zero or one")) s_bin
 
 let find_used_vars exp =
   (* Overapproximates the set of used identifiers, but for the use cases below
@@ -264,13 +264,15 @@ let rewrite_defs_nexp_ids, rewrite_typ_nexp_ids =
     | Typ_app (id, targs) ->
        Typ_aux (Typ_app (id, List.map (rewrite_typ_arg env) targs), l)
     | _ -> typ_aux
-  and rewrite_typ_arg env (Typ_arg_aux (targ, l) as targ_aux) = match targ with
-    | Typ_arg_nexp nexp ->
-       Typ_arg_aux (Typ_arg_nexp (rewrite_nexp_ids env nexp), l)
-    | Typ_arg_typ typ ->
-       Typ_arg_aux (Typ_arg_typ (rewrite_typ env typ), l)
-    | Typ_arg_order ord ->
-       Typ_arg_aux (Typ_arg_order ord, l)
+  and rewrite_typ_arg env (A_aux (targ, l) as targ_aux) = match targ with
+    | A_nexp nexp ->
+       A_aux (A_nexp (rewrite_nexp_ids env nexp), l)
+    | A_typ typ ->
+       A_aux (A_typ (rewrite_typ env typ), l)
+    | A_order ord ->
+       A_aux (A_order ord, l)
+    | A_bool nc ->
+       A_aux (A_bool nc, l)
   in
 
   let rewrite_annot (l, tannot) =
@@ -409,7 +411,7 @@ let rewrite_sizeof (Defs defs) =
                | P_id id | P_as (_, id) ->
                   let (Typ_aux (typ,_) as typ_aux) = typ_of_annot annot in
                   (match typ with
-                   | Typ_app (atom, [Typ_arg_aux (Typ_arg_nexp nexp, _)])
+                   | Typ_app (atom, [A_aux (A_nexp nexp, _)])
                         when string_of_id atom = "atom" ->
                       [nexp, E_id id]
                    | Typ_app (vector, _) when string_of_id vector = "vector" ->
@@ -461,7 +463,7 @@ let rewrite_sizeof (Defs defs) =
          let inst =
            try instantiation_of orig_exp with
            | Type_error (l, err) ->
-             raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err)) in
+             raise (Reporting.err_typ l (Type_error.string_of_type_error err)) in
          (* Rewrite the inst using orig_kid so that each type variable has it's
             original name rather than a mangled typechecker name *)
          let inst = KBindings.fold (fun kid uvar b -> KBindings.add (orig_kid kid) uvar b) inst KBindings.empty in
@@ -470,17 +472,17 @@ let rewrite_sizeof (Defs defs) =
              assert (not (Str.string_match ex_regex (string_of_kid kid) 0));
              let uvar = try Some (KBindings.find (orig_kid kid) inst) with Not_found -> None in
              match uvar with
-             | Some (U_nexp nexp) ->
+             | Some (A_aux (A_nexp nexp, _)) ->
                 let sizeof = E_aux (E_sizeof nexp, (l, mk_tannot env (atom_typ nexp) no_effect)) in
                 (try rewrite_trivial_sizeof_exp sizeof with
                 | Type_error (l, err) ->
-                  raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err)))
+                  raise (Reporting.err_typ l (Type_error.string_of_type_error err)))
              (* If the type variable is Not_found then it was probably
                 introduced by a P_var pattern, so it likely exists as
                 a variable in scope. It can't be an existential because the assert rules that out. *)
              | None -> annot_exp (E_id (id_of_kid (orig_kid kid))) l env (atom_typ (nvar (orig_kid kid)))
              | _ ->
-                raise (Reporting_basic.err_unreachable l __POS__
+                raise (Reporting.err_unreachable l __POS__
                                                        ("failed to infer nexp for type variable " ^ string_of_kid kid ^
                                                           " of function " ^ string_of_id f))
            end in
@@ -513,8 +515,8 @@ let rewrite_sizeof (Defs defs) =
     ; e_vector_append = (fun ((e1,e1'),(e2,e2')) -> (E_vector_append (e1,e2), E_vector_append (e1',e2')))
     ; e_list = (fun es -> let (es, es') = List.split es in (E_list es, E_list es'))
     ; e_cons = (fun ((e1,e1'),(e2,e2')) -> (E_cons (e1,e2), E_cons (e1',e2')))
-    ; e_record = (fun (fexps, fexps') -> (E_record fexps, E_record fexps'))
-    ; e_record_update = (fun ((e1,e1'),(fexp,fexp')) -> (E_record_update (e1,fexp), E_record_update (e1',fexp')))
+    ; e_record = (fun fexps -> let (fexps, fexps') = List.split fexps in (E_record fexps, E_record fexps'))
+    ; e_record_update = (fun ((e1,e1'),fexps) -> let (fexps, fexps') = List.split fexps in (E_record_update (e1,fexps), E_record_update (e1',fexps')))
     ; e_field = (fun ((e1,e1'),id) -> (E_field (e1,id), E_field (e1',id)))
     ; e_case = (fun ((e1,e1'),pexps) -> let (pexps, pexps') = List.split pexps in (E_case (e1,pexps), E_case (e1',pexps')))
     ; e_try = (fun ((e1,e1'),pexps) -> let (pexps, pexps') = List.split pexps in (E_try (e1,pexps), E_try (e1',pexps')))
@@ -543,8 +545,6 @@ let rewrite_sizeof (Defs defs) =
     ; lEXP_aux = (fun ((lexp,lexp'),annot) -> (LEXP_aux (lexp,annot), LEXP_aux (lexp',annot)))
     ; fE_Fexp = (fun (id,(e,e')) -> (FE_Fexp (id,e), FE_Fexp (id,e')))
     ; fE_aux = (fun ((fexp,fexp'),annot) -> (FE_aux (fexp,annot), FE_aux (fexp',annot)))
-    ; fES_Fexps = (fun (fexps,b) -> let (fexps, fexps') = List.split fexps in (FES_Fexps (fexps,b), FES_Fexps (fexps',b)))
-    ; fES_aux = (fun ((fexp,fexp'),annot) -> (FES_aux (fexp,annot), FES_aux (fexp',annot)))
     ; def_val_empty = (Def_val_empty, Def_val_empty)
     ; def_val_dec = (fun (e,e') -> (Def_val_dec e, Def_val_dec e'))
     ; def_val_aux = (fun ((defval,defval'),aux) -> (Def_val_aux (defval,aux), Def_val_aux (defval',aux)))
@@ -592,7 +592,7 @@ let rewrite_sizeof (Defs defs) =
         let penv = env_of_annot pannot in
         let peff = effect_of_annot (snd pannot) in
         if KidSet.is_empty nvars then paux else
-          match pat_typ_of paux with
+          match typ_of_pat paux with
           | Typ_aux (Typ_tup typs, _) ->
              let ptyp' = Typ_aux (Typ_tup (kid_typs @ typs), l) in
              (match pat with
@@ -605,10 +605,10 @@ let rewrite_sizeof (Defs defs) =
               | P_as (_, id) | P_id id ->
                  (* adding parameters here would change the type of id;
               we should remove the P_as/P_id here and add a let-binding to the body *)
-                 raise (Reporting_basic.err_todo l
+                 raise (Reporting.err_todo l
                                                  "rewriting as- or id-patterns for sizeof expressions not yet implemented")
               | _ ->
-                 raise (Reporting_basic.err_unreachable l __POS__
+                 raise (Reporting.err_unreachable l __POS__
                                                         "unexpected pattern while rewriting function parameters for sizeof expressions"))
           | ptyp ->
              let ptyp' = Typ_aux (Typ_tup (kid_typs @ [ptyp]), l) in
@@ -649,6 +649,9 @@ let rewrite_sizeof (Defs defs) =
            LB_val (pat, exp') in
          (params_map, defs @ [DEF_val (LB_aux (lb', annot))])
        end
+    | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), annot)) ->
+       let exp' = fst (fold_exp { copy_exp_alg with e_aux = e_app_aux params_map } exp) in
+       (params_map, defs @ [DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp'), annot))])
     | def ->
        (params_map, defs @ [def]) in
 
@@ -661,7 +664,7 @@ let rewrite_sizeof (Defs defs) =
           | Typ_aux (Typ_fn (vtyp_args, vtyp_ret, declared_eff), vl) ->
              Typ_aux (Typ_fn (kid_typs @ vtyp_args, vtyp_ret, declared_eff), vl)
           | _ ->
-            raise (Reporting_basic.err_typ l "val spec with non-function type") in
+            raise (Reporting.err_typ l "val spec with non-function type") in
         TypSchm_aux (TypSchm_ts (tq, typ'), l)
       else ts in
     match def with
@@ -758,7 +761,7 @@ let remove_vector_concat_pat pat =
            P_aux (P_app (id, List.map aux pats), a)
         | _ ->
            raise
-             (Reporting_basic.err_unreachable
+             (Reporting.err_unreachable
                 l __POS__ "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
@@ -806,7 +809,7 @@ let remove_vector_concat_pat pat =
                      then Big_int.sub (Big_int.add start length) (Big_int.of_int 1)
                      else Big_int.add (Big_int.sub start length) (Big_int.of_int 1))
           | _ ->
-            raise (Reporting_basic.err_unreachable (fst rannot') __POS__
+            raise (Reporting.err_unreachable (fst rannot') __POS__
               ("unname_vector_concat_elements: vector of unspecified length in vector-concat pattern"))) in
          let rec aux typ_opt (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
@@ -820,7 +823,7 @@ let remove_vector_concat_pat pat =
                 if is_last then (pos,last_idx)
                 else
                   raise
-                    (Reporting_basic.err_unreachable
+                    (Reporting.err_unreachable
                        l __POS__ ("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
@@ -930,7 +933,7 @@ let remove_vector_concat_pat pat =
           | _, _ ->
             (*if is_last then*) acc @ [wild Big_int.zero]
         else raise
-          (Reporting_basic.err_unreachable l __POS__
+          (Reporting.err_unreachable l __POS__
             ("remove_vector_concats: Non-vector in vector-concat pattern " ^
               string_of_typ (typ_of_annot annot))) in
 
@@ -1156,11 +1159,11 @@ let subst_id_exp exp (id1,id2) =
 
 let rec pat_to_exp ((P_aux (pat,(l,annot))) as p_aux) =
   let rewrap e = E_aux (e,(l,annot)) in
-  let env = pat_env_of p_aux in
-  let typ = pat_typ_of p_aux in
+  let env = env_of_pat p_aux in
+  let typ = typ_of_pat p_aux in
   match pat with
   | P_lit lit -> rewrap (E_lit lit)
-  | P_wild -> raise (Reporting_basic.err_unreachable l __POS__
+  | P_wild -> raise (Reporting.err_unreachable l __POS__
       "pat_to_exp given wildcard pattern")
   | P_or(pat1, pat2) -> (* todo: insert boolean or *) pat_to_exp pat1 
   | P_not(pat) -> (* todo: insert boolean not *) pat_to_exp pat
@@ -1170,7 +1173,7 @@ let rec pat_to_exp ((P_aux (pat,(l,annot))) as p_aux) =
   | 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))))
+      rewrap (E_record (List.map fpat_to_fexp fpats))
   | P_vector pats -> rewrap (E_vector (List.map pat_to_exp pats))
   | P_vector_concat pats -> begin
       let empty_vec = E_aux (E_vector [], (l,())) in
@@ -1248,7 +1251,7 @@ let rewrite_guarded_clauses l cs =
       | ((pat,guard,body,annot) as c) :: cs ->
           group_aux (remove_wildcards "g__" pat, [c], annot) [] cs
       | _ ->
-          raise (Reporting_basic.err_unreachable l __POS__
+          raise (Reporting.err_unreachable l __POS__
             "group given empty list in rewrite_guarded_clauses") in
     let add_group cs groups = (if_pexp (groups @ fallthrough) cs) :: groups in
     List.fold_right add_group groups []
@@ -1260,7 +1263,7 @@ let rewrite_guarded_clauses l cs =
         let (Pat_aux (_,annot)) = pexp in
         (pat, body, annot)
     | [] ->
-        raise (Reporting_basic.err_unreachable l __POS__
+        raise (Reporting.err_unreachable l __POS__
             "if_pexp given empty list in rewrite_guarded_clauses"))
   and if_exp fallthrough current_pat = (function
     | (pat,guard,body,annot) :: ((pat',guard',body',annot') as c') :: cs ->
@@ -1284,7 +1287,7 @@ let rewrite_guarded_clauses l cs =
               fix_eff_exp (annot_exp (E_if (exp,body,else_exp)) (fst annot) (env_of exp) (typ_of body))
           | _, _ -> body)
     | [] ->
-        raise (Reporting_basic.err_unreachable l __POS__
+        raise (Reporting.err_unreachable l __POS__
             "if_exp given empty list in rewrite_guarded_clauses")) in
   group [] cs
 
@@ -1322,7 +1325,7 @@ let contains_bitvector_pexp = function
 
 let remove_bitvector_pat (P_aux (_, (l, _)) as pat) =
 
-  let env = try pat_env_of pat with _ -> Env.empty in
+  let env = try env_of_pat pat with _ -> Env.empty in
 
   (* first introduce names for bitvector patterns *)
   let name_bitvector_roots =
@@ -1360,7 +1363,7 @@ let remove_bitvector_pat (P_aux (_, (l, _)) as pat) =
     } in
   let pat, env = bind_pat_no_guard env
     (strip_pat ((fold_pat name_bitvector_roots pat) false))
-    (pat_typ_of pat) in
+    (typ_of_pat pat) in
 
   (* Then collect guard expressions testing whether the literal bits of a
      bitvector pattern match those of a given bitvector, and collect let
@@ -1419,7 +1422,7 @@ let remove_bitvector_pat (P_aux (_, (l, _)) as pat) =
       let start_idx = match start with
       | Nexp_aux (Nexp_constant s, _) -> s
       | _ ->
-        raise (Reporting_basic.err_unreachable l __POS__
+        raise (Reporting.err_unreachable l __POS__
           "guard_bitvector_pat called on pattern with non-constant start index") in
       let add_bit_pat (idx, current, guards, dls) pat =
         let idx' =
@@ -1607,7 +1610,7 @@ let rewrite_defs_remove_numeral_pats =
     fold_pat { (compute_pat_alg None compose_guard_opt) with p_lit = p_lit outer_env } in
   let pat_aux (pexp_aux, a) =
     let pat,guard,exp,a = destruct_pexp (Pat_aux (pexp_aux, a)) in
-    let guard',pat = guard_pat (pat_env_of pat) pat in
+    let guard',pat = guard_pat (env_of_pat pat) pat in
     match compose_guard_opt guard guard' with
     | Some g -> Pat_aux (Pat_when (pat, g, exp), a)
     | None -> Pat_aux (Pat_exp (pat, exp), a) in
@@ -1725,17 +1728,18 @@ let rec rewrite_lexp_to_rhs ((LEXP_aux(lexp,((l,_) as annot))) as le) =
        let env = env_of_annot lannot in
        match Env.expand_synonyms env (typ_of_annot lannot) with
        | Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
-          let field_update exp = FES_aux (FES_Fexps ([FE_aux (FE_Fexp (id, exp), annot)], false), annot) in
-          (lhs, (fun exp -> rhs (E_aux (E_record_update (lexp_to_exp lexp, field_update exp), lannot))))
-       | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("Unsupported lexp: " ^ string_of_lexp le))
+          let field_update exp = FE_aux (FE_Fexp (id, exp), annot) in
+          (lhs, (fun exp -> rhs (E_aux (E_record_update (lexp_to_exp lexp, [field_update exp]), lannot))))
+       | _ -> raise (Reporting.err_unreachable l __POS__ ("Unsupported lexp: " ^ string_of_lexp le))
      end
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__ ("Unsupported lexp: " ^ string_of_lexp le))
+  | _ -> raise (Reporting.err_unreachable l __POS__ ("Unsupported lexp: " ^ string_of_lexp le))
 
 let updates_vars exp =
   let e_assign ((_, lexp), (u, exp)) =
     (u || lexp_is_local lexp (env_of exp), E_assign (lexp, exp)) in
   fst (fold_exp { (compute_exp_alg false (||)) with e_assign = e_assign } exp)
 
+
 (*Expects to be called after rewrite_defs; thus the following should not appear:
   internal_exp of any form
   lit vectors in patterns or expressions
@@ -1759,72 +1763,18 @@ let rewrite_exp_lift_assign_intro rewriters ((E_aux (exp,((l,_) as annot))) as f
          let effects = union_eff_exps exps' in
          let block = E_aux (E_block exps', (gen_loc l, mk_tannot env unit_typ effects)) in
          [fix_eff_exp (E_aux (E_var(le', e', block), annot))]
-      (*| ((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_var (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
-    check_exp (env_of full_exp)
-      (E_aux (E_block (List.map strip_exp (walker exps)), (l, ()))) (typ_of full_exp)
+    E_aux (E_block (walker exps), annot)
+
   | E_assign(le,e)
     when lexp_is_local_intro le (env_of full_exp) && not (lexp_is_effectful le) ->
     let (le', re') = rewrite_lexp_to_rhs le in
     let e' = re' (rewrite_base e) in
     let block = annot_exp (E_block []) (gen_loc l) (env_of full_exp) unit_typ in
-    check_exp (env_of full_exp)
-      (strip_exp (E_aux (E_var(le', e', block), annot))) (typ_of 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*)
+    E_aux (E_var (le', e', block), annot)
 
+  | _ -> rewrite_base full_exp
 
 let rewrite_defs_exp_lift_assign defs = rewrite_defs_base
     {rewrite_exp = rewrite_exp_lift_assign_intro;
@@ -1866,56 +1816,6 @@ let rewrite_register_ref_writes (Defs defs) =
     | [] -> [] in
   Defs (rewrite (write_reg_spec @ defs))
 
-  (* rewrite_defs_base { rewriters_base with rewrite_exp = rewrite_exp }
-    (Defs (write_reg_spec @ 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_var (lexp,exp,body) ->
-    rewrap (E_var (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*)
 
 (* Remove redundant return statements, and translate remaining ones into an
    (effectful) call to builtin function "early_return" (in the Lem shallow
@@ -2093,7 +1993,7 @@ let rewrite_defs_early_return (Defs defs) =
 
 let swaptyp typ (l,tannot) = match destruct_tannot tannot with
   | Some (env, typ', eff) -> (l, mk_tannot env typ eff)
-  | _ -> raise (Reporting_basic.err_unreachable l __POS__ "swaptyp called with empty type annotation")
+  | _ -> raise (Reporting.err_unreachable l __POS__ "swaptyp called with empty type annotation")
 
 let is_funcl_rec (FCL_aux (FCL_Funcl (id, pexp), _)) =
   let pat,guard,exp,pannot = destruct_pexp pexp in
@@ -2131,7 +2031,7 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
            let pat, guard, exp, annot = destruct_pexp pexp in
            match pat with
              | P_aux (P_app (constr_id, args), pannot) ->
-                let argstup_typ = tuple_typ (List.map pat_typ_of args) in
+                let argstup_typ = tuple_typ (List.map typ_of_pat args) in
                 let pannot' = swaptyp argstup_typ pannot in
                 let pat' =
                   match args with
@@ -2172,9 +2072,9 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
       let env, args_typ, ret_typ = match funcls with
         | FCL_aux (FCL_Funcl (_, pexp), _) :: _ ->
            let pat, _, exp, _ = destruct_pexp pexp in
-           env_of exp, pat_typ_of pat, typ_of exp
+           env_of exp, typ_of_pat pat, typ_of exp
         | _ ->
-           raise (Reporting_basic.err_unreachable l __POS__
+           raise (Reporting.err_unreachable l __POS__
              "rewrite_split_fun_constr_pats: empty auxiliary function")
       in
       let eff = List.fold_left
@@ -2196,7 +2096,7 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
         let quant_tyvars = List.fold_left KidSet.union KidSet.empty (List.map tyvars_of_quant_item qis) in
         let typ_tyvars = tyvars_of_typ fun_typ in
         let new_tyvars = KidSet.diff typ_tyvars quant_tyvars in
-        List.map (mk_qi_id BK_int) (KidSet.elements new_tyvars)
+        List.map (mk_qi_id K_int) (KidSet.elements new_tyvars)
       in
       let typquant = match typquant with
         | TypQ_aux (TypQ_tq qis, l) ->
@@ -2208,7 +2108,7 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
            in
            TypQ_aux (TypQ_tq qis, l)
         | _ ->
-           TypQ_aux (TypQ_tq (List.map (mk_qi_id BK_int) (KidSet.elements (tyvars_of_typ fun_typ))), l)
+           TypQ_aux (TypQ_tq (List.map (mk_qi_id K_int) (KidSet.elements (tyvars_of_typ fun_typ))), l)
       in
       let val_spec =
         VS_aux (VS_val_spec
@@ -2242,7 +2142,7 @@ let rewrite_fix_val_specs (Defs defs) =
        begin
          try Env.get_val_spec id env with
          | _ ->
-            raise (Reporting_basic.err_unreachable (Parse_ast.Unknown) __POS__
+            raise (Reporting.err_unreachable (Parse_ast.Unknown) __POS__
               ("No val spec found for " ^ string_of_id id))
        end
   in
@@ -2304,9 +2204,11 @@ let rewrite_fix_val_specs (Defs defs) =
     (* Repeat once to cross-propagate effects between clauses *)
     let (val_specs, funcls) = List.fold_left rewrite_funcl (val_specs, []) funcls in
     let recopt =
-      if List.exists is_funcl_rec funcls then
-        Rec_aux (Rec_rec, Parse_ast.Unknown)
-      else recopt
+      match recopt with
+      | Rec_aux ((Rec_rec | Rec_measure _), _) -> recopt
+      | _ when List.exists is_funcl_rec funcls ->
+         Rec_aux (Rec_rec, Parse_ast.Unknown)
+      | _ -> recopt
     in
     let tannotopt = match tannotopt, funcls with
     | Typ_annot_opt_aux (Typ_annot_opt_some (typq, typ), l),
@@ -2402,9 +2304,10 @@ let rewrite_constraint =
 let rewrite_type_union_typs rw_typ (Tu_aux (Tu_ty_id (typ, id), annot)) =
   Tu_aux (Tu_ty_id (rw_typ typ, id), annot)
 
-let rewrite_type_def_typs rw_typ rw_typquant rw_typschm (TD_aux (td, annot)) =
+let rewrite_type_def_typs rw_typ rw_typquant (TD_aux (td, annot)) =
   match td with
-  | TD_abbrev (id, nso, typschm) -> TD_aux (TD_abbrev (id, nso, rw_typschm typschm), annot)
+  | TD_abbrev (id, typq, A_aux (A_typ typ, l)) ->
+     TD_aux (TD_abbrev (id, rw_typquant typq, A_aux (A_typ (rw_typ typ), l)), annot)
   | TD_record (id, nso, typq, typ_ids, flag) ->
      TD_aux (TD_record (id, nso, rw_typquant typq, List.map (fun (typ, id) -> (rw_typ typ, id)) typ_ids, flag), annot)
   | TD_variant (id, nso, typq, tus, flag) ->
@@ -2456,8 +2359,8 @@ let rewrite_undefined_if_gen always_bitvector defs =
 let rec simple_typ (Typ_aux (typ_aux, l) as typ) = Typ_aux (simple_typ_aux typ_aux, l)
 and simple_typ_aux = function
   | Typ_id id -> Typ_id id
-  | Typ_app (id, [_; _; Typ_arg_aux (Typ_arg_typ typ, l)]) when Id.compare id (mk_id "vector") = 0 ->
-     Typ_app (mk_id "list", [Typ_arg_aux (Typ_arg_typ (simple_typ typ), l)])
+  | Typ_app (id, [_; _; A_aux (A_typ typ, l)]) when Id.compare id (mk_id "vector") = 0 ->
+     Typ_app (mk_id "list", [A_aux (A_typ (simple_typ typ), l)])
   | Typ_app (id, [_]) when Id.compare id (mk_id "atom") = 0 ->
      Typ_id (mk_id "int")
   | Typ_app (id, [_; _]) when Id.compare id (mk_id "range") = 0 ->
@@ -2467,9 +2370,9 @@ and simple_typ_aux = function
   | Typ_tup typs -> Typ_tup (List.map simple_typ typs)
   | Typ_exist (_, _, Typ_aux (typ, l)) -> simple_typ_aux typ
   | typ_aux -> typ_aux
-and simple_typ_arg (Typ_arg_aux (typ_arg_aux, l)) =
+and simple_typ_arg (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
-  | Typ_arg_typ typ -> [Typ_arg_aux (Typ_arg_typ (simple_typ typ), l)]
+  | A_typ typ -> [A_aux (A_typ (simple_typ typ), l)]
   | _ -> []
 
 (* This pass aims to remove all the Num quantifiers from the specification. *)
@@ -2498,7 +2401,7 @@ let rewrite_simple_types (Defs defs) =
   in
   let simple_def = function
     | DEF_spec vs -> DEF_spec (simple_vs vs)
-    | DEF_type td -> DEF_type (rewrite_type_def_typs simple_typ simple_typquant simple_typschm td)
+    | DEF_type td -> DEF_type (rewrite_type_def_typs simple_typ simple_typquant td)
     | DEF_reg_dec ds -> DEF_reg_dec (rewrite_dec_spec_typs simple_typ ds)
     | def -> def
   in
@@ -2570,7 +2473,7 @@ let rewrite_vector_concat_assignments defs =
          begin
            try check_exp env e_aux unit_typ with
            | Type_error (l, err) ->
-             raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err))
+             raise (Reporting.err_typ l (Type_error.string_of_type_error err))
          end
        else E_aux (e_aux, annot)
     | _ -> E_aux (e_aux, annot)
@@ -2591,12 +2494,15 @@ let rewrite_tuple_assignments defs =
        let (_, ids) = List.fold_left (fun (n, ids) _ -> (n + 1, ids @ [mk_id ("tup__" ^ string_of_int n)])) (0, []) lexps in
        let block_assign i lexp = mk_exp (E_assign (strip_lexp lexp, mk_exp (E_id (mk_id ("tup__" ^ string_of_int i))))) in
        let block = mk_exp (E_block (List.mapi block_assign lexps)) in
-       let letbind = mk_letbind (mk_pat (P_tup (List.map (fun id -> mk_pat (P_id id)) ids))) (strip_exp exp) in
+       let letbind = mk_letbind (mk_pat (P_typ (Type_check.typ_of exp,
+                                                mk_pat (P_tup (List.map (fun id -> mk_pat (P_id id)) ids)))))
+                                (strip_exp exp)
+       in
        let let_exp = mk_exp (E_let (letbind, block)) in
        begin
          try check_exp env let_exp unit_typ with
          | Type_error (l, err) ->
-           raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err))
+           raise (Reporting.err_typ l (Type_error.string_of_type_error err))
        end
     | _ -> E_aux (e_aux, annot)
   in
@@ -2641,7 +2547,7 @@ let rewrite_defs_remove_blocks =
   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
@@ -2672,7 +2578,7 @@ let letbind (v : 'a exp) (body : 'a exp -> 'a exp) : 'a exp =
      let body = body (annot_exp (E_id id) l env typ) in
      fix_eff_exp (annot_exp (E_let (lb, body)) l env (typ_of body))
   | None ->
-     raise (Reporting_basic.err_unreachable l __POS__ "no type information")
+     raise (Reporting.err_unreachable l __POS__ "no type information")
 
 
 let rec mapCont (f : 'b -> ('b -> 'a exp) -> 'a exp) (l : 'b list) (k : 'b list -> 'a exp) : 'a exp = 
@@ -2687,7 +2593,7 @@ let rewrite_defs_letbind_effects =
   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,_),_)) =
+  and value_fexps fexps =
     List.fold_left (fun b (FE_aux (FE_Fexp (_,e),_)) -> b && value e) true fexps in
 
 
@@ -2718,11 +2624,6 @@ let rewrite_defs_letbind_effects =
   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
@@ -2871,11 +2772,11 @@ let rewrite_defs_letbind_effects =
        n_exp_name exp2 (fun exp2 ->
        k (rewrap (E_cons (exp1,exp2)))))
     | E_record fexps ->
-       n_fexps fexps (fun fexps ->
+       n_fexpL fexps (fun fexps ->
        k (rewrap (E_record fexps)))
     | E_record_update (exp1,fexps) ->
        n_exp_name exp1 (fun exp1 ->
-       n_fexps fexps (fun fexps ->
+       n_fexpL fexps (fun fexps ->
        k (rewrap (E_record_update (exp1,fexps)))))
     | E_field (exp1,id) ->
        n_exp_name exp1 (fun exp1 ->
@@ -2968,7 +2869,7 @@ let rewrite_defs_internal_lets =
     | LEXP_id id -> P_aux (P_id id, annot)
     | LEXP_cast (typ, id) -> add_p_typ typ (P_aux (P_id id, annot))
     | LEXP_tup lexps -> P_aux (P_tup (List.map pat_of_local_lexp lexps), annot)
-    | _ -> raise (Reporting_basic.err_unreachable l __POS__ "unexpected local lexp") in
+    | _ -> raise (Reporting.err_unreachable l __POS__ "unexpected local lexp") in
 
   let e_let (lb,body) =
     match lb with
@@ -3032,13 +2933,13 @@ let rewrite_pexp_with_guards rewrite_pat (Pat_aux (pexp_aux, (annot: tannot anno
        | [] -> pexp
        | gs ->
           let unchecked_pexp = mk_pexp (Pat_when (strip_pat pat, List.map strip_exp gs |> fold_guards, strip_exp exp)) in
-          check_case (pat_env_of pat) (pat_typ_of pat) unchecked_pexp (typ_of exp)
+          check_case (env_of_pat pat) (typ_of_pat pat) unchecked_pexp (typ_of exp)
      end
   | Pat_when (pat, guard, exp) ->
      begin
        let pat = fold_pat { id_pat_alg with p_aux = rewrite_pat guards } pat in
        let unchecked_pexp = mk_pexp (Pat_when (strip_pat pat, List.map strip_exp !guards |> fold_guards, strip_exp exp)) in
-       check_case (pat_env_of pat) (pat_typ_of pat) unchecked_pexp (typ_of exp)
+       check_case (env_of_pat pat) (typ_of_pat pat) unchecked_pexp (typ_of exp)
      end
 
 
@@ -3077,7 +2978,7 @@ let rec bindings_of_pat (P_aux (p_aux, p_annot) as pat) =
   | P_record _ -> failwith "record patterns not yet implemented"
   (* we assume the type-checker has already checked the two sides have the same bindings *)
   | P_or (left, right) -> bindings_of_pat left
-  | P_as (p, id) -> [annot_pat (P_id id) unk (pat_env_of p) (pat_typ_of p)]
+  | P_as (p, id) -> [annot_pat (P_id id) unk (env_of_pat p) (typ_of_pat p)]
   | P_cons (left, right) -> bindings_of_pat left @ bindings_of_pat right
   (* todo: is this right for negated patterns? *)
   | P_not p
@@ -3093,11 +2994,11 @@ let rec bindings_of_pat (P_aux (p_aux, p_annot) as pat) =
 let rec binding_typs_of_pat (P_aux (p_aux, p_annot) as pat) =
   match p_aux with
   | P_lit _ | P_wild -> []
-  | P_id id -> [pat_typ_of pat]
+  | P_id id -> [typ_of_pat pat]
   | P_record _ -> failwith "record patterns not yet implemented"
   (* we assume the type-checker has already checked the two sides have the same bindings *)
   | P_or (left, right) -> binding_typs_of_pat left
-  | P_as (p, id) -> [pat_typ_of p]
+  | P_as (p, id) -> [typ_of_pat p]
   | P_cons (left, right) -> binding_typs_of_pat left @ binding_typs_of_pat right
   (* todo: is this right for negated patterns? *)
   | P_not p
@@ -3113,7 +3014,7 @@ let rec binding_typs_of_pat (P_aux (p_aux, p_annot) as pat) =
 let construct_toplevel_string_append_call env f_id bindings binding_typs guard expr =
   (* s# if match f#(s#) { Some (bindings) => guard, _ => false) } => let Some(bindings) = f#(s#) in expr *)
   let s_id = fresh_stringappend_id () in
-  let option_typ = app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (match binding_typs with
+  let option_typ = app_typ (mk_id "option") [A_aux (A_typ (match binding_typs with
                                                                          | [] -> unit_typ
                                                                          | [typ] -> typ
                                                                          | typs -> tuple_typ typs
@@ -3145,7 +3046,7 @@ let construct_toplevel_string_append_func env f_id pat =
                  else
                    bindings
   in
-  let option_typ = app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (match binding_typs with
+  let option_typ = app_typ (mk_id "option") [A_aux (A_typ (match binding_typs with
                                                                        | [] -> unit_typ
                                                                        | [typ] -> typ
                                                                        | typs -> tuple_typ typs
@@ -3205,7 +3106,7 @@ let construct_toplevel_string_append_func env f_id pat =
        in
        let mapping_inner_typ =
          match Env.get_val_spec (mk_id mapping_prefix_func) env with
-         | (_, Typ_aux (Typ_fn (_, Typ_aux (Typ_app (_, [Typ_arg_aux (Typ_arg_typ typ, _)]), _), _), _)) -> typ
+         | (_, Typ_aux (Typ_fn (_, Typ_aux (Typ_app (_, [A_aux (A_typ typ, _)]), _), _), _)) -> typ
          | _ -> typ_error Parse_ast.Unknown "mapping prefix func without correct function type?"
        in
 
@@ -3222,11 +3123,11 @@ let construct_toplevel_string_append_func env f_id pat =
                                         [annot_exp (E_id s_id) unk env string_typ]))
                         unk env mapping_inner_typ in
        (* construct some pattern -- Some (n#, len#) *)
-       let opt_typ = app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ mapping_inner_typ, unk)] in
+       let opt_typ = app_typ (mk_id "option") [A_aux (A_typ mapping_inner_typ, unk)] in
        let tup_arg_pat = match arg_pats with
          | [] -> assert false
          | [arg_pat] -> arg_pat
-         | arg_pats -> annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map pat_typ_of arg_pats))
+         | arg_pats -> annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map typ_of_pat arg_pats))
        in
 
        let some_pat = annot_pat (P_app (mk_id "Some",
@@ -3381,7 +3282,7 @@ let rec rewrite_defs_pat_string_append =
        in
        let mapping_inner_typ =
          match Env.get_val_spec (mk_id mapping_prefix_func) env with
-         | (_, Typ_aux (Typ_fn (_, Typ_aux (Typ_app (_, [Typ_arg_aux (Typ_arg_typ typ, _)]), _), _), _)) -> typ
+         | (_, Typ_aux (Typ_fn (_, Typ_aux (Typ_app (_, [A_aux (A_typ typ, _)]), _), _), _)) -> typ
          | _ -> typ_error Parse_ast.Unknown "mapping prefix func without correct function type?"
        in
 
@@ -3398,11 +3299,11 @@ let rec rewrite_defs_pat_string_append =
                                         [annot_exp (E_id s_id) unk env string_typ]))
                         unk env mapping_inner_typ in
        (* construct some pattern -- Some (n#, len#) *)
-       let opt_typ = app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ mapping_inner_typ, unk)] in
+       let opt_typ = app_typ (mk_id "option") [A_aux (A_typ mapping_inner_typ, unk)] in
        let tup_arg_pat = match arg_pats with
          | [] -> assert false
          | [arg_pat] -> arg_pat
-         | arg_pats -> annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map pat_typ_of arg_pats))
+         | arg_pats -> annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map typ_of_pat arg_pats))
        in
 
        let some_pat = annot_pat (P_app (mk_id "Some",
@@ -3450,13 +3351,13 @@ let rec rewrite_defs_pat_string_append =
          | [] -> assert false
          | [arg_pat] -> annot_letbind
                           (P_tup [arg_pat; annot_pat (P_id len_id) unk env nat_typ], new_binding)
-                          unk env (tuple_typ [pat_typ_of arg_pat; nat_typ])
+                          unk env (tuple_typ [typ_of_pat arg_pat; nat_typ])
          | arg_pats -> annot_letbind
                          (P_tup
-                            [annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map pat_typ_of arg_pats));
+                            [annot_pat (P_tup arg_pats) unk env (tuple_typ (List.map typ_of_pat arg_pats));
                              annot_pat (P_id len_id) unk env nat_typ],
                           new_binding)
-                         unk env (tuple_typ [tuple_typ (List.map pat_typ_of arg_pats); nat_typ])
+                         unk env (tuple_typ [tuple_typ (List.map typ_of_pat arg_pats); nat_typ])
        in
        let new_let = annot_exp (E_let (new_letbind, new_match)) unk env (typ_of expr) in
 
@@ -3562,7 +3463,7 @@ let rewrite_defs_mapping_patterns =
       expr_ref := e;
       p
     in
-    let env = pat_env_of pat in
+    let env = env_of_pat pat in
     match pat with
       (*
           mapping(args) if g => expr ----> s# if mapping_matches(s#)
@@ -3769,10 +3670,10 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
   let tuple_pat = function
     | [] -> annot_pat P_wild l env unit_typ
     | [pat] ->
-       let typ = pat_typ_of pat in
+       let typ = typ_of_pat pat in
        add_p_typ typ pat
     | pats ->
-       let typ = tuple_typ (List.map pat_typ_of pats) in
+       let typ = tuple_typ (List.map typ_of_pat pats) in
        add_p_typ typ (annot_pat (P_tup pats) l env typ) in
 
   let rec add_vars overwrite ((E_aux (expaux,annot)) as exp) vars =
@@ -3832,9 +3733,9 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
        in
        let exp4 = rewrite_var_updates (add_vars overwrite exp4 vars) in
        let ord_exp, kids, constr, lower, upper, lower_exp, upper_exp =
-         match destruct_numeric env (typ_of exp1), destruct_numeric env (typ_of exp2) with
+         match destruct_numeric (Env.expand_synonyms env (typ_of exp1)), destruct_numeric (Env.expand_synonyms env (typ_of exp2)) with
            | None, _ | _, None ->
-              raise (Reporting_basic.err_unreachable el __POS__ "Could not determine loop bounds")
+              raise (Reporting.err_unreachable el __POS__ "Could not determine loop bounds")
            | Some (kids1, constr1, n1), Some (kids2, constr2, n2) ->
               let kids = kids1 @ kids2 in
               let constr = nc_and constr1 constr2 in
@@ -3848,7 +3749,7 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
        (* Bind the loop variable in the body, annotated with constraints *)
        let lvar_kid = mk_kid ("loop_" ^ string_of_id id) in
        let lvar_nc = nc_and constr (nc_and (nc_lteq lower (nvar lvar_kid)) (nc_lteq (nvar lvar_kid) upper)) in
-       let lvar_typ = mk_typ (Typ_exist (lvar_kid :: kids, lvar_nc, atom_typ (nvar lvar_kid))) in
+       let lvar_typ = mk_typ (Typ_exist (List.map (mk_kopt K_int) (lvar_kid :: kids), lvar_nc, atom_typ (nvar lvar_kid))) in
        let lvar_pat = unaux_pat (add_p_typ lvar_typ (annot_pat (P_var (
          annot_pat (P_id id) el env (atom_typ (nvar lvar_kid)),
          TP_aux (TP_var lvar_kid, gen_loc el))) el env lvar_typ)) in
@@ -3940,7 +3841,7 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
              let pannot = (l, mk_tannot (env_of exp) (typ_of exp) (effect_of exp)) in
              Pat_aux (Pat_exp (pat, exp), pannot)
            | Pat_when _ ->
-             raise (Reporting_basic.err_unreachable l __POS__
+             raise (Reporting.err_unreachable l __POS__
                "Guarded patterns should have been rewritten already") in
          let ps = List.map rewrite_pexp ps in
          let expaux = if is_case then E_case (e1, ps) else E_try (e1, ps) in
@@ -3954,7 +3855,7 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          | Local (_, typ) ->
             add_p_typ typ (annot_pat (P_id id) pl env typ)
          | _ ->
-            raise (Reporting_basic.err_unreachable pl __POS__
+            raise (Reporting.err_unreachable pl __POS__
               ("Failed to look up type of variable " ^ string_of_id id)) in
        if effectful exp then
          Same_vars (E_aux (E_assign (lexp,vexp),annot))
@@ -4000,7 +3901,7 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
        | LEXP_aux (LEXP_cast (typ, id), _) ->
           unaux_pat (add_p_typ typ (annot_pat (P_id id) l env (typ_of v))), typ
        | _ ->
-         raise (Reporting_basic.err_unreachable l __POS__
+         raise (Reporting.err_unreachable l __POS__
            "E_var with a lexp that is not a variable") in
      let lb = fix_eff_lb (annot_letbind (paux, v) l env typ) in
      let exp = fix_eff_exp (annot_exp (E_let (lb, body)) l env (typ_of body)) in
@@ -4029,14 +3930,14 @@ 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, _)), _)]) ->
+    | Typ_app (Id_aux (Id "reg",_), [A_aux (A_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 (arg_typs, ret_typ, eff) -> Typ_fn (List.map rewrite_t arg_typs, rewrite_t ret_typ, 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)
+    | A_aux (A_typ t, a) -> A_aux (A_typ (rewrite_t t), a)
     | _ -> t_arg in
 
   let rec rewrite_annot (l, tannot) =
@@ -4081,6 +3982,56 @@ let rewrite_defs_remove_superfluous_letbinds =
     ; rewrite_defs = rewrite_defs_base
     }
 
+(* FIXME: We shouldn't allow nested not-patterns *)
+let rewrite_defs_not_pats =
+  let rewrite_pexp (pexp_aux, annot) =
+    let rewrite_pexp' pat exp orig_guard =
+      let guards = ref [] in
+      let not_counter = ref 0 in
+      let rewrite_not_pat (pat_aux, annot) =
+        match pat_aux with
+        | P_not pat ->
+           incr not_counter;
+           let np_id = mk_id ("np#" ^ string_of_int !not_counter) in
+           let guard =
+             mk_exp (E_case (mk_exp (E_id np_id),
+                             [mk_pexp (Pat_exp (strip_pat pat, mk_lit_exp L_false));
+                              mk_pexp (Pat_exp (mk_pat P_wild, mk_lit_exp L_true))]))
+           in
+           guards := (np_id, typ_of_annot annot, guard) :: !guards;
+           P_aux (P_id np_id, annot)
+
+        | _ -> P_aux (pat_aux, annot)
+       in
+       let pat = fold_pat { id_pat_alg with p_aux = rewrite_not_pat } pat in
+       begin match !guards with
+       | [] ->
+          Pat_aux (pexp_aux, annot)
+       | guards ->
+          let guard_exp =
+            match orig_guard, guards with
+            | Some guard, _ ->
+               List.fold_left (fun exp1 (_, _, exp2) -> mk_exp (E_app_infix (exp1, mk_id "&", exp2))) guard guards
+            | None, (_, _, guard) :: guards ->
+               List.fold_left (fun exp1 (_, _, exp2) -> mk_exp (E_app_infix (exp1, mk_id "&", exp2))) guard guards
+            | _ -> raise (Reporting.err_unreachable (fst annot) __POS__ "Case in not-pattern re-writing should be unreachable")
+          in
+          (* We need to construct an environment to check the match guard in *)
+          let env = env_of_pat pat in
+          let env = List.fold_left (fun env (np_id, np_typ, _) -> Env.add_local np_id (Immutable, np_typ) env) env guards in
+          let guard_exp = Type_check.check_exp env guard_exp bool_typ in
+          Pat_aux (Pat_when (pat, guard_exp, exp), annot)
+       end
+    in
+    match pexp_aux with
+    | Pat_exp (pat, exp) ->
+       rewrite_pexp' pat exp None
+    | Pat_when (pat, guard, exp) ->
+       rewrite_pexp' pat exp (Some (strip_exp guard))
+  in
+  let rw_exp = { id_exp_alg with pat_aux = rewrite_pexp } in
+  rewrite_defs_base { rewriters_base with rewrite_exp = (fun _ -> fold_exp rw_exp) }
+
 let rewrite_defs_remove_superfluous_returns =
 
   let add_opt_cast typopt1 typopt2 annot exp =
@@ -4202,7 +4153,7 @@ and fexps_of_mfpats mfpats flag annot =
   let fexp_of_mfpat (MFP_aux (MFP_mpat (id, mpat), annot)) =
     FE_aux (FE_Fexp (id, exp_of_mpat mpat), annot)
   in
-  FES_aux (FES_Fexps (List.map fexp_of_mfpat mfpats, flag), annot)
+  List.map fexp_of_mfpat mfpats
 
 and pat_of_mpat (MP_aux (mpat, annot)) =
   match mpat with
@@ -4331,7 +4282,8 @@ let rewrite_defs_realise_mappings (Defs defs) =
 
     let non_rec = (Rec_aux (Rec_nonrec, Parse_ast.Unknown)) in
     let effect_pure = (Effect_opt_aux (Effect_opt_pure, Parse_ast.Unknown)) in
-    let env = match mapcls with
+    (* We need to make sure we get the environment for the last mapping clause *)
+    let env = match List.rev mapcls with
       | MCL_aux (_, mapcl_annot) :: _ -> env_of_annot mapcl_annot
       | _ -> Type_check.typ_error l "mapping with no clauses?"
     in
@@ -4381,7 +4333,7 @@ let rewrite_defs_realise_mappings (Defs defs) =
     let prefix_wildcard = mk_pexp (Pat_exp (mk_pat P_wild, mk_exp (E_app (mk_id "None", [mk_exp (E_lit (mk_lit L_unit))])))) in
     let string_defs =
       begin if subtype_check env typ1 string_typ && subtype_check env string_typ typ1 then
-              let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+              let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
               let forwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq forwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
               let forwards_prefix_spec, env = Type_check.check_val_spec env forwards_prefix_spec in
               let forwards_prefix_match = mk_exp (E_case (arg_exp, ((List.map (fun mapcl -> strip_mapcl mapcl |> realise_prefix_mapcl true prefix_id) mapcls) |> List.flatten) @ [prefix_wildcard])) in
@@ -4391,7 +4343,7 @@ let rewrite_defs_realise_mappings (Defs defs) =
               forwards_prefix_spec @ forwards_prefix_fun
             else
               if subtype_check env typ2 string_typ && subtype_check env string_typ typ2 then
-                let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+                let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
                 let backwards_prefix_spec = VS_aux (VS_val_spec (mk_typschm typq backwards_prefix_typ, prefix_id, [], false), (Parse_ast.Unknown,())) in
                 let backwards_prefix_spec, env = Type_check.check_val_spec env backwards_prefix_spec in
                 let backwards_prefix_match = mk_exp (E_case (arg_exp, ((List.map (fun mapcl -> strip_mapcl mapcl |> realise_prefix_mapcl false prefix_id) mapcls) |> List.flatten) @ [prefix_wildcard])) in
@@ -4553,7 +4505,7 @@ let rec remove_clause_from_pattern ctx (P_aux (rm_pat,ann)) res_pat =
     in aux [] res_pats res_pats'
   in
   let inconsistent () =
-    raise (Reporting_basic.err_unreachable (fst ann) __POS__
+    raise (Reporting.err_unreachable (fst ann) __POS__
              ("Inconsistency during exhaustiveness analysis with " ^
                  string_of_rp res_pat))
   in
@@ -4637,12 +4589,12 @@ let rec remove_clause_from_pattern ctx (P_aux (rm_pat,ann)) res_pat =
         rp' @ List.map (function [rp1;rp2] -> RP_cons (rp1,rp2) | _ -> assert false) res_pats
   end
   | P_record _ ->
-     raise (Reporting_basic.err_unreachable (fst ann) __POS__
+     raise (Reporting.err_unreachable (fst ann) __POS__
               "Record pattern not supported")
   | P_vector _
   | P_vector_concat _
   | P_string_append _ ->
-     raise (Reporting_basic.err_unreachable (fst ann) __POS__
+     raise (Reporting.err_unreachable (fst ann) __POS__
               "Found pattern that should have been rewritten away in earlier stage")
 
   (*in let _ = printprefix := String.sub (!printprefix) 0 (String.length !printprefix - 2)
@@ -4658,7 +4610,7 @@ let process_pexp env =
   | Pat_aux (Pat_exp (p,_),_) -> 
      List.concat (List.map (remove_clause_from_pattern ctx p) rps)
   | Pat_aux (Pat_when _,(l,_)) ->
-     raise (Reporting_basic.err_unreachable l __POS__
+     raise (Reporting.err_unreachable l __POS__
               "Guarded pattern should have been rewritten away")
 
 (* We do some minimal redundancy checking to remove bogus wildcard patterns here *)
@@ -4666,7 +4618,7 @@ let check_cases process is_wild loc_of cases =
   let rec aux rps acc = function
     | [] -> acc, rps
     | [p] when is_wild p && match rps with [] -> true | _ -> false ->
-      let () = Reporting_basic.print_err false false
+      let () = Reporting.print_err false false
         (loc_of p) "Match checking" "Redundant wildcard clause" in
       acc, []
     | h::t -> aux (process rps h) (h::acc) t
@@ -4706,7 +4658,7 @@ let rewrite_case (e,ann) =
 
         let _ =
           if !opt_coq_warn_nonexhaustive
-          then Reporting_basic.print_err false false
+          then Reporting.print_err false false
             (fst ann) "Non-exhaustive matching" ("Example: " ^ string_of_rp example) in
 
         let l = Parse_ast.Generated Parse_ast.Unknown in
@@ -4726,7 +4678,7 @@ let rewrite_case (e,ann) =
      | (example::_) ->
         let _ =
           if !opt_coq_warn_nonexhaustive
-          then Reporting_basic.print_err false false
+          then Reporting.print_err false false
             (fst ann) "Non-exhaustive let" ("Example: " ^ string_of_rp example) in
         let l = Parse_ast.Generated Parse_ast.Unknown in
         let p = P_aux (P_wild, (l, empty_tannot)) in
@@ -4742,7 +4694,7 @@ let rewrite_fun rewriters (FD_aux (FD_function (r,t,e,fcls),f_ann)) =
   let id,fcl_ann =
     match fcls with
     | FCL_aux (FCL_Funcl (id,_),ann) :: _ -> id,ann
-    | [] -> raise (Reporting_basic.err_unreachable (fst f_ann) __POS__
+    | [] -> raise (Reporting.err_unreachable (fst f_ann) __POS__
                  "Empty function")
   in
   let env = env_of_annot fcl_ann in
@@ -4756,7 +4708,7 @@ let rewrite_fun rewriters (FD_aux (FD_function (r,t,e,fcls),f_ann)) =
   | (example::_) ->
      let _ =
        if !opt_coq_warn_nonexhaustive
-       then Reporting_basic.print_err false false
+       then Reporting.print_err false false
               (fst f_ann) "Non-exhaustive matching" ("Example: " ^ string_of_rp example) in
 
      let l = Parse_ast.Generated Parse_ast.Unknown in
@@ -4801,7 +4753,7 @@ let minimise_recursive_functions (Defs defs) =
   let rewrite_function (FD_aux (FD_function (recopt,topt,effopt,funcls),ann) as fd) =
     match recopt with
     | Rec_aux (Rec_nonrec, _) -> fd
-    | Rec_aux (Rec_rec, l) ->
+    | Rec_aux ((Rec_rec | Rec_measure _), l) ->
        if List.exists funcl_is_rec funcls
        then fd
        else FD_aux (FD_function (Rec_aux (Rec_nonrec, Generated l),topt,effopt,funcls),ann)
@@ -4811,7 +4763,150 @@ let minimise_recursive_functions (Defs defs) =
     | d -> d
   in Defs (List.map rewrite_def defs)
 
+(* Make recursive functions with a measure use the measure as an
+   explicit recursion limit, enforced by an assertion. *)
+let rewrite_explicit_measure (Defs defs) =
+  let scan_function measures = function
+    | FD_aux (FD_function (Rec_aux (Rec_measure (mpat,mexp),rl),topt,effopt,
+                           FCL_aux (FCL_Funcl (id,_),_)::_),ann) ->
+       Bindings.add id (mpat,mexp) measures
+    | _ -> measures
+  in
+  let scan_def measures = function
+    | DEF_fundef fd -> scan_function measures fd
+    | _ -> measures
+  in
+  let measures = List.fold_left scan_def Bindings.empty defs in
+  let add_escape eff =
+    union_effects eff (mk_effect [BE_escape])
+  in
+  (* NB: the Coq backend relies on recognising the #rec# prefix *)
+  let rec_id = function
+    | Id_aux (Id id,l)
+    | Id_aux (DeIid id,l) -> Id_aux (Id ("#rec#" ^ id),Generated l)
+  in
+  let limit = mk_id "#reclimit" in
+  (* Add helper function with extra argument to spec *)
+  let rewrite_spec (VS_aux (VS_val_spec (typsch,id,extern,flag),ann) as vs) =
+    match Bindings.find id measures with
+    | _ -> begin
+       match typsch with
+       | TypSchm_aux (TypSchm_ts (tq,
+           Typ_aux (Typ_fn (args,res,eff),typl)),tsl) ->
+          [VS_aux (VS_val_spec (
+             TypSchm_aux (TypSchm_ts (tq,
+               Typ_aux (Typ_fn (args@[int_typ],res,add_escape eff),typl)),tsl)
+                     ,rec_id id,extern,flag),ann);
+           VS_aux (VS_val_spec (
+             TypSchm_aux (TypSchm_ts (tq,
+               Typ_aux (Typ_fn (args,res,add_escape eff),typl)),tsl)
+                     ,id,extern,flag),ann)]
+       | _ -> [vs] (* TODO warn *)
+      end
+    | exception Not_found -> [vs]
+  in
+  (* Add extra argument and assertion to each funcl, and rewrite recursive calls *)
+  let rewrite_funcl (FCL_aux (FCL_Funcl (id,pexp),ann) as fcl) =
+    let loc = Parse_ast.Generated (fst ann) in
+    let P_aux (pat,pann),guard,body,ann = destruct_pexp pexp in
+    let extra_pat = P_aux (P_id limit,(loc,empty_tannot)) in
+    let pat = match pat with
+      | P_tup pats -> P_tup (pats@[extra_pat])
+      | p -> P_tup [P_aux (p,pann);extra_pat]
+    in
+    let assert_exp =
+      E_aux (E_assert
+         (E_aux (E_app (mk_id "gteq_int",
+           [E_aux (E_id limit,(loc,empty_tannot));
+            E_aux (E_lit (L_aux (L_num Big_int.zero,loc)),(loc,empty_tannot))]),
+           (loc,empty_tannot)),
+          (E_aux (E_lit (L_aux (L_string "recursion limit reached",loc)),(loc,empty_tannot)))),
+              (loc,empty_tannot))
+    in
+    let tick =
+      E_aux (E_app (mk_id "sub_int",
+        [E_aux (E_id limit,(loc,empty_tannot));
+         E_aux (E_lit (L_aux (L_num (Big_int.of_int 1),loc)),(loc,empty_tannot))]),
+             (loc,empty_tannot))
+    in
+    let open Rewriter in
+    let body =
+      fold_exp { id_exp_alg with
+          e_app = (fun (f,args) ->
+          if Id.compare f id == 0
+          then E_app (rec_id id, args@[tick])
+          else E_app (f, args))
+        } body
+    in
+    let body = E_aux (E_block [assert_exp; body],(loc,empty_tannot)) in
+    FCL_aux (FCL_Funcl (rec_id id, construct_pexp (P_aux (pat,pann),guard,body,ann)),ann)
+  in
+  let rewrite_function (FD_aux (FD_function (r,t,e,fcls),ann) as fd) =
+    let loc = Parse_ast.Generated (fst ann) in
+    match fcls with
+    | FCL_aux (FCL_Funcl (id,_),fcl_ann)::_ -> begin
+        match Bindings.find id measures with
+        | (measure_pat, measure_exp) ->
+           let e = match e with
+             | Effect_opt_aux (Effect_opt_pure, _) ->
+                Effect_opt_aux (Effect_opt_effect (mk_effect [BE_escape]), loc)
+             | Effect_opt_aux (Effect_opt_effect eff,_) ->
+                Effect_opt_aux (Effect_opt_effect (add_escape eff), loc)
+           in
+           let arg_typs = match Env.get_val_spec id (env_of_annot fcl_ann) with
+             | _, Typ_aux (Typ_fn (args,_,_),_) -> args
+             | _, _ -> raise (Reporting.err_unreachable (fst ann) __POS__
+                            "Function doesn't have function type")
+           in
+           let measure_pats = match arg_typs, measure_pat with
+             | [_], _ -> [measure_pat]
+             | _, P_aux (P_tup ps,_) -> ps
+             | _, _ -> [measure_pat]
+           in
+           let mk_wrap i (P_aux (p,(l,_))) =
+             let id =
+               match p with
+               | P_id id
+               | P_typ (_,(P_aux (P_id id,_))) -> id
+               | P_wild
+               | P_typ (_,(P_aux (P_wild,_))) ->
+                  mk_id ("_arg" ^ string_of_int i)
+               | _ -> raise (Reporting.err_todo l "Measure patterns can only be identifiers or wildcards")
+             in
+             P_aux (P_id id,(loc,empty_tannot)),
+             E_aux (E_id id,(loc,empty_tannot))
+           in
+           let wpats,wexps = List.split (Util.list_mapi mk_wrap measure_pats) in
+           let wpat = match wpats with
+             | [wpat] -> wpat
+             | _ -> P_aux (P_tup wpats,(loc,empty_tannot))
+           in
+           let wbody = E_aux (E_app (rec_id id,wexps@[measure_exp]),(loc,empty_tannot)) in
+           let wrapper =
+             FCL_aux (FCL_Funcl (id, Pat_aux (Pat_exp (wpat,wbody),(loc,empty_tannot))),(loc,empty_tannot))
+           in
+           let new_rec =
+             Rec_aux (Rec_measure (P_aux (P_tup (List.map (fun _ -> P_aux (P_wild,(loc,empty_tannot))) measure_pats @ [P_aux (P_id limit,(loc,empty_tannot))]),(loc,empty_tannot)), E_aux (E_id limit, (loc,empty_tannot))), loc)
+           in
+           [FD_aux (FD_function (new_rec,t,e,List.map rewrite_funcl fcls),ann);
+            FD_aux (FD_function (Rec_aux (Rec_nonrec,loc),t,e,[wrapper]),ann)]
+        | exception Not_found -> [fd]
+      end
+    | _ -> [fd]
+  in
+  let rewrite_def = function
+    | DEF_spec vs -> List.map (fun vs -> DEF_spec vs) (rewrite_spec vs)
+    | DEF_fundef fd -> List.map (fun f -> DEF_fundef f) (rewrite_function fd)
+    | d -> [d]
+  in
+  Defs (List.flatten (List.map rewrite_def defs))
+
 let recheck_defs defs = fst (Type_error.check initial_env defs)
+let recheck_defs_without_effects defs =
+  let () = opt_no_effects := true in
+  let result,_ = Type_error.check initial_env defs in
+  let () = opt_no_effects := false in
+  result
 
 let remove_mapping_valspecs (Defs defs) =
   let allowed_def def =
@@ -4872,6 +4967,7 @@ let rewrite_defs_lem = [
   ("recheck_defs", if_mono recheck_defs);
   ("rewrite_undefined", rewrite_undefined_if_gen false);
   ("rewrite_defs_vector_string_pats_to_bit_list", rewrite_defs_vector_string_pats_to_bit_list);
+  ("remove_not_pats", rewrite_defs_not_pats);
   ("pat_lits", rewrite_defs_pat_lits rewrite_lit_lem);
   ("vector_concat_assignments", rewrite_vector_concat_assignments);
   ("tuple_assignments", rewrite_tuple_assignments);
@@ -4914,6 +5010,7 @@ let rewrite_defs_coq = [
   ("mapping_builtins", rewrite_defs_mapping_patterns);
   ("rewrite_undefined", rewrite_undefined_if_gen true);
   ("rewrite_defs_vector_string_pats_to_bit_list", rewrite_defs_vector_string_pats_to_bit_list);
+  ("remove_not_pats", rewrite_defs_not_pats);
   ("pat_lits", rewrite_defs_pat_lits rewrite_lit_lem);
   ("vector_concat_assignments", rewrite_vector_concat_assignments);
   ("tuple_assignments", rewrite_tuple_assignments);
@@ -4937,8 +5034,9 @@ let rewrite_defs_coq = [
   ("sizeof", rewrite_sizeof);
   ("early_return", rewrite_defs_early_return);
   ("make_cases_exhaustive", MakeExhaustive.rewrite);
+  ("rewrite_explicit_measure", rewrite_explicit_measure);
+  ("recheck_defs_without_effects", recheck_defs_without_effects);
   ("fix_val_specs", rewrite_fix_val_specs);
-  ("recheck_defs", recheck_defs);
   ("remove_blocks", rewrite_defs_remove_blocks);
   ("letbind_effects", rewrite_defs_letbind_effects);
   ("remove_e_assign", rewrite_defs_remove_e_assign);
@@ -4962,6 +5060,7 @@ let rewrite_defs_ocaml = [
   ("vector_concat_assignments", rewrite_vector_concat_assignments);
   ("tuple_assignments", rewrite_tuple_assignments);
   ("simple_assignments", rewrite_simple_assignments);
+  ("remove_not_pats", rewrite_defs_not_pats);
   ("remove_vector_concat", rewrite_defs_remove_vector_concat);
   ("remove_bitvector_pats", rewrite_defs_remove_bitvector_pats);
   ("remove_numeral_pats", rewrite_defs_remove_numeral_pats);
@@ -4983,6 +5082,7 @@ let rewrite_defs_c = [
   ("mapping_builtins", rewrite_defs_mapping_patterns);
   ("rewrite_undefined", rewrite_undefined_if_gen false);
   ("rewrite_defs_vector_string_pats_to_bit_list", rewrite_defs_vector_string_pats_to_bit_list);
+  ("remove_not_pats", rewrite_defs_not_pats);
   ("pat_lits", rewrite_defs_pat_lits (fun _ -> true));
   ("vector_concat_assignments", rewrite_vector_concat_assignments);
   ("tuple_assignments", rewrite_tuple_assignments);
@@ -5021,16 +5121,16 @@ let rewrite_check_annot =
       let typ1 = typ_of exp in
       let typ2 = Env.expand_synonyms (env_of exp) (typ_of exp) in
       (if not (alpha_equivalent (env_of exp) typ1 typ2)
-       then raise (Reporting_basic.err_typ Parse_ast.Unknown
+       then raise (Reporting.err_typ Parse_ast.Unknown
                     ("Found synonym in annotation " ^ string_of_typ typ1 ^ " vs " ^ string_of_typ typ2))
        else ());
       exp
     with
-      Type_error (l, err) -> raise (Reporting_basic.err_typ l (Type_error.string_of_type_error err))
+      Type_error (l, err) -> raise (Reporting.err_typ l (Type_error.string_of_type_error err))
   in
   let check_pat pat =
-    prerr_endline ("CHECKING PAT: " ^ string_of_pat pat ^ " : " ^ string_of_typ (pat_typ_of pat));
-    let _, _ = bind_pat_no_guard (pat_env_of pat) (strip_pat pat) (pat_typ_of pat) in
+    prerr_endline ("CHECKING PAT: " ^ string_of_pat pat ^ " : " ^ string_of_typ (typ_of_pat pat));
+    let _, _ = bind_pat_no_guard (env_of_pat pat) (strip_pat pat) (typ_of_pat pat) in
     pat
   in
 
diff --git a/src/sail.ml b/src/sail.ml
index 5deaa340..9f2c7310 100644
--- a/src/sail.ml
+++ b/src/sail.ml
@@ -64,6 +64,7 @@ let opt_print_ocaml = ref false
 let opt_print_c = ref false
 let opt_print_latex = ref false
 let opt_print_coq = ref false
+let opt_print_cgen = ref false
 let opt_memo_z3 = ref false
 let opt_sanity = ref false
 let opt_includes_c = ref ([]:string list)
@@ -110,7 +111,7 @@ let options = Arg.align ([
     Arg.String (fun s -> opt_ocaml_generators := s::!opt_ocaml_generators),
     "<types> produce random generators for the given types");
   ( "-latex",
-    Arg.Set opt_print_latex,
+    Arg.Tuple [Arg.Set opt_print_latex; Arg.Clear Type_check.opt_expand_valspec ],
     " pretty print the input to latex");
   ( "-marshal",
     Arg.Set opt_marshal_defs,
@@ -132,17 +133,24 @@ let options = Arg.align ([
                Arg.Set C_backend.optimize_hoist_allocations;
                Arg.Set Initial_check.opt_fast_undefined;
                Arg.Set Type_check.opt_no_effects;
-               Arg.Set C_backend.optimize_struct_updates ],
+               Arg.Set C_backend.optimize_struct_updates;
+               Arg.Set C_backend.optimize_alias],
     " turn on optimizations for C compilation");
   ( "-Oconstant_fold",
     Arg.Set Constant_fold.optimize_constant_fold,
     " Apply constant folding optimizations");
+  ( "-Oexperimental",
+    Arg.Set C_backend.optimize_experimental,
+    " turn on additional, experimental optimisations");
   ( "-static",
     Arg.Set C_backend.opt_static,
     " Make generated C functions static");
   ( "-trace",
     Arg.Tuple [Arg.Set C_backend.opt_trace; Arg.Set Ocaml_backend.opt_trace_ocaml],
     " Instrument ouput with tracing");
+  ( "-cgen",
+    Arg.Set opt_print_cgen,
+    " Generate CGEN source");
   ( "-lem",
     Arg.Set opt_print_lem,
     " output a Lem translated version of the input");
@@ -171,7 +179,7 @@ let options = Arg.align ([
     Arg.String (fun f -> Pretty_print_coq.opt_debug_on := f::!Pretty_print_coq.opt_debug_on),
     "<function> produce debug messages for Coq output on given function");
   ( "-latex_prefix",
-    Arg.String (fun prefix -> Latex.opt_prefix_latex := prefix),
+    Arg.String (fun prefix -> Latex.opt_prefix := prefix),
     " set a custom prefix for generated latex command (default sail)");
   ( "-mono_split",
     Arg.String (fun s ->
@@ -190,6 +198,9 @@ let options = Arg.align ([
   ( "-enum_casts",
     Arg.Set Initial_check.opt_enum_casts,
     " allow enumerations to be automatically casted to numeric range types");
+  ( "-non_lexical_flow",
+    Arg.Set Nl_flow.opt_nl_flow,
+    " allow non-lexical flow typing");
   ( "-no_lexp_bounds_check",
     Arg.Set Type_check.opt_no_lexp_bounds_check,
     " turn off bounds checking for vector assignments in l-expressions");
@@ -227,7 +238,7 @@ let options = Arg.align ([
     Arg.String (fun l -> opt_ddump_rewrite_ast := Some (l, 0)),
     "<prefix> (debug) dump the ast after each rewriting step to <prefix>_<i>.lem");
   ( "-ddump_flow_graphs",
-    Arg.Set C_backend.opt_ddump_flow_graphs,
+    Arg.Set C_backend.opt_debug_flow_graphs,
     " (debug) dump flow analysis for Sail functions when compiling to C");
   ( "-dtc_verbose",
     Arg.Int (fun verbosity -> Type_check.opt_tc_debug := verbosity),
@@ -241,9 +252,12 @@ let options = Arg.align ([
   ( "-dmagic_hash",
     Arg.Set Initial_check.opt_magic_hash,
     " (debug) allow special character # in identifiers");
-  ( "-Xconstraint_synonyms",
-    Arg.Set Type_check.opt_constraint_synonyms,
-    " (extension) allow constraint synonyms");
+  ( "-dfunction",
+    Arg.String (fun f -> C_backend.opt_debug_function := f),
+    " (debug) print debugging output for a single function");
+  ( "-dprofile",
+    Arg.Set Profile.opt_profile,
+    " (debug) provides basic profiling information for rewriting passes within Sail");
   ( "-v",
     Arg.Set opt_print_version,
     " print version");
@@ -266,15 +280,20 @@ let interactive_env = ref Type_check.initial_env
 let load_files type_envs files =
   if !opt_memo_z3 then Constraint.load_digests () else ();
 
+  let t = Profile.start () in
   let parsed = List.map (fun f -> (f, parse_file f)) files in
   let ast =
     List.fold_right (fun (_, Parse_ast.Defs ast_nodes) (Parse_ast.Defs later_nodes)
                      -> Parse_ast.Defs (ast_nodes@later_nodes)) parsed (Parse_ast.Defs []) in
   let ast = Process_file.preprocess_ast options ast in
   let ast = convert_ast Ast_util.inc_ord ast in
+  Profile.finish "parsing" t;
 
+  let t = Profile.start () in
   let (ast, type_envs) = check_ast type_envs ast in
+  Profile.finish "type checking" t;
 
+  let ast = Scattered.descatter ast in
   let ast = rewrite_ast type_envs ast in
 
   let out_name = match !opt_file_out with
@@ -344,6 +363,9 @@ let main() =
          Util.opt_warnings := true;
          C_backend.compile_ast (C_backend.initial_ctx type_envs) (!opt_includes_c) ast_c
        else ());
+      (if !(opt_print_cgen)
+       then Cgen_backend.output type_envs ast
+       else ());
       (if !(opt_print_lem)
        then
          let mwords = !Pretty_print_lem.opt_mwords in
@@ -360,15 +382,19 @@ let main() =
       (if !(opt_print_latex)
        then
          begin
+           Util.opt_warnings := true;
            let latex_dir = match !opt_file_out with None -> "sail_latex" | Some s -> s in
-           try
-             if not (Sys.is_directory latex_dir) then begin
-                 prerr_endline ("Failure: latex output directory exists but is not a directory: " ^ latex_dir);
-                 exit 1
-               end
-           with Sys_error(_) -> Unix.mkdir latex_dir 0o755;
+           begin
+             try
+               if not (Sys.is_directory latex_dir) then begin
+                   prerr_endline ("Failure: latex output directory exists but is not a directory: " ^ latex_dir);
+                   exit 1
+                 end
+             with Sys_error(_) -> Unix.mkdir latex_dir 0o755
+           end;
+           Latex.opt_directory := latex_dir;
            let chan = open_out (Filename.concat latex_dir "commands.tex") in
-           output_string chan (Pretty_print_sail.to_string (Latex.latex_defs latex_dir ast));
+           output_string chan (Pretty_print_sail.to_string (Latex.defs ast));
            close_out chan
          end
        else ());
@@ -389,6 +415,6 @@ let main() =
 let _ =  try
     begin
       try ignore(main ())
-      with  Failure(s) -> raise (Reporting_basic.err_general Parse_ast.Unknown ("Failure "^s))
+      with  Failure(s) -> raise (Reporting.err_general Parse_ast.Unknown ("Failure "^s))
     end
-  with Reporting_basic.Fatal_error e -> Reporting_basic.report_error e
+  with Reporting.Fatal_error e -> Reporting.report_error e
diff --git a/src/sail_lib.ml b/src/sail_lib.ml
index a718e6d5..c0bf80fa 100644
--- a/src/sail_lib.ml
+++ b/src/sail_lib.ml
@@ -160,6 +160,8 @@ let update_subrange (xs, n, m, ys) =
 
 let vector_truncate (xs, n) = List.rev (take (Big_int.to_int n) (List.rev xs))
 
+let vector_truncateLSB (xs, n) = take (Big_int.to_int n) xs
+
 let length xs = Big_int.of_int (List.length xs)
 
 let big_int_of_bit = function
@@ -359,6 +361,14 @@ let int_of_bit = function
   | B0 -> 0
   | B1 -> 1
 
+let bool_of_bit = function
+  | B0 -> false
+  | B1 -> true
+
+let bit_of_bool = function
+  | false -> B0
+  | true -> B1
+
 let bigint_of_bit b = Big_int.of_int (int_of_bit b)
 
 let string_of_hex = function
@@ -578,20 +588,49 @@ let gteq_real (x, y) = Rational.geq x y
 let to_real x = Rational.of_int (Big_int.to_int x) (* FIXME *)
 let negate_real x = Rational.neg x
 
-let print_real (str, r) = print_string "REAL\n"
-let prerr_real (str, r) = prerr_string "REAL\n"
+let string_of_real x =
+  if Big_int.equal (Rational.den x) (Big_int.of_int 1) then
+    Big_int.to_string (Rational.num x)
+  else
+    Big_int.to_string (Rational.num x) ^ "/" ^ Big_int.to_string (Rational.den x)
+
+let print_real (str, r) = print_endline (str ^ string_of_real r)
+let prerr_real (str, r) = prerr_endline (str ^ string_of_real r)
 
-let round_down x = Rational.floor x (* Num.big_int_of_num (Num.floor_num x) *)
-let round_up x = Rational.ceiling x (* Num.big_int_of_num (Num.ceiling_num x) *)
+let round_down x = Rational.floor x
+let round_up x = Rational.ceiling x
 let quotient_real (x, y) = Rational.div x y
-let mult_real (x, y) = Rational.mul x y (* Num.mult_num x y *)
-let real_power (x, y) = failwith "real_power" (* Num.power_num x (Num.num_of_big_int y) *)
+let div_real (x, y) = Rational.div x y
+let mult_real (x, y) = Rational.mul x y
+let real_power (x, y) = failwith "real_power"
 let int_power (x, y) = Big_int.pow_int x (Big_int.to_int y)
 let add_real (x, y) = Rational.add x y
 let sub_real (x, y) = Rational.sub x y
 
 let abs_real x = Rational.abs x
 
+let sqrt_real x =
+  let precision = 30 in
+  let s = Big_int.sqrt (Rational.num x) in
+  if Big_int.equal (Rational.den x) (Big_int.of_int 1) && Big_int.equal (Big_int.mul s s) (Rational.num x) then
+    to_real s
+  else
+    let p = ref (to_real (Big_int.sqrt (Big_int.div (Rational.num x) (Rational.den x)))) in
+    let n = ref (Rational.of_int 0) in
+    let convergence = ref (Rational.div (Rational.of_int 1) (Rational.of_big_int (Big_int.pow_int_positive 10 precision))) in
+    let quit_loop = ref false in
+    while not !quit_loop do
+      n := Rational.div (Rational.add !p (Rational.div x !p)) (Rational.of_int 2);
+
+      if Rational.lt (Rational.abs (Rational.sub !p !n)) !convergence then
+        quit_loop := true
+      else
+        p := !n
+    done;
+    !n
+
+let random_real () = Rational.div (Rational.of_int (Random.bits ())) (Rational.of_int (Random.bits()))
+
 let lt (x, y) = Big_int.less x y
 let gt (x, y) = Big_int.greater x y
 let lteq (x, y) = Big_int.less_equal x y
@@ -620,9 +659,6 @@ let real_of_string str =
   | [whole] -> Rational.of_int (int_of_string str)
   | _ -> failwith "invalid real literal"
 
-(* Not a very good sqrt implementation *)
-let sqrt_real x = failwith "sqrt_real" (* real_of_string (string_of_float (sqrt (Num.float_of_num x))) *)
-
 let print str = Pervasives.print_string str
 
 let prerr str = Pervasives.prerr_string str
@@ -1112,7 +1148,7 @@ let rand_zvector (g : 'generators) (size : int) (order : bool) (elem_gen : 'gene
   Util.list_init size (fun _ -> elem_gen g)
 
 let rand_zbit (g : 'generators) : bit =
-  if Random.bool() then B0 else B1
+  bit_of_bool (Random.bool())
 
 let rand_zbool (g : 'generators) : bool =
   Random.bool()
diff --git a/src/scattered.ml b/src/scattered.ml
new file mode 100644
index 00000000..be304dc8
--- /dev/null
+++ b/src/scattered.ml
@@ -0,0 +1,141 @@
+(**************************************************************************)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(**************************************************************************)
+
+open Ast
+open Ast_util
+
+let funcl_id (FCL_aux (FCL_Funcl (id, _), _)) = id
+
+let rec last_scattered_funcl id = function
+  | DEF_scattered (SD_aux (SD_funcl funcl, _)) :: _
+       when Id.compare (funcl_id funcl) id = 0 -> false
+  | _ :: defs -> last_scattered_funcl id defs
+  | [] -> true
+
+let rec last_scattered_mapcl id = function
+  | DEF_scattered (SD_aux (SD_mapcl (mid, _), _)) :: _
+       when Id.compare mid id = 0 -> false
+  | _ :: defs -> last_scattered_mapcl id defs
+  | [] -> true
+
+(* Nothing cares about these and the AST should be changed *)
+let fake_effect_opt l = Effect_opt_aux (Effect_opt_pure, gen_loc l)
+let fake_rec_opt l = Rec_aux (Rec_rec, gen_loc l)
+
+let no_tannot_opt l = Typ_annot_opt_aux (Typ_annot_opt_none, gen_loc l)
+
+let rec get_union_clauses id = function
+  | DEF_scattered (SD_aux (SD_unioncl (uid, tu), _)) :: defs when Id.compare id uid = 0 ->
+     tu :: get_union_clauses id defs
+  | def :: defs ->
+     get_union_clauses id defs
+  | [] -> []
+
+let rec filter_union_clauses id = function
+  | DEF_scattered (SD_aux (SD_unioncl (uid, tu), _)) :: defs when Id.compare id uid = 0 ->
+     filter_union_clauses id defs
+  | def :: defs ->
+     def :: filter_union_clauses id defs
+  | [] -> []
+
+let rec descatter' funcls mapcls = function
+  (* For scattered functions we collect all the seperate function
+     clauses until we find the last one, then we turn that function
+     clause into a DEF_fundef containing all the clauses. *)
+  | DEF_scattered (SD_aux (SD_funcl funcl, (l, _))) :: defs
+       when last_scattered_funcl (funcl_id funcl) defs ->
+     let clauses = match Bindings.find_opt (funcl_id funcl) funcls with
+       | Some clauses -> List.rev (funcl :: clauses)
+       | None -> [funcl]
+     in
+     DEF_fundef (FD_aux (FD_function (fake_rec_opt l, no_tannot_opt l, fake_effect_opt l, clauses),
+                         (gen_loc l, Type_check.empty_tannot)))
+     :: descatter' funcls mapcls defs
+
+  | DEF_scattered (SD_aux (SD_funcl funcl, _)) :: defs ->
+     let id = funcl_id funcl in
+     begin match Bindings.find_opt id funcls with
+     | Some clauses -> descatter' (Bindings.add id (funcl :: clauses) funcls) mapcls defs
+     | None -> descatter' (Bindings.add id [funcl] funcls) mapcls defs
+     end
+
+  (* Scattered mappings are handled the same way as scattered functions *)
+  | DEF_scattered (SD_aux (SD_mapcl (id, mapcl), (l, tannot))) :: defs
+       when last_scattered_mapcl id defs ->
+     let clauses = match Bindings.find_opt id mapcls with
+       | Some clauses -> List.rev (mapcl :: clauses)
+       | None -> [mapcl]
+     in
+     DEF_mapdef (MD_aux (MD_mapping (id, no_tannot_opt l, clauses),
+                         (gen_loc l, tannot)))
+     :: descatter' funcls mapcls defs
+
+  | DEF_scattered (SD_aux (SD_mapcl (id, mapcl), _)) :: defs ->
+     begin match Bindings.find_opt id mapcls with
+     | Some clauses -> descatter' funcls (Bindings.add id (mapcl :: clauses) mapcls) defs
+     | None -> descatter' funcls (Bindings.add id [mapcl] mapcls) defs
+     end
+
+  (* For scattered unions, when we find a union declaration we
+     immediately grab all the future clauses and turn it into a
+     regular union declaration. *)
+  | DEF_scattered (SD_aux (SD_variant (id, namescm, typq), (l, _))) :: defs ->
+     let tus = get_union_clauses id defs in
+     DEF_type (TD_aux (TD_variant (id, namescm, typq, tus, false), (gen_loc l, Type_check.empty_tannot)))
+     :: descatter' funcls mapcls (filter_union_clauses id defs)
+
+  (* Therefore we should never see SD_unioncl... *)
+  | DEF_scattered (SD_aux (SD_unioncl _, (l, _))) :: defs ->
+     raise (Reporting.err_unreachable l __POS__ "Found union clause during de-scattering")
+
+  | def :: defs -> def :: descatter' funcls mapcls defs
+  | [] -> []
+
+let descatter (Defs defs) = Defs (descatter' Bindings.empty Bindings.empty defs)
diff --git a/src/spec_analysis.ml b/src/spec_analysis.ml
index 56c488ff..940fbfe5 100644
--- a/src/spec_analysis.ml
+++ b/src/spec_analysis.ml
@@ -94,14 +94,14 @@ let rec free_type_names_t consider_var (Typ_aux (t, l)) = match t with
                                         (free_type_names_t consider_var t2)
   | Typ_tup ts -> free_type_names_ts consider_var ts
   | Typ_app (name,targs) -> Nameset.add (string_of_id name) (free_type_names_t_args consider_var targs)
-  | Typ_exist (kids,_,t') -> List.fold_left (fun s kid -> Nameset.remove (string_of_kid kid) s) (free_type_names_t consider_var t') kids
+  | Typ_exist (kopts,_,t') -> List.fold_left (fun s kopt -> Nameset.remove (string_of_kid (kopt_kid kopt)) s) (free_type_names_t consider_var t') kopts
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
 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
+  | A_aux (A_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)
@@ -126,12 +126,15 @@ let rec fv_of_typ consider_var bound used (Typ_aux (t,l)) : Nameset.t =
   | 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)
-  | Typ_exist (kids,_,t') -> fv_of_typ consider_var (List.fold_left (fun b (Kid_aux (Var v,_)) -> Nameset.add v b) bound kids) used t'
+  | Typ_exist (kopts,_,t') ->
+     fv_of_typ consider_var
+       (List.fold_left (fun b (KOpt_aux (KOpt_kind (_, (Kid_aux (Var v,_))), _)) -> Nameset.add v b) bound kopts)
+       used t'
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
 
-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
+and fv_of_targ consider_var bound used (Ast.A_aux(targ,_)) : Nameset.t = match targ with
+  | A_typ t -> fv_of_typ consider_var bound used t
+  | A_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
@@ -151,7 +154,6 @@ let typq_bindings (TypQ_aux(tq,_)) = match tq with
         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  
@@ -210,11 +212,11 @@ let rec fv_of_exp consider_var bound used set (E_aux (e,(_,tannot))) : (Nameset.
   | 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,_),_)) ->
+  | E_record 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,_),_))) ->
+  | E_record_update(e, 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)
@@ -282,6 +284,10 @@ and fv_of_lexp consider_var bound used set (LEXP_aux(lexp,(_,tannot))) =
         (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_vector_concat(args) ->
+     List.fold_right
+       (fun e (b,u,s) ->
+         fv_of_lexp consider_var b u s e) args (bound,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
@@ -304,8 +310,13 @@ let typ_variants consider_var bound tunions =
 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
 
+let fv_of_abbrev consider_var bound used typq typ_arg =
+  let ts_bound = if consider_var then typq_bindings typq else mt in
+  ts_bound, fv_of_targ consider_var (Nameset.union bound ts_bound) used typ_arg
+
 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_abbrev(id,typq,typ_arg) ->
+     init_env (string_of_id id), snd (fv_of_abbrev consider_var mt mt typq typ_arg)
   | 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
@@ -382,17 +393,17 @@ 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,_) ->
+     | SD_function(_,_,_,id)
+     | SD_funcl(FCL_aux(FCL_Funcl(id,_),_))
+     | SD_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 rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd,(l, _))) = match sd with
+  | SD_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
@@ -400,7 +411,7 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
         | 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,pexp),_)) ->
+  | SD_funcl (FCL_aux(FCL_Funcl(id,pexp),_)) ->
      begin
        match pexp with
        | Pat_aux(Pat_exp (pat,exp),_) ->
@@ -419,7 +430,7 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
             | _ -> mt in
           scattered_binds, exp_ns
      end
-  | SD_scattered_variant (id,_,_) ->
+  | SD_variant (id,_,_) ->
     let name = string_of_id id in
     let uses =
       if consider_scatter_as_one
@@ -431,12 +442,12 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
         Nameset.remove name pieces_uses
       else mt in
     init_env name, uses
-  | SD_scattered_unioncl(id, type_union) ->
+  | SD_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 ->
+  | SD_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 *)
@@ -446,16 +457,28 @@ let rec fv_of_scattered consider_var consider_scatter_as_one all_defs (SD_aux(sd
           (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_config(id,t,exp) ->
-    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
+  | _ -> raise (Reporting.err_unreachable l __POS__ "Tried to find free variables for scattered mapping clause")
+
+let fv_of_rd consider_var (DEC_aux (d, annot)) =
+  (* When we get the free variables of a register, we have to ensure
+     that we expand all synonyms so we can pick up dependencies with
+     undefined_type function, even when type is indirected through a
+     synonym. *)
+  let open Type_check in
+  let env = env_of_annot annot in
+  match d with
+  | DEC_reg(t, id) ->
+     let t' = Env.expand_synonyms env t in
+     init_env (string_of_id id),
+     Nameset.union (fv_of_typ consider_var mt mt t) (fv_of_typ consider_var mt mt t')
+  | DEC_config(id, t, exp) ->
+     let t' = Env.expand_synonyms env t in
+     init_env (string_of_id id),
+     Nameset.union (fv_of_typ consider_var mt mt t) (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
@@ -475,6 +498,7 @@ let fv_of_def consider_var consider_scatter_as_one all_defs = function
      List.fold_left Nameset.union Nameset.empty (List.map snd fvs)
   | 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_pragma _ -> 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
@@ -549,6 +573,15 @@ let scc ?(original_order : string list option) (g : graph) =
 
 let add_def_to_graph (prelude, original_order, defset, graph) d =
   let bound, used = fv_of_def false true [] d in
+  let used = match d with
+    | DEF_reg_dec _ ->
+       (* For a register, we need to ensure that any undefined_type
+          functions for types used by the register are placed before
+          the register declaration. *)
+       let undefineds = Nameset.map (fun name -> "undefined_" ^ name) used in
+       Nameset.union undefineds used
+    | _ -> used
+  in
   try
     (* A definition may bind multiple identifiers, e.g. "let (x, y) = ...".
        We add all identifiers to the dependency graph as a cycle.  The actual
@@ -598,7 +631,7 @@ let def_of_component graph defset comp =
        | DEF_fundef fundef -> [fundef]
        | DEF_internal_mutrec fundefs -> fundefs
        | _ ->
-          raise (Reporting_basic.err_unreachable (def_loc def) __POS__
+          raise (Reporting.err_unreachable (def_loc def) __POS__
             "Trying to merge non-function definition with mutually recursive functions") in
      let fundefs = List.concat (List.map get_fundefs defs) in
      print_dot graph (List.map (fun fd -> string_of_id (id_of_fundef fd)) fundefs);
diff --git a/src/specialize.ml b/src/specialize.ml
index 4d7a997f..1ba57bd0 100644
--- a/src/specialize.ml
+++ b/src/specialize.ml
@@ -54,8 +54,8 @@ open Rewriter
 open Extra_pervasives
 
 let is_typ_ord_uvar = function
-  | Type_check.U_typ _ -> true
-  | Type_check.U_order _ -> true
+  | A_aux (A_typ _, _) -> true
+  | A_aux (A_order _, _) -> true
   | _ -> false
 
 let rec nexp_simp_typ (Typ_aux (typ_aux, l)) =
@@ -71,24 +71,20 @@ let rec nexp_simp_typ (Typ_aux (typ_aux, l)) =
     | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
   in
   Typ_aux (typ_aux, l)
-and nexp_simp_typ_arg (Typ_arg_aux (typ_arg_aux, l)) =
+and nexp_simp_typ_arg (A_aux (typ_arg_aux, l)) =
   let typ_arg_aux = match typ_arg_aux with
-    | Typ_arg_nexp n -> Typ_arg_nexp (nexp_simp n)
-    | Typ_arg_typ typ -> Typ_arg_typ (nexp_simp_typ typ)
-    | Typ_arg_order ord -> Typ_arg_order ord
+    | A_nexp n -> A_nexp (nexp_simp n)
+    | A_typ typ -> A_typ (nexp_simp_typ typ)
+    | A_order ord -> A_order ord
+    | A_bool nc -> A_bool (constraint_simp nc)
   in
-  Typ_arg_aux (typ_arg_aux, l)
-
-let nexp_simp_uvar = function
-  | Type_check.U_nexp nexp -> (prerr_endline ("Simp nexp " ^ string_of_nexp nexp); Type_check.U_nexp (nexp_simp nexp))
-  | Type_check.U_typ typ -> Type_check.U_typ (nexp_simp_typ typ)
-  | uvar -> uvar
+  A_aux (typ_arg_aux, l)
 
 (* We have to be careful about whether the typechecker has renamed anything returned by instantiation_of.
    This part of the typechecker API is a bit ugly. *)
 let fix_instantiation instantiation =
-  let instantiation = KBindings.bindings (KBindings.filter (fun _ uvar -> is_typ_ord_uvar uvar) instantiation) in
-  let instantiation = List.map (fun (kid, uvar) -> Type_check.orig_kid kid, nexp_simp_uvar uvar) instantiation in
+  let instantiation = KBindings.bindings (KBindings.filter (fun _ arg -> is_typ_ord_uvar arg) instantiation) in
+  let instantiation = List.map (fun (kid, arg) -> Type_check.orig_kid kid, nexp_simp_typ_arg arg) instantiation in
   List.fold_left (fun m (k, v) -> KBindings.add k v m) KBindings.empty instantiation
 
 let rec polymorphic_functions is_kopt (Defs defs) =
@@ -104,13 +100,13 @@ let rec polymorphic_functions is_kopt (Defs defs) =
 
 let string_of_instantiation instantiation =
   let open Type_check in
-  let kid_names = ref KBindings.empty in
+  let kid_names = ref KOptMap.empty in
   let kid_counter = ref 0 in
   let kid_name kid =
-    try KBindings.find kid !kid_names with
+    try KOptMap.find kid !kid_names with
     | Not_found -> begin
         let n = string_of_int !kid_counter in
-        kid_names := KBindings.add kid n !kid_names;
+        kid_names := KOptMap.add kid n !kid_names;
         incr kid_counter;
         n
       end
@@ -121,7 +117,7 @@ let string_of_instantiation instantiation =
     | Nexp_aux (nexp, _) -> string_of_nexp_aux nexp
   and string_of_nexp_aux = function
     | Nexp_id id -> string_of_id id
-    | Nexp_var kid -> kid_name kid
+    | Nexp_var kid -> kid_name (mk_kopt K_int kid)
     | Nexp_constant c -> Big_int.to_string c
     | Nexp_times (n1, n2) -> "(" ^ string_of_nexp n1 ^ " * " ^ string_of_nexp n2 ^ ")"
     | Nexp_sum (n1, n2) -> "(" ^ string_of_nexp n1 ^ " + " ^ string_of_nexp n2 ^ ")"
@@ -135,7 +131,7 @@ let string_of_instantiation instantiation =
     | Typ_aux (typ, l) -> string_of_typ_aux typ
   and string_of_typ_aux = function
     | Typ_id id -> string_of_id id
-    | Typ_var kid -> kid_name kid
+    | Typ_var kid -> kid_name (mk_kopt K_type kid)
     | Typ_tup typs -> "(" ^ Util.string_of_list ", " string_of_typ typs ^ ")"
     | Typ_app (id, args) -> string_of_id id ^ "(" ^ Util.string_of_list ", " string_of_typ_arg args ^ ")"
     | Typ_fn (arg_typs, ret_typ, eff) ->
@@ -146,11 +142,12 @@ let string_of_instantiation instantiation =
        "exist " ^ Util.string_of_list " " kid_name kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ
     | Typ_internal_unknown -> "UNKNOWN"
   and string_of_typ_arg = function
-    | Typ_arg_aux (typ_arg, l) -> string_of_typ_arg_aux typ_arg
+    | A_aux (typ_arg, l) -> string_of_typ_arg_aux typ_arg
   and string_of_typ_arg_aux = function
-    | Typ_arg_nexp n -> string_of_nexp n
-    | Typ_arg_typ typ -> string_of_typ typ
-    | Typ_arg_order o -> string_of_order o
+    | A_nexp n -> string_of_nexp n
+    | A_typ typ -> string_of_typ typ
+    | A_order o -> string_of_order o
+    | A_bool nc -> string_of_n_constraint nc
   and string_of_n_constraint = function
     | NC_aux (NC_equal (n1, n2), _) -> string_of_nexp n1 ^ " = " ^ string_of_nexp n2
     | NC_aux (NC_not_equal (n1, n2), _) -> string_of_nexp n1 ^ " != " ^ string_of_nexp n2
@@ -161,18 +158,12 @@ let string_of_instantiation instantiation =
     | NC_aux (NC_and (nc1, nc2), _) ->
        "(" ^ string_of_n_constraint nc1 ^ " & " ^ string_of_n_constraint nc2 ^ ")"
     | NC_aux (NC_set (kid, ns), _) ->
-       kid_name kid ^ " in {" ^ Util.string_of_list ", " Big_int.to_string ns ^ "}"
+       kid_name (mk_kopt K_int kid) ^ " in {" ^ Util.string_of_list ", " Big_int.to_string ns ^ "}"
     | NC_aux (NC_true, _) -> "true"
     | NC_aux (NC_false, _) -> "false"
   in
 
-  let string_of_uvar = function
-    | U_nexp n -> string_of_nexp n
-    | U_order o -> string_of_order o
-    | U_typ typ -> string_of_typ typ
-  in
-
-  let string_of_binding (kid, uvar) = string_of_kid kid ^ " => " ^ string_of_uvar uvar in
+  let string_of_binding (kid, arg) = string_of_kid kid ^ " => " ^ string_of_typ_arg arg in
   Util.zencode_string (Util.string_of_list ", " string_of_binding (KBindings.bindings instantiation))
 
 let id_of_instantiation id instantiation =
@@ -182,7 +173,7 @@ let id_of_instantiation id instantiation =
 let rec variant_generic_typ id (Defs defs) =
   match defs with
   | DEF_type (TD_aux (TD_variant (id', _, typq, _, _), _)) :: _ when Id.compare id id' = 0 ->
-     mk_typ (Typ_app (id', List.map (fun kopt -> mk_typ_arg (Typ_arg_typ (mk_typ (Typ_var (kopt_kid kopt))))) (quant_kopts typq)))
+     mk_typ (Typ_app (id', List.map (fun kopt -> mk_typ_arg (A_typ (mk_typ (Typ_var (kopt_kid kopt))))) (quant_kopts typq)))
   | _ :: defs -> variant_generic_typ id (Defs defs)
   | [] -> failwith ("No variant with id " ^ string_of_id id)
 
@@ -207,9 +198,10 @@ let rec instantiations_of id ast =
        begin match Type_check.typ_of_annot annot with
        | Typ_aux (Typ_app (variant_id, _), _) as typ ->
           let open Type_check in
-          let instantiation, _, _ = unify (fst annot) (env_of_annot annot)
-                                          (variant_generic_typ variant_id ast)
-                                          typ
+          let instantiation = unify (fst annot) (env_of_annot annot)
+                                (tyvars_of_typ (variant_generic_typ variant_id ast))
+                                (variant_generic_typ variant_id ast)
+                                typ
           in
           instantiations := fix_instantiation instantiation :: !instantiations;
           pat
@@ -257,16 +249,16 @@ let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | Typ_var kid -> KidSet.singleton kid
   | Typ_tup typs -> List.fold_left KidSet.union KidSet.empty (List.map (typ_frees ~exs:exs) typs)
   | Typ_app (f, args) -> List.fold_left KidSet.union KidSet.empty (List.map (typ_arg_frees ~exs:exs) args)
-  | Typ_exist (kids, nc, typ) -> typ_frees ~exs:(KidSet.of_list kids) typ
+  | Typ_exist (kopts, nc, typ) -> typ_frees ~exs:(KidSet.of_list (List.map kopt_kid kopts)) typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.fold_left KidSet.union (typ_frees ~exs:exs ret_typ) (List.map (typ_frees ~exs:exs) arg_typs)
   | Typ_bidir (t1, t2) -> KidSet.union (typ_frees ~exs:exs t1) (typ_frees ~exs:exs t2)
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and typ_arg_frees ?exs:(exs=KidSet.empty) (Typ_arg_aux (typ_arg_aux, l)) =
+and typ_arg_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
-  | Typ_arg_nexp n -> KidSet.empty
-  | Typ_arg_typ typ -> typ_frees ~exs:exs typ
-  | Typ_arg_order ord -> KidSet.empty
+  | A_nexp n -> KidSet.empty
+  | A_typ typ -> typ_frees ~exs:exs typ
+  | A_order ord -> KidSet.empty
 
 let rec typ_int_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   match typ_aux with
@@ -274,25 +266,16 @@ let rec typ_int_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | Typ_var kid -> KidSet.empty
   | Typ_tup typs -> List.fold_left KidSet.union KidSet.empty (List.map (typ_int_frees ~exs:exs) typs)
   | Typ_app (f, args) -> List.fold_left KidSet.union KidSet.empty (List.map (typ_arg_int_frees ~exs:exs) args)
-  | Typ_exist (kids, nc, typ) -> typ_int_frees ~exs:(KidSet.of_list kids) typ
+  | Typ_exist (kopts, nc, typ) -> typ_int_frees ~exs:(KidSet.of_list (List.map kopt_kid kopts)) typ
   | Typ_fn (arg_typs, ret_typ, _) ->
      List.fold_left KidSet.union (typ_int_frees ~exs:exs ret_typ) (List.map (typ_int_frees ~exs:exs) arg_typs)
   | Typ_bidir (t1, t2) -> KidSet.union (typ_int_frees ~exs:exs t1) (typ_int_frees ~exs:exs t2)
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and typ_arg_int_frees ?exs:(exs=KidSet.empty) (Typ_arg_aux (typ_arg_aux, l)) =
+and typ_arg_int_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
-  | Typ_arg_nexp n -> KidSet.diff (tyvars_of_nexp n) exs
-  | Typ_arg_typ typ -> KidSet.empty
-  | Typ_arg_order ord -> KidSet.empty
-
-let uvar_int_frees = function
-  | Type_check.U_nexp n -> tyvars_of_nexp n
-  | Type_check.U_typ typ -> typ_int_frees typ
-  | _ -> KidSet.empty
-
-let uvar_typ_frees = function
-  | Type_check.U_typ typ -> typ_frees typ
-  | _ -> KidSet.empty
+  | A_nexp n -> KidSet.diff (tyvars_of_nexp n) exs
+  | A_typ typ -> typ_int_frees ~exs:exs typ
+  | A_order ord -> KidSet.empty
 
 let specialize_id_valspec instantiations id ast =
   match split_defs (is_valspec id) ast with
@@ -313,14 +296,14 @@ let specialize_id_valspec instantiations id ast =
 
        (* Collect any new type variables introduced by the instantiation *)
        let collect_kids kidsets = KidSet.elements (List.fold_left KidSet.union KidSet.empty kidsets) in
-       let typ_frees = KBindings.bindings instantiation |> List.map snd |> List.map uvar_typ_frees |> collect_kids in
-       let int_frees = KBindings.bindings instantiation |> List.map snd |> List.map uvar_int_frees |> collect_kids in
+       let typ_frees = KBindings.bindings instantiation |> List.map snd |> List.map typ_arg_frees |> collect_kids in
+       let int_frees = KBindings.bindings instantiation |> List.map snd |> List.map typ_arg_int_frees |> collect_kids in
 
        (* Remove type variables from the type quantifier. *)
        let kopts, constraints = quant_split typq in
        let kopts = List.filter (fun kopt -> not (is_typ_kopt kopt || is_order_kopt kopt)) kopts in
-       let typq = mk_typquant (List.map (mk_qi_id BK_type) typ_frees
-                               @ List.map (mk_qi_id BK_int) int_frees
+       let typq = mk_typquant (List.map (mk_qi_id K_type) typ_frees
+                               @ List.map (mk_qi_id K_int) int_frees
                                @ List.map mk_qi_kopt kopts
                                @ List.map mk_qi_nc constraints) in
        let typschm = mk_typschm typq typ in
diff --git a/src/specialize.mli b/src/specialize.mli
index 87533e9b..f2c94a48 100644
--- a/src/specialize.mli
+++ b/src/specialize.mli
@@ -68,6 +68,6 @@ val polymorphic_functions : (kinded_id -> bool) -> 'a defs -> IdSet.t
    which case specialize returns the AST unmodified. *)
 val specialize : tannot defs -> Env.t -> tannot defs * Env.t
 
-val instantiations_of : id -> tannot defs -> uvar KBindings.t list
+val instantiations_of : id -> tannot defs -> typ_arg KBindings.t list
 
-val string_of_instantiation : uvar KBindings.t -> string
+val string_of_instantiation : typ_arg KBindings.t -> string
diff --git a/src/state.ml b/src/state.ml
index 70e53a52..c9a47b06 100644
--- a/src/state.ml
+++ b/src/state.ml
@@ -102,12 +102,12 @@ let generate_initial_regstate defs =
          if string_of_id id = "unit" then "()" else
          Bindings.find id vals []
       | Typ_app (id, _) when string_of_id id = "list" -> "[||]"
-      | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp, _)]) when string_of_id id = "atom" ->
+      | Typ_app (id, [A_aux (A_nexp nexp, _)]) when string_of_id id = "atom" ->
          string_of_nexp nexp
-      | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp, _); _]) when string_of_id id = "range" ->
+      | Typ_app (id, [A_aux (A_nexp nexp, _); _]) when string_of_id id = "range" ->
          string_of_nexp nexp
-      | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant len, _)), _); _ ;
-                      Typ_arg_aux (Typ_arg_typ etyp, _)])
+      | Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_constant len, _)), _); _ ;
+                      A_aux (A_typ etyp, _)])
         when string_of_id id = "vector" ->
          (* Output a list of initial values of the vector elements, or a
             literal binary zero value if this is a bitvector and the
@@ -127,15 +127,9 @@ let generate_initial_regstate defs =
       | Typ_exist (_, _, typ) -> lookup_init_val vals typ
       | _ -> raise Not_found
     in
-    (* Helper functions to instantiate type arguments *)
-    let typ_subst_targ kid (Typ_arg_aux (arg, _)) typ = match arg with
-      | Typ_arg_nexp (Nexp_aux (nexp, _)) -> typ_subst_nexp kid nexp typ
-      | Typ_arg_typ (Typ_aux (typ', _)) -> typ_subst_typ kid typ' typ
-      | Typ_arg_order (Ord_aux (ord, _)) -> typ_subst_order kid ord typ
-    in
     let typ_subst_quant_item typ (QI_aux (qi, _)) arg = match qi with
-      | QI_id (KOpt_aux ((KOpt_none kid | KOpt_kind (_, kid)), _)) ->
-         typ_subst_targ kid arg typ
+      | QI_id (KOpt_aux (KOpt_kind (_, kid), _)) ->
+         typ_subst kid arg typ
       | _ -> typ
     in
     let typ_subst_typquant tq args typ =
@@ -152,7 +146,7 @@ let generate_initial_regstate defs =
            string_of_id id1 ^ " (" ^ lookup_init_val vals typ1 ^ ")"
          in
          Bindings.add id init_val vals
-      | TD_abbrev (id, _, TypSchm_aux (TypSchm_ts (tq, typ), _)) ->
+      | TD_abbrev (id, tq, A_aux (A_typ typ, _)) ->
          let init_val args = lookup_init_val vals (typ_subst_typquant tq args typ) in
          Bindings.add id init_val vals
       | TD_record (id, _, tq, fields, _) ->
@@ -180,19 +174,19 @@ let generate_initial_regstate defs =
 let rec regval_constr_id mwords (Typ_aux (t, l) as typ) = match t with
   | Typ_id id -> id
   | Typ_app (id, args) ->
-     let name_arg (Typ_arg_aux (targ, _)) = match targ with
-       | Typ_arg_typ targ -> string_of_id (regval_constr_id mwords targ)
-       | Typ_arg_nexp nexp when is_nexp_constant (nexp_simp nexp) ->
+     let name_arg (A_aux (targ, _)) = match targ with
+       | A_typ targ -> string_of_id (regval_constr_id mwords targ)
+       | A_nexp nexp when is_nexp_constant (nexp_simp nexp) ->
           string_of_nexp (nexp_simp nexp)
-       | Typ_arg_order (Ord_aux (Ord_inc, _)) -> "inc"
-       | Typ_arg_order (Ord_aux (Ord_dec, _)) -> "dec"
+       | A_order (Ord_aux (Ord_inc, _)) -> "inc"
+       | A_order (Ord_aux (Ord_dec, _)) -> "dec"
        | _ ->
-          raise (Reporting_basic.err_typ l "Unsupported register type")
+          raise (Reporting.err_typ l "Unsupported register type")
      in
      let builtins = IdSet.of_list (List.map mk_id ["vector"; "list"; "option"]) in
      if IdSet.mem id builtins && not (mwords && is_bitvector_typ typ) then id else
      append_id id (String.concat "_" ("" :: List.map name_arg args))
-  | _ -> raise (Reporting_basic.err_typ l "Unsupported register type")
+  | _ -> raise (Reporting.err_typ l "Unsupported register type")
 
 let register_base_types mwords typs =
   let rec add_base_typs typs (Typ_aux (t, _) as typ) =
@@ -200,9 +194,9 @@ let register_base_types mwords typs =
     match t with
       | Typ_app (id, args)
         when IdSet.mem id builtins && not (mwords && is_bitvector_typ typ) ->
-         let add_typ_arg base_typs (Typ_arg_aux (targ, _)) =
+         let add_typ_arg base_typs (A_aux (targ, _)) =
            match targ with
-             | Typ_arg_typ typ -> add_base_typs typs typ
+             | A_typ typ -> add_base_typs typs typ
              | _ -> typs
          in
          List.fold_left add_typ_arg typs args
@@ -249,12 +243,12 @@ let rec regval_convs_lem mwords (Typ_aux (t, _) as typ) = match t with
      let etyp_of, of_etyp = regval_convs_lem mwords etyp in
      "(fun v -> vector_of_regval " ^ etyp_of ^ " v)",
      "(fun v -> regval_of_vector " ^ of_etyp ^ " " ^ size ^ " " ^ is_inc ^ " v)"
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ etyp, _)])
+  | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "list" ->
      let etyp_of, of_etyp = regval_convs_lem mwords etyp in
      "(fun v -> list_of_regval " ^ etyp_of ^ " v)",
      "(fun v -> regval_of_list " ^ of_etyp ^ " v)"
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ etyp, _)])
+  | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "option" ->
      let etyp_of, of_etyp = regval_convs_lem mwords etyp in
      "(fun v -> option_of_regval " ^ etyp_of ^ " v)",
@@ -413,12 +407,12 @@ let rec regval_convs_coq (Typ_aux (t, _) as typ) = match t with
      let etyp_of, of_etyp = regval_convs_coq etyp in
      "(fun v => vector_of_regval " ^ size ^ " " ^ etyp_of ^ " v)",
      "(fun v => regval_of_vector " ^ of_etyp ^ " " ^ size ^ " " ^ is_inc ^ " v)"
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ etyp, _)])
+  | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "list" ->
      let etyp_of, of_etyp = regval_convs_coq etyp in
      "(fun v => list_of_regval " ^ etyp_of ^ " v)",
      "(fun v => regval_of_list " ^ of_etyp ^ " v)"
-  | Typ_app (id, [Typ_arg_aux (Typ_arg_typ etyp, _)])
+  | Typ_app (id, [A_aux (A_typ etyp, _)])
     when string_of_id id = "option" ->
      let etyp_of, of_etyp = regval_convs_coq etyp in
      "(fun v => option_of_regval " ^ etyp_of ^ " v)",
diff --git a/src/type_check.ml b/src/type_check.ml
index 88d33569..63f03c81 100644
--- a/src/type_check.ml
+++ b/src/type_check.ml
@@ -69,9 +69,9 @@ let opt_no_effects = ref false
    assignments in l-expressions *)
 let opt_no_lexp_bounds_check = ref false
 
-(* opt_constraint_synonyms allows constraint synonyms as toplevel
-   definitions *)
-let opt_constraint_synonyms = ref false
+(* opt_expand_valspec expands typedefs in valspecs during type check.
+   We prefer not to do it for latex output but it is otherwise a good idea. *)
+let opt_expand_valspec = ref true
 
 let depth = ref 0
 
@@ -82,7 +82,7 @@ let rec indent n = match n with
 (* Lazily evaluate debugging message. This can make a big performance
    difference; for example, repeated calls to string_of_exp can be costly for
    deeply nested expressions, e.g. with long sequences of monadic binds. *)
-let typ_debug m = if !opt_tc_debug > 1 then prerr_endline (indent !depth ^ Lazy.force m) else ()
+let typ_debug ?level:(level=1) m = if !opt_tc_debug > level then prerr_endline (indent !depth ^ Lazy.force m) else ()
 
 let typ_print m = if !opt_tc_debug > 0 then prerr_endline (indent !depth ^ Lazy.force m) else ()
 
@@ -92,10 +92,11 @@ type type_error =
      coercions *)
   | Err_no_casts of unit exp * typ * typ * type_error * type_error list
   | Err_no_overloading of id * (id * type_error) list
-  | Err_unresolved_quants of id * quant_item list
+  | Err_unresolved_quants of id * quant_item list * (mut * typ) Bindings.t * n_constraint list
   | Err_subtype of typ * typ * n_constraint list * Ast.l KBindings.t
   | Err_no_num_ident of id
   | Err_other of string
+  | Err_because of type_error * type_error
 
 exception Type_error of l * type_error;;
 
@@ -125,7 +126,7 @@ let orig_kid (Kid_aux (Var v, l) as kid) =
 
 let is_list (Typ_aux (typ_aux, _)) =
   match typ_aux with
-  | Typ_app (f, [Typ_arg_aux (Typ_arg_typ typ, _)])
+  | Typ_app (f, [A_aux (A_typ typ, _)])
        when string_of_id f = "list" -> Some typ
   | _ -> None
 
@@ -167,17 +168,19 @@ and strip_n_constraint_aux = function
   | NC_set (kid, nums) -> NC_set (strip_kid kid, nums)
   | NC_or (nc1, nc2) -> NC_or (strip_n_constraint nc1, strip_n_constraint nc2)
   | NC_and (nc1, nc2) -> NC_and (strip_n_constraint nc1, strip_n_constraint nc2)
-  | NC_app (id, nexps) -> NC_app (strip_id id, List.map strip_nexp nexps)
+  | NC_var kid -> NC_var (strip_kid kid)
+  | NC_app (id, args) -> NC_app (strip_id id, List.map strip_typ_arg args)
   | NC_true -> NC_true
   | NC_false -> NC_false
 and strip_n_constraint = function
   | NC_aux (nc_aux, _) -> NC_aux (strip_n_constraint_aux nc_aux, Parse_ast.Unknown)
 and strip_typ_arg = function
-  | Typ_arg_aux (typ_arg_aux, _) -> Typ_arg_aux (strip_typ_arg_aux typ_arg_aux, Parse_ast.Unknown)
+  | A_aux (typ_arg_aux, _) -> A_aux (strip_typ_arg_aux typ_arg_aux, Parse_ast.Unknown)
 and strip_typ_arg_aux = function
-  | Typ_arg_nexp nexp -> Typ_arg_nexp (strip_nexp nexp)
-  | Typ_arg_typ typ -> Typ_arg_typ (strip_typ typ)
-  | Typ_arg_order ord -> Typ_arg_order (strip_order ord)
+  | A_nexp nexp -> A_nexp (strip_nexp nexp)
+  | A_typ typ -> A_typ (strip_typ typ)
+  | A_order ord -> A_order (strip_order ord)
+  | A_bool nc -> A_bool (strip_n_constraint nc)
 and strip_order = function
   | Ord_aux (ord_aux, _) -> Ord_aux (strip_order_aux ord_aux, Parse_ast.Unknown)
 and strip_order_aux = function
@@ -191,7 +194,8 @@ and strip_typ_aux : typ_aux -> typ_aux = function
   | Typ_fn (arg_typs, ret_typ, effect) -> Typ_fn (List.map strip_typ arg_typs, strip_typ ret_typ, strip_effect effect)
   | Typ_bidir (typ1, typ2) -> Typ_bidir (strip_typ typ1, strip_typ typ2)
   | Typ_tup typs -> Typ_tup (List.map strip_typ typs)
-  | Typ_exist (kids, constr, typ) -> Typ_exist ((List.map strip_kid kids), strip_n_constraint constr, strip_typ typ)
+  | Typ_exist (kopts, constr, typ) ->
+     Typ_exist ((List.map strip_kinded_id kopts), strip_n_constraint constr, strip_typ typ)
   | Typ_app (id, args) -> Typ_app (strip_id id, List.map strip_typ_arg args)
 and strip_typ : typ -> typ = function
   | Typ_aux (typ_aux, _) -> Typ_aux (strip_typ_aux typ_aux, Parse_ast.Unknown)
@@ -207,145 +211,63 @@ and strip_qi_aux = function
 and strip_kinded_id = function
   | KOpt_aux (kinded_id_aux, _) -> KOpt_aux (strip_kinded_id_aux kinded_id_aux, Parse_ast.Unknown)
 and strip_kinded_id_aux = function
-  | KOpt_none kid -> KOpt_none (strip_kid kid)
   | KOpt_kind (kind, kid) -> KOpt_kind (strip_kind kind, strip_kid kid)
 and strip_kind = function
-  | K_aux (k_aux, _) -> K_aux (strip_kind_aux k_aux, Parse_ast.Unknown)
-and strip_kind_aux = function
-  | K_kind base_kinds -> K_kind (List.map strip_base_kind base_kinds)
-and strip_base_kind = function
-  | BK_aux (bk_aux, _) -> BK_aux (bk_aux, Parse_ast.Unknown)
+  | K_aux (k_aux, _) -> K_aux (k_aux, Parse_ast.Unknown)
 
+let ex_counter = ref 0
 
-(**************************************************************************)
-(* 1. Substitutions                                                       *)
-(**************************************************************************)
-
-let rec nexp_subst sv subst (Nexp_aux (nexp, l)) = Nexp_aux (nexp_subst_aux sv subst nexp, l)
-and nexp_subst_aux sv subst = function
-  | Nexp_id v -> Nexp_id v
-  | Nexp_var kid -> if Kid.compare kid sv = 0 then subst else Nexp_var kid
-  | Nexp_constant c -> Nexp_constant c
-  | Nexp_times (nexp1, nexp2) -> Nexp_times (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
-  | Nexp_sum (nexp1, nexp2) -> Nexp_sum (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
-  | Nexp_minus (nexp1, nexp2) -> Nexp_minus (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
-  | Nexp_app (id, nexps) -> Nexp_app (id, List.map (nexp_subst sv subst) nexps)
-  | Nexp_exp nexp -> Nexp_exp (nexp_subst sv subst nexp)
-  | Nexp_neg nexp -> Nexp_neg (nexp_subst sv subst nexp)
-
-let rec nexp_set_to_or l subst = function
-  | [] -> typ_error l "Cannot substitute into empty nexp set"
-  | [int] -> NC_equal (subst, nconstant int)
-  | (int :: ints) -> NC_or (mk_nc (NC_equal (subst, nconstant int)), mk_nc (nexp_set_to_or l subst ints))
-
-let rec nc_subst_nexp sv subst (NC_aux (nc, l)) = NC_aux (nc_subst_nexp_aux l sv subst nc, l)
-and nc_subst_nexp_aux l sv subst = function
-  | NC_equal (n1, n2) -> NC_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
-  | NC_bounded_ge (n1, n2) -> NC_bounded_ge (nexp_subst sv subst n1, nexp_subst sv subst n2)
-  | NC_bounded_le (n1, n2) -> NC_bounded_le (nexp_subst sv subst n1, nexp_subst sv subst n2)
-  | NC_not_equal (n1, n2) -> NC_not_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
-  | NC_set (kid, ints) as set_nc ->
-     if Kid.compare kid sv = 0
-     then nexp_set_to_or l (mk_nexp subst) ints
-     else set_nc
-  | NC_or (nc1, nc2) -> NC_or (nc_subst_nexp sv subst nc1, nc_subst_nexp sv subst nc2)
-  | NC_and (nc1, nc2) -> NC_and (nc_subst_nexp sv subst nc1, nc_subst_nexp sv subst nc2)
-  | NC_app (id, nexps) -> NC_app (id, List.map (nexp_subst sv subst) nexps)
-  | NC_false -> NC_false
-  | NC_true -> NC_true
-
-let rec typ_subst_nexp sv subst (Typ_aux (typ, l)) = Typ_aux (typ_subst_nexp_aux sv subst typ, l)
-and typ_subst_nexp_aux sv subst = function
-  | Typ_internal_unknown -> Typ_internal_unknown
-  | Typ_id v -> Typ_id v
-  | Typ_var kid -> Typ_var kid
-  | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst_nexp sv subst) arg_typs, typ_subst_nexp sv subst ret_typ, effs)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst_nexp sv subst typ1, typ_subst_nexp sv subst typ2)
-  | Typ_tup typs -> Typ_tup (List.map (typ_subst_nexp sv subst) typs)
-  | Typ_app (f, args) -> Typ_app (f, List.map (typ_subst_arg_nexp sv subst) args)
-  | Typ_exist (kids, nc, typ) when KidSet.mem sv (KidSet.of_list kids) -> Typ_exist (kids, nc, typ)
-  | Typ_exist (kids, nc, typ) -> Typ_exist (kids, nc_subst_nexp sv subst nc, typ_subst_nexp sv subst typ)
-and typ_subst_arg_nexp sv subst (Typ_arg_aux (arg, l)) = Typ_arg_aux (typ_subst_arg_nexp_aux sv subst arg, l)
-and typ_subst_arg_nexp_aux sv subst = function
-  | Typ_arg_nexp nexp -> Typ_arg_nexp (nexp_subst sv subst nexp)
-  | Typ_arg_typ typ -> Typ_arg_typ (typ_subst_nexp sv subst typ)
-  | Typ_arg_order ord -> Typ_arg_order ord
-
-let rec typ_subst_typ sv subst (Typ_aux (typ, l)) = Typ_aux (typ_subst_typ_aux sv subst typ, l)
-and typ_subst_typ_aux sv subst = function
-  | Typ_internal_unknown -> Typ_internal_unknown
-  | Typ_id v -> Typ_id v
-  | Typ_var kid -> if Kid.compare kid sv = 0 then subst else Typ_var kid
-  | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst_typ sv subst) arg_typs, typ_subst_typ sv subst ret_typ, effs)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst_typ sv subst typ1, typ_subst_typ sv subst typ2)
-  | Typ_tup typs -> Typ_tup (List.map (typ_subst_typ sv subst) typs)
-  | Typ_app (f, args) -> Typ_app (f, List.map (typ_subst_arg_typ sv subst) args)
-  | Typ_exist (kids, nc, typ) -> Typ_exist (kids, nc, typ_subst_typ sv subst typ)
-and typ_subst_arg_typ sv subst (Typ_arg_aux (arg, l)) = Typ_arg_aux (typ_subst_arg_typ_aux sv subst arg, l)
-and typ_subst_arg_typ_aux sv subst = function
-  | Typ_arg_nexp nexp -> Typ_arg_nexp nexp
-  | Typ_arg_typ typ -> Typ_arg_typ (typ_subst_typ sv subst typ)
-  | Typ_arg_order ord -> Typ_arg_order ord
-
-let order_subst_aux sv subst = function
-  | Ord_var kid -> if Kid.compare kid sv = 0 then subst else Ord_var kid
-  | Ord_inc -> Ord_inc
-  | Ord_dec -> Ord_dec
+let fresh_existential ?name:(n="") k =
+  let fresh = Kid_aux (Var ("'ex" ^ string_of_int !ex_counter ^ "#" ^ n), Parse_ast.Unknown) in
+  incr ex_counter; mk_kopt k fresh
 
-let order_subst sv subst (Ord_aux (ord, l)) = Ord_aux (order_subst_aux sv subst ord, l)
+let destruct_exist_plain typ =
+  match typ with
+  | Typ_aux (Typ_exist (kopts, nc, typ), _) ->
+     let fresh_kopts =
+       List.map (fun kopt -> (kopt_kid kopt,
+                              fresh_existential ~name:(string_of_id (id_of_kid (kopt_kid kopt))) (unaux_kind (kopt_kind kopt))))
+         kopts
+     in
+     let nc = List.fold_left (fun nc (kid, fresh) -> constraint_subst kid (arg_kopt fresh) nc) nc fresh_kopts in
+     let typ = List.fold_left (fun typ (kid, fresh) -> typ_subst kid (arg_kopt fresh) typ) typ fresh_kopts in
+     Some (List.map snd fresh_kopts, nc, typ)
+  | _ -> None
 
-let rec typ_subst_order sv subst (Typ_aux (typ, l)) = Typ_aux (typ_subst_order_aux sv subst typ, l)
-and typ_subst_order_aux sv subst = function
-  | Typ_internal_unknown -> Typ_internal_unknown
-  | Typ_id v -> Typ_id v
-  | Typ_var kid -> Typ_var kid
-  | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst_order sv subst) arg_typs, typ_subst_order sv subst ret_typ, effs)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst_order sv subst typ1, typ_subst_order sv subst typ2)
-  | Typ_tup typs -> Typ_tup (List.map (typ_subst_order sv subst) typs)
-  | Typ_app (f, args) -> Typ_app (f, List.map (typ_subst_arg_order sv subst) args)
-  | Typ_exist (kids, nc, typ) -> Typ_exist (kids, nc, typ_subst_order sv subst typ)
-and typ_subst_arg_order sv subst (Typ_arg_aux (arg, l)) = Typ_arg_aux (typ_subst_arg_order_aux sv subst arg, l)
-and typ_subst_arg_order_aux sv subst = function
-  | Typ_arg_nexp nexp -> Typ_arg_nexp nexp
-  | Typ_arg_typ typ -> Typ_arg_typ (typ_subst_order sv subst typ)
-  | Typ_arg_order ord -> Typ_arg_order (order_subst sv subst ord)
-
-let rec typ_subst_kid sv subst (Typ_aux (typ, l)) = Typ_aux (typ_subst_kid_aux sv subst typ, l)
-and typ_subst_kid_aux sv subst = function
-  | Typ_internal_unknown -> Typ_internal_unknown
-  | Typ_id v -> Typ_id v
-  | Typ_var kid -> if Kid.compare kid sv = 0 then Typ_var subst else Typ_var kid
-  | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map (typ_subst_kid sv subst) arg_typs, typ_subst_kid sv subst ret_typ, effs)
-  | Typ_bidir (typ1, typ2) -> Typ_bidir (typ_subst_kid sv subst typ1, typ_subst_kid sv subst typ2)
-  | Typ_tup typs -> Typ_tup (List.map (typ_subst_kid sv subst) typs)
-  | Typ_app (f, args) -> Typ_app (f, List.map (typ_subst_arg_kid sv subst) args)
-  | Typ_exist (kids, nc, typ) when KidSet.mem sv (KidSet.of_list kids) -> Typ_exist (kids, nc, typ)
-  | Typ_exist (kids, nc, typ) -> Typ_exist (kids, nc_subst_nexp sv (Nexp_var subst) nc, typ_subst_kid sv subst typ)
-and typ_subst_arg_kid sv subst (Typ_arg_aux (arg, l)) = Typ_arg_aux (typ_subst_arg_kid_aux sv subst arg, l)
-and typ_subst_arg_kid_aux sv subst = function
-  | Typ_arg_nexp nexp -> Typ_arg_nexp (nexp_subst sv (Nexp_var subst) nexp)
-  | Typ_arg_typ typ -> Typ_arg_typ (typ_subst_kid sv subst typ)
-  | Typ_arg_order ord -> Typ_arg_order (order_subst sv (Ord_var subst) ord)
-
-let quant_item_subst_kid_aux sv subst = function
-  | QI_id (KOpt_aux (KOpt_none kid, l)) as qid ->
-     if Kid.compare kid sv = 0 then QI_id (KOpt_aux (KOpt_none subst, l)) else qid
-  | QI_id (KOpt_aux (KOpt_kind (k, kid), l)) as qid ->
-     if Kid.compare kid sv = 0 then QI_id (KOpt_aux (KOpt_kind (k, subst), l)) else qid
-  | QI_const nc -> QI_const (nc_subst_nexp sv (Nexp_var subst) nc)
-
-let quant_item_subst_kid sv subst (QI_aux (quant, l)) = QI_aux (quant_item_subst_kid_aux sv subst quant, l)
-
-let typquant_subst_kid_aux sv subst = function
-  | TypQ_tq quants -> TypQ_tq (List.map (quant_item_subst_kid sv subst) quants)
-  | TypQ_no_forall -> TypQ_no_forall
+(** Destructure and canonicalise a numeric type into a list of type
+   variables, a constraint on those type variables, and an
+   N-expression that represents that numeric type in the
+   environment. For example:
+   - {'n, 'n <= 10. atom('n)} => ['n], 'n <= 10, 'n
+   - int => ['n], true, 'n (where x is fresh)
+   - atom('n) => [], true, 'n
+**)
+let destruct_numeric typ =
+  match destruct_exist_plain typ, typ with
+  | Some (kids, nc, Typ_aux (Typ_app (id, [A_aux (A_nexp nexp, _)]), _)), _ when string_of_id id = "atom" ->
+     Some (List.map kopt_kid kids, nc, nexp)
+  | None, Typ_aux (Typ_app (id, [A_aux (A_nexp nexp, _)]), _) when string_of_id id = "atom" ->
+     Some ([], nc_true, nexp)
+  | None, Typ_aux (Typ_app (id, [A_aux (A_nexp lo, _); A_aux (A_nexp hi, _)]), _) when string_of_id id = "range" ->
+     let kid = kopt_kid (fresh_existential K_int) in
+     Some ([kid], nc_and (nc_lteq lo (nvar kid)) (nc_lteq (nvar kid) hi), nvar kid)
+  | None, Typ_aux (Typ_id id, _) when string_of_id id = "nat" ->
+     let kid = kopt_kid (fresh_existential K_int) in
+     Some ([kid], nc_lteq (nint 0) (nvar kid), nvar kid)
+  | None, Typ_aux (Typ_id id, _) when string_of_id id = "int" ->
+     let kid = kopt_kid (fresh_existential K_int) in
+     Some ([kid], nc_true, nvar kid)
+  | _, _ -> None
 
-let typquant_subst_kid sv subst (TypQ_aux (typq, l)) = TypQ_aux (typquant_subst_kid_aux sv subst typq, l)
+let destruct_exist typ =
+  match destruct_numeric typ with
+  | Some (kids, nc, nexp) -> Some (List.map (mk_kopt K_int) kids, nc, atom_typ nexp)
+  | None -> destruct_exist_plain typ
 
 let adding = Util.("Adding " |> darkgray |> clear)
 
 (**************************************************************************)
-(* 2. Environment                                                         *)
+(* 1. Environment                                                         *)
 (**************************************************************************)
 
 module Env : sig
@@ -366,24 +288,27 @@ module Env : sig
   val add_local : id -> mut * typ -> t -> t
   val get_locals : t -> (mut * typ) Bindings.t
   val add_variant : id -> typquant * type_union list -> t -> t
+  val add_scattered_variant : id -> typquant -> t -> t
+  val add_variant_clause : id -> type_union -> t -> t
+  val get_variant : id -> t -> typquant * type_union list
   val add_mapping : id -> typquant * typ * typ -> t -> t
   val add_union_id : id -> typquant * typ -> t -> t
+  val get_union_id  : id -> t -> typquant * typ
   val is_register : id -> t -> bool
   val get_register : id -> t -> effect * effect * typ
   val add_register : id -> effect -> effect -> typ -> t -> t
   val is_mutable : id -> t -> bool
   val get_constraints : t -> n_constraint list
   val add_constraint : n_constraint -> t -> t
-  val get_typ_var : kid -> t -> base_kind_aux
+  val get_typ_var : kid -> t -> kind_aux
   val get_typ_var_loc : kid -> t -> Ast.l
-  val get_typ_vars : t -> base_kind_aux KBindings.t
+  val get_typ_vars : t -> kind_aux KBindings.t
   val get_typ_var_locs : t -> Ast.l KBindings.t
-  val add_typ_var : l -> kid -> base_kind_aux -> t -> t
+  val add_typ_var : l -> kinded_id -> t -> t
   val get_ret_typ : t -> typ option
   val add_ret_typ : typ -> t -> t
-  val add_typ_synonym : id -> (t -> typ_arg list -> typ) -> t -> t
-  val get_typ_synonym : id -> t -> t -> typ_arg list -> typ
-  val add_constraint_synonym : id -> kid list -> n_constraint -> t -> t
+  val add_typ_synonym : id -> (t -> typ_arg list -> typ_arg) -> t -> t
+  val get_typ_synonym : id -> t -> t -> typ_arg list -> typ_arg
   val add_num_def : id -> nexp -> t -> t
   val get_num_def : id -> t -> nexp
   val add_overloads : id -> id list -> t -> t
@@ -406,16 +331,9 @@ module Env : sig
   val polymorphic_undefineds : t -> bool
   val lookup_id : ?raw:bool -> id -> t -> typ lvar
   val fresh_kid : ?kid:kid -> t -> kid
-
   val expand_synonyms : t -> typ -> typ
   val expand_constraint_synonyms : t -> n_constraint -> n_constraint
-  val expand_typquant_synonyms : t -> typquant -> typquant
-
-  val canonicalize : t -> typ -> typ
   val base_typ_of : t -> typ -> typ
-  val add_smt_op : id -> string -> t -> t
-  val get_smt_op : id -> t -> string
-  val have_smt_op : id -> t -> bool
   val allow_unknowns : t -> bool
   val set_allow_unknowns : bool -> t -> t
 
@@ -448,16 +366,14 @@ end = struct
       registers : (effect * effect * typ) Bindings.t;
       variants : (typquant * type_union list) Bindings.t;
       mappings : (typquant * typ * typ) Bindings.t;
-      typ_vars : (Ast.l * base_kind_aux) KBindings.t;
-      typ_synonyms : (t -> typ_arg list -> typ) Bindings.t;
+      typ_vars : (Ast.l * kind_aux) KBindings.t;
+      typ_synonyms : (t -> typ_arg list -> typ_arg) Bindings.t;
       num_defs : nexp Bindings.t;
       overloads : (id list) Bindings.t;
       enums : IdSet.t Bindings.t;
       records : (typquant * (typ * id) list) Bindings.t;
       accessors : (typquant * typ) Bindings.t;
       externs : (string * string) list Bindings.t;
-      smt_ops : string Bindings.t;
-      constraint_synonyms : (kid list * n_constraint) Bindings.t;
       casts : id list;
       allow_casts : bool;
       allow_bindings : bool;
@@ -485,8 +401,6 @@ end = struct
       records = Bindings.empty;
       accessors = Bindings.empty;
       externs = Bindings.empty;
-      smt_ops = Bindings.empty;
-      constraint_synonyms = Bindings.empty;
       casts = [];
       allow_bindings = true;
       allow_casts = true;
@@ -514,26 +428,27 @@ end = struct
   let get_typ_vars env = KBindings.map snd env.typ_vars
   let get_typ_var_locs env = KBindings.map fst env.typ_vars
 
-  let bk_counter = ref 0
-  let bk_name () = let kid = mk_kid ("bk#" ^ string_of_int !bk_counter) in incr bk_counter; kid
+  let k_counter = ref 0
+  let k_name () = let kid = mk_kid ("k#" ^ string_of_int !k_counter) in incr k_counter; kid
 
-  let kinds_typq kinds = mk_typquant (List.map (fun k -> mk_qi_id k (bk_name ())) kinds)
+  let kinds_typq kinds = mk_typquant (List.map (fun k -> mk_qi_id k (k_name ())) kinds)
 
   let builtin_typs =
     List.fold_left (fun m (name, kinds) -> Bindings.add (mk_id name) (kinds_typq kinds) m) Bindings.empty
-      [ ("range", [BK_int; BK_int]);
-        ("atom", [BK_int]);
-        ("vector", [BK_int; BK_order; BK_type]);
-        ("register", [BK_type]);
+      [ ("range", [K_int; K_int]);
+        ("atom", [K_int]);
+        ("vector", [K_int; K_order; K_type]);
+        ("register", [K_type]);
         ("bit", []);
         ("unit", []);
         ("int", []);
         ("nat", []);
         ("bool", []);
         ("real", []);
-        ("list", [BK_type]);
+        ("list", [K_type]);
         ("string", []);
-        ("itself", [BK_int])
+        ("itself", [K_int]);
+        ("atom_bool", [K_bool])
       ]
 
   let builtin_mappings =
@@ -559,21 +474,6 @@ end = struct
     let existing = try Bindings.find id env.overloads with Not_found -> [] in
     { env with overloads = Bindings.add id (existing @ ids) env.overloads }
 
-  let add_smt_op id str env =
-    typ_print (lazy (adding ^ "smt binding " ^ string_of_id id ^ " to " ^ str));
-    { env with smt_ops = Bindings.add id str env.smt_ops }
-
-  let get_smt_op (Id_aux (_, l) as id) env =
-    let rec first_smt_op = function
-      | id :: ids -> (try Bindings.find id env.smt_ops with Not_found -> first_smt_op ids)
-      | [] -> typ_error l ("No SMT op for " ^ string_of_id id)
-    in
-    try Bindings.find id env.smt_ops with
-    | Not_found -> first_smt_op (get_overloads id env)
-
-  let have_smt_op id env =
-    try ignore(get_smt_op id env); true with Type_error _ -> false
-
   let rec infer_kind env id =
     if Bindings.mem id builtin_typs then
       Bindings.find id builtin_typs
@@ -592,14 +492,16 @@ end = struct
     let kopts, ncs = quant_split typq in
     let rec subst_args kopts args =
       match kopts, args with
-      | kopt :: kopts, Typ_arg_aux (Typ_arg_nexp arg, _) :: args when is_nat_kopt kopt ->
-         List.map (nc_subst_nexp (kopt_kid kopt) (unaux_nexp arg)) (subst_args kopts args)
-      | kopt :: kopts, Typ_arg_aux (Typ_arg_typ arg, _) :: args when is_typ_kopt kopt ->
+      | kopt :: kopts, (A_aux (A_nexp _, _) as arg) :: args when is_nat_kopt kopt ->
+         List.map (constraint_subst (kopt_kid kopt) arg) (subst_args kopts args)
+      | kopt :: kopts, A_aux (A_typ arg, _) :: args when is_typ_kopt kopt ->
+         subst_args kopts args
+      | kopt :: kopts, A_aux (A_order arg, _) :: args when is_order_kopt kopt ->
          subst_args kopts args
-      | kopt :: kopts, Typ_arg_aux (Typ_arg_order arg, _) :: args when is_order_kopt kopt ->
+      | kopt :: kopts, A_aux (A_bool arg, _) :: args when is_bool_kopt kopt ->
          subst_args kopts args
       | [], [] -> ncs
-      | _, Typ_arg_aux (_, l) :: _ -> typ_error l ("Error when processing type quantifer arguments " ^ string_of_typquant typq)
+      | _, A_aux (_, l) :: _ -> typ_error l ("Error when processing type quantifer arguments " ^ string_of_typquant typq)
       | _, _ -> typ_error Parse_ast.Unknown ("Error when processing type quantifer arguments " ^ string_of_typquant typq)
     in
     let ncs = subst_args kopts args in
@@ -607,50 +509,43 @@ end = struct
     then ()
     else typ_error (id_loc id) ("Could not prove " ^ string_of_list ", " string_of_n_constraint ncs ^ " for type constructor " ^ string_of_id id)
 
-  let rec expand_constraint_synonyms env (NC_aux (nc_aux, l) as nc) =
-    let expand = expand_constraint_synonyms env in
-    match nc_aux with
-    | NC_app (id, nexps) ->
-       begin
-         try
-           let kids, nc = Bindings.find id env.constraint_synonyms in
-           let nc = List.fold_left2 (fun nc kid nexp -> nc_subst_nexp kid (unaux_nexp nexp) nc) nc kids nexps in
-           expand nc
-         with Not_found -> typ_error l ("Could not expand constraint synonym in " ^ string_of_n_constraint nc)
-       end
-    | NC_and (nc1, nc2) -> NC_aux (NC_and (expand nc1, expand nc2), l)
-    | NC_or (nc1, nc2) -> NC_aux (NC_or (expand nc1, expand nc2), l)
-    | NC_true | NC_false | NC_set _ | NC_equal _ | NC_not_equal _ | NC_bounded_le _ | NC_bounded_ge _  -> nc
-
-  let expand_quant_item_synonyms env = function
-    | QI_aux (QI_id kopt, l) -> QI_aux (QI_id kopt, l)
-    | QI_aux (QI_const nc, l) -> QI_aux (QI_const (expand_constraint_synonyms env nc), l)
-
-  let expand_typquant_synonyms env = quant_map_items (expand_quant_item_synonyms env)
+  let rec expand_constraint_synonyms env (NC_aux (aux, l) as nc) =
+    typ_debug ~level:2 (lazy ("Expanding " ^ string_of_n_constraint nc));
+    match aux with
+    | NC_or (nc1, nc2) -> NC_aux (NC_or (expand_constraint_synonyms env nc1, expand_constraint_synonyms env nc2), l)
+    | NC_and (nc1, nc2) -> NC_aux (NC_and (expand_constraint_synonyms env nc1, expand_constraint_synonyms env nc2), l)
+    | NC_app (id, args) ->
+       (try
+          begin match Bindings.find id env.typ_synonyms env args with
+          | A_aux (A_bool nc, _) -> expand_constraint_synonyms env nc
+          | arg -> typ_error l ("Expected Bool when expanding synonym " ^ string_of_id id ^ " got " ^ string_of_typ_arg arg)
+          end
+        with Not_found -> NC_aux (NC_app (id, List.map (expand_synonyms_arg env) args), l))
+    | NC_true | NC_false | NC_equal _ | NC_not_equal _ | NC_bounded_le _ | NC_bounded_ge _ | NC_var _ | NC_set _ -> nc
 
-  let rec expand_synonyms env (Typ_aux (typ, l) as t) =
+  and expand_synonyms env (Typ_aux (typ, l) as t) =
     match typ with
     | Typ_internal_unknown -> Typ_aux (Typ_internal_unknown, l)
     | Typ_tup typs -> Typ_aux (Typ_tup (List.map (expand_synonyms env) typs), l)
     | Typ_fn (arg_typs, ret_typ, effs) -> Typ_aux (Typ_fn (List.map (expand_synonyms env) arg_typs, expand_synonyms env ret_typ, effs), l)
     | Typ_bidir (typ1, typ2) -> Typ_aux (Typ_bidir (expand_synonyms env typ1, expand_synonyms env typ2), l)
     | Typ_app (id, args) ->
-       begin
-         try
-           let synonym = Bindings.find id env.typ_synonyms in
-           expand_synonyms env (synonym env args)
-         with
-       | Not_found -> Typ_aux (Typ_app (id, List.map (expand_synonyms_arg env) args), l)
-       end
+       (try
+          begin match Bindings.find id env.typ_synonyms env args with
+          | A_aux (A_typ typ, _) -> expand_synonyms env typ
+          | _ -> typ_error l ("Expected Type when expanding synonym " ^ string_of_id id)
+          end
+        with
+        | Not_found -> Typ_aux (Typ_app (id, List.map (expand_synonyms_arg env) args), l))
     | Typ_id id ->
-       begin
-         try
-           let synonym = Bindings.find id env.typ_synonyms in
-           expand_synonyms env (synonym env [])
-         with
-         | Not_found -> Typ_aux (Typ_id id, l)
-       end
-    | Typ_exist (kids, nc, typ) ->
+       (try
+          begin match Bindings.find id env.typ_synonyms env [] with
+          | A_aux (A_typ typ, _) -> expand_synonyms env typ
+          | _ -> typ_error l ("Expected Type when expanding synonym " ^ string_of_id id)
+          end
+        with
+        | Not_found -> Typ_aux (Typ_id id, l))
+    | Typ_exist (kopts, nc, typ) ->
        (* When expanding an existential synonym we need to take care
           to add the type variables and constraints to the
           environment, so we can check constraints attached to type
@@ -659,29 +554,33 @@ end = struct
           scope while doing this. *)
        let rebindings = ref [] in
 
-       let rename_kid kid = if KBindings.mem kid env.typ_vars then prepend_kid "syn#" kid else kid in
-       let add_typ_var env kid =
+       let rename_kopt (KOpt_aux (KOpt_kind (k, kid), l) as kopt) =
+         if KBindings.mem kid env.typ_vars then
+           KOpt_aux (KOpt_kind (k, prepend_kid "syn#" kid), l)
+         else kopt
+       in
+       let add_typ_var env (KOpt_aux (KOpt_kind (k, kid), l) as kopt) =
          try
            let (l, _) = KBindings.find kid env.typ_vars in
            rebindings := kid :: !rebindings;
-           { env with typ_vars = KBindings.add (prepend_kid "syn#" kid) (l, BK_int) env.typ_vars }
+           { env with typ_vars = KBindings.add (prepend_kid "syn#" kid) (l, unaux_kind k) env.typ_vars }
          with
          | Not_found ->
-            { env with typ_vars = KBindings.add kid (l, BK_int) env.typ_vars }
+            { env with typ_vars = KBindings.add kid (l, unaux_kind k) env.typ_vars }
        in
 
-       let env = List.fold_left add_typ_var env kids in
-       let kids = List.map rename_kid kids in
-       let nc = List.fold_left (fun nc kid -> nc_subst_nexp kid (Nexp_var (prepend_kid "syn#" kid)) nc) nc !rebindings in
-       let typ = List.fold_left (fun typ kid -> typ_subst_nexp kid (Nexp_var (prepend_kid "syn#" kid)) typ) typ !rebindings in
-       typ_debug (lazy ("Synonym existential: {" ^ string_of_list " " string_of_kid kids ^ ", " ^ string_of_n_constraint nc ^ ". " ^ string_of_typ typ ^ "}"));
+       let env = List.fold_left add_typ_var env kopts in
+       let kopts = List.map rename_kopt kopts in
+       let nc = List.fold_left (fun nc kid -> constraint_subst kid (arg_nexp (nvar (prepend_kid "syn#" kid))) nc) nc !rebindings in
+       let typ = List.fold_left (fun typ kid -> typ_subst kid (arg_nexp (nvar (prepend_kid "syn#" kid))) typ) typ !rebindings in
        let env = { env with constraints = nc :: env.constraints } in
-       Typ_aux (Typ_exist (kids, nc, expand_synonyms env typ), l)
+       Typ_aux (Typ_exist (kopts, nc, expand_synonyms env typ), l)
     | Typ_var v -> Typ_aux (Typ_var v, l)
-  and expand_synonyms_arg env (Typ_arg_aux (typ_arg, l)) =
+  and expand_synonyms_arg env (A_aux (typ_arg, l)) =
     match typ_arg with
-    | Typ_arg_typ typ -> Typ_arg_aux (Typ_arg_typ (expand_synonyms env typ), l)
-    | arg -> Typ_arg_aux (arg, l)
+    | A_typ typ -> A_aux (A_typ (expand_synonyms env typ), l)
+    | A_bool nc -> A_aux (A_bool (expand_constraint_synonyms env nc), l)
+    | arg -> A_aux (arg, l)
 
   (** Map over all nexps in a type - excluding those in existential constraints **)
   let rec map_nexps f (Typ_aux (typ_aux, l) as typ) =
@@ -693,62 +592,18 @@ end = struct
     | Typ_tup typs -> Typ_aux (Typ_tup (List.map (map_nexps f) typs), l)
     | Typ_exist (kids, nc, typ) -> Typ_aux (Typ_exist (kids, nc, map_nexps f typ), l)
     | Typ_app (id, args) -> Typ_aux (Typ_app (id, List.map (map_nexps_arg f) args), l)
-  and map_nexps_arg f (Typ_arg_aux (arg_aux, l) as arg) =
+  and map_nexps_arg f (A_aux (arg_aux, l) as arg) =
     match arg_aux with
-    | Typ_arg_order _ | Typ_arg_typ _ -> arg
-    | Typ_arg_nexp n -> Typ_arg_aux (Typ_arg_nexp (f n), l)
-
-  let canonical env typ =
-    let typ = expand_synonyms env typ in
-    let counter = ref 0 in
-    let complex_nexps = ref KBindings.empty in
-    let simplify_nexp (Nexp_aux (nexp_aux, l) as nexp) =
-      match nexp_aux with
-      | Nexp_constant _ -> nexp (* Check this ? *)
-      | _ ->
-         let kid = Kid_aux (Var ("'c#" ^ string_of_int !counter), l) in
-         complex_nexps := KBindings.add kid nexp !complex_nexps;
-         incr counter;
-         Nexp_aux (Nexp_var kid, l)
-    in
-    let typ = map_nexps (fun nexp -> simplify_nexp (nexp_simp nexp)) typ in
-    let existentials = KBindings.bindings !complex_nexps |> List.map fst in
-    let constrs = List.fold_left (fun ncs (kid, nexp) -> nc_eq (nvar kid) nexp :: ncs) [] (KBindings.bindings !complex_nexps) in
-    existentials, constrs, typ
-
-  let is_canonical env typ =
-    let typ = expand_synonyms env typ in
-    let counter = ref 0 in
-    let simplify_nexp (Nexp_aux (nexp_aux, l) as nexp) =
-      match nexp_aux with
-      | Nexp_constant _ -> nexp
-      | _ -> (incr counter; nexp)
-    in
-    let typ = map_nexps simplify_nexp typ in
-    not (!counter > 0)
+    | A_order _ | A_typ _ | A_bool _ -> arg
+    | A_nexp n -> A_aux (A_nexp (f n), l)
 
-  let rec canonicalize env typ =
-    match typ with
-    | Typ_aux (Typ_fn (arg_typs, ret_typ, effects), l) when List.for_all (is_canonical env) arg_typs ->
-       Typ_aux (Typ_fn (arg_typs, canonicalize env ret_typ, effects), l)
-    | Typ_aux (Typ_fn _, l) -> typ_error l ("Function type " ^ string_of_typ typ ^ " is not canonical")
-    | _ ->
-       let existentials, constrs, (Typ_aux (typ_aux, l) as typ) = canonical env typ in
-       if existentials = [] then
-         typ
-       else
-         let typ_aux = match typ_aux with
-           | Typ_tup _ | Typ_app _ -> Typ_exist (existentials, List.fold_left nc_and (List.hd constrs) (List.tl constrs), typ)
-           | Typ_exist (kids, nc, typ) -> Typ_exist (kids @ existentials, List.fold_left nc_and nc constrs, typ)
-           | Typ_fn _ | Typ_bidir _ | Typ_id _ | Typ_var _ -> assert false (* These must be simple *)
-           | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-         in
-         Typ_aux (typ_aux, l)
+  let wf_debug str f x exs =
+    typ_debug ~level:2 (lazy ("wf_" ^ str ^ ": " ^ f x ^ " exs: " ^ Util.string_of_list ", " string_of_kid (KidSet.elements exs)))
 
   (* Check if a type, order, n-expression or constraint is
      well-formed. Throws a type error if the type is badly formed. *)
   let rec wf_typ ?exs:(exs=KidSet.empty) env typ =
-    typ_debug (lazy ("well-formed " ^ string_of_typ typ));
+    wf_debug "typ" string_of_typ typ exs;
     let (Typ_aux (typ_aux, l)) = expand_synonyms env typ in
     match typ_aux with
     | Typ_id id when bound_typ_id env id ->
@@ -759,9 +614,9 @@ end = struct
     | Typ_id id -> typ_error l ("Undefined type " ^ string_of_id id)
     | Typ_var kid -> begin
       match KBindings.find kid env.typ_vars with
-      | (_, BK_type) -> ()
+      | (_, K_type) -> ()
       | (_, k) -> typ_error l ("Kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ
-                               ^ " is " ^ string_of_base_kind_aux k ^ " rather than Type")
+                               ^ " is " ^ string_of_kind_aux k ^ " rather than Type")
       | exception Not_found ->
          typ_error l ("Unbound kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ)
     end
@@ -775,71 +630,75 @@ end = struct
        check_args_typquant id env args (infer_kind env id)
     | Typ_app (id, _) -> typ_error l ("Undefined type " ^ string_of_id id)
     | Typ_exist ([], _, _) -> typ_error l ("Existential must have some type variables")
-    | Typ_exist (kids, nc, typ) when KidSet.is_empty exs ->
-       wf_constraint ~exs:(KidSet.of_list kids) env nc;
-       wf_typ ~exs:(KidSet.of_list kids) { env with constraints = nc :: env.constraints } typ
+    | Typ_exist (kopts, nc, typ) when KidSet.is_empty exs ->
+       wf_constraint ~exs:(KidSet.of_list (List.map kopt_kid kopts)) env nc;
+       wf_typ ~exs:(KidSet.of_list (List.map kopt_kid kopts)) { env with constraints = nc :: env.constraints } typ
     | Typ_exist (_, _, _) -> typ_error l ("Nested existentials are not allowed")
     | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-  and wf_typ_arg ?exs:(exs=KidSet.empty) env (Typ_arg_aux (typ_arg_aux, _)) =
+  and wf_typ_arg ?exs:(exs=KidSet.empty) env (A_aux (typ_arg_aux, _)) =
     match typ_arg_aux with
-    | Typ_arg_nexp nexp -> wf_nexp ~exs:exs env nexp
-    | Typ_arg_typ typ -> wf_typ ~exs:exs env typ
-    | Typ_arg_order ord -> wf_order env ord
+    | A_nexp nexp -> wf_nexp ~exs:exs env nexp
+    | A_typ typ -> wf_typ ~exs:exs env typ
+    | A_order ord -> wf_order env ord
+    | A_bool nc -> wf_constraint ~exs:exs env nc
   and wf_nexp ?exs:(exs=KidSet.empty) env (Nexp_aux (nexp_aux, l) as nexp) =
-    typ_debug (lazy ("well-formed nexp " ^ string_of_nexp nexp));
+    wf_debug "nexp" string_of_nexp nexp exs;
     match nexp_aux with
     | Nexp_id _ -> ()
     | Nexp_var kid when KidSet.mem kid exs -> ()
     | Nexp_var kid ->
        begin
          match get_typ_var kid env with
-         | BK_int -> ()
+         | K_int -> ()
          | kind -> typ_error l ("Constraint is badly formed, "
                                 ^ string_of_kid kid ^ " has kind "
-                                ^ string_of_base_kind_aux kind ^ " but should have kind Int")
+                                ^ string_of_kind_aux kind ^ " but should have kind Int")
        end
     | Nexp_constant _ -> ()
     | Nexp_app (id, nexps) ->
-       let _ = get_smt_op id env in
        List.iter (fun n -> wf_nexp ~exs:exs env n) nexps
     | Nexp_times (nexp1, nexp2) -> wf_nexp ~exs:exs env nexp1; wf_nexp ~exs:exs env nexp2
     | Nexp_sum (nexp1, nexp2) -> wf_nexp ~exs:exs env nexp1; wf_nexp ~exs:exs env nexp2
     | Nexp_minus (nexp1, nexp2) -> wf_nexp ~exs:exs env nexp1; wf_nexp ~exs:exs env nexp2
     | Nexp_exp nexp -> wf_nexp ~exs:exs env nexp (* MAYBE: Could put restrictions on what is allowed here *)
     | Nexp_neg nexp -> wf_nexp ~exs:exs env nexp
-  and wf_order env (Ord_aux (ord_aux, l)) =
+  and wf_order env (Ord_aux (ord_aux, l) as ord) =
     match ord_aux with
     | Ord_var kid ->
        begin
          match get_typ_var kid env with
-         | BK_order -> ()
+         | K_order -> ()
          | kind -> typ_error l ("Order is badly formed, "
                                 ^ string_of_kid kid ^ " has kind "
-                                ^ string_of_base_kind_aux kind ^ " but should have kind Order")
+                                ^ string_of_kind_aux kind ^ " but should have kind Order")
        end
     | Ord_inc | Ord_dec -> ()
   and wf_constraint ?exs:(exs=KidSet.empty) env (NC_aux (nc_aux, l) as nc) =
-    typ_debug (lazy ("well-formed constraint " ^ string_of_n_constraint nc));
+    wf_debug "constraint" string_of_n_constraint nc exs;
     match nc_aux with
     | NC_equal (n1, n2) -> wf_nexp ~exs:exs env n1; wf_nexp ~exs:exs env n2
     | NC_not_equal (n1, n2) -> wf_nexp ~exs:exs env n1; wf_nexp ~exs:exs env n2
     | NC_bounded_ge (n1, n2) -> wf_nexp ~exs:exs env n1; wf_nexp ~exs:exs env n2
     | NC_bounded_le (n1, n2) -> wf_nexp ~exs:exs env n1; wf_nexp ~exs:exs env n2
     | NC_set (kid, _) when KidSet.mem kid exs -> ()
-    | NC_set (kid, _) -> begin
-        match get_typ_var kid env with
-        | BK_int -> ()
-        | kind -> typ_error l ("Set constraint is badly formed, "
-                               ^ string_of_kid kid ^ " has kind "
-                               ^ string_of_base_kind_aux kind ^ " but should have kind Int")
-      end
+    | NC_set (kid, _) ->
+       begin match get_typ_var kid env with
+       | K_int -> ()
+       | kind -> typ_error l ("Set constraint is badly formed, "
+                              ^ string_of_kid kid ^ " has kind "
+                              ^ string_of_kind_aux kind ^ " but should have kind Int")
+       end
     | NC_or (nc1, nc2) -> wf_constraint ~exs:exs env nc1; wf_constraint ~exs:exs env nc2
     | NC_and (nc1, nc2) -> wf_constraint ~exs:exs env nc1; wf_constraint ~exs:exs env nc2
-    | NC_app (id, nexps) ->
-       if not (Bindings.mem id env.constraint_synonyms) then
-         typ_error l ("Constraint synonym " ^ string_of_id id ^ " is not defined")
-       else ();
-       List.iter (wf_nexp ~exs:exs env) nexps
+    | NC_app (id, args) -> List.iter (wf_typ_arg ~exs:exs env) args
+    | NC_var kid when KidSet.mem kid exs -> ()
+    | NC_var kid ->
+       begin match get_typ_var kid env with
+       | K_bool -> ()
+       | kind -> typ_error l ("Set constraint is badly formed, "
+                              ^ string_of_kid kid ^ " has kind "
+                              ^ string_of_kind_aux kind ^ " but should have kind Bool")
+       end
     | NC_true | NC_false -> ()
 
   let counter = ref 0
@@ -852,7 +711,7 @@ end = struct
   let freshen_kid env kid (typq, typ) =
     let fresh = fresh_kid ~kid:kid env in
     if KidSet.mem kid (KidSet.of_list (List.map kopt_kid (quant_kopts typq))) then
-      (typquant_subst_kid kid fresh typq, typ_subst_kid kid fresh typ)
+      (typquant_subst_kid kid fresh typq, subst_kid typ_subst kid fresh typ)
     else
       (typq, typ)
 
@@ -868,28 +727,59 @@ end = struct
   let get_val_spec id env =
     try
       let bind = Bindings.find id env.top_val_specs in
-      typ_debug (lazy ("get_val_spec: Env has " ^ string_of_list ", " (fun (kid, (_, bk)) -> string_of_kid kid ^ " => " ^ string_of_base_kind_aux bk) (KBindings.bindings env.typ_vars)));
+      typ_debug (lazy ("get_val_spec: Env has " ^ string_of_list ", " (fun (kid, (_, k)) -> string_of_kid kid ^ " => " ^ string_of_kind_aux k) (KBindings.bindings env.typ_vars)));
       let bind' = List.fold_left (fun bind (kid, _) -> freshen_kid env kid bind) bind (KBindings.bindings env.typ_vars) in
       typ_debug (lazy ("get_val_spec: freshened to " ^ string_of_bind bind'));
       bind'
     with
     | Not_found -> typ_error (id_loc id) ("No val spec found for " ^ string_of_id id)
 
+  let add_union_id id bind env =
+    typ_print (lazy (adding ^ "union identifier " ^ string_of_id id ^ " : " ^ string_of_bind bind));
+    { env with union_ids = Bindings.add id bind env.union_ids }
+
+  let get_union_id id env =
+    try
+      let bind = Bindings.find id env.union_ids in
+      List.fold_left (fun bind (kid, _) -> freshen_kid env kid bind) bind (KBindings.bindings env.typ_vars)
+    with
+    | Not_found -> typ_error (id_loc id) ("No union constructor found for " ^ string_of_id id)
+
   let rec update_val_spec id (typq, typ) env =
-    begin
-      let typ = expand_synonyms env typ in
-      let typq = expand_typquant_synonyms env typq in
-      typ_print (lazy (adding ^ "val spec " ^ string_of_id id ^ " : " ^ string_of_bind (typq, typ)));
-      let env = match typ with
-        | Typ_aux (Typ_bidir (typ1, typ2), _) -> add_mapping id (typq, typ1, typ2) env
-        | _ -> env
-      in
-      { env with top_val_specs = Bindings.add id (typq, typ) env.top_val_specs }
+    begin match expand_synonyms env typ with
+    | Typ_aux (Typ_fn (arg_typs, ret_typ, effect), l) ->
+       (* We perform some canonicalisation for function types where existentials appear on the left, so
+          ({'n, 'n >= 2, int('n)}, foo) -> bar
+          would become
+          forall 'n, 'n >= 2. (int('n), foo) -> bar
+          this enforces the invariant that all things on the left of functions are 'base types' (i.e. without existentials)
+        *)
+       let base_args = List.map (fun typ -> destruct_exist (expand_synonyms env typ)) arg_typs in
+       let existential_arg typq = function
+         | None -> typq
+         | Some (exs, nc, _) ->
+            List.fold_left (fun typq kopt -> quant_add (mk_qi_kopt kopt) typq) (quant_add (mk_qi_nc nc) typq) exs
+       in
+       let typq = List.fold_left existential_arg typq base_args in
+       let arg_typs = List.map2 (fun typ -> function Some (_, _, typ) -> typ | None -> typ) arg_typs base_args in
+       let typ = Typ_aux (Typ_fn (arg_typs, ret_typ, effect), l) in
+       typ_print (lazy (adding ^ "val " ^ string_of_id id ^ " : " ^ string_of_bind (typq, typ)));
+       { env with top_val_specs = Bindings.add id (typq, typ) env.top_val_specs }
+
+    | Typ_aux (Typ_bidir (typ1, typ2), l) ->
+       let env = add_mapping id (typq, typ1, typ2) env in
+       typ_print (lazy (adding ^ "mapping " ^ string_of_id id ^ " : " ^ string_of_bind (typq, typ)));
+       { env with top_val_specs = Bindings.add id (typq, typ) env.top_val_specs }
+
+    | _ -> typ_error (id_loc id) "val definition must have a mapping or function type"
     end
+
   and add_val_spec id (bind_typq, bind_typ) env =
     if not (Bindings.mem id env.top_val_specs)
     then update_val_spec id (bind_typq, bind_typ) env
     else
+      env
+        (*
       let (existing_typq, existing_typ) = Bindings.find id env.top_val_specs in
       let existing_cmp = (strip_typq existing_typq, strip_typ existing_typ) in
       let bind_cmp = (strip_typq bind_typq, strip_typ bind_typ) in
@@ -897,35 +787,34 @@ end = struct
         typ_error (id_loc id) ("Identifier " ^ string_of_id id ^ " is already bound as " ^ string_of_bind (existing_typq, existing_typ) ^ ", cannot rebind as " ^ string_of_bind (bind_typq, bind_typ))
       else
         env
+         *)
+
   and add_mapping id (typq, typ1, typ2) env =
-    begin
-      typ_print (lazy (adding ^ "mapping " ^ string_of_id id));
-      let forwards_id = mk_id (string_of_id id ^ "_forwards") in
-      let forwards_matches_id = mk_id (string_of_id id ^ "_forwards_matches") in
-      let backwards_id = mk_id (string_of_id id ^ "_backwards") in
-      let backwards_matches_id = mk_id (string_of_id id ^ "_backwards_matches") in
-      let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, no_effect), Parse_ast.Unknown) in
-      let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, no_effect), Parse_ast.Unknown) in
-      let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, no_effect), Parse_ast.Unknown) in
-      let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, no_effect), Parse_ast.Unknown) in
-      let env =
-        { env with mappings = Bindings.add id (typq, typ1, typ2) env.mappings }
-        |> add_val_spec forwards_id (typq, forwards_typ)
-        |> add_val_spec backwards_id (typq, backwards_typ)
-        |> add_val_spec forwards_matches_id (typq, forwards_matches_typ)
-        |> add_val_spec backwards_matches_id (typq, backwards_matches_typ)
-      in
-      let prefix_id = mk_id (string_of_id id ^ "_matches_prefix") in
-      begin if strip_typ typ1 = string_typ then
-              let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
-              add_val_spec prefix_id (typq, forwards_prefix_typ) env
-            else if strip_typ typ2 = string_typ then
-              let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [Typ_arg_aux (Typ_arg_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
-              add_val_spec prefix_id (typq, backwards_prefix_typ) env
-            else
-              env
-      end
-    end
+    typ_print (lazy (adding ^ "mapping " ^ string_of_id id));
+    let forwards_id = mk_id (string_of_id id ^ "_forwards") in
+    let forwards_matches_id = mk_id (string_of_id id ^ "_forwards_matches") in
+    let backwards_id = mk_id (string_of_id id ^ "_backwards") in
+    let backwards_matches_id = mk_id (string_of_id id ^ "_backwards_matches") in
+    let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, no_effect), Parse_ast.Unknown) in
+    let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, no_effect), Parse_ast.Unknown) in
+    let backwards_typ = Typ_aux (Typ_fn ([typ2], typ1, no_effect), Parse_ast.Unknown) in
+    let backwards_matches_typ = Typ_aux (Typ_fn ([typ2], bool_typ, no_effect), Parse_ast.Unknown) in
+    let env =
+      { env with mappings = Bindings.add id (typq, typ1, typ2) env.mappings }
+      |> add_val_spec forwards_id (typq, forwards_typ)
+      |> add_val_spec backwards_id (typq, backwards_typ)
+      |> add_val_spec forwards_matches_id (typq, forwards_matches_typ)
+      |> add_val_spec backwards_matches_id (typq, backwards_matches_typ)
+    in
+    let prefix_id = mk_id (string_of_id id ^ "_matches_prefix") in
+    if strip_typ typ1 = string_typ then
+      let forwards_prefix_typ = Typ_aux (Typ_fn ([typ1], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ2; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+      add_val_spec prefix_id (typq, forwards_prefix_typ) env
+    else if strip_typ typ2 = string_typ then
+      let backwards_prefix_typ = Typ_aux (Typ_fn ([typ2], app_typ (mk_id "option") [A_aux (A_typ (tuple_typ [typ1; nat_typ]), Parse_ast.Unknown)], no_effect), Parse_ast.Unknown) in
+      add_val_spec prefix_id (typq, backwards_prefix_typ) env
+    else
+      env
 
   let define_val_spec id env =
     if IdSet.mem id env.defined_val_specs
@@ -979,11 +868,11 @@ end = struct
         let rec record_typ_args = function
           | [] -> []
           | ((QI_aux (QI_id kopt, _)) :: qis) when is_nat_kopt kopt ->
-             mk_typ_arg (Typ_arg_nexp (nvar (kopt_kid kopt))) :: record_typ_args qis
+             mk_typ_arg (A_nexp (nvar (kopt_kid kopt))) :: record_typ_args qis
           | ((QI_aux (QI_id kopt, _)) :: qis) when is_typ_kopt kopt ->
-             mk_typ_arg (Typ_arg_typ (mk_typ (Typ_var (kopt_kid kopt)))) :: record_typ_args qis
+             mk_typ_arg (A_typ (mk_typ (Typ_var (kopt_kid kopt)))) :: record_typ_args qis
           | ((QI_aux (QI_id kopt, _)) :: qis) when is_order_kopt kopt ->
-             mk_typ_arg (Typ_arg_order (mk_ord (Ord_var (kopt_kid kopt)))) :: record_typ_args qis
+             mk_typ_arg (A_order (mk_ord (Ord_var (kopt_kid kopt)))) :: record_typ_args qis
           | (_ :: qis) -> record_typ_args qis
         in
         let rectyp = match record_typ_args (quant_items typq) with
@@ -1037,16 +926,22 @@ end = struct
     end
 
   let add_variant id variant env =
-    begin
-      typ_print (lazy (adding ^ "variant " ^ string_of_id id));
-      { env with variants = Bindings.add id variant env.variants }
-    end
+    typ_print (lazy (adding ^ "variant " ^ string_of_id id));
+    { env with variants = Bindings.add id variant env.variants }
 
-  let add_union_id id bind env =
-    begin
-      typ_print (lazy (adding ^ "union identifier " ^ string_of_id id ^ " : " ^ string_of_bind bind));
-      { env with union_ids = Bindings.add id bind env.union_ids }
-    end
+  let add_scattered_variant id typq env =
+    typ_print (lazy (adding ^ "scattered variant " ^ string_of_id id));
+    { env with variants = Bindings.add id (typq, []) env.variants }
+
+  let add_variant_clause id tu env =
+    match Bindings.find_opt id env.variants with
+    | Some (typq, tus) -> { env with variants = Bindings.add id (typq, tus @ [tu]) env.variants }
+    | None -> typ_error (id_loc id) ("scattered union " ^ string_of_id id ^ " not found")
+
+  let get_variant id env =
+    match Bindings.find_opt id env.variants with
+    | Some (typq, tus) -> typq, tus
+    | None -> typ_error (id_loc id) ("union " ^ string_of_id id ^ " not found")
 
   let is_register id env =
     Bindings.mem id env.registers
@@ -1102,12 +997,12 @@ end = struct
     with
     | Not_found -> Unbound
 
-  let add_typ_var l kid k env =
+  let add_typ_var l (KOpt_aux (KOpt_kind (K_aux (k, _), kid), _) as kopt) env =
     if KBindings.mem kid env.typ_vars
-    then typ_error (kid_loc kid) ("type variable " ^ string_of_kid kid ^ " is already bound")
+    then typ_error (kid_loc kid) ("type variable " ^ string_of_kinded_id kopt ^ " is already bound")
     else
       begin
-        typ_print (lazy (adding ^ "type variable " ^ string_of_kid kid ^ " : " ^ string_of_base_kind_aux k));
+        typ_print (lazy (adding ^ "type variable " ^ string_of_kid kid ^ " : " ^ string_of_kind_aux k));
         { env with typ_vars = KBindings.add kid (l, k) env.typ_vars }
       end
 
@@ -1126,12 +1021,12 @@ end = struct
 
   let get_constraints env = env.constraints
 
-  let add_constraint (NC_aux (nc_aux, l) as constr) env =
+  let add_constraint constr env =
     wf_constraint env constr;
+    let (NC_aux (nc_aux, l) as constr) = expand_constraint_synonyms env constr in
     match nc_aux with
     | NC_true -> env
     | _ ->
-       let constr = expand_constraint_synonyms env constr in
        typ_print (lazy (adding ^ "constraint " ^ string_of_n_constraint constr));
        { env with constraints = constr :: env.constraints }
 
@@ -1161,16 +1056,6 @@ end = struct
 
   let get_typ_synonym id env = Bindings.find id env.typ_synonyms
 
-  let add_constraint_synonym id kids nc env =
-    if Bindings.mem id env.constraint_synonyms
-    then typ_error (id_loc id) ("Constraint synonym " ^ string_of_id id ^ " already exists")
-    else
-      begin
-        typ_print (lazy (adding ^ "constraint synonym " ^ string_of_id id));
-        wf_constraint ~exs:(KidSet.of_list kids) env nc;
-        { env with constraint_synonyms = Bindings.add id (kids, nc) env.constraint_synonyms }
-      end
-
   let get_default_order env =
     match env.default_order with
     | None -> typ_error Parse_ast.Unknown ("No default order has been set")
@@ -1192,15 +1077,15 @@ end = struct
         rewrap (Typ_fn (List.map aux arg_typs, aux ret_typ, eff))
       | Typ_tup ts ->
         rewrap (Typ_tup (List.map aux ts))
-      | Typ_app (r, [Typ_arg_aux (Typ_arg_typ rtyp,_)]) when string_of_id r = "register" ->
+      | Typ_app (r, [A_aux (A_typ rtyp,_)]) when string_of_id r = "register" ->
         aux rtyp
       | Typ_app (id, targs) ->
         rewrap (Typ_app (id, List.map aux_arg targs))
       | t -> rewrap t
-    and aux_arg (Typ_arg_aux (targ,a)) =
-      let rewrap targ = Typ_arg_aux (targ,a) in
+    and aux_arg (A_aux (targ,a)) =
+      let rewrap targ = A_aux (targ,a) in
       match targ with
-      | Typ_arg_typ typ -> rewrap (Typ_arg_typ (aux typ))
+      | A_typ typ -> rewrap (A_typ (aux typ))
       | targ -> rewrap targ in
     aux (expand_synonyms env typ)
 
@@ -1221,17 +1106,14 @@ let add_typquant l (quant : typquant) (env : Env.t) : Env.t =
     | QI_aux (qi, _) -> add_quant_item_aux env qi
   and add_quant_item_aux env = function
     | QI_const constr -> Env.add_constraint constr env
-    | QI_id (KOpt_aux (KOpt_none kid, _)) -> Env.add_typ_var l kid BK_int env
-    | QI_id (KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (k, _)], _), kid), _)) -> Env.add_typ_var l kid k env
-    | QI_id (KOpt_aux (_, l)) -> typ_error l "Type variable had non base kinds!"
+    | QI_id kopt -> Env.add_typ_var l kopt env
   in
   match quant with
   | TypQ_aux (TypQ_no_forall, _) -> env
   | TypQ_aux (TypQ_tq quants, _) -> List.fold_left add_quant_item env quants
 
 let expand_bind_synonyms l env (typq, typ) =
-  Env.expand_typquant_synonyms env typq, Env.expand_synonyms (add_typquant l typq env) typ
-
+  typq, Env.expand_synonyms (add_typquant l typq env) typ
 
 (* Create vectors with the default order from the environment *)
 
@@ -1240,92 +1122,49 @@ let default_order_error_string =
 
 let dvector_typ env n typ = vector_typ n (Env.get_default_order env) typ
 
-let ex_counter = ref 0
-
-let fresh_existential ?name:(n="") () =
-  let fresh = Kid_aux (Var ("'ex" ^ string_of_int !ex_counter ^ "#" ^ n), Parse_ast.Unknown) in
-  incr ex_counter; fresh
-
-let destruct_exist env typ =
-  match Env.expand_synonyms env typ with
-  | Typ_aux (Typ_exist (kids, nc, typ), _) ->
-     let fresh_kids = List.map (fun kid -> (kid, fresh_existential ~name:(string_of_id (id_of_kid kid)) ())) kids in
-     let nc = List.fold_left (fun nc (kid, fresh) -> nc_subst_nexp kid (Nexp_var fresh) nc) nc fresh_kids in
-     let typ = List.fold_left (fun typ (kid, fresh) -> typ_subst_nexp kid (Nexp_var fresh) typ) typ fresh_kids in
-     Some (List.map snd fresh_kids, nc, typ)
-  | _ -> None
-
-let add_existential l kids nc env =
-  let env = List.fold_left (fun env kid -> Env.add_typ_var l kid BK_int env) env kids in
+let add_existential l kopts nc env =
+  let env = List.fold_left (fun env kopt -> Env.add_typ_var l kopt env) env kopts in
   Env.add_constraint nc env
 
-let add_typ_vars l kids env = List.fold_left (fun env kid -> Env.add_typ_var l kid BK_int env) env kids
+let add_typ_vars l kopts env = List.fold_left (fun env kopt -> Env.add_typ_var l kopt env) env kopts
 
 let is_exist = function
   | Typ_aux (Typ_exist (_, _, _), _) -> true
   | _ -> false
 
 let exist_typ constr typ =
-  let fresh_kid = fresh_existential () in
-  mk_typ (Typ_exist ([fresh_kid], constr fresh_kid, typ fresh_kid))
-
-(** Destructure and canonicalise a numeric type into a list of type
-   variables, a constraint on those type variables, and an
-   N-expression that represents that numeric type in the
-   environment. For example:
-   - {'n, 'n <= 10. atom('n)} => ['n], 'n <= 10, 'n
-   - int => ['n], true, 'n (where x is fresh)
-   - atom('n) => [], true, 'n
-**)
-let destruct_numeric env typ =
-  let typ = Env.expand_synonyms env typ in
-  match destruct_exist env typ, typ with
-  | Some (kids, nc, Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp, _)]), _)), _ when string_of_id id = "atom" ->
-     Some (kids, nc, nexp)
-  | None, Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp nexp, _)]), _) when string_of_id id = "atom" ->
-     Some ([], nc_true, nexp)
-  | None, Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp lo, _); Typ_arg_aux (Typ_arg_nexp hi, _)]), _) when string_of_id id = "range" ->
-     let kid = fresh_existential () in
-     Some ([kid], nc_and (nc_lteq lo (nvar kid)) (nc_lteq (nvar kid) hi), nvar kid)
-  | None, Typ_aux (Typ_id id, _) when string_of_id id = "nat" ->
-     let kid = fresh_existential () in
-     Some ([kid], nc_lteq (nint 0) (nvar kid), nvar kid)
-  | None, Typ_aux (Typ_id id, _) when string_of_id id = "int" ->
-     let kid = fresh_existential () in
-     Some ([kid], nc_true, nvar kid)
-  | _, _ -> None
+  let fresh = fresh_existential K_int in
+  mk_typ (Typ_exist ([fresh], constr (kopt_kid fresh), typ (kopt_kid fresh)))
 
 let bind_numeric l typ env =
-  match destruct_numeric env typ with
+  match destruct_numeric (Env.expand_synonyms env typ) with
   | Some (kids, nc, nexp) ->
-     nexp, add_existential l kids nc env
+     nexp, add_existential l (List.map (mk_kopt K_int) kids) nc env
   | None -> typ_error l ("Expected " ^ string_of_typ typ ^ " to be numeric")
 
 (** Pull an (potentially)-existentially qualified type into the global
    typing environment **)
 let bind_existential l typ env =
-  match destruct_numeric env typ with
-  | Some (kids, nc, nexp) -> atom_typ nexp, add_existential l kids nc env
-  | None -> match destruct_exist env typ with
-            | Some (kids, nc, typ) -> typ, add_existential l kids nc env
-            | None -> typ, env
+  match destruct_exist (Env.expand_synonyms env typ) with
+  | Some (kids, nc, typ) -> typ, add_existential l kids nc env
+  | None -> typ, env
 
 let destruct_range env typ =
-  let kids, constr, (Typ_aux (typ_aux, _)) =
-    Util.option_default ([], nc_true, typ) (destruct_exist env typ)
+  let kopts, constr, (Typ_aux (typ_aux, _)) =
+    Util.option_default ([], nc_true, typ) (destruct_exist (Env.expand_synonyms env typ))
   in
   match typ_aux with
-    | Typ_app (f, [Typ_arg_aux (Typ_arg_nexp n, _)])
-         when string_of_id f = "atom" -> Some (kids, constr, n, n)
-    | Typ_app (f, [Typ_arg_aux (Typ_arg_nexp n1, _); Typ_arg_aux (Typ_arg_nexp n2, _)])
-         when string_of_id f = "range" -> Some (kids, constr, n1, n2)
+    | Typ_app (f, [A_aux (A_nexp n, _)])
+         when string_of_id f = "atom" -> Some (List.map kopt_kid kopts, constr, n, n)
+    | Typ_app (f, [A_aux (A_nexp n1, _); A_aux (A_nexp n2, _)])
+         when string_of_id f = "range" -> Some (List.map kopt_kid kopts, constr, n1, n2)
     | _ -> None
 
 let destruct_vector env typ =
   let destruct_vector' = function
-    | Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp n1, _);
-                             Typ_arg_aux (Typ_arg_order o, _);
-                             Typ_arg_aux (Typ_arg_typ vtyp, _)]
+    | Typ_aux (Typ_app (id, [A_aux (A_nexp n1, _);
+                             A_aux (A_order o, _);
+                             A_aux (A_typ vtyp, _)]
                        ), _) when string_of_id id = "vector" -> Some (nexp_simp n1, o, vtyp)
     | typ -> None
   in
@@ -1340,15 +1179,15 @@ let rec is_typ_monomorphic (Typ_aux (typ, l)) =
   | Typ_bidir (typ1, typ2) -> is_typ_monomorphic typ1 && is_typ_monomorphic typ2
   | Typ_exist _ | Typ_var _ -> false
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and is_typ_arg_monomorphic (Typ_arg_aux (arg, _)) =
+and is_typ_arg_monomorphic (A_aux (arg, _)) =
   match arg with
-  | Typ_arg_nexp _ -> true
-  | Typ_arg_typ typ -> is_typ_monomorphic typ
-  | Typ_arg_order (Ord_aux (Ord_dec, _)) | Typ_arg_order (Ord_aux (Ord_inc, _)) -> true
-  | Typ_arg_order (Ord_aux (Ord_var _, _)) -> false
+  | A_nexp _ -> true
+  | A_typ typ -> is_typ_monomorphic typ
+  | A_order (Ord_aux (Ord_dec, _)) | A_order (Ord_aux (Ord_inc, _)) -> true
+  | A_order (Ord_aux (Ord_var _, _)) -> false
 
 (**************************************************************************)
-(* 3. Subtyping and constraint solving                                    *)
+(* 2. Subtyping and constraint solving                                    *)
 (**************************************************************************)
 
 let rec simp_typ (Typ_aux (typ_aux, l)) = Typ_aux (simp_typ_aux typ_aux, l)
@@ -1378,86 +1217,31 @@ this is equivalent to
 which is then a problem we can feed to the constraint solver expecting unsat.
  *)
 
-let rec nexp_constraint env var_of (Nexp_aux (nexp, l)) =
-  match nexp with
-  | Nexp_id v -> nexp_constraint env var_of (Env.get_num_def v env)
-  | Nexp_var kid -> Constraint.variable (var_of kid)
-  | Nexp_constant c -> Constraint.constant c
-  | Nexp_times (nexp1, nexp2) -> Constraint.mult (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | Nexp_sum (nexp1, nexp2) -> Constraint.add (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | Nexp_minus (nexp1, nexp2) -> Constraint.sub (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | Nexp_exp nexp -> Constraint.pow2 (nexp_constraint env var_of nexp)
-  | Nexp_neg nexp -> Constraint.sub (Constraint.constant (Big_int.of_int 0)) (nexp_constraint env var_of nexp)
-  | Nexp_app (id, nexps) -> Constraint.app (Env.get_smt_op id env) (List.map (nexp_constraint env var_of) nexps)
-
-let rec nc_constraint env var_of (NC_aux (nc, l)) =
-  match nc with
-  | NC_equal (nexp1, nexp2) -> Constraint.eq (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | NC_not_equal (nexp1, nexp2) -> Constraint.neq (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | NC_bounded_ge (nexp1, nexp2) -> Constraint.gteq (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | NC_bounded_le (nexp1, nexp2) -> Constraint.lteq (nexp_constraint env var_of nexp1) (nexp_constraint env var_of nexp2)
-  | NC_set (_, []) -> Constraint.literal false
-  | NC_set (kid, (int :: ints)) ->
-     List.fold_left Constraint.disj
-                    (Constraint.eq (nexp_constraint env var_of (nvar kid)) (Constraint.constant int))
-                    (List.map (fun i -> Constraint.eq (nexp_constraint env var_of (nvar kid)) (Constraint.constant i)) ints)
-  | NC_or (nc1, nc2) -> Constraint.disj (nc_constraint env var_of nc1) (nc_constraint env var_of nc2)
-  | NC_and (nc1, nc2) -> Constraint.conj (nc_constraint env var_of nc1) (nc_constraint env var_of nc2)
-  | NC_app (id, nexps) -> raise (Reporting_basic.err_unreachable l __POS__ "constraint synonym reached smt generation")
-  | NC_false -> Constraint.literal false
-  | NC_true -> Constraint.literal true
-
-let rec nc_constraints env var_of ncs =
-  match ncs with
-  | [] -> Constraint.literal true
-  | [nc] -> nc_constraint env var_of nc
-  | (nc :: ncs) ->
-     Constraint.conj (nc_constraint env var_of nc) (nc_constraints env var_of ncs)
-
-let prove_z3' env constr =
-  let module Bindings = Map.Make(Kid) in
-  let bindings = ref Bindings.empty  in
-  let fresh_var kid =
-    let n = Bindings.cardinal !bindings in
-    bindings := Bindings.add kid n !bindings;
-    n
-  in
-  let var_of kid =
-    try Bindings.find kid !bindings with
-    | Not_found -> fresh_var kid
-  in
-  let constr = Constraint.conj (nc_constraints env var_of (Env.get_constraints env)) (constr var_of) in
-  match Constraint.call_z3 constr with
+let prove_z3 env (NC_aux (_, l) as nc) =
+  let vars = Env.get_typ_vars env in
+  let vars = KBindings.filter (fun _ k -> match k with K_int | K_bool -> true | _ -> false) vars in
+  let ncs = Env.get_constraints env in
+  match Constraint.call_z3 l vars (List.fold_left nc_and (nc_not nc) ncs) with
   | Constraint.Unsat -> typ_debug (lazy "unsat"); true
   | Constraint.Sat -> typ_debug (lazy "sat"); false
   | Constraint.Unknown -> typ_debug (lazy "unknown"); false
 
-let prove_z3 env nc =
-  typ_print (lazy (Util.("Prove " |> red |> clear) ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env) ^ " |- " ^ string_of_n_constraint nc));
-  prove_z3' env (fun var_of -> Constraint.negate (nc_constraint env var_of nc))
-
-let solve env nexp =
-  typ_print (lazy ("Solve " ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env) ^ " |- " ^ string_of_nexp nexp ^ " = ?"));
+let solve env (Nexp_aux (_, l) as nexp) = 
+  typ_print (lazy (Util.("Solve " |> red |> clear) ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env)
+                   ^ " |- " ^ string_of_nexp nexp ^ " = ?"));
   match nexp with
   | Nexp_aux (Nexp_constant n,_) -> Some n
   | _ ->
-    let bindings = ref KBindings.empty  in
-    let fresh_var kid =
-      let n = KBindings.cardinal !bindings in
-      bindings := KBindings.add kid n !bindings;
-      n
-    in
-    let var_of kid =
-      try KBindings.find kid !bindings with
-      | Not_found -> fresh_var kid
-    in
-    let env = Env.add_typ_var Parse_ast.Unknown (mk_kid "solve#") BK_int env in
-    let constr = Constraint.conj (nc_constraints env var_of (Env.get_constraints env))
-                                 (nc_constraint env var_of (nc_eq (nvar (mk_kid "solve#")) nexp))
-    in
-    Constraint.solve_z3 constr (var_of (mk_kid "solve#"))
+    let env = Env.add_typ_var Parse_ast.Unknown (mk_kopt K_int (mk_kid "solve#")) env in
+    let vars = Env.get_typ_vars env in
+    let vars = KBindings.filter (fun _ k -> match k with K_int | K_bool -> true | _ -> false) vars in
+    let constr = List.fold_left nc_and (nc_eq (nvar (mk_kid "solve#")) nexp) (Env.get_constraints env) in
+    Constraint.solve_z3 l vars constr (mk_kid "solve#")
 
-let prove env (NC_aux (nc_aux, _) as nc) =
+let prove env nc =
+  typ_print (lazy (Util.("Prove " |> red |> clear) ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env) ^ " |- " ^ string_of_n_constraint nc));
+  let (NC_aux (nc_aux, _) as nc) = Env.expand_constraint_synonyms env nc in
+  typ_debug ~level:2 (lazy (Util.("Prove " |> red |> clear) ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env) ^ " |- " ^ string_of_n_constraint nc));
   let compare_const f (Nexp_aux (n1, _)) (Nexp_aux (n2, _)) =
     match n1, n2 with
     | Nexp_constant c1, Nexp_constant c2 when f c1 c2 -> true
@@ -1471,7 +1255,7 @@ let prove env (NC_aux (nc_aux, _) as nc) =
   | _ -> prove_z3 env nc
 
 (**************************************************************************)
-(* 4. Unification                                                         *)
+(* 3. Unification                                                         *)
 (**************************************************************************)
 
 let rec nexp_frees ?exs:(exs=KidSet.empty) (Nexp_aux (nexp, l)) =
@@ -1503,11 +1287,11 @@ let rec typ_nexps (Typ_aux (typ_aux, l)) =
      List.concat (List.map typ_nexps arg_typs) @ typ_nexps ret_typ
   | Typ_bidir (typ1, typ2) ->
      typ_nexps typ1 @ typ_nexps typ2
-and typ_arg_nexps (Typ_arg_aux (typ_arg_aux, l)) =
+and typ_arg_nexps (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
-  | Typ_arg_nexp n -> [n]
-  | Typ_arg_typ typ -> typ_nexps typ
-  | Typ_arg_order ord -> []
+  | A_nexp n -> [n]
+  | A_typ typ -> typ_nexps typ
+  | A_order ord -> []
 
 let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   match typ_aux with
@@ -1517,14 +1301,15 @@ let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | Typ_var kid -> KidSet.singleton kid
   | Typ_tup typs -> List.fold_left KidSet.union KidSet.empty (List.map (typ_frees ~exs:exs) typs)
   | Typ_app (f, args) -> List.fold_left KidSet.union KidSet.empty (List.map (typ_arg_frees ~exs:exs) args)
-  | Typ_exist (kids, nc, typ) -> typ_frees ~exs:(KidSet.of_list kids) typ
+  | Typ_exist (kopts, nc, typ) -> typ_frees ~exs:(KidSet.of_list (List.map kopt_kid kopts)) typ
   | Typ_fn (arg_typs, ret_typ, _) -> List.fold_left KidSet.union (typ_frees ~exs:exs ret_typ) (List.map (typ_frees ~exs:exs) arg_typs)
   | Typ_bidir (typ1, typ2) -> KidSet.union (typ_frees ~exs:exs typ1) (typ_frees ~exs:exs typ2)
-and typ_arg_frees ?exs:(exs=KidSet.empty) (Typ_arg_aux (typ_arg_aux, l)) =
+and typ_arg_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
-  | Typ_arg_nexp n -> nexp_frees ~exs:exs n
-  | Typ_arg_typ typ -> typ_frees ~exs:exs typ
-  | Typ_arg_order ord -> order_frees ord
+  | A_nexp n -> nexp_frees ~exs:exs n
+  | A_typ typ -> typ_frees ~exs:exs typ
+  | A_order ord -> order_frees ord
+  | A_bool nc -> tyvars_of_constraint nc
 
 let rec nexp_identical (Nexp_aux (nexp1, _)) (Nexp_aux (nexp2, _)) =
   match nexp1, nexp2 with
@@ -1559,6 +1344,7 @@ let rec nc_identical (NC_aux (nc1, _)) (NC_aux (nc2, _)) =
   | NC_false, NC_false -> true
   | NC_set (kid1, ints1), NC_set (kid2, ints2) when List.length ints1 = List.length ints2 ->
      Kid.compare kid1 kid2 = 0 && List.for_all2 (fun i1 i2 -> i1 = i2) ints1 ints2
+  | NC_var kid1, NC_var kid2 -> Kid.compare kid1 kid2 = 0
   | _, _ -> false
 
 let typ_identical env typ1 typ2 =
@@ -1584,97 +1370,139 @@ let typ_identical env typ1 typ2 =
          try Id.compare f1 f2 = 0 && List.for_all2 typ_arg_identical args1 args2 with
          | Invalid_argument _ -> false
        end
-    | Typ_exist (kids1, nc1, typ1), Typ_exist (kids2, nc2, typ2) when List.length kids1 = List.length kids2 ->
-       List.for_all2 (fun k1 k2 -> Kid.compare k1 k2 = 0) kids1 kids2 && nc_identical nc1 nc2 && typ_identical' typ1 typ2
+    | Typ_exist (kopts1, nc1, typ1), Typ_exist (kopts2, nc2, typ2) when List.length kopts1 = List.length kopts2 ->
+       List.for_all2 (fun k1 k2 -> KOpt.compare k1 k2 = 0) kopts1 kopts2 && nc_identical nc1 nc2 && typ_identical' typ1 typ2
     | _, _ -> false
-  and typ_arg_identical (Typ_arg_aux (arg1, _)) (Typ_arg_aux (arg2, _)) =
+  and typ_arg_identical (A_aux (arg1, _)) (A_aux (arg2, _)) =
     match arg1, arg2 with
-    | Typ_arg_nexp n1, Typ_arg_nexp n2 -> nexp_identical n1 n2
-    | Typ_arg_typ typ1, Typ_arg_typ typ2 -> typ_identical' typ1 typ2
-    | Typ_arg_order ord1, Typ_arg_order ord2 -> ord_identical ord1 ord2
+    | A_nexp n1, A_nexp n2 -> nexp_identical n1 n2
+    | A_typ typ1, A_typ typ2 -> typ_identical' typ1 typ2
+    | A_order ord1, A_order ord2 -> ord_identical ord1 ord2
     | _, _ -> false
   in
   typ_identical' (Env.expand_synonyms env typ1) (Env.expand_synonyms env typ2)
 
-type uvar =
-  | U_nexp of nexp
-  | U_order of order
-  | U_typ of typ
+exception Unification_error of l * string;;
+
+let unify_error l str = raise (Unification_error (l, str))
 
-let uvar_subst_nexp sv subst = function
-  | U_nexp nexp -> U_nexp (nexp_subst sv subst nexp)
-  | U_typ typ -> U_typ (typ_subst_nexp sv subst typ)
-  | U_order ord -> U_order ord
+let merge_unifiers l kid uvar1 uvar2 =
+  match uvar1, uvar2 with
+  | Some (A_aux (A_nexp n1, _)), Some (A_aux (A_nexp n2, _)) ->
+     if nexp_identical n1 n2 then
+       Some (arg_nexp n1)
+     else
+       unify_error l ("Multiple non-identical unifiers for " ^ string_of_kid kid
+                      ^ ": " ^ string_of_nexp n1 ^ " and " ^ string_of_nexp n2)
+  | Some _, Some _ -> unify_error l "Multiple non-identical non-nexp unifiers"
+  | None, Some u2 -> Some u2
+  | Some u1, None -> Some u1
+  | None, None -> None
 
-let uvar_subst_typ sv subst = function
-  | U_nexp nexp -> U_nexp nexp
-  | U_typ typ -> U_typ (typ_subst_typ sv subst typ)
-  | U_order ord -> U_order ord
+let merge_uvars l unifiers1 unifiers2 =
+  KBindings.merge (merge_unifiers l) unifiers1 unifiers2
 
-let uvar_subst_order sv subst = function
-  | U_nexp nexp -> U_nexp nexp
-  | U_typ typ -> U_typ (typ_subst_order sv subst typ)
-  | U_order ord -> U_order (order_subst sv subst ord)
+let rec unify_typ l env goals (Typ_aux (aux1, _) as typ1) (Typ_aux (aux2, _) as typ2) =
+  match aux1, aux2 with
+  | Typ_internal_unknown, _ | _, Typ_internal_unknown
+       when Env.allow_unknowns env ->
+     KBindings.empty
 
-exception Unification_error of l * string;;
+  | Typ_var v, _ when KidSet.mem v goals -> KBindings.singleton v (arg_typ typ2)
 
-let unify_error l str = raise (Unification_error (l, str))
+  | Typ_app (range, [A_aux (A_nexp n1, _); A_aux (A_nexp n2, _)]),
+    Typ_app (atom, [A_aux (A_nexp m, _)])
+       when string_of_id range = "range" && string_of_id atom = "atom" ->
+     merge_uvars l (unify_nexp l env goals n1 m) (unify_nexp l env goals n2 m)
 
-let rec unify_nexps l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_aux2, _) as nexp2) =
-  typ_debug (lazy ("UNIFYING NEXPS " ^ string_of_nexp nexp1 ^ " AND " ^ string_of_nexp nexp2 ^ " FOR GOALS " ^ string_of_list ", " string_of_kid (KidSet.elements goals)));
+  | Typ_app (id1, args1), Typ_app (id2, args2) when List.length args1 = List.length args2 && Id.compare id1 id2 = 0 ->
+     List.fold_left (merge_uvars l) KBindings.empty (List.map2 (unify_typ_arg l env goals) args1 args2)
+
+  | Typ_app (id1, []), Typ_id id2 when Id.compare id1 id2 = 0 -> KBindings.empty
+  | Typ_id id1, Typ_app (id2, []) when Id.compare id1 id2 = 0 -> KBindings.empty
+  | Typ_id id1, Typ_id id2 when Id.compare id1 id2 = 0 -> KBindings.empty
+
+  | Typ_tup typs1, Typ_tup typs2 when List.length typs1 = List.length typs2 ->
+     List.fold_left (merge_uvars l) KBindings.empty (List.map2 (unify_typ l env goals) typs1 typs2)
+
+  | _, _ -> unify_error l ("Cound not unify " ^ string_of_typ typ1 ^ " and " ^ string_of_typ typ2)
+
+and unify_typ_arg l env goals (A_aux (aux1, _) as typ_arg1) (A_aux (aux2, _) as typ_arg2) =
+  match aux1, aux2 with
+  | A_typ typ1, A_typ typ2 -> unify_typ l env goals typ1 typ2
+  | A_nexp nexp1, A_nexp nexp2 -> unify_nexp l env goals nexp1 nexp2
+  | A_order ord1, A_order ord2 -> unify_order l goals ord1 ord2
+  | A_bool nc1, A_bool nc2 -> unify_constraint l goals nc1 nc2
+  | _, _ -> unify_error l ("Could not unify type arguments " ^ string_of_typ_arg typ_arg1 ^ " and " ^ string_of_typ_arg typ_arg2)
+
+and unify_constraint l goals (NC_aux (aux1, _) as nc1) (NC_aux (aux2, _) as nc2) =
+  typ_debug (lazy (Util.("Unify constraint " |> magenta |> clear) ^ string_of_n_constraint nc1 ^ " and " ^ string_of_n_constraint nc2));
+  match aux1, aux2 with
+  | NC_var v, _ when KidSet.mem v goals -> KBindings.singleton v (arg_bool nc2)
+  | _, _ -> unify_error l ("Could not unify constraints " ^ string_of_n_constraint nc1 ^ " and " ^ string_of_n_constraint nc2)
+
+and unify_order l goals (Ord_aux (aux1, _) as ord1) (Ord_aux (aux2, _) as ord2) =
+  typ_print (lazy (Util.("Unify order " |> magenta |> clear) ^ string_of_order ord1 ^ " and " ^ string_of_order ord2));
+  match aux1, aux2 with
+  | Ord_var v, _ when KidSet.mem v goals -> KBindings.singleton v (arg_order ord2)
+  | Ord_inc, Ord_inc -> KBindings.empty
+  | Ord_dec, Ord_dec -> KBindings.empty
+  | _, _ -> unify_error l ("Cound not unify " ^ string_of_order ord1 ^ " and " ^ string_of_order ord2)
+
+and unify_nexp l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_aux2, _) as nexp2) =
+  typ_debug (lazy (Util.("Unify nexp " |> magenta |> clear) ^ string_of_nexp nexp1 ^ " and " ^ string_of_nexp nexp2
+                   ^ " goals " ^ string_of_list ", " string_of_kid (KidSet.elements goals)));
   if KidSet.is_empty (KidSet.inter (nexp_frees nexp1) goals)
   then
     begin
       if prove env (NC_aux (NC_equal (nexp1, nexp2), Parse_ast.Unknown))
-      then None
+      then KBindings.empty
       else unify_error l ("Nexp " ^ string_of_nexp nexp1 ^ " and " ^ string_of_nexp nexp2 ^ " are not equal")
     end
   else
     match nexp_aux1 with
     | Nexp_id v -> unify_error l "Unimplemented Nexp_id in unify nexp"
-    | Nexp_var kid when KidSet.mem kid goals -> Some (kid, nexp2)
+    | Nexp_var kid when KidSet.mem kid goals -> KBindings.singleton kid (arg_nexp nexp2)
     | Nexp_constant c1 ->
        begin
          match nexp_aux2 with
-         | Nexp_constant c2 -> if c1 = c2 then None else unify_error l "Constants are not the same"
+         | Nexp_constant c2 -> if c1 = c2 then KBindings.empty else unify_error l "Constants are not the same"
          | _ -> unify_error l "Unification error"
        end
     | Nexp_sum (n1a, n1b) ->
        if KidSet.is_empty (nexp_frees n1b)
-       then unify_nexps l env goals n1a (nminus nexp2 n1b)
+       then unify_nexp l env goals n1a (nminus nexp2 n1b)
        else
          if KidSet.is_empty (nexp_frees n1a)
-         then unify_nexps l env goals n1b (nminus nexp2 n1a)
+         then unify_nexp l env goals n1b (nminus nexp2 n1a)
          else unify_error l ("Both sides of Int expression " ^ string_of_nexp nexp1
                              ^ " contain free type variables so it cannot be unified with " ^ string_of_nexp nexp2)
     | Nexp_minus (n1a, n1b) ->
        if KidSet.is_empty (nexp_frees n1b)
-       then unify_nexps l env goals n1a (nsum nexp2 n1b)
-       else  unify_error l ("Cannot unify minus Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
+       then unify_nexp l env goals n1a (nsum nexp2 n1b)
+       else unify_error l ("Cannot unify minus Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
     | Nexp_times (n1a, n1b) ->
-       (* If we have SMT operations div and mod, then we can use the
+       (* f we have SMT operations div and mod, then we can use the
           property that
 
           mod(m, C) = 0 && C != 0 --> (C * n = m <--> n = m / C)
 
-          to help us unify multiplications.  *)
-       if Env.have_smt_op (mk_id "div") env && Env.have_smt_op (mk_id "mod") env then
-         let valid n c = prove env (nc_eq (napp (mk_id "mod") [n; c]) (nint 0)) && prove env (nc_neq c (nint 0)) in
-         if KidSet.is_empty (nexp_frees n1b) && valid nexp2 n1b then
-           unify_nexps l env goals n1a (napp (mk_id "div") [nexp2; n1b])
-         else if KidSet.is_empty (nexp_frees n1a) && valid nexp2 n1a then
-           unify_nexps l env goals n1b (napp (mk_id "div") [nexp2; n1a])
-         else unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
-       else if KidSet.is_empty (nexp_frees n1a) then
+          to help us unify multiplications and divisions. 
+       let valid n c = prove env (nc_eq (napp (mk_id "mod") [n; c]) (nint 0)) && prove env (nc_neq c (nint 0)) in
+       if KidSet.is_empty (nexp_frees n1b) && valid nexp2 n1b then
+         unify_nexp l env goals n1a (napp (mk_id "div") [nexp2; n1b])
+       else if KidSet.is_empty (nexp_frees n1a) && valid nexp2 n1a then
+         unify_nexp l env goals n1b (napp (mk_id "div") [nexp2; n1a]) *)
+       if KidSet.is_empty (nexp_frees n1a) then
          begin
            match nexp_aux2 with
            | Nexp_times (n2a, n2b) when prove env (NC_aux (NC_equal (n1a, n2a), Parse_ast.Unknown)) ->
-              unify_nexps l env goals n1b n2b
+              unify_nexp l env goals n1b n2b
            | Nexp_constant c2 ->
               begin
                 match n1a with
                 | Nexp_aux (Nexp_constant c1,_) when Big_int.equal (Big_int.modulus c2 c1) Big_int.zero ->
-                   unify_nexps l env goals n1b (mk_nexp (Nexp_constant (Big_int.div c2 c1)))
+                   unify_nexp l env goals n1b (nconstant (Big_int.div c2 c1))
                 | _ -> unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
               end
            | _ -> unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
@@ -1683,213 +1511,103 @@ let rec unify_nexps l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (ne
          begin
            match nexp_aux2 with
            | Nexp_times (n2a, n2b) when prove env (NC_aux (NC_equal (n1b, n2b), Parse_ast.Unknown)) ->
-              unify_nexps l env goals n1a n2a
+              unify_nexp l env goals n1a n2a
            | _ -> unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
          end
        else unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
     | _ -> unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
 
-let string_of_uvar = function
-  | U_nexp n -> string_of_nexp n
-  | U_order o -> string_of_order o
-  | U_typ typ -> string_of_typ typ
-
-let unify_order l (Ord_aux (ord_aux1, _) as ord1) (Ord_aux (ord_aux2, _) as ord2) =
-  typ_debug (lazy ("UNIFYING ORDERS " ^ string_of_order ord1 ^ " AND " ^ string_of_order ord2));
-  match ord_aux1, ord_aux2 with
-  | Ord_var kid, _ -> KBindings.singleton kid (U_order ord2)
-  | Ord_inc, Ord_inc -> KBindings.empty
-  | Ord_dec, Ord_dec -> KBindings.empty
-  | _, _ -> unify_error l (string_of_order ord1 ^ " cannot be unified with " ^ string_of_order ord2)
+let unify l env goals typ1 typ2 =
+  typ_print (lazy (Util.("Unify " |> magenta |> clear) ^ string_of_typ typ1 ^ " and " ^ string_of_typ typ2
+                   ^ " for " ^ Util.string_of_list ", " string_of_kid (KidSet.elements goals)));
+  let typ1, typ2 = Env.expand_synonyms env typ1, Env.expand_synonyms env typ2 in
+  if not (KidSet.is_empty (KidSet.inter goals (tyvars_of_typ typ2))) then
+    typ_error l ("Occurs check failed: " ^ string_of_typ typ2 ^ " contains "
+                 ^ Util.string_of_list ", " string_of_kid (KidSet.elements goals))
+  else
+    unify_typ l env goals typ1 typ2
 
 let subst_unifiers unifiers typ =
-  let subst_unifier typ (kid, uvar) =
-    match uvar with
-    | U_nexp nexp -> typ_subst_nexp kid (unaux_nexp nexp) typ
-    | U_order ord -> typ_subst_order kid (unaux_order ord) typ
-    | U_typ subst -> typ_subst_typ kid (unaux_typ subst) typ
-  in
-  List.fold_left subst_unifier typ (KBindings.bindings unifiers)
-
-let subst_args_unifiers unifiers typ_args =
-  let subst_unifier typ_args (kid, uvar) =
-    match uvar with
-    | U_nexp nexp -> List.map (typ_subst_arg_nexp kid (unaux_nexp nexp)) typ_args
-    | U_order ord -> List.map (typ_subst_arg_order kid (unaux_order ord)) typ_args
-    | U_typ subst -> List.map (typ_subst_arg_typ kid (unaux_typ subst)) typ_args
-  in
-  List.fold_left subst_unifier typ_args (KBindings.bindings unifiers)
-
-let subst_uvar_unifiers unifiers uvar =
-  let subst_unifier uvar' (kid, uvar) =
-    match uvar with
-    | U_nexp nexp -> uvar_subst_nexp kid (unaux_nexp nexp) uvar'
-    | U_order ord -> uvar_subst_order kid (unaux_order ord) uvar'
-    | U_typ subst -> uvar_subst_typ kid (unaux_typ subst) uvar'
-  in
-  List.fold_left subst_unifier uvar (KBindings.bindings unifiers)
+  List.fold_left (fun typ (v, arg) -> typ_subst v arg typ) typ (KBindings.bindings unifiers)
 
-let merge_unifiers l kid uvar1 uvar2 =
-  match uvar1, uvar2 with
-  | Some (U_nexp n1), Some (U_nexp n2) ->
-     if nexp_identical n1 n2 then Some (U_nexp n1)
-     else unify_error l ("Multiple non-identical unifiers for " ^ string_of_kid kid
-                         ^ ": " ^ string_of_nexp n1 ^ " and " ^ string_of_nexp n2)
-  | Some _, Some _ -> unify_error l "Multiple non-identical non-nexp unifiers"
-  | None, Some u2 -> Some u2
-  | Some u1, None -> Some u1
-  | None, None -> None
+let subst_unifiers_typ_arg unifiers typ_arg =
+  List.fold_left (fun typ_arg (v, arg) -> typ_arg_subst v arg typ_arg) typ_arg (KBindings.bindings unifiers)
 
-let rec unify l env typ1 typ2 =
-  typ_print (lazy ("Unify " ^ string_of_typ typ1 ^ " with " ^ string_of_typ typ2));
-  let goals = KidSet.inter (KidSet.diff (typ_frees typ1) (typ_frees typ2)) (typ_frees typ1) in
-
-  let rec unify_typ l (Typ_aux (typ1_aux, _) as typ1) (Typ_aux (typ2_aux, _) as typ2) =
-    typ_debug (lazy ("UNIFYING TYPES " ^ string_of_typ typ1 ^ " AND " ^ string_of_typ typ2));
-    match typ1_aux, typ2_aux with
-    | Typ_internal_unknown, _
-    | _, Typ_internal_unknown when Env.allow_unknowns env -> KBindings.empty
-    | Typ_id v1, Typ_id v2 ->
-       if Id.compare v1 v2 = 0 then KBindings.empty
-       else unify_error l (string_of_typ typ1 ^ " cannot be unified with " ^ string_of_typ typ2)
-    | Typ_id v1, Typ_app (f2, []) ->
-       if Id.compare v1 f2 = 0 then KBindings.empty
-       else unify_error l (string_of_typ typ1 ^ " cannot be unified with " ^ string_of_typ typ2)
-    | Typ_app (f1, []), Typ_id v2 ->
-       if Id.compare f1 v2 = 0 then KBindings.empty
-       else unify_error l (string_of_typ typ1 ^ " cannot be unified with " ^ string_of_typ typ2)
-    | Typ_var kid, _ when KidSet.mem kid goals -> KBindings.singleton kid (U_typ typ2)
-    | Typ_var kid1, Typ_var kid2 when Kid.compare kid1 kid2 = 0 -> KBindings.empty
-    | Typ_tup typs1, Typ_tup typs2 ->
-       begin
-         try List.fold_left (KBindings.merge (merge_unifiers l)) KBindings.empty (List.map2 (unify_typ l) typs1 typs2) with
-         | Invalid_argument _ -> unify_error l (string_of_typ typ1 ^ " cannot be unified with " ^ string_of_typ typ2
-                                              ^ " tuple type is of different length")
-       end
-    | Typ_app (f1, [arg1]), Typ_app (f2, [arg2a; arg2b])
-         when Id.compare (mk_id "atom") f1 = 0 && Id.compare (mk_id "range") f2 = 0 ->
-       unify_typ_arg_list 0 KBindings.empty [] [] [arg1; arg1] [arg2a; arg2b]
-    | Typ_app (f1, [arg1a; arg1b]), Typ_app (f2, [arg2])
-         when Id.compare (mk_id "range") f1 = 0 && Id.compare (mk_id "atom") f2 = 0 ->
-       unify_typ_arg_list 0 KBindings.empty [] [] [arg1a; arg1b] [arg2; arg2]
-    | Typ_app (f1, args1), Typ_app (f2, args2) when Id.compare f1 f2 = 0 ->
-       unify_typ_arg_list 0 KBindings.empty [] [] args1 args2
-    | _, _ -> unify_error l (string_of_typ typ1 ^ " cannot be unified with " ^ string_of_typ typ2)
-
-  and unify_typ_arg_list unified acc uargs1 uargs2 args1 args2 =
-    match args1, args2 with
-    | [], [] when unified = 0 && List.length uargs1 > 0 ->
-       unify_error l "Could not unify arg lists" (*FIXME improve error *)
-    | [], [] when unified > 0 && List.length uargs1 > 0 -> unify_typ_arg_list 0 acc [] [] uargs1 uargs2
-    | [], [] when List.length uargs1 = 0 -> acc
-    | (a1 :: a1s), (a2 :: a2s) ->
-       begin
-         let unifiers, success =
-           try unify_typ_args l a1 a2, true with
-           | Unification_error _ -> KBindings.empty, false
-         in
-         let a1s = subst_args_unifiers unifiers a1s in
-         let a2s = subst_args_unifiers unifiers a2s in
-         let uargs1 = subst_args_unifiers unifiers uargs1 in
-         let uargs2 = subst_args_unifiers unifiers uargs2 in
-         if success
-         then unify_typ_arg_list (unified + 1) (KBindings.merge (merge_unifiers l) unifiers acc) uargs1 uargs2 a1s a2s
-         else unify_typ_arg_list unified acc (a1 :: uargs1) (a2 :: uargs2) a1s a2s
-       end
-    | _, _ -> unify_error l "Cannot unify type lists of different length"
-
-  and unify_typ_args l (Typ_arg_aux (typ_arg_aux1, _) as typ_arg1) (Typ_arg_aux (typ_arg_aux2, _) as typ_arg2) =
-    match typ_arg_aux1, typ_arg_aux2 with
-    | Typ_arg_nexp n1, Typ_arg_nexp n2 ->
-       begin
-         match unify_nexps l env goals (nexp_simp n1) (nexp_simp n2) with
-         | Some (kid, unifier) -> KBindings.singleton kid (U_nexp (nexp_simp unifier))
-         | None -> KBindings.empty
-       end
-    | Typ_arg_typ typ1, Typ_arg_typ typ2 -> unify_typ l typ1 typ2
-    | Typ_arg_order ord1, Typ_arg_order ord2 -> unify_order l ord1 ord2
-    | _, _ -> unify_error l (string_of_typ_arg typ_arg1 ^ " cannot be unified with type argument " ^ string_of_typ_arg typ_arg2)
-  in
-
-  match destruct_exist env typ2 with
-  | Some (kids, nc, typ2) ->
-     let typ1, typ2 = Env.expand_synonyms env typ1, Env.expand_synonyms env typ2 in
-     let (unifiers, _, _) = unify l env typ1 typ2 in
-     typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
-     unifiers, kids, Some nc
-  | None ->
-   let typ1, typ2 = Env.expand_synonyms env typ1, Env.expand_synonyms env typ2 in
-   unify_typ l typ1 typ2, [], None
+let instantiate_quant (v, arg) (QI_aux (aux, l) as qi) =
+  match aux with
+  | QI_id kopt when Kid.compare (kopt_kid kopt) v = 0 ->
+     typ_debug (lazy ("Instantiated " ^ string_of_quant_item qi));
+     None
+  | QI_id _ -> Some qi
+  | QI_const nc -> Some (QI_aux (QI_const (constraint_subst v arg nc), l))
 
-let merge_uvars l unifiers1 unifiers2 =
-  try KBindings.merge (merge_unifiers l) unifiers1 unifiers2
-  with
-  | Unification_error (_, m) -> typ_error l ("Could not merge unification variables: " ^ m)
+let instantiate_quants quants unifier =
+  List.map (instantiate_quant unifier) quants |> Util.option_these
 
 (**************************************************************************)
-(* 4.5. Subtyping with existentials                                       *)
+(* 3.5. Subtyping with existentials                                       *)
 (**************************************************************************)
 
 let destruct_atom_nexp env typ =
   match Env.expand_synonyms env typ with
-  | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_nexp n, _)]), _)
+  | Typ_aux (Typ_app (f, [A_aux (A_nexp n, _)]), _)
        when string_of_id f = "atom" -> Some n
-  | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_nexp n, _); Typ_arg_aux (Typ_arg_nexp m, _)]), _)
+  | Typ_aux (Typ_app (f, [A_aux (A_nexp n, _); A_aux (A_nexp m, _)]), _)
        when string_of_id f = "range" && nexp_identical n m -> Some n
   | _ -> None
 
 let destruct_atom_kid env typ =
   match Env.expand_synonyms env typ with
-  | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid, _)), _)]), _)
+  | Typ_aux (Typ_app (f, [A_aux (A_nexp (Nexp_aux (Nexp_var kid, _)), _)]), _)
        when string_of_id f = "atom" -> Some kid
-  | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid1, _)), _);
-                          Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_var kid2, _)), _)]), _)
+  | Typ_aux (Typ_app (f, [A_aux (A_nexp (Nexp_aux (Nexp_var kid1, _)), _);
+                          A_aux (A_nexp (Nexp_aux (Nexp_var kid2, _)), _)]), _)
        when string_of_id f = "range" && Kid.compare kid1 kid2 = 0 -> Some kid1
   | _ -> None
 
-let nc_subst_uvar kid uvar nc =
-  match uvar with
-  | U_nexp nexp -> nc_subst_nexp kid (unaux_nexp nexp) nc
-  | _ -> nc
-
-let uv_nexp_constraint env (kid, uvar) =
-  match uvar with
-  | U_nexp nexp -> Env.add_constraint (nc_eq (nvar kid) nexp) env
-  | _ -> env
-
 (* The kid_order function takes a set of Int-kinded kids, and returns
    a list of those kids in the order they appear in a type, as well as
    a set containing all the kids that did not occur in the type. We
    only care about Int-kinded kids because those are the only type
    that can appear in an existential. *)
 
-let rec kid_order_nexp kids (Nexp_aux (aux, l) as nexp) =
+let rec kid_order_nexp kind_map (Nexp_aux (aux, l) as nexp) =
   match aux with
-  | Nexp_var kid when KidSet.mem kid kids -> ([kid], KidSet.remove kid kids)
-  | Nexp_var _ | Nexp_id _ | Nexp_constant _ -> ([], kids)
-  | Nexp_exp nexp | Nexp_neg nexp -> kid_order_nexp kids nexp
+  | Nexp_var kid when KBindings.mem kid kind_map ->
+     ([mk_kopt (unaux_kind (KBindings.find kid kind_map)) kid], KBindings.remove kid kind_map)
+  | Nexp_var _ | Nexp_id _ | Nexp_constant _ -> ([], kind_map)
+  | Nexp_exp nexp | Nexp_neg nexp -> kid_order_nexp kind_map nexp
   | Nexp_times (nexp1, nexp2) | Nexp_sum (nexp1, nexp2) | Nexp_minus (nexp1, nexp2) ->
-     let (ord, kids) = kid_order_nexp kids nexp1 in
+     let (ord, kids) = kid_order_nexp kind_map nexp1 in
      let (ord', kids) = kid_order_nexp kids nexp2 in
      (ord @ ord', kids)
   | Nexp_app (id, nexps) ->
-     List.fold_left (fun (ord, kids) nexp -> let (ord', kids) = kid_order_nexp kids nexp in (ord @ ord', kids)) ([], kids) nexps
+     List.fold_left (fun (ord, kids) nexp -> let (ord', kids) = kid_order_nexp kids nexp in (ord @ ord', kids)) ([], kind_map) nexps
+
 
-let rec kid_order kids (Typ_aux (aux, l) as typ) =
+let rec kid_order kind_map (Typ_aux (aux, l) as typ) =
   match aux with
-  | Typ_var kid when KidSet.mem kid kids -> ([kid], KidSet.remove kid kids)
-  | Typ_id _ | Typ_var _ -> ([], kids)
+  | Typ_var kid when KBindings.mem kid kind_map ->
+     ([mk_kopt (unaux_kind (KBindings.find kid kind_map)) kid], KBindings.remove kid kind_map)
+  | Typ_id _ | Typ_var _ -> ([], kind_map)
   | Typ_tup typs ->
-     List.fold_left (fun (ord, kids) typ -> let (ord', kids) = kid_order kids typ in (ord @ ord', kids)) ([], kids) typs
+     List.fold_left (fun (ord, kids) typ -> let (ord', kids) = kid_order kids typ in (ord @ ord', kids)) ([], kind_map) typs
   | Typ_app (_, args) ->
-     List.fold_left (fun (ord, kids) arg -> let (ord', kids) = kid_order_arg kids arg in (ord @ ord', kids)) ([], kids) args
+     List.fold_left (fun (ord, kids) arg -> let (ord', kids) = kid_order_arg kids arg in (ord @ ord', kids)) ([], kind_map) args
   | Typ_fn _ | Typ_bidir _ | Typ_exist _ -> typ_error l ("Existential or function type cannot appear within existential type: " ^ string_of_typ typ)
   | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
-and kid_order_arg kids (Typ_arg_aux (aux, l) as arg) =
+and kid_order_arg kind_map (A_aux (aux, l) as arg) =
   match aux with
-  | Typ_arg_typ typ -> kid_order kids typ
-  | Typ_arg_nexp nexp -> kid_order_nexp kids nexp
-  | Typ_arg_order _ -> ([], kids)
+  | A_typ typ -> kid_order kind_map typ
+  | A_nexp nexp -> kid_order_nexp kind_map nexp
+  | A_bool nc -> kid_order_constraint kind_map nc
+  | A_order _ -> ([], kind_map)
+and kid_order_constraint kind_map (NC_aux (aux, l) as nc) =
+  match aux with
+  | NC_var kid when KBindings.mem kid kind_map ->
+     ([mk_kopt (unaux_kind (KBindings.find kid kind_map)) kid], KBindings.remove kid kind_map)
+  | NC_var _ -> ([], kind_map)
+  | _ -> unreachable l __POS__ "bad constraint type"
 
 let rec alpha_equivalent env typ1 typ2 =
   let counter = ref 0 in
@@ -1903,21 +1621,23 @@ let rec alpha_equivalent env typ1 typ2 =
       | Typ_fn (arg_typs, ret_typ, eff) -> Typ_fn (List.map relabel arg_typs, relabel ret_typ, eff)
       | Typ_bidir (typ1, typ2) -> Typ_bidir (relabel typ1, relabel typ2)
       | Typ_tup typs -> Typ_tup (List.map relabel typs)
-      | Typ_exist (kids, nc, typ) ->
-         let (kids, _) = kid_order (KidSet.of_list kids) typ in
-         let kids = List.map (fun kid -> (kid, new_kid ())) kids in
-         let nc = List.fold_left (fun nc (kid, nk) -> nc_subst_nexp kid (Nexp_var nk) nc) nc kids in
-         let typ = List.fold_left (fun nc (kid, nk) -> typ_subst_nexp kid (Nexp_var nk) nc) typ kids in
-         let kids = List.map snd kids in
-         Typ_exist (kids, nc, typ)
+      | Typ_exist (kopts, nc, typ) ->
+         let kind_map = List.fold_left (fun m kopt -> KBindings.add (kopt_kid kopt) (kopt_kind kopt) m) KBindings.empty kopts in
+         let (kopts, _) = kid_order kind_map typ in
+         let kopts = List.map (fun kopt -> (kopt_kid kopt, mk_kopt (unaux_kind (kopt_kind kopt)) (new_kid ()))) kopts in
+         let nc = List.fold_left (fun nc (kid, nk) -> constraint_subst kid (arg_kopt nk) nc) nc kopts in
+         let typ = List.fold_left (fun nc (kid, nk) -> typ_subst kid (arg_kopt nk) nc) typ kopts in
+         let kopts = List.map snd kopts in
+         Typ_exist (kopts, nc, typ)
       | Typ_app (id, args) ->
          Typ_app (id, List.map relabel_arg args)
     in
     Typ_aux (relabelled_aux, l)
-  and relabel_arg (Typ_arg_aux (aux, l) as arg) =
+  and relabel_arg (A_aux (aux, l) as arg) =
+    (* FIXME relabel constraint *)
     match aux with
-    | Typ_arg_nexp _ | Typ_arg_order _ -> arg
-    | Typ_arg_typ typ -> Typ_arg_aux (Typ_arg_typ (relabel typ), l)
+    | A_nexp _ | A_order _ | A_bool _ -> arg
+    | A_typ typ -> A_aux (A_typ (relabel typ), l)
   in
 
   let typ1 = relabel (Env.expand_synonyms env typ1) in
@@ -1929,62 +1649,121 @@ let rec alpha_equivalent env typ1 typ2 =
   else (typ_debug (lazy "Not alpha-equivalent"); false)
 
 let unwrap_exist env typ =
-  match destruct_exist env typ with
+  match destruct_exist (Env.expand_synonyms env typ) with
   | Some (kids, nc, typ) -> (kids, nc, typ)
   | None -> ([], nc_true, typ)
 
-let rec subtyp l env (Typ_aux (typ_aux1, _) as typ1) (Typ_aux (typ_aux2, _) as typ2) =
+let unifier_constraint env (v, arg) =
+  match arg with
+  | A_aux (A_nexp nexp, _) -> Env.add_constraint (nc_eq (nvar v) nexp) env
+  | _ -> env
+
+let canonicalize env typ =
+  let typ = Env.expand_synonyms env typ in
+  let rec canon (Typ_aux (aux, l)) =
+    match aux with
+    | Typ_var v -> Typ_aux (Typ_var v, l)
+    | Typ_internal_unknown -> Typ_aux (Typ_internal_unknown, l)
+    | Typ_id id when string_of_id id = "int" ->
+       exist_typ (fun _ -> nc_true) (fun v -> atom_typ (nvar v))
+    | Typ_id id -> Typ_aux (Typ_id id, l)
+    | Typ_app (id, [A_aux (A_nexp lo, _); A_aux (A_nexp hi, _)]) when string_of_id id = "range" ->
+       exist_typ (fun v -> nc_and (nc_lteq lo (nvar v)) (nc_lteq (nvar v) hi)) (fun v -> atom_typ (nvar v))
+    | Typ_app (id, args) ->
+       Typ_aux (Typ_app (id, List.map canon_arg args), l)
+    | Typ_tup typs ->
+       let typs = List.map canon typs in
+       let fold_exist (kids, nc, typs) typ =
+         match destruct_exist typ with
+         | Some (kids', nc', typ') -> (kids @ kids', nc_and nc nc', typs @ [typ'])
+         | None -> (kids, nc, typs @ [typ])
+       in
+       let kids, nc, typs = List.fold_left fold_exist ([], nc_true, []) typs in
+       if kids = [] then
+         Typ_aux (Typ_tup typs, l)
+       else
+         Typ_aux (Typ_exist (kids, nc, Typ_aux (Typ_tup typs, l)), l)
+    | Typ_exist (kids, nc, typ) ->
+       begin match destruct_exist (canon typ) with
+       | Some (kids', nc', typ') ->
+          Typ_aux (Typ_exist (kids @ kids', nc_and nc nc', typ'), l)
+       | None -> Typ_aux (Typ_exist (kids, nc, typ), l)
+       end
+    | Typ_fn _ | Typ_bidir _ -> raise (Reporting.err_unreachable l __POS__ "Function type passed to Type_check.canonicalize")
+  and canon_arg (A_aux (aux, l)) =
+    A_aux ((match aux with
+            | A_typ typ -> A_typ (canon typ)
+            | arg -> arg),
+           l)
+  in
+  canon typ
+
+let rec subtyp l env typ1 typ2 =
+  let (Typ_aux (typ_aux1, _) as typ1) = Env.expand_synonyms env typ1 in
+  let (Typ_aux (typ_aux2, _) as typ2) = Env.expand_synonyms env typ2 in
   typ_print (lazy (("Subtype " |> Util.green |> Util.clear) ^ string_of_typ typ1 ^ " and " ^ string_of_typ typ2));
-  match typ_aux1, typ_aux2 with
-  | Typ_tup typs1, Typ_tup typs2 when List.length typs1 = List.length typs2 ->
-     List.iter2 (subtyp l env) typs1 typs2
-  | _, _ ->
-  match destruct_numeric env typ1, destruct_numeric env typ2 with
+  match destruct_numeric typ1, destruct_numeric typ2 with
   (* Ensure alpha equivalent types are always subtypes of one another
      - this ensures that we can always re-check inferred types. *)
   | _, _ when alpha_equivalent env typ1 typ2 -> ()
   (* Special cases for two numeric (atom) types *)
   | Some (kids1, nc1, nexp1), Some ([], _, nexp2) ->
-     let env = add_existential l kids1 nc1 env in
+     let env = add_existential l (List.map (mk_kopt K_int) kids1) nc1 env in
      if prove env (nc_eq nexp1 nexp2) then () else typ_raise l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
   | Some (kids1, nc1, nexp1), Some (kids2, nc2, nexp2) ->
-     let env = add_existential l kids1 nc1 env in
-     let env = add_typ_vars l (KidSet.elements (KidSet.inter (nexp_frees nexp2) (KidSet.of_list kids2))) env in
+     let env = add_existential l (List.map (mk_kopt K_int) kids1) nc1 env in
+     let env = add_typ_vars l (List.map (mk_kopt K_int) (KidSet.elements (KidSet.inter (nexp_frees nexp2) (KidSet.of_list kids2)))) env in
      let kids2 = KidSet.elements (KidSet.diff (KidSet.of_list kids2) (nexp_frees nexp2)) in
+     if not (kids2 = []) then typ_error l ("Universally quantified constraint generated: " ^ Util.string_of_list ", " string_of_kid kids2) else ();
      let env = Env.add_constraint (nc_eq nexp1 nexp2) env in
-     let constr var_of =
-       Constraint.forall (List.map var_of kids2)
-         (nc_constraint env var_of (nc_negate nc2))
-     in
-     if prove_z3' env constr then ()
+     if prove env nc2 then ()
      else typ_raise l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
   | _, _ ->
-  match destruct_exist env typ1, unwrap_exist env (Env.canonicalize env typ2) with
-  | Some (kids, nc, typ1), _ ->
-     let env = add_existential l kids nc env in subtyp l env typ1 typ2
-  | None, (kids, nc, typ2) ->
+  match destruct_exist_plain typ1, destruct_exist (canonicalize env typ2) with
+  | Some (kopts, nc, typ1), _ ->
+     let env = add_existential l kopts nc env in subtyp l env typ1 typ2
+  | None, Some (kopts, nc, typ2) ->
      typ_debug (lazy "Subtype check with unification");
-     let env = add_typ_vars l kids env in
-     let kids' = KidSet.elements (KidSet.diff (KidSet.of_list kids) (typ_frees typ2)) in
-     let unifiers, existential_kids, existential_nc =
-       try unify l env typ2 typ1 with
+     let typ1 = canonicalize env typ1 in
+     let env = add_typ_vars l kopts env in
+     let kids' = KidSet.elements (KidSet.diff (KidSet.of_list (List.map kopt_kid kopts)) (typ_frees typ2)) in
+     if not (kids' = []) then typ_error l "Universally quantified constraint generated" else ();
+     let unifiers =
+       try unify l env (KidSet.diff (tyvars_of_typ typ2) (tyvars_of_typ typ1)) typ2 typ1 with
        | Unification_error (_, m) -> typ_error l m
      in
-     let nc = List.fold_left (fun nc (kid, uvar) -> nc_subst_uvar kid uvar nc) nc (KBindings.bindings unifiers) in
-     let env = List.fold_left uv_nexp_constraint env (KBindings.bindings unifiers) in
-     let env = match existential_kids, existential_nc with
-       | [], None -> env
-       | _, Some enc ->
-          let env = List.fold_left (fun env kid -> Env.add_typ_var l kid BK_int env) env existential_kids in
-          Env.add_constraint enc env
-       | _, None -> assert false (* Cannot have existential_kids without existential_nc *)
-     in
-     let constr var_of =
-       Constraint.forall (List.map var_of kids')
-         (nc_constraint env var_of (nc_negate nc))
-     in
-     if prove_z3' env constr then ()
+     let nc = List.fold_left (fun nc (kid, uvar) -> constraint_subst kid uvar nc) nc (KBindings.bindings unifiers) in
+     let env = List.fold_left unifier_constraint env (KBindings.bindings unifiers) in
+     if prove env nc then ()
      else typ_raise l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
+  | None, None ->
+  match typ_aux1, typ_aux2 with
+  | _, Typ_internal_unknown when Env.allow_unknowns env -> ()
+
+  | Typ_app (id1, _), Typ_id id2 when string_of_id id1 = "atom_bool" && string_of_id id2 = "bool" ->
+     typ_debug (lazy "Boolean subtype");
+     ()
+
+  | Typ_tup typs1, Typ_tup typs2 when List.length typs1 = List.length typs2 ->
+     List.iter2 (subtyp l env) typs1 typs2
+
+  | Typ_app (id1, args1), Typ_app (id2, args2) when Id.compare id1 id2 = 0 && List.length args1 = List.length args2 ->
+     List.iter2 (subtyp_arg l env) args1 args2
+
+  | Typ_id id1, Typ_id id2 when Id.compare id1 id2 = 0 -> ()
+  | Typ_id id1, Typ_app (id2, []) when Id.compare id1 id2 = 0 -> ()
+  | Typ_app (id1, []), Typ_id id2 when Id.compare id1 id2 = 0 -> ()
+
+  | _, _ -> typ_raise l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
+
+and subtyp_arg l env (A_aux (aux1, _) as arg1) (A_aux (aux2, _) as arg2) =
+  typ_print (lazy (("Subtype arg " |> Util.green |> Util.clear) ^ string_of_typ_arg arg1 ^ " and " ^ string_of_typ_arg arg2));
+  match aux1, aux2 with
+  | A_nexp n1, A_nexp n2 when prove env (nc_eq n1 n2) -> ()
+  | A_typ typ1, A_typ typ2 -> subtyp l env typ1 typ2
+  | A_order ord1, A_order ord2 when ord_identical ord1 ord2 -> ()
+  | A_bool nc1, A_bool nc2 when nc_identical nc1 nc2 -> ()
+  | _, _ -> typ_error l "Mismatched argument types in subtype check"
 
 let typ_equality l env typ1 typ2 =
   subtyp l env typ1 typ2; subtyp l env typ2 typ1
@@ -1994,7 +1773,7 @@ let subtype_check env typ1 typ2 =
   | Type_error _ -> false
 
 (**************************************************************************)
-(* 5. Type checking expressions                                           *)
+(* 4. Type checking expressions                                           *)
 (**************************************************************************)
 
 (* The type checker produces a fully annoted AST - tannot is the type
@@ -2052,52 +1831,24 @@ let infer_lit env (L_aux (lit_aux, l) as lit) =
   | L_undef -> typ_error l "Cannot infer the type of undefined"
 
 let is_nat_kid kid = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_int, _)], _), kid'), _) -> Kid.compare kid kid' = 0
-  | KOpt_aux (KOpt_none kid', _) -> Kid.compare kid kid' = 0
+  | KOpt_aux (KOpt_kind (K_aux (K_int, _), kid'), _) -> Kid.compare kid kid' = 0
   | _ -> false
 
 let is_order_kid kid = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_order, _)], _), kid'), _) -> Kid.compare kid kid' = 0
+  | KOpt_aux (KOpt_kind (K_aux (K_order, _), kid'), _) -> Kid.compare kid kid' = 0
   | _ -> false
 
 let is_typ_kid kid = function
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_type, _)], _), kid'), _) -> Kid.compare kid kid' = 0
+  | KOpt_aux (KOpt_kind (K_aux (K_type, _), kid'), _) -> Kid.compare kid kid' = 0
   | _ -> false
 
-let rec instantiate_quants quants kid uvar = match quants with
-  | [] -> []
-  | ((QI_aux (QI_id kinded_id, _) as quant) :: quants) ->
-     typ_debug (lazy ("instantiating quant " ^ string_of_quant_item quant));
-     begin
-       match uvar with
-       | U_nexp nexp ->
-          if is_nat_kid kid kinded_id
-          then instantiate_quants quants kid uvar
-          else quant :: instantiate_quants quants kid uvar
-       | U_order ord ->
-          if is_order_kid kid kinded_id
-          then instantiate_quants quants kid uvar
-          else quant :: instantiate_quants quants kid uvar
-       | U_typ typ ->
-          if is_typ_kid kid kinded_id
-          then instantiate_quants quants kid uvar
-          else quant :: instantiate_quants quants kid uvar
-     end
-  | ((QI_aux (QI_const nc, l)) :: quants) ->
-     begin
-       match uvar with
-       | U_nexp nexp ->
-          QI_aux (QI_const (nc_subst_nexp kid (unaux_nexp nexp) nc), l) :: instantiate_quants quants kid uvar
-       | _ -> (QI_aux (QI_const nc, l)) :: instantiate_quants quants kid uvar
-     end
-
 let instantiate_simple_equations =
   let rec find_eqs kid (NC_aux (nc,_)) = 
     match nc with
     | NC_equal (Nexp_aux (Nexp_var kid',_), nexp)
         when Kid.compare kid kid' == 0 &&
           not (KidSet.mem kid (nexp_frees nexp)) ->
-       [U_nexp nexp]
+       [arg_nexp nexp]
     | NC_and (nexp1, nexp2) ->
        find_eqs kid nexp1 @ find_eqs kid nexp2
     | _ -> []
@@ -2123,9 +1874,9 @@ in inst_from_eq
 
 let destruct_vec_typ l env typ =
   let destruct_vec_typ' l = function
-    | Typ_aux (Typ_app (id, [Typ_arg_aux (Typ_arg_nexp n1, _);
-                             Typ_arg_aux (Typ_arg_order o, _);
-                             Typ_arg_aux (Typ_arg_typ vtyp, _)]
+    | Typ_aux (Typ_app (id, [A_aux (A_nexp n1, _);
+                             A_aux (A_order o, _);
+                             A_aux (A_typ vtyp, _)]
                        ), _) when string_of_id id = "vector" -> (n1, o, vtyp)
     | typ -> typ_error l ("Expected vector type, got " ^ string_of_typ typ)
   in
@@ -2134,25 +1885,25 @@ let destruct_vec_typ l env typ =
 
 let env_of_annot (l, tannot) = match tannot with
   | Some ((env, _, _),_) -> env
-  | None -> raise (Reporting_basic.err_unreachable l __POS__ "no type annotation")
+  | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 let env_of (E_aux (_, (l, tannot))) = env_of_annot (l, tannot)
 
 let typ_of_annot (l, tannot) = match tannot with
   | Some ((_, typ, _), _) -> typ
-  | None -> raise (Reporting_basic.err_unreachable l __POS__ "no type annotation")
+  | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 let env_of_annot (l, tannot) = match tannot with
   | Some ((env, _, _), _) -> env
-  | None -> raise (Reporting_basic.err_unreachable l __POS__ "no type annotation")
+  | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 let typ_of (E_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
 
 let env_of (E_aux (_, (l, tannot))) = env_of_annot (l, tannot)
 
-let pat_typ_of (P_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
+let typ_of_pat (P_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
 
-let pat_env_of (P_aux (_, (l, tannot))) = env_of_annot (l, tannot)
+let env_of_pat (P_aux (_, (l, tannot))) = env_of_annot (l, tannot)
 
 let typ_of_pexp (Pat_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
 
@@ -2172,10 +1923,42 @@ let lexp_env_of (LEXP_aux (_, (l, tannot))) = env_of_annot (l, tannot)
 
 let expected_typ_of (l, tannot) = match tannot with
   | Some ((_, _, _), exp_typ) -> exp_typ
-  | None -> raise (Reporting_basic.err_unreachable l __POS__ "no type annotation")
+  | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 (* Flow typing *)
 
+type simple_numeric =
+  | Equal of nexp
+  | Constraint of (kid -> n_constraint)
+  | Anything
+
+let to_simple_numeric l kids nc (Nexp_aux (aux, _) as n) =
+  match aux, kids with
+  | Nexp_var v, [v'] when Kid.compare v v' = 0 ->
+     Constraint (fun subst -> constraint_subst v (arg_nexp (nvar subst)) nc)
+  | _, [] ->
+     Equal n
+  | _ ->
+     typ_error l "Numeric type is non-simple"
+
+let union_simple_numeric ex1 ex2 =
+  match ex1, ex2 with
+  | Equal nexp1, Equal nexp2 ->
+     Constraint (fun kid -> nc_or (nc_eq (nvar kid) nexp1) (nc_eq (nvar kid) nexp2))
+
+  | Equal nexp, Constraint c ->
+     Constraint (fun kid -> nc_or (nc_eq (nvar kid) nexp) (c kid))
+
+  | Constraint c, Equal nexp ->
+     Constraint (fun kid -> nc_or (c kid) (nc_eq (nvar kid) nexp))
+
+  | _, _ -> Anything
+
+let typ_of_simple_numeric = function
+  | Anything -> int_typ
+  | Equal nexp -> atom_typ nexp
+  | Constraint c -> exist_typ c (fun kid -> atom_typ (nvar kid))
+
 let rec big_int_of_nexp (Nexp_aux (nexp, _)) = match nexp with
   | Nexp_constant c -> Some c
   | Nexp_times (n1, n2) ->
@@ -2190,10 +1973,10 @@ let rec big_int_of_nexp (Nexp_aux (nexp, _)) = match nexp with
 
 let destruct_atom (Typ_aux (typ_aux, _)) =
   match typ_aux with
-  | Typ_app (f, [Typ_arg_aux (Typ_arg_nexp nexp, _)])
+  | Typ_app (f, [A_aux (A_nexp nexp, _)])
        when string_of_id f = "atom" ->
      Util.option_map (fun c -> (c, nexp)) (big_int_of_nexp nexp)
-  | Typ_app (f, [Typ_arg_aux (Typ_arg_nexp nexp1, _); Typ_arg_aux (Typ_arg_nexp nexp2, _)])
+  | Typ_app (f, [A_aux (A_nexp nexp1, _); A_aux (A_nexp nexp2, _)])
        when string_of_id f = "range" ->
      begin
        match big_int_of_nexp nexp1, big_int_of_nexp nexp2 with
@@ -2214,6 +1997,11 @@ let rec combine_constraint b f x y = match b, x, y with
   | _, _, _ -> None
 
 let rec assert_constraint env b (E_aux (exp_aux, _) as exp) =
+  typ_debug ~level:2 (lazy ("Asserting constraint for " ^ string_of_exp exp ^ " : " ^ string_of_typ (typ_of exp)));
+  match typ_of exp with
+  | Typ_aux (Typ_app (Id_aux (Id "atom_bool", _), [A_aux (A_bool nc, _)]), _) ->
+     Some nc
+  | _ ->
   match exp_aux with
   | E_constraint nc ->
      Some nc
@@ -2225,17 +2013,17 @@ let rec assert_constraint env b (E_aux (exp_aux, _) as exp) =
      combine_constraint (not b) nc_or (assert_constraint env b x) (assert_constraint env b y)
   | E_app (op, [x; y]) when string_of_id op = "and_bool" ->
      combine_constraint b nc_and (assert_constraint env b x) (assert_constraint env b y)
-  | E_app (op, [x; y]) when string_of_id op = "gteq_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "gteq_int" ->
      option_binop nc_gteq (assert_nexp env x) (assert_nexp env y)
-  | E_app (op, [x; y]) when string_of_id op = "lteq_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "lteq_int" ->
      option_binop nc_lteq (assert_nexp env x) (assert_nexp env y)
-  | E_app (op, [x; y]) when string_of_id op = "gt_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "gt_int" ->
      option_binop nc_gt (assert_nexp env x) (assert_nexp env y)
-  | E_app (op, [x; y]) when string_of_id op = "lt_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "lt_int" ->
      option_binop nc_lt (assert_nexp env x) (assert_nexp env y)
-  | E_app (op, [x; y]) when string_of_id op = "eq_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "eq_int" ->
      option_binop nc_eq (assert_nexp env x) (assert_nexp env y)
-  | E_app (op, [x; y]) when string_of_id op = "neq_atom" ->
+  | E_app (op, [x; y]) when string_of_id op = "neq_int" ->
      option_binop nc_neq (assert_nexp env x) (assert_nexp env y)
   | _ ->
      None
@@ -2315,6 +2103,14 @@ let irule r env exp =
   with
   | Type_error (l, err) -> decr depth; typ_raise l err
 
+
+(* This function adds useful assertion messages to asserts missing them *)
+let assert_msg test = function
+  | E_aux (E_lit (L_aux (L_string "", _)), (l, _)) ->
+     let open Reporting in
+     locate (fun _ -> l) (mk_lit_exp (L_string (loc_to_string ~code:false l ^ ": " ^ string_of_exp test)))
+  | msg -> msg
+
 let strip_exp : 'a exp -> unit exp = function exp -> map_exp_annot (fun (l, _) -> (l, ())) exp
 let strip_pat : 'a pat -> unit pat = function pat -> map_pat_annot (fun (l, _) -> (l, ())) pat
 let strip_pexp : 'a pexp -> unit pexp = function pexp -> map_pexp_annot (fun (l, _) -> (l, ())) pexp
@@ -2343,15 +2139,16 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
        let rec check_block l env exps typ =
          let annot_exp_effect exp typ eff exp_typ = E_aux (exp, (l, Some ((env, typ, eff), exp_typ))) in
          let annot_exp exp typ exp_typ = annot_exp_effect exp typ no_effect exp_typ in
-         match exps with
+         match Nl_flow.analyze exps with
          | [] -> typ_equality l env typ unit_typ; []
          | [exp] -> [crule check_exp env exp typ]
          | (E_aux (E_assign (lexp, bind), _) :: exps) ->
             let texp, env = bind_assignment env lexp bind in
             texp :: check_block l env exps typ
-         | ((E_aux (E_assert (constr_exp, assert_msg), _) as exp) :: exps) ->
+         | ((E_aux (E_assert (constr_exp, msg), _) as exp) :: exps) ->
+            let msg = assert_msg constr_exp msg in
             let constr_exp = crule check_exp env constr_exp bool_typ in
-            let checked_msg = crule check_exp env assert_msg string_typ in
+            let checked_msg = crule check_exp env msg string_typ in
             let env = match assert_constraint env true constr_exp with
               | Some nc ->
                  typ_print (lazy (adding ^ "constraint " ^ string_of_n_constraint nc ^ " for assert"));
@@ -2360,6 +2157,11 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
             in
             let texp = annot_exp_effect (E_assert (constr_exp, checked_msg)) unit_typ (mk_effect [BE_escape]) (Some unit_typ) in
             texp :: check_block l env exps typ
+         | ((E_aux (E_if (cond, (E_aux (E_throw _, _) | E_aux (E_block [E_aux (E_throw _, _)], _)), _), _) as exp) :: exps) ->
+            let texp = crule check_exp env exp (mk_typ (Typ_id (mk_id "unit"))) in
+            let cond' = crule check_exp env cond (mk_typ (Typ_id (mk_id "bool"))) in
+            let env = add_opt_constraint (option_map nc_not (assert_constraint env false cond')) env in
+            texp :: check_block l env exps typ
          | (exp :: exps) ->
             let texp = crule check_exp env exp (mk_typ (Typ_id (mk_id "unit"))) in
             texp :: check_block l env exps typ
@@ -2391,7 +2193,7 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
           annot_exp (E_list checked_xs) typ
        | None -> typ_error l ("List " ^ string_of_exp exp ^ " must have list type, got " ^ string_of_typ typ)
      end
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, flag), (l, ()))), _ ->
+  | E_record_update (exp, fexps), _ ->
      (* TODO: this could also infer exp - also fix code duplication with E_record below *)
      let checked_exp = crule check_exp env exp typ in
      let rectyp_id = match Env.expand_synonyms env typ with
@@ -2401,13 +2203,13 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      in
      let check_fexp (FE_aux (FE_Fexp (field, exp), (l, ()))) =
        let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
-       let unifiers, _, _ (* FIXME *) = try unify l env rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
+       let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
        let field_typ' = subst_unifiers unifiers field_typ in
        let checked_exp = crule check_exp env exp field_typ' in
        FE_aux (FE_Fexp (field, checked_exp), (l, None))
      in
-     annot_exp (E_record_update (checked_exp, FES_aux (FES_Fexps (List.map check_fexp fexps, flag), (l, None)))) typ
-  | E_record (FES_aux (FES_Fexps (fexps, flag), (l, ()))), _ ->
+     annot_exp (E_record_update (checked_exp, List.map check_fexp fexps)) typ
+  | E_record fexps, _ ->
      (* TODO: check record fields are total *)
      let rectyp_id = match Env.expand_synonyms env typ with
        | Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
@@ -2416,12 +2218,12 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      in
      let check_fexp (FE_aux (FE_Fexp (field, exp), (l, ()))) =
        let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
-       let unifiers, _, _ (* FIXME *) = try unify l env rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
+       let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
        let field_typ' = subst_unifiers unifiers field_typ in
        let checked_exp = crule check_exp env exp field_typ' in
        FE_aux (FE_Fexp (field, checked_exp), (l, None))
      in
-     annot_exp (E_record (FES_aux (FES_Fexps (List.map check_fexp fexps, flag), (l, None)))) typ
+     annot_exp (E_record (List.map check_fexp fexps)) typ
   | E_let (LB_aux (letbind, (let_loc, _)), exp), _ ->
      begin
        match letbind with
@@ -2442,14 +2244,11 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      if prove env nc
      then annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
      else typ_error l ("Cannot prove " ^ string_of_n_constraint nc)
-  | E_app (f, [E_aux (E_sizeof nexp, _)]), _ when Id.compare f (mk_id "__solve") = 0 ->
-     Env.wf_nexp env nexp;
-     begin match solve env nexp with
-     | None -> typ_error l ("Coud not solve " ^ string_of_nexp nexp)
-     | Some n ->
-        print_endline ("Solved " ^ string_of_nexp nexp ^ " = " ^ Big_int.to_string n);
-        annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
-     end
+  | E_app (f, [E_aux (E_constraint nc, _)]), _ when Id.compare f (mk_id "_not_prove") = 0 ->
+     Env.wf_constraint env nc;
+     if prove env nc
+     then typ_error l ("Can prove " ^ string_of_n_constraint nc)
+     else annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
   (* All constructors and mappings are treated as having one argument
      so Ctor(x, y) is checked as Ctor((x, y)) *)
   | E_app (f, x :: y :: zs), _ when Env.is_union_constructor f env || Env.is_mapping f env ->
@@ -2494,10 +2293,19 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      let inferred_exp = infer_funapp l env f xs (Some typ) in
      type_coercion env inferred_exp typ
   | E_if (cond, then_branch, else_branch), _ ->
-     let cond' = crule check_exp env cond (mk_typ (Typ_id (mk_id "bool"))) in
-     let then_branch' = crule check_exp (add_opt_constraint (assert_constraint env true cond') env) then_branch typ in
-     let else_branch' = crule check_exp (add_opt_constraint (option_map nc_negate (assert_constraint env false cond')) env) else_branch typ in
-     annot_exp (E_if (cond', then_branch', else_branch')) typ
+     let cond' = try irule infer_exp env cond with Type_error _ -> crule check_exp env cond bool_typ in
+     begin match destruct_exist (typ_of cond') with
+     | Some (kopts, nc, Typ_aux (Typ_app (ab, [A_aux (A_bool flow, _)]), _)) when string_of_id ab = "atom_bool" ->
+        let env = add_existential l kopts nc env in
+        let then_branch' = crule check_exp (Env.add_constraint flow env) then_branch typ in
+        let else_branch' = crule check_exp (Env.add_constraint (nc_not flow) env) else_branch typ in
+        annot_exp (E_if (cond', then_branch', else_branch')) typ
+     | _ ->
+        let cond' = type_coercion env cond' bool_typ in
+        let then_branch' = crule check_exp (add_opt_constraint (assert_constraint env true cond') env) then_branch typ in
+        let else_branch' = crule check_exp (add_opt_constraint (option_map nc_not (assert_constraint env false cond')) env) else_branch typ in
+        annot_exp (E_if (cond', then_branch', else_branch')) typ
+     end
   | E_exit exp, _ ->
      let checked_exp = crule check_exp env exp (mk_typ (Typ_id (mk_id "unit"))) in
      annot_exp_effect (E_exit checked_exp) typ (mk_effect [BE_escape])
@@ -2632,13 +2440,13 @@ and type_coercion env (E_aux (_, (l, _)) as annotated_exp) typ =
   in
   begin
     try
-      typ_debug (lazy ("PERFORMING TYPE COERCION: from " ^ string_of_typ (typ_of annotated_exp) ^ " to " ^ string_of_typ typ));
+      typ_debug (lazy ("Performing type coercion: from " ^ string_of_typ (typ_of annotated_exp) ^ " to " ^ string_of_typ typ));
       subtyp l env (typ_of annotated_exp) typ; switch_exp_typ annotated_exp
     with
     | Type_error (_, trigger) when Env.allow_casts env ->
        let casts = filter_casts env (typ_of annotated_exp) typ (Env.get_casts env) in
        try_casts trigger [] casts
-    | Type_error (l, err) -> typ_error l "Subtype error"
+    | Type_error (l, err) -> typ_raise l err
   end
 
 (* type_coercion_unify env exp typ attempts to coerce exp to a type
@@ -2646,7 +2454,7 @@ and type_coercion env (E_aux (_, (l, _)) as annotated_exp) typ =
    required that exp_typ unifies with typ. Returns the annotated
    coercion as with type_coercion and also a set of unifiers, or
    throws a unification error *)
-and type_coercion_unify env (E_aux (_, (l, _)) as annotated_exp) typ =
+and type_coercion_unify env goals (E_aux (_, (l, _)) as annotated_exp) typ =
   let strip exp_aux = strip_exp (E_aux (exp_aux, (Parse_ast.Unknown, None))) in
   let annot_exp exp typ' = E_aux (exp, (l, Some ((env, typ', no_effect), Some typ))) in
   let switch_typ exp typ = match exp with
@@ -2659,8 +2467,8 @@ and type_coercion_unify env (E_aux (_, (l, _)) as annotated_exp) typ =
         typ_print (lazy ("Casting with " ^ string_of_id cast ^ " expression " ^ string_of_exp annotated_exp ^ " for unification"));
         try
           let inferred_cast = irule infer_exp (Env.no_casts env) (strip (E_app (cast, [annotated_exp]))) in
-          let ityp = typ_of inferred_cast in
-          annot_exp (E_cast (ityp, inferred_cast)) ityp, unify l env typ ityp
+          let ityp, env = bind_existential l (typ_of inferred_cast) env in
+          inferred_cast, unify l env goals typ ityp, env
         with
         | Type_error (_, err) -> try_casts casts
         | Unification_error (_, err) -> try_casts casts
@@ -2668,8 +2476,9 @@ and type_coercion_unify env (E_aux (_, (l, _)) as annotated_exp) typ =
   in
   begin
     try
-      typ_debug (lazy "PERFORMING COERCING UNIFICATION");
-      annotated_exp, unify l env typ (typ_of annotated_exp)
+      typ_debug (lazy ("Coercing unification: from " ^ string_of_typ (typ_of annotated_exp) ^ " to " ^ string_of_typ typ));
+      let atyp, env = bind_existential l (typ_of annotated_exp) env in
+      annotated_exp, unify l env goals typ atyp, env
     with
     | Unification_error (_, m) when Env.allow_casts env ->
        let casts = filter_casts env (typ_of annotated_exp) typ (Env.get_casts env) in
@@ -2683,7 +2492,7 @@ and bind_pat_no_guard env (P_aux (_,(l,_)) as pat) typ =
 
 and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ) =
   let (Typ_aux (typ_aux, _) as typ), env = bind_existential l typ env in
-  typ_print (lazy ("Binding " ^ string_of_pat pat ^  " to " ^ string_of_typ typ));
+  typ_print (lazy (Util.("Binding " |> yellow |> clear) ^ string_of_pat pat ^  " to " ^ string_of_typ typ));
   let annot_pat pat typ' = P_aux (pat, (l, Some ((env, typ', no_effect), Some typ))) in
   let switch_typ pat typ = match pat with
     | P_aux (pat_aux, (l, Some ((env, _, eff), exp_typ))) -> P_aux (pat_aux, (l, Some ((env, typ, eff), exp_typ)))
@@ -2700,7 +2509,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
        if Env.is_union_constructor v env then
          Util.warn (Printf.sprintf "Identifier %s found in pattern is also a union constructor at %s\n"
                                    (string_of_id v)
-                                   (Reporting_basic.loc_to_string l))
+                                   (Reporting.loc_to_string l))
        else ();
        match Env.lookup_id v env with
        | Local _ | Unbound -> annot_pat (P_id v) typ, Env.add_local v (Immutable, typ) env, []
@@ -2723,7 +2532,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
   | P_cons (hd_pat, tl_pat) ->
      begin
        match Env.expand_synonyms env typ with
-       | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
+       | Typ_aux (Typ_app (f, [A_aux (A_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
           let hd_pat, env, hd_guards = bind_pat env hd_pat ltyp in
           let tl_pat, env, tl_guards = bind_pat env tl_pat typ in
           annot_pat (P_cons (hd_pat, tl_pat)) typ, env, hd_guards @ tl_guards
@@ -2747,7 +2556,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
   | P_list pats ->
      begin
        match Env.expand_synonyms env typ with
-       | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
+       | Typ_aux (Typ_app (f, [A_aux (A_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
           let rec process_pats env = function
             | [] -> [], env, []
             | (pat :: pats) ->
@@ -2781,7 +2590,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
      end
   | P_app (f, pats) when Env.is_union_constructor f env ->
      begin
-       let (typq, ctor_typ) = Env.get_val_spec f env in
+       let (typq, ctor_typ) = Env.get_union_id f env in
        let quants = quant_items typq in
        let untuple (Typ_aux (typ_aux, _) as typ) = match typ_aux with
          | Typ_tup typs -> typs
@@ -2791,13 +2600,13 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
        | Typ_aux (Typ_fn ([arg_typ], ret_typ, _), _) ->
           begin
             try
+              let goals = quant_kopts typq |> List.map kopt_kid |> KidSet.of_list in
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, ctor_typ) ^ " for pattern " ^ string_of_typ typ));
-              let unifiers, _, _ (* FIXME! *) = unify l env ret_typ typ in
-              typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
+              let unifiers = unify l env goals ret_typ typ in
               let arg_typ' = subst_unifiers unifiers arg_typ in
-              let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
-              if (match quants' with [] -> false | _ -> true)
-              then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in pattern " ^ string_of_pat pat)
+              let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
+              if not (List.for_all (solve_quant env) quants') then
+                typ_raise l (Err_unresolved_quants (f, quants', Env.get_locals env, Env.get_constraints env))
               else ();
               let ret_typ' = subst_unifiers unifiers ret_typ in
               let tpats, env, guards =
@@ -2825,12 +2634,10 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
             try
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for pattern " ^ string_of_typ typ));
 
-              let unifiers, _, _ (* FIXME! *) = unify l env typ2 typ in
-
-              typ_debug (lazy ("unifiers: " ^ string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
-
+              (* FIXME: There's no obvious goals here *)
+              let unifiers = unify l env (tyvars_of_typ typ2) typ2 typ in
               let arg_typ' = subst_unifiers unifiers typ1 in
-              let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
+              let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
               if (match quants' with [] -> false | _ -> true)
               then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in pattern " ^ string_of_pat pat)
               else ();
@@ -2846,10 +2653,9 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
                try
                  typ_debug (lazy "Unifying mapping forwards failed, trying backwards.");
                  typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for pattern " ^ string_of_typ typ));
-                 let unifiers, _, _ (* FIXME! *) = unify l env typ1 typ in
-                 typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
+                 let unifiers = unify l env (tyvars_of_typ typ1) typ1 typ in
                  let arg_typ' = subst_unifiers unifiers typ2 in
-                 let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
+                 let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
                  if (match quants' with [] -> false | _ -> true)
                  then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in pattern " ^ string_of_pat pat)
                  else ();
@@ -2869,20 +2675,20 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
      typ_error l (string_of_id f ^ " is not a union constructor or mapping in pattern " ^ string_of_pat pat)
   | P_as (pat, id) ->
      let (typed_pat, env, guards) = bind_pat env pat typ in
-     annot_pat (P_as (typed_pat, id)) (pat_typ_of typed_pat), Env.add_local id (Immutable, pat_typ_of typed_pat) env, guards
+     annot_pat (P_as (typed_pat, id)) (typ_of_pat typed_pat), Env.add_local id (Immutable, typ_of_pat typed_pat) env, guards
   (* This is a special case for flow typing when we match a constant numeric literal. *)
   | P_lit (L_aux (L_num n, _) as lit) when is_atom typ ->
      let nexp = match destruct_atom_nexp env typ with Some n -> n | None -> assert false in
      annot_pat (P_lit lit) (atom_typ (nconstant n)), Env.add_constraint (nc_eq nexp (nconstant n)) env, []
   | _ ->
      let (inferred_pat, env, guards) = infer_pat env pat in
-     match subtyp l env typ (pat_typ_of inferred_pat) with
-     | () -> switch_typ inferred_pat (pat_typ_of inferred_pat), env, guards
+     match subtyp l env typ (typ_of_pat inferred_pat) with
+     | () -> switch_typ inferred_pat (typ_of_pat inferred_pat), env, guards
      | exception (Type_error _ as typ_exn) ->
         match pat_aux with
         | P_lit lit ->
            let var = fresh_var () in
-           let guard = locate l (mk_exp (E_app_infix (mk_exp (E_id var), mk_id "==", mk_exp (E_lit lit)))) in
+           let guard = locate (fun _ -> l) (mk_exp (E_app_infix (mk_exp (E_id var), mk_id "==", mk_exp (E_lit lit)))) in
            let (typed_pat, env, guards) = bind_pat env (mk_pat (P_id var)) typ in
            typed_pat, env, guard::guards
         | _ -> raise typ_exn
@@ -2934,8 +2740,8 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
      in
      let pats, env, guards = List.fold_left fold_pats ([], env, []) (pat :: pats) in
      let len = nexp_simp (nint (List.length pats)) in
-     let etyp = pat_typ_of (List.hd pats) in
-     List.iter (fun pat -> typ_equality l env etyp (pat_typ_of pat)) pats;
+     let etyp = typ_of_pat (List.hd pats) in
+     List.iter (fun pat -> typ_equality l env etyp (typ_of_pat pat)) pats;
      annot_pat (P_vector pats) (dvector_typ env len etyp), env, guards
   | P_vector_concat (pat :: pats) ->
      let fold_pats (pats, env, guards) pat =
@@ -2944,9 +2750,9 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
      in
      let inferred_pats, env, guards =
        List.fold_left fold_pats ([], env, []) (pat :: pats) in
-     let (len, _, vtyp) = destruct_vec_typ l env (pat_typ_of (List.hd inferred_pats)) in
+     let (len, _, vtyp) = destruct_vec_typ l env (typ_of_pat (List.hd inferred_pats)) in
      let fold_len len pat =
-       let (len', _, vtyp') = destruct_vec_typ l env (pat_typ_of pat) in
+       let (len', _, vtyp') = destruct_vec_typ l env (typ_of_pat pat) in
        typ_equality l env vtyp vtyp';
        nsum len len'
      in
@@ -2955,7 +2761,7 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
   | P_string_append pats ->
      let fold_pats (pats, env, guards) pat =
        let inferred_pat, env, guards' = infer_pat env pat in
-       typ_equality l env (pat_typ_of inferred_pat) string_typ;
+       typ_equality l env (typ_of_pat inferred_pat) string_typ;
        pats @ [inferred_pat], env, guards' @ guards
      in
      let typed_pats, env, guards =
@@ -2964,8 +2770,8 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
      annot_pat (P_string_append typed_pats) string_typ, env, guards
   | P_as (pat, id) ->
      let (typed_pat, env, guards) = infer_pat env pat in
-     annot_pat (P_as (typed_pat, id)) (pat_typ_of typed_pat),
-     Env.add_local id (Immutable, pat_typ_of typed_pat) env,
+     annot_pat (P_as (typed_pat, id)) (typ_of_pat typed_pat),
+     Env.add_local id (Immutable, typ_of_pat typed_pat) env,
      guards
   | _ -> typ_error l ("Couldn't infer type of pattern " ^ string_of_pat pat)
 
@@ -2976,7 +2782,7 @@ and bind_typ_pat env (TP_aux (typ_pat_aux, l) as typ_pat) (Typ_aux (typ_aux, _)
      begin
        match typ_nexps typ with
        | [nexp] ->
-          Env.add_constraint (nc_eq (nvar kid) nexp) (Env.add_typ_var l kid BK_int env)
+          Env.add_constraint (nc_eq (nvar kid) nexp) (Env.add_typ_var l (mk_kopt K_int kid) env)
        | [] ->
           typ_error l ("No numeric expressions in " ^ string_of_typ typ ^ " to bind " ^ string_of_kid kid ^ " to")
        | nexps ->
@@ -2985,13 +2791,13 @@ and bind_typ_pat env (TP_aux (typ_pat_aux, l) as typ_pat) (Typ_aux (typ_aux, _)
   | TP_app (f1, tpats), Typ_app (f2, typs) when Id.compare f1 f2 = 0 ->
      List.fold_left2 bind_typ_pat_arg env tpats typs
   | _, _ -> typ_error l ("Couldn't bind type " ^ string_of_typ typ ^ " with " ^ string_of_typ_pat typ_pat)
-and bind_typ_pat_arg env (TP_aux (typ_pat_aux, l) as typ_pat) (Typ_arg_aux (typ_arg_aux, _) as typ_arg) =
+and bind_typ_pat_arg env (TP_aux (typ_pat_aux, l) as typ_pat) (A_aux (typ_arg_aux, _) as typ_arg) =
   match typ_pat_aux, typ_arg_aux with
   | TP_wild, _ -> env
-  | TP_var kid, Typ_arg_nexp nexp ->
-     Env.add_constraint (nc_eq (nvar kid) nexp) (Env.add_typ_var l kid BK_int env)
-  | _, Typ_arg_typ typ -> bind_typ_pat env typ_pat typ
-  | _, Typ_arg_order _ -> typ_error l "Cannot bind type pattern against order"
+  | TP_var kid, A_nexp nexp ->
+     Env.add_constraint (nc_eq (nvar kid) nexp) (Env.add_typ_var l (mk_kopt K_int kid) env)
+  | _, A_typ typ -> bind_typ_pat env typ_pat typ
+  | _, A_order _ -> typ_error l "Cannot bind type pattern against order"
   | _, _ -> typ_error l ("Couldn't bind type argument " ^ string_of_typ_arg typ_arg ^ " with " ^ string_of_typ_pat typ_pat)
 
 and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as exp) =
@@ -3038,7 +2844,7 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
        | Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
           let eff = if is_register then mk_effect [BE_wreg] else no_effect in
           let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
-          let unifiers, _, _ (* FIXME *) = try unify l env rectyp_q regtyp with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
+          let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q regtyp with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
           let field_typ' = subst_unifiers unifiers field_typ in
           let checked_exp = crule check_exp env exp field_typ' in
           annot_assign (annot_lexp (LEXP_field (annot_lexp_effect inferred_flexp regtyp eff, field)) field_typ') checked_exp, env
@@ -3059,9 +2865,21 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
      | _ -> assert false
      end
   | _ ->
-     let inferred_exp = irule infer_exp env exp in
-     let tlexp, env' = bind_lexp env lexp (typ_of inferred_exp) in
-     annot_assign tlexp inferred_exp, env'
+     (* Here we have two options, we can infer the type from the
+        expression, or we can infer the type from the
+        l-expression. Both are useful in different cases, so try
+        both. *)
+     try
+       let inferred_exp = irule infer_exp env exp in
+       let tlexp, env' = bind_lexp env lexp (typ_of inferred_exp) in
+       annot_assign tlexp inferred_exp, env'
+     with
+     | Type_error (l, err) ->
+        try
+          let inferred_lexp = infer_lexp env lexp in
+          let checked_exp = crule check_exp env exp (lexp_typ_of inferred_lexp) in
+          annot_assign inferred_lexp checked_exp, env
+        with Type_error (l, err') -> typ_raise l (Err_because (err', err))
 
 and bind_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) typ =
   typ_print (lazy ("Binding mutable " ^ string_of_lexp lexp ^  " to " ^ string_of_typ typ));
@@ -3087,7 +2905,7 @@ and bind_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) typ =
   | LEXP_deref exp ->
      let inferred_exp = infer_exp env exp in
      begin match typ_of inferred_exp with
-     | Typ_aux (Typ_app (r, [Typ_arg_aux (Typ_arg_typ vtyp, _)]), _) when string_of_id r = "register" ->
+     | Typ_aux (Typ_app (r, [A_aux (A_typ vtyp, _)]), _) when string_of_id r = "register" ->
         subtyp l env typ vtyp; annot_lexp_effect (LEXP_deref inferred_exp) typ (mk_effect [BE_wreg]), env
      | _ ->
         typ_error l (string_of_typ typ  ^ " must be a register type in " ^ string_of_exp exp ^ ")")
@@ -3140,7 +2958,7 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
        let inferred_v_lexp = infer_lexp env v_lexp in
        let (Typ_aux (v_typ_aux, _) as v_typ) = Env.expand_synonyms env (lexp_typ_of inferred_v_lexp) in
        match v_typ_aux with
-       | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp len, _); Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ elem_typ, _)])
+       | Typ_app (id, [A_aux (A_nexp len, _); A_aux (A_order ord, _); A_aux (A_typ elem_typ, _)])
             when Id.compare id (mk_id "vector") = 0 ->
           let inferred_exp1 = infer_exp env exp1 in
           let inferred_exp2 = infer_exp env exp2 in
@@ -3162,7 +2980,7 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
        let inferred_v_lexp = infer_lexp env v_lexp in
        let (Typ_aux (v_typ_aux, _) as v_typ) = Env.expand_synonyms env (lexp_typ_of inferred_v_lexp) in
        match v_typ_aux with
-       | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp len, _); Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ elem_typ, _)])
+       | Typ_app (id, [A_aux (A_nexp len, _); A_aux (A_order ord, _); A_aux (A_typ elem_typ, _)])
             when Id.compare id (mk_id "vector") = 0 ->
           let inferred_exp = infer_exp env exp in
           let nexp, env = bind_numeric l (typ_of inferred_exp) env in
@@ -3177,7 +2995,7 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
      begin
        let sum_lengths first_ord first_elem_typ acc (Typ_aux (v_typ_aux, _) as v_typ) =
          match v_typ_aux with
-         | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp len, _); Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ elem_typ, _)])
+         | Typ_app (id, [A_aux (A_nexp len, _); A_aux (A_order ord, _); A_aux (A_typ elem_typ, _)])
               when Id.compare id (mk_id "vector") = 0 && ord_identical ord first_ord ->
             typ_equality l env elem_typ first_elem_typ;
             nsum acc len
@@ -3188,7 +3006,7 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
        let (Typ_aux (v_typ_aux, _) as v_typ) = Env.expand_synonyms env (lexp_typ_of inferred_v_lexp) in
        let v_typs = List.map (fun lexp -> Env.expand_synonyms env (lexp_typ_of lexp)) inferred_v_lexps in
        match v_typ_aux with
-       | Typ_app (id, [Typ_arg_aux (Typ_arg_nexp len, _); Typ_arg_aux (Typ_arg_order ord, _); Typ_arg_aux (Typ_arg_typ elem_typ, _)])
+       | Typ_app (id, [A_aux (A_nexp len, _); A_aux (A_order ord, _); A_aux (A_typ elem_typ, _)])
             when Id.compare id (mk_id "vector") = 0 ->
           let len = List.fold_left (sum_lengths ord elem_typ) len v_typs in
           annot_lexp (LEXP_vector_concat (inferred_v_lexp :: inferred_v_lexps)) (vector_typ (nexp_simp len) ord elem_typ)
@@ -3203,7 +3021,10 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
      in
      let typq, _, ret_typ, _ = Env.get_accessor rec_id fid env in
      annot_lexp_effect (LEXP_field (annot_lexp (LEXP_id v) (mk_id_typ rec_id), fid)) ret_typ weff
-  | _ -> typ_error l ("Unhandled l-expression " ^ string_of_lexp lexp)
+  | LEXP_tup lexps ->
+     let inferred_lexps = List.map (infer_lexp env) lexps in
+     annot_lexp (LEXP_tup inferred_lexps) (tuple_typ (List.map lexp_typ_of inferred_lexps))
+  | _ -> typ_error l ("Could not infer the type of " ^ string_of_lexp lexp)
 
 and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
   let annot_exp_effect exp typ eff = E_aux (exp, (l, Some ((env, typ, eff),None))) in
@@ -3219,7 +3040,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        | Unbound -> typ_error l ("Identifier " ^ string_of_id v ^ " is unbound")
      end
   | E_lit lit -> annot_exp (E_lit lit) (infer_lit env lit)
-  | E_sizeof nexp -> annot_exp (E_sizeof nexp) (mk_typ (Typ_app (mk_id "atom", [mk_typ_arg (Typ_arg_nexp nexp)])))
+  | E_sizeof nexp -> annot_exp (E_sizeof nexp) (mk_typ (Typ_app (mk_id "atom", [mk_typ_arg (A_nexp nexp)])))
   | E_constraint nc ->
      Env.wf_constraint env nc;
      annot_exp (E_constraint nc) bool_typ
@@ -3250,7 +3071,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      annot_exp (E_tuple inferred_exps) (mk_typ (Typ_tup (List.map typ_of inferred_exps)))
   | E_assign (lexp, bind) ->
      fst (bind_assignment env lexp bind)
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, flag), (l, ()))) ->
+  | E_record_update (exp, fexps) ->
      let inferred_exp = irule infer_exp env exp in
      let typ = typ_of inferred_exp in
      let rectyp_id = match Env.expand_synonyms env typ with
@@ -3260,12 +3081,12 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      in
      let check_fexp (FE_aux (FE_Fexp (field, exp), (l, ()))) =
        let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
-       let unifiers, _, _ (* FIXME *) = try unify l env rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
+       let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error l ("Unification error: " ^ m) in
        let field_typ' = subst_unifiers unifiers field_typ in
        let inferred_exp = crule check_exp env exp field_typ' in
        FE_aux (FE_Fexp (field, inferred_exp), (l, None))
      in
-     annot_exp (E_record_update (inferred_exp, FES_aux (FES_Fexps (List.map check_fexp fexps, flag), (l, None)))) typ
+     annot_exp (E_record_update (inferred_exp, List.map check_fexp fexps)) typ
   | E_cast (typ, exp) ->
      let checked_exp = crule check_exp env exp typ in
      annot_exp (E_cast (typ, checked_exp)) typ
@@ -3315,10 +3136,10 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        let inferred_f = irule infer_exp env f in
        let inferred_t = irule infer_exp env t in
        let checked_step = crule check_exp env step int_typ in
-       match destruct_numeric env (typ_of inferred_f), destruct_numeric env (typ_of inferred_t) with
+       match destruct_numeric (typ_of inferred_f), destruct_numeric (typ_of inferred_t) with
        | Some (kids1, nc1, nexp1), Some (kids2, nc2, nexp2) ->
           let loop_kid = mk_kid ("loop_" ^ string_of_id v) in
-          let env = List.fold_left (fun env kid -> Env.add_typ_var l kid BK_int env) env (loop_kid :: kids1 @ kids2) in
+          let env = List.fold_left (fun env kid -> Env.add_typ_var l (mk_kopt K_int kid) env) env (loop_kid :: kids1 @ kids2) in
           let env = Env.add_constraint (nc_and nc1 nc2) env in
           let env = Env.add_constraint (nc_and (nc_lteq nexp1 (nvar loop_kid)) (nc_lteq (nvar loop_kid) nexp2)) env in
           let loop_vtyp = atom_typ (nvar loop_kid) in
@@ -3331,8 +3152,22 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
   | E_if (cond, then_branch, else_branch) ->
      let cond' = crule check_exp env cond (mk_typ (Typ_id (mk_id "bool"))) in
      let then_branch' = irule infer_exp (add_opt_constraint (assert_constraint env true cond') env) then_branch in
-     let else_branch' = crule check_exp (add_opt_constraint (option_map nc_negate (assert_constraint env false cond')) env) else_branch (typ_of then_branch') in
-     annot_exp (E_if (cond', then_branch', else_branch')) (typ_of then_branch')
+     (* We don't have generic type union in Sail, but we can union simple numeric types. *)
+     begin match destruct_numeric (Env.expand_synonyms env (typ_of then_branch')) with
+     | Some (kids, nc, then_nexp) ->
+        let then_sn = to_simple_numeric l kids nc then_nexp in
+        let else_branch' = irule infer_exp (add_opt_constraint (option_map nc_not (assert_constraint env false cond')) env) else_branch in
+        begin match destruct_numeric (Env.expand_synonyms env (typ_of else_branch')) with
+        | Some (kids, nc, else_nexp) ->
+           let else_sn = to_simple_numeric l kids nc else_nexp in
+           let typ = typ_of_simple_numeric (union_simple_numeric then_sn else_sn) in
+           annot_exp (E_if (cond', then_branch', else_branch')) typ
+        | None -> typ_error l ("Could not infer type of " ^ string_of_exp else_branch)
+        end
+     | None ->
+        let else_branch' = crule check_exp (add_opt_constraint (option_map nc_not (assert_constraint env false cond')) env) else_branch (typ_of then_branch') in
+        annot_exp (E_if (cond', then_branch', else_branch')) (typ_of then_branch')
+     end
   | E_vector_access (v, n) -> infer_exp env (E_aux (E_app (mk_id "vector_access", [v; n]), (l, ())))
   | E_vector_update (v, n, exp) -> infer_exp env (E_aux (E_app (mk_id "vector_update", [v; n; exp]), (l, ())))
   | E_vector_update_subrange (v, n, m, exp) -> infer_exp env (E_aux (E_app (mk_id "vector_update_subrange", [v; n; m; exp]), (l, ())))
@@ -3346,6 +3181,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      let vec_typ = dvector_typ env (nint (List.length vec)) (typ_of inferred_item) in
      annot_exp (E_vector (inferred_item :: checked_items)) vec_typ
   | E_assert (test, msg) ->
+     let msg = assert_msg test msg in
      let checked_test = crule check_exp env test bool_typ in
      let checked_msg = crule check_exp env msg string_typ in
      annot_exp_effect (E_assert (checked_test, checked_msg)) unit_typ (mk_effect [BE_escape])
@@ -3406,161 +3242,125 @@ and instantiation_of_without_type (E_aux (exp_aux, (l, _)) as exp) =
   | E_app (f, xs) -> snd (infer_funapp' l (Env.no_casts env) f (Env.get_val_spec f env) (List.map strip_exp xs) None)
   | _ -> invalid_arg ("instantiation_of expected application,  got " ^ string_of_exp exp)
 
-and infer_funapp' l env f (typq, f_typ) xs ret_ctx_typ =
-  let annot_exp exp typ eff = E_aux (exp, (l, Some ((env, typ, eff), ret_ctx_typ))) in
-  let switch_annot env typ = function
-    | (E_aux (exp, (l, Some (_, _, eff)))) -> E_aux (exp, (l, Some (env, typ, eff)))
-    | _ -> failwith "Cannot switch annot for unannotated function"
-  in
-  let all_unifiers = ref KBindings.empty in
-  let ex_goal = ref None in
-  let prove_goal env = match !ex_goal with
-    | Some goal when prove env goal -> ()
-    | Some goal -> typ_error l ("Could not prove existential goal: " ^ string_of_n_constraint goal)
-    | None -> ()
-  in
+and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
+  typ_print (lazy (Util.("Function " |> cyan |> clear) ^ string_of_id f));
+  let annot_exp exp typ eff = E_aux (exp, (l, Some ((env, typ, eff), expected_ret_typ))) in
+  let is_bound env kid = KBindings.mem kid (Env.get_typ_vars env) in
+
+  (* First we record all the type variables when we start checking the
+     application, so we can distinguish them from existentials
+     introduced by instantiating function arguments later. *)
   let universals = Env.get_typ_vars env in
   let universal_constraints = Env.get_constraints env in
-  let is_bound kid env = KBindings.mem kid (Env.get_typ_vars env) in
-  let rec number n = function
-    | [] -> []
-    | (x :: xs) -> (n, x) :: number (n + 1) xs
-  in
-  let solve_quant env = function
-    | QI_aux (QI_id _, _) -> false
-    | QI_aux (QI_const nc, _) -> prove env nc
-  in
+
+  let all_unifiers = ref KBindings.empty in
   let record_unifiers unifiers =
     let previous_unifiers = !all_unifiers in
-    let updated_unifiers = KBindings.map (subst_uvar_unifiers unifiers) previous_unifiers in
+    let updated_unifiers = KBindings.map (subst_unifiers_typ_arg unifiers) previous_unifiers in
     all_unifiers := merge_uvars l updated_unifiers unifiers;
   in
-  let rec instantiate env quants typs ret_typ args =
-    match typs, args with
-    | (utyps, []), (uargs, []) ->
-       begin
-         typ_debug (lazy ("Got unresolved args: " ^ string_of_list ", " (fun (_, exp) -> string_of_exp exp) uargs));
-         if List.for_all (solve_quant env) quants
-         then
-           let iuargs = List.map2 (fun utyp (n, uarg) -> (n, crule check_exp env uarg utyp)) utyps uargs in
-           (iuargs, ret_typ, env)
-         else typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants
-                           ^ " not resolved during application of " ^ string_of_id f ^ " unresolved args: " ^ string_of_list ", " (fun (_, exp) -> string_of_exp exp) uargs)
-       end
-    | (utyps, (typ :: typs)), (uargs, ((n, arg) :: args))
-         when List.for_all (fun kid -> is_bound kid env) (KidSet.elements (typ_frees typ)) ->
-       begin
-         let carg = crule check_exp env arg typ in
-         let (iargs, ret_typ', env) = instantiate env quants (utyps, typs) ret_typ (uargs, args) in
-         ((n, carg) :: iargs, ret_typ', env)
-       end
-    | (utyps, (typ :: typs)), (uargs, ((n, arg) :: args)) ->
-       begin
-         typ_debug (lazy ("INSTANTIATE: " ^ string_of_exp arg ^ " with " ^ string_of_typ typ));
-         let iarg = irule infer_exp env arg in
-         typ_debug (lazy ("INFER: " ^ string_of_exp arg ^ " type " ^ string_of_typ (typ_of iarg)));
-         try
-           (* If we get an existential when instantiating, we prepend
-              the identifier of the exisitential with the tag argN# to
-              denote that it was bound by the Nth argument to the
-              function. *)
-           let ex_tag = "arg" ^ string_of_int n ^ "#" in
-           let iarg, (unifiers, ex_kids, ex_nc) = type_coercion_unify env iarg typ in
-           typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
-           typ_debug (lazy ("EX KIDS: " ^ string_of_list ", " string_of_kid ex_kids));
-           let env = match ex_kids, ex_nc with
-             | [], None -> env
-             | _, Some enc ->
-                let enc = List.fold_left (fun nc kid -> nc_subst_nexp kid (Nexp_var (prepend_kid ex_tag kid)) nc) enc ex_kids in
-                let env = List.fold_left (fun env kid -> Env.add_typ_var l (prepend_kid ex_tag kid) BK_int env) env ex_kids in
-                Env.add_constraint enc env
-             | _, None -> assert false (* Cannot have ex_kids without ex_nc *)
-           in
-           let tag_unifier uvar = List.fold_left (fun uvar kid -> uvar_subst_nexp kid (Nexp_var (prepend_kid ex_tag kid)) uvar) uvar ex_kids in
-           let unifiers = KBindings.map tag_unifier unifiers in
-           record_unifiers unifiers;
-           let utyps' = List.map (subst_unifiers unifiers) utyps in
-           let typs' = List.map (subst_unifiers unifiers) typs in
-           let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
-           let ret_typ' = subst_unifiers unifiers ret_typ in
-           let (iargs, ret_typ'', env) = instantiate env quants' (utyps', typs') ret_typ' (uargs, args) in
-           ((n, iarg) :: iargs, ret_typ'', env)
-         with
-         | Unification_error (l, str) ->
-            typ_print (lazy ("Unification error: " ^ str));
-            instantiate env quants (typ :: utyps, typs) ret_typ ((n, arg) :: uargs, args)
-       end
-    | (_, []), _ -> typ_error l ("Function " ^ string_of_id f ^ " applied to too many arguments")
-    | _, (_, []) -> typ_error l ("Function " ^ string_of_id f ^ " not applied to enough arguments")
-  in
-  let instantiate_ret env quants typs ret_typ =
-    match ret_ctx_typ with
-    | None -> (quants, typs, ret_typ, env)
-    | Some rct when is_exist (Env.expand_synonyms env rct) -> (quants, typs, ret_typ, env) 
-    | Some rct ->
-       begin
-         typ_debug (lazy ("RCT is " ^ string_of_typ rct));
-         typ_debug (lazy ("INSTANTIATE RETURN:" ^ string_of_typ ret_typ));
-         let unifiers, ex_kids, ex_nc =
-           try unify l env ret_typ rct with
-           | Unification_error _ -> typ_debug (lazy "UERROR"); KBindings.empty, [], None
-         in
-         typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
-         if ex_kids = [] then () else (typ_debug (lazy ("EX GOAL: " ^ string_of_option string_of_n_constraint ex_nc)); ex_goal := ex_nc);
-         record_unifiers unifiers;
-         let env = List.fold_left (fun env kid -> Env.add_typ_var l kid BK_int env) env ex_kids in
-         let typs' = List.map (subst_unifiers unifiers) typs in
-         let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
-         let ret_typ' =
-           match ex_nc with
-           | None -> subst_unifiers unifiers ret_typ
-           | Some nc -> mk_typ (Typ_exist (ex_kids, nc, subst_unifiers unifiers ret_typ))
-         in
-         (quants', typs', ret_typ', env)
-       end
-  in
+
   let quants, typ_args, typ_ret, eff =
     match Env.expand_synonyms env f_typ with
-    | Typ_aux (Typ_fn (typ_args, typ_ret, eff), _) -> quant_items typq, typ_args, typ_ret, eff
+    | Typ_aux (Typ_fn (typ_args, typ_ret, eff), _) -> ref (quant_items typq), typ_args, ref typ_ret, eff
     | _ -> typ_error l (string_of_typ f_typ ^ " is not a function type")
   in
-  let unifiers = instantiate_simple_equations quants in
+
+  let unifiers = instantiate_simple_equations !quants in
   typ_debug (lazy "Instantiating from equations");
-  typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));  all_unifiers := unifiers;
+  typ_debug (lazy (string_of_list ", " (fun (kid, arg) -> string_of_kid kid ^ " => " ^ string_of_typ_arg arg) (KBindings.bindings unifiers)));
+  all_unifiers := unifiers;
   let typ_args = List.map (subst_unifiers unifiers) typ_args in
-  let quants = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
-  let typ_ret = subst_unifiers unifiers typ_ret in
-  let quants, typ_args, typ_ret, env =
-    instantiate_ret env quants typ_args typ_ret
+  List.iter (fun unifier -> quants := instantiate_quants !quants unifier) (KBindings.bindings unifiers);
+  List.iter (fun (v, arg) -> typ_ret := typ_subst v arg !typ_ret) (KBindings.bindings unifiers);
+
+  typ_debug (lazy ("Quantifiers " ^ Util.string_of_list ", " string_of_quant_item !quants));
+
+  if not (List.length typ_args = List.length xs) then
+    typ_error l (Printf.sprintf "Function %s applied to %d args, expected %d" (string_of_id f) (List.length xs) (List.length typ_args))
+  else ();
+
+  let instantiate_quant (v, arg) (QI_aux (aux, l) as qi) =
+    match aux with
+    | QI_id kopt when Kid.compare (kopt_kid kopt) v = 0 -> None
+    | QI_id _ -> Some qi
+    | QI_const nc -> Some (QI_aux (QI_const (constraint_subst v arg nc), l))
+  in
+
+  let typ_args = match expected_ret_typ with
+    | None -> typ_args
+    | Some expect when is_exist (Env.expand_synonyms env expect) || is_exist !typ_ret -> typ_args
+    | Some expect ->
+       let goals = quant_kopts (mk_typquant !quants) |> List.map kopt_kid |> KidSet.of_list in
+       try
+         let unifiers = unify l env goals !typ_ret expect in
+         record_unifiers unifiers;
+         let unifiers = KBindings.bindings unifiers in
+         typ_debug (lazy (Util.("Unifiers " |> magenta |> clear)
+                          ^ Util.string_of_list ", " (fun (v, arg) -> string_of_kid v ^ " => " ^ string_of_typ_arg arg) unifiers));
+         List.iter (fun unifier -> quants := instantiate_quants !quants unifier) unifiers;
+         List.iter (fun (v, arg) -> typ_ret := typ_subst v arg !typ_ret) unifiers;
+         List.map (fun typ -> List.fold_left (fun typ (v, arg) -> typ_subst v arg typ) typ unifiers) typ_args
+       with Unification_error _ -> typ_args
+  in
+
+  (* We now iterate throught the function arguments, checking them and
+     instantiating quantifiers. *)
+  let instantiate env arg typ remaining_typs =
+    if KidSet.for_all (is_bound env) (tyvars_of_typ typ) then
+      crule check_exp env arg typ, remaining_typs, env
+    else
+      let goals = quant_kopts (mk_typquant !quants) |> List.map kopt_kid |> KidSet.of_list in
+      typ_debug (lazy ("Quantifiers " ^ Util.string_of_list ", " string_of_quant_item !quants));
+      let inferred_arg = irule infer_exp env arg in
+      let inferred_arg, unifiers, env =
+        try type_coercion_unify env goals inferred_arg typ with
+        | Unification_error (l, m) -> typ_error l m
+      in
+      record_unifiers unifiers;
+      let unifiers = KBindings.bindings unifiers in
+      typ_debug (lazy (Util.("Unifiers " |> magenta |> clear)
+                       ^ Util.string_of_list ", " (fun (v, arg) -> string_of_kid v ^ " => " ^ string_of_typ_arg arg) unifiers));
+      List.iter (fun unifier -> quants := instantiate_quants !quants unifier) unifiers;
+      List.iter (fun (v, arg) -> typ_ret := typ_subst v arg !typ_ret) unifiers;
+      let remaining_typs =
+        List.map (fun typ -> List.fold_left (fun typ (v, arg) -> typ_subst v arg typ) typ unifiers) remaining_typs
+      in
+      inferred_arg, remaining_typs, env
+  in
+  let fold_instantiate (xs, args, env) x =
+    match args with
+    | arg :: remaining_args ->
+       let x, remaining_args, env = instantiate env x arg remaining_args in
+       (x :: xs, remaining_args, env)
+    | [] -> raise (Reporting.err_unreachable l __POS__ "Empty arguments during instantiation")
   in
-  let (xs_instantiated, typ_ret, env) = instantiate env quants ([], typ_args) typ_ret ([], number 0 xs) in
-  let xs_reordered = List.map snd (List.sort (fun (n, _) (m, _) -> compare n m) xs_instantiated) in
+  let xs, _, env = List.fold_left fold_instantiate ([], typ_args, env) xs in
+  let xs = List.rev xs in
 
-  prove_goal env;
+  if not (List.for_all (solve_quant env) !quants) then
+    typ_raise l (Err_unresolved_quants (f, !quants, Env.get_locals env, Env.get_constraints env))
+  else ();
 
-  let ty_vars = List.map fst (KBindings.bindings (Env.get_typ_vars env)) in
-  let existentials = List.filter (fun kid -> not (KBindings.mem kid universals)) ty_vars in
+  let ty_vars = KBindings.bindings (Env.get_typ_vars env) |> List.map (fun (v, k) -> mk_kopt k v) in
+  let existentials = List.filter (fun kopt -> not (KBindings.mem (kopt_kid kopt) universals)) ty_vars in
   let num_new_ncs = List.length (Env.get_constraints env) - List.length universal_constraints in
-  let ex_constraints = take num_new_ncs (Env.get_constraints env) in 
+  let ex_constraints = take num_new_ncs (Env.get_constraints env) in
 
-  typ_debug (lazy ("Existentials: " ^ string_of_list ", " string_of_kid existentials));
+  typ_debug (lazy ("Existentials: " ^ string_of_list ", " string_of_kinded_id existentials));
   typ_debug (lazy ("Existential constraints: " ^ string_of_list ", " string_of_n_constraint ex_constraints));
 
+  let universals = KBindings.bindings universals |> List.map fst |> KidSet.of_list in
   let typ_ret =
-    if KidSet.is_empty (KidSet.of_list existentials) || KidSet.is_empty (typ_frees typ_ret)
-    then (typ_debug (lazy "Returning Existential"); typ_ret)
-    else mk_typ (Typ_exist (existentials, List.fold_left nc_and nc_true ex_constraints, typ_ret))
+    if KidSet.is_empty (KidSet.of_list (List.map kopt_kid existentials)) || KidSet.is_empty (KidSet.diff (typ_frees !typ_ret) universals)
+    then !typ_ret
+    else mk_typ (Typ_exist (existentials, List.fold_left nc_and nc_true ex_constraints, !typ_ret))
   in
   let typ_ret = simp_typ typ_ret in
-  let exp = annot_exp (E_app (f, xs_reordered)) typ_ret eff in
-  typ_debug (lazy ("RETURNING: " ^ string_of_typ (typ_of exp)));
-  match ret_ctx_typ with
-  | None ->
-     exp, !all_unifiers
-  | Some rct ->
-     let exp = type_coercion env exp rct in
-     typ_debug (lazy ("RETURNING AFTER COERCION " ^ string_of_typ (typ_of exp)));
-     exp, !all_unifiers
+  let exp = annot_exp (E_app (f, xs)) typ_ret eff in
+  typ_debug (lazy ("Returning: " ^ string_of_exp exp));
+
+  exp, !all_unifiers
 
 and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (Typ_aux (typ_aux, _) as typ) =
   let (Typ_aux (typ_aux, _) as typ), env = bind_existential l typ env in
@@ -3581,7 +3381,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
        if Env.is_union_constructor v env then
          Util.warn (Printf.sprintf "Identifier %s found in mapping-pattern is also a union constructor at %s\n"
                                    (string_of_id v)
-                                   (Reporting_basic.loc_to_string l))
+                                   (Reporting.loc_to_string l))
        else ();
        match Env.lookup_id v env with
        | Local (Immutable, _) | Unbound -> annot_mpat (MP_id v) typ, Env.add_local v (Immutable, typ) env, []
@@ -3592,7 +3392,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
   | MP_cons (hd_mpat, tl_mpat) ->
      begin
        match Env.expand_synonyms env typ with
-       | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
+       | Typ_aux (Typ_app (f, [A_aux (A_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
           let hd_mpat, env, hd_guards = bind_mpat allow_unknown other_env env hd_mpat ltyp in
           let tl_mpat, env, tl_guards = bind_mpat allow_unknown other_env env tl_mpat typ in
           annot_mpat (MP_cons (hd_mpat, tl_mpat)) typ, env, hd_guards @ tl_guards
@@ -3616,7 +3416,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
   | MP_list mpats ->
      begin
        match Env.expand_synonyms env typ with
-       | Typ_aux (Typ_app (f, [Typ_arg_aux (Typ_arg_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
+       | Typ_aux (Typ_app (f, [A_aux (A_typ ltyp, _)]), _) when Id.compare f (mk_id "list") = 0 ->
           let rec process_mpats env = function
             | [] -> [], env, []
             | (pat :: mpats) ->
@@ -3659,10 +3459,9 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
           begin
             try
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, ctor_typ) ^ " for mapping-pattern " ^ string_of_typ typ));
-              let unifiers, _, _ (* FIXME! *) = unify l env ret_typ typ in
-              typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
+              let unifiers = unify l env (tyvars_of_typ ret_typ) ret_typ typ in
               let arg_typ' = subst_unifiers unifiers arg_typ in
-              let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
+              let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
               if (match quants' with [] -> false | _ -> true)
               then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
               else ();
@@ -3690,10 +3489,9 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
           begin
             try
               typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for mapping-pattern " ^ string_of_typ typ));
-              let unifiers, _, _ (* FIXME! *) = unify l env typ2 typ in
-              typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
+              let unifiers = unify l env (tyvars_of_typ typ2) typ2 typ in
               let arg_typ' = subst_unifiers unifiers typ1 in
-              let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
+              let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
               if (match quants' with [] -> false | _ -> true)
               then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
               else ();
@@ -3708,10 +3506,9 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
                try
                  typ_debug (lazy "Unifying mapping forwards failed, trying backwards.");
                  typ_debug (lazy ("Unifying " ^ string_of_bind (typq, mapping_typ) ^ " for mapping-pattern " ^ string_of_typ typ));
-                 let unifiers, _, _ (* FIXME! *) = unify l env typ1 typ in
-                 typ_debug (lazy (string_of_list ", " (fun (kid, uvar) -> string_of_kid kid ^ " => " ^ string_of_uvar uvar) (KBindings.bindings unifiers)));
+                 let unifiers = unify l env (tyvars_of_typ typ1) typ1 typ in
                  let arg_typ' = subst_unifiers unifiers typ2 in
-                 let quants' = List.fold_left (fun qs (kid, uvar) -> instantiate_quants qs kid uvar) quants (KBindings.bindings unifiers) in
+                 let quants' = List.fold_left instantiate_quants quants (KBindings.bindings unifiers) in
                  if (match quants' with [] -> false | _ -> true)
                  then typ_error l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
                  else ();
@@ -3844,7 +3641,7 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
      typ_error l ("Couldn't infer type of mapping-pattern " ^ string_of_mpat mpat)
 
 (**************************************************************************)
-(* 6. Effect system                                                       *)
+(* 5. Effect system                                                       *)
 (**************************************************************************)
 
 let effect_of_annot = function
@@ -3942,14 +3739,14 @@ and propagate_exp_effect_aux = function
      let p_cases = List.map propagate_pexp_effect cases in
      let case_eff = List.fold_left union_effects no_effect (List.map snd p_cases) in
      E_case (p_exp, List.map fst p_cases), union_effects (effect_of p_exp) case_eff
-  | E_record_update (exp, FES_aux (FES_Fexps (fexps, flag), (l, _))) ->
+  | E_record_update (exp, fexps) ->
      let p_exp = propagate_exp_effect exp in
      let p_fexps = List.map propagate_fexp_effect fexps in
-     E_record_update (p_exp, FES_aux (FES_Fexps (List.map fst p_fexps, flag), (l, None))),
+     E_record_update (p_exp, List.map fst p_fexps),
      List.fold_left union_effects no_effect (effect_of p_exp :: List.map snd p_fexps)
-  | E_record (FES_aux (FES_Fexps (fexps, flag), (l, _))) ->
+  | E_record fexps ->
      let p_fexps = List.map propagate_fexp_effect fexps in
-     E_record (FES_aux (FES_Fexps (List.map fst p_fexps, flag), (l, None))),
+     E_record (List.map fst p_fexps),
      List.fold_left union_effects no_effect (List.map snd p_fexps)
   | E_try (exp, cases) ->
      let p_exp = propagate_exp_effect exp in
@@ -4288,7 +4085,7 @@ let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
             MCL_aux (MCL_backwards (typed_mpexp, typed_exp), (l, Some ((env, typ, prop_effs), Some typ)))
           end
       end
-    | _ -> typ_error l ("Mapping clause must have mapping type: " ^ string_of_typ typ ^ " is not a mapping type")        
+    | _ -> typ_error l ("Mapping clause must have mapping type: " ^ string_of_typ typ ^ " is not a mapping type")
 
 let funcl_effect (FCL_aux (FCL_Funcl (id, typed_pexp), (l, annot))) =
   match annot with
@@ -4357,7 +4154,7 @@ let check_fundef env (FD_aux (FD_function (recopt, tannotopt, effectopt, funcls)
     | Some id -> id
     | None -> typ_error l "funcl list is empty"
   in
-  typ_print (lazy ("\nChecking function " ^ string_of_id id));
+  typ_print (lazy ("\n" ^ Util.("Check function " |> cyan |> clear) ^ string_of_id id));
   let have_val_spec, (quant, typ), env =
     try true, Env.get_val_spec id env, env with
     | Type_error (l, _) ->
@@ -4366,11 +4163,21 @@ let check_fundef env (FD_aux (FD_function (recopt, tannotopt, effectopt, funcls)
   in
   let vtyp_args, vtyp_ret, declared_eff, vl = match typ with
     | Typ_aux (Typ_fn (vtyp_args, vtyp_ret, declared_eff), vl) -> vtyp_args, vtyp_ret, declared_eff, vl
-    | _ -> typ_error l "Function val spec was not a function type"
+    | _ -> typ_error l "Function val spec is not a function type"
   in
   check_tannotopt env quant vtyp_ret tannotopt;
   typ_debug (lazy ("Checking fundef " ^ string_of_id id ^ " has type " ^ string_of_bind (quant, typ)));
   let funcl_env = add_typquant l quant env in
+  let recopt =
+    match recopt with
+    | Rec_aux (Rec_nonrec, l) -> Rec_aux (Rec_nonrec, l)
+    | Rec_aux (Rec_rec, l) -> Rec_aux (Rec_rec, l)
+    | Rec_aux (Rec_measure (measure_p, measure_e), l) ->
+       let typ = match vtyp_args with [x] -> x | _ -> Typ_aux (Typ_tup vtyp_args,Unknown) in
+       let tpat, env = bind_pat_no_guard funcl_env (strip_pat measure_p) typ in
+       let texp = check_exp env (strip_exp measure_e) int_typ in
+       Rec_aux (Rec_measure (tpat, texp), l)
+  in
   let funcls = List.map (fun funcl -> check_funcl funcl_env funcl typ) funcls in
   let eff = List.fold_left union_effects no_effect (List.map funcl_effect funcls) in
   let vs_def, env, declared_eff =
@@ -4424,7 +4231,6 @@ let check_mapdef env (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, _)) as md
   else
     typ_error l ("Mapping not pure (or escape only): " ^ string_of_effect eff ^ " found")
 
-
 (* Checking a val spec simply adds the type as a binding in the
    context. We have to destructure the various kinds of val specs, but
    the difference is irrelevant for the typechecker. *)
@@ -4433,13 +4239,14 @@ let check_val_spec env (VS_aux (vs, (l, _))) =
   let vs, id, typq, typ, env = match vs with
     | VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ), ts_l) as typschm, id, exts, is_cast) ->
        typ_print (lazy (Util.("Check val spec " |> cyan |> clear) ^ string_of_id id ^ " : " ^ string_of_typschm typschm));
-       let env = match (Ast_util.extern_assoc "smt" exts, Ast_util.extern_assoc "#" exts) with
-         | Some op, None -> Env.add_smt_op id op env
-         | _, _ -> env
-       in
        let env = Env.add_extern id exts env in
        let env = if is_cast then Env.add_cast id env else env in
-       let typq, typ = expand_bind_synonyms ts_l env (typq, typ) in
+       let typq, typ =
+         if !opt_expand_valspec then
+           expand_bind_synonyms ts_l env (typq, typ)
+         else
+           (typq, typ)
+       in
        let vs = VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ), ts_l), id, exts, is_cast) in
        (vs, id, typq, typ, env)
   in
@@ -4457,15 +4264,16 @@ let check_default env (DT_aux (ds, l)) =
   | DT_order (Ord_aux (Ord_var _, _)) -> typ_error l "Cannot have variable default order"
 
 let kinded_id_arg kind_id =
-  let typ_arg arg = Typ_arg_aux (arg, Parse_ast.Unknown) in
+  let typ_arg arg = A_aux (arg, Parse_ast.Unknown) in
   match kind_id with
-  | KOpt_aux (KOpt_none kid, _) -> typ_arg (Typ_arg_nexp (nvar kid))
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_int, _)], _), kid), _) -> typ_arg (Typ_arg_nexp (nvar kid))
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_order, _)], _), kid), _) ->
-     typ_arg (Typ_arg_order (Ord_aux (Ord_var kid, Parse_ast.Unknown)))
-  | KOpt_aux (KOpt_kind (K_aux (K_kind [BK_aux (BK_type, _)], _), kid), _) ->
-     typ_arg (Typ_arg_typ (mk_typ (Typ_var kid)))
-  | KOpt_aux (KOpt_kind (K_aux (K_kind kinds, _), kid), l) -> typ_error l "Badly formed kind"
+  | KOpt_aux (KOpt_kind (K_aux (K_int, _), kid), _) ->
+     typ_arg (A_nexp (nvar kid))
+  | KOpt_aux (KOpt_kind (K_aux (K_order, _), kid), _) ->
+     typ_arg (A_order (Ord_aux (Ord_var kid, Parse_ast.Unknown)))
+  | KOpt_aux (KOpt_kind (K_aux (K_type, _), kid), _) ->
+     typ_arg (A_typ (mk_typ (Typ_var kid)))
+  | KOpt_aux (KOpt_kind (K_aux (K_bool, _), kid), _) ->
+     typ_arg (A_bool (nc_var kid))
 
 let fold_union_quant quants (QI_aux (qi, l)) =
   match qi with
@@ -4476,7 +4284,7 @@ let check_type_union env variant typq (Tu_aux (tu, l)) =
   let ret_typ = app_typ variant (List.fold_left fold_union_quant [] (quant_items typq)) in
   match tu with
   | Tu_ty_id (Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) as typ, v) ->
-     let typq = mk_typquant (List.map (mk_qi_id BK_type) (KidSet.elements (typ_frees typ))) in
+     let typq = mk_typquant (List.map (mk_qi_id K_type) (KidSet.elements (typ_frees typ))) in
      env
      |> Env.add_union_id v (typq, typ)
      |> Env.add_val_spec v (typq, typ)
@@ -4487,46 +4295,53 @@ let check_type_union env variant typq (Tu_aux (tu, l)) =
      |> Env.add_val_spec v (typq, typ')
 
 (* FIXME: This code is duplicated with general kind-checking code in environment, can they be merged? *)
-let mk_synonym typq typ =
+let mk_synonym typq typ_arg =
   let kopts, ncs = quant_split typq in
+  let kopts = List.map (fun kopt -> kopt, fresh_existential (unaux_kind (kopt_kind kopt))) kopts in
+  let ncs = List.map (fun nc -> List.fold_left (fun nc (kopt, fresh) -> constraint_subst (kopt_kid kopt) (arg_kopt fresh) nc) nc kopts) ncs in
+  let typ_arg = List.fold_left (fun typ_arg (kopt, fresh) -> typ_arg_subst (kopt_kid kopt) (arg_kopt fresh) typ_arg) typ_arg kopts in
+  let kopts = List.map snd kopts in
   let rec subst_args kopts args =
     match kopts, args with
-    | kopt :: kopts, Typ_arg_aux (Typ_arg_nexp arg, _) :: args when is_nat_kopt kopt ->
-       let typ, ncs = subst_args kopts args in
-       typ_subst_nexp (kopt_kid kopt) (unaux_nexp arg) typ,
-       List.map (nc_subst_nexp (kopt_kid kopt) (unaux_nexp arg)) ncs
-    | kopt :: kopts, Typ_arg_aux (Typ_arg_typ arg, _) :: args when is_typ_kopt kopt ->
-       let typ, ncs = subst_args kopts args in
-       typ_subst_typ (kopt_kid kopt) (unaux_typ arg) typ, ncs
-    | kopt :: kopts, Typ_arg_aux (Typ_arg_order arg, _) :: args when is_order_kopt kopt ->
-       let typ, ncs = subst_args kopts args in
-       typ_subst_order (kopt_kid kopt) (unaux_order arg) typ, ncs
-    | [], [] -> typ, ncs
-    | _, Typ_arg_aux (_, l) :: _ -> typ_error l "Synonym applied to bad arguments"
+    | kopt :: kopts, A_aux (A_nexp arg, _) :: args when is_nat_kopt kopt ->
+       let typ_arg, ncs = subst_args kopts args in
+       typ_arg_subst (kopt_kid kopt) (arg_nexp arg) typ_arg,
+       List.map (constraint_subst (kopt_kid kopt) (arg_nexp arg)) ncs
+    | kopt :: kopts, A_aux (A_typ arg, _) :: args when is_typ_kopt kopt ->
+       let typ_arg, ncs = subst_args kopts args in
+       typ_arg_subst (kopt_kid kopt) (arg_typ arg) typ_arg, ncs
+    | kopt :: kopts, A_aux (A_order arg, _) :: args when is_order_kopt kopt ->
+       let typ_arg, ncs = subst_args kopts args in
+       typ_arg_subst (kopt_kid kopt) (arg_order arg) typ_arg, ncs
+    | kopt :: kopts, A_aux (A_bool arg, _) :: args when is_bool_kopt kopt ->
+       let typ_arg, ncs = subst_args kopts args in
+       typ_arg_subst (kopt_kid kopt) (arg_bool arg) typ_arg, ncs
+    | [], [] -> typ_arg, ncs
+    | _, A_aux (_, l) :: _ -> typ_error l "Synonym applied to bad arguments"
     | _, _ -> typ_error Parse_ast.Unknown "Synonym applied to bad arguments"
   in
   fun env args ->
-    let typ, ncs = subst_args kopts args in
+    let typ_arg, ncs = subst_args kopts args in
     if List.for_all (prove env) ncs
-    then typ
+    then typ_arg
     else typ_error Parse_ast.Unknown ("Could not prove constraints " ^ string_of_list ", " string_of_n_constraint ncs
-                                      ^ " in type synonym " ^ string_of_typ typ
+                                      ^ " in type synonym " ^ string_of_typ_arg typ_arg
                                       ^ " with " ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env))
 
 let check_kinddef env (KD_aux (kdef, (l, _))) =
-  let kd_err () = raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented kind def") in
+  let kd_err () = raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented kind def") in
   match kdef with
-  | KD_nabbrev ((K_aux(K_kind([BK_aux (BK_int, _)]),_) as kind), id, nmscm, nexp) ->
+  | KD_nabbrev (K_aux (K_int, _) as kind, id, nmscm, nexp) ->
      [DEF_kind (KD_aux (KD_nabbrev (kind, id, nmscm, nexp), (l, None)))],
      Env.add_num_def id nexp env
   | _ -> kd_err ()
 
 let rec check_typedef : 'a. Env.t -> 'a type_def -> (tannot def) list * Env.t =
   fun env (TD_aux (tdef, (l, _))) ->
-  let td_err () = raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Typedef") in
+  let td_err () = raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Typedef") in
   match tdef with
-  | TD_abbrev (id, nmscm, (TypSchm_aux (TypSchm_ts (typq, typ), _))) ->
-     [DEF_type (TD_aux (tdef, (l, None)))], Env.add_typ_synonym id (mk_synonym typq typ) env
+  | TD_abbrev (id, typq, typ_arg) ->
+     [DEF_type (TD_aux (tdef, (l, None)))], Env.add_typ_synonym id (mk_synonym typq typ_arg) env
   | TD_record (id, nmscm, typq, fields, _) ->
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_record id typq fields env
   | TD_variant (id, nmscm, typq, arms, _) ->
@@ -4543,9 +4358,9 @@ let rec check_typedef : 'a. Env.t -> 'a type_def -> (tannot def) list * Env.t =
      begin
        match typ with
        (* The type of a bitfield must be a constant-width bitvector *)
-       | Typ_aux (Typ_app (v, [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant size, _)), _);
-                               Typ_arg_aux (Typ_arg_order order, _);
-                               Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id b, _)), _)]), _)
+       | Typ_aux (Typ_app (v, [A_aux (A_nexp (Nexp_aux (Nexp_constant size, _)), _);
+                               A_aux (A_order order, _);
+                               A_aux (A_typ (Typ_aux (Typ_id b, _)), _)]), _)
             when string_of_id v = "vector" && string_of_id b = "bit" ->
           let size = Big_int.to_int size in
           let (Defs defs), env = check env (Bitfield.macro id size order ranges) in
@@ -4554,19 +4369,37 @@ let rec check_typedef : 'a. Env.t -> 'a type_def -> (tannot def) list * Env.t =
           typ_error l "Bad bitfield type"
      end
 
+and check_scattered : 'a. Env.t -> 'a scattered_def -> (tannot def) list * Env.t =
+  fun env (SD_aux (sdef, (l, _))) ->
+  match sdef with
+  | SD_function _ | SD_end _ | SD_mapping _ -> [], env
+  | SD_variant (id, namescm, typq) ->
+     [DEF_scattered (SD_aux (SD_variant (id, namescm, typq), (l, None)))], Env.add_scattered_variant id typq env
+  | SD_unioncl (id, tu) ->
+     [DEF_scattered (SD_aux (SD_unioncl (id, tu), (l, None)))],
+     let env = Env.add_variant_clause id tu env in
+     let typq, _ = Env.get_variant id env in
+     check_type_union env id typq tu
+  | SD_funcl (FCL_aux (FCL_Funcl (id, _), (l, _)) as funcl) ->
+     let typq, typ = Env.get_val_spec id env in
+     let funcl_env = add_typquant l typq env in
+     let funcl = check_funcl funcl_env funcl typ in
+     [DEF_scattered (SD_aux (SD_funcl funcl, (l, None)))], env
+  | SD_mapcl (id, mapcl) ->
+     let typq, typ = Env.get_val_spec id env in
+     let mapcl_env = add_typquant l typq env in
+     let mapcl = check_mapcl mapcl_env mapcl typ in
+     [DEF_scattered (SD_aux (SD_mapcl (id, mapcl), (l, None)))], env
+
 and check_def : 'a. Env.t -> 'a def -> (tannot def) list * Env.t =
   fun env def ->
-  let cd_err () = raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Case") in
+  let cd_err () = raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Case") in
   match def with
   | DEF_kind kdef -> check_kinddef env kdef
   | DEF_type tdef -> check_typedef env tdef
   | DEF_fixity (prec, n, op) -> [DEF_fixity (prec, n, op)], env
   | DEF_fundef fdef -> check_fundef env fdef
   | DEF_mapdef mdef -> check_mapdef env mdef
-  | DEF_constraint (id, kids, nc) when !opt_constraint_synonyms ->
-     [], Env.add_constraint_synonym id kids nc env
-  | DEF_constraint (id, _, _) ->
-     typ_error (id_loc id) "Use -Xconstraint_synonyms to enable constraint synonyms"
   | DEF_internal_mutrec fdefs ->
      let defs = List.concat (List.map (fun fdef -> fst (check_fundef env fdef)) fdefs) in
      let split_fundef (defs, fdefs) def = match def with
@@ -4585,9 +4418,10 @@ and check_def : 'a. Env.t -> 'a def -> (tannot def) list * Env.t =
      let checked_exp = crule check_exp env (strip_exp exp) typ in
      let env = Env.add_register id no_effect (mk_effect [BE_config]) typ env in
      [DEF_reg_dec (DEC_aux (DEC_config (id, typ, checked_exp), (l, Some ((env, typ, no_effect), Some typ))))], env
+  | DEF_pragma (pragma, arg, l) -> [DEF_pragma (pragma, arg, l)], env
   | DEF_reg_dec (DEC_aux (DEC_alias (id, aspec), (l, annot))) -> cd_err ()
   | DEF_reg_dec (DEC_aux (DEC_typ_alias (typ, id, aspec), (l, tannot))) -> cd_err ()
-  | DEF_scattered _ -> raise (Reporting_basic.err_unreachable Parse_ast.Unknown __POS__ "Scattered given to type checker")
+  | DEF_scattered sdef -> check_scattered env sdef
 
 and check : 'a. Env.t -> 'a defs -> tannot defs * Env.t =
   fun env (Defs defs) ->
@@ -4610,13 +4444,13 @@ let initial_env =
 
   |> Env.add_extern (mk_id "size_itself_int") [("_", "size_itself_int")]
   |> Env.add_val_spec (mk_id "size_itself_int")
-      (TypQ_aux (TypQ_tq [QI_aux (QI_id (KOpt_aux (KOpt_none (mk_kid "n"),Parse_ast.Unknown)),
+      (TypQ_aux (TypQ_tq [QI_aux (QI_id (mk_kopt K_int (mk_kid "n")),
                                   Parse_ast.Unknown)],Parse_ast.Unknown),
-       function_typ [app_typ (mk_id "itself") [mk_typ_arg (Typ_arg_nexp (nvar (mk_kid "n")))]]
+       function_typ [app_typ (mk_id "itself") [mk_typ_arg (A_nexp (nvar (mk_kid "n")))]]
          (atom_typ (nvar (mk_kid "n"))) no_effect)
   |> Env.add_extern (mk_id "make_the_value") [("_", "make_the_value")]
   |> Env.add_val_spec (mk_id "make_the_value")
-      (TypQ_aux (TypQ_tq [QI_aux (QI_id (KOpt_aux (KOpt_none (mk_kid "n"),Parse_ast.Unknown)),
+      (TypQ_aux (TypQ_tq [QI_aux (QI_id (mk_kopt K_int (mk_kid "n")),
                                   Parse_ast.Unknown)],Parse_ast.Unknown),
        function_typ [atom_typ (nvar (mk_kid "n"))]
-         (app_typ (mk_id "itself") [mk_typ_arg (Typ_arg_nexp (nvar (mk_kid "n")))]) no_effect)
+         (app_typ (mk_id "itself") [mk_typ_arg (A_nexp (nvar (mk_kid "n")))]) no_effect)
diff --git a/src/type_check.mli b/src/type_check.mli
index 93f5302a..501a0d7d 100644
--- a/src/type_check.mli
+++ b/src/type_check.mli
@@ -67,23 +67,24 @@ val opt_no_effects : bool ref
    assignments in l-expressions. *)
 val opt_no_lexp_bounds_check : bool ref
 
-(** [opt_constraint_synonyms] allows constraint synonyms as toplevel
-   definitions *)
-val opt_constraint_synonyms : bool ref
+(** opt_expand_valspec expands typedefs in valspecs during type check.
+   We prefer not to do it for latex output but it is otherwise a good idea. *)
+val opt_expand_valspec : bool ref
 
 (** {2 Type errors} *)
 
 type type_error =
   | Err_no_casts of unit exp * typ * typ * type_error * type_error list
   | Err_no_overloading of id * (id * type_error) list
-  | Err_unresolved_quants of id * quant_item list
+  | Err_unresolved_quants of id * quant_item list * (mut * typ) Bindings.t * n_constraint list
   | Err_subtype of typ * typ * n_constraint list * Ast.l KBindings.t
   | Err_no_num_ident of id
   | Err_other of string
+  | Err_because of type_error * type_error
 
 exception Type_error of l * type_error;;
 
-val typ_debug : string Lazy.t -> unit
+val typ_debug : ?level:int -> string Lazy.t -> unit
 val typ_print : string Lazy.t -> unit
 
 (** {2 Environments} *)
@@ -95,7 +96,7 @@ module Env : sig
   type t
 
   (** Note: Most get_ functions assume the identifiers exist, and throw
-     type errors if it doesn't. *)
+     type errors if they don't. *)
 
   (** Get the quantifier and type for a function identifier, freshening
       type variables. *)
@@ -127,13 +128,13 @@ module Env : sig
 
   val add_constraint : n_constraint -> t -> t
 
-  val get_typ_var : kid -> t -> base_kind_aux
+  val get_typ_var : kid -> t -> kind_aux
 
-  val get_typ_vars : t -> base_kind_aux KBindings.t
+  val get_typ_vars : t -> kind_aux KBindings.t
 
   val get_typ_var_locs : t -> Ast.l KBindings.t
 
-  val add_typ_var : Ast.l -> kid -> base_kind_aux -> t -> t
+  val add_typ_var : Ast.l -> kinded_id -> t -> t
 
   val is_record : id -> t -> bool
 
@@ -149,7 +150,7 @@ module Env : sig
      won't throw any exceptions. *)
   val get_ret_typ : t -> typ option
 
-  val get_typ_synonym : id -> t -> (t -> typ_arg list -> typ)
+  val get_typ_synonym : id -> t -> (t -> typ_arg list -> typ_arg)
 
   val get_overloads : id -> t -> id list
 
@@ -207,9 +208,14 @@ end
    an environment *)
 val add_typquant : Ast.l -> typquant -> Env.t -> Env.t
 
-val destruct_exist : Env.t -> typ -> (kid list * n_constraint * typ) option
+(** Safely destructure an existential type. Returns None if the type
+   is not existential. This function will pick a fresh name for the
+   existential to ensure that no name-clashes occur. The "plain"
+   version does not treat numeric types as existentials. *)
+val destruct_exist_plain : typ -> (kinded_id list * n_constraint * typ) option
+val destruct_exist : typ -> (kinded_id list * n_constraint * typ) option
 
-val add_existential : Ast.l -> kid list -> n_constraint -> Env.t -> Env.t
+val add_existential : Ast.l -> kinded_id list -> n_constraint -> Env.t -> Env.t
 
 (** When the typechecker creates new type variables it gives them
    fresh names of the form 'fvXXX#name, where XXX is a number (not
@@ -299,6 +305,8 @@ val prove : Env.t -> n_constraint -> bool
 
 val solve : Env.t -> nexp -> Big_int.num option
 
+val canonicalize : Env.t -> typ -> typ
+
 val subtype_check : Env.t -> typ -> typ -> bool
 
 val bind_pat : Env.t -> unit pat -> typ -> tannot pat * Env.t * unit Ast.exp list
@@ -321,9 +329,8 @@ val env_of_annot : Ast.l * tannot -> Env.t
 val typ_of : tannot exp -> typ
 val typ_of_annot : Ast.l * tannot -> typ
 
-
-val pat_typ_of : tannot pat -> typ
-val pat_env_of : tannot pat -> Env.t
+val typ_of_pat : tannot pat -> typ
+val env_of_pat : tannot pat -> Env.t
 
 val typ_of_pexp : tannot pexp -> typ
 val env_of_pexp : tannot pexp -> Env.t
@@ -347,44 +354,33 @@ val expected_typ_of : Ast.l * tannot -> typ option
 
 val destruct_atom_nexp : Env.t -> typ -> nexp option
 
-(** Safely destructure an existential type. Returns None if the type
-   is not existential. This function will pick a fresh name for the
-   existential to ensure that no name-clashes occur. *)
-val destruct_exist : Env.t -> typ -> (kid list * n_constraint * typ) option
-
 val destruct_range : Env.t -> typ -> (kid list * n_constraint * nexp * nexp) option
 
-val destruct_numeric : Env.t -> typ -> (kid list * n_constraint * nexp) option
+val destruct_numeric : typ -> (kid list * n_constraint * nexp) option
 
 val destruct_vector : Env.t -> typ -> (nexp * order * typ) option
 
-type uvar =
-  | U_nexp of nexp
-  | U_order of order
-  | U_typ of typ
-
-val string_of_uvar : uvar -> string
-
-val subst_unifiers : uvar KBindings.t -> typ -> typ
-
-val typ_subst_nexp : kid -> nexp_aux -> typ -> typ
-val typ_subst_typ : kid -> typ_aux -> typ -> typ
-val typ_subst_order : kid -> order_aux -> typ -> typ
-val typ_subst_kid : kid -> kid -> typ -> typ
+val subst_unifiers : typ_arg KBindings.t -> typ -> typ
 
-val unify : l -> Env.t -> typ -> typ -> uvar KBindings.t * kid list * n_constraint option
+(** [unify l env goals typ1 typ2] returns set of typ_arg bindings such
+   that substituting those bindings using every type variable in goals
+   will make typ1 and typ2 equal. Will throw a Unification_error if
+   typ1 and typ2 cannot unification (although unification in Sail is
+   not complete). Will throw a type error if any goals appear in in
+   typ2 (occurs check). *)
+val unify : l -> Env.t -> KidSet.t -> typ -> typ -> typ_arg KBindings.t
 
 val alpha_equivalent : Env.t -> typ -> typ -> bool
 
 (** Throws Invalid_argument if the argument is not a E_app expression *)
-val instantiation_of : tannot exp -> uvar KBindings.t
+val instantiation_of : tannot exp -> typ_arg KBindings.t
 
 (** Doesn't use the type of the expression when calculating instantiations.
     May fail if the arguments aren't sufficient to calculate all unifiers. *)
-val instantiation_of_without_type : tannot exp -> uvar KBindings.t
+val instantiation_of_without_type : tannot exp -> typ_arg KBindings.t
 
 (* Type variable instantiations that inference will extract from constraints *)
-val instantiate_simple_equations : quant_item list -> uvar KBindings.t
+val instantiate_simple_equations : quant_item list -> typ_arg KBindings.t
 
 val propagate_exp_effect : tannot exp -> tannot exp
 
@@ -413,7 +409,7 @@ Some invariants that will hold of a fully checked AST are:
    for them to have type annotations.
 
    check throws type_errors rather than Sail generic errors from
-   Reporting_basic. For a function that uses generic errors, use
+   Reporting. For a function that uses generic errors, use
    Type_error.check *)
 val check : Env.t -> 'a defs -> tannot defs * Env.t
 
diff --git a/src/type_error.ml b/src/type_error.ml
index 78db65bc..9144e993 100644
--- a/src/type_error.ml
+++ b/src/type_error.ml
@@ -58,35 +58,6 @@ let bullet f xs =
   group (separate_map hardline (fun x -> string "* " ^^ nest 2 (f x)) xs)
 
 let pp_nexp, pp_n_constraint =
-  let rec string_of_nexp = function
-    | Nexp_aux (nexp, _) -> string_of_nexp_aux nexp
-  and string_of_nexp_aux = function
-    | Nexp_id id -> string_of_id id
-    | Nexp_var kid -> string_of_kid kid
-    | Nexp_constant c -> Big_int.to_string c
-    | Nexp_times (n1, n2) -> "(" ^ string_of_nexp n1 ^ " * " ^ string_of_nexp n2 ^ ")"
-    | Nexp_sum (n1, n2) -> "(" ^ string_of_nexp n1 ^ " + " ^ string_of_nexp n2 ^ ")"
-    | Nexp_minus (n1, n2) -> "(" ^ string_of_nexp n1 ^ " - " ^ string_of_nexp n2 ^ ")"
-    | Nexp_app (id, nexps) -> string_of_id id ^ "(" ^ string_of_list ", " string_of_nexp nexps ^ ")"
-    | Nexp_exp n -> "2 ^ " ^ string_of_nexp n
-    | Nexp_neg n -> "- " ^ string_of_nexp n
-  in
-
-  let string_of_n_constraint = function
-    | NC_aux (NC_equal (n1, n2), _) -> string_of_nexp n1 ^ " = " ^ string_of_nexp n2
-    | NC_aux (NC_not_equal (n1, n2), _) -> string_of_nexp n1 ^ " != " ^ string_of_nexp n2
-    | NC_aux (NC_bounded_ge (n1, n2), _) -> string_of_nexp n1 ^ " >= " ^ string_of_nexp n2
-    | NC_aux (NC_bounded_le (n1, n2), _) -> string_of_nexp n1 ^ " <= " ^ string_of_nexp n2
-    | NC_aux (NC_or (nc1, nc2), _) ->
-       "(" ^ string_of_n_constraint nc1 ^ " | " ^ string_of_n_constraint nc2 ^ ")"
-    | NC_aux (NC_and (nc1, nc2), _) ->
-       "(" ^ string_of_n_constraint nc1 ^ " & " ^ string_of_n_constraint nc2 ^ ")"
-    | NC_aux (NC_set (kid, ns), _) ->
-       string_of_kid kid ^ " in {" ^ string_of_list ", " Big_int.to_string ns ^ "}"
-    | NC_aux (NC_true, _) -> "true"
-    | NC_aux (NC_false, _) -> "false"
-  in
-
   let pp_nexp' nexp =
     string (string_of_nexp nexp)
   in
@@ -94,39 +65,181 @@ let pp_nexp, pp_n_constraint =
   let pp_n_constraint' nc =
     string (string_of_n_constraint nc)
   in
-
   pp_nexp', pp_n_constraint'
 
+let rec nexp_subst sv subst (Nexp_aux (nexp, l)) = Nexp_aux (nexp_subst_aux sv subst nexp, l)
+and nexp_subst_aux sv subst = function
+  | Nexp_id v -> Nexp_id v
+  | Nexp_var kid -> if Kid.compare kid sv = 0 then subst else Nexp_var kid
+  | Nexp_constant c -> Nexp_constant c
+  | Nexp_times (nexp1, nexp2) -> Nexp_times (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_sum (nexp1, nexp2) -> Nexp_sum (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_minus (nexp1, nexp2) -> Nexp_minus (nexp_subst sv subst nexp1, nexp_subst sv subst nexp2)
+  | Nexp_app (id, nexps) -> Nexp_app (id, List.map (nexp_subst sv subst) nexps)
+  | Nexp_exp nexp -> Nexp_exp (nexp_subst sv subst nexp)
+  | Nexp_neg nexp -> Nexp_neg (nexp_subst sv subst nexp)
+
+let rec nexp_set_to_or l subst = function
+  | [] -> typ_error l "Cannot substitute into empty nexp set"
+  | [int] -> NC_equal (subst, nconstant int)
+  | (int :: ints) -> NC_or (mk_nc (NC_equal (subst, nconstant int)), mk_nc (nexp_set_to_or l subst ints))
+
+let rec nc_subst_nexp sv subst (NC_aux (nc, l)) = NC_aux (nc_subst_nexp_aux l sv subst nc, l)
+and nc_subst_nexp_aux l sv subst = function
+  | NC_equal (n1, n2) -> NC_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_bounded_ge (n1, n2) -> NC_bounded_ge (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_bounded_le (n1, n2) -> NC_bounded_le (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_not_equal (n1, n2) -> NC_not_equal (nexp_subst sv subst n1, nexp_subst sv subst n2)
+  | NC_set (kid, ints) as set_nc ->
+     if Kid.compare kid sv = 0
+     then nexp_set_to_or l (mk_nexp subst) ints
+     else set_nc
+  | NC_or (nc1, nc2) -> NC_or (nc_subst_nexp sv subst nc1, nc_subst_nexp sv subst nc2)
+  | NC_and (nc1, nc2) -> NC_and (nc_subst_nexp sv subst nc1, nc_subst_nexp sv subst nc2)
+  | NC_false -> NC_false
+  | NC_true -> NC_true
+
+type suggestion =
+  | Suggest_add_constraint of n_constraint
+  | Suggest_none
+
+(* Temporary hack while I work on using these suggestions in asl_parser *)
+let rec analyze_unresolved_quant2 locals ncs = function
+  | QI_aux (QI_const nc, _) ->
+     let gen_kids = List.filter is_kid_generated (KidSet.elements (tyvars_of_constraint nc)) in
+     if gen_kids = [] then
+       Suggest_add_constraint nc
+     else
+       (* If there are generated kind-identifiers in the constraint,
+          we don't want to make a suggestion based on them, so try to
+          look for generated kid free nexps in the set of constraints
+          that are equal to the generated identifier. This often
+          occurs due to how the type-checker introduces new type
+          variables. *)
+       let is_subst v = function
+         | NC_aux (NC_equal (Nexp_aux (Nexp_var v', _), nexp), _)
+              when Kid.compare v v' = 0 && not (KidSet.exists is_kid_generated (tyvars_of_nexp nexp)) ->
+            [(v, nexp)]
+         | NC_aux (NC_equal (nexp, Nexp_aux (Nexp_var v', _)), _)
+              when Kid.compare v v' = 0 && not (KidSet.exists is_kid_generated (tyvars_of_nexp nexp)) ->
+            [(v, nexp)]
+         | _ -> []
+       in
+       let substs = List.concat (List.map (fun v -> List.concat (List.map (fun nc -> is_subst v nc) ncs)) gen_kids) in
+       let nc = List.fold_left (fun nc (v, nexp) -> nc_subst_nexp v (unaux_nexp nexp) nc) nc substs in
+       if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
+         Suggest_add_constraint nc
+       else
+         (* If we have a really anonymous type-variable, try to find a
+            regular variable that corresponds to it. *)
+         let is_linked v = function
+           | (id, (Immutable, (Typ_aux (Typ_app (ty_id, [A_aux (A_nexp (Nexp_aux (Nexp_var v', _)), _)]), _) as typ)))
+                when Id.compare ty_id (mk_id "atom") = 0 && Kid.compare v v' = 0 ->
+              [(v, nid id, typ)]
+           | (id, (mut, typ)) ->
+              []
+         in
+         let substs = List.concat (List.map (fun v -> List.concat (List.map (fun nc -> is_linked v nc) (Bindings.bindings locals))) gen_kids) in
+         let nc = List.fold_left (fun nc (v, nexp, _) -> nc_subst_nexp v (unaux_nexp nexp) nc) nc substs in
+         if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
+           Suggest_none
+         else
+           Suggest_none
+
+  | QI_aux (QI_id kopt, _) ->
+     Suggest_none
+
+let rec analyze_unresolved_quant locals ncs = function
+  | QI_aux (QI_const nc, _) ->
+     let gen_kids = List.filter is_kid_generated (KidSet.elements (tyvars_of_constraint nc)) in
+     if gen_kids = [] then
+       string ("Try adding the constraint: " ^ string_of_n_constraint nc)
+     else
+       (* If there are generated kind-identifiers in the constraint,
+          we don't want to make a suggestion based on them, so try to
+          look for generated kid free nexps in the set of constraints
+          that are equal to the generated identifier. This often
+          occurs due to how the type-checker introduces new type
+          variables. *)
+       let is_subst v = function
+         | NC_aux (NC_equal (Nexp_aux (Nexp_var v', _), nexp), _)
+              when Kid.compare v v' = 0 && not (KidSet.exists is_kid_generated (tyvars_of_nexp nexp)) ->
+            [(v, nexp)]
+         | NC_aux (NC_equal (nexp, Nexp_aux (Nexp_var v', _)), _)
+              when Kid.compare v v' = 0 && not (KidSet.exists is_kid_generated (tyvars_of_nexp nexp)) ->
+            [(v, nexp)]
+         | _ -> []
+       in
+       let substs = List.concat (List.map (fun v -> List.concat (List.map (fun nc -> is_subst v nc) ncs)) gen_kids) in
+       let nc = List.fold_left (fun nc (v, nexp) -> nc_subst_nexp v (unaux_nexp nexp) nc) nc substs in
+       if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
+         string ("Try adding the constraint " ^ string_of_n_constraint nc)
+       else
+         (* If we have a really anonymous type-variable, try to find a
+            regular variable that corresponds to it. *)
+         let is_linked v = function
+           | (id, (Immutable, (Typ_aux (Typ_app (ty_id, [A_aux (A_nexp (Nexp_aux (Nexp_var v', _)), _)]), _) as typ)))
+                when Id.compare ty_id (mk_id "atom") = 0 && Kid.compare v v' = 0 ->
+              [(v, nid id, typ)]
+           | (id, (mut, typ)) ->
+              []
+         in
+         let substs = List.concat (List.map (fun v -> List.concat (List.map (fun nc -> is_linked v nc) (Bindings.bindings locals))) gen_kids) in
+         (string "Try adding named type variables for"
+          ^//^ string (Util.string_of_list ", " (fun (_, nexp, typ) -> string_of_nexp nexp ^ " : " ^ string_of_typ typ) substs))
+         ^^ twice hardline ^^
+         let nc = List.fold_left (fun nc (v, nexp, _) -> nc_subst_nexp v (unaux_nexp nexp) nc) nc substs in
+         if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
+           string ("The property " ^ string_of_n_constraint nc ^ " must hold")
+         else
+           empty
+
+  | QI_aux (QI_id kopt, _) ->
+     empty
+
 let rec pp_type_error = function
-  | Err_no_casts (exp, typ_from, typ_to, trigger, _) ->
+  | Err_no_casts (exp, typ_from, typ_to, trigger, reasons) ->
      let coercion =
        group (string "Tried performing type coercion from" ^/^ Pretty_print_sail.doc_typ typ_from
               ^/^ string "to" ^/^ Pretty_print_sail.doc_typ typ_to
               ^/^ string "on" ^/^ Pretty_print_sail.doc_exp exp)
      in
-     coercion ^^ hardline ^^ (string "Failed because" ^/^ pp_type_error trigger)
+     coercion ^^ hardline
+     ^^ (string "Coercion failed because:" ^//^ pp_type_error trigger)
+     ^^ if not (reasons = []) then
+          hardline
+          ^^ (string "Possible reasons:" ^//^ separate_map hardline pp_type_error reasons)
+        else
+          empty
 
   | Err_no_overloading (id, errs) ->
      string ("No overloadings for " ^ string_of_id id ^ ", tried:") ^//^
        group (separate_map hardline (fun (id, err) -> string (string_of_id id) ^^ colon ^//^ pp_type_error err) errs)
 
   | Err_subtype (typ1, typ2, constrs, locs) ->
-     enclose (string (Util.termcode 1)) (string (Util.termcode 21))
-             (separate space [ string (string_of_typ typ1);
-                               string "is not a subtype of";
-                               string (string_of_typ typ2) ])
+     (separate space [ string (string_of_typ typ1);
+                       string "is not a subtype of";
+                       string (string_of_typ typ2) ])
      ^/^ string "in context"
      ^/^ bullet pp_n_constraint constrs
      ^/^ string "where"
-     ^/^ bullet (fun (kid, l) -> string (string_of_kid kid ^ " bound at " ^ Reporting_basic.loc_to_string l ^ "\n")) (KBindings.bindings locs)
+     ^/^ bullet (fun (kid, l) -> string (string_of_kid kid ^ " bound at " ^ Reporting.loc_to_string l ^ "\n")) (KBindings.bindings locs)
 
   | Err_no_num_ident id ->
      string "No num identifier" ^^ space ^^ string (string_of_id id)
 
-  | Err_unresolved_quants (id, quants) ->
-     string "Could not resolve quantifiers for" ^^ space ^^ string (string_of_id id)
-     ^//^ group (separate_map hardline (fun quant -> string (string_of_quant_item quant)) quants)
+  | Err_unresolved_quants (id, quants, locals, ncs) ->
+     (string "Could not resolve quantifiers for" ^^ space ^^ string (string_of_id id)
+      ^//^ group (separate_map hardline (fun quant -> string (string_of_quant_item quant)) quants))
+     ^^ twice hardline
+     ^^ group (separate_map hardline (analyze_unresolved_quant locals ncs) quants)
 
+  (* We only got err, because of previous error, err' *)
+  | Err_because (err, err') ->
+     pp_type_error err
+     ^^ hardline ^^ string "This error occured because of a previous error:"
+     ^//^ pp_type_error err'
+    
   | Err_other str -> string str
 
 let rec string_of_type_error err =
@@ -135,7 +248,25 @@ let rec string_of_type_error err =
   ToBuffer.pretty 1. 400 b (pp_type_error err);
   "\n" ^ Buffer.contents b
 
+let rec collapse_errors = function
+  | (Err_no_overloading (_, (err :: errs)) as no_collapse) ->
+      let err = collapse_errors (snd err) in
+      let errs = List.map (fun (_, err) -> collapse_errors err) errs in
+      let fold_equal msg err =
+        match msg, err with
+        | Some msg, Err_no_overloading _ -> Some msg
+        | Some msg, Err_other _ -> Some msg
+        | Some msg, Err_no_casts _ -> Some msg
+        | Some msg, err when msg = string_of_type_error err -> Some msg
+        | _, _ -> None
+      in
+      begin match List.fold_left fold_equal (Some (string_of_type_error err)) errs with
+      | Some _ -> err
+      | None -> no_collapse
+      end
+  | err -> err
+
 let check : 'a. Env.t -> 'a defs -> tannot defs * Env.t =
   fun env defs ->
   try Type_check.check env defs with
-  | Type_error (l, err) -> raise (Reporting_basic.err_typ l (string_of_type_error err))
+  | Type_error (l, err) -> raise (Reporting.err_typ l (string_of_type_error err))
diff --git a/src/util.ml b/src/util.ml
index e0366fe7..5e5654d1 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -232,6 +232,15 @@ let rec option_these = function
   | None :: xs -> option_these xs
   | [] -> []
 
+let rec option_all = function
+  | [] -> Some []
+  | None :: _ -> None
+  | Some x :: xs ->
+     begin match option_all xs with
+     | None -> None
+     | Some xs -> Some (x :: xs)
+     end
+
 let changed2 f g x h y =
   match (g x, h y) with
     | (None,None) -> None
@@ -439,6 +448,14 @@ let zencode_string str = "z" ^ List.fold_left (fun s1 s2 -> s1 ^ s2) "" (List.ma
 
 let zencode_upper_string str = "Z" ^ List.fold_left (fun s1 s2 -> s1 ^ s2) "" (List.map zchar (string_to_list str))
 
+(** Encode string for use as a filename. We can't use zencode directly
+   because some operating systems make the mistake of being
+   case-insensitive. *)
+let file_encode_string str =
+  let zstr = zencode_string str in
+  let md5 = Digest.to_hex (Digest.string zstr) in
+  String.lowercase_ascii zstr ^ String.lowercase_ascii md5
+
 let warn str =
   if !opt_warnings then
     prerr_endline (("Warning" |> yellow |> clear) ^ ": " ^ str)
@@ -446,3 +463,5 @@ let warn str =
 
 let log_line str line msg =
   "\n[" ^ (str ^ ":" ^ string_of_int line |> blue |> clear) ^ "] " ^ msg
+
+let header str n = "\n" ^ str ^ "\n" ^ String.make (String.length str - 9 * n) '='
diff --git a/src/util.mli b/src/util.mli
index eb4b4bd2..fd0242a3 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -57,8 +57,8 @@ val opt_colors : bool ref
 val butlast : 'a list -> 'a list
 
 (** Mixed useful things *)
-module Duplicate(S : Set.S) : sig 
-  type dups = 
+module Duplicate(S : Set.S) : sig
+  type dups =
     | No_dups of S.t
     | Has_dups of S.elt
   val duplicates : S.elt list -> dups
@@ -105,6 +105,11 @@ val option_get_exn : exn -> 'a option -> 'a
     wrapped in [Some]. *)
 val option_these : 'a option list -> 'a list
 
+(** [option_all xs] extracts the elements of the list [xs] if all of
+   them are wrapped in Some. If any are None then the result is None is
+   None. [option_all []] is [Some []] *)
+val option_all : 'a option list -> 'a list option
+
 (** [changed2 f g x h y] applies [g] to [x] and [h] to [y].
     If both function applications return [None], then [None] is
     returned. Otherwise [f] is applied to the results. For this
@@ -254,4 +259,7 @@ val warn : string -> unit
 val zencode_string : string -> string
 val zencode_upper_string : string -> string
 
+val file_encode_string : string -> string
+
 val log_line : string -> int -> string -> string
+val header : string -> int -> string
diff --git a/src/value.ml b/src/value.ml
index 8e920377..261b0f4e 100644
--- a/src/value.ml
+++ b/src/value.ml
@@ -86,6 +86,12 @@ type value =
   | V_ref of string
   | V_ctor of string * value list
   | V_record of value StringMap.t
+  (* When constant folding we disable reading registers, so a register
+     read will return a V_attempted_read value. If we try to do
+     anything with this value, we'll get an exception - but if all we
+     do is return it then we can replace the expression we are folding
+     with a direct register read. *)
+  | V_attempted_read of string
 
 let rec eq_value v1 v2 =
   match v1, v2 with
@@ -394,10 +400,11 @@ let rec string_of_value = function
   | V_unit -> "()"
   | V_string str -> "\"" ^ str ^ "\""
   | V_ref str -> "ref " ^ str
-  | V_real r -> "REAL" (* No Rational.to_string *)
+  | V_real r -> Sail_lib.string_of_real r
   | V_ctor (str, vals) -> str ^ "(" ^ Util.string_of_list ", " string_of_value vals ^ ")"
   | V_record record ->
      "{" ^ Util.string_of_list ", " (fun (field, v) -> field ^ "=" ^ string_of_value v) (StringMap.bindings record) ^ "}"
+  | V_attempted_read _ -> assert false
 
 let value_sign_extend = function
   | [v1; v2] -> mk_vector (Sail_lib.sign_extend (coerce_bv v1, coerce_int v2))
@@ -506,6 +513,18 @@ let value_to_real = function
   | [v] -> V_real (Sail_lib.to_real (coerce_int v))
   | _ -> failwith "value to_real"
 
+let value_print_real = function
+  | [v1; v2] -> output_endline (coerce_string v1 ^ string_of_value v2); V_unit
+  | _ -> failwith "value print_real"
+
+let value_random_real = function
+  | [_] -> V_real (Sail_lib.random_real ())
+  | _ -> failwith "value random_real"
+
+let value_sqrt_real = function
+  | [v] -> V_real (Sail_lib.sqrt_real (coerce_real v))
+  | _ -> failwith "value sqrt_real"
+
 let value_quotient_real = function
   | [v1; v2] -> V_real (Sail_lib.quotient_real (coerce_real v1, coerce_real v2))
   | _ -> failwith "value quotient_real"
@@ -526,6 +545,26 @@ let value_rem_round_zero = function
   | [v1; v2] -> V_int (Sail_lib.rem_round_zero (coerce_int v1, coerce_int v2))
   | _ -> failwith "value rem_round_zero"
 
+let value_add_real = function
+  | [v1; v2] -> V_real (Sail_lib.add_real (coerce_real v1, coerce_real v2))
+  | _ -> failwith "value add_real"
+
+let value_sub_real = function
+  | [v1; v2] -> V_real (Sail_lib.sub_real (coerce_real v1, coerce_real v2))
+  | _ -> failwith "value sub_real"
+
+let value_mult_real = function
+  | [v1; v2] -> V_real (Sail_lib.mult_real (coerce_real v1, coerce_real v2))
+  | _ -> failwith "value mult_real"
+
+let value_div_real = function
+  | [v1; v2] -> V_real (Sail_lib.div_real (coerce_real v1, coerce_real v2))
+  | _ -> failwith "value div_real"
+
+let value_abs_real = function
+  | [v] -> V_real (Sail_lib.abs_real (coerce_real v))
+  | _ -> failwith "value abs_real"
+
 let value_eq_real = function
   | [v1; v2] -> V_bool (Sail_lib.eq_real (coerce_real v1, coerce_real v2))
   | _ -> failwith "value eq_real"
@@ -644,13 +683,21 @@ let primops =
       ("eq_real", value_eq_real);
       ("lt_real", value_lt_real);
       ("gt_real", value_gt_real);
-      ("lteq_real", value_lt_real);
-      ("gteq_real", value_gt_real);
+      ("lteq_real", value_lteq_real);
+      ("gteq_real", value_gteq_real);
+      ("add_real", value_add_real);
+      ("sub_real", value_sub_real);
+      ("mult_real", value_mult_real);
       ("round_up", value_round_up);
       ("round_down", value_round_down);
       ("quot_round_zero", value_quot_round_zero);
       ("rem_round_zero", value_rem_round_zero);
       ("quotient_real", value_quotient_real);
+      ("abs_real", value_abs_real);
+      ("div_real", value_div_real);
+      ("sqrt_real", value_sqrt_real);
+      ("print_real", value_print_real);
+      ("random_real", value_random_real);
       ("undefined_unit", fun _ -> V_unit);
       ("undefined_bit", fun _ -> V_bit Sail_lib.B0);
       ("undefined_int", fun _ -> V_int Big_int.zero);