Merge branch 'sail2' into rmem_interpreter

61 files changed, 3572 insertions, 2663 deletions

diff --git a/src/Makefile b/src/Makefile
index f4e0c967..e29a1ef0 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -62,16 +62,14 @@ endif
 endif
 
 
-.PHONY: all sail sail.native sail.byte test clean doc lib power test_power test_idempotence
+.PHONY: all sail isail coverage sail.native sail.byte manifest.ml clean doc lib
 
 # set to -p on command line to enable gprof profiling
 OCAML_OPTS?=
 
-SHARE_DIR?=$(realpath ..)
-
 all: sail lib doc
 
-full: sail lib power doc test
+full: sail lib doc
 
 ast.lem: ../language/sail.ott
 	ott -sort false -generate_aux_rules true -o ast.lem -picky_multiple_parses true ../language/sail.ott
@@ -87,22 +85,32 @@ bytecode.ml: bytecode.lem
 	lem -ocaml bytecode.lem -lib . -lib gen_lib/
 	sed -i.bak -f ast.sed bytecode.ml
 
-lem_interp/interp_ast.lem: ../language/l2.ott
-	ott -sort false -generate_aux_rules true -o lem_interp/interp_ast.lem -picky_multiple_parses true ../language/l2.ott
-
-share_directory.ml:
-	echo "(* Generated file -- do not edit. *)" > share_directory.ml
-	echo let d=\"$(SHARE_DIR)\" >> share_directory.ml
+manifest.ml:
+	echo "(* Generated file -- do not edit. *)" > manifest.ml
+ifndef SHARE_DIR
+	echo let dir=\"$(realpath ..)\" >> manifest.ml
+	echo let commit=\"$(shell git rev-parse HEAD)\" >> manifest.ml
+	echo let branch=\"$(shell  git rev-parse --abbrev-ref HEAD)\" >> manifest.ml
+	echo let version=\"$(shell git describe)\" >> manifest.ml
+else
+	echo let dir=\"$(SHARE_DIR)\" >> manifest.ml
+	echo let commit=\"opam\" >> manifest.ml
+	echo let branch=\"sail2\" >> manifest.ml
+	echo let version=\"0.8\" >> manifest.ml
+endif
 
-sail: ast.ml bytecode.ml share_directory.ml
+sail: ast.ml bytecode.ml manifest.ml
 	ocamlbuild -use-ocamlfind sail.native sail_lib.cma sail_lib.cmxa
 
-isail: ast.ml bytecode.ml share_directory.ml
+isail: ast.ml bytecode.ml manifest.ml
 	ocamlbuild -use-ocamlfind isail.native
 
+coverage: ast.ml bytecode.ml manifest.ml
+	BISECT_COVERAGE=YES ocamlbuild -use-ocamlfind -plugin-tag 'package(bisect_ppx-ocamlbuild)' isail.native
+
 sail.native: sail
 
-sail.byte: ast.ml bytecode.ml share_directory.ml
+sail.byte: ast.ml bytecode.ml manifest.ml
 	ocamlbuild -use-ocamlfind -cflag -g sail.byte
 
 isail.byte: ast.ml bytecode.ml share_directory.ml
@@ -112,31 +120,10 @@ interpreter: lem_interp/interp_ast.lem
 	ocamlbuild -use-ocamlfind lem_interp/extract.cmxa
 	ocamlbuild -use-ocamlfind lem_interp/extract.cma
 
-test: sail interpreter
-	ocamlbuild -use-ocamlfind test/run_tests.native
-	./run_tests.native
-
 THIS_MAKEFILE := $(realpath $(lastword $(MAKEFILE_LIST)))
 SAIL_DIR:=$(realpath $(dir $(THIS_MAKEFILE))..)
 PROJECT_ROOT=$(realpath $(dir $(THIS_MAKEFILE))../..)
 
-_build/sail_values.ml: gen_lib/sail_values.ml
-	$(CP_TO_BUILD)
-
-_build/power.ml: $(SAIL_DIR)/src/test/power.sail sail.native
-	cd _build; \
-	./sail.native -lem_ast -ocaml $< -o $(basename $(@))
-
-_build/power.native: _build/sail_values.ml _build/power.ml
-	env OCAMLRUNPARAM=l=100M ocamlfind ocamlopt $(OCAML_OPTS) -g -package zarith -package unix -I _build -linkpkg $^ -o $@
-
-_build/armv8_embed.ml: sail.native
-	make -C ../arm ocaml
-	cp ../arm/build/armv8_embed.ml $@
-
-_build/arm.native: _build/sail_values.ml _build/armv8_embed.ml
-	env OCAMLRUNPARAM=l=100M ocamlfind ocamlopt $(OCAML_OPTS) -g -package zarith -package unix -I _build -linkpkg $^ -o $@
-
 clean:
 	-ocamlbuild -clean
 	-rm -rf _build *.native
@@ -151,7 +138,7 @@ clean:
 	-rm -f bytecode.ml
 	-rm -f bytecode.lem
 	-rm -f bytecode.ml.bak
-	-rm -f share_directory.ml
+	-rm -f manifest.ml
 
 doc:
 	ocamlbuild -use-ocamlfind sail.docdir/index.html
diff --git a/src/Makefile-non-opam b/src/Makefile-non-opam
deleted file mode 100644
index ebd82c09..00000000
--- a/src/Makefile-non-opam
+++ /dev/null
@@ -1,217 +0,0 @@
-##########################################################################
-#     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.                                                          #
-##########################################################################
-
-THIS_MAKEFILE := $(lastword $(MAKEFILE_LIST))
-# NOTE: it matters that this path is *not* canonicalised (realpath'd).
-# If we realpath it, the ocaml deps files will include realpaths, and
-# make won't know they're the same CMX files that we're building. So
-# will not correctly merge dependency subgraphs, and we will not build
-# stuff in the right order.
-# In general, the lesson is that the whole system needs to use the same
-# path, whether absolute or relative, to name a given file.
-# Sometimes that's difficult. Rules which cd to another directory break
-# if we're using absolute paths. I have used $(realpath $(srcdir)) in
-# those cases. This is not ideal. We shouldn't cd unless we really have to.
-srcdir := $(dir $(THIS_MAKEFILE))
-$(warning srcdir is $(srcdir))
-
-BITSTRING ?= $(srcdir)/contrib/bitstring
-BATTERIES ?= $(srcdir)/contrib/batteries-included/_build/src
-UINT ?= $(srcdir)/contrib/ocaml-uint/_build/lib
-
-export CAML_LD_LIBRARY_PATH := $(BITSTRING) $(CAML_LD_LIBRARY_PATH)
-
-LEM ?= ~/bitbucket/lem/lem
-LEMLIB ?= ~/bitbucket/lem/ocaml-lib/_build/
-OCAMLFLAGS +=  -I $(LEMLIB) # FIXME
-
-.PHONY: all sail test clean doc lib power test_power test_idempotence contrib install_elf
-all: sail lib doc
-full: all power test test
-sail: sail.native sail_lib.cma sail_lib.cmxa
-interpreter: _build/lem_interp/extract.cmxa _build/lem_interp/extract.cma
-sail.native sail_lib.cma sail_lib.cmxa:
-	ocamlbuild sail.native sail_lib.cma sail_lib.cmxa
-_build/lem_interp/extract.cmxa:
-	ocamlbuild lem_interp/extract.cmxa
-_build/lem_interp/extract.cma:
-	ocamlbuild lem_interp/extract.cma
-test: sail interpreter
-	ocamlbuild test/run_tests.native
-	./run_tests.native
-contrib:
-	cd contrib && ./checkout.sh
-install_elf:
-	cp -p ../../system-v-abi/src/*.lem elf_model/
-	cp -p ../../system-v-abi/src/*.ml elf_model/
-
-%.ml: %.lem
-	$(LEM) -outdir $$(dirname "$<") -ocaml -only_changed_output "$<"
-# HACK: special case for bitstring_local
-elf_model/bitstring_local.ml: elf_model/bitstring.lem
-	$(LEM) -outdir $$(dirname "$<") -ocaml -only_changed_output "$<"
-
-ELF_LEM_SRC := $(addprefix elf_model/,missing_pervasives.lem show.lem endianness.lem bitstring.lem elf_types.lem elf_interpreted_segment.lem elf_header.lem elf_file1.lem elf_program_header_table.lem elf_executable_file2.lem elf_section_header_table.lem elf_executable_file3.lem string_table.lem elf_executable_file4.lem elf_executable_file5.lem sail_interface.lem main.lem)
-vpath _build/%.lem .
-vpath _build/%.cmx .
-
-CAMLP4FLAGS += -nolib 
-CAMLP4FLAGS += -I $(srcdir)/contrib/$(BITSTRING)
-CAMLP4FLAGS += -parser o -parser op -printer p
-CAMLP4FLAGS += unix.cma 
-CAMLP4FLAGS += bitstring.cma 
-CAMLP4FLAGS += bitstring_persistent.cma 
-CAMLP4FLAGS += pa_bitstring.cmo
-
-# HACK: rewrite for bitstring_local
-ELF_ML_LEM := $(filter-out elf_model/bitstring.ml,$(patsubst %.lem,%.ml,$(ELF_LEM_SRC))) elf_model/bitstring_local.ml
-ELF_ML_SRC := $(addprefix elf_model/,error.ml ml_bindings.ml)  
-ELF_ML := $(ELF_ML_SRC) $(ELF_ML_LEM)
-ELF_ML_DEPS := $(patsubst %.ml,%.d,$(ELF_ML))
-ELF_CMX := $(patsubst %.ml,%.cmx,$(ELF_ML))
-
-$(ELF_CMX): OCAMLFLAGS += \
--I $(BITSTRING) -pp 'env CAML_LD_LIBRARY_PATH=$(BITSTRING) camlp4o $(CAMLP4FLAGS)' \
--I $(BATTERIES) \
--I $(UINT) \
--I $(srcdir)/elf_model
-
-$(ELF_ML_DEPS): OCAMLFLAGS += \
--I $(BITSTRING) -pp 'env CAML_LD_LIBRARY_PATH=$(BITSTRING) camlp4o $(CAMLP4FLAGS)' \
--I $(BATTERIES) \
--I $(UINT) \
--I $(srcdir)/elf_model
-
-$(ELF_ML_DEPS): %.d: %.ml
-	ocamldep -native $(OCAMLFLAGS) "$<" > "$@" || (rm -f "$@"; false)
-
-ifneq ($(MAKECMDGOALS),clean)
-include $(ELF_ML_DEPS)
-endif
-
-elf_extract.cmxa: OCAMLFLAGS += \
--I $(BITSTRING) -package bitstring,bitstring.syntax -syntax bitstring \
--I $(BATTERIES) -package batteries \
--I $(UINT) -package bitstring \
--pp 'camlp4 $(CAMLP4FLAGS)' \
--I $(LEMLIB)/../ocaml-lib/_build
-
-LEM_CMX :=  $(addprefix $(LEMLIB)/../ocaml-lib/,nat_num.cmx lem.cmx lem_function.cmx lem_list.cmx)
-
-%.cmx: %.ml
-	echo CAML_LD_LIBRARY_PATH is $$CAML_LD_LIBRARY_PATH 
-	ocamlopt $(OCAMLFLAGS) -c "$<"
-
-elf_model/elf_extract.cmxa: $(ELF_CMX)
-	ocamlopt $(OCAMLFLAGS) -a -o "$@" $+
-
-elf: $(ELF_CMX) $(LEM_CMX) elf_model/elf_extract.cmxa
-
-_build/test/power.lem: sail.native test/power.sail
-	mkdir -p _build/test
-	cp -p test/* _build/test/
-	cd _build/test && \
-	../../sail.native -lem_ast power.sail
-
-pprint/src/_build/PPrintLib.cmxa:
-	$(MAKE) -C $(srcdir)/pprint/src
-
-_build/test/run_power.native: OCAMLFLAGS += \
--I $(LEMLIB) \
--I $(srcdir)/_build/lem_interp/ \
--I $(srcdir)/elf_model/ \
--I $(UINT) 
-
-_build/test/run_power.native: OCAMLLIBS += \
-$(LEMLIB)/extract.cmxa
-
-_build/test/power.ml: _build/test/power.lem
-	cd _build/test && $(LEM) -ocaml -only_changed_output -lib $(realpath $(srcdir))/lem_interp/ power.lem
-	touch "$@" # HACK HACK HACK! why didn't lem update the timestamp?
-
-_build/test/run_power.native: pprint/src/_build/PPrintLib.cmxa _build/lem_interp/extract.cmxa elf_model/elf_extract.cmxa _build/test/power.ml test/run_power.ml
-	cd _build/test && \
-	ocamlopt $(OCAMLFLAGS) $(OCAMLLIBS) -I $(realpath $(srcdir))/_build/lem_interp $(addprefix $(realpath $(srcdir))/,$+) -o run_power.native
-
-power: run_power.native
-
-run_power.native: _build/test/run_power.native
-	ln -fs _build/test/run_power.native run_power.native
-
-test_power: power
-	./run_power.native --file ../../../rsem/idl/power/binary/main.bin
-
-test_power_interactive: power
-	./run_power.native --interactive --file ../../../rsem/idl/power/binary/main.bin
-
-test_power_interactive_srcs:
-	ebig ~/rsem/idl/power/generated/power.sail ../../../rsem/idl/power/binary/hello.c  ../../../rsem/idl/power/binary/hello.s 
-
-# or test/power.sail for cut-down one
-
-test_idempotence: sail
-	@cd test; for file in *.sail; do \
-		./idempotence.sh $$file; echo ;\
-	done
-
-clean:
-	#-ocamlbuild -clean
-	-rm -rf _build *.native
-	-rm -rf $(srcdir)/elf_model/*.o $(srcdir)/elf_model/*.cmx $(srcdir)/elf_model/*.cmi $(ELF_ML_LEM) $(ELF_ML_DEPS)
-	-rm -rf html-doc
-	-rm -rf tex-doc
-	-rm -rf lem lib
-	-rm -rf sail.docdir
-
-doc:
-	ocamlbuild sail.docdir/index.html
-
-lib:
-	ocamlbuild pretty_print.cmxa pretty_print.cma
diff --git a/src/_tags b/src/_tags
index cdc8fbb5..fbea6a00 100644
--- a/src/_tags
+++ b/src/_tags
@@ -1,10 +1,11 @@
 true: -traverse, debug, use_menhir
-<**/*.ml>: bin_annot, annot
+<**/parser.ml>: bin_annot, annot
+<**/*.ml> and not <**/parser.ml>: bin_annot, annot
 
 <sail.{byte,native}>: package(zarith), package(linksem), package(lem), package(omd), package(base64), use_pprint
-<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(omd), package(base64), use_pprint
+<isail.{byte,native}>: package(zarith), package(linenoise), package(linksem), package(lem), package(omd), package(base64), package(yojson), use_pprint
 
-<isail.ml>: package(linenoise)
+<isail.ml>: package(linenoise), package(yojson)
 <elf_loader.ml>: package(linksem)
 <latex.ml>: package(omd)
 <**/*.m{l,li}>: package(lem), package(base64)
diff --git a/src/anf.ml b/src/anf.ml
index 915ab738..38c77e0b 100644
--- a/src/anf.ml
+++ b/src/anf.ml
@@ -699,9 +699,13 @@ let rec anf (E_aux (e_aux, ((l, _) as exp_annot)) as exp) =
      (* Interpreter specific *)
      raise (Reporting.err_unreachable l __POS__ "encountered E_internal_value when converting to ANF")
 
-  | E_sizeof _ | E_constraint _ ->
+  | E_sizeof nexp ->
      (* Sizeof nodes removed by sizeof rewriting pass *)
-     raise (Reporting.err_unreachable l __POS__ "encountered E_sizeof or E_constraint node when converting to ANF")
+     raise (Reporting.err_unreachable l __POS__ ("encountered E_sizeof node " ^ string_of_nexp nexp ^ " when converting to ANF"))
+
+  | E_constraint _ ->
+     (* Sizeof nodes removed by sizeof rewriting pass *)
+     raise (Reporting.err_unreachable l __POS__ "encountered E_constraint node when converting to ANF")
 
   | E_nondet _ ->
      (* We don't compile E_nondet nodes *)
diff --git a/src/ast_util.ml b/src/ast_util.ml
index c89d30c1..04b76a61 100644
--- a/src/ast_util.ml
+++ b/src/ast_util.ml
@@ -236,6 +236,11 @@ let rec is_nexp_constant (Nexp_aux (nexp, _)) = match nexp with
   | Nexp_exp n | Nexp_neg n -> is_nexp_constant n
   | Nexp_app (_, nexps) -> List.for_all is_nexp_constant nexps
 
+let int_of_nexp_opt nexp =
+  match nexp with
+  | Nexp_aux(Nexp_constant i,_) -> Some i
+  | _ -> None
+
 let rec nexp_simp (Nexp_aux (nexp, l)) = Nexp_aux (nexp_simp_aux nexp, l)
 and nexp_simp_aux = function
   (* (n - (n - m)) often appears in foreach loops *)
@@ -321,10 +326,23 @@ let rec constraint_simp (NC_aux (nc_aux, l)) =
        | 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)
+       let nexp1, nexp2 = nexp_simp nexp1, nexp_simp nexp2 in
+       begin match nexp1, nexp2 with
+       | Nexp_aux (Nexp_constant c1, _), Nexp_aux (Nexp_constant c2, _) ->
+          if Big_int.greater_equal c1 c2 then NC_true else NC_false
+       | _, _ -> NC_bounded_ge (nexp1, nexp2)
+       end
+
     | NC_bounded_le (nexp1, nexp2) ->
-       NC_bounded_le (nexp_simp nexp1, nexp_simp nexp2)
+       let nexp1, nexp2 = nexp_simp nexp1, nexp_simp nexp2 in
+       begin match nexp1, nexp2 with
+       | Nexp_aux (Nexp_constant c1, _), Nexp_aux (Nexp_constant c2, _) ->
+          if Big_int.less_equal c1 c2 then NC_true else NC_false
+       | _, _ -> NC_bounded_le (nexp1, nexp2)
+       end
+
     | _ -> nc_aux
   in
   NC_aux (nc_aux, l)
@@ -361,10 +379,13 @@ 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 (A_typ typ)]))
 let atom_typ nexp =
   mk_typ (Typ_app (mk_id "atom", [mk_typ_arg (A_nexp (nexp_simp nexp))]))
+let implicit_typ nexp =
+  mk_typ (Typ_app (mk_id "implicit", [mk_typ_arg (A_nexp (nexp_simp nexp))]))
 let range_typ nexp1 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 atom_bool_typ nc = mk_typ (Typ_app (mk_id "atom_bool", [mk_typ_arg (A_bool nc)]))
 let string_typ = mk_id_typ (mk_id "string")
 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)
@@ -609,7 +630,6 @@ let exp_loc = function
   | E_aux (_, (l, _)) -> l
 
 let def_loc = function
-  | DEF_kind (KD_aux (_, (l, _)))
   | DEF_type (TD_aux (_, (l, _)))
   | DEF_fundef (FD_aux (_, (l, _)))
   | DEF_mapdef (MD_aux (_, (l, _)))
@@ -622,6 +642,7 @@ let def_loc = function
   | DEF_overload (Id_aux (_, l), _) -> l
   | DEF_internal_mutrec _ -> Parse_ast.Unknown
   | DEF_pragma (_, _, l) -> l
+  | DEF_measure (id, _, _) -> id_loc id
 
 let string_of_id = function
   | Id_aux (Id v, _) -> v
@@ -895,8 +916,8 @@ and string_of_letbind (LB_aux (lb, l)) =
 
 let rec string_of_index_range (BF_aux (ir, _)) =
   match ir with
-  | BF_single n -> Big_int.to_string n
-  | BF_range (n, m) -> Big_int.to_string n ^ " .. " ^ Big_int.to_string m
+  | BF_single n -> string_of_nexp n
+  | BF_range (n, m) -> string_of_nexp n ^ " .. " ^ string_of_nexp m
   | BF_concat (ir1, ir2) -> "(" ^ string_of_index_range ir1 ^ ") : (" ^ string_of_index_range ir2 ^ ")"
 
 
@@ -934,9 +955,9 @@ let id_of_fundef (FD_aux (FD_function (_, _, _, funcls), (l, _))) =
 
 let id_of_type_def_aux = function
   | TD_abbrev (id, _, _)
-  | TD_record (id, _, _, _, _)
-  | TD_variant (id, _, _, _, _)
-  | TD_enum (id, _, _, _)
+  | TD_record (id, _, _, _)
+  | TD_variant (id, _, _, _)
+  | TD_enum (id, _, _)
   | TD_bitfield (id, _, _) -> id
 let id_of_type_def (TD_aux (td_aux, _)) = id_of_type_def_aux td_aux
 
@@ -944,17 +965,16 @@ 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_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)
   | DEF_fundef fd -> IdSet.singleton (id_of_fundef fd)
   | DEF_val (LB_aux (LB_val (pat, _), _)) -> pat_ids pat
-  | DEF_reg_dec (DEC_aux (DEC_reg (_, id), _)) -> IdSet.singleton id
+  | DEF_reg_dec (DEC_aux (DEC_reg (_, _, _, id), _)) -> IdSet.singleton id
   | DEF_spec vs -> IdSet.singleton (id_of_val_spec vs)
   | DEF_internal_mutrec fds -> IdSet.of_list (List.map id_of_fundef fds)
   | _ -> IdSet.empty
@@ -1183,6 +1203,72 @@ let equal_effects e1 e2 =
   | Effect_aux (Effect_set base_effs1, _), Effect_aux (Effect_set base_effs2, _) ->
      BESet.compare (BESet.of_list base_effs1) (BESet.of_list base_effs2) = 0
 
+let subseteq_effects e1 e2 =
+  match e1, e2 with
+  | Effect_aux (Effect_set base_effs1, _), Effect_aux (Effect_set base_effs2, _) ->
+     BESet.subset (BESet.of_list base_effs1) (BESet.of_list base_effs2)
+
+let rec kopts_of_nexp (Nexp_aux (nexp,_)) =
+  match nexp with
+  | Nexp_id _
+  | Nexp_constant _ -> KOptSet.empty
+  | Nexp_var kid -> KOptSet.singleton (mk_kopt K_int kid)
+  | Nexp_times (n1,n2)
+  | Nexp_sum (n1,n2)
+  | Nexp_minus (n1,n2) -> KOptSet.union (kopts_of_nexp n1) (kopts_of_nexp n2)
+  | Nexp_exp n
+  | Nexp_neg n -> kopts_of_nexp n
+  | Nexp_app (_, nexps) -> List.fold_left KOptSet.union KOptSet.empty (List.map kopts_of_nexp nexps)
+
+let kopts_of_order (Ord_aux (ord, _)) =
+  match ord with
+  | Ord_var kid -> KOptSet.singleton (mk_kopt K_order kid)
+  | Ord_inc | Ord_dec -> KOptSet.empty
+
+let rec kopts_of_constraint (NC_aux (nc, _)) =
+  match nc with
+  | NC_equal (nexp1, nexp2)
+  | NC_bounded_ge (nexp1, nexp2)
+  | NC_bounded_le (nexp1, nexp2)
+  | NC_not_equal (nexp1, nexp2) ->
+     KOptSet.union (kopts_of_nexp nexp1) (kopts_of_nexp nexp2)
+  | NC_set (kid, _) -> KOptSet.singleton (mk_kopt K_int kid)
+  | NC_or (nc1, nc2)
+  | NC_and (nc1, nc2) ->
+     KOptSet.union (kopts_of_constraint nc1) (kopts_of_constraint nc2)
+  | NC_app (id, args) ->
+     List.fold_left (fun s t -> KOptSet.union s (kopts_of_typ_arg t)) KOptSet.empty args
+  | NC_var kid -> KOptSet.singleton (mk_kopt K_bool kid)
+  | NC_true | NC_false -> KOptSet.empty
+
+and kopts_of_typ (Typ_aux (t,_)) =
+  match t with
+  | Typ_internal_unknown -> KOptSet.empty
+  | Typ_id _ -> KOptSet.empty
+  | Typ_var kid -> KOptSet.singleton (mk_kopt K_type kid)
+  | Typ_fn (ts, t, _) -> List.fold_left KOptSet.union (kopts_of_typ t) (List.map kopts_of_typ ts)
+  | Typ_bidir (t1, t2) -> KOptSet.union (kopts_of_typ t1) (kopts_of_typ t2)
+  | Typ_tup ts ->
+     List.fold_left (fun s t -> KOptSet.union s (kopts_of_typ t))
+       KOptSet.empty ts
+  | Typ_app (_,tas) ->
+     List.fold_left (fun s ta -> KOptSet.union s (kopts_of_typ_arg ta))
+       KOptSet.empty tas
+  | Typ_exist (kopts, nc, t) ->
+     let s = KOptSet.union (kopts_of_typ t) (kopts_of_constraint nc) in
+     KOptSet.diff s (KOptSet.of_list kopts)
+and kopts_of_typ_arg (A_aux (ta,_)) =
+  match ta with
+  | A_nexp nexp -> kopts_of_nexp nexp
+  | A_typ typ -> kopts_of_typ typ
+  | A_order ord -> kopts_of_order ord
+  | A_bool nc -> kopts_of_constraint nc
+
+let kopts_of_quant_item (QI_aux (qi, _)) = match qi with
+  | QI_id kopt ->
+     KOptSet.singleton kopt
+  | QI_const nc -> kopts_of_constraint nc
+
 let rec tyvars_of_nexp (Nexp_aux (nexp,_)) =
   match nexp with
   | Nexp_id _
@@ -1738,3 +1824,116 @@ let typquant_subst_kid_aux sv subst = function
   | 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)
+
+let rec simp_loc = function
+  | Parse_ast.Unknown -> None
+  | Parse_ast.Unique (_, l) -> simp_loc l
+  | Parse_ast.Generated l -> simp_loc l
+  | Parse_ast.Range (p1, p2) -> Some (p1, p2)
+  | Parse_ast.Documented (_, l) -> simp_loc l
+
+let before p1 p2 =
+  let open Lexing in
+  p1.pos_fname = p2.pos_fname && p1.pos_cnum <= p2.pos_cnum
+
+let subloc sl l =
+  match sl, simp_loc l with
+  | _, None -> false
+  | None, _ -> false
+  | Some (p1a, p1b), Some (p2a, p2b) ->
+     before p2a p1a && before p1b p2b
+
+let rec option_mapm f = function
+  | [] -> None
+  | x :: xs ->
+     begin match f x with
+     | Some y -> Some y
+     | None -> option_mapm f xs
+     end
+
+let option_chain opt1 opt2 =
+  begin match opt1 with
+  | None -> opt2
+  | _ -> opt1
+  end
+
+let rec find_annot_exp sl (E_aux (aux, (l, annot)) as exp) =
+  if not (subloc sl l) then None else
+    let result = match aux with
+      | E_block exps | E_tuple exps ->
+         option_mapm (find_annot_exp sl) exps
+      | E_app (id, exps) ->
+         option_mapm (find_annot_exp sl) exps
+      | E_let (LB_aux (LB_val (pat, exp), _), body) ->
+         option_chain (find_annot_pat sl pat) (option_mapm (find_annot_exp sl) [exp; body])
+      | E_assign (lexp, exp) ->
+         option_chain (find_annot_lexp sl lexp) (find_annot_exp sl exp)
+      | E_var (lexp, exp1, exp2) ->
+         option_chain (find_annot_lexp sl lexp) (option_mapm (find_annot_exp sl) [exp1; exp2])
+      | _ -> None
+    in
+    match result with
+    | None -> Some (l, annot)
+    | _ -> result
+
+and find_annot_lexp sl (LEXP_aux (aux, (l, annot))) =
+  if not (subloc sl l) then None else
+    let result = match aux with
+      | LEXP_vector_range (lexp, exp1, exp2) ->
+         option_chain (find_annot_lexp sl lexp) (option_mapm (find_annot_exp sl) [exp1; exp2])
+      | LEXP_deref exp ->
+         find_annot_exp sl exp
+      | LEXP_tup lexps ->
+         option_mapm (find_annot_lexp sl) lexps
+      | LEXP_memory (id, exps) ->
+         option_mapm (find_annot_exp sl) exps
+      | _ -> None
+    in
+    match result with
+    | None -> Some (l, annot)
+    | _ -> result
+
+and find_annot_pat sl (P_aux (aux, (l, annot))) =
+  if not (subloc sl l) then None else
+    let result = match aux with
+      | _ -> None
+    in
+    match result with
+    | None -> Some (l, annot)
+    | _ -> result
+
+and find_annot_pexp sl (Pat_aux (aux, (l, annot))) =
+  if not (subloc sl l) then None else
+    match aux with
+    | Pat_exp (pat, exp) ->
+       find_annot_exp sl exp
+    | Pat_when (pat, guard, exp) ->
+       None
+
+let find_annot_funcl sl (FCL_aux (FCL_Funcl (id, pexp), (l, annot))) =
+  if not (subloc sl l) then
+    None
+  else
+    match find_annot_pexp sl pexp with
+    | None -> Some (l, annot)
+    | result -> result
+
+let find_annot_fundef sl (FD_aux (FD_function (_, _, _, funcls), (l, annot))) =
+  if not (subloc sl l) then
+    None
+  else
+    match option_mapm (find_annot_funcl sl) funcls with
+    | None -> Some (l, annot)
+    | result -> result
+
+let rec find_annot_defs sl = function
+  | DEF_fundef fdef :: defs ->
+     begin match find_annot_fundef sl fdef with
+     | None -> find_annot_defs sl defs
+     | result -> result
+     end
+  | _ :: defs ->
+     find_annot_defs sl defs
+  | [] -> None
+
+let rec find_annot_ast sl (Defs defs) = find_annot_defs sl defs
diff --git a/src/ast_util.mli b/src/ast_util.mli
index 65e02d81..a2466326 100644
--- a/src/ast_util.mli
+++ b/src/ast_util.mli
@@ -113,7 +113,7 @@ 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
@@ -124,9 +124,11 @@ val unknown_typ : typ
 val int_typ : typ
 val nat_typ : typ
 val atom_typ : nexp -> typ
+val implicit_typ : nexp -> typ
 val range_typ : nexp -> nexp -> typ
 val bit_typ : typ
 val bool_typ : typ
+val atom_bool_typ : n_constraint -> typ
 val app_typ : id -> typ_arg list -> typ
 val register_typ : typ -> typ
 val unit_typ : typ
@@ -191,7 +193,7 @@ 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
@@ -281,6 +283,11 @@ module BE : sig
   val compare : base_effect -> base_effect -> int
 end
 
+module NC : sig
+  type t = n_constraint
+  val compare : n_constraint -> n_constraint -> int
+end
+
 (* NB: the comparison function does not expand synonyms *)
 module Typ : sig
   type t = typ
@@ -330,6 +337,7 @@ end
 val nexp_frees : nexp -> KidSet.t
 val nexp_identical : nexp -> nexp -> bool
 val is_nexp_constant : nexp -> bool
+val int_of_nexp_opt : nexp -> Big_int.num option
 
 val lexp_to_exp : 'a lexp -> 'a exp
 
@@ -351,8 +359,16 @@ val has_effect : effect -> base_effect_aux -> bool
 val effect_set : effect -> BESet.t
 
 val equal_effects : effect -> effect -> bool
+val subseteq_effects : effect -> effect -> bool
 val union_effects : effect -> effect -> effect
 
+val kopts_of_order : order -> KOptSet.t
+val kopts_of_nexp : nexp -> KOptSet.t
+val kopts_of_typ : typ -> KOptSet.t
+val kopts_of_typ_arg : typ_arg -> KOptSet.t
+val kopts_of_constraint : n_constraint -> KOptSet.t
+val kopts_of_quant_item : quant_item -> KOptSet.t
+
 val tyvars_of_nexp : nexp -> KidSet.t
 val tyvars_of_typ : typ -> KidSet.t
 val tyvars_of_constraint : n_constraint -> KidSet.t
@@ -427,3 +443,7 @@ 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
+
+val simp_loc : Ast.l -> (Lexing.position * Lexing.position) option
+
+val find_annot_ast : (Lexing.position * Lexing.position) option -> 'a defs -> (Ast.l * 'a) option
diff --git a/src/bitfield.ml b/src/bitfield.ml
index afdd5baf..1f64adbd 100644
--- a/src/bitfield.ml
+++ b/src/bitfield.ml
@@ -75,7 +75,7 @@ let newtype name size order =
       chunk_rem :: List.rev chunks_64
   in
   let nt = Printf.sprintf "struct %s = {\n  %s }" name (Util.string_of_list ",\n  " (fun x -> x) chunks) in
-  ast_of_def_string order nt
+  ast_of_def_string nt
 
 let rec translate_indices hi lo =
   if hi / 64 = lo / 64 then
@@ -97,7 +97,7 @@ let constructor name order start stop =
                      "}"
     ]
   in
-  combine [ast_of_def_string order constructor_val; ast_of_def_string order constructor_function]
+  combine [ast_of_def_string constructor_val; ast_of_def_string constructor_function]
 
 (* For every index range, create a getter and setter *)
 let index_range_getter name field order start stop =
@@ -108,7 +108,7 @@ let index_range_getter name field order start stop =
     Printf.sprintf "v.%s_chunk_%i[%i .. %i]" name chunk start stop
   in
   let irg_function = Printf.sprintf "function _get_%s_%s v = %s" name field (Util.string_of_list " @ " body indices) in
-  combine [ast_of_def_string order irg_val; ast_of_def_string order irg_function]
+  combine [ast_of_def_string irg_val; ast_of_def_string irg_function]
 
 let index_range_setter name field order start stop =
   let indices = translate_indices start stop in
@@ -127,7 +127,7 @@ let index_range_setter name field order start stop =
                      "}"
     ]
   in
-  combine [ast_of_def_string order irs_val; ast_of_def_string order irs_function]
+  combine [ast_of_def_string irs_val; ast_of_def_string irs_function]
 
 let index_range_update name field order start stop =
   let indices = translate_indices start stop in
@@ -145,24 +145,35 @@ let index_range_update name field order start stop =
     ]
   in
   let iru_overload = Printf.sprintf "overload update_%s = {_update_%s_%s}" field name field in
-  combine [ast_of_def_string order iru_val; ast_of_def_string order iru_function; ast_of_def_string order iru_overload]
+  combine [ast_of_def_string iru_val; ast_of_def_string iru_function; ast_of_def_string iru_overload]
 
 let index_range_overload name field order =
-  ast_of_def_string order (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field)
+  ast_of_def_string (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field)
 
-let index_range_accessor name field order (BF_aux (bf_aux, l)) =
+let index_range_accessor (eval, typ_error) name field order (BF_aux (bf_aux, l)) =
   let getter n m = index_range_getter name field order (Big_int.to_int n) (Big_int.to_int m) in
   let setter n m = index_range_setter name field order (Big_int.to_int n) (Big_int.to_int m) in
   let update n m = index_range_update name field order (Big_int.to_int n) (Big_int.to_int m) in
   let overload = index_range_overload name field order in
+  let const_fold nexp = match eval nexp with
+      | Some v -> v
+      | None -> typ_error l (Printf.sprintf "Non-constant index for field %s" field) in
   match bf_aux with
-  | BF_single n -> combine [getter n n; setter n n; update n n; overload]
-  | BF_range (n, m) -> combine [getter n m; setter n m; update n m; overload]
+  | BF_single n ->
+        let n = const_fold n in
+        combine [getter n n; setter n n; update n n; overload]
+  | BF_range (n, m) ->
+        let n, m = const_fold n, const_fold m in
+        combine [getter n m; setter n m; update n m; overload]
   | BF_concat _ -> failwith "Unimplemented"
 
-let field_accessor name order (id, ir) = index_range_accessor name (string_of_id id) order ir
+let field_accessor (eval, typ_error) name order (id, ir) =
+  index_range_accessor (eval, typ_error) name (string_of_id id) order ir
 
-let macro id size order ranges =
+let macro (eval, typ_error) id size order ranges =
   let name = string_of_id id in
-  let ranges = (mk_id "bits", BF_aux (BF_range (Big_int.of_int (size - 1), Big_int.of_int 0), Parse_ast.Unknown)) :: ranges in
-  combine ([newtype name size order; constructor name order (size - 1) 0] @ List.map (field_accessor name order) ranges)
+  let ranges = (mk_id "bits", BF_aux (BF_range (nconstant (Big_int.of_int (size - 1)),
+                                                nconstant (Big_int.of_int 0)),
+                                      Parse_ast.Unknown)) :: ranges in
+  combine ([newtype name size order; constructor name order (size - 1) 0]
+           @ List.map (field_accessor (eval, typ_error) name order) ranges)
diff --git a/src/c_backend.ml b/src/c_backend.ml
index 7cda4668..a1050972 100644
--- a/src/c_backend.ml
+++ b/src/c_backend.ml
@@ -64,8 +64,10 @@ let c_verbosity = ref 0
 let opt_debug_flow_graphs = ref false
 let opt_debug_function = ref ""
 let opt_trace = ref false
+let opt_smt_trace = ref false
 let opt_static = ref false
 let opt_no_main = ref false
+let opt_memo_cache = ref false
 
 (* Optimization flags *)
 let optimize_primops = ref false
@@ -141,7 +143,7 @@ let rec ctyp_of_typ ctx typ =
 
   | 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" ->
+  | Typ_app (id, _) when string_of_id id = "range" || string_of_id id = "atom" || string_of_id id = "implicit" ->
      begin match destruct_range Env.empty typ with
      | None -> assert false (* Checked if range type in guard *)
      | Some (kids, constr, n, m) ->
@@ -150,7 +152,7 @@ let rec ctyp_of_typ ctx typ =
              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
+           if prove __POS__ ctx.local_env (nc_lteq (nconstant min_int64) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant max_int64)) then
              CT_int64
            else
              CT_int
@@ -171,7 +173,7 @@ let rec ctyp_of_typ ctx typ =
      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
+     | n when ctx.optimize_z3 && prove __POS__ ctx.local_env (nc_lteq n (nint 64)) -> CT_sbits direction
      | _ -> CT_lbits direction
      end
 
@@ -541,7 +543,7 @@ let analyze_primop' ctx id args typ =
         | 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)) ->
+        | n, m when prove __POS__ ctx.local_env (nc_lteq (nconstant min_int64) n) && prove __POS__ ctx.local_env (nc_lteq m (nconstant max_int64)) ->
            AE_val (AV_C_fragment (F_op (op1, "+", op2), typ, CT_int64))
         | _ -> no_change
      end
@@ -1119,6 +1121,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      let aexp_setup, aexp_call, aexp_cleanup = compile_aexp ctx aexp in
      let try_return_id = gensym () in
      let handled_exception_label = label "handled_exception_" in
+     let fallthrough_label = label "fallthrough_exception_" in
      let compile_case (apat, guard, body) =
        let trivial_guard = match guard with
          | AE_aux (AE_val (AV_lit (L_aux (L_true, _), _)), _, _)
@@ -1144,14 +1147,14 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
        [iblock case_instrs; ilabel try_label]
      in
      assert (ctyp_equal ctyp (ctyp_of_typ ctx typ));
-     [icomment "begin try catch";
-      idecl ctyp try_return_id;
+     [idecl ctyp try_return_id;
       itry_block (aexp_setup @ [aexp_call (CL_id (try_return_id, ctyp))] @ aexp_cleanup);
       ijump (F_unary ("!", F_have_exception), CT_bool) handled_exception_label]
      @ List.concat (List.map compile_case cases)
-     @ [imatch_failure ();
+     @ [igoto fallthrough_label;
         ilabel handled_exception_label;
-        icopy l CL_have_exception (F_lit (V_bool false), CT_bool)],
+        icopy l CL_have_exception (F_lit (V_bool false), CT_bool);
+        ilabel fallthrough_label],
      (fun clexp -> icopy l clexp (F_id try_return_id, ctyp)),
      []
 
@@ -1390,16 +1393,16 @@ and compile_block ctx = function
    it returns a ctypdef * ctx pair. **)
 let compile_type_def ctx (TD_aux (type_def, _)) =
   match type_def with
-  | TD_enum (id, _, ids, _) ->
+  | TD_enum (id, ids, _) ->
      CTD_enum (id, ids),
      { ctx with enums = Bindings.add id (IdSet.of_list ids) ctx.enums }
 
-  | TD_record (id, _, _, ctors, _) ->
+  | TD_record (id, _, ctors, _) ->
      let ctors = List.fold_left (fun ctors (typ, id) -> Bindings.add id (ctyp_of_typ ctx typ) ctors) Bindings.empty ctors in
      CTD_struct (id, Bindings.bindings ctors),
      { ctx with records = Bindings.add id ctors ctx.records }
 
-  | TD_variant (id, _, typq, tus, _) ->
+  | TD_variant (id, typq, tus, _) ->
      let compile_tu = function
        | Tu_aux (Tu_ty_id (typ, id), _) ->
           let ctx = { ctx with local_env = add_typquant (id_loc id) typq ctx.local_env } in
@@ -1625,8 +1628,42 @@ let fix_destructure fail_label = function
 let letdef_count = ref 0
 
 (** Compile a Sail toplevel definition into an IR definition **)
-let rec compile_def ctx = function
-  | DEF_reg_dec (DEC_aux (DEC_reg (typ, id), _)) ->
+let rec compile_def n total ctx def =
+  match def with
+  | DEF_fundef (FD_aux (FD_function (_, _, _, [FCL_aux (FCL_Funcl (id, _), _)]), _))
+       when !opt_memo_cache ->
+     let digest =
+       def |> Pretty_print_sail.doc_def |> Pretty_print_sail.to_string |> Digest.string
+     in
+     let cachefile = Filename.concat "_sbuild" ("ccache" ^ Digest.to_hex digest) in
+     let cached =
+       if Sys.file_exists cachefile then
+         let in_chan = open_in cachefile in
+         try
+           let compiled = Marshal.from_channel in_chan in
+           close_in in_chan;
+           Some (compiled, ctx)
+         with
+         | _ -> close_in in_chan; None
+       else
+         None
+     in
+     begin match cached with
+     | Some (compiled, ctx) ->
+        Util.progress "Compiling " (string_of_id id) n total;
+        compiled, ctx
+     | None ->
+        let compiled, ctx = compile_def' n total ctx def in
+        let out_chan = open_out cachefile in
+        Marshal.to_channel out_chan compiled [Marshal.Closures];
+        close_out out_chan;
+        compiled, ctx
+     end
+
+  | _ -> compile_def' n total ctx def
+
+and compile_def' n total ctx = function
+  | DEF_reg_dec (DEC_aux (DEC_reg (_, _, typ, id), _)) ->
      [CDEF_reg_dec (id, ctyp_of_typ ctx typ, [])], ctx
   | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), _)) ->
      let aexp = analyze_functions ctx analyze_primop (c_literals ctx (no_shadow IdSet.empty (anf exp))) in
@@ -1647,6 +1684,8 @@ let rec compile_def ctx = function
 
   | DEF_fundef (FD_aux (FD_function (_, _, _, [FCL_aux (FCL_Funcl (id, Pat_aux (Pat_exp (pat, exp), _)), _)]), _)) ->
      c_debug (lazy ("Compiling function " ^ string_of_id id));
+     Util.progress "Compiling " (string_of_id id) n total;
+
      (* Find the function's type. *)
      let quant, Typ_aux (fn_typ, _) =
        try Env.get_val_spec id ctx.local_env
@@ -1768,7 +1807,7 @@ let rec compile_def ctx = function
 
   | DEF_internal_mutrec fundefs ->
      let defs = List.map (fun fdef -> DEF_fundef fdef) fundefs in
-     List.fold_left (fun (cdefs, ctx) def -> let cdefs', ctx = compile_def ctx def in (cdefs @ cdefs', ctx)) ([], ctx) defs
+     List.fold_left (fun (cdefs, ctx) def -> let cdefs', ctx = compile_def n total ctx def in (cdefs @ cdefs', ctx)) ([], ctx) defs
 
   | def ->
      c_error ("Could not compile:\n" ^ Pretty_print_sail.to_string (Pretty_print_sail.doc_def def))
@@ -1936,6 +1975,7 @@ let flatten_cdef =
 
   | cdef -> cdef
 
+
 let rec specialize_variants ctx prior =
   let unifications = ref (Bindings.empty) in
 
@@ -2569,9 +2609,9 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) =
        empty
      else if fname = "reg_deref" then
        if is_stack_ctyp ctyp then
-         string (Printf.sprintf  " %s = *(%s);" (sgen_clexp_pure x) c_args)
+         string (Printf.sprintf  "  %s = *(%s);" (sgen_clexp_pure x) c_args)
        else
-         string (Printf.sprintf  " COPY(%s)(&%s, *(%s));" (sgen_ctyp_name ctyp) (sgen_clexp_pure x) c_args)
+         string (Printf.sprintf  "  COPY(%s)(&%s, *(%s));" (sgen_ctyp_name ctyp) (sgen_clexp_pure x) c_args)
      else
        if is_stack_ctyp ctyp then
          string (Printf.sprintf "  %s = %s(%s);" (sgen_clexp_pure x) fname c_args)
@@ -3326,7 +3366,10 @@ let bytecode_ast ctx rewrites (Defs defs) =
   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 total = List.length defs in
+  let _, chunks, ctx =
+    List.fold_left (fun (n, chunks, ctx) def -> let defs, ctx = compile_def n total ctx def in n + 1, defs :: chunks, ctx) (1, [], ctx) defs
+  in
   let cdefs = List.concat (List.rev chunks) in
   rewrites cdefs
 
@@ -3357,6 +3400,79 @@ let rec get_recursive_functions (Defs defs) =
   | _ :: defs -> get_recursive_functions (Defs defs)
   | [] -> IdSet.empty
 
+let trace_cval = function (frag, ctyp) -> string_of_fragment frag ^ " : " ^ string_of_ctyp ctyp
+
+let rec trace_clexp = function
+  | CL_id (id, ctyp) -> sgen_id id ^ " : " ^ string_of_ctyp ctyp
+  | CL_field (clexp, field) -> "(" ^ trace_clexp clexp ^ ")->" ^ field ^ ")"
+  | CL_tuple (clexp, n) -> "(" ^ trace_clexp clexp ^ ")." ^ string_of_int n
+  | CL_addr clexp -> "*(" ^ trace_clexp clexp ^ ")"
+  | CL_have_exception -> "have_exception"
+  | CL_current_exception _ -> "current_exception"
+
+let rec smt_trace_instrs ctx function_id = function
+  | I_aux (I_jump (cval, label), aux) :: instrs ->
+     iraw ("printf(\"!branch %s %s\\n\"," ^ sgen_cval cval ^ " ?\"true\":\"false\", \"" ^ trace_cval cval ^ "\");")
+     :: I_aux (I_jump (cval, label), aux)
+     :: smt_trace_instrs ctx function_id instrs
+
+  | (I_aux ((I_init (ctyp, id, cval) | I_reinit (ctyp, id, cval)), _) as instr) :: instrs ->
+     iraw ("printf(\"!create " ^ Util.zencode_string (string_of_id id) ^ " : " ^ string_of_ctyp ctyp ^ " = " ^ trace_cval cval ^ "\\n\");")
+     :: instr
+     :: smt_trace_instrs ctx function_id instrs
+
+  | (I_aux ((I_decl (ctyp, id) | I_reset (ctyp, id)), _) as instr) :: instrs ->
+     iraw ("printf(\"!create " ^ Util.zencode_string (string_of_id id) ^ " : " ^ string_of_ctyp ctyp ^ "\\n\");")
+     :: instr
+     :: smt_trace_instrs ctx function_id instrs
+
+  | I_aux (I_funcall (x, extern, f, args), aux) :: instrs ->
+     let extern_name =
+       if Env.is_extern f ctx.tc_env "c" then
+         Some (Env.get_extern f ctx.tc_env "c")
+       else if extern then
+         Some (string_of_id f)
+       else None
+     in
+     begin match extern_name with
+     | Some name ->
+        iraw ("printf(\"!"
+              ^ trace_clexp x
+              ^ " = "
+              ^ string_of_id f ^ "(" ^ Util.string_of_list ", " (fun cval -> String.escaped (trace_cval cval)) args ^ ")\\n\");")
+        :: I_aux (I_funcall (x, extern, f, args), aux)
+        :: smt_trace_instrs ctx function_id instrs
+     | None ->
+        iraw ("printf(\"!call " ^ string_of_id f ^ "(" ^ Util.string_of_list ", " (fun cval -> String.escaped (trace_cval cval)) args ^ ")\\n\");")
+        :: I_aux (I_funcall (x, extern, f, args), aux)
+        :: iraw ("printf(\"!" ^ trace_clexp x ^ " = endcall " ^ string_of_id f ^ "\\n\");")
+        :: smt_trace_instrs ctx function_id instrs
+     end
+
+  | I_aux (I_return cval, aux) :: instrs ->
+     iraw ("printf(\"!return " ^ trace_cval cval ^ "\\n\");")
+     :: I_aux (I_return cval, aux)
+     :: smt_trace_instrs ctx function_id instrs
+
+  | instr :: instrs -> instr :: smt_trace_instrs ctx function_id instrs
+
+  | [] -> []
+
+let smt_trace ctx =
+  function
+  | CDEF_fundef (function_id, heap_return, args, body) ->
+     let string_of_heap_return = function
+       | Some id -> Util.zencode_string (string_of_id id)
+       | None -> "return"
+     in
+     let body =
+       iraw ("printf(\"!link " ^ string_of_heap_return heap_return ^ "(" ^ Util.string_of_list ", " (fun id -> Util.zencode_string (string_of_id id)) args ^ ")\\n\");")
+       :: smt_trace_instrs ctx function_id body
+     in
+     CDEF_fundef (function_id, heap_return, args, body)
+
+  | cdef -> cdef
+
 let compile_ast ctx c_includes (Defs defs) =
   try
     c_debug (lazy (Util.log_line __MODULE__ __LINE__ "Identifying recursive functions"));
@@ -3367,12 +3483,30 @@ let compile_ast ctx c_includes (Defs defs) =
     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
+
+    if !opt_memo_cache then
+      (try
+         if Sys.is_directory "_sbuild" then
+           ()
+         else
+           raise (Reporting.err_general Parse_ast.Unknown "_sbuild exists, but is a file not a directory!")
+       with
+       | Sys_error _ -> Unix.mkdir "_sbuild" 0o775)
+    else ();
+
+    let total = List.length defs in
+    let _, chunks, ctx =
+      List.fold_left (fun (n, chunks, ctx) def -> let defs, ctx = compile_def n total ctx def in n + 1, defs :: chunks, ctx) (1, [], 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 cdefs = if !opt_smt_trace then List.map (fun cdef -> smt_trace ctx (flatten_cdef cdef)) cdefs else cdefs in
+
     let docs = List.map (codegen_def ctx) cdefs in
 
     let preamble = separate hardline
@@ -3465,4 +3599,4 @@ let compile_ast ctx c_includes (Defs defs) =
                                  ^^ model_main)
     |> print_endline
   with
-    Type_error (l, err) -> c_error ("Unexpected type error when compiling to C:\n" ^ Type_error.string_of_type_error err)
+    Type_error (_, l, err) -> c_error ("Unexpected type error when compiling to C:\n" ^ Type_error.string_of_type_error err)
diff --git a/src/c_backend.mli b/src/c_backend.mli
index 24f6e03b..10bf9f40 100644
--- a/src/c_backend.mli
+++ b/src/c_backend.mli
@@ -56,9 +56,19 @@ open Type_check
 val opt_debug_flow_graphs : bool ref
 val opt_debug_function : string ref
 val opt_trace : bool ref
+val opt_smt_trace : bool ref
 val opt_static : bool ref
 val opt_no_main : bool ref
 
+(** [opt_memo_cache] will store the compiled function definitions in
+   file _sbuild/ccacheDIGEST where DIGEST is the md5sum of the
+   original function to be compiled. Enabled using the -memo
+   flag. Uses Marshal so it's quite picky about the exact version of
+   the Sail version. This cache can obviously become stale if the C
+   backend changes - it'll load an old version compiled without said
+   changes. *)
+val opt_memo_cache : bool ref
+
 (** Optimization flags *)
 
 val optimize_primops : bool ref
diff --git a/src/constant_fold.ml b/src/constant_fold.ml
index f232067c..031493a4 100644
--- a/src/constant_fold.ml
+++ b/src/constant_fold.ml
@@ -169,7 +169,7 @@ let rec rewrite_constant_function_calls' env ast =
         let v = run (Interpreter.Step (lazy "", (lstate, gstate), initial_monad, [])) in
         let exp = exp_of_value v in
         try (ok (); Type_check.check_exp (env_of_annot annot) exp (typ_of_annot annot)) with
-        | Type_error (l, err) ->
+        | Type_error (env, l, err) ->
            (* A type error here would be unexpected, so don't ignore it! *)
            Util.warn ("Type error when folding constants in "
                       ^ string_of_exp (E_aux (e_aux, annot))
diff --git a/src/constraint.ml b/src/constraint.ml
index b7e3cb47..b7fa50c3 100644
--- a/src/constraint.ml
+++ b/src/constraint.ml
@@ -53,6 +53,8 @@ open Ast
 open Ast_util
 open Util
 
+let opt_smt_verbose = ref false
+
 (* 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
@@ -186,7 +188,9 @@ let call_z3' l vars constraints : smt_result =
   let problems = [constraints] in
   let z3_file, _ = smtlib_of_constraints l vars constraints in
 
-  (* prerr_endline (Printf.sprintf "SMTLIB2 constraints are: \n%s%!" z3_file); *)
+  if !opt_smt_verbose then
+    prerr_endline (Printf.sprintf "SMTLIB2 constraints are: \n%s%!" z3_file)
+  else ();
 
   let rec input_lines chan = function
     | 0 -> []
@@ -205,12 +209,21 @@ let call_z3' l vars constraints : smt_result =
   with
   | Not_found ->
     begin
-      let (input_file, tmp_chan) = Filename.open_temp_file "constraint_" ".sat" in
+      let (input_file, tmp_chan) =
+        try Filename.open_temp_file "constraint_" ".sat" with
+        | Sys_error msg -> raise (Reporting.err_general l ("Could not open temp file when calling Z3: " ^ msg))
+      in
       output_string tmp_chan z3_file;
       close_out tmp_chan;
-      let z3_chan = Unix.open_process_in ("z3 -t:1000 -T:10 " ^ input_file) in
-      let z3_output = List.combine problems (input_lines z3_chan (List.length problems)) in
-      let _ = Unix.close_process_in z3_chan in
+      let z3_output =
+        try
+          let z3_chan = Unix.open_process_in ("z3 -t:1000 -T:10 " ^ input_file) in
+          let z3_output = List.combine problems (input_lines z3_chan (List.length problems)) in
+          let _ = Unix.close_process_in z3_chan in
+          z3_output
+        with
+        | exn -> raise (Reporting.err_general l ("Error when calling z3: " ^ Printexc.to_string exn))
+      in
       Sys.remove input_file;
       try
         let (problem, _) = List.find (fun (_, result) -> result = "unsat") z3_output in
@@ -249,9 +262,16 @@ let rec solve_z3 l vars constraints var =
   let (input_file, tmp_chan) = Filename.open_temp_file "constraint_" ".sat" in
   output_string tmp_chan z3_file;
   close_out tmp_chan;
-  let z3_chan = Unix.open_process_in ("z3 -t:1000 -T:10 " ^ input_file) in
-  let z3_output = String.concat " " (input_all z3_chan) in
-  let _ = Unix.close_process_in z3_chan in
+  let z3_output =
+    try
+      let z3_chan = Unix.open_process_in ("z3 -t:1000 -T:10 " ^ input_file) in
+      let z3_output = String.concat " " (input_all z3_chan) in
+      let _ = Unix.close_process_in z3_chan in
+      z3_output
+    with
+    | exn ->
+       raise (Reporting.err_general l ("Got error when calling z3: " ^ Printexc.to_string exn))
+  in
   Sys.remove input_file;
   let regexp = {|(define-fun |} ^ z3_var ^ {| () Int[ ]+\([0-9]+\))|} in
   try
diff --git a/src/constraint.mli b/src/constraint.mli
index 51088245..fa318c35 100644
--- a/src/constraint.mli
+++ b/src/constraint.mli
@@ -52,6 +52,8 @@ module Big_int = Nat_big_num
 open Ast
 open Ast_util
 
+val opt_smt_verbose : bool ref
+
 type smt_result = Unknown | Sat | Unsat
 
 val load_digests : unit -> unit
diff --git a/src/error_format.ml b/src/error_format.ml
new file mode 100644
index 00000000..8e00c2b7
--- /dev/null
+++ b/src/error_format.ml
@@ -0,0 +1,131 @@
+
+let rec skip_lines in_chan = function
+  | n when n <= 0 -> ()
+  | n -> ignore (input_line in_chan); skip_lines in_chan (n - 1)
+
+let rec read_lines in_chan = function
+  | n when n <= 0 -> []
+  | n ->
+     let l = input_line in_chan in
+     let ls = read_lines in_chan (n - 1) in
+     l :: ls
+
+type formatter = {
+    indent : string;
+    endline : string -> unit;
+    loc_color : string -> string
+  }
+
+let err_formatter = {
+    indent = "";
+    endline = prerr_endline;
+    loc_color = Util.red
+  }
+
+let buffer_formatter b = {
+    indent = "";
+    endline = (fun str -> Buffer.add_string b (str ^ "\n"));
+    loc_color = Util.red
+  }
+
+let format_endline str ppf = ppf.endline (ppf.indent ^ (Str.global_replace (Str.regexp_string "\n") ("\n" ^ ppf.indent) str))
+
+let underline_single color cnum_from cnum_to =
+  if (cnum_from + 1) >= cnum_to then
+    Util.(String.make cnum_from ' ' ^ clear (color "^"))
+  else
+    Util.(String.make cnum_from ' ' ^ clear (color ("^" ^ String.make (cnum_to - cnum_from - 2) '-' ^ "^")))
+
+let format_code_single' fname in_chan lnum cnum_from cnum_to contents ppf =
+  skip_lines in_chan (lnum - 1);
+  let line = input_line in_chan in
+  let line_prefix = string_of_int lnum ^ Util.(clear (cyan " |")) in
+  let blank_prefix = String.make (String.length (string_of_int lnum)) ' ' ^ Util.(clear (ppf.loc_color " |")) in
+  format_endline (Printf.sprintf "[%s]:%d:%d-%d" Util.(fname |> cyan |> clear) lnum cnum_from cnum_to) ppf;
+  format_endline (line_prefix ^ line) ppf;
+  format_endline (blank_prefix ^ underline_single ppf.loc_color cnum_from cnum_to) ppf;
+  contents { ppf with indent = blank_prefix ^ " " }
+
+let underline_double_from color cnum_from eol =
+  Util.(String.make cnum_from ' ' ^ clear (color ("^" ^ String.make (eol - cnum_from - 1) '-')))
+
+let underline_double_to color cnum_to =
+  Util.(clear (color (String.make (cnum_to - 1) '-' ^ "^")))
+
+let format_code_double' fname in_chan lnum_from cnum_from lnum_to cnum_to contents ppf =
+  skip_lines in_chan (lnum_from - 1);
+  let line_from = input_line in_chan in
+  skip_lines in_chan (lnum_to - lnum_from - 1);
+  let line_to = input_line in_chan in
+  let line_to_prefix = string_of_int lnum_to ^ Util.(clear (cyan " |")) in
+  let line_from_padding = String.make (String.length (string_of_int lnum_to) - String.length (string_of_int lnum_from)) ' ' in
+  let line_from_prefix = string_of_int lnum_from ^ line_from_padding ^ Util.(clear (cyan " |")) in
+  let blank_prefix = String.make (String.length (string_of_int lnum_to)) ' ' ^ Util.(clear (ppf.loc_color " |")) in
+  format_endline (Printf.sprintf "[%s]:%d:%d-%d:%d" Util.(fname |> cyan |> clear) lnum_from cnum_from lnum_to cnum_to) ppf;
+  format_endline (line_from_prefix ^ line_from) ppf;
+  format_endline (blank_prefix ^ underline_double_from ppf.loc_color cnum_from (String.length line_from)) ppf;
+  format_endline (line_to_prefix ^ line_to) ppf;
+  format_endline (blank_prefix ^ underline_double_to ppf.loc_color cnum_to) ppf;
+  contents { ppf with indent = blank_prefix ^ " " }
+
+let format_code_single fname lnum cnum_from cnum_to contents ppf =
+  try
+    let in_chan = open_in fname in
+    begin
+      try format_code_single' fname in_chan lnum cnum_from cnum_to contents ppf; close_in in_chan
+      with
+      | _ -> close_in_noerr in_chan; ()
+    end
+  with
+  | _ -> ()
+
+let format_code_double fname lnum_from cnum_from lnum_to cnum_to contents ppf =
+  try
+    let in_chan = open_in fname in
+    begin
+      try format_code_double' fname in_chan lnum_from cnum_from lnum_to cnum_to contents ppf; close_in in_chan
+      with
+      | _ -> close_in_noerr in_chan; ()
+    end
+  with
+  | _ -> ()
+
+let format_pos p1 p2 contents ppf =
+  let open Lexing in
+  if p1.pos_lnum == p2.pos_lnum
+  then format_code_single p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) (p2.pos_cnum - p2.pos_bol) contents ppf
+  else format_code_double p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) p2.pos_lnum (p2.pos_cnum - p2.pos_bol) contents ppf
+
+let rec format_loc l contents =
+  match l with
+  | Parse_ast.Unknown -> contents
+  | Parse_ast.Range (p1, p2) -> format_pos p1 p2 contents
+  | Parse_ast.Unique (_, l) -> format_loc l contents
+  | Parse_ast.Documented (_, l) -> format_loc l contents
+  | Parse_ast.Generated l ->
+     fun ppf -> (format_endline "Code generated nearby:" ppf; format_loc l contents ppf)
+
+type message =
+  | Location of Parse_ast.l * message
+  | Line of string
+  | List of (string * message) list
+  | Seq of message list
+  | With of (formatter -> formatter) * message
+
+let bullet = Util.(clear (blue "*"))
+
+let rec format_message msg ppf =
+  match msg with
+  | Location (l, msg) ->
+     format_loc l (format_message msg) ppf
+  | Line str ->
+     format_endline str ppf
+  | Seq messages ->
+     List.iter (fun msg -> format_message msg ppf) messages
+  | List list ->
+     let format_list_item ppf (header, msg) =
+       format_endline (Util.(clear (blue "*")) ^ " " ^ header) ppf;
+       format_message msg { ppf with indent = ppf.indent ^ "   " }
+     in
+     List.iter (format_list_item ppf) list
+  | With (f, msg) -> format_message msg (f ppf)
diff --git a/src/extra_pervasives.ml b/src/extra_pervasives.ml
deleted file mode 100644
index 8001c647..00000000
--- a/src/extra_pervasives.ml
+++ /dev/null
@@ -1,52 +0,0 @@
-(**************************************************************************)
-(*     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 unreachable l pos msg =
-  raise (Reporting.err_unreachable l pos msg)
diff --git a/src/finite_map.ml b/src/finite_map.ml
deleted file mode 100644
index 444e3790..00000000
--- a/src/finite_map.ml
+++ /dev/null
@@ -1,216 +0,0 @@
-(**************************************************************************)
-(*     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.                                                          *)
-(**************************************************************************)
-
-
-(**************************************************************************)
-(*                        Lem                                             *)
-(*                                                                        *)
-(*          Dominic Mulligan, University of Cambridge                     *)
-(*          Francesco Zappa Nardelli, INRIA Paris-Rocquencourt            *)
-(*          Gabriel Kerneis, University of Cambridge                      *)
-(*          Kathy Gray, University of Cambridge                           *)
-(*          Peter Boehm, University of Cambridge (while working on Lem)   *)
-(*          Peter Sewell, University of Cambridge                         *)
-(*          Scott Owens, University of Kent                               *)
-(*          Thomas Tuerk, University of Cambridge                         *)
-(*                                                                        *)
-(*  The Lem sources are copyright 2010-2013                               *)
-(*  by the UK authors above and Institut National de Recherche en         *)
-(*  Informatique et en Automatique (INRIA).                               *)
-(*                                                                        *)
-(*  All files except ocaml-lib/pmap.{ml,mli} and ocaml-libpset.{ml,mli}   *)
-(*  are distributed under the license below.  The former are distributed  *)
-(*  under the LGPLv2, as in the LICENSE file.                             *)
-(*                                                                        *)
-(*                                                                        *)
-(*  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.  *)
-(*  3. The names of the authors may not be used to endorse or promote     *)
-(*  products derived from this software without specific prior written    *)
-(*  permission.                                                           *)
-(*                                                                        *)
-(*  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.                         *)
-(**************************************************************************)
-
-
-(** finite map library *)
-
-module type Fmap = sig
-  type k
-  module S : Set.S with type elt = k
-  type 'a t
-  val empty : 'a t
-  val is_empty : 'a t -> bool
-  val from_list : (k * 'a) list -> 'a t
-  val to_list : 'a t -> (k * 'a) list 
-  val from_list2 : k list -> 'a list -> 'a t
-  val insert : 'a t -> (k * 'a) -> 'a t
-  (* Keys from the right argument replace those from the left *)
-  val union : 'a t -> 'a t -> 'a t
-  (* Function merges the stored value when a key is in the right and the left map *)
-  val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
-  val intersect : 'a t -> 'a t -> 'a t
-  (* Function merges the stored values for shared keys *)
-  val intersect_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
-  val big_union : 'a t list -> 'a t
-  val big_union_merge : ('a -> 'a -> 'a) -> 'a t list -> 'a t
-  val difference : 'a t -> 'a t -> 'a t
-  val merge : (k -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
-  val apply : 'a t -> k -> 'a option
-  val in_dom : k -> 'a t -> bool
-  val map : (k -> 'a -> 'b) -> 'a t -> 'b t
-  val domains_overlap : 'a t -> 'b t -> k option
-  val domains_disjoint : 'a t list -> bool
-  val iter : (k -> 'a -> unit) -> 'a t -> unit
-  val fold : ('b -> k -> 'a -> 'b) -> 'b -> 'a t -> 'b
-  val remove : 'a t -> k -> 'a t
-  val pp_map : (Format.formatter -> k -> unit) -> 
-               (Format.formatter -> 'a -> unit) -> 
-               Format.formatter -> 
-               'a t ->
-               unit
-  val domain : 'a t -> S.t
-end
-
-module Fmap_map(Key : Set.OrderedType) : Fmap 
-                  with type k = Key.t and module S = Set.Make(Key) = struct
-
-  type k = Key.t
-  module S = Set.Make(Key)
-
-  module M = Map.Make(Key)
-  module D = Util.Duplicate(S)
-
-  type 'a t = 'a M.t
-  let empty = M.empty
-  let is_empty m = M.is_empty m
-  let from_list l = List.fold_left (fun m (k,v) -> M.add k v m) M.empty l
-  let from_list2 l1 l2 = List.fold_left2 (fun m k v -> M.add k v m) M.empty l1 l2
-  let insert m (k,v) = M.add k v m
-  let union m1 m2 = 
-    M.merge (fun k v1 v2 -> match v2 with | None -> v1 | Some _ -> v2) m1 m2
-  let union_merge f m1 m2 =
-    M.merge (fun k v1 v2 -> 
-      match v1,v2 with 
-	| None,None -> None
-	| None,Some v | Some v,None -> Some v
-	| Some v1, Some v2 -> Some (f v1 v2)) m1 m2
-  let merge f m1 m2 = M.merge f m1 m2
-  let apply m k = 
-    try
-      Some(M.find k m)
-    with
-      | Not_found -> None
-  let in_dom k m = M.mem k m
-  let map f m = M.mapi f m
-  let rec domains_overlap m1 m2 = 
-    M.fold 
-      (fun k _ res ->
-         if M.mem k m1 then
-           Some(k)
-         else
-           res)
-      m2
-      None
-  let iter f m = M.iter f m
-  let fold f m base = M.fold (fun k v res -> f res k v) base m
-  let difference m1 m2 = 
-    M.fold (fun k v res ->
-      if (M.mem k m2) 
-      then res
-      else M.add k v res) m1 M.empty
-  let intersect m1 m2 = 
-    M.fold (fun k v res -> 
-      if (M.mem k m2)
-      then M.add k v res
-      else res) m1 M.empty
-  let intersect_merge f m1 m2 = 
-    M.fold (fun k v res -> 
-      match (apply m2 k) with
-	| None -> res
-	| Some v2 -> M.add k (f v v2) res) m1 M.empty
-  let to_list m = M.fold (fun k v res -> (k,v)::res) m []
-  let remove m k = M.remove k m
-  let pp_map pp_key pp_val ppf m =
-    let l = M.fold (fun k v l -> (k,v)::l) m [] in
-      Format.fprintf ppf "@[%a@]"
-        (Pp.lst "@\n"
-           (fun ppf (k,v) -> 
-              Format.fprintf ppf "@[<2>%a@ |->@ %a@]"
-                pp_key k
-                pp_val v))
-        l
-  let big_union l = List.fold_left union empty l
-  let big_union_merge f l = List.fold_left (union_merge f) empty l
-  let domains_disjoint maps =
-    match D.duplicates (List.concat (List.map (fun m -> List.map fst (M.bindings m)) maps)) with
-      | D.No_dups _ -> true
-      | D.Has_dups _ -> false
-
-  let domain m =
-    M.fold (fun k _ s -> S.add k s) m S.empty
-end
-
diff --git a/src/gen_lib/sail2_prompt.lem b/src/gen_lib/sail2_prompt.lem
index e01cc051..3cde7ade 100644
--- a/src/gen_lib/sail2_prompt.lem
+++ b/src/gen_lib/sail2_prompt.lem
@@ -38,6 +38,11 @@ end
 
 declare {isabelle} termination_argument foreachM = automatic
 
+val genlistM : forall 'a 'rv 'e. (nat -> monad 'rv 'a 'e) -> nat -> monad 'rv (list 'a) 'e
+let genlistM f n =
+  let indices = genlist (fun n -> n) n in
+  foreachM indices [] (fun n xs -> (f n >>= (fun x -> return (xs ++ [x]))))
+
 val and_boolM : forall 'rv 'e. monad 'rv bool 'e -> monad 'rv bool 'e -> monad 'rv bool 'e
 let and_boolM l r = l >>= (fun l -> if l then r else return false)
 
@@ -55,7 +60,7 @@ val bool_of_bitU_nondet : forall 'rv 'e. bitU -> monad 'rv bool 'e
 let bool_of_bitU_nondet = function
   | B0 -> return false
   | B1 -> return true
-  | BU -> undefined_bool ()
+  | BU -> choose_bool "bool_of_bitU"
 end
 
 val bools_of_bits_nondet : forall 'rv 'e. list bitU -> monad 'rv (list bool) 'e
@@ -93,16 +98,25 @@ let rec untilM vars cond body =
   cond vars >>= fun cond_val ->
   if cond_val then return vars else untilM vars cond body
 
-val internal_pick : forall 'rv 'a 'e. list 'a -> monad 'rv 'a 'e
-let internal_pick xs =
-  (* Use sufficiently many undefined bits and convert into an index into the list *)
-  bools_of_bits_nondet (repeat [BU] (length_list xs)) >>= fun bs ->
+val choose_bools : forall 'rv 'e. string -> nat -> monad 'rv (list bool) 'e
+let choose_bools descr n = genlistM (fun _ -> choose_bool descr) n
+
+val choose : forall 'rv 'a 'e. string -> list 'a -> monad 'rv 'a 'e
+let choose descr xs =
+  (* Use sufficiently many nondeterministically chosen bits and convert into an
+     index into the list *)
+  choose_bools descr (List.length xs) >>= fun bs ->
   let idx = (natFromNatural (nat_of_bools bs)) mod List.length xs in
   match index xs idx with
     | Just x -> return x
-    | Nothing -> Fail "internal_pick"
+    | Nothing -> Fail ("choose " ^ descr)
   end
 
+declare {isabelle} rename function choose = chooseM
+
+val internal_pick : forall 'rv 'a 'e. list 'a -> monad 'rv 'a 'e
+let internal_pick xs = choose "internal_pick" xs
+
 (*let write_two_regs r1 r2 vec =
   let is_inc =
     let is_inc_r1 = is_inc_of_reg r1 in
diff --git a/src/gen_lib/sail2_prompt_monad.lem b/src/gen_lib/sail2_prompt_monad.lem
index 78b1615e..e0ac09f6 100644
--- a/src/gen_lib/sail2_prompt_monad.lem
+++ b/src/gen_lib/sail2_prompt_monad.lem
@@ -8,19 +8,20 @@ type address = list bitU
 
 type monad 'regval 'a 'e =
   | Done of 'a
-  (* Read a number of bytes from memory, returned in little endian order *)
-  | Read_mem of read_kind * address * nat * (list memory_byte -> monad 'regval 'a 'e)
-  (* Read the tag of a memory address *)
-  | Read_tag of address * (bitU -> monad 'regval 'a 'e)
-  (* Tell the system a write is imminent, at address lifted, of size nat *)
-  | Write_ea of write_kind * address * nat * monad 'regval 'a 'e
+  (* Read a number of bytes from memory, returned in little endian order,
+     with or without a tag.  The first nat specifies the address, the second
+     the number of bytes. *)
+  | Read_mem of read_kind * nat * nat * (list memory_byte -> monad 'regval 'a 'e)
+  | Read_memt of read_kind * nat * nat * ((list memory_byte * bitU) -> monad 'regval 'a 'e)
+  (* Tell the system a write is imminent, at the given address and with the
+     given size. *)
+  | Write_ea of write_kind * nat * nat * monad 'regval 'a 'e
   (* Request the result of store-exclusive *)
   | Excl_res of (bool -> monad 'regval 'a 'e)
-  (* Request to write memory at last signalled address. Memory value should be 8
-     times the size given in ea signal, given in little endian order *)
-  | Write_memv of list memory_byte * (bool -> monad 'regval 'a 'e)
-  (* Request to write the tag at given address. *)
-  | Write_tag of address * bitU * (bool -> monad 'regval 'a 'e)
+  (* Request to write a memory value of the given size at the given address,
+     with or without a tag. *)
+  | Write_mem of write_kind * nat * nat * list memory_byte * (bool -> monad 'regval 'a 'e)
+  | Write_memt of write_kind * nat * nat * list memory_byte * bitU * (bool -> monad 'regval 'a 'e)
   (* Tell the system to dynamically recalculate dependency footprint *)
   | Footprint of monad 'regval 'a 'e
   (* Request a memory barrier *)
@@ -29,8 +30,10 @@ type monad 'regval 'a 'e =
   | Read_reg of register_name * ('regval -> monad 'regval 'a 'e)
   (* Request to write register *)
   | Write_reg of register_name * 'regval * monad 'regval 'a 'e
-  (* Request to choose a Boolean, e.g. to resolve an undefined bit *)
-  | Undefined of (bool -> monad 'regval 'a 'e)
+  (* Request to choose a Boolean, e.g. to resolve an undefined bit. The string
+     argument may be used to provide information to the system about what the
+     Boolean is going to be used for. *)
+  | Choose of string * (bool -> monad 'regval 'a 'e)
   (* Print debugging or tracing information *)
   | Print of string * monad 'regval 'a 'e
   (*Result of a failed assert with possible error message to report*)
@@ -38,33 +41,52 @@ type monad 'regval 'a 'e =
   (* Exception of type 'e *)
   | Exception of 'e
 
+type event 'regval =
+  | E_read_mem of read_kind * nat * nat * list memory_byte
+  | E_read_memt of read_kind * nat * nat * (list memory_byte * bitU)
+  | E_write_mem of write_kind * nat * nat * list memory_byte * bool
+  | E_write_memt of write_kind * nat * nat * list memory_byte * bitU * bool
+  | E_write_ea of write_kind * nat * nat
+  | E_excl_res of bool
+  | E_barrier of barrier_kind
+  | E_footprint
+  | E_read_reg of register_name * 'regval
+  | E_write_reg of register_name * 'regval
+  | E_choose of string * bool
+  | E_print of string
+
+type trace 'regval = list (event 'regval)
+
 val return : forall 'rv 'a 'e. 'a -> monad 'rv 'a 'e
 let return a = Done a
 
 val bind : forall 'rv 'a 'b 'e. monad 'rv 'a 'e -> ('a -> monad 'rv 'b 'e) -> monad 'rv 'b 'e
 let rec bind m f = match m with
   | Done a -> f a
-  | Read_mem rk a sz k -> Read_mem rk a sz (fun v -> bind (k v) f)
-  | Read_tag a k ->       Read_tag a       (fun v -> bind (k v) f)
-  | Write_memv descr k -> Write_memv descr (fun v -> bind (k v) f)
-  | Write_tag a t k ->    Write_tag a t    (fun v -> bind (k v) f)
-  | Read_reg descr k ->   Read_reg descr   (fun v -> bind (k v) f)
-  | Excl_res k ->         Excl_res         (fun v -> bind (k v) f)
-  | Undefined k ->        Undefined        (fun v -> bind (k v) f)
-  | Write_ea wk a sz k -> Write_ea wk a sz (bind k f)
-  | Footprint k ->        Footprint        (bind k f)
-  | Barrier bk k ->       Barrier bk       (bind k f)
-  | Write_reg r v k ->    Write_reg r v    (bind k f)
-  | Print msg k ->        Print msg        (bind k f)
-  | Fail descr ->         Fail descr
-  | Exception e ->        Exception e
+  | Read_mem rk a sz k ->       Read_mem rk a sz       (fun v -> bind (k v) f)
+  | Read_memt rk a sz k ->      Read_memt rk a sz      (fun v -> bind (k v) f)
+  | Write_mem wk a sz v k ->    Write_mem wk a sz v    (fun v -> bind (k v) f)
+  | Write_memt wk a sz v t k -> Write_memt wk a sz v t (fun v -> bind (k v) f)
+  | Read_reg descr k ->         Read_reg descr         (fun v -> bind (k v) f)
+  | Excl_res k ->               Excl_res               (fun v -> bind (k v) f)
+  | Choose descr k ->           Choose descr           (fun v -> bind (k v) f)
+  | Write_ea wk a sz k ->       Write_ea wk a sz       (bind k f)
+  | Footprint k ->              Footprint              (bind k f)
+  | Barrier bk k ->             Barrier bk             (bind k f)
+  | Write_reg r v k ->          Write_reg r v          (bind k f)
+  | Print msg k ->              Print msg              (bind k f)
+  | Fail descr ->               Fail descr
+  | Exception e ->              Exception e
 end
 
 val exit : forall 'rv 'a 'e. unit -> monad 'rv 'a 'e
 let exit () = Fail "exit"
 
+val choose_bool : forall 'rv 'e. string -> monad 'rv bool 'e
+let choose_bool descr = Choose descr return
+
 val undefined_bool : forall 'rv 'e. unit -> monad 'rv bool 'e
-let undefined_bool () = Undefined return
+let undefined_bool () = choose_bool "undefined_bool"
 
 val assert_exp : forall 'rv 'e. bool -> string -> monad 'rv unit 'e
 let assert_exp exp msg = if exp then Done () else Fail msg
@@ -74,21 +96,21 @@ let throw e = Exception e
 
 val try_catch : forall 'rv 'a 'e1 'e2. monad 'rv 'a 'e1 -> ('e1 -> monad 'rv 'a 'e2) -> monad 'rv 'a 'e2
 let rec try_catch m h = match m with
-  | Done a ->             Done a
-  | Read_mem rk a sz k -> Read_mem rk a sz (fun v -> try_catch (k v) h)
-  | Read_tag a k ->       Read_tag a       (fun v -> try_catch (k v) h)
-  | Write_memv descr k -> Write_memv descr (fun v -> try_catch (k v) h)
-  | Write_tag a t k ->    Write_tag a t    (fun v -> try_catch (k v) h)
-  | Read_reg descr k ->   Read_reg descr   (fun v -> try_catch (k v) h)
-  | Excl_res k ->         Excl_res         (fun v -> try_catch (k v) h)
-  | Undefined k ->        Undefined        (fun v -> try_catch (k v) h)
-  | Write_ea wk a sz k -> Write_ea wk a sz (try_catch k h)
-  | Footprint k ->        Footprint        (try_catch k h)
-  | Barrier bk k ->       Barrier bk       (try_catch k h)
-  | Write_reg r v k ->    Write_reg r v    (try_catch k h)
-  | Print msg k ->        Print msg        (try_catch k h)
-  | Fail descr ->         Fail descr
-  | Exception e ->        h e
+  | Done a -> Done a
+  | Read_mem rk a sz k ->       Read_mem rk a sz       (fun v -> try_catch (k v) h)
+  | Read_memt rk a sz k ->      Read_memt rk a sz      (fun v -> try_catch (k v) h)
+  | Write_mem wk a sz v k ->    Write_mem wk a sz v    (fun v -> try_catch (k v) h)
+  | Write_memt wk a sz v t k -> Write_memt wk a sz v t (fun v -> try_catch (k v) h)
+  | Read_reg descr k ->         Read_reg descr         (fun v -> try_catch (k v) h)
+  | Excl_res k ->               Excl_res               (fun v -> try_catch (k v) h)
+  | Choose descr k ->           Choose descr           (fun v -> try_catch (k v) h)
+  | Write_ea wk a sz k ->       Write_ea wk a sz       (try_catch k h)
+  | Footprint k ->              Footprint              (try_catch k h)
+  | Barrier bk k ->             Barrier bk             (try_catch k h)
+  | Write_reg r v k ->          Write_reg r v          (try_catch k h)
+  | Print msg k ->              Print msg              (try_catch k h)
+  | Fail descr ->               Fail descr
+  | Exception e ->              h e
 end
 
 (* For early return, we abuse exceptions by throwing and catching
@@ -126,19 +148,37 @@ let maybe_fail msg = function
   | Nothing -> Fail msg
 end
 
+val read_memt_bytes : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv (list memory_byte * bitU) 'e
+let read_memt_bytes rk addr sz =
+  bind
+    (maybe_fail "nat_of_bv" (nat_of_bv addr))
+    (fun addr -> Read_memt rk addr (nat_of_int sz) return)
+
+val read_memt : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv ('b * bitU) 'e
+let read_memt rk addr sz =
+  bind
+    (read_memt_bytes rk addr sz)
+    (fun (bytes, tag) ->
+       match of_bits (bits_of_mem_bytes bytes) with
+         | Just v -> return (v, tag)
+         | Nothing -> Fail "bits_of_mem_bytes"
+       end)
+
 val read_mem_bytes : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv (list memory_byte) 'e
 let read_mem_bytes rk addr sz =
-  Read_mem rk (bits_of addr) (nat_of_int sz) return
+  bind
+    (maybe_fail "nat_of_bv" (nat_of_bv addr))
+    (fun addr -> Read_mem rk addr (nat_of_int sz) return)
 
 val read_mem : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monad 'rv 'b 'e
 let read_mem rk addr sz =
   bind
     (read_mem_bytes rk addr sz)
     (fun bytes ->
-       maybe_fail "bits_of_mem_bytes" (of_bits (bits_of_mem_bytes bytes)))
-
-val read_tag : forall 'rv 'a 'e. Bitvector 'a => 'a -> monad 'rv bitU 'e
-let read_tag addr = Read_tag (bits_of addr) return
+       match of_bits (bits_of_mem_bytes bytes) with
+         | Just v -> return v
+         | Nothing -> Fail "bits_of_mem_bytes"
+       end)
 
 val excl_result : forall 'rv 'e. unit -> monad 'rv bool 'e
 let excl_result () =
@@ -146,16 +186,28 @@ let excl_result () =
   Excl_res k
 
 val write_mem_ea : forall 'rv 'a 'e. Bitvector 'a => write_kind -> 'a -> integer -> monad 'rv unit 'e
-let write_mem_ea wk addr sz = Write_ea wk (bits_of addr) (nat_of_int sz) (Done ())
-
-val write_mem_val : forall 'rv 'a 'e. Bitvector 'a => 'a -> monad 'rv bool 'e
-let write_mem_val v = match mem_bytes_of_bits v with
-  | Just v -> Write_memv v return
-  | Nothing -> Fail "write_mem_val"
-end
-
-val write_tag : forall 'rv 'a 'e. Bitvector 'a => 'a -> bitU -> monad 'rv bool 'e
-let write_tag addr b = Write_tag (bits_of addr) b return
+let write_mem_ea wk addr sz =
+  bind
+    (maybe_fail "nat_of_bv" (nat_of_bv addr))
+    (fun addr -> Write_ea wk addr (nat_of_int sz) (Done ()))
+
+val write_mem : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'a -> integer -> 'b -> monad 'rv bool 'e
+let write_mem wk addr sz v =
+  match (mem_bytes_of_bits v, nat_of_bv addr) with
+    | (Just v, Just addr) ->
+       Write_mem wk addr (nat_of_int sz) v return
+    | _ -> Fail "write_mem"
+  end
+
+val write_memt : forall 'rv 'a 'b 'e. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'a -> integer -> 'b -> bitU -> monad 'rv bool 'e
+let write_memt wk addr sz v tag =
+  match (mem_bytes_of_bits v, nat_of_bv addr) with
+    | (Just v, Just addr) ->
+       Write_memt wk addr (nat_of_int sz) v tag return
+    | _ -> Fail "write_mem"
+  end
 
 val read_reg : forall 's 'rv 'a 'e. register_ref 's 'rv 'a -> monad 'rv 'a 'e
 let read_reg reg =
@@ -214,6 +266,68 @@ let barrier bk = Barrier bk (Done ())
 val footprint : forall 'rv 'e. unit -> monad 'rv unit 'e
 let footprint _ = Footprint (Done ())
 
+(* Event traces *)
+
+val emitEvent : forall 'regval 'a 'e. Eq 'regval => monad 'regval 'a 'e -> event 'regval -> maybe (monad 'regval 'a 'e)
+let emitEvent m e = match (e, m) with
+  | (E_read_mem rk a sz v, Read_mem rk' a' sz' k) ->
+     if rk' = rk && a' = a && sz' = sz then Just (k v) else Nothing
+  | (E_read_memt rk a sz vt, Read_memt rk' a' sz' k) ->
+     if rk' = rk && a' = a && sz' = sz then Just (k vt) else Nothing
+  | (E_write_mem wk a sz v r, Write_mem wk' a' sz' v' k) ->
+     if wk' = wk && a' = a && sz' = sz && v' = v then Just (k r) else Nothing
+  | (E_write_memt wk a sz v tag r, Write_memt wk' a' sz' v' tag' k) ->
+     if wk' = wk && a' = a && sz' = sz && v' = v && tag' = tag then Just (k r) else Nothing
+  | (E_read_reg r v, Read_reg r' k) ->
+     if r' = r then Just (k v) else Nothing
+  | (E_write_reg r v, Write_reg r' v' k) ->
+     if r' = r && v' = v then Just k else Nothing
+  | (E_write_ea wk a sz, Write_ea wk' a' sz' k) ->
+     if wk' = wk && a' = a && sz' = sz then Just k else Nothing
+  | (E_barrier bk, Barrier bk' k) ->
+     if bk' = bk then Just k else Nothing
+  | (E_print m, Print m' k) ->
+     if m' = m then Just k else Nothing
+  | (E_excl_res v, Excl_res k) -> Just (k v)
+  | (E_choose descr v, Choose descr' k) -> if descr' = descr then Just (k v) else Nothing
+  | (E_footprint, Footprint k) -> Just k
+  | _ -> Nothing
+end
+
+val runTrace : forall 'regval 'a 'e. Eq 'regval => trace 'regval -> monad 'regval 'a 'e -> maybe (monad 'regval 'a 'e)
+let rec runTrace t m = match t with
+  | [] -> Just m
+  | e :: t' -> Maybe.bind (emitEvent m e) (runTrace t')
+end
+
+declare {isabelle} termination_argument runTrace = automatic
+
+val final : forall 'regval 'a 'e. monad 'regval 'a 'e -> bool
+let final = function
+  | Done _ -> true
+  | Fail _ -> true
+  | Exception _ -> true
+  | _ -> false
+end
+
+val hasTrace : forall 'regval 'a 'e. Eq 'regval => trace 'regval -> monad 'regval 'a 'e -> bool
+let hasTrace t m = match runTrace t m with
+  | Just m -> final m
+  | Nothing -> false
+end
+
+val hasException : forall 'regval 'a 'e. Eq 'regval => trace 'regval -> monad 'regval 'a 'e -> bool
+let hasException t m = match runTrace t m with
+  | Just (Exception _) -> true
+  | _ -> false
+end
+
+val hasFailure : forall 'regval 'a 'e. Eq 'regval => trace 'regval -> monad 'regval 'a 'e -> bool
+let hasFailure t m = match runTrace t m with
+  | Just (Fail _) -> true
+  | _ -> false
+end
+
 (* Define a type synonym that also takes the register state as a type parameter,
    in order to make switching to the state monad without changing generated
    definitions easier, see also lib/hol/prompt_monad.lem. *)
diff --git a/src/gen_lib/sail2_state.lem b/src/gen_lib/sail2_state.lem
index f703dead..ec787764 100644
--- a/src/gen_lib/sail2_state.lem
+++ b/src/gen_lib/sail2_state.lem
@@ -28,6 +28,11 @@ end
 
 declare {isabelle} termination_argument foreachS = automatic
 
+val genlistS : forall 'a 'rv 'e. (nat -> monadS 'rv 'a 'e) -> nat -> monadS 'rv (list 'a) 'e
+let genlistS f n =
+  let indices = genlist (fun n -> n) n in
+  foreachS indices [] (fun n xs -> (f n >>$= (fun x -> returnS (xs ++ [x]))))
+
 val and_boolS : forall 'rv 'e. monadS 'rv bool 'e -> monadS 'rv bool 'e -> monadS 'rv bool 'e
 let and_boolS l r = l >>$= (fun l -> if l then r else returnS false)
 
@@ -84,12 +89,17 @@ let rec untilS vars cond body s =
   (cond vars >>$= (fun cond_val s'' ->
   if cond_val then returnS vars s'' else untilS vars cond body s'')) s')) s
 
+val choose_boolsS : forall 'rv 'e. nat -> monadS 'rv (list bool) 'e
+let choose_boolsS n = genlistS (fun _ -> choose_boolS ()) n
+
+(* TODO: Replace by chooseS and prove equivalence to prompt monad version *)
 val internal_pickS : forall 'rv 'a 'e. list 'a -> monadS 'rv 'a 'e
 let internal_pickS xs =
-  (* Use sufficiently many undefined bits and convert into an index into the list *)
-  bools_of_bits_nondetS (repeat [BU] (length_list xs)) >>$= fun bs ->
+  (* Use sufficiently many nondeterministically chosen bits and convert into an
+     index into the list *)
+  choose_boolsS (List.length xs) >>$= fun bs ->
   let idx = (natFromNatural (nat_of_bools bs)) mod List.length xs in
   match index xs idx with
     | Just x -> returnS x
-    | Nothing -> failS "internal_pick"
+    | Nothing -> failS "choose internal_pick"
   end
diff --git a/src/gen_lib/sail2_state_lifting.lem b/src/gen_lib/sail2_state_lifting.lem
index 039343e2..98a5390d 100644
--- a/src/gen_lib/sail2_state_lifting.lem
+++ b/src/gen_lib/sail2_state_lifting.lem
@@ -5,23 +5,53 @@ open import Sail2_prompt
 open import Sail2_state_monad
 open import {isabelle} `Sail2_state_monad_lemmas`
 
-(* State monad wrapper around prompt monad *)
-
+(* Lifting from prompt monad to state monad *)
 val liftState : forall 'regval 'regs 'a 'e. register_accessors 'regs 'regval -> monad 'regval 'a 'e -> monadS 'regs 'a 'e
-let rec liftState ra s = match s with
-  | (Done a)             -> returnS a
-  | (Read_mem rk a sz k) -> bindS (read_mem_bytesS rk a sz) (fun v -> liftState ra (k v))
-  | (Read_tag t k)       -> bindS (read_tagS t)             (fun v -> liftState ra (k v))
-  | (Write_memv a k)     -> bindS (write_mem_bytesS a)      (fun v -> liftState ra (k v))
-  | (Write_tag a t k)    -> bindS (write_tagS a t)          (fun v -> liftState ra (k v))
-  | (Read_reg r k)       -> bindS (read_regvalS ra r)       (fun v -> liftState ra (k v))
-  | (Excl_res k)         -> bindS (excl_resultS ())         (fun v -> liftState ra (k v))
-  | (Undefined k)        -> bindS (undefined_boolS ())      (fun v -> liftState ra (k v))
-  | (Write_ea wk a sz k) -> seqS (write_mem_eaS wk a sz)    (liftState ra k)
-  | (Write_reg r v k)    -> seqS (write_regvalS ra r v)     (liftState ra k)
-  | (Footprint k)        -> liftState ra k
-  | (Barrier _ k)        -> liftState ra k
-  | (Print _ k)          -> liftState ra k (* TODO *)
-  | (Fail descr)         -> failS descr
-  | (Exception e)        -> throwS e
+let rec liftState ra m = match m with
+  | (Done a)                   -> returnS a
+  | (Read_mem rk a sz k)       -> bindS (read_mem_bytesS rk a sz)       (fun v -> liftState ra (k v))
+  | (Read_memt rk a sz k)      -> bindS (read_memt_bytesS rk a sz)      (fun v -> liftState ra (k v))
+  | (Write_mem wk a sz v k)    -> bindS (write_mem_bytesS wk a sz v)    (fun v -> liftState ra (k v))
+  | (Write_memt wk a sz v t k) -> bindS (write_memt_bytesS wk a sz v t) (fun v -> liftState ra (k v))
+  | (Read_reg r k)             -> bindS (read_regvalS ra r)             (fun v -> liftState ra (k v))
+  | (Excl_res k)               -> bindS (excl_resultS ())               (fun v -> liftState ra (k v))
+  | (Choose _ k)               -> bindS (choose_boolS ())               (fun v -> liftState ra (k v))
+  | (Write_reg r v k)          -> seqS (write_regvalS ra r v)           (liftState ra k)
+  | (Write_ea _ _ _ k)         -> liftState ra k
+  | (Footprint k)              -> liftState ra k
+  | (Barrier _ k)              -> liftState ra k
+  | (Print _ k)                -> liftState ra k (* TODO *)
+  | (Fail descr)               -> failS descr
+  | (Exception e)              -> throwS e
+end
+
+val emitEventS : forall 'regval 'regs 'a 'e. Eq 'regval => register_accessors 'regs 'regval -> event 'regval -> sequential_state 'regs -> maybe (sequential_state 'regs)
+let emitEventS ra e s = match e with
+  | E_read_mem _ addr sz v ->
+     Maybe.bind (get_mem_bytes addr sz s) (fun (v', _) ->
+     if v' = v then Just s else Nothing)
+  | E_read_memt _ addr sz (v, tag) ->
+     Maybe.bind (get_mem_bytes addr sz s) (fun (v', tag') ->
+     if v' = v && tag' = tag then Just s else Nothing)
+  | E_write_mem _ addr sz v success ->
+     if success then Just (put_mem_bytes addr sz v B0 s) else Nothing
+  | E_write_memt _ addr sz v tag success ->
+     if success then Just (put_mem_bytes addr sz v tag s) else Nothing
+  | E_read_reg r v ->
+     let (read_reg, _) = ra in
+     Maybe.bind (read_reg r s.regstate) (fun v' ->
+     if v' = v then Just s else Nothing)
+  | E_write_reg r v ->
+     let (_, write_reg) = ra in
+     Maybe.bind (write_reg r v s.regstate) (fun rs' ->
+     Just <| s with regstate = rs' |>)
+  | _ -> Just s
 end
+
+val runTraceS : forall 'regval 'regs 'a 'e. Eq 'regval => register_accessors 'regs 'regval -> trace 'regval -> sequential_state 'regs -> maybe (sequential_state 'regs)
+let rec runTraceS ra t s = match t with
+  | [] -> Just s
+  | e :: t' -> Maybe.bind (emitEventS ra e s) (runTraceS ra t')
+end
+
+declare {isabelle} termination_argument runTraceS = automatic
diff --git a/src/gen_lib/sail2_state_monad.lem b/src/gen_lib/sail2_state_monad.lem
index 30b296cc..3042700c 100644
--- a/src/gen_lib/sail2_state_monad.lem
+++ b/src/gen_lib/sail2_state_monad.lem
@@ -4,24 +4,20 @@ open import Sail2_values
 
 (* 'a is result type *)
 
-type memstate = map integer memory_byte
-type tagstate = map integer bitU
+type memstate = map nat memory_byte
+type tagstate = map nat bitU
 (* type regstate = map string (vector bitU) *)
 
 type sequential_state 'regs =
   <| regstate : 'regs;
      memstate : memstate;
-     tagstate : tagstate;
-     write_ea : maybe (write_kind * integer * integer);
-     last_exclusive_operation_was_load : bool |>
+     tagstate : tagstate |>
 
 val init_state : forall 'regs. 'regs -> sequential_state 'regs
 let init_state regs =
   <| regstate = regs;
      memstate = Map.empty;
-     tagstate = Map.empty;
-     write_ea = Nothing;
-     last_exclusive_operation_was_load = false |>
+     tagstate = Map.empty |>
 
 type ex 'e =
   | Failure of string
@@ -51,8 +47,8 @@ let seqS m n = bindS m (fun (_ : unit) -> n)
 let inline (>>$=) = bindS
 let inline (>>$) = seqS
 
-val chooseS : forall 'regs 'a 'e. SetType 'a => set 'a -> monadS 'regs 'a 'e
-let chooseS xs s = Set.map (fun x -> (Value x, s)) xs
+val chooseS : forall 'regs 'a 'e. SetType 'a => list 'a -> monadS 'regs 'a 'e
+let chooseS xs s = Set.fromList (List.map (fun x -> (Value x, s)) xs)
 
 val readS : forall 'regs 'a 'e. (sequential_state 'regs -> 'a) -> monadS 'regs 'a 'e
 let readS f = (fun s -> returnS (f s) s)
@@ -63,8 +59,9 @@ let updateS f = (fun s -> returnS () (f s))
 val failS : forall 'regs 'a 'e. string -> monadS 'regs 'a 'e
 let failS msg s = {(Ex (Failure msg), s)}
 
-val undefined_boolS : forall 'regval 'regs 'a 'e. unit -> monadS 'regs bool 'e
-let undefined_boolS () = chooseS {false; true}
+val choose_boolS : forall 'regval 'regs 'a 'e. unit -> monadS 'regs bool 'e
+let choose_boolS () = chooseS [false; true]
+let undefined_boolS = choose_boolS
 
 val exitS : forall 'regs 'e 'a. unit -> monadS 'regs 'a 'e
 let exitS () = failS "exit"
@@ -120,69 +117,78 @@ end
 
 val read_tagS : forall 'regs 'a 'e. Bitvector 'a => 'a -> monadS 'regs bitU 'e
 let read_tagS addr =
-  maybe_failS "unsigned" (unsigned addr) >>$= (fun addr ->
+  maybe_failS "nat_of_bv" (nat_of_bv addr) >>$= (fun addr ->
   readS (fun s -> fromMaybe B0 (Map.lookup addr s.tagstate)))
 
 (* Read bytes from memory and return in little endian order *)
-val read_mem_bytesS : forall 'regs 'e 'a. Bitvector 'a => read_kind -> 'a -> nat -> monadS 'regs (list memory_byte) 'e
-let read_mem_bytesS read_kind addr sz =
-  maybe_failS "unsigned" (unsigned addr) >>$= (fun addr ->
-  let sz = integerFromNat sz in
-  let addrs = index_list addr (addr+sz-1) 1 in
+val get_mem_bytes : forall 'regs. nat -> nat -> sequential_state 'regs -> maybe (list memory_byte * bitU)
+let get_mem_bytes addr sz s =
+  let addrs = genlist (fun n -> addr + n) sz in
   let read_byte s addr = Map.lookup addr s.memstate in
-  readS (fun s -> just_list (List.map (read_byte s) addrs)) >>$= (function
-    | Just mem_val ->
-       updateS (fun s ->
-         if read_is_exclusive read_kind
-         then <| s with last_exclusive_operation_was_load = true |>
-         else s) >>$
-       returnS mem_val
-    | Nothing -> failS "read_memS"
-  end))
+  let read_tag s addr = Map.findWithDefault addr B0 s.tagstate in
+  Maybe.map
+    (fun mem_val -> (mem_val, List.foldl and_bit B1 (List.map (read_tag s) addrs)))
+    (just_list (List.map (read_byte s) addrs))
+
+val read_memt_bytesS : forall 'regs 'e. read_kind -> nat -> nat -> monadS 'regs (list memory_byte * bitU) 'e
+let read_memt_bytesS _ addr sz =
+  readS (get_mem_bytes addr sz) >>$=
+  maybe_failS "read_memS"
+
+val read_mem_bytesS : forall 'regs 'e. read_kind -> nat -> nat -> monadS 'regs (list memory_byte) 'e
+let read_mem_bytesS rk addr sz =
+  read_memt_bytesS rk addr sz >>$= (fun (bytes, _) ->
+  returnS bytes)
+
+val read_memtS : forall 'regs 'e 'a 'b. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monadS 'regs ('b * bitU) 'e
+let read_memtS rk a sz =
+  maybe_failS "nat_of_bv" (nat_of_bv a) >>$= (fun a ->
+  read_memt_bytesS rk a (nat_of_int sz) >>$= (fun (bytes, tag) ->
+  maybe_failS "bits_of_mem_bytes" (of_bits (bits_of_mem_bytes bytes)) >>$= (fun mem_val ->
+  returnS (mem_val, tag))))
 
 val read_memS : forall 'regs 'e 'a 'b. Bitvector 'a, Bitvector 'b => read_kind -> 'a -> integer -> monadS 'regs 'b 'e
 let read_memS rk a sz =
-  read_mem_bytesS rk a (nat_of_int sz) >>$= (fun bytes ->
-  maybe_failS "bits_of_mem_bytes" (of_bits (bits_of_mem_bytes bytes)))
+  read_memtS rk a sz >>$= (fun (bytes, _) ->
+  returnS bytes)
 
 val excl_resultS : forall 'regs 'e. unit -> monadS 'regs bool 'e
-let excl_resultS () =
-  readS (fun s -> s.last_exclusive_operation_was_load) >>$= (fun excl_load ->
-  updateS (fun s -> <| s with last_exclusive_operation_was_load = false |>) >>$
-  chooseS (if excl_load then {false; true} else {false}))
-
-val write_mem_eaS : forall 'regs 'e 'a. Bitvector 'a => write_kind -> 'a -> nat -> monadS 'regs unit 'e
-let write_mem_eaS write_kind addr sz =
-  maybe_failS "unsigned" (unsigned addr) >>$= (fun addr ->
-  let sz = integerFromNat sz in
-  updateS (fun s -> <| s with write_ea = Just (write_kind, addr, sz) |>))
-
-(* Write little-endian list of bytes to previously announced address *)
-val write_mem_bytesS : forall 'regs 'e. list memory_byte -> monadS 'regs bool 'e
-let write_mem_bytesS v =
-  readS (fun s -> s.write_ea) >>$= (function
-      | Nothing -> failS "write ea has not been announced yet"
-      | Just (_, addr, sz) ->
-         let addrs = index_list addr (addr+sz-1) 1 in
-         (*let v = external_mem_value (bits_of v) in*)
-         let a_v = List.zip addrs v in
-         let write_byte mem (addr, v) = Map.insert addr v mem in
-         updateS (fun s ->
-           <| s with memstate = List.foldl write_byte s.memstate a_v |>) >>$
-         returnS true
-    end)
-
-val write_mem_valS : forall 'regs 'e 'a. Bitvector 'a => 'a -> monadS 'regs bool 'e
-let write_mem_valS v = match mem_bytes_of_bits v with
-  | Just v -> write_mem_bytesS v
-  | Nothing -> failS "write_mem_val"
-end
-
-val write_tagS : forall 'regs 'a 'e. Bitvector 'a => 'a -> bitU -> monadS 'regs bool 'e
-let write_tagS addr t =
-   maybe_failS "unsigned" (unsigned addr) >>$= (fun addr ->
-   updateS (fun s -> <| s with tagstate = Map.insert addr t s.tagstate |>) >>$
-   returnS true)
+let excl_resultS =
+  (* TODO: This used to be more deterministic, checking a flag in the state
+     whether an exclusive load has occurred before.  However, this does not
+     seem very precise; it might be safer to overapproximate the possible
+     behaviours by always making a nondeterministic choice. *)
+  undefined_boolS
+
+(* Write little-endian list of bytes to given address *)
+val put_mem_bytes : forall 'regs. nat -> nat -> list memory_byte -> bitU -> sequential_state 'regs -> sequential_state 'regs
+let put_mem_bytes addr sz v tag s =
+  let addrs = genlist (fun n -> addr + n) sz in
+  let a_v = List.zip addrs v in
+  let write_byte mem (addr, v) = Map.insert addr v mem in
+  let write_tag mem addr = Map.insert addr tag mem in
+  <| s with memstate = List.foldl write_byte s.memstate a_v;
+            tagstate = List.foldl write_tag s.tagstate addrs |>
+
+val write_memt_bytesS : forall 'regs 'e. write_kind -> nat -> nat -> list memory_byte -> bitU -> monadS 'regs bool 'e
+let write_memt_bytesS _ addr sz v t =
+  updateS (put_mem_bytes addr sz v t) >>$
+  returnS true
+
+val write_mem_bytesS : forall 'regs 'e. write_kind -> nat -> nat -> list memory_byte -> monadS 'regs bool 'e
+let write_mem_bytesS wk addr sz v = write_memt_bytesS wk addr sz v B0
+
+val write_memtS : forall 'regs 'e 'a 'b. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'a -> integer -> 'b -> bitU -> monadS 'regs bool 'e
+let write_memtS wk addr sz v t =
+  match (nat_of_bv addr, mem_bytes_of_bits v) with
+    | (Just addr, Just v) -> write_memt_bytesS wk addr (nat_of_int sz) v t
+    | _ -> failS "write_mem"
+  end
+
+val write_memS : forall 'regs 'e 'a 'b. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'a -> integer -> 'b -> monadS 'regs bool 'e
+let write_memS wk addr sz v = write_memtS wk addr sz v B0
 
 val read_regS : forall 'regs 'rv 'a 'e. register_ref 'regs 'rv 'a -> monadS 'regs 'a 'e
 let read_regS reg = readS (fun s -> reg.read_from s.regstate)
diff --git a/src/gen_lib/sail2_values.lem b/src/gen_lib/sail2_values.lem
index 8957f0dd..5e6537a8 100644
--- a/src/gen_lib/sail2_values.lem
+++ b/src/gen_lib/sail2_values.lem
@@ -47,7 +47,11 @@ let power_real b e = realPowInteger b e*)
 
 val print_endline : string -> unit
 let print_endline _ = ()
-(* declare ocaml target_rep function print_endline = `print_endline` *)
+declare ocaml target_rep function print_endline = `print_endline`
+
+val print : string -> unit
+let print _ = ()
+declare ocaml target_rep function print = `print_string`
 
 val prerr_endline : string -> unit
 let prerr_endline _ = ()
@@ -625,9 +629,21 @@ let extz_bv n v = extz_bits n (bits_of v)
 val exts_bv : forall 'a. Bitvector 'a => integer -> 'a -> list bitU
 let exts_bv n v = exts_bits n (bits_of v)
 
+val nat_of_bv : forall 'a. Bitvector 'a => 'a -> maybe nat
+let nat_of_bv v = Maybe.map nat_of_int (unsigned v)
+
 val string_of_bv : forall 'a. Bitvector 'a => 'a -> string
 let string_of_bv v = show_bitlist (bits_of v)
 
+val print_bits : forall 'a. Bitvector 'a => string -> 'a -> unit
+let print_bits str v = print_endline (str ^ string_of_bv v)
+
+val dec_str : integer -> string
+let dec_str bv = show bv
+
+val concat_str : string -> string -> string
+let concat_str str1 str2 = str1 ^ str2
+
 val int_of_bit : bitU -> integer
 let int_of_bit b =
   match b with
diff --git a/src/initial_check.ml b/src/initial_check.ml
index 05d51eb2..f728d92d 100644
--- a/src/initial_check.ml
+++ b/src/initial_check.ml
@@ -201,6 +201,20 @@ and to_ast_nexp ctx (P.ATyp_aux (aux, l)) =
   in
   Nexp_aux (aux, l)
 
+and to_ast_bitfield_index_nexp (P.ATyp_aux (aux, l)) =
+  let aux = match aux with
+    | P.ATyp_id id -> Nexp_id (to_ast_id id)
+    | P.ATyp_lit (P.L_aux (P.L_num c, _)) -> Nexp_constant c
+    | P.ATyp_sum (t1, t2) -> Nexp_sum (to_ast_bitfield_index_nexp t1, to_ast_bitfield_index_nexp t2)
+    | P.ATyp_exp t1 -> Nexp_exp (to_ast_bitfield_index_nexp t1)
+    | P.ATyp_neg t1 -> Nexp_neg (to_ast_bitfield_index_nexp t1)
+    | P.ATyp_times (t1, t2) -> Nexp_times (to_ast_bitfield_index_nexp t1, to_ast_bitfield_index_nexp t2)
+    | P.ATyp_minus (t1, t2) -> Nexp_minus (to_ast_bitfield_index_nexp t1, to_ast_bitfield_index_nexp t2)
+    | P.ATyp_app (id, ts) -> Nexp_app (to_ast_id id, List.map (to_ast_bitfield_index_nexp) ts)
+    | _ -> raise (Reporting.err_typ l "Invalid numeric expression in field index")
+  in
+  Nexp_aux (aux, l)
+
 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)
@@ -387,6 +401,16 @@ and to_ast_exp ctx (P.E_aux(exp,l) : P.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)
+    | P.E_internal_plet(pat,exp1,exp2) ->
+       if !opt_magic_hash then
+         E_internal_plet(to_ast_pat ctx pat, to_ast_exp ctx exp1, to_ast_exp ctx exp2)
+       else
+         raise (Reporting.err_general l "Internal plet construct found without -dmagic_hash")
+    | P.E_internal_return(exp) ->
+       if !opt_magic_hash then
+         E_internal_return(to_ast_exp ctx exp)
+       else
+         raise (Reporting.err_general l "Internal return construct found without -dmagic_hash")
     | _ -> raise (Reporting.err_unreachable l __POS__ "Unparsable construct in to_ast_exp")
     ), (l,()))
 
@@ -490,19 +514,12 @@ let to_ast_spec ctx (val_:P.val_spec) : (unit val_spec) ctx_out =
       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 (P.Name_sect_aux(ns,l)) =
-  Name_sect_aux(
-    (match ns with
-    | P.Name_sect_none -> Name_sect_none
-    | P.Name_sect_some(s) -> Name_sect_some(s)
-    ),l)
-
 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
-    | 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)),
+    | P.BF_single(i) -> BF_single(to_ast_bitfield_index_nexp i)
+    | P.BF_range(i1,i2) -> BF_range(to_ast_bitfield_index_nexp i1,to_ast_bitfield_index_nexp i2)
+    | P.BF_concat(ir1,ir2) -> BF_concat(to_ast_range ir1, to_ast_range ir2)),
     l)
 
 let to_ast_type_union ctx (P.Tu_aux (P.Tu_ty_id (atyp, id), l)) =
@@ -523,24 +540,24 @@ let to_ast_typedef ctx (P.TD_aux (aux, l) : P.type_def) : unit type_def ctx_out
        TD_abbrev (id, typq, typ_arg),
        add_constructor id typq ctx
 
-    | P.TD_record (id, namescm_opt, typq, fields, _) ->
+    | P.TD_record (id, 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),
+       TD_record (id, typq, fields, false),
        add_constructor id typq ctx
 
-    | P.TD_variant (id, namescm_opt, typq, arms, _) ->
+    | P.TD_variant (id, 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),
+       TD_variant (id, typq, arms, false),
        add_constructor id typq ctx
 
-    | P.TD_enum (id, namescm_opt, enums, _) ->
+    | P.TD_enum (id, 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),
+       TD_enum (id, enums, false),
        { ctx with type_constructors = Bindings.add id [] ctx.type_constructors }
 
     | P.TD_bitfield (id, typ, ranges) ->
@@ -552,13 +569,6 @@ let to_ast_typedef ctx (P.TD_aux (aux, l) : P.type_def) : unit type_def ctx_out
   in
   TD_aux (aux, (l, ())), ctx
 
-let to_ast_kdef ctx (td:P.kind_def) : unit kind_def =
-  match td with
-  | 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
   | P.Rec_nonrec -> Rec_nonrec
@@ -656,8 +666,8 @@ let to_ast_alias_spec ctx (P.E_aux(e, 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_reg (reffect, weffect, typ, id) ->
+              DEC_reg (to_ast_effects reffect, to_ast_effects weffect, 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) ->
@@ -674,10 +684,10 @@ let to_ast_scattered ctx (P.SD_aux (aux, l)) =
        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) ->
+    | P.SD_variant (id, 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),
+       SD_variant (id, 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
@@ -710,9 +720,6 @@ let to_ast_def ctx def : unit def ctx_out =
      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
@@ -797,6 +804,10 @@ let typ_of_string str =
   let typ = to_ast_typ initial_ctx typ in
   typ
 
+let constraint_of_string str =
+  let atyp = Parser.typ_eof Lexer.token (Lexing.from_string str) in
+  to_ast_constraint initial_ctx atyp
+
 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))
 
@@ -871,7 +882,7 @@ let generate_undefineds vs_ids (Defs defs) =
     | pats -> mk_pat (P_tup pats)
   in
   let undefined_td = function
-    | TD_enum (id, _, ids, _) when not (IdSet.mem (prepend_id "undefined_" id) vs_ids) ->
+    | TD_enum (id, ids, _) when not (IdSet.mem (prepend_id "undefined_" id) vs_ids) ->
        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)
@@ -881,13 +892,13 @@ let generate_undefineds vs_ids (Defs defs) =
                              else
                                mk_exp (E_app (mk_id "internal_pick",
                                               [mk_exp (E_list (List.map (fun id -> mk_exp (E_id id)) ids))])))]]
-    | TD_record (id, _, typq, fields, _) when not (IdSet.mem (prepend_id "undefined_" id) vs_ids) ->
+    | TD_record (id, typq, fields, _) 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
        [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 (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) ->
+    | 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 =
          if !opt_fast_undefined && List.length tus > 0 then
@@ -947,7 +958,7 @@ let generate_undefineds vs_ids (Defs defs) =
   Defs (undefined_builtins @ undefined_defs defs)
 
 let rec get_registers = function
-  | DEF_reg_dec (DEC_aux (DEC_reg (typ, id), _)) :: defs -> (typ, id) :: get_registers defs
+  | DEF_reg_dec (DEC_aux (DEC_reg (_, _, typ, id), _)) :: defs -> (typ, id) :: get_registers defs
   | _ :: defs -> get_registers defs
   | [] -> []
 
@@ -965,7 +976,7 @@ let generate_initialize_registers vs_ids (Defs defs) =
 
 let generate_enum_functions vs_ids (Defs defs) =
   let rec gen_enums = function
-    | DEF_type (TD_aux (TD_enum (id, _, elems, _), _)) as enum :: defs ->
+    | DEF_type (TD_aux (TD_enum (id, elems, _), _)) as enum :: defs ->
        let enum_val_spec name quants typ =
          mk_val_spec (VS_val_spec (mk_typschm (mk_typquant quants) typ, name, [], !opt_enum_casts))
        in
@@ -1023,18 +1034,20 @@ let generate_enum_functions vs_ids (Defs defs) =
 
 let incremental_ctx = ref initial_ctx
 
-let process_ast order defs =
+let process_ast ?generate:(generate=true) defs =
   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
+  if not !opt_undefined_gen && generate then
     generate_enum_functions vs_ids ast
-  else
+  else if generate then
     ast
     |> generate_undefineds vs_ids
     |> generate_enum_functions vs_ids
     |> generate_initialize_registers vs_ids
-
-let ast_of_def_string order str =
+  else
+    ast
+  
+let ast_of_def_string str =
   let def = Parser.def_eof Lexer.token (Lexing.from_string str) in
-  process_ast order (P.Defs [def])
+  process_ast (P.Defs [def])
diff --git a/src/initial_check.mli b/src/initial_check.mli
index 25187e4c..a0bde482 100644
--- a/src/initial_check.mli
+++ b/src/initial_check.mli
@@ -82,8 +82,11 @@ val opt_enum_casts : bool ref
    all the loaded files. *)
 val have_undefined_builtins : bool ref
 
-val ast_of_def_string : order -> string -> unit defs
-val process_ast : order -> Parse_ast.defs -> unit defs
+val ast_of_def_string : string -> unit defs
+
+(** If the generate flag is false, then we won't generate any
+   auxilliary definitions, like the initialize_registers function *)
+val process_ast : ?generate:bool -> Parse_ast.defs -> unit defs
 
 val val_spec_ids : 'a defs -> IdSet.t
 
@@ -92,3 +95,4 @@ val val_spec_of_string : id -> string -> unit def
 
 val exp_of_string : string -> unit exp
 val typ_of_string : string -> typ
+val constraint_of_string : string -> n_constraint
diff --git a/src/interactive.ml b/src/interactive.ml
new file mode 100644
index 00000000..e5fda4cf
--- /dev/null
+++ b/src/interactive.ml
@@ -0,0 +1,8 @@
+
+let opt_interactive = ref false
+let opt_emacs_mode = ref false
+let opt_suppress_banner = ref false
+
+let env = ref Type_check.initial_env
+
+let ast = ref (Ast.Defs [])
diff --git a/src/interactive.mli b/src/interactive.mli
new file mode 100644
index 00000000..915193ec
--- /dev/null
+++ b/src/interactive.mli
@@ -0,0 +1,10 @@
+open Ast
+open Type_check
+
+val opt_interactive : bool ref
+val opt_emacs_mode : bool ref
+val opt_suppress_banner : bool ref
+
+val ast : tannot defs ref
+
+val env : Env.t ref
diff --git a/src/interpreter.ml b/src/interpreter.ml
index 96ef80f0..737f937e 100644
--- a/src/interpreter.ml
+++ b/src/interpreter.ml
@@ -115,6 +115,15 @@ let value_of_exp = function
   | (E_aux (E_internal_value v, _)) -> v
   | _ -> failwith "value_of_exp coerction failed"
 
+let fallthrough =
+  let open Type_check in
+  try
+    let env = initial_env |> Env.add_scattered_variant (mk_id "exception") (mk_typquant []) in
+    check_case env exc_typ (mk_pexp (Pat_exp (mk_pat (P_id (mk_id "exn")), mk_exp (E_throw (mk_exp (E_id (mk_id "exn"))))))) unit_typ
+  with
+  | Type_error (_, l, err) ->
+     Reporting.unreachable l __POS__ (Type_error.string_of_type_error err);
+
 (**************************************************************************)
 (* 1. Interpreter Monad                                                   *)
 (**************************************************************************)
@@ -591,7 +600,7 @@ let rec step (E_aux (e_aux, annot) as orig_exp) =
      begin
        catch (step exp) >>= fun exp' ->
        match exp' with
-       | Left exn -> wrap (E_case (exp_of_value exn, pexps))
+       | Left exn -> wrap (E_case (exp_of_value exn, pexps @ [fallthrough]))
        | Right exp' -> wrap (E_try (exp', pexps))
      end
 
@@ -887,7 +896,7 @@ let rec eval_frame' = function
 
 let eval_frame frame =
   try eval_frame' frame with
-  | Type_check.Type_error (l, err) ->
+  | Type_check.Type_error (env, l, err) ->
      raise (Reporting.err_typ l (Type_error.string_of_type_error err))
 
 let default_effect_interp state eff =
@@ -977,7 +986,7 @@ let initial_gstate primops ast env =
 
 let rec initialize_registers gstate =
   let process_def = function
-    | DEF_reg_dec (DEC_aux (DEC_reg (typ, id), annot)) ->
+    | DEF_reg_dec (DEC_aux (DEC_reg (_, _, typ, id), annot)) ->
        begin
          let env = Type_check.env_of_annot annot in
          let typ = Type_check.Env.expand_synonyms env typ in
diff --git a/src/isail.ml b/src/isail.ml
index 5c578220..e513e0ee 100644
--- a/src/isail.ml
+++ b/src/isail.ml
@@ -59,6 +59,7 @@ type mode =
   | Evaluation of frame
   | Bytecode of Value2.vl Bytecode_interpreter.gstate * Value2.vl Bytecode_interpreter.stack
   | Normal
+  | Emacs
 
 let current_mode = ref Normal
 
@@ -67,6 +68,7 @@ let prompt () =
   | Normal -> "sail> "
   | Evaluation _ -> "eval> "
   | Bytecode _ -> "ir> "
+  | Emacs -> ""
 
 let eval_clear = ref true
 
@@ -75,6 +77,7 @@ let mode_clear () =
   | Normal -> ()
   | Evaluation _ -> if !eval_clear then LNoise.clear_screen () else ()
   | Bytecode _ -> () (* if !eval_clear then LNoise.clear_screen () else () *)
+  | Emacs -> ()
 
 let rec user_input callback =
   match LNoise.linenoise (prompt ()) with
@@ -83,20 +86,22 @@ let rec user_input callback =
      mode_clear ();
      begin
        try callback v with
-       | Reporting.Fatal_error e -> Reporting.report_error e
+       | Reporting.Fatal_error e -> Reporting.print_error e
      end;
      user_input callback
 
 let sail_logo =
   let banner str = str |> Util.bold |> Util.red |> Util.clear in
   let logo =
-    [ {|    ___       ___       ___       ___ |};
-      {|   /\  \     /\  \     /\  \     /\__\|};
-      {|  /::\  \   /::\  \   _\:\  \   /:/  /|};
-      {| /\:\:\__\ /::\:\__\ /\/::\__\ /:/__/ |};
-      {| \:\:\/__/ \/\::/  / \::/\/__/ \:\  \ |};
-      {|  \::/  /    /:/  /   \:\__\    \:\__\|};
-      {|   \/__/     \/__/     \/__/     \/__/|} ]
+    if !Interactive.opt_suppress_banner then []
+    else
+      [ {|    ___       ___       ___       ___ |};
+        {|   /\  \     /\  \     /\  \     /\__\|};
+        {|  /::\  \   /::\  \   _\:\  \   /:/  /|};
+        {| /\:\:\__\ /::\:\__\ /\/::\__\ /:/__/ |};
+        {| \:\:\/__/ \/\::/  / \::/\/__/ \:\  \ |};
+        {|  \::/  /    /:/  /   \:\__\    \:\__\|};
+        {|   \/__/     \/__/     \/__/     \/__/|} ]
   in
   let help =
     [ "Type :commands for a list of commands, and :help <command> for help.";
@@ -104,9 +109,9 @@ let sail_logo =
   in
   List.map banner logo @ [""] @ help @ [""]
 
-let vs_ids = ref (Initial_check.val_spec_ids !interactive_ast)
+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_state = ref (initial_state !Interactive.ast !Interactive.env Value.primops)
 
 let interactive_bytecode = ref []
 
@@ -114,7 +119,7 @@ let sep = "-----------------------------------------------------" |> Util.blue |
 
 let print_program () =
   match !current_mode with
-  | Normal -> ()
+  | Normal | Emacs -> ()
   | Evaluation (Step (out, _, _, stack)) ->
      List.map stack_string stack |> List.rev |> List.iter (fun code -> print_endline (Lazy.force code); print_endline sep);
      print_endline (Lazy.force out)
@@ -140,7 +145,7 @@ let print_program () =
 
 let rec run () =
   match !current_mode with
-  | Normal -> ()
+  | Normal | Emacs -> ()
   | Evaluation frame ->
      begin
        match frame with
@@ -174,7 +179,7 @@ let rec run_steps n =
   print_endline ("step " ^ string_of_int n);
   match !current_mode with
   | _ when n <= 0 -> ()
-  | Normal -> ()
+  | Normal | Emacs -> ()
   | Evaluation frame ->
      begin
        match frame with
@@ -241,6 +246,65 @@ let help = function
   | cmd ->
      "Either invalid command passed to help, or no documentation for " ^ cmd ^ ". Try :help :help."
 
+let format_pos_emacs p1 p2 contents =
+  let open Lexing in
+  let b = Buffer.create 160 in
+  Printf.sprintf "(sail-error %d %d %d %d \"%s\")"
+                 p1.pos_lnum (p1.pos_cnum - p1.pos_bol)
+                 p2.pos_lnum (p2.pos_cnum - p2.pos_bol)
+                 contents
+
+let rec emacs_error l contents =
+  match l with
+  | Parse_ast.Unknown -> "(error \"no location info: " ^ contents ^ "\")"
+  | Parse_ast.Range (p1, p2) -> format_pos_emacs p1 p2 contents
+  | Parse_ast.Unique (_, l) -> emacs_error l contents
+  | Parse_ast.Documented (_, l) -> emacs_error l contents
+  | Parse_ast.Generated l -> emacs_error l contents
+
+type session = {
+    id : string;
+    files : string list
+  }
+
+let default_session = {
+    id = "none";
+    files = []
+  }
+
+let session = ref default_session
+
+let parse_session file =
+  let open Yojson.Basic.Util in
+  if Sys.file_exists file then
+    let json = Yojson.Basic.from_file file in
+    let args = Str.split (Str.regexp " +") (json |> member "options" |> to_string) in
+    Arg.parse_argv ~current:(ref 0) (Array.of_list ("sail" :: args)) Sail.options (fun _ -> ()) "";
+    print_endline ("(message \"Using session " ^ file ^ "\")");
+    {
+      id = file;
+      files = json |> member "files" |> convert_each to_string
+    }
+  else
+    default_session
+
+let load_session upto file =
+  match upto with
+  | None -> None
+  | Some upto_file when Filename.basename upto_file = file -> None
+  | Some upto_file ->
+     let (_, ast, env) =
+       load_files ~generate:false !Interactive.env [Filename.concat (Filename.dirname upto_file) file]
+     in
+     Interactive.ast := append_ast !Interactive.ast ast;
+     Interactive.env := env;
+     print_endline ("(message \"Checked " ^ file ^ "...\")\n");
+     Some upto_file
+
+let load_into_session file =
+  let session_file = Filename.concat (Filename.dirname file) "sail.json" in
+  session := (if session_file = !session.id then !session else parse_session session_file);
+  ignore (List.fold_left load_session (Some file) !session.files)
 
 type input = Command of string * string | Expression of string | Empty
 
@@ -269,156 +333,212 @@ let handle_input' input =
   in
 
   (* First handle commands that are mode-independent *)
-  begin
-    match input with
-    | 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));
-            print_newline ();
-         | ":q" | ":quit" ->
-            Value.output_close ();
-            exit 0
-         | ":i" | ":infer" ->
-            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" ->
+  begin match input with
+  | 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));
+        print_newline ();
+     | ":q" | ":quit" ->
+        Value.output_close ();
+        exit 0
+     | ":i" | ":infer" ->
+        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))
+     | ":prove" ->
+        let nc = Initial_check.constraint_of_string arg in
+        print_endline (string_of_bool (Type_check.prove __POS__ !Interactive.env nc))
+     | ":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)
-         | ":clear" ->
-            if arg = "on" then
-              eval_clear := true
-            else if arg = "off" then
-              eval_clear := false
-            else print_endline "Invalid argument for :clear, expected either :clear on or :clear off"
-         | ":commands" ->
-            let commands =
-              [ "Universal commands - :(t)ype :(i)nfer :(q)uit :(v)erbose :clear :commands :help :output :option";
-                "Normal mode commands - :elf :bin :(l)oad :(u)nload";
-                "Evaluation mode commands - :(r)un :(s)tep :(n)ormal";
-                "";
-                ":(c)ommand can be called as either :c or :command." ]
-            in
-            List.iter print_endline commands
-         | ":poly" ->
-            let is_kopt = match arg with
-              | "Int" -> is_nat_kopt
-              | "Type" -> is_typ_kopt
-              | "Order" -> is_order_kopt
-              | _ -> failwith "Invalid kind"
-            in
-            let ids = Specialize.polymorphic_functions is_kopt !interactive_ast in
-            List.iter (fun id -> print_endline (string_of_id id)) (IdSet.elements ids)
-         | ":option" ->
-            begin
-              try
-                let args = Str.split (Str.regexp " +") arg in
-                Arg.parse_argv ~current:(ref 0) (Array.of_list ("sail" :: args)) Sail.options (fun _ -> ()) "";
-              with
-              | Arg.Bad message | Arg.Help message -> print_endline message
-            end;
-         | ":spec" ->
-            let ast, env = Specialize.specialize !interactive_ast !interactive_env in
-            interactive_ast := ast;
-            interactive_env := env;
-            interactive_state := initial_state !interactive_ast !interactive_env Value.primops
-         | ":pretty" ->
-            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
-            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;
-            close_out chan
-         | ":output" ->
-            let chan = open_out arg in
-            Value.output_redirect chan
-         | ":help" -> print_endline (help arg)
-         | _ -> recognised := false
-       end
-    | _ -> ()
+     | ":clear" ->
+        if arg = "on" then
+          eval_clear := true
+        else if arg = "off" then
+          eval_clear := false
+        else print_endline "Invalid argument for :clear, expected either :clear on or :clear off"
+     | ":commands" ->
+        let commands =
+          [ "Universal commands - :(t)ype :(i)nfer :(q)uit :(v)erbose :clear :commands :help :output :option";
+            "Normal mode commands - :elf :(l)oad :(u)nload";
+            "Evaluation mode commands - :(r)un :(s)tep :(n)ormal";
+            "";
+            ":(c)ommand can be called as either :c or :command." ]
+        in
+        List.iter print_endline commands
+     | ":poly" ->
+        let is_kopt = match arg with
+          | "Int" -> is_nat_kopt
+          | "Type" -> is_typ_kopt
+          | "Order" -> is_order_kopt
+          | _ -> failwith "Invalid kind"
+        in
+        let ids = Specialize.polymorphic_functions is_kopt !Interactive.ast in
+        List.iter (fun id -> print_endline (string_of_id id)) (IdSet.elements ids)
+     | ":option" ->
+        begin
+          try
+            let args = Str.split (Str.regexp " +") arg in
+            Arg.parse_argv ~current:(ref 0) (Array.of_list ("sail" :: args)) Sail.options (fun _ -> ()) "";
+          with
+          | Arg.Bad message | Arg.Help message -> print_endline message
+        end;
+     | ":spec" ->
+        let ast, env = Specialize.specialize !Interactive.ast !Interactive.env in
+        Interactive.ast := ast;
+        Interactive.env := env;
+        interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops
+     | ":pretty" ->
+        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
+        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;
+        close_out chan
+     | ":output" ->
+        let chan = open_out arg in
+        Value.output_redirect chan
+     | ":help" -> print_endline (help arg)
+     | _ -> recognised := false
+     end
+  | _ -> ()
   end;
 
   match !current_mode with
   | Normal ->
-     begin
-       match input with
-       | Command (cmd, arg) ->
-          (* Normal mode commands *)
-          begin
-            match cmd with
-            | ":elf" -> Elf_loader.load_elf arg
-            | ":bin" ->
-               begin
-                 let args = Util.split_on_char ' ' arg in
-                 match args with
-                 | [addr_s; filename] ->
-                    let addr = Big_int.of_string addr_s in
-                    Elf_loader.load_binary addr filename
-                 | _ ->
-                    print_endline "Invalid argument for :bin, expected <addr> <filename>"
-               end
-            | ":l" | ":load" ->
-               let files = Util.split_on_char ' ' arg in
-               let (_, ast, env) = load_files !interactive_env files in
-               let ast = Process_file.rewrite_ast_interpreter env ast in
-               interactive_ast := append_ast !interactive_ast ast;
-               interactive_state := initial_state !interactive_ast !interactive_env Value.primops;
-               interactive_env := env;
-               vs_ids := Initial_check.val_spec_ids !interactive_ast
-            | ":u" | ":unload" ->
-               interactive_ast := Ast.Defs [];
-               interactive_env := Type_check.initial_env;
-               interactive_state := initial_state !interactive_ast !interactive_env Value.primops;
-               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
+     begin match input with
+     | Command (cmd, arg) ->
+        (* Normal mode commands *)
+        begin match cmd with
+        | ":elf" -> Elf_loader.load_elf arg
+        | ":l" | ":load" ->
+           let files = Util.split_on_char ' ' arg in
+           let (_, ast, env) = load_files !Interactive.env files in
+           let ast = Process_file.rewrite_ast_interpreter !Interactive.env ast in
+           Interactive.ast := append_ast !Interactive.ast ast;
+           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           Interactive.env := env;
+           vs_ids := Initial_check.val_spec_ids !Interactive.ast
+        | ":bin" ->
+           begin
+             let args = Util.split_on_char ' ' arg in
+             match args with
+             | [addr_s; filename] ->
+                let addr = Big_int.of_string addr_s in
+                Elf_loader.load_binary addr filename
+             | _ ->
+                print_endline "Invalid argument for :bin, expected <addr> <filename>"
+           end
+        | ":u" | ":unload" ->
+           Interactive.ast := Ast.Defs [];
+           Interactive.env := Type_check.initial_env;
+           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           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;
+           Process_file.clear_symbols ()
+        | ":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 str) in
-          current_mode := Evaluation (eval_frame (Step (lazy "", !interactive_state, return exp, [])));
-          print_program ()
-       | Empty -> ()
+        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
+
+  | Emacs ->
+     begin match input with
+     | Command (cmd, arg) ->
+        begin match cmd with
+        | ":load" ->
+           begin
+             try
+               load_into_session arg;
+               let (_, ast, env) = load_files !Interactive.env [arg] in
+               Interactive.ast := append_ast !Interactive.ast ast;
+               interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+               Interactive.env := env;
+               vs_ids := Initial_check.val_spec_ids !Interactive.ast;
+               print_endline ("(message \"Checked " ^ arg ^ " done\")\n");
+             with
+             | Reporting.Fatal_error (Err_type (l, msg)) ->
+                print_endline (emacs_error l (String.escaped msg))
+           end
+        | ":unload" ->
+           Interactive.ast := Ast.Defs [];
+           Interactive.env := Type_check.initial_env;
+           interactive_state := initial_state !Interactive.ast !Interactive.env Value.primops;
+           vs_ids := Initial_check.val_spec_ids !Interactive.ast;
+           Initial_check.have_undefined_builtins := false;
+           Process_file.clear_symbols ()
+        | ":typeat" ->
+           let args = Str.split (Str.regexp " +") arg in
+           begin match args with
+           | [file; pos] ->
+              let open Lexing in
+              let pos = int_of_string pos in
+              let pos = { dummy_pos with pos_fname = file; pos_cnum = pos - 1 } in
+              let sl = Some (pos, pos) in
+              begin match find_annot_ast sl !Interactive.ast with
+              | Some annot ->
+                 let msg = String.escaped (string_of_typ (Type_check.typ_of_annot annot)) in
+                 begin match simp_loc (fst annot) with
+                 | Some (p1, p2) ->
+                    print_endline ("(sail-highlight-region "
+                                   ^ string_of_int (p1.pos_cnum + 1) ^ " " ^ string_of_int (p2.pos_cnum + 1)
+                                   ^ " \"" ^ msg ^ "\")")
+                 | None ->
+                    print_endline ("(message \"" ^ msg ^ "\")")
+                 end
+              | None ->
+                 print_endline "(message \"No type here\")"
+              end
+           | _ ->
+              print_endline "(error \"Bad arguments for type at cursor\")"
+           end
+        | _ -> ()
+        end
+     | Expression _ | Empty -> ()
+     end
+
   | Evaluation frame ->
      begin match input with
      | Command (cmd, arg) ->
@@ -478,7 +598,7 @@ let handle_input' input =
     
 let handle_input input =
   try handle_input' input with
-  | Type_check.Type_error (l, err) ->
+  | Type_check.Type_error (env, l, err) ->
      print_endline (Type_error.string_of_type_error err)
   | Reporting.Fatal_error err ->
      Reporting.print_error err
@@ -525,9 +645,11 @@ let () =
   LNoise.history_load ~filename:"sail_history" |> ignore;
   LNoise.history_set ~max_length:100 |> ignore;
 
-  if !opt_interactive then
+  if !Interactive.opt_interactive then
     begin
-      List.iter print_endline sail_logo;
+      if not !Interactive.opt_emacs_mode then
+        List.iter print_endline sail_logo
+      else (current_mode := Emacs; Util.opt_colors := false);
       user_input handle_input
     end
   else ()
diff --git a/src/latex.ml b/src/latex.ml
index 71e0ba54..a0660daa 100644
--- a/src/latex.ml
+++ b/src/latex.ml
@@ -397,9 +397,9 @@ let process_pragma l command =
 
 let tdef_id = function
   | TD_abbrev (id, _, _) -> id
-  | TD_record (id, _, _, _, _) -> id
-  | TD_variant (id, _, _, _, _) -> id
-  | TD_enum (id, _, _, _) -> id
+  | TD_record (id, _, _, _) -> id
+  | TD_variant (id, _, _, _) -> id
+  | TD_enum (id, _, _) -> id
   | TD_bitfield (id, _, _) -> id
 
 let defs (Defs defs) =
diff --git a/src/lexer.mll b/src/lexer.mll
index 1d48b82b..43426d77 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -146,7 +146,6 @@ let kw_table =
      ("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));
@@ -164,7 +163,6 @@ let kw_table =
      ("do",                      (fun _ -> Do));
      ("mutual",                  (fun _ -> Mutual));
      ("bitfield",                (fun _ -> Bitfield));
-     ("where",                   (fun _ -> Where));
 
      ("barr",                    (fun x -> Barr));
      ("depend",                  (fun x -> Depend));
@@ -183,6 +181,8 @@ let kw_table =
      ("escape",                  (fun x -> Escape));
      ("configuration",           (fun _ -> Configuration));
      ("termination_measure",     (fun _ -> TerminationMeasure));
+     ("internal_plet",           (fun _ -> InternalPLet));
+     ("internal_return",         (fun _ -> InternalReturn));
    ]
 
 
diff --git a/src/monomorphise.ml b/src/monomorphise.ml
index dd0f7afd..3167ad6b 100644
--- a/src/monomorphise.ml
+++ b/src/monomorphise.ml
@@ -59,7 +59,6 @@ open Ast
 open Ast_util
 module Big_int = Nat_big_num
 open Type_check
-open Extra_pervasives
 
 let size_set_limit = 64
 
@@ -100,36 +99,36 @@ let subst_nexp substs nexp =
     | Nexp_app (id,args) -> re (Nexp_app (id,List.map s_snexp args))
   in s_snexp substs nexp
 
-let rec subst_nc substs (NC_aux (nc,l) as n_constraint) =
-  let snexp nexp = subst_nexp substs nexp in
-  let snc nc = subst_nc substs nc in
-  let re nc = NC_aux (nc,l) in
-  match nc with
-  | NC_equal (n1,n2) -> re (NC_equal (snexp n1, snexp n2))
-  | NC_bounded_ge (n1,n2) -> re (NC_bounded_ge (snexp n1, snexp n2))
-  | NC_bounded_le (n1,n2) -> re (NC_bounded_le (snexp n1, snexp n2))
-  | NC_not_equal (n1,n2) -> re (NC_not_equal (snexp n1, snexp n2))
-  | NC_set (kid,is) ->
-     begin
-       match KBindings.find kid substs with
-       | 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.err_general l
-                   ("Unable to substitute " ^ string_of_nexp nexp ^
-                       " into set constraint " ^ string_of_n_constraint n_constraint))
-       | exception Not_found -> n_constraint
-     end
-  | NC_or (nc1,nc2) -> re (NC_or (snc nc1, snc nc2))
-  | NC_and (nc1,nc2) -> re (NC_and (snc nc1, snc nc2))
-  | NC_true
-  | NC_false
+let subst_nc, subst_src_typ, subst_src_typ_arg =
+  let rec subst_nc substs (NC_aux (nc,l) as n_constraint) =
+    let snexp nexp = subst_nexp substs nexp in
+    let snc nc = subst_nc substs nc in
+    let re nc = NC_aux (nc,l) in
+    match nc with
+    | NC_equal (n1,n2) -> re (NC_equal (snexp n1, snexp n2))
+    | NC_bounded_ge (n1,n2) -> re (NC_bounded_ge (snexp n1, snexp n2))
+    | NC_bounded_le (n1,n2) -> re (NC_bounded_le (snexp n1, snexp n2))
+    | NC_not_equal (n1,n2) -> re (NC_not_equal (snexp n1, snexp n2))
+    | NC_set (kid,is) ->
+       begin
+         match KBindings.find kid substs with
+         | 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.err_general l
+                     ("Unable to substitute " ^ string_of_nexp nexp ^
+                        " into set constraint " ^ string_of_n_constraint n_constraint))
+         | exception Not_found -> n_constraint
+       end
+    | NC_or (nc1,nc2) -> re (NC_or (snc nc1, snc nc2))
+    | NC_and (nc1,nc2) -> re (NC_and (snc nc1, snc nc2))
+    | NC_true
+      | NC_false
       -> n_constraint
-
-
-
-let subst_src_typ substs t =
-  let rec s_styp substs ((Typ_aux (t,l)) as ty) =
+    | NC_var kid -> re (NC_var kid)
+    | NC_app (f, args) ->
+       re (NC_app (f, List.map (s_starg substs) args))
+  and  s_styp substs ((Typ_aux (t,l)) as ty) =
     let re t = Typ_aux (t,l) in
     match t with
     | Typ_id _
@@ -141,14 +140,15 @@ let subst_src_typ substs t =
     | Typ_app (id,tas) -> re (Typ_app (id,List.map (s_starg substs) tas))
     | 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"
+       re (Typ_exist (kopts,subst_nc substs nc,s_styp substs t))
+    | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   and s_starg substs (A_aux (ta,l) as targ) =
     match ta with
     | 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
+    | A_bool nc -> A_aux (A_bool (subst_nc substs nc), l)
+  in subst_nc, s_styp, s_starg
 
 let make_vector_lit sz i =
   let f j = if Big_int.equal (Big_int.modulus (Big_int.shift_right i (sz-j-1)) (Big_int.of_int 2)) Big_int.zero then '0' else '1' in
@@ -180,7 +180,7 @@ let rec is_value (E_aux (e,(l,annot))) =
   let is_constructor id =
     match destruct_tannot annot with
     | None ->
-       (Reporting.print_err false true l "Monomorphisation"
+       (Reporting.print_err l "Monomorphisation"
           ("Missing type information for identifier " ^ string_of_id id);
         false) (* Be conservative if we have no info *)
     | Some (env,_,_) ->
@@ -340,7 +340,7 @@ let rec inst_src_type insts (Typ_aux (ty,l) as typ) =
      | [] -> insts', t'
      | _ -> 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"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and inst_src_typ_arg insts (A_aux (ta,l) as tyarg) =
   match ta with
   | A_nexp _
@@ -360,7 +360,7 @@ let rec contains_exist (Typ_aux (ty,l)) =
   | Typ_tup ts -> List.exists contains_exist ts
   | Typ_app (_,args) -> List.exists contains_exist_arg args
   | Typ_exist _ -> true
-  | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and contains_exist_arg (A_aux (arg,_)) =
   match arg with
   | A_nexp _
@@ -436,7 +436,7 @@ let split_src_type id ty (TypQ_aux (q,ql)) =
        let tys = List.concat (List.map (fun instty -> List.map (ty_and_inst instty) insts) tys) in
        let free = List.fold_left (fun vars k -> KidSet.remove k vars) vars kids in
        (free,tys)
-    | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
+    | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   in
   (* Only single-variable prenex-form for now *)
   let size_nvars_ty (Typ_aux (ty,l) as typ) =
@@ -545,7 +545,7 @@ let refine_constructor refinements l env id args =
           match List.find matches_refinement irefinements with
           | (_,new_id,_) -> Some (E_app (new_id,args))
           | exception Not_found ->
-             (Reporting.print_err false true l "Monomorphisation"
+             (Reporting.print_err l "Monomorphisation"
                 ("Unable to refine constructor " ^ string_of_id id);
               None)
     end
@@ -727,8 +727,10 @@ let fabricate_nexp_exist env l typ kids nc typ' =
       when Kid.compare kid kid'' = 0 &&
         Kid.compare kid kid''' = 0 ->
      nint 32
-  | _ -> raise (Reporting.err_general l
-                  ("Undefined value at unsupported type " ^ string_of_typ typ))
+  | ([], _, typ) -> nint 32
+  | (kids, nc, typ) ->
+     raise (Reporting.err_general l
+              ("Undefined value at unsupported type " ^ string_of_typ typ ^ " with " ^ Util.string_of_list ", " string_of_kid kids))
 
 let fabricate_nexp l tannot =
   match destruct_tannot tannot with
@@ -756,7 +758,7 @@ let reduce_cast typ exp l annot =
   | 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
+     if prove __POS__ nc_env nc
      then exp
      else raise (Reporting.err_unreachable l __POS__
                    ("Constant propagation error: literal " ^ Big_int.to_string n ^
@@ -1176,7 +1178,7 @@ let apply_pat_choices choices =
 let is_env_inconsistent env ksubsts =
   let env = KBindings.fold (fun k nexp env ->
     Env.add_constraint (nc_eq (nvar k) nexp) env) ksubsts env in
-  prove env nc_false
+  prove __POS__ env nc_false
 
 let split_defs all_errors splits defs =
   let no_errors_happened = ref true in
@@ -1190,9 +1192,9 @@ let split_defs all_errors splits defs =
     in
     let sc_type_def ((TD_aux (tda,annot)) as td) =
       match tda with
-      | TD_variant (id,nscm,quant,tus,flag) ->
+      | TD_variant (id,quant,tus,flag) ->
          let (refinements, tus') = List.split (List.map (sc_type_union quant) tus) in
-         (List.concat refinements, TD_aux (TD_variant (id,nscm,quant,List.concat tus',flag),annot))
+         (List.concat refinements, TD_aux (TD_variant (id,quant,List.concat tus',flag),annot))
       | _ -> ([],td)
     in
     let sc_def d =
@@ -1533,7 +1535,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.print_err false true l "Monomorphisation"
+      | [] -> (Reporting.print_err 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 ->
@@ -1580,7 +1582,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.print_err false true l' "Monomorphisation"
+               (Reporting.print_err l' "Monomorphisation"
                   "Unexpected kind of pattern for enumeration"; GiveUp)
           in findpat_generic checkpat (string_of_id id) assigns cases
        | _ -> None)
@@ -1603,11 +1605,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.print_err false true lit_l "Monomorphisation"
+                 (Reporting.print_err lit_l "Monomorphisation"
                     "Unexpected kind of literal for var match"; GiveUp)
             end
          | P_aux (_,(l',_)) ->
-            (Reporting.print_err false true l' "Monomorphisation"
+            (Reporting.print_err 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 ->
@@ -1627,11 +1629,11 @@ let split_defs all_errors splits defs =
               | _ -> DoesNotMatch) (DoesMatch ([],[])) matches in
             (match final with
             | GiveUp ->
-               (Reporting.print_err false true l "Monomorphisation"
+               (Reporting.print_err l "Monomorphisation"
                   "Unexpected kind of pattern for vector literal"; GiveUp)
             | _ -> final)
          | _ ->
-            (Reporting.print_err false true l "Monomorphisation"
+            (Reporting.print_err l "Monomorphisation"
                "Unexpected kind of pattern for vector literal"; GiveUp)
        in findpat_generic checkpat "vector literal" assigns cases
 
@@ -1649,7 +1651,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.print_err false true l' "Monomorphisation"
+            (Reporting.print_err l' "Monomorphisation"
                "Unexpected kind of pattern for literal"; GiveUp)
        in findpat_generic checkpat "literal" assigns cases
     | _ -> None
@@ -1663,7 +1665,7 @@ let split_defs all_errors splits defs =
     let substs = bindings_from_list substs, ksubsts in
     fst (const_prop_exp ref_vars substs Bindings.empty exp)
   in
-    
+
   (* Split a variable pattern into every possible value *)
 
   let split var pat_l annot =
@@ -1686,7 +1688,7 @@ let split_defs all_errors splits defs =
         else raise (Fatal_error error)
     in
     match ty with
-    | Typ_id (Id_aux (Id "bool",_)) ->
+    | Typ_id (Id_aux (Id "bool",_)) | Typ_app (Id_aux (Id "atom_bool", _), [_]) ->
        [P_aux (P_lit (L_aux (L_true,new_l)),(l,annot)),[var, E_aux (E_lit (L_aux (L_true,new_l)),(new_l,annot))],[],[];
         P_aux (P_lit (L_aux (L_false,new_l)),(l,annot)),[var, E_aux (E_lit (L_aux (L_false,new_l)),(new_l,annot))],[],[]]
 
@@ -1946,7 +1948,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.print_err false true l "Monomorphisation"
+             Reporting.print_err l "Monomorphisation"
                "Splitting a singleton pattern is not possible"
          in p
     in
@@ -2109,7 +2111,6 @@ let split_defs all_errors splits defs =
     in
     let map_def d =
       match d with
-      | DEF_kind _
       | DEF_type _
       | DEF_spec _
       | DEF_default _
@@ -2120,7 +2121,7 @@ let split_defs all_errors splits defs =
       | DEF_internal_mutrec _
         -> [d]
       | DEF_fundef fd -> [DEF_fundef (map_fundef fd)]
-      | DEF_mapdef (MD_aux (_, (l, _))) -> unreachable l __POS__ "mappings should be gone by now"
+      | DEF_mapdef (MD_aux (_, (l, _))) -> Reporting.unreachable l __POS__ "mappings should be gone by now"
       | DEF_val lb -> [DEF_val (map_letbind lb)]
       | DEF_scattered sd -> List.map (fun x -> DEF_scattered x) (map_scattered_def sd)
     in
@@ -2200,7 +2201,7 @@ let rec sizes_of_typ (Typ_aux (t,l)) =
      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"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and sizes_of_typarg (A_aux (ta,_)) =
   match ta with
     A_nexp _
@@ -2259,12 +2260,15 @@ let replace_with_the_value bound_nexps (E_aux (_,(l,_)) as exp) =
   let replace_size size = 
     (* TODO: pick simpler nexp when there's a choice (also in pretty printer) *)
     let is_equal nexp =
-      prove env (NC_aux (NC_equal (size,nexp), Parse_ast.Unknown))
+      prove __POS__ env (NC_aux (NC_equal (size,nexp), Parse_ast.Unknown))
     in
     if is_nexp_constant size then size else
-      match List.find is_equal bound_nexps with
-      | nexp -> nexp
-      | exception Not_found -> size
+      match solve env size with
+      | Some n -> nconstant n
+      | None ->
+         match List.find is_equal bound_nexps with
+         | nexp -> nexp
+         | exception Not_found -> size
   in
   let mk_exp nexp l l' =
     let nexp = replace_size nexp in
@@ -2273,30 +2277,18 @@ let replace_with_the_value bound_nexps (E_aux (_,(l,_)) as exp) =
                    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",_),
-                      [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",_),
-                      [A_aux (A_nexp nexp,l')]),_) ->
-     mk_exp nexp l l'
+  match destruct_numeric typ with
+  | Some ([], nc, nexp) when prove __POS__ env nc -> mk_exp nexp l l
   | _ -> raise (Reporting.err_unreachable l __POS__
-                  "atom stopped being an atom?")
+                  ("replace_with_the_value: Unsupported type " ^ string_of_typ typ))
 
 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",_),
-             [A_aux (A_nexp nexp,l');A_aux (A_nexp _,_)]) ->
-     Typ_aux (Typ_app (Id_aux (Id "itself",Generated Unknown),
-                       [A_aux (A_nexp nexp,l')]),Generated l)
-  | Typ_app (Id_aux (Id "atom",_),
-                      [A_aux (A_nexp nexp,l')]) ->
-     Typ_aux (Typ_app (Id_aux (Id "itself",Generated Unknown),
-                       [A_aux (A_nexp nexp,l')]),Generated l)
+  match destruct_numeric typ with
+  | Some ([], nc, nexp) when prove __POS__ env nc ->
+     Typ_aux (Typ_app (mk_id "itself", [A_aux (A_nexp nexp, Generated l)]), Generated l)
   | _ -> raise (Reporting.err_unreachable l __POS__
-                  "atom stopped being an atom?")
+                  ("replace_type: Unsupported type " ^ string_of_typ typ))
 
 
 let rewrite_size_parameters env (Defs defs) =
@@ -2345,9 +2337,9 @@ in *)
               | i -> IntSet.singleton i
               | exception Not_found ->
                  (* Look for equivalent nexps, but only in consistent type env *)
-                 if prove env (NC_aux (NC_false,Unknown)) then IntSet.empty else
+                 if prove __POS__ env (NC_aux (NC_false,Unknown)) then IntSet.empty else
                    match List.find (fun (nexp,i) -> 
-                     prove env (NC_aux (NC_equal (nexp,size),Unknown))) nexp_list with
+                     prove __POS__ env (NC_aux (NC_equal (nexp,size),Unknown))) nexp_list with
                    | _, i -> IntSet.singleton i
                    | exception Not_found -> IntSet.empty
           end
@@ -2430,15 +2422,15 @@ in *)
       | Some exp -> Some (fold_exp { id_exp_alg with e_app = rewrite_e_app } exp) in
     FCL_aux (FCL_Funcl (id,construct_pexp (pat,guard,body,(pl,empty_tannot))),(l,empty_tannot))
   in
-  let rewrite_letbind lb =
-    let rewrite_e_app (id,args) =
-      match Bindings.find id fn_sizes with
-      | to_change,_ ->
-         let args' = mapat (replace_with_the_value []) to_change args in
-         E_app (id,args')
-      | exception Not_found -> E_app (id,args)
-    in fold_letbind { id_exp_alg with e_app = rewrite_e_app } lb
+  let rewrite_e_app (id,args) =
+    match Bindings.find id fn_sizes with
+    | to_change,_ ->
+       let args' = mapat (replace_with_the_value []) to_change args in
+       E_app (id,args')
+    | exception Not_found -> E_app (id,args)
   in
+  let rewrite_letbind = fold_letbind { id_exp_alg with e_app = rewrite_e_app } in
+  let rewrite_exp = fold_exp { id_exp_alg with e_app = rewrite_e_app } in
   let rewrite_def = function
     | DEF_fundef (FD_aux (FD_function (recopt,tannopt,effopt,funcls),(l,_))) ->
        (* TODO rewrite tannopt? *)
@@ -2460,6 +2452,8 @@ in *)
          | _ -> spec
          | exception Not_found -> spec
        end
+    | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), a)) ->
+       DEF_reg_dec (DEC_aux (DEC_config (id, typ, rewrite_exp exp), a))
     | def -> def
   in
 (*
@@ -2732,7 +2726,7 @@ let merge rs rs' = {
 }
 
 type env = {
-  top_kids : kid list;
+  top_kids : kid list; (* Int kids bound by the function type *)
   var_deps : dependencies Bindings.t;
   kid_deps : dependencies KBindings.t;
   referenced_vars : IdSet.t
@@ -2848,11 +2842,15 @@ let rec deps_of_nc kid_deps (NC_aux (nc,l)) =
   | NC_true
   | NC_false
     -> dempty
+  | NC_app (Id_aux (Id "mod", _), [A_aux (A_nexp nexp1, _); A_aux (A_nexp nexp2, _)])
+    -> dmerge (deps_of_nexp l kid_deps [] nexp1) (deps_of_nexp l kid_deps [] nexp2)
+  | NC_var _ | NC_app _
+    -> dempty
 
-let deps_of_typ l kid_deps arg_deps typ =
+and deps_of_typ l kid_deps arg_deps typ =
   deps_of_tyvars l kid_deps arg_deps (tyvars_of_typ typ)
 
-let deps_of_typ_arg l fn_id env arg_deps (A_aux (aux, _)) =
+and 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 ->
@@ -2861,7 +2859,7 @@ let deps_of_typ_arg l fn_id env arg_deps (A_aux (aux, _)) =
   | 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
@@ -2936,7 +2934,9 @@ let simplify_size_nexp env typ_env (Nexp_aux (ne,l) as nexp) =
   | Some n -> nconstant n
   | None ->
      let is_equal kid =
-       prove typ_env (NC_aux (NC_equal (Nexp_aux (Nexp_var kid,Unknown), nexp),Unknown))
+       try
+         prove __POS__ typ_env (NC_aux (NC_equal (Nexp_aux (Nexp_var kid,Unknown), nexp),Unknown))
+       with _ -> false
      in
      match ne with
      | Nexp_var _
@@ -3364,12 +3364,11 @@ let initial_env fn_id fn_l (TypQ_aux (tq,_)) pat body set_assertions =
       | P_cons (p1,p2) -> of_list [p1;p2]
     in aux pat
   in
-  let quant = function
-    | QI_aux (QI_id (KOpt_aux (KOpt_kind (_,kid),_)),_) ->
-       Some kid
-    | QI_aux (QI_const _,_) -> None
+  let int_quant = function
+    | QI_aux (QI_id (KOpt_aux (KOpt_kind (K_aux (K_int,_),kid),_)),_) -> Some kid
+    | _ -> None
   in
-  let top_kids = Util.map_filter quant qs in
+  let top_kids = Util.map_filter int_quant qs in
   let _,var_deps,kid_deps = split3 (List.mapi arg pats) in
   let var_deps = List.fold_left dep_bindings_merge Bindings.empty var_deps in
   let kid_deps = List.fold_left dep_kbindings_merge KBindings.empty kid_deps in
@@ -3422,6 +3421,17 @@ let rec sets_from_assert e =
                [E_aux (E_sizeof (Nexp_aux (Nexp_var kid,_)),_);
                 E_aux (E_lit (L_aux (L_num i,_)),_)]) ->
          (check_kid kid; [i])
+      (* TODO: Now that E_constraint is re-written by the typechecker,
+         we'll end up with the following for the above - some of this
+         function is probably redundant now *)
+      | E_app (Id_aux (Id "eq_int",_),
+               [E_aux (E_app (Id_aux (Id "__id", _), [E_aux (E_id id, annot)]), _);
+                E_aux (E_lit (L_aux (L_num i,_)),_)]) ->
+         begin match typ_of_annot annot with
+         | Typ_aux (Typ_app (Id_aux (Id "atom", _), [A_aux (A_nexp (Nexp_aux (Nexp_var kid, _)), _)]), _) ->
+            check_kid kid; [i]
+         | _ -> raise Not_found
+         end
       | _ -> raise Not_found
     in try
          let is = aux e in
@@ -3586,11 +3596,11 @@ let analyse_defs debug env (Defs defs) =
     else ()
   in
   let splits = argset_to_list splits in
-  if Failures.is_empty fails 
+  if Failures.is_empty fails
   then (true,splits,extras) else
     begin
       Failures.iter (fun l msgs ->
-        Reporting.print_err false false l "Monomorphisation" (String.concat "\n" (StringSet.elements msgs)))
+        Reporting.print_err l "Monomorphisation" (String.concat "\n" (StringSet.elements msgs)))
         fails;
       (false, splits,extras)
     end
@@ -3615,7 +3625,7 @@ let add_extra_splits extras (Defs defs) =
          let loc = match Analysis.translate_loc l with
            | Some l -> l
            | None ->
-              (Reporting.print_err false false l "Monomorphisation"
+              (Reporting.print_err l "Monomorphisation"
                  "Internal error: bad location for added case";
                ("",0))
          in
@@ -3666,14 +3676,18 @@ let is_constant_vec_typ env typ =
 (* We have to add casts in here with appropriate length information so that the
    type checker knows the expected return types. *)
 
-let rewrite_app env typ (id,args) =
+let rec rewrite_app env typ (id,args) =
   let is_append = is_id env (Id "append") in
+  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
   let is_zero_extend =
-    is_id env (Id "Extend") id || is_id env (Id "ZeroExtend") 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 mk_exp e = E_aux (e, (Unknown, empty_tannot)) in
+  let try_cast_to_typ (E_aux (e,(l, _)) as exp) =
     let (size,order,bittyp) = vector_typ_args_of (Env.base_typ_of env typ) in
     match size with
     | Nexp_aux (Nexp_constant _,_) -> E_cast (typ,exp)
@@ -3681,10 +3695,8 @@ let rewrite_app env typ (id,args) =
       | Some c -> E_cast (vector_typ (nconstant c) order bittyp, exp)
       | None -> e
   in
+  let rewrap e = E_aux (e, (Unknown, empty_tannot)) in
   if is_append id 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
     match args with
       (* (known-size-vector @ variable-vector) @ variable-vector *)
     | [E_aux (E_app (append,
@@ -3744,6 +3756,14 @@ let rewrite_app env typ (id,args) =
                            (Unknown,empty_tannot))])
        end
 
+    (* variable-slice @ zeros *)
+    | [E_aux (E_app (slice1, [vector1; start1; len1]),_);
+       E_aux (E_app (zeros2, [len2]),_)]
+        when is_slice slice1 && is_zeros zeros2 &&
+          not (is_constant start1 && is_constant len1 && is_constant len2) ->
+       try_cast_to_typ
+         (mk_exp (E_app (mk_id "place_slice", [vector1; start1; len1; len2])))
+
     (* variable-range @ variable-range *)
     | [E_aux (E_app (subrange1,
                      [vector1; start1; end1]),_);
@@ -3797,9 +3817,14 @@ let rewrite_app env typ (id,args) =
        end
     | _ -> E_app (id,args)
 
-  else if is_id env (Id "eq_vec") id then
+  else if is_id env (Id "eq_vec") id || is_id env (Id "neq_vec") id then
     (* variable-range == variable_range *)
     let is_subrange = is_id env (Id "vector_subrange") in
+    let wrap e =
+      if is_id env (Id "neq_vec") id
+      then E_app (mk_id "not_bool", [mk_exp e])
+      else e
+    in
     match args with
     | [E_aux (E_app (subrange1,
                      [vector1; start1; end1]),_);
@@ -3807,17 +3832,37 @@ let rewrite_app env typ (id,args) =
                      [vector2; start2; end2]),_)]
         when is_subrange subrange1 && is_subrange subrange2 &&
           not (is_constant_range (start1, end1) || is_constant_range (start2, end2)) ->
-       E_app (mk_id "subrange_subrange_eq",
-              [vector1; start1; end1; vector2; start2; end2])
+       wrap (E_app (mk_id "subrange_subrange_eq",
+              [vector1; start1; end1; vector2; start2; end2]))
+    | [E_aux (E_app (slice1,
+                     [vector1; len1; start1]),_);
+       E_aux (E_app (slice2,
+                     [vector2; len2; start2]),_)]
+        when is_slice slice1 && is_slice slice2 &&
+          not (is_constant len1 && is_constant start1 && is_constant len2 && is_constant start2) ->
+       let upper start len =
+         mk_exp (E_app_infix (start, mk_id "+",
+                       mk_exp (E_app_infix (len, mk_id "-",
+                                     mk_exp (E_lit (mk_lit (L_num (Big_int.of_int 1))))))))
+       in
+       wrap (E_app (mk_id "subrange_subrange_eq",
+              [vector1; upper start1 len1; start1; vector2; upper start2 len2; start2]))
+    | [E_aux (E_app (slice1, [vector1; start1; len1]), _);
+       E_aux (E_app (zeros2, _), _)]
+      when is_slice slice1 && is_zeros zeros2 && not (is_constant len1) ->
+       wrap (E_app (mk_id "is_zeros_slice", [vector1; start1; len1]))
     | _ -> E_app (id,args)
 
   else if is_id env (Id "IsZero") id then
     match args with
     | [E_aux (E_app (subrange1, [vector1; start1; end1]),_)]
-        when is_id env (Id "vector_subrange") subrange1 &&
+        when (is_id env (Id "vector_subrange") subrange1) &&
           not (is_constant_range (start1,end1)) ->
-       E_app (mk_id "is_zero_subrange",
-              [vector1; start1; end1])
+       E_app (mk_id "is_zero_subrange", [vector1; start1; end1])
+    | [E_aux (E_app (slice1, [vector1; start1; len1]),_)]
+        when (is_slice slice1) &&
+          not (is_constant len1) ->
+       E_app (mk_id "is_zeros_slice", [vector1; start1; len1])
     | _ -> E_app (id,args)
 
   else if is_id env (Id "IsOnes") id then
@@ -3827,6 +3872,9 @@ let rewrite_app env typ (id,args) =
           not (is_constant_range (start1,end1)) ->
        E_app (mk_id "is_ones_subrange",
               [vector1; start1; end1])
+    | [E_aux (E_app (slice1, [vector1; start1; len1]),_)]
+        when is_slice slice1 && not (is_constant len1) ->
+       E_app (mk_id "is_ones_slice", [vector1; start1; len1])
     | _ -> E_app (id,args)
 
   else if is_zero_extend then
@@ -3834,54 +3882,59 @@ let rewrite_app env typ (id,args) =
     let is_slice = is_id env (Id "slice") in
     let is_zeros = is_id env (Id "Zeros") in
     let is_ones = is_id env (Id "Ones") in
-    match args with
-    | (E_aux (E_app (append1,
+    let length_arg = List.filter (fun arg -> is_number (typ_of arg)) args in
+    match List.filter (fun arg -> not (is_number (typ_of arg))) args with
+    | [E_aux (E_app (append1,
                      [E_aux (E_app (subrange1, [vector1; start1; end1]), _);
-                      E_aux (E_app (zeros1, [len1]),_)]),_))::
-        ([] | [_;E_aux (E_id (Id_aux (Id "unsigned",_)),_)])
+                      E_aux (E_app (zeros1, [len1]),_)]),_)]
         when is_subrange subrange1 && is_zeros zeros1 && is_append append1
-      -> E_app (mk_id "place_subrange",
-                [vector1; start1; end1; len1])
+      -> try_cast_to_typ (rewrap (E_app (mk_id "place_subrange", length_arg @ [vector1; start1; end1; len1])))
 
-    | (E_aux (E_app (append1,
+    | [E_aux (E_app (append1,
                      [E_aux (E_app (slice1, [vector1; start1; length1]), _);
-                      E_aux (E_app (zeros1, [length2]),_)]),_))::
-        ([] | [_;E_aux (E_id (Id_aux (Id "unsigned",_)),_)])
+                      E_aux (E_app (zeros1, [length2]),_)]),_)]
         when is_slice slice1 && is_zeros zeros1 && is_append append1
-      -> E_app (mk_id "place_slice",
-                [vector1; start1; length1; length2])
+      -> try_cast_to_typ (rewrap (E_app (mk_id "place_slice", length_arg @ [vector1; start1; length1; length2])))
 
     (* 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_cast (_, (E_aux (E_app (Id_aux ((Id "slice_slice_concat" | Id "subrange_subrange_concat" | Id "place_slice"),_) as op, args),_))),_)]
+      -> try_cast_to_typ (rewrap (E_app (op, length_arg @ 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 (op, args)
+    | [E_aux (E_app (Id_aux ((Id "slice_slice_concat" | Id "subrange_subrange_concat" | Id "place_slice"),_) as op, args),_)]
+      -> try_cast_to_typ (rewrap (E_app (op, length_arg @ args)))
 
     | [E_aux (E_app (slice1, [vector1; start1; length1]),_)]
         when is_slice slice1 && not (is_constant length1) ->
-       E_app (mk_id "zext_slice", [vector1; start1; length1])
+       try_cast_to_typ (rewrap (E_app (mk_id "zext_slice", length_arg @ [vector1; start1; length1])))
 
-    | [E_aux (E_app (ones, [len1]),_);
-       _ (* unnecessary ZeroExtend length *)]
-        when is_ones ones ->
-       E_app (mk_id "zext_ones", [len1])
+    | [E_aux (E_app (ones, [len1]),_)] when is_ones ones ->
+       try_cast_to_typ (rewrap (E_app (mk_id "zext_ones", length_arg @ [len1])))
 
     | _ -> E_app (id,args)
 
   else if is_id env (Id "SignExtend") id || is_id env (Id "sign_extend") id then
     let is_slice = is_id env (Id "slice") in
-    match args with
+    let length_arg = List.filter (fun arg -> is_number (typ_of arg)) args in
+    match List.filter (fun arg -> not (is_number (typ_of arg))) args with
     | [E_aux (E_app (slice1, [vector1; start1; length1]),_)]
         when is_slice slice1 && not (is_constant length1) ->
-       E_app (mk_id "sext_slice", [vector1; start1; length1])
+       try_cast_to_typ (rewrap (E_app (mk_id "sext_slice", length_arg @ [vector1; start1; length1])))
+
+    | [E_aux (E_app (append,
+         [E_aux (E_app (slice1, [vector1; start1; len1]), _);
+          E_aux (E_app (zeros2, [len2]), _)]), _)]
+      when is_append append && is_slice slice1 && is_zeros zeros2 &&
+           not (is_constant len1 && is_constant len2) ->
+       E_app (mk_id "place_slice_signed", length_arg @ [vector1; start1; len1; len2])
+
+    | [E_aux (E_cast (_, (E_aux (E_app (Id_aux ((Id "place_slice"),_), args),_))),_)]
+    | [E_aux (E_app (Id_aux ((Id "place_slice"),_), args),_)]
+      -> try_cast_to_typ (rewrap (E_app (mk_id "place_slice_signed", length_arg @ args)))
 
       (* If the original had a length, keep it *)
-    | [E_aux (E_app (slice1, [vector1; start1; length1]),_);length2]
+    (* | [E_aux (E_app (slice1, [vector1; start1; length1]),_);length2]
         when is_slice slice1 && not (is_constant length1) ->
        begin
          match Type_check.destruct_atom_nexp (env_of length2) (typ_of length2) with
@@ -3891,10 +3944,18 @@ let rewrite_app env typ (id,args) =
             E_cast (vector_typ nlen order bittyp,
                     E_aux (E_app (mk_id "sext_slice", [vector1; start1; length1]),
                            (Unknown,empty_tannot)))
-       end
+       end *)
 
     | _ -> E_app (id,args)
 
+  else if is_id env (Id "Extend") id then
+    match args with
+    | [vector; len; unsigned] ->
+       let extz = mk_exp (rewrite_app env typ (mk_id "ZeroExtend", [vector; len])) in
+       let exts = mk_exp (rewrite_app env typ (mk_id "SignExtend", [vector; len])) in
+       E_if (unsigned, extz, exts)
+    | _ -> E_app (id, args)
+
   else if is_id env (Id "UInt") id || is_id env (Id "unsigned") id then
     let is_slice = is_id env (Id "slice") in
     let is_subrange = is_id env (Id "vector_subrange") in
@@ -3908,6 +3969,13 @@ let rewrite_app env typ (id,args) =
 
     | _ -> E_app (id,args)
 
+  else if is_id env (Id "__SetSlice_bits") id then
+    match args with
+    | [len; slice_len; vector; pos; E_aux (E_app (zeros, _), _)]
+      when is_zeros zeros ->
+       E_app (mk_id "set_slice_zeros", [len; slice_len; vector; pos])
+    | _ -> E_app (id, args)
+
   else E_app (id,args)
 
 let rewrite_aux = function
@@ -3936,7 +4004,7 @@ let simplify_size_nexp env quant_kids nexp =
     | Some n -> Some (nconstant n)
     | None ->
        let is_equal kid =
-         prove env (NC_aux (NC_equal (Nexp_aux (Nexp_var kid,Unknown), nexp),Unknown))
+         prove __POS__ env (NC_aux (NC_equal (Nexp_aux (Nexp_var kid,Unknown), nexp),Unknown))
        in
        match List.find is_equal quant_kids with
        | kid -> Some (Nexp_aux (Nexp_var kid,Generated l))
@@ -3999,8 +4067,7 @@ let make_bitvector_cast_fns cast_name env quant_kids src_typ target_typ =
                [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' ->
-          if Nexp.compare size size' <> 0 then
+       | Some size, Some size' when Nexp.compare size size' <> 0 ->
           let var = fresh () in
           let tar_typ' = Typ_aux (Typ_app (t_id, [A_aux (A_nexp size',l_size');t_ord;t_bit]),
                                   tar_l) in
@@ -4011,10 +4078,6 @@ let make_bitvector_cast_fns cast_name env quant_kids src_typ target_typ =
                      E_aux (E_app (Id_aux (Id cast_name, genunk),
                                    [E_aux (E_id var, (genunk, src_ann))]), (genunk, tar_ann))),
              (genunk, tar_ann))
-          else
-          let var = fresh () in
-          P_aux (P_id var,(Generated src_l,src_ann)),
-          E_aux (E_id var,(Generated src_l,tar_ann))
        | _ ->
           let var = fresh () in
           P_aux (P_id var,(Generated src_l,src_ann)),
@@ -4076,7 +4139,7 @@ let make_bitvector_cast_exp cast_name cast_env quant_kids typ target_typ exp =
            let arg_typ' = subst_unifiers unifiers arg_typ in
            arg_typ'
        end
-    | _ -> typ_error l ("Malformed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
+    | _ -> typ_error env l ("Malformed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
 
   in
   (* Push the cast down, including through constructors *)
@@ -4237,7 +4300,7 @@ let add_bitvector_casts (Defs defs) =
   let rewrite_funcl (FCL_aux (FCL_Funcl (id,pexp),fcl_ann)) =
     let fcl_env = env_of_annot fcl_ann in
     let (tq,typ) = Env.get_val_spec_orig id fcl_env in
-    let quant_kids = List.map kopt_kid (quant_kopts tq) in
+    let quant_kids = List.map kopt_kid (List.filter is_nat_kopt (quant_kopts tq)) in
     let ret_typ =
       match typ with
       | Typ_aux (Typ_fn (_,ret,_),_) -> ret
@@ -4270,9 +4333,8 @@ let add_bitvector_casts (Defs defs) =
     let bitsn = vector_typ (nvar kid) dec_ord bit_typ in
     let ts = mk_typschm (mk_typquant [mk_qi_id K_int kid])
                (function_typ [bitsn] bitsn no_effect) in
-    let extfn _ = Some "zeroExtend" in
     let mkfn name =
-      mk_val_spec (VS_val_spec (ts,name,extfn,false))
+      mk_val_spec (VS_val_spec (ts,name,[("_", "zeroExtend")],false))
     in
     let defs = List.map mkfn (IdSet.elements !specs_required) in
     check Env.empty (Defs defs)
@@ -4303,11 +4365,11 @@ let replace_nexp_in_typ env typ orig new_nexp =
     | Typ_app (id, targs) ->
        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"
+    | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   and aux_targ (A_aux (ta,l) as typ_arg) =
     match ta with
     | A_nexp nexp ->
-       if prove env (nc_eq nexp orig)
+       if prove __POS__ env (nc_eq nexp orig)
        then true, A_aux (A_nexp new_nexp,l)
        else false, typ_arg
     | A_typ typ ->
@@ -4336,7 +4398,7 @@ let fresh_nexp_kid nexp =
 
 let rewrite_toplevel_nexps (Defs defs) =
   let find_nexp env nexp_map nexp =
-    let is_equal (kid,nexp') = prove env (nc_eq nexp nexp') in
+    let is_equal (kid,nexp') = prove __POS__ env (nc_eq nexp nexp') in
     List.find is_equal nexp_map
   in
   let rec rewrite_typ_in_spec env nexp_map (Typ_aux (t,ann) as typ_full) =
@@ -4413,7 +4475,9 @@ let rewrite_toplevel_nexps (Defs defs) =
             VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (tqs,typ),ts_l),id,ext_opt,is_cast),ann) in
           Some (id, nexp_map, vs)
   in
-  let rewrite_typ_in_body env nexp_map typ =
+  (* Changing types in the body confuses simple sizeof rewriting, so turn it
+     off for now *)
+  (* let rewrite_typ_in_body env nexp_map typ =
     let rec aux (Typ_aux (t,l) as typ_full) =
     match t with
     | Typ_tup typs -> Typ_aux (Typ_tup (List.map aux typs),l)
@@ -4425,10 +4489,23 @@ let rewrite_toplevel_nexps (Defs defs) =
       match ta with
       | 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,_) -> A_aux (A_nexp (nvar kid),l)
-         | exception Not_found -> ta_full
+      | A_nexp nexp -> A_aux (A_nexp (aux_nexp nexp), l)
+      | A_bool nc -> A_aux (A_bool (aux_nconstraint nc), l)
+    and aux_nexp nexp =
+      match find_nexp env nexp_map nexp with
+      | (kid,_) -> nvar kid
+      | exception Not_found -> nexp
+    and aux_nconstraint (NC_aux (nc, l)) =
+      let rewrap nc = NC_aux (nc, l) in
+      match nc with
+      | NC_equal (n1, n2) -> rewrap (NC_equal (aux_nexp n1, aux_nexp n2))
+      | NC_bounded_ge (n1, n2) -> rewrap (NC_bounded_ge (aux_nexp n1, aux_nexp n2))
+      | NC_bounded_le (n1, n2) -> rewrap (NC_bounded_le (aux_nexp n1, aux_nexp n2))
+      | NC_not_equal (n1, n2) -> rewrap (NC_not_equal (aux_nexp n1, aux_nexp n2))
+      | NC_or (nc1, nc2) -> rewrap (NC_or (aux_nconstraint nc1, aux_nconstraint nc2))
+      | NC_and (nc1, nc2) -> rewrap (NC_and (aux_nconstraint nc1, aux_nconstraint nc2))
+      | NC_app (id, args) -> rewrap (NC_app (id, List.map aux_targ args))
+      | _ -> rewrap nc
     in aux typ
   in
   let rewrite_one_exp nexp_map (e,ann) =
@@ -4456,19 +4533,19 @@ let rewrite_toplevel_nexps (Defs defs) =
     match Bindings.find id spec_map with
     | nexp_map -> FCL_aux (FCL_Funcl (id,rewrite_body nexp_map pexp),ann)
     | exception Not_found -> funcl
-  in
+  in *)
   let rewrite_def spec_map def =
     match def with
     | DEF_spec vs -> (match rewrite_valspec vs with
       | None -> spec_map, def
       | Some (id, nexp_map, vs) -> Bindings.add id nexp_map spec_map, DEF_spec vs)
-    | DEF_fundef (FD_aux (FD_function (recopt,_,eff,funcls),ann)) ->
+    (* | DEF_fundef (FD_aux (FD_function (recopt,_,eff,funcls),ann)) ->
        (* Type annotations on function definitions will have been turned into
           valspecs by type checking, so it should be safe to drop them rather
           than updating them. *)
        let tann = Typ_annot_opt_aux (Typ_annot_opt_none,Generated Unknown) in
        spec_map,
-       DEF_fundef (FD_aux (FD_function (recopt,tann,eff,List.map (rewrite_funcl spec_map) funcls),ann))
+       DEF_fundef (FD_aux (FD_function (recopt,tann,eff,List.map (rewrite_funcl spec_map) funcls),ann)) *)
     | _ -> spec_map, def
   in
   let _, defs = List.fold_left (fun (spec_map,t) def ->
diff --git a/src/myocamlbuild.ml b/src/myocamlbuild.ml
index f408703f..ae45857d 100644
--- a/src/myocamlbuild.ml
+++ b/src/myocamlbuild.ml
@@ -79,6 +79,8 @@ let lem_opts = [A "-lib"; P "../gen_lib";
 
 dispatch begin function
 | After_rules ->
+    (* Bisect_ppx_plugin.handle_coverage (); *)
+
     (* ocaml_lib "lem_interp/interp"; *)
     ocaml_lib ~extern:false ~dir:"pprint/src" ~tag_name:"use_pprint" "pprint/src/PPrintLib";
 
diff --git a/src/nl_flow.ml b/src/nl_flow.ml
index e38e5fa5..6196f23b 100644
--- a/src/nl_flow.ml
+++ b/src/nl_flow.ml
@@ -91,7 +91,7 @@ let add_assert cond (E_aux (aux, (l, ())) as exp) =
 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 ->
+       when (string_of_id f = "unsigned" || string_of_id f = "UInt") && Id.compare id id' = 0 ->
      begin match pat_id pat with
      | None -> exp
      | Some uid ->
diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml
index 09be449d..2cbdfab2 100644
--- a/src/ocaml_backend.ml
+++ b/src/ocaml_backend.ml
@@ -128,6 +128,7 @@ let ocaml_typ_id ctx = function
   | id when Id.compare id (mk_id "list") = 0 -> string "list"
   | id when Id.compare id (mk_id "bit") = 0 -> string "bit"
   | id when Id.compare id (mk_id "int") = 0 -> string "Big_int.num"
+  | id when Id.compare id (mk_id "implicit") = 0 -> string "Big_int.num"
   | id when Id.compare id (mk_id "nat") = 0 -> string "Big_int.num"
   | id when Id.compare id (mk_id "bool") = 0 -> string "bool"
   | id when Id.compare id (mk_id "unit") = 0 -> string "unit"
@@ -393,7 +394,7 @@ let initial_value_for id inits =
 
 let ocaml_dec_spec ctx (DEC_aux (reg, _)) =
   match reg with
-  | DEC_reg (typ, id) ->
+  | DEC_reg (_, _, typ, id) ->
      separate space [string "let"; zencode ctx id; colon;
                      parens (ocaml_typ ctx typ); string "ref"; equals;
                      string "ref"; parens (ocaml_exp ctx (initial_value_for id ctx.register_inits))]
@@ -588,31 +589,39 @@ let ocaml_string_of_abbrev ctx id typq typ =
 let ocaml_string_of_variant ctx id typq cases =
   separate space [string "let"; ocaml_string_of id; string "_"; equals; string "\"VARIANT\""]
 
-let ocaml_typedef ctx (TD_aux (td_aux, _)) =
+let ocaml_typedef ctx (TD_aux (td_aux, (l, _))) =
   match td_aux with
-  | TD_record (id, _, typq, fields, _) ->
+  | TD_record (id, typq, fields, _) ->
      ((separate space [string "type"; ocaml_typquant typq; zencode ctx id; equals; lbrace]
        ^//^ ocaml_fields ctx fields)
       ^/^ rbrace)
      ^^ ocaml_def_end
      ^^ ocaml_string_of_struct ctx id typq fields
-  | TD_variant (id, _, _, cases, _) when string_of_id id = "exception" ->
+     ^^ ocaml_def_end
+  | TD_variant (id, _, cases, _) when string_of_id id = "exception" ->
      ocaml_exceptions ctx cases
-  | TD_variant (id, _, typq, cases, _) ->
+     ^^ ocaml_def_end
+  | TD_variant (id, typq, cases, _) ->
      (separate space [string "type"; ocaml_typquant typq; zencode ctx id; equals]
       ^//^ ocaml_cases ctx cases)
      ^^ ocaml_def_end
      ^^ ocaml_string_of_variant ctx id typq cases
-  | TD_enum (id, _, ids, _) ->
+     ^^ ocaml_def_end
+  | TD_enum (id, ids, _) ->
      (separate space [string "type"; zencode ctx id; equals]
       ^//^ (bar ^^ space ^^ ocaml_enum ctx ids))
      ^^ ocaml_def_end
      ^^ ocaml_string_of_enum ctx id ids
+     ^^ ocaml_def_end
   | 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
- | _ -> failwith "Unsupported typedef"
+     ^^ ocaml_def_end
+  | TD_abbrev _ ->
+     empty
+  | TD_bitfield _ ->
+     Reporting.unreachable l __POS__ "Bitfield should be re-written"
 
 let get_externs (Defs defs) =
   let extern_id (VS_aux (VS_val_spec (typschm, id, exts, _), _)) =
@@ -636,7 +645,7 @@ let ocaml_def ctx def = match def with
   | DEF_fundef fd -> group (ocaml_fundef ctx fd) ^^ twice hardline
   | DEF_internal_mutrec fds ->
      separate_map (twice hardline) (fun fd -> group (ocaml_fundef ctx fd)) fds ^^ twice hardline
-  | DEF_type td -> nf_group (ocaml_typedef ctx td) ^^ ocaml_def_end
+  | DEF_type td -> nf_group (ocaml_typedef ctx td)
   | DEF_val lb -> nf_group (string "let" ^^ space ^^ ocaml_letbind ctx lb) ^^ ocaml_def_end
   | _ -> empty
 
@@ -714,9 +723,9 @@ let ocaml_pp_generators ctx defs orig_types required =
     match td with
     | TD_abbrev (_, _, A_aux (A_typ typ, _)) ->
        add_req_from_typ required typ
-    | TD_record (_, _, _, fields, _) ->
+    | TD_record (_, _, fields, _) ->
        List.fold_left (fun req (typ,_) -> add_req_from_typ req typ) required fields
-    | TD_variant (_, _, _, variants, _) ->
+    | TD_variant (_, _, variants, _) ->
        List.fold_left (fun req (Tu_aux (Tu_ty_id (typ,_),_)) ->
            add_req_from_typ req typ) required variants
     | TD_enum _ -> required
@@ -730,8 +739,8 @@ let ocaml_pp_generators ctx defs orig_types required =
       | TD_aux (td,_) ->
          (match td with
           | TD_abbrev (_,tqs,A_aux (A_typ _, _)) -> tqs
-          | TD_record (_,_,tqs,_,_) -> tqs
-          | TD_variant (_,_,tqs,_,_) -> 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)
@@ -853,7 +862,7 @@ let ocaml_pp_generators ctx defs orig_types required =
         match td with
         | TD_abbrev (_,tqs,A_aux (A_typ typ, _)) ->
            tqs, gen_type typ, None, None
-        | TD_variant (_,_,tqs,variants,_) ->
+        | TD_variant (_,tqs,variants,_) ->
            tqs,
            string "let c = rand_choice [" ^^ group (nest 2 (break 0 ^^
              separate_map (string ";" ^^ break 1) rand_variant variants) ^^
@@ -861,7 +870,7 @@ let ocaml_pp_generators ctx defs orig_types required =
              string "] in c g",
            Some (separate_map (string ";" ^^ break 1) variant_constructor variants),
            Some (separate_map (break 1) build_constructor variants)
-        | TD_enum (_,_,variants,_) ->
+        | TD_enum (_,variants,_) ->
            TypQ_aux (TypQ_no_forall, Parse_ast.Unknown),
            string "rand_choice [" ^^ group (nest 2 (break 0 ^^
              separate_map (string ";" ^^ break 1) (zencode_upper ctx) variants) ^^
@@ -869,7 +878,7 @@ 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,_) ->
+        | TD_record (_,tqs,fields,_) ->
            tqs, braces (separate_map (string ";" ^^ break 1) rand_field fields), None, None
         | _ ->
            raise (Reporting.err_todo l "Generators for bitfields not yet supported")
@@ -969,7 +978,7 @@ let ocaml_compile spec defs generator_types =
   let sail_dir =
     try Sys.getenv "SAIL_DIR" with
     | Not_found ->
-       let share_dir = Share_directory.d in
+       let share_dir = Manifest.dir in
        if Sys.file_exists share_dir then
          share_dir
        else
diff --git a/src/parse_ast.ml b/src/parse_ast.ml
index c47ca931..5f0d7487 100644
--- a/src/parse_ast.ml
+++ b/src/parse_ast.ml
@@ -275,6 +275,8 @@ exp_aux =  (* Expression *)
  | E_return of exp
  | E_assert of exp * exp
  | E_var of exp * exp * exp
+ | E_internal_plet of pat * exp * exp
+ | E_internal_return of exp
 
 and exp = 
    E_aux of exp_aux * l
@@ -343,13 +345,6 @@ type_union_aux =  (* Type union constructors *)
    Tu_ty_id of atyp * id
  | Tu_ty_anon_rec of (atyp * id) list * id
 
-
-type 
-name_scm_opt_aux =  (* Optional variable-naming-scheme specification for variables of defined type *)
-   Name_sect_none
- | Name_sect_some of string
-
-
 type 
 tannot_opt = 
    Typ_annot_opt_aux of tannot_opt_aux * l
@@ -376,19 +371,13 @@ type_union =
 
 type 
 index_range_aux =  (* index specification, for bitfields in register types *)
-   BF_single of Big_int.num (* single index *)
- | BF_range of Big_int.num * Big_int.num (* index range *)
+   BF_single of atyp       (* single index *)
+ | BF_range of atyp * atyp (* index range *)
  | BF_concat of index_range * index_range (* concatenation of index ranges *)
 
 and index_range = 
    BF_aux of index_range_aux * l
 
-
-type 
-name_scm_opt = 
-   Name_sect_aux of name_scm_opt_aux * l
-
-
 type 
 default_typing_spec_aux =  (* Default kinding or typing assumption, and default order for literal vectors and vector shorthands *)
    DT_order of kind * atyp
@@ -447,23 +436,18 @@ fundef_aux =  (* Function definition *)
 type 
 type_def_aux =  (* Type definition body *)
    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 *)
+ | TD_record of id * typquant * ((atyp * id)) list * bool (* struct type definition *)
+ | TD_variant of id * typquant * (type_union) list * bool (* union type definition *)
+ | TD_enum of id * (id) list * bool (* enumeration type definition *)
  | TD_bitfield of id * atyp * (id * index_range) list (* register mutable bitfield type definition *)
 
 type 
 val_spec_aux =  (* Value type specification *)
    VS_val_spec of typschm * id * (string * string) list * bool
 
-
-type 
-kind_def_aux =  (* Definition body for elements of kind; many are shorthands for type\_defs *)
-   KD_nabbrev of kind * id * name_scm_opt * atyp (* type abbreviation *)
-
 type 
 dec_spec_aux =  (* Register declarations *)
-   DEC_reg of atyp * id
+   DEC_reg of atyp * atyp * atyp * id
  | DEC_config of id * atyp * exp
  | DEC_alias of id * exp
  | DEC_typ_alias of atyp * id * exp
@@ -474,7 +458,7 @@ scattered_def_aux =  (* Function and type union definitions that can be spread a
          a file. Each one must end in $_$ *)
    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_variant of id * 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
@@ -500,12 +484,6 @@ type
 val_spec = 
    VS_aux of val_spec_aux * l
 
-
-type 
-kind_def = 
-   KD_aux of kind_def_aux * l
-
-
 type 
 dec_spec = 
    DEC_aux of dec_spec_aux * l
@@ -521,8 +499,7 @@ type fixity_token = (prec * Big_int.num * string)
 
 type
 def =  (* Top-level definition *)
-   DEF_kind of kind_def (* definition of named kind identifiers *)
- | DEF_type of type_def (* type definition *)
+   DEF_type of type_def (* type definition *)
  | DEF_fundef of fundef (* function definition *)
  | DEF_mapdef of mapdef (* mapping definition *)
  | DEF_val of letbind (* value definition *)
diff --git a/src/parser.mly b/src/parser.mly
index abf533c3..2cd0dbe1 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -134,7 +134,6 @@ let mk_typqn = (TypQ_aux(TypQ_no_forall,Unknown))
 let mk_tannotn = Typ_annot_opt_aux(Typ_annot_opt_none,Unknown)
 let mk_tannot typq typ n m = Typ_annot_opt_aux(Typ_annot_opt_some (typq, typ), loc n m)
 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)
 
@@ -178,12 +177,13 @@ let rec desugar_rchain chain s e =
 
 /*Terminals with no content*/
 
-%token And As Assert Bitzero Bitone By Match Clause Dec Default Effect End Op Where
+%token And As Assert Bitzero Bitone By Match Clause Dec Default Effect End Op
 %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 Constant Constraint Throw Try Catch Exit Bitfield
+%token Undefined Union Newtype With Val 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 TerminationMeasure
+%token InternalPLet InternalReturn
 
 %nonassoc Then
 %nonassoc Else
@@ -807,6 +807,12 @@ exp:
   | While exp Do exp
     { mk_exp (E_loop (While, $2, $4)) $startpos $endpos }
 
+  /* Debugging only, will be rejected in initial_check if debugging isn't on */
+  | InternalPLet pat Eq exp In exp
+    { mk_exp (E_internal_plet ($2,$4,$6)) $startpos $endpos }
+  | InternalReturn exp
+    { mk_exp (E_internal_return($2)) $startpos $endpos }
+
 /* The following implements all nine levels of user-defined precedence for
 operators in expressions, with both left, right and non-associative operators */
 
@@ -1124,9 +1130,9 @@ funcl_typ:
     { mk_tannot mk_typqn $1 $startpos $endpos }
 
 index_range:
-  | Num
+  | typ
     { mk_ir (BF_single $1) $startpos $endpos }
-  | Num DotDot Num
+  | typ DotDot typ
     { mk_ir (BF_range ($1, $3)) $startpos $endpos }
 
 r_id_def:
@@ -1170,21 +1176,21 @@ type_def:
   | 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 }
+    { mk_td (TD_record ($2, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), $5, false)) $startpos $endpos }
   | Struct id typaram Eq Lcurly struct_fields Rcurly
-    { mk_td (TD_record ($2, mk_namesectn, $3, $6, false)) $startpos $endpos }
+    { mk_td (TD_record ($2, $3, $6, false)) $startpos $endpos }
   | Enum id Eq enum_bar
-    { mk_td (TD_enum ($2, mk_namesectn, $4, false)) $startpos $endpos }
+    { mk_td (TD_enum ($2, $4, false)) $startpos $endpos }
   | Enum id Eq Lcurly enum Rcurly
-    { mk_td (TD_enum ($2, mk_namesectn, $5, false)) $startpos $endpos }
+    { mk_td (TD_enum ($2, $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 }
+    { mk_td (TD_variant ($2, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), [$4], false)) $startpos $endpos }
   | Newtype id typaram Eq type_union
-    { mk_td (TD_variant ($2, mk_namesectn, $3, [$5], false)) $startpos $endpos }
+    { mk_td (TD_variant ($2, $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 }
+    { mk_td (TD_variant ($2, TypQ_aux (TypQ_tq [], loc $endpos($2) $startpos($3)), $5, false)) $startpos $endpos }
   | Union id typaram Eq Lcurly type_unions Rcurly
-    { mk_td (TD_variant ($2, mk_namesectn, $3, $6, false)) $startpos $endpos }
+    { mk_td (TD_variant ($2, $3, $6, false)) $startpos $endpos }
   | Bitfield id Colon typ Eq Lcurly r_def_body Rcurly
     { mk_td (TD_bitfield ($2, $4, $7)) $startpos $endpos }
 
@@ -1363,7 +1369,11 @@ val_spec_def:
 
 register_def:
   | Register id Colon typ
-    { mk_reg_dec (DEC_reg ($4, $2)) $startpos $endpos }
+    { let rreg = mk_typ (ATyp_set [mk_effect BE_rreg $startpos($1) $endpos($1)]) $startpos($1) $endpos($1) in
+      let wreg = mk_typ (ATyp_set [mk_effect BE_wreg $startpos($1) $endpos($1)]) $startpos($1) $endpos($1) in
+      mk_reg_dec (DEC_reg (rreg, wreg, $4, $2)) $startpos $endpos }
+  | Register effect_set effect_set id Colon typ
+    { mk_reg_dec (DEC_reg ($2, $3, $6, $4)) $startpos $endpos }
   | Register Configuration id Colon typ Eq exp
     { mk_reg_dec (DEC_config ($3, $5, $7)) $startpos $endpos }
 
@@ -1375,9 +1385,9 @@ default_def:
 
 scattered_def:
   | Union id typaram
-    { mk_sd (SD_variant($2, mk_namesectn, $3)) $startpos $endpos }
+    { mk_sd (SD_variant($2, $3)) $startpos $endpos }
   | Union id
-    { mk_sd (SD_variant($2, mk_namesectn, mk_typqn)) $startpos $endpos }
+    { mk_sd (SD_variant($2, mk_typqn)) $startpos $endpos }
   | Function_ id
     { mk_sd (SD_function(mk_recn, mk_tannotn, mk_eannotn, $2)) $startpos $endpos }
   | Mapping id
@@ -1423,9 +1433,6 @@ def:
     { DEF_scattered (mk_sd (SD_end $2) $startpos $endpos) }
   | default_def
     { DEF_default $1 }
-  | 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/pp.ml b/src/pp.ml
deleted file mode 100644
index b3eaf1fc..00000000
--- a/src/pp.ml
+++ /dev/null
@@ -1,80 +0,0 @@
-(**************************************************************************)
-(*     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.                                                          *)
-(**************************************************************************)
-
-(** pretty printing utilities *)
-
-open Format
-
-let pp_str ppf s =
-  fprintf ppf "%s" s
-
-let rec lst sep f ppf = function
-  | [] -> ()
-  | [x] ->
-      fprintf ppf "%a"
-        f x
-  | (h::t) -> 
-      f ppf h;
-      fprintf ppf sep;
-      lst sep f ppf t
-
-let opt f ppf = function
-  | None ->
-      fprintf ppf "None"
-  | Some(x) ->
-      fprintf ppf "Some(%a)"
-        f x
-
-let pp_to_string pp =
-  let b = Buffer.create 16 in
-  let f = formatter_of_buffer b in
-    pp f;
-    pp_print_flush f ();
-    Buffer.contents b
diff --git a/src/pretty_print.mli b/src/pretty_print.mli
index 2aaf5318..5537f42c 100644
--- a/src/pretty_print.mli
+++ b/src/pretty_print.mli
@@ -52,4 +52,4 @@ open Ast
 open Type_check
 
 (* Prints on formatter the defs as Lem Ast nodes *)
-val pp_defs_lem : (out_channel * string list) -> (out_channel * string list) -> tannot defs -> string -> unit
+val pp_defs_lem : (out_channel * string list) -> (out_channel * string list) -> Env.t -> tannot defs -> string -> unit
diff --git a/src/pretty_print_common.ml b/src/pretty_print_common.ml
index c01896ac..3a1deed0 100644
--- a/src/pretty_print_common.ml
+++ b/src/pretty_print_common.ml
@@ -89,10 +89,12 @@ let doc_id (Id_aux(i,_)) =
        * token in case of x ending with star. *)
       parens (separate space [string "deinfix"; string x; empty])
 
+(*
 let rec doc_range (BF_aux(r,_)) = match r with
   | BF_single i -> doc_int i
   | 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 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 b5d72807..46d07cc3 100644
--- a/src/pretty_print_coq.ml
+++ b/src/pretty_print_coq.ml
@@ -51,10 +51,10 @@
 open Type_check
 open Ast
 open Ast_util
+open Reporting
 open Rewriter
 open PPrint
 open Pretty_print_common
-open Extra_pervasives
 
 module StringSet = Set.Make(String)
 
@@ -84,7 +84,7 @@ type context = {
   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;
+  build_at_return : string option;
   recursive_ids : IdSet.t;
   debug : bool;
 }
@@ -93,7 +93,7 @@ let empty_ctxt = {
   kid_renames = KBindings.empty;
   kid_id_renames = KBindings.empty;
   bound_nvars = KidSet.empty;
-  build_ex_return = false;
+  build_at_return = None;
   recursive_ids = IdSet.empty;
   debug = false;
 }
@@ -272,6 +272,27 @@ let rec orig_nexp (Nexp_aux (nexp, l)) =
   | Nexp_neg n -> rewrap (Nexp_neg (orig_nexp n))
   | _ -> rewrap nexp
 
+let rec orig_nc (NC_aux (nc, l) as full_nc) =
+  let rewrap nc = NC_aux (nc, l) in
+  match nc with
+  | NC_equal (nexp1, nexp2) -> rewrap (NC_equal (orig_nexp nexp1, orig_nexp nexp2))
+  | NC_bounded_ge (nexp1, nexp2) -> rewrap (NC_bounded_ge (orig_nexp nexp1, orig_nexp nexp2))
+  | NC_bounded_le (nexp1, nexp2) -> rewrap (NC_bounded_le (orig_nexp nexp1, orig_nexp nexp2))
+  | NC_not_equal (nexp1, nexp2) -> rewrap (NC_not_equal (orig_nexp nexp1, orig_nexp nexp2))
+  | NC_set (kid,s) -> rewrap (NC_set (orig_kid kid, s))
+  | NC_or (nc1, nc2) -> rewrap (NC_or (orig_nc nc1, orig_nc nc2))
+  | NC_and (nc1, nc2) -> rewrap (NC_and (orig_nc nc1, orig_nc nc2))
+  | NC_app (f,args) -> rewrap (NC_app (f,List.map orig_typ_arg args))
+  | NC_var kid -> rewrap (NC_var (orig_kid kid))
+  | NC_true | NC_false -> full_nc
+and orig_typ_arg (A_aux (arg,l)) =
+  let rewrap a = (A_aux (a,l)) in
+  match arg with
+  | A_nexp nexp -> rewrap (A_nexp (orig_nexp nexp))
+  | A_bool nc -> rewrap (A_bool (orig_nc nc))
+  | A_order _ | A_typ _ ->
+       raise (Reporting.err_unreachable l __POS__ "Tried to pass Type or Order kind to SMT function")
+
 (* Returns the set of type variables that will appear in the Coq output,
    which may be smaller than those in the Sail type.  May need to be
    updated with doc_typ *)
@@ -289,6 +310,7 @@ let rec coq_nvars_of_typ (Typ_aux (t,l)) =
   | Typ_app(Id_aux (Id "implicit", _),_)
   (* TODO: update when complex atom types are sorted out *)
   | Typ_app(Id_aux (Id "atom", _), _) -> KidSet.empty
+  | Typ_app(Id_aux (Id "atom_bool", _), _) -> KidSet.empty
   | Typ_app (_,tas) ->
      List.fold_left (fun s ta -> KidSet.union s (coq_nvars_of_typ_arg ta))
        KidSet.empty tas
@@ -301,71 +323,7 @@ and coq_nvars_of_typ_arg (A_aux (ta,_)) =
   | 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 =
-  let rec l85 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_or (nc1, nc2) -> doc_op (string "\\/") (doc_nc_prop ctx nc1) (doc_nc_prop ctx nc2)
-  | _ -> l80 nc_full
-  and l80 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_and (nc1, nc2) -> doc_op (string "/\\") (doc_nc_prop ctx nc1) (doc_nc_prop ctx nc2)
-  | _ -> l70 nc_full
-  and l70 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_equal (ne1, ne2) -> doc_op equals (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_bounded_ge (ne1, ne2) -> doc_op (string ">=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_bounded_le (ne1, ne2) -> doc_op (string "<=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | NC_not_equal (ne1, ne2) -> doc_op (string "<>") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-  | _ -> l10 nc_full
-  and l10 (NC_aux (nc,_) as nc_full) =
-  match nc with
-  | NC_set (kid, is) ->
-     separate space [string "In"; doc_var ctx kid;
-                     brackets (separate (string "; ")
-                                 (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
-  | NC_true -> string "True"
-  | NC_false -> string "False"
-  | NC_or _
-  | NC_and _
-  | NC_equal _
-  | NC_bounded_ge _
-  | NC_bounded_le _
-  | NC_not_equal _ -> parens (l85 nc_full)
-  in l85 nc
-
-(* Follows Coq precedence levels *)
-let doc_nc_exp ctx nc =
-  let rec l70 (NC_aux (nc,_) as nc_full) =
-    match nc with
-    | NC_equal (ne1, ne2) -> doc_op (string "=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-    | NC_bounded_ge (ne1, ne2) -> doc_op (string ">=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-    | NC_bounded_le (ne1, ne2) -> doc_op (string "<=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
-    | _ -> l50 nc_full
-  and l50 (NC_aux (nc,_) as nc_full) =
-    match nc with
-    | NC_or (nc1, nc2) -> doc_op (string "||") (l50 nc1) (l40 nc2)
-    | _ -> l40 nc_full
-  and l40 (NC_aux (nc,_) as nc_full) =
-    match nc with
-    | NC_and (nc1, nc2) -> doc_op (string "&&") (l40 nc1) (l10 nc2)
-    | _ -> l10 nc_full
-  and l10 (NC_aux (nc,_) as nc_full) =
-    match nc with
-    | NC_not_equal (ne1, ne2) -> string "negb" ^^ space ^^ parens (doc_op (string "=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2))
-    | NC_set (kid, is) ->
-       separate space [string "member_Z_list"; doc_var ctx kid;
-                       brackets (separate (string "; ")
-                                   (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
-    | NC_true -> string "true"
-    | NC_false -> string "false"
-    | NC_equal _
-    | NC_bounded_ge _
-    | NC_bounded_le _
-    | NC_or _
-    | NC_and _ -> parens (l70 nc_full)
-  in l70 nc
+  | A_bool nc -> tyvars_of_constraint (orig_nc nc)
 
 let maybe_expand_range_type (Typ_aux (typ,l) as full_typ) =
   match typ with
@@ -385,18 +343,6 @@ let maybe_expand_range_type (Typ_aux (typ,l) as full_typ) =
 
 let expand_range_type typ = Util.option_default typ (maybe_expand_range_type typ)
 
-let doc_arithfact ctxt ?(exists = []) ?extra nc =
-  let prop = doc_nc_prop ctxt nc in
-  let prop = match extra with
-    | None -> prop
-    | Some pp -> separate space [pp; string "/\\"; prop]
-  in
-  let prop =
-    match exists with
-    | [] -> prop
-    | _ -> separate space ([string "exists"]@(List.map (doc_var ctxt) exists)@[comma; prop])
-  in
-  string "ArithFact" ^^ space ^^ parens prop
 
 let nice_and nc1 nc2 =
 match nc1, nc2 with
@@ -404,9 +350,28 @@ match nc1, nc2 with
 | _, NC_aux (NC_true,_) -> nc1
 | _,_ -> nc_and nc1 nc2
 
+let nice_iff nc1 nc2 =
+match nc1, nc2 with
+| NC_aux (NC_true,_), _ -> nc2
+| _, NC_aux (NC_true,_) -> nc1
+| NC_aux (NC_false,_), _ -> nc_not nc2
+| _, NC_aux (NC_false,_) -> nc_not nc1
+| _,_ -> nc_or (nc_and nc1 nc2) (nc_and (nc_not nc1) (nc_not nc2))
+
+(* n_constraint functions are currently just Z3 functions *)
+let doc_nc_fn_prop id =
+  match string_of_id id with
+  | "not" -> string "not"
+  | s -> string s
+
+(* n_constraint functions are currently just Z3 functions *)
+let doc_nc_fn id =
+  match string_of_id id with
+  | "not" -> string "negb"
+  | s -> string s
+
 (* When making changes here, check whether they affect coq_nvars_of_typ *)
-let doc_typ, doc_atomic_typ =
-  let fns ctx =
+let rec doc_typ_fns ctx =
   (* following the structure of parser for precedence *)
   let rec typ ty = fn_typ true ty
     and typ' ty = fn_typ false ty
@@ -448,6 +413,10 @@ let doc_typ, doc_atomic_typ =
          (string "Z")
       | Typ_app(Id_aux (Id "atom", _), [A_aux(A_nexp n,_)]) ->
          (string "Z")
+      | Typ_app(Id_aux (Id "atom_bool", _), [_]) -> string "bool"
+      | Typ_app (Id_aux (Id "atom#bool",_), [A_aux (A_bool nc,_)]) ->
+         let tpp = string "Bool" ^^ space ^^ doc_nc_prop ~top:false ctx nc in
+         if atyp_needed then parens tpp else tpp
       | Typ_app(id,args) ->
          let tpp = (doc_id_type id) ^^ space ^^ (separate_map space doc_typ_arg args) in
          if atyp_needed then parens tpp else tpp
@@ -507,6 +476,13 @@ let doc_typ, doc_atomic_typ =
                        [doc_var ctx var; colon; tpp;
                         ampersand;
                         doc_arithfact ctx ~exists:(List.map kopt_kid kopts) ?extra:length_constraint_pp nc])
+          | Typ_aux (Typ_app (Id_aux (Id "atom_bool",_), [A_aux (A_bool atom_nc,_)]),_) ->
+             let var = mk_kid "_bool" in (* TODO collision avoid *)
+             let nc = nice_and (nice_iff (nc_var var) atom_nc) nc in
+             braces (separate space
+                       [doc_var ctx var; colon; string "bool";
+                        ampersand;
+                        doc_arithfact ctx ~exists:(List.map kopt_kid kopts) nc])
           | _ ->
              raise (Reporting.err_todo l
                   ("Non-atom existential type not yet supported in Coq: " ^
@@ -536,8 +512,106 @@ let doc_typ, doc_atomic_typ =
       | 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)))
+      | A_bool nc -> doc_nc_prop ~top:false ctx nc
+  in typ', atomic_typ, doc_typ_arg
+and doc_typ ctx = let f,_,_ = doc_typ_fns ctx in f
+and doc_atomic_typ ctx = let _,f,_ = doc_typ_fns ctx in f
+and doc_typ_arg ctx = let _,_,f = doc_typ_fns ctx in f
+
+and doc_arithfact ctxt ?(exists = []) ?extra nc =
+  let prop = doc_nc_prop ctxt nc in
+  let prop = match extra with
+    | None -> prop
+    | Some pp -> separate space [pp; string "/\\"; prop]
+  in
+  let prop =
+    match exists with
+    | [] -> prop
+    | _ -> separate space ([string "exists"]@(List.map (doc_var ctxt) exists)@[comma; prop])
+  in
+  string "ArithFact" ^^ space ^^ parens prop
+
+(* Follows Coq precedence levels *)
+and doc_nc_prop ?(top = true) ctx nc =
+  let rec l85 (NC_aux (nc,_) as nc_full) =
+  match nc with
+  | NC_or (nc1, nc2) -> doc_op (string "\\/") (doc_nc_prop ctx nc1) (doc_nc_prop ctx nc2)
+  | _ -> l80 nc_full
+  and l80 (NC_aux (nc,_) as nc_full) =
+  match nc with
+  | NC_and (nc1, nc2) -> doc_op (string "/\\") (doc_nc_prop ctx nc1) (doc_nc_prop ctx nc2)
+  | _ -> l70 nc_full
+  and l70 (NC_aux (nc,_) as nc_full) =
+  match nc with
+  | NC_equal (ne1, ne2) -> doc_op equals (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+  | NC_var kid -> doc_op equals (doc_nexp ctx (nvar kid)) (string "true")
+  | NC_bounded_ge (ne1, ne2) -> doc_op (string ">=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+  | NC_bounded_le (ne1, ne2) -> doc_op (string "<=") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+  | NC_not_equal (ne1, ne2) -> doc_op (string "<>") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+  | _ -> l10 nc_full
+  and l10 (NC_aux (nc,_) as nc_full) =
+  match nc with
+  | NC_set (kid, is) ->
+     separate space [string "In"; doc_var ctx kid;
+                     brackets (separate (string "; ")
+                                 (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
+  | NC_app (f,args) -> separate space (doc_nc_fn_prop f::List.map (doc_typ_arg ctx) args)
+  | _ -> l0 nc_full
+  and l0 (NC_aux (nc,_) as nc_full) =
+  match nc with
+  | NC_true -> string "True"
+  | NC_false -> string "False"
+  | NC_set _
+  | NC_app _
+  | NC_var _
+  | NC_or _
+  | NC_and _
+  | NC_equal _
+  | NC_bounded_ge _
+  | NC_bounded_le _
+  | NC_not_equal _ -> parens (l85 nc_full)
+  in if top then l85 nc else l0 nc
+
+(* Follows Coq precedence levels *)
+let rec doc_nc_exp ctx env nc =
+  let nc = Env.expand_constraint_synonyms env nc in
+  let rec l70 (NC_aux (nc,_) as nc_full) =
+    match nc with
+    | NC_equal (ne1, ne2) -> doc_op (string "=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+    | NC_bounded_ge (ne1, ne2) -> doc_op (string ">=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+    | NC_bounded_le (ne1, ne2) -> doc_op (string "<=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2)
+    | _ -> l50 nc_full
+  and l50 (NC_aux (nc,_) as nc_full) =
+    match nc with
+    | NC_or (nc1, nc2) -> doc_op (string "||") (l50 nc1) (l40 nc2)
+    | _ -> l40 nc_full
+  and l40 (NC_aux (nc,_) as nc_full) =
+    match nc with
+    | NC_and (nc1, nc2) -> doc_op (string "&&") (l40 nc1) (l10 nc2)
+    | _ -> l10 nc_full
+  and l10 (NC_aux (nc,_) as nc_full) =
+    match nc with
+    | NC_not_equal (ne1, ne2) -> string "negb" ^^ space ^^ parens (doc_op (string "=?") (doc_nexp ctx ne1) (doc_nexp ctx ne2))
+    | NC_set (kid, is) ->
+       separate space [string "member_Z_list"; doc_var ctx kid;
+                       brackets (separate (string "; ")
+                                   (List.map (fun i -> string (Nat_big_num.to_string i)) is))]
+    | NC_true -> string "true"
+    | NC_false -> string "false"
+    | NC_app (f,args) -> separate space (doc_nc_fn f::List.map (doc_typ_arg_exp ctx env) args)
+    | NC_var kid -> doc_nexp ctx (nvar kid)
+    | NC_equal _
+    | NC_bounded_ge _
+    | NC_bounded_le _
+    | NC_or _
+    | NC_and _ -> parens (l70 nc_full)
+  in l70 nc
+and doc_typ_arg_exp ctx env (A_aux (arg,l)) =
+  match arg with
+  | A_nexp nexp -> doc_nexp ctx nexp
+  | A_bool nc -> doc_nc_exp ctx env nc
+  | A_order _ | A_typ _ ->
+       raise (Reporting.err_unreachable l __POS__ "Tried to pass Type or Order kind to SMT function")
 
 (* Check for variables in types that would be pretty-printed and are not
    bound in the val spec of the function. *)
@@ -556,7 +630,7 @@ let replace_typ_size ctxt env (Typ_aux (t,a)) =
        | Some n -> mk_typ (nconstant n)
        | None ->
           let is_equal nexp =
-            prove env (NC_aux (NC_equal (size,nexp),Parse_ast.Unknown))
+            prove __POS__ env (NC_aux (NC_equal (size,nexp),Parse_ast.Unknown))
           in match List.find is_equal (NexpSet.elements ctxt.bound_nexps) with
           | nexp -> mk_typ nexp
           | exception Not_found -> None
@@ -619,6 +693,7 @@ let doc_quant_item_id ctx delimit (QI_aux (qi,_)) =
     | 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
+    | K_bool -> Some (delimit (separate space [doc_var ctx kid; colon; string "bool"]))
   end
   | QI_const nc -> None
 
@@ -630,6 +705,7 @@ let quant_item_id_name ctx (QI_aux (qi,_)) =
     | K_type -> Some (doc_var ctx kid)
     | K_int -> Some (doc_var ctx kid)
     | K_order -> None
+    | K_bool -> Some (doc_var ctx kid)
   end
   | QI_const nc -> None
 
@@ -852,7 +928,7 @@ let similar_nexps ctxt env n1 n2 =
        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)) && (
+         (prove __POS__ 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
@@ -888,13 +964,15 @@ let condition_produces_constraint exp =
    dependent pair with a proof that the result is the expected integer.  This
    is redundant for basic arithmetic functions and functions which we unfold
    in the constraint solver. *)
-let no_Z_proof_fns = ["Z.add"; "Z.sub"; "Z.opp"; "Z.mul"; "length_mword"; "length"]
+let no_proof_fns = ["Z.add"; "Z.sub"; "Z.opp"; "Z.mul"; "length_mword"; "length";
+                      "negb"; "andb"; "orb";
+                      "Z.leb"; "Z.geb"; "Z.ltb"; "Z.gtb"; "Z.eqb"]
 
-let is_no_Z_proof_fn env id =
+let is_no_proof_fn env id =
   if Env.is_extern id env "coq"
   then
     let s = Env.get_extern id env "coq" in
-    List.exists (fun x -> String.compare x s == 0) no_Z_proof_fns
+    List.exists (fun x -> String.compare x s == 0) no_proof_fns
   else false
 
 let replace_atom_return_type ret_typ =
@@ -902,15 +980,19 @@ let replace_atom_return_type ret_typ =
   match ret_typ with
   | 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 ([mk_kopt K_int kid], nc_eq (nvar kid) nexp, atom_typ (nvar kid)),Parse_ast.Generated l)
-  | _ -> false, ret_typ
+     Some "build_ex", Typ_aux (Typ_exist ([mk_kopt K_int kid], nc_eq (nvar kid) nexp, atom_typ (nvar kid)),Parse_ast.Generated l)
+  (* For informative booleans tweak the type name so that doc_typ knows that the
+     constraint should be output. *)
+  | Typ_aux (Typ_app (Id_aux (Id "atom_bool",il), ([A_aux (A_bool _,_)] as args)),l) ->
+     Some "build_Bool", Typ_aux (Typ_app (Id_aux (Id "atom#bool",il), args),l)
+  | _ -> None, ret_typ
 
 let is_range_from_atom env (Typ_aux (argty,_)) (Typ_aux (fnty,_)) =
   match argty, fnty with
   | 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))
+     Type_check.prove __POS__ env (nc_and (nc_eq nexp low) (nc_eq nexp high))
   | _ -> false
 
 (* Get a more general type for an annotation/expression - i.e.,
@@ -998,6 +1080,8 @@ let doc_exp, doc_let =
       then separate space [string "liftR"; parens (doc)]
       else doc in
     match e with
+    | E_assign(_, _) when has_effect (effect_of full_exp) BE_config ->
+       string "returnm tt" (* TODO *)
     | E_assign((LEXP_aux(le_act,tannot) as le), e) ->
        (* can only be register writes *)
        (match le_act (*, t, tag*) with
@@ -1083,14 +1167,12 @@ let doc_exp, doc_let =
             match args with
             | [from_exp; to_exp; step_exp; ord_exp; vartuple; body] ->
                let loopvar, body = match body with
-                 | E_aux (E_let (LB_aux (LB_val (_, _), _),
-                   E_aux (E_let (LB_aux (LB_val (_, _), _),
-                   E_aux (E_if (_,
+                 | E_aux (E_if (_,
                    E_aux (E_let (LB_aux (LB_val (
                      ((P_aux (P_typ (_, P_aux (P_var (P_aux (P_id id, _), _), _)), _))
                      | (P_aux (P_var (P_aux (P_id id, _), _), _))
                      | (P_aux (P_id id, _))), _), _),
-                     body), _), _), _)), _)), _) -> id, body
+                     body), _), _), _) -> id, body
                  | _ -> 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"
@@ -1169,9 +1251,9 @@ let doc_exp, doc_let =
             match args with
             | [exp] ->
                let exp_pp =
-                 if ctxt.build_ex_return
-                 then parens (string "build_ex" ^/^ expY exp)
-                 else expY exp
+                 match ctxt.build_at_return with
+                 | Some s -> parens (string s ^/^ expY exp)
+                 | None -> expY exp
                in
                let epp = separate space [string "early_return"; exp_pp] in
                let aexp_needed, tepp =
@@ -1307,12 +1389,12 @@ let doc_exp, doc_let =
           let ret_typ_inst =
                subst_unifiers inst ret_typ
           in
-          let packeff,unpack,autocast =
+          let packeff,unpack,autocast,projbool =
             let ann_typ = Env.expand_synonyms env (general_typ_of_annot (l,annot)) in
             let ann_typ = expand_range_type ann_typ in
             let ret_typ_inst = expand_range_type (Env.expand_synonyms env ret_typ_inst) in
             let ret_typ_inst =
-              if is_no_Z_proof_fn env f then ret_typ_inst
+              if is_no_proof_fn env f then ret_typ_inst
               else snd (replace_atom_return_type ret_typ_inst) in
             let () = 
               debug ctxt (lazy (" type returned " ^ string_of_typ ret_typ_inst));
@@ -1336,13 +1418,19 @@ let doc_exp, doc_let =
                 Typ_aux (Typ_app (_,[A_aux (A_nexp n2,_);_;_]),_) ->
                  not (similar_nexps ctxt env n1 n2)
               | _ -> false
-            in pack,unpack,autocast
+            in
+            let projbool =
+              match in_typ with
+              | Typ_aux (Typ_app (Id_aux (Id "atom#bool",_),_),_) -> true
+              | _ -> false
+            in pack,unpack,autocast,projbool
           in
           let autocast_id, proj_id =
             if effectful eff
             then "autocast_m", "projT1_m"
             else "autocast",   "projT1" in
           let epp = if unpack && not (effectful eff) then string proj_id ^^ space ^^ parens epp else epp in
+          let epp = if projbool && not (effectful eff) then string "projBool" ^^ space ^^ parens epp else epp in
           let epp = if autocast then string autocast_id ^^ space ^^ parens epp else epp in
           let epp =
             if effectful eff && packeff && not unpack
@@ -1382,7 +1470,7 @@ let doc_exp, doc_let =
          if is_bitvector_typ base_typ
          then wrap_parens (align (group (prefix 0 1 (parens (liftR epp)) (doc_tannot ctxt env true base_typ))))
          else liftR epp
-       else if Env.is_register id env then doc_id (append_id id "_ref")
+       else if Env.is_register id env && is_regtyp typ env then doc_id (append_id id "_ref")
        else if is_ctor env id then doc_id_ctor id
        else begin
          match Env.lookup_id id env with
@@ -1665,9 +1753,9 @@ let doc_exp, doc_let =
     | E_return r ->
       let ret_monad = " : MR" in
       let exp_pp =
-        if ctxt.build_ex_return
-        then parens (string "build_ex" ^/^ expY r)
-        else expY r
+        match ctxt.build_at_return with
+        | Some s -> parens (string s ^/^ expY r)
+        | None -> expY r
       in
       let ta =
         if contains_t_pp_var ctxt (typ_of full_exp) || contains_t_pp_var ctxt (typ_of r)
@@ -1677,7 +1765,7 @@ let doc_exp, doc_let =
           parens (doc_typ ctxt (typ_of full_exp));
           parens (doc_typ ctxt (typ_of r))] in
       align (parens (string "early_return" ^//^ exp_pp ^//^ ta))
-    | E_constraint nc -> wrap_parens (doc_nc_exp ctxt nc)
+    | E_constraint nc -> wrap_parens (doc_nc_exp ctxt (env_of full_exp) nc)
     | E_internal_value _ ->
       raise (Reporting.err_unreachable l __POS__
         "unsupported internal expression encountered while pretty-printing")
@@ -1780,8 +1868,10 @@ let types_used_with_generic_eq defs =
   let typs_req_funcl (FCL_aux (FCL_Funcl (_,pexp), _)) =
     fst (Rewriter.fold_pexp alg pexp)
   in
-  let typs_req_def = function
-    | DEF_kind _
+  let typs_req_fundef (FD_aux (FD_function (_,_,_,fcls),_)) =
+    List.fold_left IdSet.union IdSet.empty (List.map typs_req_funcl fcls)
+  in
+  let rec typs_req_def = function
     | DEF_type _
     | DEF_spec _
     | DEF_fixity _
@@ -1790,13 +1880,13 @@ let types_used_with_generic_eq defs =
     | 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_fundef fd -> typs_req_fundef fd
     | DEF_mapdef (MD_aux (_,(l,_)))
     | DEF_scattered (SD_aux (_,(l,_)))
+    | DEF_measure (Id_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_internal_mutrec fds ->
+       List.fold_left IdSet.union IdSet.empty (List.map typs_req_fundef fds)
     | DEF_val lb ->
        fst (Rewriter.fold_letbind alg lb)
   in
@@ -1806,10 +1896,12 @@ 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]
 
-let rec doc_range (BF_aux(r,_)) = match r with
-  | BF_single i -> parens (doc_op comma (doc_int i) (doc_int i))
-  | BF_range(i1,i2) -> parens (doc_op comma (doc_int i1) (doc_int i2))
-  | BF_concat(ir1,ir2) -> (doc_range ir1) ^^ comma ^^ (doc_range ir2)
+(*
+let rec doc_range ctxt (BF_aux(r,_)) = match r with
+  | BF_single i -> parens (doc_op comma (doc_nexp ctxt i) (doc_nexp ctxt i))
+  | BF_range(i1,i2) -> parens (doc_op comma (doc_nexp ctxt i1) (doc_nexp ctxt i2))
+  | BF_concat(ir1,ir2) -> (doc_range ctxt ir1) ^^ comma ^^ (doc_range ctxt ir2)
+ *)
 
 let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
   | TD_abbrev(id,typq,A_aux (A_typ typ, _)) ->
@@ -1819,7 +1911,9 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
                         doc_typquant_items empty_ctxt parens typq;
                         colon; string "Type"])
        (doc_typschm empty_ctxt false typschm) ^^ dot
-  | TD_record(id,nm,typq,fs,_) ->
+  | TD_abbrev _ -> empty (* TODO? *)
+  | TD_bitfield _ -> empty (* TODO? *)
+  | TD_record(id,typq,fs,_) ->
     let fname fid = if prefix_recordtype && string_of_id id <> "regstate"
                     then concat [doc_id id;string "_";doc_id_type fid;]
                     else doc_id_type fid in
@@ -1872,7 +1966,7 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
            (separate space [string "Record"; id_pp; doc_typquant_items empty_ctxt parens typq])
            ((*doc_typquant typq*) (braces (space ^^ align fs_doc ^^ space))) ^^
       dot ^^ hardline ^^ eq_pp ^^ updates_pp
-  | TD_variant(id,nm,typq,ar,_) ->
+  | TD_variant(id,typq,ar,_) ->
      (match id with
       | Id_aux ((Id "read_kind"),_) -> empty
       | Id_aux ((Id "write_kind"),_) -> empty
@@ -1896,7 +1990,7 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
             type, so undo that here. *)
          let resetimplicit = separate space [string "Arguments"; id_pp; colon; string "clear implicits."] in
          typ_pp ^^ dot ^^ hardline ^^ resetimplicit ^^ hardline ^^ hardline)
-  | TD_enum(id,nm,enums,_) ->
+  | TD_enum(id,enums,_) ->
      (match id with
       | Id_aux ((Id "read_kind"),_) -> empty
       | Id_aux ((Id "write_kind"),_) -> empty
@@ -1917,7 +2011,6 @@ let doc_typdef generic_eq_types (TD_aux(td, (l, annot))) = match td with
            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.err_unreachable l __POS__ "register with non-constant indices")
 
 let args_of_typ l env typs =
   let arg i typ =
@@ -2066,18 +2159,23 @@ let merge_kids_atoms pats =
   let try_eliminate (gone,map,seen) = function
     | P_aux (P_id id, ann), typ
     | P_aux (P_typ (_,P_aux (P_id id, ann)),_), typ -> begin
-      match Type_check.destruct_atom_nexp (env_of_annot ann) typ with
-      | Some (Nexp_aux (Nexp_var kid,l)) ->
-         if KidSet.mem kid seen then
-           let () = 
-             Reporting.print_err false true l "merge_kids_atoms"
-               ("want to merge tyvar and argument for " ^ string_of_kid kid ^
+        let merge kid l =
+          if KidSet.mem kid seen then
+            let () =
+              Reporting.print_err 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
-         else
-           KidSet.add kid gone, KBindings.add kid id map, KidSet.add kid seen
-      | _ -> gone,map,KidSet.union seen (tyvars_of_typ typ)
-    end
+            gone,map,seen
+          else
+            KidSet.add kid gone, KBindings.add kid id map, KidSet.add kid seen
+        in
+        match Type_check.destruct_atom_nexp (env_of_annot ann) typ with
+        | Some (Nexp_aux (Nexp_var kid,l)) -> merge kid l
+        | _ ->
+           match Type_check.destruct_atom_bool (env_of_annot ann) typ with
+           | Some (NC_aux (NC_var kid,l)) -> merge kid l
+           | _ -> gone,map,KidSet.union seen (tyvars_of_typ typ)
+      end
     | _, typ -> gone,map,KidSet.union seen (tyvars_of_typ typ)
   in
   let gone,map,_ = List.fold_left try_eliminate (KidSet.empty, KBindings.empty, KidSet.empty) pats in
@@ -2092,7 +2190,9 @@ let merge_var_patterns map pats =
     | _ -> map, (pat,typ)::pats) (map,[]) pats
   in map, List.rev pats
 
-let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
+type mutrec_pos = NotMutrec | FirstFn | LaterFn
+
+let doc_funcl mutrec 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
@@ -2101,7 +2201,7 @@ let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
   in
   let build_ex, ret_typ = replace_atom_return_type ret_typ in
   let build_ex = match destruct_exist_plain (Env.expand_synonyms env (expand_range_type ret_typ)) with
-    | Some _ -> true
+    | Some _ -> Some "build_ex"
     | _ -> build_ex
   in
   let ids_to_avoid = all_ids pexp in
@@ -2130,15 +2230,18 @@ let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
       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;
+      build_at_return = if effectful eff then build_ex else None;
       recursive_ids = recursive_ids;
       debug = List.mem (string_of_id id) (!opt_debug_on)
     } in
   let () =
     debug ctxt (lazy ("Function " ^ string_of_id id));
     debug ctxt (lazy (" return type " ^ string_of_typ ret_typ));
-    debug ctxt (lazy (" build_ex " ^ if build_ex then "needed" else "not needed"));
-    debug ctxt (lazy (if effectful eff then " effectful" else " pure"))
+    debug ctxt (lazy (" build_ex " ^ match build_ex with Some s -> s ^ " needed" | _ -> "not needed"));
+    debug ctxt (lazy (if effectful eff then " effectful" else " pure"));
+    debug ctxt (lazy (" kid_id_renames " ^ String.concat ", " (List.map
+                        (fun (kid,id) -> string_of_kid kid ^ " |-> " ^ string_of_id id)
+                        (KBindings.bindings kid_to_arg_rename))))
   in
   (* Put the constraints after pattern matching so that any type variable that's
      been replaced by one of the term-level arguments is bound. *)
@@ -2211,6 +2314,13 @@ let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
        let d = match r with Rec_nonrec -> "Definition" | _ -> "Fixpoint" in
        string d, [], [], []
   in
+  let intropp =
+    match mutrec with
+    | NotMutrec -> intropp
+    | FirstFn -> string "Fixpoint"
+    | LaterFn -> string "with"
+  in
+  let terminalpp = match mutrec with NotMutrec -> dot | _ -> empty 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
@@ -2229,35 +2339,38 @@ let doc_funcl rec_opt (FCL_aux(FCL_Funcl(id, pexp), annot)) =
        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 = if effectful eff then bodypp else match build_ex with Some s -> string s ^^ parens bodypp | None -> bodypp in
   let bodypp = separate (break 1) fixupspp ^/^ bodypp in
   group (prefix 3 1
     (flow (break 1) ([intropp; idpp] @ quantspp @ [patspp] @ constrspp @ [atom_constr_pp] @ accpp) ^/^
        flow (break 1) (measurepp @ [colon; retpp; coloneq]))
-    (bodypp ^^ dot)) ^^ implicitargs
+    (bodypp ^^ terminalpp)) ^^ implicitargs
 
 let get_id = function
   | [] -> failwith "FD_function with empty list"
   | (FCL_aux (FCL_Funcl (id,_),_))::_ -> id
 
-(* Strictly speaking, Lem doesn't support multiple clauses for a single 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 r) funcls
+(* Coq doesn't support multiple clauses for a single function joined
+   by "and".  However, all the funcls should have been merged by the
+   merge_funcls rewrite now. *)
+let doc_fundef_rhs ?(mutrec=NotMutrec) (FD_aux(FD_function(r, typa, efa, funcls),(l,_))) =
+  match funcls with
+  | [] -> unreachable l __POS__ "function with no clauses"
+  | [funcl] -> doc_funcl mutrec r funcl
+  | (FCL_aux (FCL_Funcl (id,_),_))::_ -> unreachable l __POS__ ("function " ^ string_of_id id ^ " has multiple clauses in backend")
 
 let doc_mutrec = function
   | [] -> failwith "DEF_internal_mutrec with empty function list"
-  | fundefs ->
-     string "let rec " ^^
-     separate_map (hardline ^^ string "and ") doc_fundef_rhs fundefs
+  | fundef::fundefs ->
+     doc_fundef_rhs ~mutrec:FirstFn fundef ^^ hardline ^^
+     separate_map hardline (doc_fundef_rhs ~mutrec:LaterFn) fundefs ^^ dot
 
 let rec doc_fundef (FD_aux(FD_function(r, typa, efa, fcls),fannot)) =
   match fcls with
   | [] -> 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_funcl r funcl
+     doc_funcl NotMutrec r funcl
   | [_] -> empty (* extern *)
   | _ -> failwith "FD_function with more than one clause"
 
@@ -2265,7 +2378,7 @@ let rec doc_fundef (FD_aux(FD_function(r, typa, efa, fcls),fannot)) =
 
 let doc_dec (DEC_aux (reg, ((l, _) as annot))) =
   match reg with
-  | DEC_reg(typ,id) -> empty
+  | DEC_reg(_,_,typ,id) -> empty
      (*
        let env = env_of_annot annot in
        let rt = Env.base_typ_of env typ in
@@ -2284,7 +2397,7 @@ let doc_dec (DEC_aux (reg, ((l, _) as annot))) =
            ^/^ hardline
          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_config(id, typ, exp) -> separate space [string "Definition"; doc_id id; coloneq; doc_exp empty_ctxt false exp] ^^ dot ^^ hardline
   | DEC_alias(id,alspec) -> empty
   | DEC_typ_alias(typ,id,alspec) -> empty
 
@@ -2297,7 +2410,15 @@ let is_field_accessor regtypes fdef =
      (access = "get" || access = "set") && is_field_of regtyp field
   | _ -> false
 
+
+let int_of_field_index tname fid nexp =
+  match int_of_nexp_opt nexp with
+  | Some i -> i
+  | None -> raise (Reporting.err_typ Parse_ast.Unknown
+                   ("Non-constant bitfield index in field " ^ string_of_id fid ^ " of " ^ tname))
+
 let doc_regtype_fields (tname, (n1, n2, fields)) =
+  let const_int fid idx = int_of_field_index tname fid idx in
   let i1, i2 = match n1, n2 with
     | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) -> i1, i2
     | _ -> raise (Reporting.err_typ Parse_ast.Unknown
@@ -2306,8 +2427,8 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
   let dir = (if dir_b then "true" else "false") in
   let doc_field (fr, fid) =
     let i, j = match fr with
-    | BF_aux (BF_single i, _) -> (i, i)
-    | BF_aux (BF_range (i, j), _) -> (i, j)
+    | BF_aux (BF_single i, _) -> let i = const_int fid i in (i, i)
+    | BF_aux (BF_range (i, j), _) -> (const_int fid i, const_int fid j)
     | _ -> 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
@@ -2431,7 +2552,6 @@ let rec doc_def unimplemented generic_eq_types def =
   | DEF_val (LB_aux (LB_val (pat, exp), _)) -> doc_val pat exp
   | 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 =
@@ -2441,18 +2561,21 @@ let find_exc_typ defs =
   if List.exists is_exc_typ_def defs then "exception" else "unit"
 
 let find_unimplemented defs =
+  let adjust_fundef unimplemented (FD_aux (FD_function (_,_,_,funcls),_)) =
+    match funcls with
+    | [] -> unimplemented
+    | (FCL_aux (FCL_Funcl (id,_),_))::_ ->
+       IdSet.remove id unimplemented
+  in
   let adjust_def unimplemented = function
     | DEF_spec (VS_aux (VS_val_spec (_,id,exts,_),_)) -> begin
       match Ast_util.extern_assoc "coq" exts with
       | Some _ -> unimplemented
       | None -> IdSet.add id unimplemented
     end
-    | DEF_fundef (FD_aux (FD_function (_,_,_,funcls),_)) -> begin
-      match funcls with
-      | [] -> unimplemented
-      | (FCL_aux (FCL_Funcl (id,_),_))::_ ->
-         IdSet.remove id unimplemented
-    end
+    | DEF_internal_mutrec fds ->
+       List.fold_left adjust_fundef unimplemented fds
+    | DEF_fundef fd -> adjust_fundef unimplemented fd
     | _ -> unimplemented
   in
   List.fold_left adjust_def IdSet.empty defs
@@ -2481,7 +2604,7 @@ try
   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.print_err false false Parse_ast.Unknown "Warning"
+      Reporting.print_err 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
@@ -2518,7 +2641,7 @@ try
         hardline;
         string "End Content.";
         hardline])
-with Type_check.Type_error (l,err) ->
+with Type_check.Type_error (env,l,err) ->
   let extra =
     "\nError during Coq printing\n" ^
     if Printexc.backtrace_status ()
diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml
index a3bd1bba..aa03528f 100644
--- a/src/pretty_print_lem.ml
+++ b/src/pretty_print_lem.ml
@@ -51,10 +51,10 @@
 open Type_check
 open Ast
 open Ast_util
+open Reporting
 open Rewriter
 open PPrint
 open Pretty_print_common
-open Extra_pervasives
 
 (****************************************************************************
  * PPrint-based sail-to-lem pprinter
@@ -327,6 +327,9 @@ let doc_typ_lem, doc_atomic_typ_lem =
                                String.concat ", " (List.map string_of_kid bad) ^
                                " escape into Lem"))
         end
+      (* AA: I think the correct thing is likely to filter out
+         non-integer kinded_id's, then use the above code. *)
+      | Typ_exist (_,_,Typ_aux(Typ_app(id,[_]),_)) when string_of_id id = "atom_bool" -> string "bool"
       | 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"
@@ -335,7 +338,14 @@ let doc_typ_lem, doc_atomic_typ_lem =
       | A_nexp n -> doc_nexp_lem (nexp_simp n)
       | A_order o -> empty
       | A_bool _ -> empty
-  in typ', atomic_typ
+  in
+  let top env ty =
+    (* If we use the bitlist representation of bitvectors, the type argument in
+       type abbreviations such as "bits('n)" becomes dead, which confuses HOL; as a
+       workaround, we expand type synonyms in this case. *)
+    let ty' = if !opt_mwords then ty else Env.expand_synonyms env ty in
+    typ' ty'
+  in top, atomic_typ
 
 (* Check for variables in types that would be pretty-printed. *)
 let contains_t_pp_var ctxt (Typ_aux (t,a) as typ) =
@@ -353,7 +363,7 @@ let replace_typ_size ctxt env (Typ_aux (t,a)) =
        | Some n -> mk_typ (nconstant n)
        | None ->
           let is_equal nexp =
-            prove env (NC_aux (NC_equal (size,nexp),Parse_ast.Unknown))
+            prove __POS__ env (NC_aux (NC_equal (size,nexp),Parse_ast.Unknown))
           in match List.find is_equal (NexpSet.elements ctxt.bound_nexps) with
           | nexp -> mk_typ nexp
           | exception Not_found -> None
@@ -372,7 +382,7 @@ let doc_tannot_lem ctxt env eff typ =
   match make_printable_type ctxt env typ with
   | None -> empty
   | Some typ ->
-     let ta = doc_typ_lem typ in
+     let ta = doc_typ_lem env typ in
      if eff then string " : M " ^^ parens ta
      else string " : " ^^ ta
 
@@ -472,8 +482,8 @@ let doc_typclasses_lem t =
   if NexpSet.is_empty nexps then (empty, NexpSet.empty) else
   (separate_map comma_sp (fun nexp -> string "Size " ^^ doc_nexp_lem nexp) (NexpSet.elements nexps) ^^ string " => ", nexps)
 
-let doc_typschm_lem quants (TypSchm_aux(TypSchm_ts(tq,t),_)) =
-  let pt = doc_typ_lem t in
+let doc_typschm_lem env quants (TypSchm_aux(TypSchm_ts(tq,t),_)) =
+  let pt = doc_typ_lem env t in
   if quants
   then
     let nexps_used = lem_nexps_of_typ t in
@@ -513,7 +523,7 @@ let rec doc_pat_lem ctxt apat_needed (P_aux (p,(l,annot)) as pa) = match p with
     let doc_p = doc_pat_lem ctxt true p in
     (match make_printable_type ctxt (env_of_annot (l,annot)) typ with
     | None -> doc_p
-    | Some typ -> parens (doc_op colon doc_p (doc_typ_lem typ)))
+    | Some typ -> parens (doc_op colon doc_p (doc_typ_lem (env_of_annot (l,annot)) typ)))
   | P_vector pats ->
      let ppp = brackets (separate_map semi (doc_pat_lem ctxt true) pats) in
      if apat_needed then parens ppp else ppp
@@ -578,6 +588,8 @@ let doc_exp_lem, doc_let_lem =
       then wrap_parens (separate space [string "liftR"; parens (doc)])
       else wrap_parens doc in
     match e with
+    | E_assign(_, _) when has_effect (effect_of full_exp) BE_config ->
+       string "return ()" (* TODO *)
     | E_assign((LEXP_aux(le_act,tannot) as le), e) ->
        (* can only be register writes *)
        let t = typ_of_annot tannot in
@@ -661,14 +673,12 @@ let doc_exp_lem, doc_let_lem =
             match args with
             | [exp1; exp2; exp3; ord_exp; vartuple; body] ->
                let loopvar, body = match body with
-                 | E_aux (E_let (LB_aux (LB_val (_, _), _),
-                   E_aux (E_let (LB_aux (LB_val (_, _), _),
-                   E_aux (E_if (_,
+                 | E_aux (E_if (_,
                    E_aux (E_let (LB_aux (LB_val (
                      ((P_aux (P_typ (_, P_aux (P_var (P_aux (P_id id, _), _), _)), _))
                      | (P_aux (P_var (P_aux (P_id id, _), _), _))
                      | (P_aux (P_id id, _))), _), _),
-                     body), _), _), _)), _)), _) -> id, body
+                     body), _), _), _) -> id, body
                  | _ -> 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, _)), _) ->
@@ -824,7 +834,7 @@ let doc_exp_lem, doc_let_lem =
          if is_bitvector_typ base_typ
          then liftR (parens (align (group (prefix 0 1 epp (doc_tannot_lem ctxt env true base_typ)))))
          else liftR epp
-       else if Env.is_register id env then doc_id_lem (append_id id "_ref")
+       else if Env.is_register id env && is_regtyp (typ_of full_exp) env then doc_id_lem (append_id id "_ref")
        else if is_ctor env id then doc_id_lem_ctor id
        else doc_id_lem id
     | E_lit lit -> doc_lit_lem lit
@@ -947,8 +957,8 @@ let doc_exp_lem, doc_let_lem =
        | Some full_typ, Some r_typ ->
           separate space
             [string ": MR";
-            parens (doc_typ_lem full_typ);
-            parens (doc_typ_lem r_typ)]
+            parens (doc_typ_lem (env_of full_exp) full_typ);
+            parens (doc_typ_lem (env_of r) r_typ)]
        | _ -> empty
       in
       align (parens (string "early_return" ^//^ expV true r ^//^ ta))
@@ -1002,28 +1012,30 @@ let doc_exp_lem, doc_let_lem =
   in top_exp, let_exp
 
 (*TODO Upcase and downcase type and constructors as needed*)
-let doc_type_union_lem (Tu_aux(Tu_ty_id(typ,id),_)) =
+let doc_type_union_lem env (Tu_aux(Tu_ty_id(typ,id),_)) =
   separate space [pipe; doc_id_lem_ctor id; string "of";
-                  parens (doc_typ_lem typ)]
+                  parens (doc_typ_lem env typ)]
 
+(*
 let rec doc_range_lem (BF_aux(r,_)) = match r with
   | BF_single i -> parens (doc_op comma (doc_int i) (doc_int i))
   | BF_range(i1,i2) -> parens (doc_op comma (doc_int i1) (doc_int i2))
   | BF_concat(ir1,ir2) -> (doc_range ir1) ^^ comma ^^ (doc_range ir2)
+ *)
 
-let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
+let doc_typdef_lem env (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 equals
        (separate space [string "type"; doc_id_lem_type id; doc_typquant_items_lem None typq])
-       (doc_typschm_lem false typschm)
+       (doc_typschm_lem env false typschm)
   | TD_abbrev _ -> empty
-  | TD_record(id,nm,typq,fs,_) ->
+  | TD_record(id,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;]
                     else doc_id_lem_type fid in
     let f_pp (typ,fid) =
-      concat [fname fid;space;colon;space;doc_typ_lem typ; semi] in
+      concat [fname fid;space;colon;space;doc_typ_lem env typ; semi] in
     let rectyp = match typq with
       | TypQ_aux (TypQ_tq qs, _) ->
         let quant_item = function
@@ -1070,7 +1082,7 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
            ((*doc_typquant_lem typq*) (anglebars (space ^^ align fs_doc ^^ space))) ^^ hardline
     (* if !opt_sequential && string_of_id id = "regstate" then empty
     else separate_map hardline doc_field fs *)
-  | TD_variant(id,nm,typq,ar,_) ->
+  | TD_variant(id,typq,ar,_) ->
      (match id with
       | Id_aux ((Id "read_kind"),_) -> empty
       | Id_aux ((Id "write_kind"),_) -> empty
@@ -1082,7 +1094,7 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
       | Id_aux ((Id "diafp"),_) -> empty *)
       | Id_aux ((Id "option"),_) -> empty
       | _ ->
-         let ar_doc = group (separate_map (break 1) doc_type_union_lem ar) in
+         let ar_doc = group (separate_map (break 1) (doc_type_union_lem env) ar) in
          let typ_pp =
            (doc_op equals)
              (concat [string "type"; space; doc_id_lem_type id; space; doc_typquant_items_lem None typq])
@@ -1142,7 +1154,7 @@ let doc_typdef_lem (TD_aux(td, (l, annot))) = match td with
              fromInterpValuePP ^^ hardline ^^ hardline ^^
                fromToInterpValuePP ^^ hardline
            else empty)
-  | TD_enum(id,nm,enums,_) ->
+  | TD_enum(id,enums,_) ->
      (match id with
       | Id_aux ((Id "read_kind"),_) -> empty
       | Id_aux ((Id "write_kind"),_) -> empty
@@ -1267,8 +1279,8 @@ let rec untuple_args_pat (P_aux (paux, ((l, _) as annot)) as pat) arg_typs =
   | _, _ ->
      [pat], identity
 
-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)
+let doc_tannot_opt_lem env (Typ_annot_opt_aux(t,_)) = match t with
+  | Typ_annot_opt_some(tq,typ) -> (*doc_typquant_lem tq*) (doc_typ_lem env typ)
   | Typ_annot_opt_none -> empty
 
 let doc_fun_body_lem ctxt exp =
@@ -1339,7 +1351,7 @@ let rec doc_fundef_lem (FD_aux(FD_function(r, typa, efa, fcls),fannot) as fd) =
 
 let doc_dec_lem (DEC_aux (reg, ((l, _) as annot))) =
   match reg with
-  | DEC_reg(typ,id) -> empty
+  | DEC_reg(_,_,typ,id) -> empty
      (* if !opt_sequential then empty
      else
        let env = env_of_annot annot in
@@ -1359,16 +1371,17 @@ let doc_dec_lem (DEC_aux (reg, ((l, _) as annot))) =
            ^/^ hardline
          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(id, typ, exp) -> separate space [string "let"; doc_id_lem id; equals; doc_exp_lem empty_ctxt false exp] ^^ hardline
   | DEC_alias(id,alspec) -> empty
   | DEC_typ_alias(typ,id,alspec) -> empty
 
-let doc_spec_lem (VS_aux (valspec,annot)) =
+let doc_spec_lem env (VS_aux (valspec,annot)) =
   match valspec with
   | VS_val_spec (typschm,id,exts,_) when Ast_util.extern_assoc "lem" exts = None ->
      (* let (TypSchm_aux (TypSchm_ts (tq, typ), _)) = typschm in
      if contains_t_pp_var typ then empty else *)
      doc_docstring_lem annot ^^
-     separate space [string "val"; doc_id_lem id; string ":";doc_typschm_lem true typschm] ^/^ hardline 
+     separate space [string "val"; doc_id_lem id; string ":";doc_typschm_lem env true typschm] ^/^ hardline
   (* | VS_val_spec (_,_,Some _,_) -> empty *)
   | _ -> empty
 
@@ -1381,7 +1394,14 @@ let is_field_accessor regtypes fdef =
      (access = "get" || access = "set") && is_field_of regtyp field
   | _ -> false
 
+let int_of_field_index tname fid nexp =
+  match int_of_nexp_opt nexp with
+  | Some i -> i
+  | None -> raise (Reporting.err_typ Parse_ast.Unknown
+                   ("Non-constant bitfield index in field " ^ string_of_id fid ^ " of " ^ tname))
+
 let doc_regtype_fields (tname, (n1, n2, fields)) =
+  let const_int fid idx = int_of_field_index tname fid idx in
   let i1, i2 = match n1, n2 with
     | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) -> i1, i2
     | _ -> raise (Reporting.err_typ Parse_ast.Unknown
@@ -1390,8 +1410,8 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
   let dir = (if dir_b then "true" else "false") in
   let doc_field (fr, fid) =
     let i, j = match fr with
-    | BF_aux (BF_single i, _) -> (i, i)
-    | BF_aux (BF_range (i, j), _) -> (i, j)
+    | BF_aux (BF_single i, _) -> let i = const_int fid i in (i, i)
+    | BF_aux (BF_range (i, j), _) -> (const_int fid i, const_int fid j)
     | _ -> 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
@@ -1415,13 +1435,13 @@ let doc_regtype_fields (tname, (n1, n2, fields)) =
   in
   separate_map hardline doc_field fields
 
-let rec doc_def_lem def =
+let rec doc_def_lem type_env def =
   (* let _ = Pretty_print_sail.pp_defs stderr (Defs [def]) in *)
   match def with
-  | DEF_spec v_spec -> doc_spec_lem v_spec
+  | DEF_spec v_spec -> doc_spec_lem type_env v_spec
   | DEF_fixity _ -> empty
   | DEF_overload _ -> empty
-  | DEF_type t_def -> group (doc_typdef_lem t_def) ^/^ hardline
+  | DEF_type t_def -> group (doc_typdef_lem type_env t_def) ^/^ hardline
   | DEF_reg_dec dec -> group (doc_dec_lem dec)
 
   | DEF_default df -> empty
@@ -1431,9 +1451,9 @@ let rec doc_def_lem def =
      group (doc_let_lem empty_ctxt lbind) ^/^ hardline
   | DEF_scattered sdef -> failwith "doc_def_lem: shoulnd't have DEF_scattered at this point"
 
-  | DEF_kind _ -> empty
   | DEF_mapdef (MD_aux (_, (l, _))) -> unreachable l __POS__ "Lem doesn't support mappings"
   | DEF_pragma _ -> empty
+  | DEF_measure _ -> empty (* we might use these in future *)
 
 let find_exc_typ defs =
   let is_exc_typ_def = function
@@ -1441,7 +1461,7 @@ let find_exc_typ defs =
     | _ -> false in
   if List.exists is_exc_typ_def defs then "exception" else "unit"
 
-let pp_defs_lem (types_file,types_modules) (defs_file,defs_modules) (Defs defs) top_line =
+let pp_defs_lem (types_file,types_modules) (defs_file,defs_modules) type_env (Defs defs) top_line =
   (* let regtypes = find_regtypes d in *)
   let state_ids =
     State.generate_regstate_defs !opt_mwords defs
@@ -1477,9 +1497,9 @@ let pp_defs_lem (types_file,types_modules) (defs_file,defs_modules) (Defs defs)
              string "module SIA = Interp_ast"; hardline;
              hardline]
         else empty;
-        separate empty (List.map doc_def_lem typdefs); hardline;
+        separate empty (List.map (doc_def_lem type_env) typdefs); hardline;
         hardline;
-        separate empty (List.map doc_def_lem statedefs); hardline;
+        separate empty (List.map (doc_def_lem type_env) statedefs); hardline;
         hardline;
         register_refs; hardline;
         concat [
@@ -1493,5 +1513,5 @@ let pp_defs_lem (types_file,types_modules) (defs_file,defs_modules) (Defs defs)
         (separate_map hardline)
           (fun lib -> separate space [string "open import";string lib]) defs_modules;hardline;
         hardline;
-        separate empty (List.map doc_def_lem defs);
+        separate empty (List.map (doc_def_lem type_env) defs);
         hardline]);
diff --git a/src/pretty_print_sail.ml b/src/pretty_print_sail.ml
index 16c338bd..67f291bd 100644
--- a/src/pretty_print_sail.ml
+++ b/src/pretty_print_sail.ml
@@ -92,6 +92,8 @@ let rec doc_nexp =
   let rec atomic_nexp (Nexp_aux (n_aux, _) as nexp) =
     match n_aux with
     | Nexp_constant c -> string (Big_int.to_string c)
+    | Nexp_app (Id_aux (DeIid op, _), [n1; n2]) ->
+       separate space [atomic_nexp n1; string op; atomic_nexp n2]
     | Nexp_app (id, nexps) -> string (string_of_nexp nexp)
     (* This segfaults??!!!!
        doc_id id ^^ (parens (separate_map (comma ^^ space) doc_nexp nexps))
@@ -119,6 +121,12 @@ let rec doc_nexp =
   in
   nexp0
 
+let doc_effect (Effect_aux (aux, _)) =
+  match aux with
+  | Effect_set [] -> string "pure"
+  | Effect_set effs ->
+     braces (separate (comma ^^ space) (List.map (fun be -> string (string_of_base_effect be)) effs))
+
 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) =
@@ -371,6 +379,8 @@ let rec doc_exp (E_aux (e_aux, _) as exp) =
   | E_if (if_exp, then_exp, else_exp) when if_block_then then_exp ->
      (separate space [string "if"; doc_exp if_exp; string "then"] ^//^ doc_exp then_exp)
      ^/^ (string "else" ^^ space ^^ doc_exp else_exp)
+  | E_if (if_exp, then_exp, E_aux ((E_lit (L_aux (L_unit, _)) | E_block []), _)) ->
+     group (separate space [string "if"; doc_exp if_exp; string "then"; doc_exp then_exp])
   | E_if (if_exp, then_exp, else_exp) ->
      group (separate space [string "if"; doc_exp if_exp; string "then"; doc_exp then_exp; string "else"; doc_exp else_exp])
 
@@ -568,7 +578,10 @@ let doc_mapdef (MD_aux (MD_mapping (id, typa, mapcls), _)) =
 
 let doc_dec (DEC_aux (reg,_)) =
   match reg with
-  | DEC_reg (typ, id) -> separate space [string "register"; doc_id id; colon; doc_typ typ]
+  | DEC_reg (Effect_aux (Effect_set [BE_aux (BE_rreg, _)], _), Effect_aux (Effect_set [BE_aux (BE_wreg, _)], _), typ, id) ->
+     separate space [string "register"; doc_id id; colon; doc_typ typ]
+  | DEC_reg (reffect, weffect, typ, id) ->
+     separate space [string "register"; doc_effect reffect; doc_effect weffect; doc_id id; colon; doc_typ typ]
   | DEC_config (id, typ, exp) -> separate space [string "register configuration"; doc_id id; colon; doc_typ typ; equals; doc_exp exp]
   | DEC_alias(id,alspec) -> string "ALIAS"
   | DEC_typ_alias(typ,id,alspec) -> string "ALIAS"
@@ -578,11 +591,11 @@ 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, _)) =
+let doc_typ_arg_kind sep (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_nexp _ -> space ^^ string sep ^^ space ^^string "Int"
+  | A_bool _ -> space ^^ string sep ^^ space ^^ string "Bool"
+  | A_order  _ -> space ^^ string sep ^^ space ^^ string "Order"
   | A_typ _ -> empty
 
 let doc_typdef (TD_aux(td,_)) = match td with
@@ -590,20 +603,20 @@ let doc_typdef (TD_aux(td,_)) = match td with
      begin
        match doc_typquant typq with
        | Some qdoc ->
-          doc_op equals (concat [string "type"; space; doc_id id; qdoc; doc_typ_arg_kind typ_arg]) (doc_typ_arg typ_arg)
+          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_typ_arg_kind typ_arg]) (doc_typ_arg typ_arg)
+          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, _) ->
+  | 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, _) ->
+  | 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, _) ->
+  | TD_record (id, TypQ_aux (TypQ_tq qs, _), fields, _) ->
      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, _) ->
+  | 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, _) ->
+  | TD_variant (id, TypQ_aux (TypQ_tq qs, _), unions, _) ->
      separate space [string "union"; doc_id id; doc_param_quants qs; equals;
                      surround 2 0 lbrace (separate_map (comma ^^ break 1) doc_union unions) rbrace]
   | _ -> string "TYPEDEF"
@@ -629,9 +642,6 @@ let doc_prec = function
   | InfixL -> string "infixl"
   | InfixR -> string "infixr"
 
-let doc_kind_def (KD_aux (KD_nabbrev (_, id, _, nexp), _)) =
-  separate space [string "integer"; doc_id id; equals; doc_nexp nexp]
-
 let rec doc_scattered (SD_aux (sd_aux, _)) =
   match sd_aux with
   | SD_function (_, _, _, id) ->
@@ -640,9 +650,9 @@ let rec doc_scattered (SD_aux (sd_aux, _)) =
      string "function" ^^ space ^^ string "clause" ^^ space ^^ doc_funcl funcl
   | SD_end id ->
      string "end" ^^ space ^^ doc_id id
-  | SD_variant (id, _, TypQ_aux (TypQ_no_forall, _)) ->
+  | 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, _)) ->
+  | 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]
@@ -651,7 +661,6 @@ let rec doc_def def = group (match def with
   | DEF_default df -> doc_default df
   | DEF_spec v_spec -> doc_spec v_spec
   | DEF_type t_def -> doc_typdef t_def
-  | DEF_kind k_def -> doc_kind_def k_def
   | DEF_fundef f_def -> doc_fundef f_def
   | DEF_mapdef m_def -> doc_mapdef m_def
   | DEF_val lbind -> string "let" ^^ space ^^ doc_letbind lbind
diff --git a/src/process_file.ml b/src/process_file.ml
index e8bb5fc1..d2a43b4a 100644
--- a/src/process_file.ml
+++ b/src/process_file.ml
@@ -90,7 +90,13 @@ let parse_file ?loc:(l=Parse_ast.Unknown) (f : string) : Parse_ast.defs =
 (* Simple preprocessor features for conditional file loading *)
 module StringSet = Set.Make(String)
 
-let symbols = ref StringSet.empty
+let default_symbols =
+  List.fold_left (fun set str -> StringSet.add str set) StringSet.empty
+    [ "FEATURE_IMPLICITS" ]
+
+let symbols = ref default_symbols
+
+let clear_symbols () = symbols := default_symbols
 
 let cond_pragma l defs =
   let depth = ref 0 in
@@ -130,7 +136,7 @@ let parseid_to_string (Parse_ast.Id_aux (id, _)) =
 
 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) ->
+  | Parse_ast.TD_variant (union_id, typq, _, flag) ->
      begin match arms with
      | [] -> []
      | arm :: arms ->
@@ -141,7 +147,7 @@ let rec realise_union_anon_rec_types orig_union arms =
            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
+           let new_rec_def = DEF_type (TD_aux (TD_record (record_id, typq, fields, flag), Generated l)) in
            (Some new_rec_def, new_arm) :: (realise_union_anon_rec_types orig_union arms)
      end
   | _ ->
@@ -195,7 +201,7 @@ let rec preprocess opts = function
        let sail_dir =
          try Sys.getenv "SAIL_DIR" with
          | Not_found ->
-            let share_dir = Share_directory.d in
+            let share_dir = Manifest.dir in
             if Sys.file_exists share_dir then
               share_dir
             else
@@ -214,7 +220,7 @@ let rec preprocess opts = function
 
   (* realise any anonymous record arms of variants *)
   | Parse_ast.DEF_type (Parse_ast.TD_aux
-                          (Parse_ast.TD_variant (id, name_scm_opt, typq, arms, flag) as union, l)
+                          (Parse_ast.TD_variant (id, typq, arms, flag) as union, l)
                        ) :: defs ->
      let records_and_arms = realise_union_anon_rec_types union arms in
      let rec filter_records = function [] -> []
@@ -223,7 +229,7 @@ let rec preprocess opts = function
      in
      let generated_records = filter_records (List.map fst records_and_arms) in
      let rewritten_arms = List.map snd records_and_arms in
-     let rewritten_union = Parse_ast.TD_variant (id, name_scm_opt, typq, rewritten_arms, flag) in
+     let rewritten_union = Parse_ast.TD_variant (id, typq, rewritten_arms, flag) in
      generated_records @ (Parse_ast.DEF_type (Parse_ast.TD_aux (rewritten_union, l))) :: preprocess opts defs
 
   | (Parse_ast.DEF_default (Parse_ast.DT_aux (Parse_ast.DT_order (_, Parse_ast.ATyp_aux (atyp, _)), _)) as def) :: defs ->
@@ -237,12 +243,10 @@ let rec preprocess opts = function
 
 let preprocess_ast opts (Parse_ast.Defs defs) = Parse_ast.Defs (preprocess opts defs)
 
-let convert_ast (order : Ast.order) (defs : Parse_ast.defs) : unit Ast.defs = Initial_check.process_ast order defs
-
-let load_file_no_check opts order f = convert_ast order (preprocess_ast opts (parse_file f))
+let load_file_no_check opts order f = Initial_check.process_ast (preprocess_ast opts (parse_file f))
 
 let load_file opts order env f =
-  let ast = convert_ast order (preprocess_ast opts (parse_file f)) in
+  let ast = Initial_check.process_ast (preprocess_ast opts (parse_file f)) in
   Type_error.check env ast
 
 let opt_just_check = ref false
@@ -284,7 +288,7 @@ let close_output_with_check (o, temp_file_name, opt_dir, file_name) =
 let generated_line f =
   Printf.sprintf "Generated by Sail from %s." f
 
-let output_lem filename libs defs =
+let output_lem filename libs type_env defs =
   let generated_line = generated_line filename in
   (* let seq_suffix = if !Pretty_print_lem.opt_sequential then "_sequential" else "" in *)
   let types_module = (filename ^ "_types") in
@@ -324,7 +328,7 @@ let output_lem filename libs defs =
   (Pretty_print.pp_defs_lem
      (ot, base_imports)
      (o, base_imports @ (String.capitalize_ascii types_module :: libs))
-     defs generated_line);
+     type_env defs generated_line);
   close_output_with_check ext_ot;
   close_output_with_check ext_o;
   let ((ol,_,_,_) as ext_ol) =
@@ -360,23 +364,23 @@ let rec iterate (f : int -> unit) (n : int) : unit =
   if n = 0 then ()
   else (f n; iterate f (n - 1))
 
-let output1 libpath out_arg filename defs  =
+let output1 libpath out_arg filename type_env defs  =
   let f' = Filename.basename (Filename.chop_extension filename) in
   match out_arg with
   | Lem_out libs ->
-     output_lem f' libs defs
+     output_lem f' libs type_env defs
   | Coq_out libs ->
      output_coq !opt_coq_output_dir f' libs defs
 
 let output libpath out_arg files =
   List.iter
-    (fun (f, defs) ->
-      output1 libpath out_arg f defs)
+    (fun (f, type_env, defs) ->
+      output1 libpath out_arg f type_env defs)
     files
 
-let rewrite_step defs (name, rewriter) =
+let rewrite_step n total env defs (name, rewriter) =
   let t = Profile.start () in
-  let defs = rewriter defs in
+  let defs = rewriter env defs in
   Profile.finish ("rewrite " ^ name) t;
   let _ = match !(opt_ddump_rewrite_ast) with
     | Some (f, i) ->
@@ -389,21 +393,23 @@ let rewrite_step defs (name, rewriter) =
         opt_ddump_rewrite_ast := Some (f, i + 1)
       end
     | _ -> () in
+  Util.progress "Rewrite " name n total;
   defs
 
-let rewrite rewriters env defs =
-  try List.fold_left rewrite_step defs rewriters with
-  | Type_check.Type_error (l, err) ->
+let rewrite env rewriters defs =
+  let total = List.length rewriters in
+  try snd (List.fold_left (fun (n, defs) rw -> n + 1, rewrite_step n total env defs rw) (1, defs) rewriters) with
+  | Type_check.Type_error (_, l, err) ->
      raise (Reporting.err_typ l (Type_error.string_of_type_error err))
 
-let rewrite_ast = rewrite [("initial", Rewriter.rewrite_defs)]
-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
+let rewrite_ast env = rewrite env [("initial", fun _ -> Rewriter.rewrite_defs)]
+let rewrite_ast_lem env = rewrite env Rewrites.rewrite_defs_lem
+let rewrite_ast_coq env = rewrite env Rewrites.rewrite_defs_coq
+let rewrite_ast_ocaml env = rewrite env Rewrites.rewrite_defs_ocaml
 let rewrite_ast_c env ast =
   ast
-  |> rewrite Rewrites.rewrite_defs_c env
-  |> rewrite [("constant_fold", Constant_fold.rewrite_constant_function_calls env)] env
+  |> rewrite env Rewrites.rewrite_defs_c
+  |> rewrite env [("constant_fold", fun _ -> Constant_fold.rewrite_constant_function_calls env)]
 
-let rewrite_ast_interpreter = rewrite Rewrites.rewrite_defs_interpreter
-let rewrite_ast_check = rewrite Rewrites.rewrite_defs_check
+let rewrite_ast_interpreter env = rewrite env Rewrites.rewrite_defs_interpreter
+let rewrite_ast_check env = rewrite env Rewrites.rewrite_defs_check
diff --git a/src/process_file.mli b/src/process_file.mli
index 7371b299..0411464b 100644
--- a/src/process_file.mli
+++ b/src/process_file.mli
@@ -52,7 +52,8 @@
    $include directive that is importing the file, if applicable. *)
 val parse_file : ?loc:Parse_ast.l -> string -> Parse_ast.defs
 
-val convert_ast : Ast.order -> Parse_ast.defs -> unit Ast.defs
+val clear_symbols : unit -> unit
+
 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
@@ -82,7 +83,7 @@ type out_type =
 val output :
   string ->                           (* The path to the library *)
   out_type ->                         (* Backend kind *)
-  (string * Type_check.tannot Ast.defs) list -> (*File names paired with definitions *)
+  (string * Type_check.Env.t * Type_check.tannot Ast.defs) list -> (*File names paired with definitions *)
   unit
 
 (** [always_replace_files] determines whether Sail only updates modified files.
diff --git a/src/profile.ml b/src/profile.ml
index cb374403..1a8bd30b 100644
--- a/src/profile.ml
+++ b/src/profile.ml
@@ -83,7 +83,7 @@ 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 "%s %s: %fs" Util.("Profiled" |> 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
     | [] -> ()
diff --git a/src/reporting.ml b/src/reporting.ml
index 858e5c41..0bc73ed6 100644
--- a/src/reporting.ml
+++ b/src/reporting.ml
@@ -95,166 +95,24 @@
 (*  IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.                         *)
 (**************************************************************************)
 
-let rec skip_lines in_chan = function
-  | n when n <= 0 -> ()
-  | n -> ignore (input_line in_chan); skip_lines in_chan (n - 1)
-
-let rec read_lines in_chan = function
-  | n when n <= 0 -> []
-  | n ->
-     let l = input_line in_chan in
-     let ls = read_lines in_chan (n - 1) in
-     l :: ls
-
-let termcode n = "\x1B[" ^ string_of_int n ^ "m"
-
-let print_code1 ff fname lnum1 cnum1 cnum2 =
-  try
-    let in_chan = open_in fname in
-    begin
-      try
-        skip_lines in_chan (lnum1 - 1);
-        let line = input_line in_chan in
-        Format.fprintf ff "%s%s%s"
-                       (Str.string_before line cnum1)
-                       Util.(Str.string_before (Str.string_after line cnum1) (cnum2 - cnum1) |> red_bg |> clear)
-                       (Str.string_after line cnum2);
-        close_in in_chan
-      with e -> (close_in_noerr in_chan;
-                 prerr_endline (Printf.sprintf "print_code1: %s %d %d %d %s" fname lnum1 cnum1 cnum2 (Printexc.to_string e)))
-    end
-  with _ -> ()
-
-let format_pos ff p =
-  let open Lexing in
-  begin
-    Format.fprintf ff "file \"%s\", line %d, character %d:\n\n"
-                   p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol);
-    print_code1 ff p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol) (p.pos_cnum - p.pos_bol + 1);
-    Format.fprintf ff "\n\n";
-    Format.pp_print_flush ff ()
+type pos_or_loc = Loc of Parse_ast.l | Pos of Lexing.position
+
+let print_err_internal p_l m1 m2 =
+  let open Error_format in
+  prerr_endline (m1 ^ ":");
+  begin match p_l with
+  | Loc l -> format_message (Location (l, Line m2)) err_formatter
+  | Pos p -> format_message (Location (Parse_ast.Range (p, p), Line m2)) err_formatter
   end
 
-let print_code2 ff fname lnum1 cnum1 lnum2 cnum2 =
-  try
-    let in_chan = open_in fname in
-    begin
-      try
-        skip_lines in_chan (lnum1 - 1);
-        let line = input_line in_chan in
-        Format.fprintf ff "%s%s\n"
-                       (Str.string_before line cnum1)
-                       Util.(Str.string_after line cnum1 |> red_bg |> clear);
-        let lines = read_lines in_chan (lnum2 - lnum1 - 1) in
-        List.iter (fun l -> Format.fprintf ff "%s\n" Util.(l |> red_bg |> clear)) lines;
-        let line = input_line in_chan in
-        Format.fprintf ff "%s%s"
-                       Util.(Str.string_before line cnum2 |> red_bg |> clear)
-                       (Str.string_after line cnum2);
-        close_in in_chan
-      with e -> (close_in_noerr in_chan; prerr_endline (Printexc.to_string e))
-    end
-  with _ -> ()
-
-let format_pos2 ff p1 p2 =
-  let open Lexing in
-  begin
-    Format.fprintf ff "file \"%s\", line %d, character %d to line %d, character %d\n\n"
-                   p1.pos_fname
-                   p1.pos_lnum (p1.pos_cnum - p1.pos_bol + 1)
-                   p2.pos_lnum (p2.pos_cnum - p2.pos_bol);
-    if p1.pos_lnum == p2.pos_lnum
-    then print_code1 ff p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) (p2.pos_cnum - p2.pos_bol)
-    else print_code2 ff p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) p2.pos_lnum (p2.pos_cnum - p2.pos_bol);
-    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 =
-  let (s, e, multi) = if p1.Lexing.pos_lnum = p2.Lexing.pos_lnum then
-                  (* everything in the same line, so really only read this small part*)
-                  (p1.Lexing.pos_cnum, p2.Lexing.pos_cnum, None) 
-               else (*multiline, so start reading at beginning of line *)
-                  (p1.Lexing.pos_bol, p2.Lexing.pos_cnum, Some (p1.Lexing.pos_cnum - p1.Lexing.pos_bol)) in
-
-  let ic = open_in p1.Lexing.pos_fname in
-  let _ = seek_in ic s in
-  let l = (e - s) in
-  let buf = Bytes.create l in
-  let _ = input ic buf 0 l in
-  let _ = match multi with None -> () | Some sk -> Bytes.fill buf 0 sk ' ' in
-  let _ = close_in ic in
-  (buf, not (multi = None))
-
-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 = 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 =
- (format_loc_aux ff l;
-  Format.pp_print_newline ff ();
-  Format.pp_print_flush ff ()
-);;
-
-let print_err_loc l = 
-   (format_loc Format.err_formatter 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 ?code:(code=true) l =
-  let _ = Format.flush_str_formatter () in
-  let _ = format_loc_aux ~code:code Format.str_formatter l in
-  let s = Format.flush_str_formatter () in
-  s
-
-type pos_or_loc = Loc of Parse_ast.l | LocD of Parse_ast.l * Parse_ast.l | Pos of Lexing.position
-
-let print_err_internal fatal verb_loc p_l m1 m2 =
-  Format.eprintf "%s at " m1;
-  let _ = (match p_l with Pos p -> print_err_pos p
-                        | Loc l -> print_err_loc l
-                        | LocD (l1,l2) ->
-                          print_err_loc l1; Format.fprintf Format.err_formatter " and "; print_err_loc l2) in
-  Format.eprintf "%s\n" m2;
-  if verb_loc then (match p_l with Loc l ->
-      format_loc_source Format.err_formatter l;
-      Format.pp_print_newline Format.err_formatter (); | _ -> ());
-  Format.pp_print_flush Format.err_formatter ();
-  if fatal then (exit 1) else ()
+  let open Error_format in
+  let b = Buffer.create 160 in
+  format_message (Location (l, Line "")) (buffer_formatter b);
+  Buffer.contents b
 
-let print_err fatal verb_loc l m1 m2 =
-  print_err_internal fatal verb_loc (Loc l) m1 m2
+let print_err l m1 m2 =
+  print_err_internal (Loc l) m1 m2
 
 type error =
   | Err_general of Parse_ast.l * string
@@ -264,20 +122,18 @@ type error =
   | Err_syntax_locn of Parse_ast.l * string
   | Err_lex of Lexing.position * string
   | 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_general (l, m) -> ("Error", Loc l, m)
   | Err_unreachable (l, (file, line, _, _), m) ->
-     ((Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line), 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)
-  | Err_lex (p, s) -> ("Lexical error", false, Pos p, s)
-  | Err_type (l, m) -> ("Type error", false, Loc l, m)
-  | Err_type_dual(l1,l2,m) -> ("Type error", false, LocD (l1,l2), m)
+     (Printf.sprintf "Internal error: Unreachable code (at \"%s\" line %d)" file line, Loc l, m ^ issues)
+  | Err_todo (l, m) -> ("Todo" ^ m, Loc l, "")
+  | Err_syntax (p, m) -> ("Syntax error", Pos p, m)
+  | Err_syntax_locn (l, m) -> ("Syntax error", Loc l, m)
+  | Err_lex (p, s) -> ("Lexical error", Pos p, s)
+  | Err_type (l, m) -> ("Type error", Loc l, m)
 
 exception Fatal_error of error
 
@@ -286,12 +142,10 @@ let err_todo l m = Fatal_error (Err_todo (l, m))
 let err_unreachable l ocaml_pos m = Fatal_error (Err_unreachable (l, ocaml_pos, m))
 let err_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 (m1, verb_pos, pos_l, m2) = dest_err e in
-  (print_err_internal verb_pos false pos_l m1 m2; exit 1)
+let unreachable l pos msg =
+  raise (err_unreachable l pos msg)
 
 let print_error e =
-  let (m1, verb_pos, pos_l, m2) = dest_err e in
-  print_err_internal verb_pos false pos_l m1 m2
+  let (m1, pos_l, m2) = dest_err e in
+  print_err_internal pos_l m1 m2
diff --git a/src/reporting.mli b/src/reporting.mli
index 63ed3eee..2d886111 100644
--- a/src/reporting.mli
+++ b/src/reporting.mli
@@ -69,13 +69,13 @@ val loc_to_string : ?code:bool -> Parse_ast.l -> string
     std-err. It starts with printing location information stored in [l]
     It then prints "head: mes". If [fatal] is set, the program exists with error-code 1 afterwards.
 *)
-val print_err : bool -> bool -> Parse_ast.l -> string -> string -> unit
+val print_err : Parse_ast.l -> string -> string -> unit
 
 (** {2 Errors } *)
 
 (** Errors stop execution and print a message; they typically have a location and message.
 *)
-type error = 
+type error =
   (** General errors, used for multi purpose. If you are unsure, use this one. *)
   | Err_general of Parse_ast.l * string
 
@@ -90,8 +90,7 @@ type error =
   | Err_syntax_locn of Parse_ast.l * string
   | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
-  | Err_type_dual of Parse_ast.l * Parse_ast.l * string
-  
+
 exception Fatal_error of error
 
 (** [err_todo l m] is an abreviatiation for [Fatal_error (Err_todo (l, m))] *)
@@ -106,11 +105,6 @@ val err_unreachable : Parse_ast.l -> (string * int * int * int) -> string -> exn
 (** [err_typ l m] is an abreviatiation for [Fatal_error (Err_type (l, m))] *)
 val err_typ : Parse_ast.l -> string -> exn
 
-(** [err_typ_dual l1 l2 m] is an abreviatiation for [Fatal_error (Err_type_dual (l1, l2, m))] *)
-val err_typ_dual : Parse_ast.l ->  Parse_ast.l -> string -> exn
-
-(** Report error should only be used by main to print the error in the end. Everywhere else,
-    raising a [Fatal_error] exception is recommended. *)
-val report_error : error -> 'a
+val unreachable : Parse_ast.l -> (string * int * int * int) -> string -> 'a
 
 val print_error : error -> unit
diff --git a/src/rewriter.ml b/src/rewriter.ml
index 21310b91..89f64401 100644
--- a/src/rewriter.ml
+++ b/src/rewriter.ml
@@ -336,7 +336,7 @@ let rewrite_lexp rewriters (LEXP_aux(lexp,(l,annot))) =
   | LEXP_memory (id,exps) -> rewrap (LEXP_memory(id,List.map (rewriters.rewrite_exp rewriters) exps))
   | LEXP_vector (lexp,exp) ->
     rewrap (LEXP_vector (rewriters.rewrite_lexp rewriters lexp,rewriters.rewrite_exp rewriters exp))
-  | LEXP_vector_range (lexp,exp1,exp2) -> 
+  | LEXP_vector_range (lexp,exp1,exp2) ->
     rewrap (LEXP_vector_range (rewriters.rewrite_lexp rewriters lexp,
                                rewriters.rewrite_exp rewriters exp1,
                                rewriters.rewrite_exp rewriters exp2))
@@ -358,7 +358,7 @@ let rewrite_fun rewriters (FD_aux (FD_function(recopt,tannotopt,effectopt,funcls
 let rewrite_def rewriters d = match d with
   | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), annot)) ->
      DEF_reg_dec (DEC_aux (DEC_config (id, typ, rewriters.rewrite_exp rewriters exp), annot))
-  | DEF_type _ | DEF_mapdef _ | DEF_kind _ | DEF_spec _ | DEF_default _ | DEF_reg_dec _ | DEF_overload _ | DEF_fixity _ -> d
+  | DEF_type _ | DEF_mapdef _ | DEF_spec _ | DEF_default _ | DEF_reg_dec _ | DEF_overload _ | DEF_fixity _ -> d
   | 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)
@@ -372,6 +372,75 @@ let rewrite_defs_base rewriters (Defs defs) =
     | d::ds -> (rewriters.rewrite_def rewriters d)::(rewrite ds) in
   Defs (rewrite defs)
 
+let rewrite_defs_base_progress prefix rewriters (Defs defs) =
+  let total = List.length defs in
+  let rec rewrite n = function
+    | [] -> []
+    | d :: ds ->
+       Util.progress (prefix ^ " ") (string_of_int n ^ "/" ^ string_of_int total) n total;
+       let d = rewriters.rewrite_def rewriters d in
+       d :: rewrite (n + 1) ds
+  in
+  Defs (rewrite 1 defs)
+
+let rec takedrop n xs =
+  match n, xs with
+  | 0, _ -> [], xs
+  | n, [] -> [], []
+  | n, x :: xs ->
+     let ys, xs = takedrop (n - 1) xs in
+     x :: ys, xs
+
+let rewrite_defs_base_parallel j rewriters (Defs defs) =
+  let module IntMap = Map.Make(struct type t = int let compare = compare end) in
+  let total = List.length defs in
+  let defs = ref defs in
+
+  (* We have a list of child processes in pids, and a mapping from pid
+     to result location in results. *)
+  let pids = ref [] in
+  let results = ref IntMap.empty in
+  for i = 1 to j do
+    let work = if i = 1 then total / j + total mod j else total / j in
+    let work, rest = takedrop work !defs in
+    (* Create a temporary file where the child process will return it's result *)
+    let result = Filename.temp_file "sail" ".rewrite" in
+    let pid = Unix.fork () in
+    begin
+      if pid = 0 then
+        let Defs work = rewrite_defs_base rewriters (Defs work) in
+        let out_chan = open_out result in
+        Marshal.to_channel out_chan work [Marshal.Closures];
+        close_out out_chan;
+        exit 0
+      else
+        (pids := pid :: !pids; results := IntMap.add pid result !results)
+    end;
+    defs := rest
+  done;
+  (* Make sure we haven't left any definitions behind! *)
+  assert(List.length !defs = 0);
+
+  let rewritten = ref [] in
+
+  (* Now we wait for all our child processes *)
+  while List.compare_length_with !pids 0 > 0 do
+    let child = List.hd !pids in
+    pids := List.tl !pids;
+    let _, status = Unix.waitpid [] child in
+    match status with
+    | WEXITED 0 ->
+       let result = IntMap.find child !results in
+       let in_chan = open_in result in
+       rewritten := Marshal.from_channel in_chan :: !rewritten;
+       close_in in_chan;
+       Sys.remove result
+    | _ ->
+       prerr_endline "Child process exited abnormally in parallel rewrite";
+       exit 1
+  done;
+  Defs (List.concat !rewritten)
+  
 let rewriters_base =
   {rewrite_exp = rewrite_exp;
    rewrite_pat = rewrite_pat;
@@ -383,29 +452,6 @@ let rewriters_base =
 
 let rewrite_defs (Defs defs) = rewrite_defs_base rewriters_base (Defs defs)
 
-module Envmap = Finite_map.Fmap_map(String)
-
-(* TODO: This seems to only consider a single assignment (or possibly two, in
-   separate branches of an if-expression). Hence, it seems the result is always
-   at most one variable. Is this intended?
-   It is only used below when pulling out local variables inside if-expressions
-   into the outer scope, which seems dubious. I comment it out for now. *)
-(*let rec introduced_variables (E_aux (exp,(l,annot))) =
-  match exp with
-  | E_cast (typ, exp) -> introduced_variables exp
-  | E_if (c,t,e) -> Envmap.intersect (introduced_variables t) (introduced_variables e)
-  | E_assign (lexp,exp) -> introduced_vars_le lexp exp
-  | _ -> Envmap.empty
-
-and introduced_vars_le (LEXP_aux(lexp,annot)) exp =
-  match lexp with
-  | LEXP_id (Id_aux (Id id,_))  | LEXP_cast(_,(Id_aux (Id id,_))) ->
-    (match annot with
-     | Base((_,t),Emp_intro,_,_,_,_) ->
-       Envmap.insert Envmap.empty (id,(t,exp))
-     | _ -> Envmap.empty)
-  | _ -> Envmap.empty*)
-
 type ('a,'pat,'pat_aux,'fpat,'fpat_aux) pat_alg =
   { p_lit            : lit -> 'pat_aux
   ; p_wild           : 'pat_aux
diff --git a/src/rewriter.mli b/src/rewriter.mli
index 9da94a99..ec4e381c 100644
--- a/src/rewriter.mli
+++ b/src/rewriter.mli
@@ -70,6 +70,11 @@ val rewrite_defs : tannot defs -> tannot defs
 
 val rewrite_defs_base : tannot rewriters -> tannot defs -> tannot defs
 
+val rewrite_defs_base_parallel : int -> tannot rewriters -> tannot defs -> tannot defs
+  
+(* Same as rewrite_defs base but display a progress bar when verbosity >= 1 *)
+val rewrite_defs_base_progress : string -> tannot rewriters -> tannot defs -> tannot defs
+
 val rewrite_lexp : tannot rewriters -> tannot lexp -> tannot lexp
 
 val rewrite_pat : tannot rewriters -> tannot pat -> tannot pat
diff --git a/src/rewrites.ml b/src/rewrites.ml
index 284c7d67..44d99537 100644
--- a/src/rewrites.ml
+++ b/src/rewrites.ml
@@ -54,7 +54,6 @@ open Ast_util
 open Type_check
 open Spec_analysis
 open Rewriter
-open Extra_pervasives
 
 let (>>) f g = fun x -> g(f(x))
 
@@ -239,7 +238,7 @@ let lookup_constant_kid env kid =
   List.fold_left check_nc None (Env.get_constraints env)
 
 let rec rewrite_nexp_ids env (Nexp_aux (nexp, l) as nexp_aux) = match nexp with
-  | Nexp_id id -> rewrite_nexp_ids env (Env.get_num_def id env)
+  | Nexp_id id -> Env.expand_nexp_synonyms env nexp_aux
   | Nexp_var kid ->
      begin
        match lookup_constant_kid env kid with
@@ -281,27 +280,27 @@ let rewrite_defs_nexp_ids, rewrite_typ_nexp_ids =
     | None -> l, empty_tannot
   in
 
-  let rewrite_def rewriters = function
-    | DEF_spec (VS_aux (VS_val_spec (typschm, id, exts, b), (l, tannot))) when not (is_empty_tannot tannot) ->
-       let env = env_of_annot (l, tannot) in
-       let typ = typ_of_annot (l, tannot) in
-       let eff = effect_of_annot tannot in
-       let typschm = match typschm with
-         | TypSchm_aux (TypSchm_ts (tq, typ), l) ->
-            TypSchm_aux (TypSchm_ts (tq, rewrite_typ env typ), l)
-       in
-       let a = rewrite_annot (l, mk_tannot env typ eff) in
+  let rewrite_typschm env (TypSchm_aux (TypSchm_ts (tq, typ), l)) =
+    TypSchm_aux (TypSchm_ts (tq, rewrite_typ env typ), l)
+  in
+
+  let rewrite_def env rewriters = function
+    | DEF_spec (VS_aux (VS_val_spec (typschm, id, exts, b), a)) ->
+       let typschm = rewrite_typschm env typschm in
+       let a = rewrite_annot a in
        DEF_spec (VS_aux (VS_val_spec (typschm, id, exts, b), a))
+    | DEF_type (TD_aux (TD_abbrev (id, typq, typ_arg), a)) ->
+       DEF_type (TD_aux (TD_abbrev (id, typq, rewrite_typ_arg env typ_arg), a))
     | d -> Rewriter.rewrite_def rewriters d
   in
 
-  rewrite_defs_base { rewriters_base with
-    rewrite_exp = (fun _ -> map_exp_annot rewrite_annot); rewrite_def = rewrite_def
-    },
+  (fun env defs -> rewrite_defs_base { rewriters_base with
+    rewrite_exp = (fun _ -> map_exp_annot rewrite_annot); rewrite_def = rewrite_def env
+    } defs),
   rewrite_typ
 
 
-let rewrite_bitvector_exps defs =
+let rewrite_bitvector_exps env defs =
   let e_aux = function
     | (E_vector es, ((l, tannot) as a)) when not (is_empty_tannot tannot) ->
        let env = env_of_annot (l, tannot) in
@@ -332,18 +331,18 @@ let rewrite_trivial_sizeof, rewrite_trivial_sizeof_exp =
   let extract_typ_var l env nexp (id, (_, typ)) =
     let var = E_aux (E_id id, (l, mk_tannot env typ no_effect)) in
     match destruct_atom_nexp env typ with
-    | Some size when prove env (nc_eq size nexp) -> Some var
+    | Some size when prove __POS__ env (nc_eq size nexp) -> Some var
     (* AA: This next case is a bit of a hack... is there a more
        general way to deal with trivial nexps that are offset by
        constants? This will resolve a 'n - 1 sizeof when 'n is in
        scope. *)
-    | Some size when prove env (nc_eq (nsum size (nint 1)) nexp) ->
+    | Some size when prove __POS__ env (nc_eq (nsum size (nint 1)) nexp) ->
        let one_exp = infer_exp env (mk_lit_exp (L_num (Big_int.of_int 1))) in
        Some (E_aux (E_app (mk_id "add_atom", [var; one_exp]), (gen_loc l, mk_tannot env (atom_typ (nsum size (nint 1))) no_effect)))
     | _ ->
        begin
          match destruct_vector env typ with
-         | Some (len, _, _) when prove env (nc_eq len nexp) ->
+         | Some (len, _, _) when prove __POS__ env (nc_eq len nexp) ->
             Some (E_aux (E_app (mk_id "length", [var]), (l, mk_tannot env (atom_typ len) no_effect)))
          | _ -> None
        end
@@ -351,13 +350,24 @@ let rewrite_trivial_sizeof, rewrite_trivial_sizeof_exp =
   let rec split_nexp (Nexp_aux (nexp_aux, l) as nexp) =
     match nexp_aux with
     | Nexp_sum (n1, n2) ->
-       mk_exp (E_app (mk_id "add_atom", [split_nexp n1; split_nexp n2]))
+       mk_exp ~loc:l (E_app (mk_id "add_atom", [split_nexp n1; split_nexp n2]))
     | Nexp_minus (n1, n2) ->
-       mk_exp (E_app (mk_id "sub_atom", [split_nexp n1; split_nexp n2]))
+       mk_exp ~loc:l (E_app (mk_id "sub_atom", [split_nexp n1; split_nexp n2]))
     | Nexp_times (n1, n2) ->
-       mk_exp (E_app (mk_id "mult_atom", [split_nexp n1; split_nexp n2]))
-    | Nexp_neg nexp -> mk_exp (E_app (mk_id "negate_atom", [split_nexp nexp]))
-    | _ -> mk_exp (E_sizeof nexp)
+       mk_exp ~loc:l (E_app (mk_id "mult_atom", [split_nexp n1; split_nexp n2]))
+    | Nexp_neg nexp ->
+       mk_exp ~loc:l (E_app (mk_id "negate_atom", [split_nexp nexp]))
+    | Nexp_app (f, [n1; n2]) when string_of_id f = "div" ->
+       (* We should be more careful about the right division here *)
+       mk_exp ~loc:l (E_app (mk_id "div", [split_nexp n1; split_nexp n2]))
+    | _ ->
+       mk_exp ~loc:l (E_sizeof nexp)
+  in
+  let is_int_typ env v _ = function
+    | (_, Typ_aux (Typ_app (f, [A_aux (A_nexp (Nexp_aux (Nexp_var v', _)), _)]), _))
+         when Kid.compare v v' = 0 && string_of_id f = "atom" ->
+       true
+    | _ -> false
   in
   let rec rewrite_e_aux split_sizeof (E_aux (e_aux, (l, _)) as orig_exp) =
     let env = env_of orig_exp in
@@ -366,9 +376,13 @@ let rewrite_trivial_sizeof, rewrite_trivial_sizeof_exp =
        E_aux (E_lit (L_aux (L_num c, l)), (l, mk_tannot env (atom_typ nexp) no_effect))
     | E_sizeof nexp ->
        begin
+         let locals = Env.get_locals env in
          match nexp_simp (rewrite_nexp_ids (env_of orig_exp) nexp) with
          | Nexp_aux (Nexp_constant c, _) ->
             E_aux (E_lit (L_aux (L_num c, l)), (l, mk_tannot env (atom_typ nexp) no_effect))
+         | Nexp_aux (Nexp_var v, _) when Bindings.exists (is_int_typ env v) locals ->
+            let id = fst (Bindings.choose (Bindings.filter (is_int_typ env v) locals)) in
+            E_aux (E_id id, (l, mk_tannot env (atom_typ nexp) no_effect))
          | _ ->
             let locals = Env.get_locals env in
             let exps = Bindings.bindings locals
@@ -386,7 +400,7 @@ let rewrite_trivial_sizeof, rewrite_trivial_sizeof_exp =
   and rewrite_e_sizeof split_sizeof =
     { id_exp_alg with e_aux = (fun (exp, annot) -> rewrite_e_aux split_sizeof (E_aux (exp, annot))) }
   in
-  rewrite_defs_base { rewriters_base with rewrite_exp = (fun _ -> fold_exp (rewrite_e_sizeof true)) }, rewrite_e_aux true
+  (fun env -> rewrite_defs_base_parallel 4 { rewriters_base with rewrite_exp = (fun _ -> fold_exp (rewrite_e_sizeof true)) }), rewrite_e_aux true
 
 (* Rewrite sizeof expressions with type-level variables to
    term-level expressions
@@ -395,7 +409,7 @@ let rewrite_trivial_sizeof, rewrite_trivial_sizeof_exp =
    be directly extracted from existing parameters of the surrounding function,
    a further parameter is added; calls to the function are rewritten
    accordingly (possibly causing further rewriting in the calling function) *)
-let rewrite_sizeof (Defs defs) =
+let rewrite_sizeof env (Defs defs) =
   let sizeof_frees exp =
     fst (fold_exp
            { (compute_exp_alg KidSet.empty KidSet.union) with
@@ -462,7 +476,7 @@ let rewrite_sizeof (Defs defs) =
            for the given parameters in the original environment *)
          let inst =
            try instantiation_of orig_exp with
-           | Type_error (l, err) ->
+           | Type_error (_, l, err) ->
              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 *)
@@ -475,7 +489,7 @@ let rewrite_sizeof (Defs defs) =
              | 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) ->
+                | Type_error (_, l, 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
@@ -996,7 +1010,7 @@ let rewrite_fun_remove_vector_concat_pat
     (FCL_aux (FCL_Funcl (id,pexp'),(l,annot)))
   in FD_aux (FD_function(recopt,tannotopt,effectopt,List.map rewrite_funcl funcls),(l,fdannot))
 
-let rewrite_defs_remove_vector_concat (Defs defs) =
+let rewrite_defs_remove_vector_concat env (Defs defs) =
   let rewriters =
     {rewrite_exp = rewrite_exp_remove_vector_concat_pat;
      rewrite_pat = rewrite_pat;
@@ -1325,7 +1339,7 @@ let contains_bitvector_pexp = function
 
 let remove_bitvector_pat (P_aux (_, (l, _)) as pat) =
 
-  let env = try env_of_pat pat with _ -> Env.empty in
+  let env = try env_of_pat pat with _ -> raise (Reporting.err_unreachable l __POS__ "Pattern without annotation found") in
 
   (* first introduce names for bitvector patterns *)
   let name_bitvector_roots =
@@ -1565,7 +1579,7 @@ let rewrite_fun_remove_bitvector_pat
     | _ -> funcls in
   FD_aux (FD_function(recopt,tannotopt,effectopt,funcls),(l,fdannot))
 
-let rewrite_defs_remove_bitvector_pats (Defs defs) =
+let rewrite_defs_remove_bitvector_pats env (Defs defs) =
   let rewriters =
     {rewrite_exp = rewrite_exp_remove_bitvector_pat;
      rewrite_pat = rewrite_pat;
@@ -1590,7 +1604,7 @@ let rewrite_defs_remove_bitvector_pats (Defs defs) =
 (* Rewrite literal number patterns to guarded patterns
    Those numeral patterns are not handled very well by Lem (or Isabelle)
  *)
-let rewrite_defs_remove_numeral_pats =
+let rewrite_defs_remove_numeral_pats env =
   let p_lit outer_env = function
     | L_aux (L_num n, l) ->
        let id = fresh_id "l__" Parse_ast.Unknown in
@@ -1623,7 +1637,7 @@ let rewrite_defs_remove_numeral_pats =
   rewrite_defs_base
     { rewriters_base with rewrite_exp = rewrite_exp; rewrite_fun = rewrite_fun }
 
-let rewrite_defs_vector_string_pats_to_bit_list =
+let rewrite_defs_vector_string_pats_to_bit_list env =
   let rewrite_p_aux (pat, (annot : tannot annot)) =
     let env = env_of_annot annot in
     match pat with
@@ -1707,7 +1721,7 @@ let rewrite_fun_guarded_pats rewriters (FD_aux (FD_function (r,t,e,funcls),(l,fd
      | _ -> funcls (* TODO is the empty list possible here? *) in
    FD_aux (FD_function(r,t,e,funcls),(l,fdannot))
 
-let rewrite_defs_guarded_pats =
+let rewrite_defs_guarded_pats env =
   rewrite_defs_base { rewriters_base with rewrite_exp = rewrite_exp_guarded_pats;
                     rewrite_fun = rewrite_fun_guarded_pats }
 
@@ -1776,7 +1790,7 @@ let rewrite_exp_lift_assign_intro rewriters ((E_aux (exp,((l,_) as annot))) as f
 
   | _ -> rewrite_base full_exp
 
-let rewrite_defs_exp_lift_assign defs = rewrite_defs_base
+let rewrite_defs_exp_lift_assign env defs = rewrite_defs_base
     {rewrite_exp = rewrite_exp_lift_assign_intro;
      rewrite_pat = rewrite_pat;
      rewrite_let = rewrite_let;
@@ -1824,7 +1838,7 @@ let rewrite_register_ref_writes (Defs defs) =
    TODO: Maybe separate generic removal of redundant returns, and Lem-specific
    rewriting of early returns
  *)
-let rewrite_defs_early_return (Defs defs) =
+let rewrite_defs_early_return env (Defs defs) =
   let is_unit (E_aux (exp, _)) = match exp with
   | E_lit (L_aux (L_unit, _)) -> true
   | _ -> false in
@@ -2022,7 +2036,7 @@ let pat_var (P_aux (paux, a)) =
 
 (* Split out function clauses for individual union constructor patterns
    (e.g. AST nodes) into auxiliary functions.  Used for the execute function. *)
-let rewrite_split_fun_constr_pats fun_name (Defs defs) =
+let rewrite_split_fun_constr_pats fun_name env (Defs defs) =
   let rewrite_fundef typquant (FD_aux (FD_function (r_o, t_o, e_o, clauses), ((l, _) as fdannot))) =
     let rec_clauses, clauses = List.partition is_funcl_rec clauses in
     let clauses, aux_funs =
@@ -2092,23 +2106,23 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
         | _ ->
            function_typ [args_typ] ret_typ eff
       in
-      let quant_new_tyvars qis =
-        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 K_int) (KidSet.elements new_tyvars)
+      let quant_new_kopts qis =
+        let quant_kopts = List.fold_left KOptSet.union KOptSet.empty (List.map kopts_of_quant_item qis) in
+        let typ_kopts = kopts_of_typ fun_typ in
+        let new_kopts = KOptSet.diff typ_kopts quant_kopts in
+        List.map mk_qi_kopt (KOptSet.elements new_kopts)
       in
       let typquant = match typquant with
         | TypQ_aux (TypQ_tq qis, l) ->
            let qis =
              List.filter
-               (fun qi -> KidSet.subset (tyvars_of_quant_item qi) (tyvars_of_typ fun_typ))
+               (fun qi -> KOptSet.subset (kopts_of_quant_item qi) (kopts_of_typ fun_typ))
                qis
-             @ quant_new_tyvars qis
+             @ quant_new_kopts qis
            in
            TypQ_aux (TypQ_tq qis, l)
         | _ ->
-           TypQ_aux (TypQ_tq (List.map (mk_qi_id K_int) (KidSet.elements (tyvars_of_typ fun_typ))), l)
+           TypQ_aux (TypQ_tq (List.map mk_qi_kopt (KOptSet.elements (kopts_of_typ fun_typ))), l)
       in
       let val_spec =
         VS_aux (VS_val_spec
@@ -2135,7 +2149,7 @@ let rewrite_split_fun_constr_pats fun_name (Defs defs) =
 
 (* Propagate effects of functions, if effect checking and propagation
    have not been performed already by the type checker. *)
-let rewrite_fix_val_specs (Defs defs) =
+let rewrite_fix_val_specs env (Defs defs) =
   let find_vs env val_specs id =
     try Bindings.find id val_specs with
     | Not_found ->
@@ -2275,25 +2289,32 @@ let rewrite_fix_val_specs (Defs defs) =
 
 (* Turn constraints into numeric expressions with sizeof *)
 let rewrite_constraint =
-  let rec rewrite_nc (NC_aux (nc_aux, l)) = mk_exp (rewrite_nc_aux nc_aux)
-  and rewrite_nc_aux = function
+  let rec rewrite_nc env (NC_aux (nc_aux, l)) = mk_exp (rewrite_nc_aux l env nc_aux)
+  and rewrite_nc_aux l env = function
     | NC_bounded_ge (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id ">=", mk_exp (E_sizeof n2))
     | NC_bounded_le (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "<=", mk_exp (E_sizeof n2))
     | NC_equal (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "==", mk_exp (E_sizeof n2))
     | NC_not_equal (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "!=", mk_exp (E_sizeof n2))
-    | NC_and (nc1, nc2) -> E_app_infix (rewrite_nc nc1, mk_id "&", rewrite_nc nc2)
-    | NC_or (nc1, nc2) -> E_app_infix (rewrite_nc nc1, mk_id "|", rewrite_nc nc2)
+    | NC_and (nc1, nc2) -> E_app_infix (rewrite_nc env nc1, mk_id "&", rewrite_nc env nc2)
+    | NC_or (nc1, nc2) -> E_app_infix (rewrite_nc env nc1, mk_id "|", rewrite_nc env nc2)
     | NC_false -> E_lit (mk_lit L_false)
     | NC_true -> E_lit (mk_lit L_true)
     | NC_set (kid, []) -> E_lit (mk_lit (L_false))
     | NC_set (kid, int :: ints) ->
        let kid_eq kid int = nc_eq (nvar kid) (nconstant int) in
-       unaux_exp (rewrite_nc (List.fold_left (fun nc int -> nc_or nc (kid_eq kid int)) (kid_eq kid int) ints))
+       unaux_exp (rewrite_nc env (List.fold_left (fun nc int -> nc_or nc (kid_eq kid int)) (kid_eq kid int) ints))
+    | NC_app (f, [A_aux (A_bool nc, _)]) when string_of_id f = "not" ->
+       E_app (mk_id "not_bool", [rewrite_nc env nc])
+    | NC_app (f, args) ->
+       unaux_exp (rewrite_nc env (Env.expand_constraint_synonyms env (mk_nc (NC_app (f, args)))))
+    | NC_var v ->
+       (* Would be better to translate change E_sizeof to take a kid, then rewrite to E_sizeof *)
+       E_id (id_of_kid v)
   in
-  let rewrite_e_aux (E_aux (e_aux, _) as exp) =
+  let rewrite_e_aux (E_aux (e_aux, (l, _)) as exp) =
     match e_aux with
     | E_constraint nc ->
-       check_exp (env_of exp) (rewrite_nc nc) bool_typ
+       locate (fun _ -> gen_loc l) (check_exp (env_of exp) (rewrite_nc (env_of exp) nc) (atom_bool_typ nc))
     | _ -> exp
   in
 
@@ -2308,23 +2329,25 @@ let rewrite_type_def_typs rw_typ rw_typquant (TD_aux (td, annot)) =
   match td with
   | 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) ->
-     TD_aux (TD_variant (id, nso, rw_typquant typq, List.map (rewrite_type_union_typs rw_typ) tus, flag), annot)
-  | TD_enum (id, nso, ids, flag) -> TD_aux (TD_enum (id, nso, ids, flag), annot)
+  | TD_abbrev (id, typq, typ_arg) ->
+     TD_aux (TD_abbrev (id, rw_typquant typq, typ_arg), annot)
+  | TD_record (id, typq, typ_ids, flag) ->
+     TD_aux (TD_record (id, rw_typquant typq, List.map (fun (typ, id) -> (rw_typ typ, id)) typ_ids, flag), annot)
+  | TD_variant (id, typq, tus, flag) ->
+     TD_aux (TD_variant (id, rw_typquant typq, List.map (rewrite_type_union_typs rw_typ) tus, flag), annot)
+  | TD_enum (id, ids, flag) -> TD_aux (TD_enum (id, ids, flag), annot)
   | TD_bitfield _ -> assert false (* Processed before re-writing *)
 
 (* FIXME: other reg_dec types *)
 let rewrite_dec_spec_typs rw_typ (DEC_aux (ds, annot)) =
   match ds with
-  | DEC_reg (typ, id) -> DEC_aux (DEC_reg (rw_typ typ, id), annot)
+  | DEC_reg (reffect, weffect, typ, id) -> DEC_aux (DEC_reg (reffect, weffect, rw_typ typ, id), annot)
   | DEC_config (id, typ, exp) -> DEC_aux (DEC_config (id, rw_typ typ, exp), annot)
   | _ -> assert false
 
 (* Remove overload definitions and cast val specs from the
    specification because the interpreter doesn't know about them.*)
-let rewrite_overload_cast (Defs defs) =
+let rewrite_overload_cast env (Defs defs) =
   let remove_cast_vs (VS_aux (vs_aux, annot)) =
     match vs_aux with
     | VS_val_spec (typschm, id, ext, _) -> VS_aux (VS_val_spec (typschm, id, ext, false), annot)
@@ -2341,7 +2364,7 @@ let rewrite_overload_cast (Defs defs) =
   Defs (List.filter (fun def -> not (is_overload def)) defs)
 
 
-let rewrite_undefined mwords =
+let rewrite_undefined mwords env =
   let rewrite_e_aux (E_aux (e_aux, _) as exp) =
     match e_aux with
     | E_lit (L_aux (L_undef, l)) ->
@@ -2351,9 +2374,9 @@ let rewrite_undefined mwords =
   let rewrite_exp_undefined = { id_exp_alg with e_aux = (fun (exp, annot) -> rewrite_e_aux (E_aux (exp, annot))) } in
   rewrite_defs_base { rewriters_base with rewrite_exp = (fun _ -> fold_exp rewrite_exp_undefined) }
 
-let rewrite_undefined_if_gen always_bitvector defs =
+let rewrite_undefined_if_gen always_bitvector env defs =
   if !Initial_check.opt_undefined_gen
-  then rewrite_undefined (always_bitvector || !Pretty_print_lem.opt_mwords) defs
+  then rewrite_undefined (always_bitvector || !Pretty_print_lem.opt_mwords) env defs
   else defs
 
 let rec simple_typ (Typ_aux (typ_aux, l) as typ) = Typ_aux (simple_typ_aux typ_aux, l)
@@ -2365,6 +2388,8 @@ and simple_typ_aux = function
      Typ_id (mk_id "int")
   | Typ_app (id, [_; _]) when Id.compare id (mk_id "range") = 0 ->
      Typ_id (mk_id "int")
+  | Typ_app (id, [_]) when Id.compare id (mk_id "atom_bool") = 0 ->
+     Typ_id (mk_id "bool")
   | Typ_app (id, args) -> Typ_app (id, List.concat (List.map simple_typ_arg args))
   | Typ_fn (arg_typs, ret_typ, effs) -> Typ_fn (List.map simple_typ arg_typs, simple_typ ret_typ, effs)
   | Typ_tup typs -> Typ_tup (List.map simple_typ typs)
@@ -2376,7 +2401,7 @@ and simple_typ_arg (A_aux (typ_arg_aux, l)) =
   | _ -> []
 
 (* This pass aims to remove all the Num quantifiers from the specification. *)
-let rewrite_simple_types (Defs defs) =
+let rewrite_simple_types env (Defs defs) =
   let is_simple = function
     | QI_aux (QI_id kopt, annot) as qi when is_typ_kopt kopt || is_order_kopt kopt -> true
     | _ -> false
@@ -2426,7 +2451,7 @@ let rewrite_simple_types (Defs defs) =
   let defs = Defs (List.map simple_def defs) in
   rewrite_defs_base simple_defs defs
 
-let rewrite_vector_concat_assignments defs =
+let rewrite_vector_concat_assignments env defs =
   let assign_tuple e_aux annot =
     let env = env_of_annot annot in
     match e_aux with
@@ -2472,7 +2497,7 @@ let rewrite_vector_concat_assignments defs =
                mk_exp (E_assign (lexp, tup)))) in
          begin
            try check_exp env e_aux unit_typ with
-           | Type_error (l, err) ->
+           | Type_error (_, l, err) ->
              raise (Reporting.err_typ l (Type_error.string_of_type_error err))
          end
        else E_aux (e_aux, annot)
@@ -2485,7 +2510,7 @@ let rewrite_vector_concat_assignments defs =
   let assign_defs = { rewriters_base with rewrite_exp = (fun _ -> fold_exp assign_exp) } in
   rewrite_defs_base assign_defs defs
 
-let rewrite_tuple_assignments defs =
+let rewrite_tuple_assignments env defs =
   let assign_tuple e_aux annot =
     let env = env_of_annot annot in
     match e_aux with
@@ -2501,7 +2526,7 @@ let rewrite_tuple_assignments defs =
        let let_exp = mk_exp (E_let (letbind, block)) in
        begin
          try check_exp env let_exp unit_typ with
-         | Type_error (l, err) ->
+         | Type_error (_, l, err) ->
            raise (Reporting.err_typ l (Type_error.string_of_type_error err))
        end
     | _ -> E_aux (e_aux, annot)
@@ -2513,7 +2538,7 @@ let rewrite_tuple_assignments defs =
   let assign_defs = { rewriters_base with rewrite_exp = (fun _ -> fold_exp assign_exp) } in
   rewrite_defs_base assign_defs defs
 
-let rewrite_simple_assignments defs =
+let rewrite_simple_assignments env defs =
   let assign_e_aux e_aux annot =
     let env = env_of_annot annot in
     match e_aux with
@@ -2530,7 +2555,7 @@ let rewrite_simple_assignments defs =
   let assign_defs = { rewriters_base with rewrite_exp = (fun _ -> fold_exp assign_exp) } in
   rewrite_defs_base assign_defs defs
 
-let rewrite_defs_remove_blocks =
+let rewrite_defs_remove_blocks env =
   let letbind_wild v body =
     let l = get_loc_exp v in
     let env = env_of v in
@@ -2586,7 +2611,7 @@ let rec mapCont (f : 'b -> ('b -> 'a exp) -> 'a exp) (l : 'b list) (k : 'b list
   | [] -> k []
   | exp :: exps -> f exp (fun exp -> mapCont f exps (fun exps -> k (exp :: exps)))
 
-let rewrite_defs_letbind_effects =
+let rewrite_defs_letbind_effects env =
 
   let rec value ((E_aux (exp_aux,_)) as exp) =
     not (effectful exp || updates_vars exp)
@@ -2813,7 +2838,7 @@ let rewrite_defs_letbind_effects =
        rewrap (E_var (lexp,exp1,n_exp exp2 k))))
     | E_internal_return exp1 ->
        n_exp_name exp1 (fun exp1 ->
-       k (rewrap (E_internal_return exp1)))
+       k (if effectful (propagate_exp_effect exp1) then exp1 else rewrap (E_internal_return exp1)))
     | E_internal_value v ->
        k (rewrap (E_internal_value v))
     | E_return exp' ->
@@ -2863,7 +2888,7 @@ let rewrite_defs_letbind_effects =
     ; rewrite_defs = rewrite_defs_base
     }
 
-let rewrite_defs_internal_lets =
+let rewrite_defs_internal_lets env =
 
   let rec pat_of_local_lexp (LEXP_aux (lexp, ((l, _) as annot))) = match lexp with
     | LEXP_id id -> P_aux (P_id id, annot)
@@ -2879,7 +2904,13 @@ let rewrite_defs_internal_lets =
        (* Rewrite assignments to local variables into let bindings *)
        let (lhs, rhs) = rewrite_lexp_to_rhs le in
        let (LEXP_aux (_, lannot)) = lhs in
-       let ltyp = typ_of_annot lannot in
+       let ltyp = typ_of_annot
+         (* The type in the lannot might come from exp rather than being the
+            type of the storage, so ask the type checker what it really is. *)
+         (match infer_lexp (env_of_annot lannot) (strip_lexp lhs) with
+         | LEXP_aux (_,lexp_annot') -> lexp_annot'
+         | exception _ -> lannot)
+       in
        let rhs = add_e_cast ltyp (rhs exp) in
        E_let (LB_aux (LB_val (pat_of_local_lexp lhs, rhs), annot), body)
     | LB_aux (LB_val (pat,exp'),annot') ->
@@ -3014,10 +3045,16 @@ 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 hack_typ (Typ_aux (aux, _) as typ) =
+    match aux with
+    | Typ_app (Id_aux (Id "atom_bool", _), [_]) -> bool_typ
+    | Typ_app (Id_aux (Id "atom", _), [_]) -> int_typ
+    | _ -> typ
+  in
   let option_typ = app_typ (mk_id "option") [A_aux (A_typ (match binding_typs with
                                                                          | [] -> unit_typ
-                                                                         | [typ] -> typ
-                                                                         | typs -> tuple_typ typs
+                                                                         | [typ] -> hack_typ typ
+                                                                         | typs -> tuple_typ (List.map hack_typ typs)
                                                               ), unk)]
   in
   let bindings = if bindings = [] then
@@ -3046,11 +3083,22 @@ let construct_toplevel_string_append_func env f_id pat =
                  else
                    bindings
   in
+  (* AA: Pulling the types out of a pattern with binding_typs_of_pat
+     is broken here because they might contain type variables that
+     were bound locally to the pattern, so we can't lift them out to
+     the top-level. As a hacky fix we can generalise types where this
+     is likely to happen. *)
+  let hack_typ (Typ_aux (aux, _) as typ) =
+    match aux with
+    | Typ_app (Id_aux (Id "atom_bool", _), [_]) -> bool_typ
+    | Typ_app (Id_aux (Id "atom", _), [_]) -> int_typ
+    | _ -> typ
+  in
   let option_typ = app_typ (mk_id "option") [A_aux (A_typ (match binding_typs with
                                                                        | [] -> unit_typ
-                                                                       | [typ] -> typ
-                                                                       | typs -> tuple_typ typs
-                                                            ), unk)]
+                                                                       | [typ] -> hack_typ typ
+                                                                       | typs -> tuple_typ (List.map hack_typ typs)
+                                                          ), unk)]
   in
   let fun_typ = (mk_typ (Typ_fn ([string_typ], option_typ, no_effect))) in
   let new_val_spec = VS_aux (VS_val_spec (mk_typschm (TypQ_aux (TypQ_no_forall, unk)) fun_typ, f_id, [], false), unkt) in
@@ -3107,7 +3155,7 @@ let construct_toplevel_string_append_func env f_id pat =
        let mapping_inner_typ =
          match Env.get_val_spec (mk_id mapping_prefix_func) env with
          | (_, 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?"
+         | _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "mapping prefix func without correct function type?")
        in
 
        let s_id = fresh_stringappend_id () in
@@ -3133,7 +3181,7 @@ let construct_toplevel_string_append_func env f_id pat =
        let some_pat = annot_pat (P_app (mk_id "Some",
                                         [tup_arg_pat;
                                          annot_pat (P_id len_id) unk env nat_typ]))
-                        unk env opt_typ in
+                                unk env opt_typ in
        let some_pat, some_pat_env, _ = bind_pat env (strip_pat some_pat) opt_typ in
 
        (* need to add the Some(...) env to tup_arg_pats for pat_to_exp below as it calls the typechecker *)
@@ -3166,7 +3214,7 @@ let construct_toplevel_string_append_func env f_id pat =
   let new_fun_def, env = Type_check.check_fundef env new_fun_def in
   List.flatten [new_val_spec; new_fun_def]
 
-let rewrite_defs_toplevel_string_append (Defs defs) =
+let rewrite_defs_toplevel_string_append env (Defs defs) =
   let new_defs = ref ([] : tannot def list) in
   let rec rewrite_pexp (Pat_aux (pexp_aux, pexp_annot) as pexp) =
     (* merge cases of Pat_exp and Pat_when *)
@@ -3203,7 +3251,7 @@ let rewrite_defs_toplevel_string_append (Defs defs) =
   Defs (List.map rewrite defs |> List.flatten)
 
 
-let rec rewrite_defs_pat_string_append =
+let rec rewrite_defs_pat_string_append env =
   let rec rewrite_pat env ((pat : tannot pat), (guards : tannot exp list), (expr : tannot exp)) =
     let guards_ref = ref guards in
     let expr_ref = ref expr in
@@ -3283,7 +3331,7 @@ let rec rewrite_defs_pat_string_append =
        let mapping_inner_typ =
          match Env.get_val_spec (mk_id mapping_prefix_func) env with
          | (_, 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?"
+         | _ -> typ_error env Parse_ast.Unknown "mapping prefix func without correct function type?"
        in
 
        let s_id = fresh_stringappend_id () in
@@ -3453,7 +3501,7 @@ let fresh_mappingpatterns_id () =
   mappingpatterns_counter := !mappingpatterns_counter + 1;
   id
 
-let rewrite_defs_mapping_patterns =
+let rewrite_defs_mapping_patterns env =
   let rec rewrite_pat env (pat, guards, expr) =
     let guards_ref = ref guards in
     let expr_ref = ref expr in
@@ -3518,7 +3566,7 @@ let rewrite_defs_mapping_patterns =
 
        let false_exp = annot_exp (E_lit (L_aux (L_false, unk))) unk env bool_typ in
        let new_other_guards = annot_exp (E_if (new_guard,
-                                               (annot_exp (E_let (new_letbind, fold_typed_guards env guards)) unk env bool_typ),
+                                               (annot_exp (E_let (new_letbind, annot_exp (E_cast (bool_typ, fold_typed_guards env guards)) unk env bool_typ)) unk env bool_typ),
                                                false_exp)) unk env bool_typ in
 
        annot_pat (P_typ (mapping_in_typ, annot_pat (P_id s_id) unk env mapping_in_typ)) unk env mapping_in_typ, [new_guard; new_other_guards], new_let
@@ -3606,7 +3654,7 @@ let rewrite_lit_ocaml (L_aux (lit, _)) = match lit with
   | L_num _ | L_string _ | L_hex _ | L_bin _ | L_real _ | L_unit -> false
   | _ -> true
 
-let rewrite_defs_pat_lits rewrite_lit =
+let rewrite_defs_pat_lits rewrite_lit env =
   let rewrite_pexp (Pat_aux (pexp_aux, annot) as pexp) =
     let guards = ref [] in
     let counter = ref 0 in
@@ -3732,24 +3780,22 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          |> mk_var_exps_pats pl env
        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.expand_synonyms env (typ_of exp1)), destruct_numeric (Env.expand_synonyms env (typ_of exp2)) with
-           | None, _ | _, None ->
-              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
-              let ord_exp, lower, upper, lower_exp, upper_exp =
-                if is_order_inc order
-                then (annot_exp (E_lit (mk_lit L_true)) el env bool_typ, n1, n2, exp1, exp2)
-                else (annot_exp (E_lit (mk_lit L_false)) el env bool_typ, n2, n1, exp2, exp1)
-              in
-              ord_exp, kids, constr, lower, upper, lower_exp, upper_exp
-       in
        (* 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 (List.map (mk_kopt K_int) (lvar_kid :: kids), lvar_nc, atom_typ (nvar lvar_kid))) in
+       let lower_id = mk_id ("loop_" ^ string_of_id id ^ "_lower") in
+       let upper_id = mk_id ("loop_" ^ string_of_id id ^ "_upper") in
+       let lower_kid = mk_kid ("loop_" ^ string_of_id id ^ "_lower") in
+       let upper_kid = mk_kid ("loop_" ^ string_of_id id ^ "_upper") in
+       let lower_id_exp = annot_exp (E_id lower_id) el env (atom_typ (nvar lower_kid)) in
+       let upper_id_exp = annot_exp (E_id upper_id) el env (atom_typ (nvar upper_kid)) in
+       let annot_bool_lit lit = annot_exp (E_lit lit) el env bool_typ in
+       let ord_exp, lower_exp, upper_exp, exp1, exp2 =
+         if is_order_inc order
+         then annot_bool_lit (mk_lit L_true),  exp1, exp2, lower_id_exp, upper_id_exp
+         else annot_bool_lit (mk_lit L_false), exp2, exp1, upper_id_exp, lower_id_exp
+       in
+       let lvar_nc = nc_and (nc_lteq (nvar lower_kid) (nvar lvar_kid)) (nc_lteq (nvar lvar_kid) (nvar upper_kid)) in
+       let lvar_typ = mk_typ (Typ_exist (List.map (mk_kopt K_int) [lvar_kid], 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
@@ -3765,23 +3811,21 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
           that would force the loop to be effectful, so we use an if-expression
           instead.  This code assumes that the loop bounds have (possibly
           existential) atom types, and the loop body has type unit. *)
-       let lower_kid = mk_kid ("loop_" ^ string_of_id id ^ "_lower") in
-       let lower_pat = P_var (annot_pat P_wild el env (typ_of lower_exp), mk_typ_pat (TP_app (mk_id "atom", [mk_typ_pat (TP_var lower_kid)]))) in
+       let lower_pat = P_var (annot_pat (P_id lower_id) el env (typ_of lower_exp), mk_typ_pat (TP_app (mk_id "atom", [mk_typ_pat (TP_var lower_kid)]))) in
        let lb_lower = annot_letbind (lower_pat, lower_exp) el env (typ_of lower_exp) in
-       let upper_kid = mk_kid ("loop_" ^ string_of_id id ^ "_upper") in
-       let upper_pat = P_var (annot_pat P_wild el env (typ_of upper_exp), mk_typ_pat (TP_app (mk_id "atom", [mk_typ_pat (TP_var upper_kid)]))) in
+       let upper_pat = P_var (annot_pat (P_id upper_id) el env (typ_of upper_exp), mk_typ_pat (TP_app (mk_id "atom", [mk_typ_pat (TP_var upper_kid)]))) in
        let lb_upper = annot_letbind (upper_pat, upper_exp) el env (typ_of upper_exp) in
        let guard = annot_exp (E_constraint (nc_lteq (nvar lower_kid) (nvar upper_kid))) el env bool_typ in
        let unit_exp = annot_exp (E_lit (mk_lit L_unit)) el env unit_typ in
        let skip_val = tuple_exp (if overwrite then vars else unit_exp :: vars) in
-       let guarded_body =
+       let guarded_body = fix_eff_exp (annot_exp (E_if (guard, body, skip_val)) el env (typ_of exp4)) in
+       let v =
          fix_eff_exp (annot_exp (E_let (lb_lower,
            fix_eff_exp (annot_exp (E_let (lb_upper,
-             fix_eff_exp (annot_exp (E_if (guard, body, skip_val))
+             fix_eff_exp (annot_exp (E_app (mk_id "foreach", [exp1; exp2; exp3; ord_exp; tuple_exp vars; guarded_body]))
                el env (typ_of exp4))))
              el env (typ_of exp4))))
            el env (typ_of exp4)) in
-       let v = fix_eff_exp (annot_exp (E_app (mk_id "foreach", [exp1; exp2; exp3; ord_exp; tuple_exp vars; guarded_body])) el env (typ_of body)) in
        Added_vars (v, tuple_pat (if overwrite then varpats else pat :: varpats))
      | E_loop(loop,cond,body) ->
         (* Find variables that might be updated in the loop body and are used
@@ -3851,12 +3895,10 @@ let rec rewrite_var_updates ((E_aux (expaux,((l,_) as annot))) as exp) =
          let v = fix_eff_exp (annot_exp expaux pl env typ) in
          Added_vars (v, tuple_pat (if overwrite then varpats else pat :: varpats))
     | E_assign (lexp,vexp) ->
-       let mk_id_pat id = match Env.lookup_id id env with
-         | Local (_, typ) ->
-            add_p_typ typ (annot_pat (P_id id) pl env typ)
-         | _ ->
-            raise (Reporting.err_unreachable pl __POS__
-              ("Failed to look up type of variable " ^ string_of_id id)) in
+       let mk_id_pat id =
+         let typ = lvar_typ (Env.lookup_id id env) in
+         add_p_typ typ (annot_pat (P_id id) pl env typ)
+       in
        if effectful exp then
          Same_vars (E_aux (E_assign (lexp,vexp),annot))
        else 
@@ -3949,7 +3991,7 @@ let remove_reference_types exp =
 
 
 
-let rewrite_defs_remove_superfluous_letbinds =
+let rewrite_defs_remove_superfluous_letbinds env =
 
   let e_aux (exp,annot) = match exp with
     | E_let (LB_aux (LB_val (pat, exp1), _), exp2) ->
@@ -3969,6 +4011,17 @@ let rewrite_defs_remove_superfluous_letbinds =
           E_aux (E_internal_return (exp1),e1annot)
        | _ -> E_aux (exp,annot)
        end
+    | E_internal_plet (_, E_aux (E_throw e, a), _) -> E_aux (E_throw e, a)
+    | E_internal_plet (pat, (E_aux (E_assert (c, msg), a) as assert_exp), _) ->
+       begin match typ_of c with
+       | Typ_aux (Typ_app (Id_aux (Id "atom_bool", _), [A_aux (A_bool nc, _)]), _)
+         when prove __POS__ (env_of c) (nc_not nc) ->
+          (* Drop rest of block after an 'assert(false)' *)
+          let exit_exp = E_aux (E_exit (infer_exp (env_of c) (mk_lit_exp L_unit)), a) in
+          E_aux (E_internal_plet (pat, assert_exp, exit_exp), annot)
+       | _ ->
+          E_aux (exp, annot)
+       end
     | _ -> E_aux (exp,annot) in
 
   let alg = { id_exp_alg with e_aux = e_aux } in
@@ -3983,7 +4036,7 @@ let rewrite_defs_remove_superfluous_letbinds =
     }
 
 (* FIXME: We shouldn't allow nested not-patterns *)
-let rewrite_defs_not_pats =
+let rewrite_defs_not_pats env =
   let rewrite_pexp (pexp_aux, annot) =
     let rewrite_pexp' pat exp orig_guard =
       let guards = ref [] in
@@ -4032,7 +4085,7 @@ let rewrite_defs_not_pats =
   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 rewrite_defs_remove_superfluous_returns env =
 
   let add_opt_cast typopt1 typopt2 annot exp =
     match typopt1, typopt2 with
@@ -4085,7 +4138,7 @@ let rewrite_defs_remove_superfluous_returns =
     }
 
 
-let rewrite_defs_remove_e_assign (Defs defs) =
+let rewrite_defs_remove_e_assign env (Defs defs) =
   let (Defs loop_specs) = fst (Type_error.check Env.empty (Defs (List.map gen_vs
     [("foreach", "forall ('vars : Type). (int, int, int, bool, 'vars, 'vars) -> 'vars");
      ("while", "forall ('vars : Type). (bool, 'vars, 'vars) -> 'vars");
@@ -4102,7 +4155,7 @@ let rewrite_defs_remove_e_assign (Defs defs) =
     ; rewrite_defs = rewrite_defs_base
     } (Defs (loop_specs @ defs))
 
-let merge_funcls (Defs defs) =
+let merge_funcls env (Defs defs) =
   let merge_function (FD_aux (FD_function (r,t,e,fcls),ann) as f) =
     match fcls with
     | [] | [_] -> f
@@ -4176,7 +4229,7 @@ and fpats_of_mfpats mfpats =
   in
   List.map fpat_of_mfpat mfpats
 
-let rewrite_defs_realise_mappings (Defs defs) =
+let rewrite_defs_realise_mappings _ (Defs defs) =
   let realise_mpexps forwards mpexp1 mpexp2 =
     let mpexp_pat, mpexp_exp =
       if forwards then mpexp1, mpexp2
@@ -4285,12 +4338,12 @@ let rewrite_defs_realise_mappings (Defs defs) =
     (* 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?"
+      | _ -> raise (Reporting.err_unreachable l __POS__ "mapping with no clauses?")
     in
     let (typq, bidir_typ) = Env.get_val_spec id env in
     let (typ1, typ2, l) = match bidir_typ with
       | Typ_aux (Typ_bidir (typ1, typ2), l) -> typ1, typ2, l
-      | _ -> Type_check.typ_error l "non-bidir type of mapping?"
+      | _ -> raise (Reporting.err_unreachable l __POS__ "non-bidir type of mapping?")
     in
     let forwards_typ = Typ_aux (Typ_fn ([typ1], typ2, no_effect), l) in
     let forwards_matches_typ = Typ_aux (Typ_fn ([typ1], bool_typ, no_effect), l) in
@@ -4618,7 +4671,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.print_err false false
+      let () = Reporting.print_err
         (loc_of p) "Match checking" "Redundant wildcard clause" in
       acc, []
     | h::t -> aux (process rps h) (h::acc) t
@@ -4658,7 +4711,7 @@ let rewrite_case (e,ann) =
 
         let _ =
           if !opt_coq_warn_nonexhaustive
-          then Reporting.print_err false false
+          then Reporting.print_err
             (fst ann) "Non-exhaustive matching" ("Example: " ^ string_of_rp example) in
 
         let l = Parse_ast.Generated Parse_ast.Unknown in
@@ -4678,7 +4731,7 @@ let rewrite_case (e,ann) =
      | (example::_) ->
         let _ =
           if !opt_coq_warn_nonexhaustive
-          then Reporting.print_err false false
+          then Reporting.print_err
             (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
@@ -4708,7 +4761,7 @@ let rewrite_fun rewriters (FD_aux (FD_function (r,t,e,fcls),f_ann)) =
   | (example::_) ->
      let _ =
        if !opt_coq_warn_nonexhaustive
-       then Reporting.print_err false false
+       then Reporting.print_err
               (fst f_ann) "Non-exhaustive matching" ("Example: " ^ string_of_rp example) in
 
      let l = Parse_ast.Generated Parse_ast.Unknown in
@@ -4719,9 +4772,8 @@ let rewrite_fun rewriters (FD_aux (FD_function (r,t,e,fcls),f_ann)) =
      let default = FCL_aux (FCL_Funcl (id,Pat_aux (Pat_exp (p,b),(l,empty_tannot))),fcl_ann) in
 
      FD_aux (FD_function (r,t,e,fcls'@[default]),f_ann)
-  
 
-let rewrite =
+let rewrite env =
   let alg = { id_exp_alg with e_aux = rewrite_case } in
   rewrite_defs_base
     { rewrite_exp = (fun _ -> fold_exp alg)
@@ -4740,7 +4792,7 @@ end
    new functions that appear to be recursive but are not.  This checks to
    see if the flag can be turned off.  Doesn't handle mutual recursion
    for now. *)
-let minimise_recursive_functions (Defs defs) =
+let minimise_recursive_functions env (Defs defs) =
   let funcl_is_rec (FCL_aux (FCL_Funcl (id,pexp),_)) =
     fold_pexp
       { (pure_exp_alg false (||)) with
@@ -4763,7 +4815,7 @@ let minimise_recursive_functions (Defs defs) =
     | d -> d
   in Defs (List.map rewrite_def defs)
 
-let move_termination_measures (Defs defs) =
+let move_termination_measures env (Defs defs) =
   let scan_for id defs =
     let rec aux = function
       | [] -> None
@@ -4794,7 +4846,7 @@ let move_termination_measures (Defs 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 rewrite_explicit_measure env (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) ->
@@ -4931,14 +4983,15 @@ let rewrite_explicit_measure (Defs defs) =
   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 recheck_defs env defs = fst (Type_error.check initial_env defs)
+let recheck_defs_without_effects env defs =
+  let old = !opt_no_effects in
   let () = opt_no_effects := true in
   let result,_ = Type_error.check initial_env defs in
-  let () = opt_no_effects := false in
+  let () = opt_no_effects := old in
   result
 
-let remove_mapping_valspecs (Defs defs) =
+let remove_mapping_valspecs env (Defs defs) =
   let allowed_def def =
     match def with
     | DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (_, Typ_aux (Typ_bidir _, _)), _), _, _, _), _)) -> false
@@ -4950,12 +5003,12 @@ let remove_mapping_valspecs (Defs defs) =
 let opt_mono_rewrites = ref false
 let opt_mono_complex_nexps = ref true
 
-let mono_rewrites defs =
+let mono_rewrites env defs =
   if !opt_mono_rewrites then
     Monomorphise.mono_rewrites defs
   else defs
 
-let rewrite_toplevel_nexps defs =
+let rewrite_toplevel_nexps env defs =
   if !opt_mono_complex_nexps then
     Monomorphise.rewrite_toplevel_nexps defs
   else defs
@@ -4966,7 +5019,7 @@ let opt_auto_mono = ref false
 let opt_dall_split_errors = ref false
 let opt_dmono_continue = ref false
 
-let monomorphise defs =
+let monomorphise env defs =
   let open Monomorphise in
   monomorphise
     { auto = !opt_auto_mono;
@@ -4976,14 +5029,14 @@ let monomorphise defs =
     !opt_mono_split
     defs
 
-let if_mono f defs =
+let if_mono f env defs =
   match !opt_mono_split, !opt_auto_mono with
   | [], false -> defs
-  | _, _ -> f defs
+  | _, _ -> f env defs
 
 (* Also turn mwords stages on when we're just trying out mono *)
-let if_mwords f defs =
-  if !Pretty_print_lem.opt_mwords then f defs else if_mono f defs
+let if_mwords f env defs =
+  if !Pretty_print_lem.opt_mwords then f env defs else if_mono f env defs
 
 let rewrite_defs_lem = [
   ("realise_mappings", rewrite_defs_realise_mappings);
@@ -4996,8 +5049,8 @@ let rewrite_defs_lem = [
   ("rewrite_toplevel_nexps", if_mono rewrite_toplevel_nexps);
   ("monomorphise", if_mono monomorphise);
   ("recheck_defs", if_mwords recheck_defs);
-  ("add_bitvector_casts", if_mwords Monomorphise.add_bitvector_casts);
-  ("rewrite_atoms_to_singletons", if_mono Monomorphise.rewrite_atoms_to_singletons);
+  ("add_bitvector_casts", if_mwords (fun _ -> Monomorphise.add_bitvector_casts));
+  ("rewrite_atoms_to_singletons", if_mono (fun _ -> Monomorphise.rewrite_atoms_to_singletons));
   ("recheck_defs", if_mwords 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);
@@ -5019,9 +5072,9 @@ let rewrite_defs_lem = [
   ("exp_lift_assign", rewrite_defs_exp_lift_assign);
   (* ("constraint", rewrite_constraint); *)
   (* ("remove_assert", rewrite_defs_remove_assert); *)
-  ("top_sort_defs", top_sort_defs);
+  ("top_sort_defs", fun _ -> top_sort_defs);
   ("trivial_sizeof", rewrite_trivial_sizeof);
-  ("sizeof", rewrite_sizeof);
+  (* ("sizeof", rewrite_sizeof); *)
   ("early_return", rewrite_defs_early_return);
   ("fix_val_specs", rewrite_fix_val_specs);
   (* early_return currently breaks the types *)
@@ -5064,7 +5117,7 @@ let rewrite_defs_coq = [
   (* ("constraint", rewrite_constraint); *)
   (* ("remove_assert", rewrite_defs_remove_assert); *)
   ("move_termination_measures", move_termination_measures);
-  ("top_sort_defs", top_sort_defs);
+  ("top_sort_defs", fun _ -> top_sort_defs);
   ("trivial_sizeof", rewrite_trivial_sizeof);
   ("sizeof", rewrite_sizeof);
   ("early_return", rewrite_defs_early_return);
@@ -5087,7 +5140,7 @@ let rewrite_defs_coq = [
 
 let rewrite_defs_ocaml = [
     (* ("undefined", rewrite_undefined); *)
-  ("no_effect_check", (fun defs -> opt_no_effects := true; defs));
+  ("no_effect_check", (fun _ defs -> opt_no_effects := true; defs));
   ("realise_mappings", rewrite_defs_realise_mappings);
   ("toplevel_string_append", rewrite_defs_toplevel_string_append);
   ("pat_string_append", rewrite_defs_pat_string_append);
@@ -5103,17 +5156,14 @@ let rewrite_defs_ocaml = [
   ("remove_bitvector_pats", rewrite_defs_remove_bitvector_pats);
   ("remove_numeral_pats", rewrite_defs_remove_numeral_pats);
   ("exp_lift_assign", rewrite_defs_exp_lift_assign);
-  ("top_sort_defs", top_sort_defs);
-  ("constraint", rewrite_constraint);
-  ("trivial_sizeof", rewrite_trivial_sizeof);
-  ("sizeof", rewrite_sizeof);
+  ("top_sort_defs", fun _ -> top_sort_defs);
   ("simple_types", rewrite_simple_types);
   ("overload_cast", rewrite_overload_cast);
   (* ("separate_numbs", rewrite_defs_separate_numbs) *)
   ]
 
 let rewrite_defs_c = [
-  ("no_effect_check", (fun defs -> opt_no_effects := true; defs));
+  ("no_effect_check", (fun _ defs -> opt_no_effects := true; defs));
   ("realise_mappings", rewrite_defs_realise_mappings);
   ("toplevel_string_append", rewrite_defs_toplevel_string_append);
   ("pat_string_append", rewrite_defs_pat_string_append);
@@ -5127,17 +5177,13 @@ let rewrite_defs_c = [
   ("simple_assignments", rewrite_simple_assignments);
   ("remove_vector_concat", rewrite_defs_remove_vector_concat);
   ("remove_bitvector_pats", rewrite_defs_remove_bitvector_pats);
-  ("guarded_pats", rewrite_defs_guarded_pats);
   ("exp_lift_assign", rewrite_defs_exp_lift_assign);
-  ("constraint", rewrite_constraint);
-  ("trivial_sizeof", rewrite_trivial_sizeof);
-  ("sizeof", rewrite_sizeof);
   ("merge_function_clauses", merge_funcls);
-  ("recheck_defs", Optimize.recheck)
+  ("recheck_defs", fun _ -> Optimize.recheck)
   ]
 
 let rewrite_defs_interpreter = [
-    ("no_effect_check", (fun defs -> opt_no_effects := true; defs));
+    ("no_effect_check", (fun _ defs -> opt_no_effects := true; defs));
     ("realise_mappings", rewrite_defs_realise_mappings);
     ("toplevel_string_append", rewrite_defs_toplevel_string_append);
     ("pat_string_append", rewrite_defs_pat_string_append);
@@ -5145,10 +5191,7 @@ let rewrite_defs_interpreter = [
     ("rewrite_undefined", rewrite_undefined_if_gen false);
     ("vector_concat_assignments", rewrite_vector_concat_assignments);
     ("tuple_assignments", rewrite_tuple_assignments);
-    ("simple_assignments", rewrite_simple_assignments);
-    ("constraint", rewrite_constraint);
-    ("trivial_sizeof", rewrite_trivial_sizeof);
-    ("sizeof", rewrite_sizeof);
+    ("simple_assignments", rewrite_simple_assignments)
   ]
 
 let rewrite_check_annot =
@@ -5164,7 +5207,7 @@ let rewrite_check_annot =
        else ());
       exp
     with
-      Type_error (l, err) -> raise (Reporting.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 (typ_of_pat pat));
@@ -5179,5 +5222,5 @@ let rewrite_check_annot =
                                           rewrite_pat = (fun _ -> check_pat) }
 
 let rewrite_defs_check = [
-  ("check_annotations", rewrite_check_annot);
+  ("check_annotations", fun _ -> rewrite_check_annot);
   ]
diff --git a/src/rewrites.mli b/src/rewrites.mli
index aa793cb4..cea227a5 100644
--- a/src/rewrites.mli
+++ b/src/rewrites.mli
@@ -64,29 +64,29 @@ val opt_dmono_continue : bool ref
 val fresh_id : string -> l -> id
 
 (* Re-write undefined to functions created by -undefined_gen flag *)
-val rewrite_undefined : bool -> tannot defs -> tannot defs
+val rewrite_undefined : bool -> Env.t -> tannot defs -> tannot defs
 
 (* Perform rewrites to exclude AST nodes not supported for ocaml out*)
-val rewrite_defs_ocaml : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_ocaml : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 (* Perform rewrites to exclude AST nodes not supported for interpreter *)
-val rewrite_defs_interpreter : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_interpreter : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 (* Perform rewrites to exclude AST nodes not supported for lem out*)
-val rewrite_defs_lem : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_lem : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 (* Perform rewrites to exclude AST nodes not supported for coq out*)
-val rewrite_defs_coq : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_coq : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 (* Warn about matches where we add a default case for Coq because they're not
    exhaustive *)
 val opt_coq_warn_nonexhaustive : bool ref
 
 (* Perform rewrites to exclude AST nodes not supported for C compilation *)
-val rewrite_defs_c : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_c : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 (* This is a special rewriter pass that checks AST invariants without
    actually doing any re-writing *)
-val rewrite_defs_check : (string * (tannot defs -> tannot defs)) list
+val rewrite_defs_check : (string * (Env.t -> tannot defs -> tannot defs)) list
 
 val simple_typ : typ -> typ
diff --git a/src/sail.ml b/src/sail.ml
index c5d69aa5..82c1244b 100644
--- a/src/sail.ml
+++ b/src/sail.ml
@@ -54,7 +54,6 @@ module Big_int = Nat_big_num
 
 let lib = ref ([] : string list)
 let opt_file_out : string option ref = ref None
-let opt_interactive = ref false
 let opt_interactive_script : string option ref = ref None
 let opt_print_version = ref false
 let opt_print_initial_env = ref false
@@ -65,7 +64,7 @@ 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_memo_z3 = ref true
 let opt_sanity = ref false
 let opt_includes_c = ref ([]:string list)
 let opt_libs_lem = ref ([]:string list)
@@ -74,21 +73,25 @@ let opt_file_arguments = ref ([]:string list)
 let opt_process_elf : string option ref = ref None
 let opt_ocaml_generators = ref ([]:string list)
 let opt_marshal_defs = ref false
+let opt_slice = ref ([]:string list)
 
 let options = Arg.align ([
   ( "-o",
     Arg.String (fun f -> opt_file_out := Some f),
     "<prefix> select output filename prefix");
   ( "-i",
-    Arg.Tuple [Arg.Set opt_interactive; Arg.Set Initial_check.opt_undefined_gen],
+    Arg.Tuple [Arg.Set Interactive.opt_interactive; Arg.Set Initial_check.opt_undefined_gen],
     " start interactive interpreter");
   ( "-is",
-    Arg.Tuple [Arg.Set opt_interactive; Arg.Set Initial_check.opt_undefined_gen;
+    Arg.Tuple [Arg.Set Interactive.opt_interactive; Arg.Set Initial_check.opt_undefined_gen;
                Arg.String (fun s -> opt_interactive_script := Some s)],
     "<filename> start interactive interpreter and execute commands in script");
   ( "-iout",
     Arg.String (fun file -> Value.output_redirect (open_out file)),
     "<filename> print interpreter output to file");
+  ( "-emacs",
+    Arg.Set Interactive.opt_emacs_mode,
+    " run sail interactively as an emacs mode child process");
   ( "-no_warn",
     Arg.Clear Util.opt_warnings,
     " do not print warnings");
@@ -97,7 +100,7 @@ let options = Arg.align ([
     " output an OCaml translated version of the input");
   ( "-ocaml-nobuild",
     Arg.Set Ocaml_backend.opt_ocaml_nobuild,
-    " do not build generated ocaml");
+    " do not build generated OCaml");
   ( "-ocaml_trace",
     Arg.Tuple [Arg.Set opt_print_ocaml; Arg.Set Initial_check.opt_undefined_gen; Arg.Set Ocaml_backend.opt_trace_ocaml],
     " output an OCaml translated version of the input with tracing instrumentation, implies -ocaml");
@@ -106,31 +109,34 @@ let options = Arg.align ([
     " set a custom directory to build generated OCaml");
   ( "-ocaml-coverage",
     Arg.Set Ocaml_backend.opt_ocaml_coverage,
-    " Build ocaml with bisect_ppx coverage reporting (requires opam packages bisect_ppx-ocamlbuild and bisect_ppx).");
+    " build OCaml with bisect_ppx coverage reporting (requires opam packages bisect_ppx-ocamlbuild and bisect_ppx).");
   ( "-ocaml_generators",
     Arg.String (fun s -> opt_ocaml_generators := s::!opt_ocaml_generators),
     "<types> produce random generators for the given types");
   ( "-latex",
     Arg.Tuple [Arg.Set opt_print_latex; Arg.Clear Type_check.opt_expand_valspec ],
     " pretty print the input to latex");
+  ( "-latex_prefix",
+    Arg.String (fun prefix -> Latex.opt_prefix := prefix),
+    " set a custom prefix for generated LaTeX macro command (default sail)");
+  ( "-latex_full_valspecs",
+    Arg.Clear Latex.opt_simple_val,
+    " print full valspecs in LaTeX output");
   ( "-marshal",
     Arg.Set opt_marshal_defs,
     " OCaml-marshal out the rewritten AST to a file");
-  ( "-latex_full_valspecs",
-    Arg.Clear Latex.opt_simple_val,
-    " print full valspecs in latex output latex");
   ( "-c",
     Arg.Tuple [Arg.Set opt_print_c; Arg.Set Initial_check.opt_undefined_gen],
     " output a C translated version of the input");
   ( "-c_include",
     Arg.String (fun i -> opt_includes_c := i::!opt_includes_c),
-    " <filename> provide additional include for C output");
+    "<filename> provide additional include for C output");
   ( "-c_no_main",
     Arg.Set C_backend.opt_no_main,
     " do not generate the main() function" );
   ( "-elf",
     Arg.String (fun elf -> opt_process_elf := Some elf),
-    " process an elf file so that it can be executed by compiled C code");
+    " process an ELF file so that it can be executed by compiled C code");
   ( "-O",
     Arg.Tuple [Arg.Set C_backend.optimize_primops;
                Arg.Set C_backend.optimize_hoist_allocations;
@@ -141,19 +147,22 @@ let options = Arg.align ([
     " turn on optimizations for C compilation");
   ( "-Oconstant_fold",
     Arg.Set Constant_fold.optimize_constant_fold,
-    " Apply constant folding optimizations");
+    " 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");
+    " 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");
+    " instrument output with tracing");
+  ( "-smt_trace",
+    Arg.Tuple [Arg.Set C_backend.opt_smt_trace],
+    " instrument output with tracing for SMT");
   ( "-cgen",
     Arg.Set opt_print_cgen,
-    " Generate CGEN source");
+    " generate CGEN source");
   ( "-lem",
     Arg.Set opt_print_lem,
     " output a Lem translated version of the input");
@@ -190,9 +199,6 @@ let options = Arg.align ([
   ( "-dcoq_debug_on",
     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 := prefix),
-    " set a custom prefix for generated latex command (default sail)");
   ( "-mono_split",
     Arg.String (fun s ->
       let l = Util.split_on_char ':' s in
@@ -203,7 +209,13 @@ let options = Arg.align ([
       "<filename>:<line>:<variable> to case split for monomorphisation");
   ( "-memo_z3",
     Arg.Set opt_memo_z3,
-    " memoize calls to z3, improving performance when typechecking repeatedly");
+    " memoize calls to z3, improving performance when typechecking repeatedly (default)");
+  ( "-no_memo_z3",
+    Arg.Clear opt_memo_z3,
+    " do not memoize calls to z3");
+  ( "-memo",
+    Arg.Tuple [Arg.Set opt_memo_z3; Arg.Set C_backend.opt_memo_cache],
+    " memoize calls to z3, and intermediate compilation results");
   ( "-undefined_gen",
     Arg.Set Initial_check.opt_undefined_gen,
     " generate undefined_type functions for types in the specification");
@@ -241,8 +253,11 @@ let options = Arg.align ([
     Arg.Set Rewrites.opt_dmono_continue,
     " continue despite monomorphisation errors");
   ( "-verbose",
+    Arg.Int (fun verbosity -> Util.opt_verbosity := verbosity),
+    " produce verbose output");
+  ( "-output_sail",
     Arg.Set opt_print_verbose,
-    " (debug) pretty-print the input to standard output");
+    " print Sail code after type checking and initial rewriting");
   ( "-ddump_tc_ast",
     Arg.Set opt_ddump_tc_ast,
     " (debug) dump the typechecked ast to stdout");
@@ -255,6 +270,9 @@ let options = Arg.align ([
   ( "-dtc_verbose",
     Arg.Int (fun verbosity -> Type_check.opt_tc_debug := verbosity),
     "<verbosity> (debug) verbose typechecker output: 0 is silent");
+  ( "-dsmt_verbose",
+    Arg.Set Constraint.opt_smt_verbose,
+    " (debug) print SMTLIB constraints sent to Z3");
   ( "-dno_cast",
     Arg.Set opt_dno_cast,
     " (debug) typecheck without any implicit casting");
@@ -269,16 +287,27 @@ let options = Arg.align ([
     " (debug) print debugging output for a single function");
   ( "-dprofile",
     Arg.Set Profile.opt_profile,
-    " (debug) provides basic profiling information for rewriting passes within Sail");
+    " (debug) provide basic profiling information for rewriting passes within Sail");
+  ( "-slice",
+    Arg.String (fun s -> opt_slice := s::!opt_slice),
+    "<id> produce version of input restricted to the given function");
   ( "-v",
     Arg.Set opt_print_version,
     " print version");
 ] )
 
+let version =
+  let open Manifest in
+  let default = Printf.sprintf "Sail %s @ %s" branch commit in
+  (* version is parsed from the output of git describe *)
+  match String.split_on_char '-' version with
+  | (vnum :: _) ->
+     Printf.sprintf "Sail %s (%s @ %s)" vnum branch commit
+  | _ -> default
+
 let usage_msg =
-    ("Sail 2.0\n"
-     ^ "usage: sail <options> <file1.sail> ... <fileN.sail>\n"
-    )
+  version
+  ^ "\nusage: sail <options> <file1.sail> ... <fileN.sail>\n"
 
 let _ =
   Arg.parse options
@@ -286,10 +315,7 @@ let _ =
       opt_file_arguments := (!opt_file_arguments) @ [s])
     usage_msg
 
-let interactive_ast = ref (Ast.Defs [])
-let interactive_env = ref Type_check.initial_env
-
-let load_files type_envs files =
+let load_files ?generate:(generate=true) type_envs files =
   if !opt_memo_z3 then Constraint.load_digests () else ();
 
   let t = Profile.start () in
@@ -298,7 +324,7 @@ let load_files type_envs files =
     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
+  let ast = Initial_check.process_ast ~generate:generate ast in
   Profile.finish "parsing" t;
 
   let t = Profile.start () in
@@ -318,8 +344,8 @@ let load_files type_envs files =
   (out_name, ast, type_envs)
 
 let main() =
-  if !opt_print_version
-  then Printf.printf "Sail 2.0\n"
+  if !opt_print_version then
+    print_endline version
   else
     let out_name, ast, type_envs = load_files Type_check.initial_env !opt_file_arguments in
     Util.opt_warnings := false; (* Don't show warnings during re-writing for now *)
@@ -347,11 +373,10 @@ let main() =
       | _ -> Some (Ocaml_backend.orig_types_for_ocaml_generator ast, !opt_ocaml_generators)
     in
 
-    (*let _ = Printf.eprintf "Type checked, next to pretty print" in*)
     begin
-      (if !(opt_interactive)
+      (if !(Interactive.opt_interactive)
        then
-         (interactive_ast := Process_file.rewrite_ast_interpreter type_envs ast; interactive_env := type_envs)
+         (Interactive.ast := Process_file.rewrite_ast_interpreter type_envs ast; Interactive.env := type_envs)
        else ());
       (if !(opt_sanity)
        then
@@ -361,6 +386,12 @@ let main() =
       (if !(opt_print_verbose)
        then ((Pretty_print_sail.pp_defs stdout) ast)
        else ());
+      (match !opt_slice with
+       | [] -> ()
+       | ids ->
+          let ids = List.map Ast_util.mk_id ids in
+          let ids = Ast_util.IdSet.of_list ids in
+          Pretty_print_sail.pp_defs stdout (Specialize.slice_defs type_envs ast ids));
       (if !(opt_print_ocaml)
        then
          let ast_ocaml = rewrite_ast_ocaml type_envs ast in
@@ -371,7 +402,7 @@ let main() =
        then
          let ast_c = rewrite_ast_c type_envs ast in
          let ast_c, type_envs = Specialize.specialize ast_c type_envs in
-         let ast_c = Spec_analysis.top_sort_defs ast_c in
+         (* let ast_c = Spec_analysis.top_sort_defs ast_c in *)
          Util.opt_warnings := true;
          C_backend.compile_ast (C_backend.initial_ctx type_envs) (!opt_includes_c) ast_c
        else ());
@@ -383,13 +414,13 @@ let main() =
          let mwords = !Pretty_print_lem.opt_mwords in
          let type_envs, ast_lem = State.add_regstate_defs mwords type_envs ast in
          let ast_lem = rewrite_ast_lem type_envs ast_lem in
-         output "" (Lem_out (!opt_libs_lem)) [out_name,ast_lem]
+         output "" (Lem_out (!opt_libs_lem)) [out_name,type_envs,ast_lem]
        else ());
       (if !(opt_print_coq)
        then
          let type_envs, ast_coq = State.add_regstate_defs true type_envs ast in
          let ast_coq = rewrite_ast_coq type_envs ast_coq in
-         output "" (Coq_out (!opt_libs_coq)) [out_name,ast_coq]
+         output "" (Coq_out (!opt_libs_coq)) [out_name,type_envs,ast_coq]
        else ());
       (if !(opt_print_latex)
        then
@@ -422,11 +453,16 @@ let main() =
            close_out f
          end
        else ());
+
+      if !opt_memo_z3 then Constraint.save_digests () else ()
     end
 
 let _ =  try
     begin
-      try ignore(main ())
-      with  Failure(s) -> raise (Reporting.err_general Parse_ast.Unknown ("Failure "^s))
+      try ignore (main ())
+      with Failure s -> raise (Reporting.err_general Parse_ast.Unknown ("Failure " ^ s))
     end
-  with Reporting.Fatal_error e -> Reporting.report_error e
+  with Reporting.Fatal_error e ->
+    Reporting.print_error e;
+    Interactive.opt_suppress_banner := true;
+    if !Interactive.opt_interactive then () else exit 1
diff --git a/src/scattered.ml b/src/scattered.ml
index be304dc8..de286e3f 100644
--- a/src/scattered.ml
+++ b/src/scattered.ml
@@ -126,9 +126,9 @@ let rec descatter' funcls mapcls = function
   (* 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 ->
+  | DEF_scattered (SD_aux (SD_variant (id, 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)))
+     DEF_type (TD_aux (TD_variant (id, 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... *)
diff --git a/src/spec_analysis.ml b/src/spec_analysis.ml
index 398f20b5..e26ea8a2 100644
--- a/src/spec_analysis.ml
+++ b/src/spec_analysis.ml
@@ -51,7 +51,6 @@
 open Ast
 open Util
 open Ast_util
-open Extra_pervasives
 
 module Nameset = Set.Make(String)
 
@@ -95,7 +94,7 @@ let rec free_type_names_t consider_var (Typ_aux (t, l)) = match t with
   | Typ_tup ts -> free_type_names_ts consider_var ts
   | Typ_app (name,targs) -> Nameset.add (string_of_id name) (free_type_names_t_args consider_var targs)
   | Typ_exist (kopts,_,t') -> List.fold_left (fun s kopt -> Nameset.remove (string_of_kid (kopt_kid kopt)) s) (free_type_names_t consider_var t') kopts
-  | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
+  | Typ_internal_unknown -> Reporting.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
@@ -130,7 +129,7 @@ let rec fv_of_typ consider_var bound used (Typ_aux (t,l)) : Nameset.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"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 
 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
@@ -307,9 +306,6 @@ let typ_variants consider_var bound tunions =
     tunions
     (bound,mt)
 
-let fv_of_kind_def consider_var (KD_aux(k,_)) = match k with
-  | KD_nabbrev(_,id,_,nexp) -> init_env (string_of_id id), fv_of_nexp consider_var mt mt nexp
-
 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
@@ -317,14 +313,14 @@ let fv_of_abbrev consider_var bound used typq typ_arg =
 let fv_of_type_def consider_var (TD_aux(t,_)) = match t with
   | 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,_) ->
+  | TD_record(id,typq,tids,_) ->
     let binds = init_env (string_of_id id) in
     let bounds = if consider_var then typq_bindings typq else mt in
     binds, List.fold_right (fun (t,_) n -> fv_of_typ consider_var bounds n t) tids mt
-  | TD_variant(id,_,typq,tunions,_) ->
+  | TD_variant(id,typq,tunions,_) ->
     let bindings = Nameset.add (string_of_id id) (if consider_var then typq_bindings typq else mt) in
     typ_variants consider_var bindings tunions
-  | TD_enum(id,_,ids,_) ->
+  | TD_enum(id,ids,_) ->
     Nameset.of_list (List.map string_of_id (id::ids)),mt
   | TD_bitfield(id,typ,_) ->
     init_env (string_of_id id), Nameset.empty (* fv_of_typ consider_var mt typ *)
@@ -438,7 +434,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_variant (id,_,_) ->
+  | SD_variant (id,_) ->
     let name = string_of_id id in
     let uses =
       if consider_scatter_as_one
@@ -475,7 +471,7 @@ let fv_of_rd consider_var (DEC_aux (d, annot)) =
   let open Type_check in
   let env = env_of_annot annot in
   match d with
-  | DEC_reg(t, id) ->
+  | 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')
@@ -489,7 +485,6 @@ let fv_of_rd consider_var (DEC_aux (d, annot)) =
      init_env (string_of_id id), mt
 
 let fv_of_def consider_var consider_scatter_as_one all_defs = function
-  | DEF_kind kdef -> fv_of_kind_def consider_var kdef
   | DEF_type tdef -> fv_of_type_def consider_var tdef
   | DEF_fundef fdef -> fv_of_fun consider_var fdef
   | DEF_mapdef mdef -> mt,mt (* fv_of_map consider_var mdef *)
@@ -507,7 +502,14 @@ let fv_of_def consider_var consider_scatter_as_one all_defs = function
   | 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
-  | DEF_measure _ -> mt,mt (* currently removed beforehand *)
+  (* removed beforehand for Coq, but may still be present otherwise *)
+  | DEF_measure(id,pat,exp) ->
+     let i = string_of_id id in
+     let used = Nameset.of_list [i; "val:"^i] in
+     ((fun (_,u,_) -> Nameset.singleton ("measure:"^i),u)
+        (fv_of_pes consider_var mt used mt
+           [Pat_aux(Pat_exp (pat,exp),(Unknown,Type_check.empty_tannot))]))
+
 
 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
@@ -580,6 +582,13 @@ let scc ?(original_order : string list option) (g : graph) =
   List.iter (fun v -> if not (Hashtbl.mem node_indices v) then visit_node v) nodes;
   List.rev !components
 
+let add_def_to_map id d defset =
+  Namemap.add id
+    (match Namemap.find id defset with
+     | t -> t@[d]
+     | exception Not_found -> [d])
+    defset
+
 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
@@ -602,7 +611,7 @@ let add_def_to_graph (prelude, original_order, defset, graph) d =
     let add_other_node id' g = Namemap.add id' (Nameset.singleton id) g in
     prelude,
     original_order @ [id],
-    Namemap.add id d defset,
+    add_def_to_map id d defset,
     Nameset.fold add_other_node other_ids graph_id
   with
   | Not_found ->
@@ -631,11 +640,11 @@ let print_dot graph component : unit =
   | [] -> ()
 
 let def_of_component graph defset comp =
-  let get_def id = if Namemap.mem id defset then [Namemap.find id defset] else [] in
+  let get_def id = if Namemap.mem id defset then Namemap.find id defset else [] in
   match List.concat (List.map get_def comp) with
   | [] -> []
   | [def] -> [def]
-  | (def :: _) as defs ->
+  | (((DEF_fundef _ | DEF_internal_mutrec _) as def) :: _) as defs ->
      let get_fundefs = function
        | DEF_fundef fundef -> [fundef]
        | DEF_internal_mutrec fundefs -> fundefs
@@ -645,6 +654,8 @@ let def_of_component graph defset comp =
      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);
      [DEF_internal_mutrec fundefs]
+  (* We could merge other stuff, in particular overloads, but don't need to just now *)
+  | defs -> defs
 
 let top_sort_defs (Defs defs) =
   let prelude, original_order, defset, graph =
diff --git a/src/specialize.ml b/src/specialize.ml
index 1ba57bd0..00357557 100644
--- a/src/specialize.ml
+++ b/src/specialize.ml
@@ -51,7 +51,6 @@
 open Ast
 open Ast_util
 open Rewriter
-open Extra_pervasives
 
 let is_typ_ord_uvar = function
   | A_aux (A_typ _, _) -> true
@@ -68,7 +67,7 @@ let rec nexp_simp_typ (Typ_aux (typ_aux, l)) =
     | Typ_fn (arg_typs, ret_typ, effect) ->
        Typ_fn (List.map nexp_simp_typ arg_typs, nexp_simp_typ ret_typ, effect)
     | Typ_bidir (t1, t2) -> Typ_bidir (nexp_simp_typ t1, nexp_simp_typ t2)
-    | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
+    | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   in
   Typ_aux (typ_aux, l)
 and nexp_simp_typ_arg (A_aux (typ_arg_aux, l)) =
@@ -172,7 +171,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 ->
+  | 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 (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)
@@ -253,12 +252,13 @@ let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | 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"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and typ_arg_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
   | A_nexp n -> KidSet.empty
   | A_typ typ -> typ_frees ~exs:exs typ
   | A_order ord -> KidSet.empty
+  | A_bool _ -> KidSet.empty
 
 let rec typ_int_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   match typ_aux with
@@ -270,12 +270,13 @@ let rec typ_int_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
   | 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"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and typ_arg_int_frees ?exs:(exs=KidSet.empty) (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
   | A_nexp n -> KidSet.diff (tyvars_of_nexp n) exs
   | A_typ typ -> typ_int_frees ~exs:exs typ
   | A_order ord -> KidSet.empty
+  | A_bool _ -> KidSet.empty
 
 let specialize_id_valspec instantiations id ast =
   match split_defs (is_valspec id) ast with
@@ -378,8 +379,11 @@ let specialize_id_overloads instantiations id (Defs defs) =
    therefore remove all unused valspecs. Remaining polymorphic
    valspecs are then re-specialized. This process is iterated until
    the whole spec is specialized. *)
-let remove_unused_valspecs env ast =
-  let calls = ref (IdSet.of_list [mk_id "main"; mk_id "__SetConfig"; mk_id "__ListConfig"; mk_id "execute"; mk_id "decode"; mk_id "initialize_registers"; mk_id "append_64"]) in
+
+let initial_calls = (IdSet.of_list [mk_id "main"; mk_id "__SetConfig"; mk_id "__ListConfig"; mk_id "execute"; mk_id "decode"; mk_id "initialize_registers"; mk_id "append_64"])
+
+let remove_unused_valspecs ?(initial_calls=initial_calls) env ast =
+  let calls = ref initial_calls in
   let vs_ids = Initial_check.val_spec_ids ast in
 
   let inspect_exp = function
@@ -412,6 +416,14 @@ let remove_unused_valspecs env ast =
 
   List.fold_left (fun ast id -> Defs (remove_unused ast id)) ast (IdSet.elements unused)
 
+let slice_defs env (Defs defs) keep_ids =
+  let keep = function
+    | DEF_fundef fd -> IdSet.mem (id_of_fundef fd) keep_ids
+    | _ -> true
+  in
+  let defs = List.filter keep defs in
+  remove_unused_valspecs env (Defs defs) ~initial_calls:keep_ids
+
 let specialize_id id ast =
   let instantiations = instantiations_of id ast in
   let ast = specialize_id_valspec instantiations id ast in
diff --git a/src/specialize.mli b/src/specialize.mli
index f2c94a48..28029747 100644
--- a/src/specialize.mli
+++ b/src/specialize.mli
@@ -71,3 +71,6 @@ val specialize : tannot defs -> Env.t -> tannot defs * Env.t
 val instantiations_of : id -> tannot defs -> typ_arg KBindings.t list
 
 val string_of_instantiation : typ_arg KBindings.t -> string
+
+(* Remove all function definitions except for the given set *)
+val slice_defs : Env.t -> tannot defs -> IdSet.t -> tannot defs
diff --git a/src/state.ml b/src/state.ml
index fe1cebe7..86fd8395 100644
--- a/src/state.ml
+++ b/src/state.ml
@@ -58,7 +58,7 @@ open PPrint
 open Pretty_print_common
 open Pretty_print_sail
 
-let defs_of_string = ast_of_def_string Ast_util.inc_ord
+let defs_of_string = ast_of_def_string
 
 let is_defined defs name = IdSet.mem (mk_id name) (ids_of_defs (Defs defs))
 
@@ -69,7 +69,7 @@ let find_registers defs =
   List.fold_left
     (fun acc def ->
       match def with
-      | DEF_reg_dec (DEC_aux(DEC_reg (typ, id), (_, tannot))) ->
+      | DEF_reg_dec (DEC_aux(DEC_reg (_, _, typ, id), (_, tannot))) ->
          let env = match destruct_tannot tannot with
            | Some (env, _, _) -> env
            | _ -> Env.empty
@@ -136,10 +136,10 @@ let generate_initial_regstate defs =
       List.fold_left2 typ_subst_quant_item typ (quant_items tq) args
     in
     let add_typ_init_val (defs', vals) = function
-      | TD_enum (id, _, id1 :: _, _) ->
+      | TD_enum (id, id1 :: _, _) ->
          (* Choose the first value of an enumeration type as default *)
          (defs', Bindings.add id (fun _ -> string_of_id id1) vals)
-      | TD_variant (id, _, tq, (Tu_aux (Tu_ty_id (typ1, id1), _)) :: _, _) ->
+      | TD_variant (id, tq, (Tu_aux (Tu_ty_id (typ1, id1), _)) :: _, _) ->
          (* Choose the first variant of a union type as default *)
          let init_val args =
            let typ1 = typ_subst_typquant tq args typ1 in
@@ -149,7 +149,7 @@ let generate_initial_regstate defs =
       | TD_abbrev (id, tq, A_aux (A_typ typ, _)) ->
          let init_val args = lookup_init_val vals (typ_subst_typquant tq args typ) in
          (defs', Bindings.add id init_val vals)
-      | TD_record (id, _, tq, fields, _) ->
+      | TD_record (id, tq, fields, _) ->
          let init_val args =
            let init_field (typ, id) =
              let typ = typ_subst_typquant tq args typ in
diff --git a/src/type_check.ml b/src/type_check.ml
index 63cb4829..b9f8f323 100644
--- a/src/type_check.ml
+++ b/src/type_check.ml
@@ -52,7 +52,6 @@ open Ast
 open Util
 open Ast_util
 open Lazy
-open Extra_pervasives
 
 module Big_int = Nat_big_num
 
@@ -96,13 +95,40 @@ type type_error =
   | 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;;
-
-let typ_error l m = raise (Type_error (l, Err_other m))
-
-let typ_raise l err = raise (Type_error (l, err))
+  | Err_because of type_error * Parse_ast.l * type_error
+
+type env =
+  { top_val_specs : (typquant * typ) Bindings.t;
+    defined_val_specs : IdSet.t;
+    locals : (mut * typ) Bindings.t;
+    union_ids : (typquant * typ) Bindings.t;
+    registers : (effect * effect * typ) Bindings.t;
+    variants : (typquant * type_union list) Bindings.t;
+    mappings : (typquant * typ * typ) Bindings.t;
+    typ_vars : (Ast.l * kind_aux) KBindings.t;
+    shadow_vars : int KBindings.t;
+    typ_synonyms : (Ast.l -> env -> typ_arg list -> typ_arg) 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;
+    casts : id list;
+    allow_casts : bool;
+    allow_bindings : bool;
+    constraints : n_constraint list;
+    default_order : order option;
+    ret_typ : typ option;
+    poly_undefineds : bool;
+    prove : env -> n_constraint -> bool;
+    allow_unknowns : bool;
+  }
+
+exception Type_error of env * l * type_error;;
+
+let typ_error env l m = raise (Type_error (env, l, Err_other m))
+
+let typ_raise env l err = raise (Type_error (env, l, err))
 
 let deinfix = function
   | Id_aux (Id v, l) -> Id_aux (DeIid v, l)
@@ -139,6 +165,11 @@ let is_atom (Typ_aux (typ_aux, _)) =
   | Typ_app (f, [_]) when string_of_id f = "atom" -> true
   | _ -> false
 
+let is_atom_bool (Typ_aux (typ_aux, _)) =
+  match typ_aux with
+  | Typ_app (f, [_]) when string_of_id f = "atom_bool" -> true
+  | _ -> false
+
 let rec strip_id = function
   | Id_aux (Id x, _) -> Id_aux (Id x, Parse_ast.Unknown)
   | Id_aux (DeIid x, _) -> Id_aux (DeIid x, Parse_ast.Unknown)
@@ -215,19 +246,33 @@ and strip_kinded_id_aux = function
 and strip_kind = function
   | K_aux (k_aux, _) -> K_aux (k_aux, Parse_ast.Unknown)
 
+let rec name_pat (P_aux (aux, _)) =
+  match aux with
+  | P_id id | P_as (_, id) -> Some ("_" ^ string_of_id id)
+  | P_typ (_, pat) | P_var (pat, _) -> name_pat pat
+  | _ -> None
+
 let ex_counter = ref 0
 
-let fresh_existential ?name:(n="") k =
-  let fresh = Kid_aux (Var ("'ex" ^ string_of_int !ex_counter ^ "#" ^ n), Parse_ast.Unknown) in
+let fresh_existential k =
+  let fresh = Kid_aux (Var ("'ex" ^ string_of_int !ex_counter ^ "#"), Parse_ast.Unknown) in
   incr ex_counter; mk_kopt k fresh
 
-let destruct_exist_plain typ =
+let named_existential k = function
+  | Some n -> mk_kopt k (mk_kid n)
+  | None -> fresh_existential k
+ 
+let destruct_exist_plain ?name:(name=None) typ =
   match typ with
+  | Typ_aux (Typ_exist ([kopt], nc, typ), _) ->
+     let kid, fresh = kopt_kid kopt, named_existential (unaux_kind (kopt_kind kopt)) name in
+     let nc = constraint_subst kid (arg_kopt fresh) nc in
+     let typ = typ_subst kid (arg_kopt fresh) typ in
+     Some ([fresh], nc, typ)
   | Typ_aux (Typ_exist (kopts, nc, typ), _) ->
+     let add_num i = match name with Some n -> Some (n ^ string_of_int i) | None -> None in 
      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
+       List.mapi (fun i kopt -> (kopt_kid kopt, named_existential (unaux_kind (kopt_kind kopt)) (add_num i))) 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
@@ -242,27 +287,36 @@ let destruct_exist_plain typ =
    - int => ['n], true, 'n (where x is fresh)
    - atom('n) => [], true, 'n
 **)
-let destruct_numeric typ =
-  match destruct_exist_plain typ, typ with
+let destruct_numeric ?name:(name=None) typ =
+  match destruct_exist_plain ~name:name 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
+     let kid = kopt_kid (named_existential K_int name) 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
+     let kid = kopt_kid (named_existential K_int name) 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
+     let kid = kopt_kid (named_existential K_int name) in
      Some ([kid], nc_true, nvar kid)
   | _, _ -> None
 
-let destruct_exist typ =
-  match destruct_numeric typ with
+let destruct_boolean ?name:(name=None) = function
+  | Typ_aux (Typ_id (Id_aux (Id "bool", _)), _) ->
+     let kid = kopt_kid (fresh_existential K_bool) in
+     Some (kid, nc_var kid)
+  | _ -> None
+
+let destruct_exist ?name:(name=None) typ =
+  match destruct_numeric ~name:name typ with
   | Some (kids, nc, nexp) -> Some (List.map (mk_kopt K_int) kids, nc, atom_typ nexp)
-  | None -> destruct_exist_plain typ
+  | None ->
+     match destruct_boolean ~name:name typ with
+     | Some (kid, nc) -> Some ([mk_kopt K_bool kid], nc_true, atom_bool_typ nc)
+     | None -> destruct_exist_plain ~name:name typ
 
 let adding = Util.("Adding " |> darkgray |> clear)
 
@@ -271,7 +325,7 @@ let adding = Util.("Adding " |> darkgray |> clear)
 (**************************************************************************)
 
 module Env : sig
-  type t
+  type t = env
   val add_val_spec : id -> typquant * typ -> t -> t
   val update_val_spec : id -> typquant * typ -> t -> t
   val define_val_spec : id -> t -> t
@@ -307,10 +361,8 @@ module Env : sig
   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_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_typ_synonym : id -> (Ast.l -> t -> typ_arg list -> typ_arg) -> t -> t
+  val get_typ_synonym : id -> t -> Ast.l -> t -> typ_arg list -> typ_arg
   val add_overloads : id -> id list -> t -> t
   val get_overloads : id -> t -> id list
   val is_extern : id -> t -> string -> bool
@@ -332,6 +384,7 @@ module Env : sig
   val lookup_id : ?raw:bool -> id -> t -> typ lvar
   val fresh_kid : ?kid:kid -> t -> kid
   val expand_synonyms : t -> typ -> typ
+  val expand_nexp_synonyms : t -> nexp -> nexp
   val expand_constraint_synonyms : t -> n_constraint -> n_constraint
   val base_typ_of : t -> typ -> typ
   val allow_unknowns : t -> bool
@@ -358,32 +411,7 @@ module Env : sig
 
   val builtin_typs : typquant Bindings.t
 end = struct
-  type t =
-    { top_val_specs : (typquant * typ) Bindings.t;
-      defined_val_specs : IdSet.t;
-      locals : (mut * typ) Bindings.t;
-      union_ids : (typquant * typ) Bindings.t;
-      registers : (effect * effect * typ) Bindings.t;
-      variants : (typquant * type_union list) Bindings.t;
-      mappings : (typquant * typ * 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;
-      casts : id list;
-      allow_casts : bool;
-      allow_bindings : bool;
-      constraints : n_constraint list;
-      default_order : order option;
-      ret_typ : typ option;
-      poly_undefineds : bool;
-      prove : t -> n_constraint -> bool;
-      allow_unknowns : bool;
-    }
+  type t = env
 
   let empty =
     { top_val_specs = Bindings.empty;
@@ -394,8 +422,8 @@ end = struct
       variants = Bindings.empty;
       mappings = Bindings.empty;
       typ_vars = KBindings.empty;
+      shadow_vars = KBindings.empty;
       typ_synonyms = Bindings.empty;
-      num_defs = Bindings.empty;
       overloads = Bindings.empty;
       enums = Bindings.empty;
       records = Bindings.empty;
@@ -419,11 +447,11 @@ end = struct
 
   let get_typ_var kid env =
     try snd (KBindings.find kid env.typ_vars) with
-    | Not_found -> typ_error (kid_loc kid) ("No type variable " ^ string_of_kid kid)
+    | Not_found -> typ_error env (kid_loc kid) ("No type variable " ^ string_of_kid kid)
 
   let get_typ_var_loc kid env =
     try fst (KBindings.find kid env.typ_vars) with
-    | Not_found -> typ_error (kid_loc kid) ("No type variable " ^ string_of_kid kid)
+    | Not_found -> typ_error env (kid_loc kid) ("No type variable " ^ string_of_kid kid)
 
   let get_typ_vars env = KBindings.map snd env.typ_vars
   let get_typ_var_locs env = KBindings.map fst env.typ_vars
@@ -437,6 +465,7 @@ end = struct
     List.fold_left (fun m (name, kinds) -> Bindings.add (mk_id name) (kinds_typq kinds) m) Bindings.empty
       [ ("range", [K_int; K_int]);
         ("atom", [K_int]);
+        ("implicit", [K_int]);
         ("vector", [K_int; K_order; K_type]);
         ("register", [K_type]);
         ("bit", []);
@@ -484,9 +513,9 @@ end = struct
     else if Bindings.mem id env.enums then
       mk_typquant []
     else if Bindings.mem id env.typ_synonyms then
-      typ_error (id_loc id) ("Cannot infer kind of type synonym " ^ string_of_id id)
+      typ_error env (id_loc id) ("Cannot infer kind of type synonym " ^ string_of_id id)
     else
-      typ_error (id_loc id) ("Cannot infer kind of " ^  string_of_id id)
+      typ_error env (id_loc id) ("Cannot infer kind of " ^  string_of_id id)
 
   let check_args_typquant id env args typq =
     let kopts, ncs = quant_split typq in
@@ -501,13 +530,13 @@ end = struct
       | kopt :: kopts, A_aux (A_bool arg, _) :: args when is_bool_kopt kopt ->
          subst_args kopts args
       | [], [] -> ncs
-      | _, 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)
+      | _, A_aux (_, l) :: _ -> typ_error env l ("Error when processing type quantifer arguments " ^ string_of_typquant typq)
+      | _, _ -> typ_error env Parse_ast.Unknown ("Error when processing type quantifer arguments " ^ string_of_typquant typq)
     in
     let ncs = subst_args kopts args in
     if List.for_all (env.prove env) ncs
     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)
+    else typ_error env (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 (aux, l) as nc) =
     typ_debug ~level:2 (lazy ("Expanding " ^ string_of_n_constraint nc));
@@ -516,13 +545,39 @@ end = struct
     | 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
+          begin match Bindings.find id env.typ_synonyms l 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)
+          | arg -> typ_error env 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
 
+  and expand_nexp_synonyms env (Nexp_aux (aux, l) as nexp) =
+    typ_debug ~level:2 (lazy ("Expanding " ^ string_of_nexp nexp));
+    match aux with
+    | Nexp_app (id, args) ->
+       (try
+          begin match Bindings.find id env.typ_synonyms l env [] with
+          | A_aux (A_nexp nexp, _) -> expand_nexp_synonyms env nexp
+          | _ -> typ_error env l ("Expected Int when expanding synonym " ^ string_of_id id)
+          end
+        with
+        | Not_found -> Nexp_aux (Nexp_app (id, List.map (expand_nexp_synonyms env) args), l))
+    | Nexp_id id ->
+       (try
+          begin match Bindings.find id env.typ_synonyms l env [] with
+          | A_aux (A_nexp nexp, _) -> expand_nexp_synonyms env nexp
+          | _ -> typ_error env l ("Expected Int when expanding synonym " ^ string_of_id id)
+          end
+        with Not_found -> nexp)
+    | Nexp_times (nexp1, nexp2) -> Nexp_aux (Nexp_times (expand_nexp_synonyms env nexp1, expand_nexp_synonyms env nexp2), l)
+    | Nexp_sum (nexp1, nexp2) -> Nexp_aux (Nexp_sum (expand_nexp_synonyms env nexp1, expand_nexp_synonyms env nexp2), l)
+    | Nexp_minus (nexp1, nexp2) -> Nexp_aux (Nexp_minus (expand_nexp_synonyms env nexp1, expand_nexp_synonyms env nexp2), l)
+    | Nexp_exp nexp -> Nexp_aux (Nexp_exp (expand_nexp_synonyms env nexp), l)
+    | Nexp_neg nexp -> Nexp_aux (Nexp_neg (expand_nexp_synonyms env nexp), l)
+    | Nexp_var kid -> Nexp_aux (Nexp_var kid, l)
+    | Nexp_constant n -> Nexp_aux (Nexp_constant n, l)
+
   and expand_synonyms env (Typ_aux (typ, l) as t) =
     match typ with
     | Typ_internal_unknown -> Typ_aux (Typ_internal_unknown, l)
@@ -531,17 +586,17 @@ end = struct
     | Typ_bidir (typ1, typ2) -> Typ_aux (Typ_bidir (expand_synonyms env typ1, expand_synonyms env typ2), l)
     | Typ_app (id, args) ->
        (try
-          begin match Bindings.find id env.typ_synonyms env args with
+          begin match Bindings.find id env.typ_synonyms l env args with
           | A_aux (A_typ typ, _) -> expand_synonyms env typ
-          | _ -> typ_error l ("Expected Type when expanding synonym " ^ string_of_id id)
+          | _ -> typ_error env 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 ->
        (try
-          begin match Bindings.find id env.typ_synonyms env [] with
+          begin match Bindings.find id env.typ_synonyms l env [] with
           | A_aux (A_typ typ, _) -> expand_synonyms env typ
-          | _ -> typ_error l ("Expected Type when expanding synonym " ^ string_of_id id)
+          | _ -> typ_error env l ("Expected Type when expanding synonym " ^ string_of_id id)
           end
         with
         | Not_found -> Typ_aux (Typ_id id, l))
@@ -580,6 +635,7 @@ end = struct
     match typ_arg with
     | 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)
+    | A_nexp nexp -> A_aux (A_nexp (expand_nexp_synonyms env nexp), l)
     | arg -> A_aux (arg, l)
 
   (** Map over all nexps in a type - excluding those in existential constraints **)
@@ -609,32 +665,34 @@ end = struct
     | Typ_id id when bound_typ_id env id ->
        let typq = infer_kind env id in
        if quant_kopts typq != []
-       then typ_error l ("Type constructor " ^ string_of_id id ^ " expected " ^ string_of_typquant typq)
+       then typ_error env l ("Type constructor " ^ string_of_id id ^ " expected " ^ string_of_typquant typq)
        else ()
-    | Typ_id id -> typ_error l ("Undefined type " ^ string_of_id id)
+    | Typ_id id -> typ_error env l ("Undefined type " ^ string_of_id id)
     | Typ_var kid -> begin
       match KBindings.find kid env.typ_vars with
       | (_, K_type) -> ()
-      | (_, k) -> typ_error l ("Kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ
+      | (_, k) -> typ_error env l ("Kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ
                                ^ " 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)
+         typ_error env l ("Unbound kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ)
     end
     | Typ_fn (arg_typs, ret_typ, effs) -> List.iter (wf_typ ~exs:exs env) arg_typs; wf_typ ~exs:exs env ret_typ
     | Typ_bidir (typ1, typ2) when strip_typ typ1 = strip_typ typ2 ->
-       typ_error l "Bidirectional types cannot be the same on both sides"
+       typ_error env l "Bidirectional types cannot be the same on both sides"
     | Typ_bidir (typ1, typ2) -> wf_typ ~exs:exs env typ1; wf_typ ~exs:exs env typ2
     | Typ_tup typs -> List.iter (wf_typ ~exs:exs env) typs
+    | Typ_app (id, [A_aux (A_nexp _, _) as arg]) when string_of_id id = "implicit" ->
+       wf_typ_arg ~exs:exs env arg
     | Typ_app (id, args) when bound_typ_id env id ->
        List.iter (wf_typ_arg ~exs:exs env) args;
        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_app (id, _) -> typ_error env l ("Undefined type " ^ string_of_id id)
+    | Typ_exist ([], _, _) -> typ_error env l ("Existential must have some type variables")
     | 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"
+    | Typ_exist (_, _, _) -> typ_error env l ("Nested existentials are not allowed")
+    | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
   and wf_typ_arg ?exs:(exs=KidSet.empty) env (A_aux (typ_arg_aux, _)) =
     match typ_arg_aux with
     | A_nexp nexp -> wf_nexp ~exs:exs env nexp
@@ -647,12 +705,11 @@ end = struct
     | Nexp_id _ -> ()
     | Nexp_var kid when KidSet.mem kid exs -> ()
     | Nexp_var kid ->
-       begin
-         match get_typ_var kid env with
-         | K_int -> ()
-         | kind -> typ_error l ("Constraint is badly formed, "
-                                ^ string_of_kid kid ^ " has kind "
-                                ^ string_of_kind_aux kind ^ " but should have kind Int")
+       begin match get_typ_var kid env with
+       | K_int -> ()
+       | kind -> typ_error env l ("Constraint is badly formed, "
+                              ^ string_of_kid kid ^ " has kind "
+                              ^ string_of_kind_aux kind ^ " but should have kind Int")
        end
     | Nexp_constant _ -> ()
     | Nexp_app (id, nexps) ->
@@ -665,12 +722,11 @@ end = struct
   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
-         | K_order -> ()
-         | kind -> typ_error l ("Order is badly formed, "
-                                ^ string_of_kid kid ^ " has kind "
-                                ^ string_of_kind_aux kind ^ " but should have kind Order")
+       begin match get_typ_var kid env with
+       | K_order -> ()
+       | kind -> typ_error env l ("Order is badly formed, "
+                              ^ string_of_kid kid ^ " has kind "
+                              ^ 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) =
@@ -684,7 +740,7 @@ end = struct
     | NC_set (kid, _) ->
        begin match get_typ_var kid env with
        | K_int -> ()
-       | kind -> typ_error l ("Set constraint is badly formed, "
+       | kind -> typ_error env l ("Set constraint is badly formed, "
                               ^ string_of_kid kid ^ " has kind "
                               ^ string_of_kind_aux kind ^ " but should have kind Int")
        end
@@ -695,8 +751,7 @@ end = struct
     | 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 "
+       | kind -> typ_error env l (string_of_kid kid ^ " has kind "
                               ^ string_of_kind_aux kind ^ " but should have kind Bool")
        end
     | NC_true | NC_false -> ()
@@ -722,7 +777,7 @@ end = struct
     try
       Bindings.find id env.top_val_specs
     with
-    | Not_found -> typ_error (id_loc id) ("No val spec found for " ^ string_of_id id)
+    | Not_found -> typ_error env (id_loc id) ("No val spec found for " ^ string_of_id id)
 
   let get_val_spec id env =
     try
@@ -732,7 +787,7 @@ end = struct
       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)
+    | Not_found -> typ_error env (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));
@@ -743,11 +798,24 @@ end = struct
       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)
+    | Not_found -> typ_error env (id_loc id) ("No union constructor found for " ^ string_of_id id)
+
+  let rec valid_implicits env start = function
+    | Typ_aux (Typ_app (Id_aux (Id "implicit", _), [A_aux (A_nexp (Nexp_aux (Nexp_var v, _)), _)]), l) :: rest ->
+       if start then
+         valid_implicits env true rest
+       else
+         typ_error env l "Arguments are invalid, implicit arguments must come before all other arguments"
+    | Typ_aux (Typ_app (Id_aux (Id "implicit", _), [A_aux (A_nexp _, l)]), _) :: rest ->
+       typ_error env l "Implicit argument must contain a single type variable"
+    | _ :: rest -> valid_implicits env false rest
+    | [] -> ()
 
   let rec update_val_spec id (typq, typ) env =
     begin match expand_synonyms env typ with
     | Typ_aux (Typ_fn (arg_typs, ret_typ, effect), l) ->
+       valid_implicits env true arg_typs;
+
        (* We perform some canonicalisation for function types where existentials appear on the left, so
           ({'n, 'n >= 2, int('n)}, foo) -> bar
           would become
@@ -771,7 +839,7 @@ end = struct
        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"
+    | _ -> typ_error env (id_loc id) "val definition must have a mapping or function type"
     end
 
   and add_val_spec id (bind_typq, bind_typ) env =
@@ -784,7 +852,7 @@ end = struct
       let existing_cmp = (strip_typq existing_typq, strip_typ existing_typ) in
       let bind_cmp = (strip_typq bind_typq, strip_typ bind_typ) in
       if existing_cmp <> bind_cmp then
-        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))
+        typ_error env (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
          *)
@@ -818,7 +886,7 @@ end = struct
 
   let define_val_spec id env =
     if IdSet.mem id env.defined_val_specs
-    then typ_error (id_loc id) ("Function " ^ string_of_id id ^ " has already been declared")
+    then typ_error env (id_loc id) ("Function " ^ string_of_id id ^ " has already been declared")
     else { env with defined_val_specs = IdSet.add id env.defined_val_specs }
 
   let is_union_constructor id env =
@@ -843,7 +911,7 @@ end = struct
 
   let add_enum id ids env =
     if bound_typ_id env id
-    then typ_error (id_loc id) ("Cannot create enum " ^ string_of_id id ^ ", type name is already bound")
+    then typ_error env (id_loc id) ("Cannot create enum " ^ string_of_id id ^ ", type name is already bound")
     else
       begin
         typ_print (lazy (adding ^ "enum " ^ string_of_id id));
@@ -853,7 +921,7 @@ end = struct
   let get_enum id env =
     try IdSet.elements (Bindings.find id env.enums)
     with
-    | Not_found -> typ_error (id_loc id) ("Enumeration " ^ string_of_id id ^ " does not exist")
+    | Not_found -> typ_error env (id_loc id) ("Enumeration " ^ string_of_id id ^ " does not exist")
 
   let is_record id env = Bindings.mem id env.records
 
@@ -861,7 +929,7 @@ end = struct
 
   let add_record id typq fields env =
     if bound_typ_id env id
-    then typ_error (id_loc id) ("Cannot create record " ^ string_of_id id ^ ", type name is already bound")
+    then typ_error env (id_loc id) ("Cannot create record " ^ string_of_id id ^ ", type name is already bound")
     else
       begin
         typ_print (lazy (adding ^ "record " ^ string_of_id id));
@@ -892,14 +960,14 @@ end = struct
     let freshen_bind bind = List.fold_left (fun bind (kid, _) -> freshen_kid env kid bind) bind (KBindings.bindings env.typ_vars) in
     try freshen_bind (Bindings.find (field_name rec_id id) env.accessors)
     with
-    | Not_found -> typ_error (id_loc id) ("No accessor found for " ^ string_of_id (field_name rec_id id))
+    | Not_found -> typ_error env (id_loc id) ("No accessor found for " ^ string_of_id (field_name rec_id id))
 
   let get_accessor rec_id id env =
     match get_accessor_fn rec_id id env with
     (* All accessors should have a single argument (the record itself) *)
     | (typq, Typ_aux (Typ_fn ([rec_typ], field_typ, effect), _)) ->
        (typq, rec_typ, field_typ, effect)
-    | _ -> typ_error (id_loc id) ("Accessor with non-function type found for " ^ string_of_id (field_name rec_id id))
+    | _ -> typ_error env (id_loc id) ("Accessor with non-function type found for " ^ string_of_id (field_name rec_id id))
 
   let is_mutable id env =
     try
@@ -916,10 +984,10 @@ end = struct
 
   let add_local id mtyp env =
     begin
-      if not env.allow_bindings then typ_error (id_loc id) "Bindings are not allowed in this context" else ();
+      if not env.allow_bindings then typ_error env (id_loc id) "Bindings are not allowed in this context" else ();
       wf_typ env (snd mtyp);
       if Bindings.mem id env.top_val_specs then
-        typ_error (id_loc id) ("Local variable " ^ string_of_id id ^ " is already bound as a function name")
+        typ_error env (id_loc id) ("Local variable " ^ string_of_id id ^ " is already bound as a function name")
       else ();
       typ_print (lazy (adding ^ "local binding " ^ string_of_id id ^ " : " ^ string_of_mtyp mtyp));
       { env with locals = Bindings.add id mtyp env.locals }
@@ -936,19 +1004,19 @@ end = struct
   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")
+    | None -> typ_error env (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")
+    | None -> typ_error env (id_loc id) ("union " ^ string_of_id id ^ " not found")
 
   let is_register id env =
     Bindings.mem id env.registers
 
   let get_register id env =
     try Bindings.find id env.registers with
-    | Not_found -> typ_error (id_loc id) ("No register binding found for " ^ string_of_id id)
+    | Not_found -> typ_error env (id_loc id) ("No register binding found for " ^ string_of_id id)
 
   let is_extern id env backend =
     try not (Ast_util.extern_assoc backend (Bindings.find id env.externs) = None) with
@@ -962,16 +1030,16 @@ end = struct
     try
       match Ast_util.extern_assoc backend (Bindings.find id env.externs) with
       | Some ext -> ext
-      | None -> typ_error (id_loc id) ("No extern binding found for " ^ string_of_id id)
+      | None -> typ_error env (id_loc id) ("No extern binding found for " ^ string_of_id id)
     with
-    | Not_found -> typ_error (id_loc id) ("No extern binding found for " ^ string_of_id id)
+    | Not_found -> typ_error env (id_loc id) ("No extern binding found for " ^ string_of_id id)
 
   let get_casts env = env.casts
 
   let add_register id reff weff typ env =
     wf_typ env typ;
     if Bindings.mem id env.registers
-    then typ_error (id_loc id) ("Register " ^ string_of_id id ^ " is already bound")
+    then typ_error env (id_loc id) ("Register " ^ string_of_id id ^ " is already bound")
     else
       begin
         typ_print (lazy (adding ^ "register binding " ^ string_of_id id ^ " :: " ^ string_of_typ typ));
@@ -997,33 +1065,28 @@ end = struct
     with
     | Not_found -> Unbound
 
-  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_kinded_id kopt ^ " is already bound")
-    else
-      begin
-        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 }
+  let add_typ_var l (KOpt_aux (KOpt_kind (K_aux (k, _), v), _)) env =
+    if KBindings.mem v env.typ_vars then begin
+        let n = match KBindings.find_opt v env.shadow_vars with Some n -> n | None -> 0 in
+        let s_l, s_k = KBindings.find v env.typ_vars in 
+        let s_v = Kid_aux (Var (string_of_kid v ^ "#" ^ string_of_int n), l) in
+        typ_print (lazy (Printf.sprintf "%stype variable (shadowing %s) %s : %s" adding (string_of_kid s_v) (string_of_kid v) (string_of_kind_aux k)));
+        { env with
+          constraints = List.map (constraint_subst v (arg_kopt (mk_kopt s_k s_v))) env.constraints;
+          typ_vars = KBindings.add v (l, k) (KBindings.add s_v (s_l, s_k) env.typ_vars);
+          shadow_vars = KBindings.add v (n + 1) env.shadow_vars
+        }
       end
-
-  let add_num_def id nexp env =
-    if Bindings.mem id env.num_defs
-    then typ_error (id_loc id) ("Num identifier " ^ string_of_id id ^ " is already bound")
-    else
-      begin
-        typ_print (lazy (adding ^ "Num identifier " ^ string_of_id id ^ " : " ^ string_of_nexp nexp));
-        { env with num_defs = Bindings.add id nexp env.num_defs }
+    else begin
+        typ_print (lazy (adding ^ "type variable " ^ string_of_kid v ^ " : " ^ string_of_kind_aux k));
+        { env with typ_vars = KBindings.add v (l, k) env.typ_vars }
       end
 
-  let get_num_def id env =
-    try Bindings.find id env.num_defs with
-    | Not_found -> typ_raise (id_loc id) (Err_no_num_ident id)
-
   let get_constraints env = env.constraints
 
   let add_constraint constr env =
     wf_constraint env constr;
-    let (NC_aux (nc_aux, l) as constr) = expand_constraint_synonyms env constr in
+    let (NC_aux (nc_aux, l) as constr) = constraint_simp (expand_constraint_synonyms env constr) in
     match nc_aux with
     | NC_true -> env
     | _ ->
@@ -1047,7 +1110,7 @@ end = struct
 
   let add_typ_synonym id synonym env =
     if Bindings.mem id env.typ_synonyms
-    then typ_error (id_loc id) ("Type synonym " ^ string_of_id id ^ " already exists")
+    then typ_error env (id_loc id) ("Type synonym " ^ string_of_id id ^ " already exists")
     else
       begin
         typ_print (lazy (adding ^ "type synonym " ^ string_of_id id));
@@ -1058,13 +1121,13 @@ end = struct
 
   let get_default_order env =
     match env.default_order with
-    | None -> typ_error Parse_ast.Unknown ("No default order has been set")
+    | None -> typ_error env Parse_ast.Unknown ("No default order has been set")
     | Some ord -> ord
 
   let set_default_order o env =
     match env.default_order with
     | None -> { env with default_order = Some (Ord_aux (o, Parse_ast.Unknown)) }
-    | Some _ -> typ_error Parse_ast.Unknown ("Cannot change default order once already set")
+    | Some _ -> typ_error env Parse_ast.Unknown ("Cannot change default order once already set")
 
   let set_default_order_inc = set_default_order Ord_inc
   let set_default_order_dec = set_default_order Ord_dec
@@ -1140,12 +1203,12 @@ let bind_numeric l typ env =
   match destruct_numeric (Env.expand_synonyms env typ) with
   | Some (kids, nc, nexp) ->
      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")
+  | None -> typ_error env 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_exist (Env.expand_synonyms env typ) with
+let bind_existential l name typ env =
+  match destruct_exist ~name:name (Env.expand_synonyms env typ) with
   | Some (kids, nc, typ) -> typ, add_existential l kids nc env
   | None -> typ, env
 
@@ -1155,7 +1218,7 @@ let destruct_range env typ =
   in
   match typ_aux with
     | Typ_app (f, [A_aux (A_nexp n, _)])
-         when string_of_id f = "atom" -> Some (List.map kopt_kid kopts, constr, n, n)
+         when string_of_id f = "atom" || string_of_id f = "implicit" -> 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
@@ -1178,11 +1241,12 @@ let rec is_typ_monomorphic (Typ_aux (typ, l)) =
   | Typ_fn (arg_typs, ret_typ, _) -> List.for_all is_typ_monomorphic arg_typs && is_typ_monomorphic ret_typ
   | Typ_bidir (typ1, typ2) -> is_typ_monomorphic typ1 && is_typ_monomorphic typ2
   | Typ_exist _ | Typ_var _ -> false
-  | Typ_internal_unknown -> unreachable l __POS__ "escaped Typ_internal_unknown"
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and is_typ_arg_monomorphic (A_aux (arg, _)) =
   match arg with
   | A_nexp _ -> true
   | A_typ typ -> is_typ_monomorphic typ
+  | A_bool _ -> true
   | A_order (Ord_aux (Ord_dec, _)) | A_order (Ord_aux (Ord_inc, _)) -> true
   | A_order (Ord_aux (Ord_var _, _)) -> false
 
@@ -1190,10 +1254,55 @@ and is_typ_arg_monomorphic (A_aux (arg, _)) =
 (* 2. Subtyping and constraint solving                                    *)
 (**************************************************************************)
 
+type ('a, 'b) filter =
+  | Keep of 'a
+  | Remove of 'b
+
+let rec filter_keep = function
+  | Keep x :: xs -> x :: filter_keep xs
+  | Remove _ :: xs -> filter_keep xs
+  | [] -> []
+
+let rec filter_remove = function
+  | Keep _ :: xs -> filter_remove xs
+  | Remove x :: xs -> x :: filter_remove xs
+  | [] -> []
+
+let filter_split f g xs =
+  let xs = List.map f xs in
+  filter_keep xs, g (filter_remove xs)
+
 let rec simp_typ (Typ_aux (typ_aux, l)) = Typ_aux (simp_typ_aux typ_aux, l)
 and simp_typ_aux = function
   | Typ_exist (kids1, nc1, Typ_aux (Typ_exist (kids2, nc2, typ), _)) ->
-     Typ_exist (kids1 @ kids2, nc_and nc1 nc2, typ)
+     simp_typ_aux (Typ_exist (kids1 @ kids2, nc_and nc1 nc2, typ))
+
+  (* This removes redundant boolean variables in existentials, such
+     that {('p: Bool) ('q:Bool) ('r: Bool), nc('r). bool('p & 'q & 'r)}
+     would become {('s:Bool) ('r: Bool), nc('r). bool('s & 'r)},
+     wherein all the redundant boolean variables have been combined
+     into a single one. Making this simplification allows us to avoid
+     having to pass large numbers of pointless variables to Z3 if we
+     ever bind this existential. *)
+  | Typ_exist (vars, nc, Typ_aux (Typ_app (Id_aux (Id "atom_bool", _), [A_aux (A_bool b, _)]), _)) ->
+     let kids = KidSet.of_list (List.map kopt_kid vars) in
+     let constrained = tyvars_of_constraint nc in
+     let conjs = constraint_conj b in
+     let is_redundant = function
+       | NC_aux (NC_var v, _) when KidSet.mem v kids && not (KidSet.mem v constrained) -> Remove v
+       | nc -> Keep nc
+     in
+     let conjs, redundant = filter_split is_redundant KidSet.of_list conjs in
+     begin match conjs with
+     | [] -> Typ_id (mk_id "bool")
+     | conj :: conjs when KidSet.is_empty redundant ->
+        Typ_exist (vars, nc, atom_bool_typ (List.fold_left nc_and conj conjs))
+     | conjs ->
+        let vars = List.filter (fun v -> not (KidSet.mem (kopt_kid v) redundant)) vars in
+        let var = fresh_existential K_bool in
+        Typ_exist (var :: vars, nc, atom_bool_typ (List.fold_left nc_and (nc_var (kopt_kid var)) conjs))
+     end
+
   | typ_aux -> typ_aux
 
 (* Here's how the constraint generation works for subtyping
@@ -1238,21 +1347,16 @@ let solve env (Nexp_aux (_, l) as nexp) =
     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 debug_pos (file, line, _, _) =
+  "(" ^ file ^ "/" ^ string_of_int line ^ ") "
 
-
-let prove env nc =
+let prove pos 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
-    | _, _ -> false
-  in
+  let (NC_aux (nc_aux, _) as nc) = constraint_simp (Env.expand_constraint_synonyms env nc) in
+  if !Constraint.opt_smt_verbose then
+    prerr_endline (Util.("Prove " |> red |> clear) ^ debug_pos pos ^ string_of_list ", " string_of_n_constraint (Env.get_constraints env) ^ " |- " ^ string_of_n_constraint nc)
+  else ();
   match nc_aux with
-  | NC_equal (nexp1, nexp2) when compare_const Big_int.equal (nexp_simp nexp1) (nexp_simp nexp2) -> true
-  | NC_bounded_le (nexp1, nexp2) when compare_const Big_int.less_equal (nexp_simp nexp1) (nexp_simp nexp2) -> true
-  | NC_bounded_ge (nexp1, nexp2) when compare_const Big_int.greater_equal (nexp_simp nexp1) (nexp_simp nexp2) -> true
   | NC_true -> true
   | _ -> prove_z3 env nc
 
@@ -1272,11 +1376,6 @@ let rec nexp_frees ?exs:(exs=KidSet.empty) (Nexp_aux (nexp, l)) =
   | Nexp_exp n -> nexp_frees ~exs:exs n
   | Nexp_neg n -> nexp_frees ~exs:exs n
 
-let order_frees (Ord_aux (ord_aux, l)) =
-  match ord_aux with
-  | Ord_var kid -> KidSet.singleton kid
-  | _ -> KidSet.empty
-
 let rec typ_nexps (Typ_aux (typ_aux, l)) =
   match typ_aux with
   | Typ_internal_unknown -> []
@@ -1293,25 +1392,15 @@ and typ_arg_nexps (A_aux (typ_arg_aux, l)) =
   match typ_arg_aux with
   | A_nexp n -> [n]
   | A_typ typ -> typ_nexps typ
+  | A_bool nc -> constraint_nexps nc
   | A_order ord -> []
-
-let rec typ_frees ?exs:(exs=KidSet.empty) (Typ_aux (typ_aux, l)) =
-  match typ_aux with
-  | Typ_internal_unknown -> KidSet.empty
-  | Typ_id v -> KidSet.empty
-  | Typ_var kid when KidSet.mem kid exs -> KidSet.empty
-  | 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 (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) (A_aux (typ_arg_aux, l)) =
-  match typ_arg_aux with
-  | 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
+and constraint_nexps (NC_aux (nc_aux, l)) =
+  match nc_aux with
+  | NC_equal (n1, n2) | NC_bounded_ge (n1, n2) | NC_bounded_le (n1, n2) | NC_not_equal (n1, n2) ->
+     [n1; n2]
+  | NC_set _ | NC_true | NC_false | NC_var _ -> []
+  | NC_or (nc1, nc2) | NC_and (nc1, nc2) -> constraint_nexps nc1 @ constraint_nexps nc2
+  | NC_app (_, args) -> List.concat (List.map typ_arg_nexps args)
 
 let rec nexp_identical (Nexp_aux (nexp1, _)) (Nexp_aux (nexp2, _)) =
   match nexp1, nexp2 with
@@ -1434,13 +1523,38 @@ and unify_typ_arg l env goals (A_aux (aux1, _) as typ_arg1) (A_aux (aux2, _) as
   | 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
+  | A_bool nc1, A_bool nc2 -> unify_constraint l env 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) =
+and unify_constraint l env 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)
+  | NC_var v, NC_var v' when Kid.compare v v' = 0 -> KBindings.empty
+  | NC_and (nc1a, nc2a), NC_and (nc1b, nc2b) ->
+     begin
+       try
+         let conjs1 = List.sort NC.compare (constraint_conj nc1) in
+         let conjs2 = List.sort NC.compare (constraint_conj nc2) in
+         let unify_merge uv nc1 nc2 = merge_uvars l uv (unify_constraint l env goals nc1 nc2) in
+         List.fold_left2 unify_merge KBindings.empty conjs1 conjs2
+       with
+       | _ -> merge_uvars l (unify_constraint l env goals nc1a nc1b) (unify_constraint l env goals nc2a nc2b)
+     end
+  | NC_or (nc1a, nc2a), NC_or (nc1b, nc2b) ->
+     merge_uvars l (unify_constraint l env goals nc1a nc1b) (unify_constraint l env goals nc2a nc2b)
+  | NC_app (f1, args1), NC_app (f2, args2) when Id.compare f1 f2 = 0 && List.length args1 = List.length args2 ->
+     List.fold_left (merge_uvars l) KBindings.empty (List.map2 (unify_typ_arg l env goals) args1 args2)
+  | NC_equal (n1a, n2a), NC_equal (n1b, n2b) ->
+     merge_uvars l (unify_nexp l env goals n1a n1b) (unify_nexp l env goals n2a n2b)
+  | NC_not_equal (n1a, n2a), NC_not_equal (n1b, n2b) ->
+     merge_uvars l (unify_nexp l env goals n1a n1b) (unify_nexp l env goals n2a n2b)
+  | NC_bounded_ge (n1a, n2a), NC_bounded_ge (n1b, n2b) ->
+     merge_uvars l (unify_nexp l env goals n1a n1b) (unify_nexp l env goals n2a n2b)
+  | NC_bounded_le (n1a, n2a), NC_bounded_le (n1b, n2b) ->
+     merge_uvars l (unify_nexp l env goals n1a n1b) (unify_nexp l env goals n2a n2b)
+  | NC_true, NC_true -> KBindings.empty
+  | NC_false, NC_false -> KBindings.empty
   | _, _ -> 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) =
@@ -1457,7 +1571,7 @@ and unify_nexp l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_au
   if KidSet.is_empty (KidSet.inter (nexp_frees nexp1) goals)
   then
     begin
-      if prove env (NC_aux (NC_equal (nexp1, nexp2), Parse_ast.Unknown))
+      if prove __POS__ env (NC_aux (NC_equal (nexp1, nexp2), Parse_ast.Unknown))
       then KBindings.empty
       else unify_error l ("Nexp " ^ string_of_nexp nexp1 ^ " and " ^ string_of_nexp nexp2 ^ " are not equal")
     end
@@ -1477,20 +1591,30 @@ and unify_nexp l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_au
        else
          if KidSet.is_empty (nexp_frees 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)
+         else begin
+           match nexp_aux2 with
+           | Nexp_sum (n2a, n2b) ->
+              if KidSet.is_empty (nexp_frees n2a)
+              then unify_nexp l env goals n2b (nminus nexp1 n2a)
+              else
+                if KidSet.is_empty (nexp_frees n2a)
+                then unify_nexp l env goals n2a (nminus nexp1 n2b)
+                else merge_uvars l (unify_nexp l env goals n1a n2a) (unify_nexp l env goals n1b n2b)
+           | _ -> 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)
+         end
     | Nexp_minus (n1a, n1b) ->
        if KidSet.is_empty (nexp_frees n1b)
        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) ->
-       (* f we have SMT operations div and mod, then we can use the
+       (* If 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 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
+       let valid n c = prove __POS__ env (nc_eq (napp (mk_id "mod") [n; c]) (nint 0)) && prove __POS__ 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
@@ -1498,7 +1622,7 @@ and unify_nexp l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_au
        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)) ->
+           | Nexp_times (n2a, n2b) when prove __POS__ env (NC_aux (NC_equal (n1a, n2a), Parse_ast.Unknown)) ->
               unify_nexp l env goals n1b n2b
            | Nexp_constant c2 ->
               begin
@@ -1512,7 +1636,7 @@ and unify_nexp l env goals (Nexp_aux (nexp_aux1, _) as nexp1) (Nexp_aux (nexp_au
        else if KidSet.is_empty (nexp_frees n1b) then
          begin
            match nexp_aux2 with
-           | Nexp_times (n2a, n2b) when prove env (NC_aux (NC_equal (n1b, n2b), Parse_ast.Unknown)) ->
+           | Nexp_times (n2a, n2b) when prove __POS__ env (NC_aux (NC_equal (n1b, n2b), Parse_ast.Unknown)) ->
               unify_nexp l env goals n1a n2a
            | _ -> unify_error l ("Cannot unify Int expression " ^ string_of_nexp nexp1 ^ " with " ^ string_of_nexp nexp2)
          end
@@ -1524,7 +1648,7 @@ let unify l env goals typ1 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 "
+    typ_error env 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
@@ -1546,6 +1670,49 @@ let instantiate_quant (v, arg) (QI_aux (aux, l) as qi) =
 let instantiate_quants quants unifier =
   List.map (instantiate_quant unifier) quants |> Util.option_these
 
+(* During typechecking, we can run into the following issue, where we
+   have a function like
+
+   val and_bool : forall ('p : Bool) ('q : Bool). (bool('p), bool('q)) -> bool('p & 'q)
+
+   and we want to check something like Q & P <= bool(X & Y)
+
+   where Q => bool(Y) & P => bool(X)
+
+   if we instantiate using the return type (which is usually good)
+   we'll run into the situtation where we have to check bool(Y)
+   subtype bool(X) because the quantifiers will get instantiated in
+   the wrong order, despite the expression being otherwise well-typed
+   the trick here is to recognise that we shouldn't unify on goals in
+   certain ambiguous positions in types. In this case with and_bool,
+   they'll be unambigiously unified with the argument types so it's
+   better to just not bother with the return type.
+*)
+let rec ambiguous_vars (Typ_aux (aux, _)) =
+  match aux with
+  | Typ_app (_, args) -> List.fold_left KidSet.union KidSet.empty (List.map ambiguous_arg_vars args)
+  | _ -> KidSet.empty
+  
+and ambiguous_arg_vars (A_aux (aux, _)) =
+  match aux with
+  | A_bool nc -> ambiguous_nc_vars nc
+  | A_nexp nexp -> ambiguous_nexp_vars nexp
+  | _ -> KidSet.empty
+               
+and ambiguous_nc_vars (NC_aux (aux, _)) =
+  match aux with
+  | NC_and (nc1, nc2) -> KidSet.union (tyvars_of_constraint nc1) (tyvars_of_constraint nc2)
+  | NC_bounded_le (n1, n2) -> KidSet.union (tyvars_of_nexp n1) (tyvars_of_nexp n2)
+  | NC_bounded_ge (n1, n2) -> KidSet.union (tyvars_of_nexp n1) (tyvars_of_nexp n2)
+  | NC_equal (n1, n2) | NC_not_equal (n1, n2) ->
+     KidSet.union (ambiguous_nexp_vars n1) (ambiguous_nexp_vars n2)
+  | _ -> KidSet.empty
+
+and ambiguous_nexp_vars (Nexp_aux (aux, _)) =
+  match aux with
+  | Nexp_sum (nexp1, nexp2) -> KidSet.union (tyvars_of_nexp nexp1) (tyvars_of_nexp nexp2)
+  | _ -> KidSet.empty
+
 (**************************************************************************)
 (* 3.5. Subtyping with existentials                                       *)
 (**************************************************************************)
@@ -1567,6 +1734,12 @@ let destruct_atom_kid env typ =
        when string_of_id f = "range" && Kid.compare kid1 kid2 = 0 -> Some kid1
   | _ -> None
 
+let destruct_atom_bool env typ =
+  match Env.expand_synonyms env typ with
+  | Typ_aux (Typ_app (f, [A_aux (A_bool nc, _)]), _) when string_of_id f = "atom_bool" ->
+     Some nc
+  | _ -> None
+
 (* 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
@@ -1596,8 +1769,8 @@ let rec kid_order kind_map (Typ_aux (aux, l) as typ) =
      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)) ([], 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"
+  | Typ_fn _ | Typ_bidir _ | Typ_exist _ -> typ_error Env.empty l ("Existential or function type cannot appear within existential type: " ^ string_of_typ typ)
+  | Typ_internal_unknown -> Reporting.unreachable l __POS__ "escaped Typ_internal_unknown"
 and kid_order_arg kind_map (A_aux (aux, l) as arg) =
   match aux with
   | A_typ typ -> kid_order kind_map typ
@@ -1606,10 +1779,21 @@ and kid_order_arg kind_map (A_aux (aux, l) as arg) =
   | 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 ->
+  | NC_var kid | NC_set (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"
+  | NC_var _ | NC_set _ -> ([], kind_map)
+  | NC_true | NC_false -> ([], kind_map)
+  | NC_equal (n1, n2) | NC_not_equal (n1, n2) | NC_bounded_le (n1, n2) | NC_bounded_ge (n1, n2) ->
+     let ord1, kind_map = kid_order_nexp kind_map n1 in
+     let ord2, kind_map = kid_order_nexp kind_map n2 in
+     (ord1 @ ord2, kind_map)
+  | NC_app (_, args) ->
+     List.fold_left (fun (ord, kind_map) arg -> let  ord', kind_map = kid_order_arg kind_map arg in (ord @ ord', kind_map))
+                    ([], kind_map) args
+  | NC_and (nc1, nc2) | NC_or (nc1, nc2) ->
+     let ord1, kind_map = kid_order_constraint kind_map nc1 in
+     let ord2, kind_map = kid_order_constraint kind_map nc2 in
+     (ord1 @ ord2, kind_map)
 
 let rec alpha_equivalent env typ1 typ2 =
   let counter = ref 0 in
@@ -1625,7 +1809,9 @@ let rec alpha_equivalent env typ1 typ2 =
       | Typ_tup typs -> Typ_tup (List.map relabel typs)
       | Typ_exist (kopts, nc, typ) ->
          let kind_map = List.fold_left (fun m kopt -> KBindings.add (kopt_kid kopt) (kopt_kind kopt) m) KBindings.empty kopts in
-         let (kopts, _) = kid_order kind_map typ in
+         let (kopts1, kind_map) = kid_order_constraint kind_map nc in
+         let (kopts2, _) = kid_order kind_map typ in
+         let kopts = kopts1 @ kopts2 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
@@ -1711,34 +1897,16 @@ let rec subtyp l env typ1 typ2 =
   (* Special cases for two numeric (atom) types *)
   | Some (kids1, nc1, nexp1), Some ([], _, nexp2) ->
      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))
+     if prove __POS__ env (nc_eq nexp1 nexp2) then () else typ_raise env 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 (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 ();
+     if not (kids2 = []) then typ_error env 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
-     if prove env nc2 then ()
-     else typ_raise l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
+     if prove __POS__ env nc2 then ()
+     else typ_raise env l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
   | _, _ ->
-  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 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) -> 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 -> ()
 
@@ -1756,16 +1924,34 @@ let rec subtyp l env typ1 typ2 =
   | 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))
+  | _, _ ->
+  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 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)) (tyvars_of_typ typ2)) in
+     if not (kids' = []) then typ_error env 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 env l m
+     in
+     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 __POS__ env nc then ()
+     else typ_raise env l (Err_subtype (typ1, typ2, Env.get_constraints env, Env.get_typ_var_locs env))
+  | None, None -> typ_raise env 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_nexp n1, A_nexp n2 when prove __POS__ 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"
+  | A_bool nc1, A_bool nc2 when prove __POS__ env (nc_and (nc_or (nc_not nc1) nc2) (nc_or (nc_not nc2) nc1)) -> ()
+  | _, _ -> typ_error env l "Mismatched argument types in subtype check"
 
 let typ_equality l env typ1 typ2 =
   subtyp l env typ1 typ2; subtyp l env typ2 typ1
@@ -1775,22 +1961,156 @@ let subtype_check env typ1 typ2 =
   | Type_error _ -> false
 
 (**************************************************************************)
-(* 4. Type checking expressions                                           *)
+(* 4. Removing sizeof expressions                                         *)
+(**************************************************************************)
+
+exception No_simple_rewrite;;
+
+let rec rewrite_sizeof' env (Nexp_aux (aux, l) as nexp) =
+  let mk_exp exp = mk_exp ~loc:l exp in
+  match aux with
+  | Nexp_var v ->
+     let locals = Env.get_locals env |> Bindings.bindings in
+     let same_size (local, (_, Typ_aux (aux, _))) =
+       match aux with
+       | Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var v', _)), _)])
+            when string_of_id id = "atom" && Kid.compare v v' = 0 -> true
+
+       | Typ_app (id, [A_aux (A_nexp n, _)]) when string_of_id id = "atom" ->
+          prove __POS__ env (nc_eq (nvar v) n)
+
+       | Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var v', _)), _); _; _]) when string_of_id id = "vector" ->
+          Kid.compare v v' = 0
+
+       | _ ->
+          false
+     in
+     begin match List.find_opt same_size locals with
+     | Some (id, (_, typ)) -> mk_exp (E_app (mk_id "__size", [mk_exp (E_id id)]))
+     | None -> raise No_simple_rewrite
+     end
+
+  | Nexp_constant c ->
+     mk_lit_exp (L_num c)
+
+  | Nexp_neg nexp ->
+     let exp = rewrite_sizeof' env nexp in
+     mk_exp (E_app (mk_id "negate_atom", [exp]))
+
+  | Nexp_sum (nexp1, nexp2) ->
+     let exp1 = rewrite_sizeof' env nexp1 in
+     let exp2 = rewrite_sizeof' env nexp2 in
+     mk_exp (E_app (mk_id "add_atom", [exp1; exp2]))
+
+  | Nexp_minus (nexp1, nexp2) ->
+     let exp1 = rewrite_sizeof' env nexp1 in
+     let exp2 = rewrite_sizeof' env nexp2 in
+     mk_exp (E_app (mk_id "sub_atom", [exp1; exp2]))
+
+  | Nexp_times (nexp1, nexp2) ->
+     let exp1 = rewrite_sizeof' env nexp1 in
+     let exp2 = rewrite_sizeof' env nexp2 in
+     mk_exp (E_app (mk_id "mult_atom", [exp1; exp2]))
+
+  | Nexp_exp nexp ->
+     let exp = rewrite_sizeof' env nexp in
+     mk_exp (E_app (mk_id "pow2", [exp]))
+
+  | Nexp_app (id, [nexp1; nexp2]) when string_of_id id = "div" ->
+     let exp1 = rewrite_sizeof' env nexp1 in
+     let exp2 = rewrite_sizeof' env nexp2 in
+     mk_exp (E_app (mk_id "div", [exp1; exp2]))
+
+  | Nexp_app (id, [nexp1; nexp2]) when string_of_id id = "mod" ->
+     let exp1 = rewrite_sizeof' env nexp1 in
+     let exp2 = rewrite_sizeof' env nexp2 in
+     mk_exp (E_app (mk_id "mod", [exp1; exp2]))
+
+  | Nexp_app _ | Nexp_id _ ->
+     typ_error env l ("Cannot re-write sizeof(" ^ string_of_nexp nexp ^ ")")
+
+let rewrite_sizeof l env nexp =
+  try rewrite_sizeof' env nexp with
+  | No_simple_rewrite ->
+     let locals = Env.get_locals env |> Bindings.bindings in
+     let same_size (local, (_, Typ_aux (aux, _))) =
+       match aux with
+       | Typ_app (id, [A_aux (A_nexp n, _)]) when string_of_id id = "atom" ->
+          prove __POS__ env (nc_eq nexp n)
+       | _ -> false
+     in
+     begin match List.find_opt same_size locals with
+     | Some (id, (_, typ)) -> mk_exp (E_app (mk_id "__size", [mk_exp (E_id id)]))
+     | None -> typ_error env l ("Cannot re-write sizeof(" ^ string_of_nexp nexp ^ ")")
+     end
+
+let rec rewrite_nc env (NC_aux (nc_aux, l)) = mk_exp ~loc:l (rewrite_nc_aux l env nc_aux)
+and rewrite_nc_aux l env =
+  let mk_exp exp = mk_exp ~loc:l exp in
+  function
+  | NC_bounded_ge (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id ">=", mk_exp (E_sizeof n2))
+  | NC_bounded_le (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "<=", mk_exp (E_sizeof n2))
+  | NC_equal (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "==", mk_exp (E_sizeof n2))
+  | NC_not_equal (n1, n2) -> E_app_infix (mk_exp (E_sizeof n1), mk_id "!=", mk_exp (E_sizeof n2))
+  | NC_and (nc1, nc2) -> E_app_infix (rewrite_nc env nc1, mk_id "&", rewrite_nc env nc2)
+  | NC_or (nc1, nc2) -> E_app_infix (rewrite_nc env nc1, mk_id "|", rewrite_nc env nc2)
+  | NC_false -> E_lit (mk_lit L_false)
+  | NC_true -> E_lit (mk_lit L_true)
+  | NC_set (kid, []) -> E_lit (mk_lit (L_false))
+  | NC_set (kid, int :: ints) ->
+     let kid_eq kid int = nc_eq (nvar kid) (nconstant int) in
+     unaux_exp (rewrite_nc env (List.fold_left (fun nc int -> nc_or nc (kid_eq kid int)) (kid_eq kid int) ints))
+  | NC_app (f, [A_aux (A_bool nc, _)]) when string_of_id f = "not" ->
+     E_app (mk_id "not_bool", [rewrite_nc env nc])
+  | NC_app (f, args) ->
+     unaux_exp (rewrite_nc env (Env.expand_constraint_synonyms env (mk_nc (NC_app (f, args)))))
+  | NC_var v ->
+     (* Would be better to translate change E_sizeof to take a kid, then rewrite to E_sizeof *)
+     E_id (id_of_kid v)
+
+
+(**************************************************************************)
+(* 5. Type checking expressions                                           *)
 (**************************************************************************)
 
 (* The type checker produces a fully annoted AST - tannot is the type
    of these type annotations.  The extra typ option is the expected type,
    that is, the type that the AST node was checked against, if there was one. *)
-type tannot = ((Env.t * typ * effect) * typ option) option
+type tannot' = {
+    env : Env.t;
+    typ : typ;
+    effect : effect;
+    expected : typ option;
+    instantiation : typ_arg KBindings.t option
+  }
+
+type tannot = tannot' option
+
+let mk_tannot env typ effect : tannot =
+  Some {
+      env = env;
+      typ = Env.expand_synonyms env typ;
+      effect = effect;
+      expected = None;
+      instantiation = None
+    }
 
-let mk_tannot env typ effect : tannot = Some ((env, typ, effect), None)
+let mk_expected_tannot env typ effect expected : tannot =
+  Some {
+      env = env;
+      typ = Env.expand_synonyms env typ;
+      effect = effect;
+      expected = expected;
+      instantiation = None
+    }
 
 let empty_tannot = None
+
 let is_empty_tannot = function
   | None -> true
   | Some _ -> false
 
-let destruct_tannot tannot = Util.option_map fst tannot
+let destruct_tannot tannot = Util.option_map (fun t -> (t.env, t.typ, t.effect)) tannot
 
 let string_of_tannot tannot =
   match destruct_tannot tannot with
@@ -1799,21 +2119,39 @@ let string_of_tannot tannot =
   | None -> "None"
 
 let replace_typ typ = function
-  | Some ((env, _, eff), _) -> Some ((env, typ, eff), None)
+  | Some t -> Some { t with typ = typ }
   | None -> None
 
 let replace_env env = function
-  | Some ((_, typ, eff), _) -> Some ((env, typ, eff), None)
+  | Some t -> Some { t with env = env }
   | None -> None
 
+(* Helpers for implicit arguments in infer_funapp' *)
+let is_not_implicit (Typ_aux (aux, _)) =
+  match aux with
+  | Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var impl, _)), _)]) when string_of_id id = "implicit" -> false
+  | _ -> true
+
+let implicit_to_int (Typ_aux (aux, l)) =
+  match aux with
+  | Typ_app (id, args) when string_of_id id = "implicit" -> Typ_aux (Typ_app (mk_id "atom", args), l)
+  | _ -> Typ_aux (aux, l)
+
+let rec get_implicits typs =
+  match typs with
+  | Typ_aux (Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_var impl, _)), _)]), _) :: typs when string_of_id id = "implicit" ->
+     impl :: get_implicits typs
+  | _ :: typs -> get_implicits typs
+  | [] -> []
+
 let infer_lit env (L_aux (lit_aux, l) as lit) =
   match lit_aux with
   | L_unit -> unit_typ
   | L_zero -> bit_typ
   | L_one -> bit_typ
   | L_num n -> atom_typ (nconstant n)
-  | L_true -> bool_typ
-  | L_false -> bool_typ
+  | L_true -> atom_bool_typ nc_true
+  | L_false -> atom_bool_typ nc_false
   | L_string _ -> string_typ
   | L_real _ -> real_typ
   | L_bin str ->
@@ -1821,16 +2159,16 @@ let infer_lit env (L_aux (lit_aux, l) as lit) =
        match Env.get_default_order env with
        | Ord_aux (Ord_inc, _) | Ord_aux (Ord_dec, _) ->
           dvector_typ env (nint (String.length str)) (mk_typ (Typ_id (mk_id "bit")))
-       | Ord_aux (Ord_var _, _) -> typ_error l default_order_error_string
+       | Ord_aux (Ord_var _, _) -> typ_error env l default_order_error_string
      end
   | L_hex str ->
      begin
        match Env.get_default_order env with
        | Ord_aux (Ord_inc, _) | Ord_aux (Ord_dec, _) ->
           dvector_typ env (nint (String.length str * 4)) (mk_typ (Typ_id (mk_id "bit")))
-       | Ord_aux (Ord_var _, _) -> typ_error l default_order_error_string
+       | Ord_aux (Ord_var _, _) -> typ_error env l default_order_error_string
      end
-  | L_undef -> typ_error l "Cannot infer the type of undefined"
+  | L_undef -> typ_error env l "Cannot infer the type of undefined"
 
 let is_nat_kid kid = function
   | KOpt_aux (KOpt_kind (K_aux (K_int, _), kid'), _) -> Kid.compare kid kid' = 0
@@ -1880,23 +2218,19 @@ let destruct_vec_typ l env typ =
                              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)
+    | typ -> typ_error env l ("Expected vector type, got " ^ string_of_typ typ)
   in
   destruct_vec_typ' l (Env.expand_synonyms env typ)
 
 
 let env_of_annot (l, tannot) = match tannot with
-  | Some ((env, _, _),_) -> env
+  | Some t -> t.env
   | 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.err_unreachable l __POS__ "no type annotation")
-
-let env_of_annot (l, tannot) = match tannot with
-  | Some ((env, _, _), _) -> env
+  | Some t -> t.typ
   | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 let typ_of (E_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
@@ -1924,7 +2258,7 @@ let lexp_typ_of (LEXP_aux (_, (l, tannot))) = typ_of_annot (l, tannot)
 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
+  | Some t -> t.expected
   | None -> raise (Reporting.err_unreachable l __POS__ "no type annotation")
 
 (* Flow typing *)
@@ -1941,7 +2275,7 @@ let to_simple_numeric l kids nc (Nexp_aux (aux, _) as n) =
   | _, [] ->
      Equal n
   | _ ->
-     typ_error l "Numeric type is non-simple"
+     typ_error Env.empty l "Numeric type is non-simple"
 
 let union_simple_numeric ex1 ex2 =
   match ex1, ex2 with
@@ -2040,7 +2374,7 @@ let rec add_constraints constrs env =
 
 let solve_quant env = function
   | QI_aux (QI_id _, _) -> false
-  | QI_aux (QI_const nc, _) -> prove env nc
+  | QI_aux (QI_const nc, _) -> prove __POS__ env nc
 
 (* When doing implicit type coercion, for performance reasons we want
    to filter out the possible casts to only those that could
@@ -2062,6 +2396,8 @@ let rec match_typ env typ1 typ2 =
   | Typ_id v, Typ_app (f, _) when string_of_id v = "int" &&  string_of_id f = "atom" -> true
   | Typ_id v, Typ_app (f, _) when string_of_id v = "nat" &&  string_of_id f = "range" -> true
   | Typ_id v, Typ_app (f, _) when string_of_id v = "int" &&  string_of_id f = "range" -> true
+  | Typ_id v, Typ_app (f, _) when string_of_id v = "bool" &&  string_of_id f = "atom_bool" -> true
+  | Typ_app (f, _), Typ_id v when string_of_id v = "bool" &&  string_of_id f = "atom_bool" -> true
   | Typ_app (f1, _), Typ_app (f2, _) when string_of_id f1 = "range" && string_of_id f2 = "atom" -> true
   | Typ_app (f1, _), Typ_app (f2, _) when string_of_id f1 = "atom" && string_of_id f2 = "range" -> true
   | Typ_app (f1, _), Typ_app (f2, _) when Id.compare f1 f2 = 0 -> true
@@ -2076,10 +2412,14 @@ let rec filter_casts env from_typ to_typ casts =
        let (quant, cast_typ) = Env.get_val_spec cast env in
        match cast_typ with
        (* A cast should be a function A -> B and have only a single argument type. *)
-       | Typ_aux (Typ_fn ([cast_from_typ], cast_to_typ, _), _)
-            when match_typ env from_typ cast_from_typ && match_typ env to_typ cast_to_typ ->
-          typ_print (lazy ("Considering cast " ^ string_of_typ cast_typ ^ " for " ^ string_of_typ from_typ ^ " to " ^ string_of_typ to_typ));
-          cast :: filter_casts env from_typ to_typ casts
+       | Typ_aux (Typ_fn (arg_typs, cast_to_typ, _), _) ->
+          begin match List.filter is_not_implicit arg_typs with
+          | [cast_from_typ] when match_typ env from_typ cast_from_typ && match_typ env to_typ cast_to_typ ->
+             typ_print (lazy ("Considering cast " ^ string_of_typ cast_typ
+                              ^ " for " ^ string_of_typ from_typ ^ " to " ^ string_of_typ to_typ));
+             cast :: filter_casts env from_typ to_typ casts
+          | _ -> filter_casts env from_typ to_typ casts
+          end
        | _ -> filter_casts env from_typ to_typ casts
      end
   | [] -> []
@@ -2092,7 +2432,7 @@ let crule r env exp typ =
     Env.wf_typ env (typ_of checked_exp);
     decr depth; checked_exp
   with
-  | Type_error (l, err) -> decr depth; typ_raise l err
+  | Type_error (env, l, err) -> decr depth; typ_raise env l err
 
 let irule r env exp =
   incr depth;
@@ -2103,7 +2443,7 @@ let irule r env exp =
     decr depth;
     inferred_exp
   with
-  | Type_error (l, err) -> decr depth; typ_raise l err
+  | Type_error (env, l, err) -> decr depth; typ_raise env l err
 
 
 (* This function adds useful assertion messages to asserts missing them *)
@@ -2129,47 +2469,15 @@ let fresh_var =
             mk_id ("v#" ^ string_of_int n)
 
 let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ_aux, _) as typ) : tannot exp =
-  let annot_exp_effect exp typ' eff = E_aux (exp, (l, Some ((env, Env.expand_synonyms env typ', eff),Some typ))) in
+  let annot_exp_effect exp typ' eff = E_aux (exp, (l, mk_expected_tannot env typ' eff (Some typ))) in
   let add_effect exp eff = match exp with
-    | (E_aux (exp, (l, Some ((env, typ, _), otyp)))) -> E_aux (exp, (l, Some ((env, typ, eff),otyp)))
+    | E_aux (exp, (l, Some tannot)) -> E_aux (exp, (l, Some { tannot with effect = eff }))
     | _ -> failwith "Tried to add effect to unannoted expression"
   in
   let annot_exp exp typ = annot_exp_effect exp typ no_effect in
   match (exp_aux, typ_aux) with
   | E_block exps, _ ->
-     begin
-       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 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, 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 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"));
-                 Env.add_constraint nc env
-              | None -> env
-            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
-       in
-       annot_exp (E_block (check_block l env exps typ)) typ
-     end
+     annot_exp (E_block (check_block l env exps (Some typ))) typ
   | E_case (exp, cases), _ ->
      Pattern_completeness.check l (Env.pattern_completeness_ctx env) cases;
      let inferred_exp = irule infer_exp env exp in
@@ -2185,7 +2493,7 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
           let checked_xs = crule check_exp env xs typ in
           let checked_x = crule check_exp env x elem_typ in
           annot_exp (E_cons (checked_x, checked_xs)) typ
-       | None -> typ_error l ("Cons " ^ string_of_exp exp ^ " must have list type, got " ^ string_of_typ typ)
+       | None -> typ_error env l ("Cons " ^ string_of_exp exp ^ " must have list type, got " ^ string_of_typ typ)
      end
   | E_list xs, _ ->
      begin
@@ -2193,7 +2501,7 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
        | Some elem_typ ->
           let checked_xs = List.map (fun x -> crule check_exp env x elem_typ) xs in
           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)
+       | None -> typ_error env l ("List " ^ string_of_exp exp ^ " must have list type, got " ^ string_of_typ typ)
      end
   | E_record_update (exp, fexps), _ ->
      (* TODO: this could also infer exp - also fix code duplication with E_record below *)
@@ -2201,11 +2509,11 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      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 ->
           rectyp_id
-       | _ -> typ_error l ("The type " ^ string_of_typ typ ^ " is not a record")
+       | _ -> typ_error env l ("The type " ^ string_of_typ typ ^ " is not a record")
      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 = 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 unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
        let field_typ' = subst_unifiers unifiers field_typ in
        let checked_exp = crule check_exp env exp field_typ' in
        FE_aux (FE_Fexp (field, checked_exp), (l, None))
@@ -2216,11 +2524,11 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      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 ->
           rectyp_id
-       | _ -> typ_error l ("The type " ^ string_of_typ typ ^ " is not a record")
+       | _ -> typ_error env l ("The type " ^ string_of_typ typ ^ " is not a record")
      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 = 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 unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
        let field_typ' = subst_unifiers unifiers field_typ in
        let checked_exp = crule check_exp env exp field_typ' in
        FE_aux (FE_Fexp (field, checked_exp), (l, None))
@@ -2241,16 +2549,25 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      end
   | E_app_infix (x, op, y), _ ->
      check_exp env (E_aux (E_app (deinfix op, [x; y]), (l, ()))) typ
-  | E_app (f, [E_aux (E_constraint nc, _)]), _ when Id.compare f (mk_id "_prove") = 0 ->
+  | E_app (f, [E_aux (E_constraint nc, _)]), _ when string_of_id f = "_prove" ->
      Env.wf_constraint env nc;
-     if prove env nc
+     if prove __POS__ 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_constraint nc, _)]), _ when Id.compare f (mk_id "_not_prove") = 0 ->
+     else typ_error env l ("Cannot prove " ^ string_of_n_constraint nc)
+  | E_app (f, [E_aux (E_constraint nc, _)]), _ when string_of_id f = "_not_prove" ->
      Env.wf_constraint env nc;
-     if prove env nc
-     then typ_error l ("Can prove " ^ string_of_n_constraint nc)
+     if prove __POS__ env nc
+     then typ_error env l ("Can prove " ^ string_of_n_constraint nc)
      else annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
+  | E_app (f, [E_aux (E_cast (typ, exp), _)]), _ when string_of_id f = "_check" ->
+     Env.wf_typ env typ;
+     let _ = crule check_exp env exp typ in
+     annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
+  | E_app (f, [E_aux (E_cast (typ, exp), _)]), _ when string_of_id f = "_not_check" ->
+     Env.wf_typ env typ;
+     if (try (ignore (crule check_exp env exp typ); false) with Type_error _ -> true)
+     then annot_exp (E_lit (L_aux (L_unit, Parse_ast.Unknown))) unit_typ
+     else typ_error env l (Printf.sprintf "Expected _not_check(%s : %s) to fail" (string_of_exp exp) (string_of_typ 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 ->
@@ -2261,22 +2578,22 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
      let backwards_id = mk_id (string_of_id mapping ^ "_backwards") in
      typ_print (lazy("Trying forwards direction for mapping " ^ string_of_id mapping ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
      begin try crule check_exp env (E_aux (E_app (forwards_id, xs), (l, ()))) typ with
-           | Type_error (_, err1) ->
+           | Type_error (_, _, err1) ->
               (* typ_print (lazy ("Error in forwards direction: " ^ string_of_type_error err1)); *)
               typ_print (lazy ("Trying backwards direction for mapping " ^ string_of_id mapping ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
               begin try crule check_exp env (E_aux (E_app (backwards_id, xs), (l, ()))) typ with
-                    | Type_error (_, err2) ->
+                    | Type_error (_, _, err2) ->
                        (* typ_print (lazy ("Error in backwards direction: " ^ string_of_type_error err2)); *)
-                       typ_raise l (Err_no_overloading (mapping, [(forwards_id, err1); (backwards_id, err2)]))
+                       typ_raise env l (Err_no_overloading (mapping, [(forwards_id, err1); (backwards_id, err2)]))
               end
      end
   | E_app (f, xs), _ when List.length (Env.get_overloads f env) > 0 ->
      let rec try_overload = function
-       | (errs, []) -> typ_raise l (Err_no_overloading (f, errs))
+       | (errs, []) -> typ_raise env l (Err_no_overloading (f, errs))
        | (errs, (f :: fs)) -> begin
            typ_print (lazy ("Overload: " ^ string_of_id f ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
            try crule check_exp env (E_aux (E_app (f, xs), (l, ()))) typ with
-           | Type_error (_, err) ->
+           | Type_error (_, _, err) ->
               typ_debug (lazy "Error");
               try_overload (errs @ [(f, err)], fs)
          end
@@ -2285,7 +2602,7 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
   | E_return exp, _ ->
      let checked_exp = match Env.get_ret_typ env with
        | Some ret_typ -> crule check_exp env exp ret_typ
-       | None -> typ_error l "Cannot use return outside a function"
+       | None -> typ_error env l "Cannot use return outside a function"
      in
      annot_exp (E_return checked_exp) typ
   | E_tuple exps, Typ_tup typs when List.length exps = List.length typs ->
@@ -2309,7 +2626,7 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
         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
+     let checked_exp = crule check_exp env exp unit_typ in
      annot_exp_effect (E_exit checked_exp) typ (mk_effect [BE_escape])
   | E_throw exp, _ ->
      let checked_exp = crule check_exp env exp exc_typ in
@@ -2344,22 +2661,63 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
                Env.add_constraint nc env
             | None -> env
           end
+       | E_aux (E_if (cond, e_t, e_e), _) ->
+          begin
+            match unaux_exp (fst (uncast_exp e_t)) with
+            | E_throw _ | E_block [E_aux (E_throw _, _)] ->
+               add_opt_constraint (option_map nc_not (assert_constraint env false cond)) env
+            | _ -> env
+          end
        | _ -> env in
      let checked_body = crule check_exp env body typ in
      annot_exp (E_internal_plet (tpat, bind_exp, checked_body)) typ
   | E_vector vec, _ ->
      let (len, ord, vtyp) = destruct_vec_typ l env typ in
      let checked_items = List.map (fun i -> crule check_exp env i vtyp) vec in
-     if prove env (nc_eq (nint (List.length vec)) (nexp_simp len)) then annot_exp (E_vector checked_items) typ
-     else typ_error l "List length didn't match" (* FIXME: improve error message *)
+     if prove __POS__ env (nc_eq (nint (List.length vec)) (nexp_simp len)) then annot_exp (E_vector checked_items) typ
+     else typ_error env l "List length didn't match" (* FIXME: improve error message *)
   | E_lit (L_aux (L_undef, _) as lit), _ ->
      if is_typ_monomorphic typ || Env.polymorphic_undefineds env
      then annot_exp_effect (E_lit lit) typ (mk_effect [BE_undef])
-     else typ_error l ("Type " ^ string_of_typ typ ^ " failed undefined monomorphism restriction")
+     else typ_error env l ("Type " ^ string_of_typ typ ^ " failed undefined monomorphism restriction")
   | _, _ ->
      let inferred_exp = irule infer_exp env exp in
      type_coercion env inferred_exp typ
 
+and check_block l env exps ret_typ =
+  let final env exp = match ret_typ with
+    | Some typ -> crule check_exp env exp typ
+    | None -> irule infer_exp env exp
+  in
+  let annot_exp_effect exp typ eff exp_typ = E_aux (exp, (l, mk_expected_tannot env typ eff exp_typ)) in
+  let annot_exp exp typ exp_typ = annot_exp_effect exp typ no_effect exp_typ in
+  match Nl_flow.analyze exps with
+  | [] -> (match ret_typ with Some typ -> typ_equality l env typ unit_typ; [] | None -> [])
+  | [exp] -> [final env exp]
+  | (E_aux (E_assign (lexp, bind), _) :: exps) ->
+     let texp, env = bind_assignment env lexp bind in
+     texp :: check_block l env exps ret_typ
+  | ((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 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"));
+          Env.add_constraint nc env
+       | None -> env
+     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 ret_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 ret_typ
+  | (exp :: exps) ->
+     let texp = crule check_exp env exp (mk_typ (Typ_id (mk_id "unit"))) in
+     texp :: check_block l env exps ret_typ
+
 and check_case env pat_typ pexp typ =
   let pat,guard,case,((l,_) as annot) = destruct_pexp pexp in
   match bind_pat env pat pat_typ with
@@ -2424,20 +2782,20 @@ and check_mpexp other_env env mpexp typ =
    or throws a type error if the coercion cannot be performed. *)
 and type_coercion env (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 annot_exp exp typ' = E_aux (exp, (l, mk_expected_tannot env typ' no_effect (Some typ))) in
   let switch_exp_typ exp = match exp with
-    | (E_aux (exp, (l, Some ((env, typ', eff), _)))) -> E_aux (exp, (l, Some ((env, typ', eff), Some typ)))
+    | E_aux (exp, (l, Some tannot)) -> E_aux (exp, (l, Some { tannot with expected = Some typ }))
     | _ -> failwith "Cannot switch type for unannotated function"
   in
   let rec try_casts trigger errs = function
-    | [] -> typ_raise l (Err_no_casts (strip_exp annotated_exp, typ_of annotated_exp, typ, trigger, errs))
+    | [] -> typ_raise env l (Err_no_casts (strip_exp annotated_exp, typ_of annotated_exp, typ, trigger, errs))
     | (cast :: casts) -> begin
         typ_print (lazy ("Casting with " ^ string_of_id cast ^ " expression " ^ string_of_exp annotated_exp ^ " to " ^ string_of_typ typ));
         try
           let checked_cast = crule check_exp (Env.no_casts env) (strip (E_app (cast, [annotated_exp]))) typ in
           annot_exp (E_cast (typ, checked_cast)) typ
         with
-        | Type_error (_, err) -> try_casts trigger (err :: errs) casts
+        | Type_error (_, _, err) -> try_casts trigger (err :: errs) casts
       end
   in
   begin
@@ -2445,10 +2803,10 @@ and type_coercion env (E_aux (_, (l, _)) as annotated_exp) 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 ->
+    | 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_raise l err
+    | Type_error (env, l, err) -> typ_raise env l err
   end
 
 (* type_coercion_unify env exp typ attempts to coerce exp to a type
@@ -2458,9 +2816,9 @@ and type_coercion env (E_aux (_, (l, _)) as annotated_exp) typ =
    throws a unification error *)
 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 annot_exp exp typ' = E_aux (exp, (l, mk_expected_tannot env typ' no_effect (Some typ))) in
   let switch_typ exp typ = match exp with
-    | (E_aux (exp, (l, Some (env, _, eff)))) -> E_aux (exp, (l, Some (env, typ, eff)))
+    | E_aux (exp, (l, Some tannot)) -> E_aux (exp, (l, Some { tannot with typ = typ }))
     | _ -> failwith "Cannot switch type for unannotated expression"
   in
   let rec try_casts = function
@@ -2469,18 +2827,18 @@ and type_coercion_unify env goals (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, env = bind_existential l (typ_of inferred_cast) env in
-          inferred_cast, unify l env goals typ ityp, env
+          let ityp, env = bind_existential l None (typ_of inferred_cast) env in
+          inferred_cast, unify l env (KidSet.diff goals (ambiguous_vars typ)) typ ityp, env
         with
-        | Type_error (_, err) -> try_casts casts
+        | Type_error (_, _, err) -> try_casts casts
         | Unification_error (_, err) -> try_casts casts
       end
   in
   begin
     try
       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
+      let atyp, env = bind_existential l None (typ_of annotated_exp) env in
+      annotated_exp, unify l env (KidSet.diff goals (ambiguous_vars typ)) 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
@@ -2489,16 +2847,16 @@ and type_coercion_unify env goals (E_aux (_, (l, _)) as annotated_exp) typ =
 
 and bind_pat_no_guard env (P_aux (_,(l,_)) as pat) typ =
   match bind_pat env pat typ with
-  | _, _, _::_ -> typ_error l "Literal patterns not supported here"
+  | _, _, _::_ -> typ_error env l "Literal patterns not supported here"
   | tpat, env, [] -> tpat, env
 
 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
+  let (Typ_aux (typ_aux, _) as typ), env = bind_existential l (name_pat pat) typ env in
   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 annot_pat pat typ' = P_aux (pat, (l, mk_expected_tannot 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)))
-    | _ -> typ_error l "Cannot switch type for unannotated pattern"
+    | P_aux (pat_aux, (l, Some tannot)) -> P_aux (pat_aux, (l, Some { tannot with typ = typ }))
+    | _ -> typ_error env l "Cannot switch type for unannotated pattern"
   in
   let bind_tuple_pat (tpats, env, guards) pat typ =
     let tpat, env, guards' = bind_pat env pat typ in tpat :: tpats, env, guards' @ guards
@@ -2516,7 +2874,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
        match Env.lookup_id v env with
        | Local _ | Unbound -> annot_pat (P_id v) typ, Env.add_local v (Immutable, typ) env, []
        | Register _ ->
-          typ_error l ("Cannot shadow register in pattern " ^ string_of_pat pat)
+          typ_error env l ("Cannot shadow register in pattern " ^ string_of_pat pat)
        | Enum enum -> subtyp l env enum typ; annot_pat (P_id v) typ, env, []
      end
   | P_var (pat, typ_pat) ->
@@ -2538,7 +2896,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
           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
-       | _ -> typ_error l "Cannot match cons pattern against non-list type"
+       | _ -> typ_error env l "Cannot match cons pattern against non-list type"
      end
   | P_string_append pats ->
      begin
@@ -2553,7 +2911,7 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
           in
           let pats, env, guards = process_pats env pats in
           annot_pat (P_string_append pats) typ, env, guards
-       | _ -> typ_error l "Cannot match string-append pattern against non-string type"
+       | _ -> typ_error env l "Cannot match string-append pattern against non-string type"
      end
   | P_list pats ->
      begin
@@ -2568,14 +2926,14 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
           in
           let pats, env, guards = process_pats env pats in
           annot_pat (P_list pats) typ, env, guards
-       | _ -> typ_error l ("Cannot match list pattern " ^ string_of_pat pat ^ "  against non-list type " ^ string_of_typ typ)
+       | _ -> typ_error env l ("Cannot match list pattern " ^ string_of_pat pat ^ "  against non-list type " ^ string_of_typ typ)
      end
   | P_tup [] ->
      begin
        match Env.expand_synonyms env typ with
        | Typ_aux (Typ_id typ_id, _) when string_of_id typ_id = "unit" ->
           annot_pat (P_tup []) typ, env, []
-       | _ -> typ_error l "Cannot match unit pattern against non-unit type"
+       | _ -> typ_error env l "Cannot match unit pattern against non-unit type"
      end
   | P_tup pats ->
      begin
@@ -2583,11 +2941,11 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
        | Typ_aux (Typ_tup typs, _) ->
           let tpats, env, guards =
             try List.fold_left2 bind_tuple_pat ([], env, []) pats typs with
-            | Invalid_argument _ -> typ_error l "Tuple pattern and tuple type have different length"
+            | Invalid_argument _ -> typ_error env l "Tuple pattern and tuple type have different length"
           in
           annot_pat (P_tup (List.rev tpats)) typ, env, guards
        | _ ->
-          typ_error l (Printf.sprintf "Cannot bind tuple pattern %s against non tuple type %s"
+          typ_error env l (Printf.sprintf "Cannot bind tuple pattern %s against non tuple type %s"
                          (string_of_pat pat) (string_of_typ typ))
      end
   | P_app (f, pats) when Env.is_union_constructor f env ->
@@ -2608,18 +2966,18 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
               let arg_typ' = subst_unifiers unifiers arg_typ in
               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))
+                typ_raise env 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 =
                 try List.fold_left2 bind_tuple_pat ([], env, []) pats (untuple arg_typ') with
-                | Invalid_argument _ -> typ_error l "Union constructor pattern arguments have incorrect length"
+                | Invalid_argument _ -> typ_error env l "Union constructor pattern arguments have incorrect length"
               in
               annot_pat (P_app (f, List.rev tpats)) typ, env, guards
             with
-            | Unification_error (l, m) -> typ_error l ("Unification error when pattern matching against union constructor: " ^ m)
+            | Unification_error (l, m) -> typ_error env l ("Unification error when pattern matching against union constructor: " ^ m)
           end
-       | _ -> typ_error l ("Mal-formed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
+       | _ -> typ_error env l ("Mal-formed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
      end
 
   | P_app (f, pats) when Env.is_mapping f env ->
@@ -2641,13 +2999,13 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
               let arg_typ' = subst_unifiers unifiers typ1 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)
+              then typ_error env l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in pattern " ^ string_of_pat pat)
               else ();
 
               let ret_typ' = subst_unifiers unifiers typ2 in
               let tpats, env, guards =
                 try List.fold_left2 bind_tuple_pat ([], env, []) pats (untuple arg_typ') with
-                | Invalid_argument _ -> typ_error l "Mapping pattern arguments have incorrect length"
+                | Invalid_argument _ -> typ_error env l "Mapping pattern arguments have incorrect length"
               in
               annot_pat (P_app (f, List.rev tpats)) typ, env, guards
             with
@@ -2659,22 +3017,22 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
                  let arg_typ' = subst_unifiers unifiers typ2 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)
+                 then typ_error env l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in pattern " ^ string_of_pat pat)
                  else ();
                  let ret_typ' = subst_unifiers unifiers typ1 in
                  let tpats, env, guards =
                    try List.fold_left2 bind_tuple_pat ([], env, []) pats (untuple arg_typ') with
-                   | Invalid_argument _ -> typ_error l "Mapping pattern arguments have incorrect length"
+                   | Invalid_argument _ -> typ_error env l "Mapping pattern arguments have incorrect length"
                  in
                  annot_pat (P_app (f, List.rev tpats)) typ, env, guards
                with
-               | Unification_error (l, m) -> typ_error l ("Unification error when pattern matching against mapping constructor: " ^ m)
+               | Unification_error (l, m) -> typ_error env l ("Unification error when pattern matching against mapping constructor: " ^ m)
           end
-       | _ -> typ_error l ("Mal-formed mapping " ^ string_of_id f)
+       | _ -> typ_error env l ("Mal-formed mapping " ^ string_of_id f)
      end
 
   | P_app (f, _) when (not (Env.is_union_constructor f env) && not (Env.is_mapping f env)) ->
-     typ_error l (string_of_id f ^ " is not a union constructor or mapping in pattern " ^ string_of_pat pat)
+     typ_error env 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)) (typ_of_pat typed_pat), Env.add_local id (Immutable, typ_of_pat typed_pat) env, guards
@@ -2682,6 +3040,12 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
   | 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, []
+  | P_lit (L_aux (L_true, _) as lit) when is_atom_bool typ ->
+     let nc = match destruct_atom_bool env typ with Some nc -> nc | None -> assert false in
+     annot_pat (P_lit lit) (atom_bool_typ nc_true), Env.add_constraint nc env, []
+  | P_lit (L_aux (L_false, _) as lit) when is_atom_bool typ ->
+     let nc = match destruct_atom_bool env typ with Some nc -> nc | None -> assert false in
+     annot_pat (P_lit lit) (atom_bool_typ nc_false), Env.add_constraint (nc_not nc) env, []
   | _ ->
      let (inferred_pat, env, guards) = infer_pat env pat in
      match subtyp l env typ (typ_of_pat inferred_pat) with
@@ -2696,15 +3060,15 @@ and bind_pat env (P_aux (pat_aux, (l, ())) as pat) (Typ_aux (typ_aux, _) as typ)
         | _ -> raise typ_exn
 
 and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
-  let annot_pat pat typ = P_aux (pat, (l, Some ((env, typ, no_effect), None))) in
+  let annot_pat pat typ = P_aux (pat, (l, mk_tannot env typ no_effect)) in
   match pat_aux with
   | P_id v ->
      begin
        match Env.lookup_id v env with
        | Local (Immutable, _) | Unbound ->
-          typ_error l ("Cannot infer identifier in pattern " ^ string_of_pat pat ^ " - try adding a type annotation")
+          typ_error env l ("Cannot infer identifier in pattern " ^ string_of_pat pat ^ " - try adding a type annotation")
        | Local (Mutable, _) | Register _ ->
-          typ_error l ("Cannot shadow mutable local or register in switch statement pattern " ^ string_of_pat pat)
+          typ_error env l ("Cannot shadow mutable local or register in switch statement pattern " ^ string_of_pat pat)
        | Enum enum -> annot_pat (P_id v) enum, env, []
      end
   | P_app (f, mpats) when Env.is_union_constructor f env ->
@@ -2713,7 +3077,7 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
        match Env.expand_synonyms env ctor_typ with
        | Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) ->
           bind_pat env pat ret_typ
-       | _ -> typ_error l ("Mal-formed constructor " ^ string_of_id f)
+       | _ -> typ_error env l ("Mal-formed constructor " ^ string_of_id f)
      end
   | P_app (f, mpats) when Env.is_mapping f env ->
      begin
@@ -2727,7 +3091,7 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
             | Type_error _ ->
                bind_pat env pat typ1
           end
-       | _ -> typ_error l ("Malformed mapping type " ^ string_of_id f)
+       | _ -> typ_error env l ("Malformed mapping type " ^ string_of_id f)
      end
   | P_typ (typ_annot, pat) ->
      Env.wf_typ env typ_annot;
@@ -2775,7 +3139,7 @@ and infer_pat env (P_aux (pat_aux, (l, ())) as pat) =
      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)
+  | _ -> typ_error env l ("Couldn't infer type of pattern " ^ string_of_pat pat)
 
 and bind_typ_pat env (TP_aux (typ_pat_aux, l) as typ_pat) (Typ_aux (typ_aux, _) as typ) =
   match typ_pat_aux, typ_aux with
@@ -2786,25 +3150,25 @@ and bind_typ_pat env (TP_aux (typ_pat_aux, l) as typ_pat) (Typ_aux (typ_aux, _)
        | [nexp] ->
           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")
+          typ_error env l ("No numeric expressions in " ^ string_of_typ typ ^ " to bind " ^ string_of_kid kid ^ " to")
        | nexps ->
-          typ_error l ("Type " ^ string_of_typ typ ^ " has multiple numeric expressions. Cannot bind " ^ string_of_kid kid)
+          typ_error env l ("Type " ^ string_of_typ typ ^ " has multiple numeric expressions. Cannot bind " ^ string_of_kid kid)
      end
   | 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)
+  | _, _ -> typ_error env 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) (A_aux (typ_arg_aux, _) as typ_arg) =
   match typ_pat_aux, typ_arg_aux with
   | TP_wild, _ -> env
   | 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)
+  | _, A_order _ -> typ_error env l "Cannot bind type pattern against order"
+  | _, _ -> typ_error env 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) =
-  let annot_assign lexp exp = E_aux (E_assign (lexp, exp), (l, Some ((env, mk_typ (Typ_id (mk_id "unit")), no_effect), None))) in
-  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, Some ((env, typ, eff), None))) in
+  let annot_assign lexp exp = E_aux (E_assign (lexp, exp), (l, mk_tannot env (mk_typ (Typ_id (mk_id "unit"))) no_effect)) in
+  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, mk_tannot env typ eff)) in
   let annot_lexp lexp typ = annot_lexp_effect lexp typ no_effect in
   let has_typ v env =
     match Env.lookup_id v env with
@@ -2819,14 +3183,14 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
             begin match Env.lookup_id v env with
             | Register (_, _, typ) -> typ, LEXP_id v, true
             | Local (Mutable, typ) -> typ, LEXP_id v, false
-            | _ -> typ_error l "l-expression field is not a register or a local mutable type"
+            | _ -> typ_error env l "l-expression field is not a register or a local mutable type"
             end
          | LEXP_vector (LEXP_aux (LEXP_id v, _), exp) ->
             begin
               (* Check: is this ok if the vector is immutable? *)
               let is_immutable, vtyp, is_register = match Env.lookup_id v env with
-                | Unbound -> typ_error l "Cannot assign to element of unbound vector"
-                | Enum _ -> typ_error l "Cannot vector assign to enumeration element"
+                | Unbound -> typ_error env l "Cannot assign to element of unbound vector"
+                | Enum _ -> typ_error env l "Cannot vector assign to enumeration element"
                 | Local (Immutable, vtyp) -> true, vtyp, false
                 | Local (Mutable, vtyp) -> false, vtyp, false
                 | Register (_, _, vtyp) -> false, vtyp, true
@@ -2838,7 +3202,7 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
               in
               typ_of access, LEXP_vector (annot_lexp (LEXP_id v) vtyp, inferred_exp), is_register
             end
-         | _ -> typ_error l "Field l-expression must be either a vector or an identifier"
+         | _ -> typ_error env l "Field l-expression must be either a vector or an identifier"
        in
        let regtyp, inferred_flexp, is_register = infer_flexp flexp in
        typ_debug (lazy ("REGTYP: " ^ string_of_typ regtyp ^ " / " ^ string_of_typ (Env.expand_synonyms env regtyp)));
@@ -2846,11 +3210,11 @@ 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 = 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 unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q regtyp with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
           let field_typ' = subst_unifiers unifiers field_typ in
           let checked_exp = crule check_exp env exp field_typ' in
           annot_assign (annot_lexp (LEXP_field (annot_lexp_effect inferred_flexp regtyp eff, field)) field_typ') checked_exp, env
-       | _ ->  typ_error l "Field l-expression has invalid type"
+       | _ ->  typ_error env l "Field l-expression has invalid type"
      end
   | LEXP_memory (f, xs) ->
      check_exp env (E_aux (E_app (f, xs @ [exp]), (l, ()))) unit_typ, env
@@ -2876,22 +3240,22 @@ and bind_assignment env (LEXP_aux (lexp_aux, _) as lexp) (E_aux (_, (l, ())) as
        let tlexp, env' = bind_lexp env lexp (typ_of inferred_exp) in
        annot_assign tlexp inferred_exp, env'
      with
-     | Type_error (l, err) ->
+     | 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))
+        with Type_error (env, l', err') -> typ_raise env l' (Err_because (err', l, 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));
-  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, Some ((env, typ, eff),None))) in
+  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, mk_tannot env typ eff)) in
   let annot_lexp lexp typ = annot_lexp_effect lexp typ no_effect in
   match lexp_aux with
   | LEXP_cast (typ_annot, v) ->
      begin match Env.lookup_id ~raw:true v env with
        | Local (Immutable, _) | Enum _ ->
-          typ_error l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
+          typ_error env l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
        | Local (Mutable, vtyp) ->
           subtyp l env typ typ_annot;
           subtyp l env typ_annot vtyp;
@@ -2904,18 +3268,10 @@ and bind_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) typ =
           subtyp l env typ typ_annot;
           annot_lexp (LEXP_cast (typ_annot, v)) typ, Env.add_local v (Mutable, typ_annot) env
      end
-  | LEXP_deref exp ->
-     let inferred_exp = infer_exp env exp in
-     begin match typ_of inferred_exp with
-     | 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 ^ ")")
-     end
   | LEXP_id v ->
      begin match Env.lookup_id ~raw:true v env with
      | Local (Immutable, _) | Enum _ ->
-        typ_error l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
+        typ_error env l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
      | Local (Mutable, vtyp) -> subtyp l env typ vtyp; annot_lexp (LEXP_id v) typ, env
      | Register (_, weff, vtyp) -> subtyp l env typ vtyp; annot_lexp_effect (LEXP_id v) typ weff, env
      | Unbound -> annot_lexp (LEXP_id v) typ, Env.add_local v (Mutable, typ) env
@@ -2931,10 +3287,10 @@ and bind_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) typ =
           in
           let tlexps, env =
             try List.fold_right2 bind_tuple_lexp lexps typs ([], env) with
-            | Invalid_argument _ -> typ_error l "Tuple l-expression and tuple type have different length"
+            | Invalid_argument _ -> typ_error env l "Tuple l-expression and tuple type have different length"
           in
           annot_lexp (LEXP_tup tlexps) typ, env
-       | _ -> typ_error l ("Cannot bind tuple l-expression against non tuple type " ^ string_of_typ typ)
+       | _ -> typ_error env l ("Cannot bind tuple l-expression against non tuple type " ^ string_of_typ typ)
      end
   | _ ->
      let inferred_lexp = infer_lexp env lexp in
@@ -2942,7 +3298,7 @@ and bind_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) typ =
      inferred_lexp, env
 
 and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
-  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, Some ((env, typ, eff), None))) in
+  let annot_lexp_effect lexp typ eff = LEXP_aux (lexp, (l, mk_tannot env typ eff)) in
   let annot_lexp lexp typ = annot_lexp_effect lexp typ no_effect in
   match lexp_aux with
   | LEXP_id v ->
@@ -2951,9 +3307,9 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
      (* Probably need to remove flows here *)
      | Register (_, weff, typ) -> annot_lexp_effect (LEXP_id v) typ weff
      | Local (Immutable, _) | Enum _ ->
-        typ_error l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
+        typ_error env l ("Cannot modify let-bound constant or enumeration constructor " ^ string_of_id v)
      | Unbound ->
-        typ_error l ("Cannot create a new identifier in this l-expression " ^ string_of_lexp lexp)
+        typ_error env l ("Cannot create a new identifier in this l-expression " ^ string_of_lexp lexp)
      end
   | LEXP_vector_range (v_lexp, exp1, exp2) ->
      begin
@@ -2967,15 +3323,15 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
           let nexp1, env = bind_numeric l (typ_of inferred_exp1) env in
           let nexp2, env = bind_numeric l (typ_of inferred_exp2) env in
           begin match ord with
-          | Ord_aux (Ord_inc, _) when !opt_no_lexp_bounds_check || prove env (nc_lteq nexp1 nexp2) ->
+          | Ord_aux (Ord_inc, _) when !opt_no_lexp_bounds_check || prove __POS__ env (nc_lteq nexp1 nexp2) ->
              let len = nexp_simp (nsum (nminus nexp2 nexp1) (nint 1)) in
              annot_lexp (LEXP_vector_range (inferred_v_lexp, inferred_exp1, inferred_exp2)) (vector_typ len ord elem_typ)
-          | Ord_aux (Ord_dec, _) when !opt_no_lexp_bounds_check || prove env (nc_gteq nexp1 nexp2) ->
+          | Ord_aux (Ord_dec, _) when !opt_no_lexp_bounds_check || prove __POS__ env (nc_gteq nexp1 nexp2) ->
              let len = nexp_simp (nsum (nminus nexp1 nexp2) (nint 1)) in
              annot_lexp (LEXP_vector_range (inferred_v_lexp, inferred_exp1, inferred_exp2)) (vector_typ len ord elem_typ)
-          | _ -> typ_error l ("Could not infer length of vector slice assignment " ^ string_of_lexp lexp)
+          | _ -> typ_error env l ("Could not infer length of vector slice assignment " ^ string_of_lexp lexp)
           end
-       | _ -> typ_error l "Cannot assign slice of non vector type"
+       | _ -> typ_error env l "Cannot assign slice of non vector type"
      end
   | LEXP_vector (v_lexp, exp) ->
      begin
@@ -2986,13 +3342,13 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
             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
-          if !opt_no_lexp_bounds_check || prove env (nc_and (nc_lteq (nint 0) nexp) (nc_lteq nexp (nexp_simp (nminus len (nint 1))))) then
+          if !opt_no_lexp_bounds_check || prove __POS__ env (nc_and (nc_lteq (nint 0) nexp) (nc_lteq nexp (nexp_simp (nminus len (nint 1))))) then
             annot_lexp (LEXP_vector (inferred_v_lexp, inferred_exp)) elem_typ
           else
-            typ_error l ("Vector assignment not provably in bounds " ^ string_of_lexp lexp)
-       | _ -> typ_error l "Cannot assign vector element of non vector type"
+            typ_error env l ("Vector assignment not provably in bounds " ^ string_of_lexp lexp)
+       | _ -> typ_error env l "Cannot assign vector element of non vector type"
      end
-  | LEXP_vector_concat [] -> typ_error l "Cannot have empty vector concatenation l-expression"
+  | LEXP_vector_concat [] -> typ_error env l "Cannot have empty vector concatenation l-expression"
   | LEXP_vector_concat (v_lexp :: v_lexps) ->
      begin
        let sum_lengths first_ord first_elem_typ acc (Typ_aux (v_typ_aux, _) as v_typ) =
@@ -3001,7 +3357,7 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
               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
-         | _ -> typ_error l "Vector concatentation l-expression must only contain vector types of the same order"
+         | _ -> typ_error env l "Vector concatentation l-expression must only contain vector types of the same order"
        in
        let inferred_v_lexp = infer_lexp env v_lexp in
        let inferred_v_lexps = List.map (infer_lexp env) v_lexps in
@@ -3012,26 +3368,38 @@ and infer_lexp env (LEXP_aux (lexp_aux, (l, ())) as lexp) =
             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)
-       | _ -> typ_error l ("Vector concatentation l-expression must only contain vector types, found " ^ string_of_typ v_typ)
+       | _ -> typ_error env l ("Vector concatentation l-expression must only contain vector types, found " ^ string_of_typ v_typ)
      end
   | LEXP_field (LEXP_aux (LEXP_id v, _), fid) ->
      (* FIXME: will only work for ASL *)
      let rec_id, weff =
        match Env.lookup_id v env with
        | Register (_, weff, Typ_aux (Typ_id rec_id, _)) -> rec_id, weff
-       | _ -> typ_error l (string_of_lexp lexp ^ " must be a record register here")
+       | _ -> typ_error env l (string_of_lexp lexp ^ " must be a record register here")
      in
      let typq, _, ret_typ, _ = Env.get_accessor rec_id fid env in
      annot_lexp_effect (LEXP_field (annot_lexp (LEXP_id v) (mk_id_typ rec_id), fid)) ret_typ weff
+  | LEXP_deref exp ->
+     let inferred_exp = infer_exp env exp in
+     begin match typ_of inferred_exp with
+     | Typ_aux (Typ_app (r, [A_aux (A_typ vtyp, _)]), _) when string_of_id r = "register" ->
+        annot_lexp_effect (LEXP_deref inferred_exp) vtyp (mk_effect [BE_wreg])
+     | _ ->
+        typ_error env l (string_of_typ (typ_of inferred_exp)  ^ " must be a register type in " ^ string_of_exp exp ^ ")")
+     end
   | 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)
+  | _ -> typ_error env 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
+  let annot_exp_effect exp typ eff = E_aux (exp, (l, mk_tannot env typ eff)) in
   let annot_exp exp typ = annot_exp_effect exp typ no_effect in
   match exp_aux with
+  | E_block exps ->
+     let rec last_typ = function [exp] -> typ_of exp | _ :: exps -> last_typ exps | [] -> unit_typ in
+     let inferred_block = check_block l env exps None in
+     annot_exp (E_block inferred_block) (last_typ inferred_block)
   | E_nondet exps ->
      annot_exp (E_nondet (List.map (fun exp -> crule check_exp env exp unit_typ) exps)) unit_typ
   | E_id v ->
@@ -3039,13 +3407,14 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        match Env.lookup_id v env with
        | Local (_, typ) | Enum typ -> annot_exp (E_id v) typ
        | Register (reff, _, typ) -> annot_exp_effect (E_id v) typ reff
-       | Unbound -> typ_error l ("Identifier " ^ string_of_id v ^ " is unbound")
+       | Unbound -> typ_error env 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 (A_nexp nexp)])))
+  | E_sizeof nexp ->
+     irule infer_exp env (rewrite_sizeof l env (Env.expand_nexp_synonyms env nexp))
   | E_constraint nc ->
      Env.wf_constraint env nc;
-     annot_exp (E_constraint nc) bool_typ
+     crule check_exp env (rewrite_nc env (Env.expand_constraint_synonyms env nc)) (atom_bool_typ nc)
   | E_field (exp, field) ->
      begin
        let inferred_exp = irule infer_exp env exp in
@@ -3053,7 +3422,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        (* Accessing a field of a record *)
        | Typ_aux (Typ_id rectyp, _) as typ when Env.is_record rectyp env ->
           begin
-            let inferred_acc, _ = infer_funapp' l (Env.no_casts env) field (Env.get_accessor_fn rectyp field env) [strip_exp inferred_exp] None in
+            let inferred_acc = infer_funapp' l (Env.no_casts env) field (Env.get_accessor_fn rectyp field env) [strip_exp inferred_exp] None in
             match inferred_acc with
             | E_aux (E_app (field, [inferred_exp]) ,_) -> annot_exp (E_field (inferred_exp, field)) (typ_of inferred_acc)
             | _ -> assert false (* Unreachable *)
@@ -3061,12 +3430,12 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        (* Not sure if we need to do anything different with args here. *)
        | Typ_aux (Typ_app (rectyp, args), _) as typ when Env.is_record rectyp env ->
           begin
-            let inferred_acc, _ = infer_funapp' l (Env.no_casts env) field (Env.get_accessor_fn rectyp field env) [strip_exp inferred_exp] None in
+            let inferred_acc = infer_funapp' l (Env.no_casts env) field (Env.get_accessor_fn rectyp field env) [strip_exp inferred_exp] None in
             match inferred_acc with
             | E_aux (E_app (field, [inferred_exp]) ,_) -> annot_exp (E_field (inferred_exp, field)) (typ_of inferred_acc)
             | _ -> assert false (* Unreachable *)
           end
-       | _ ->  typ_error l ("Field expression " ^ string_of_exp exp ^ " :: " ^ string_of_typ (typ_of inferred_exp) ^ " is not valid")
+       | _ ->  typ_error env l ("Field expression " ^ string_of_exp exp ^ " :: " ^ string_of_typ (typ_of inferred_exp) ^ " is not valid")
      end
   | E_tuple exps ->
      let inferred_exps = List.map (irule infer_exp env) exps in
@@ -3079,11 +3448,11 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      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 ->
           rectyp_id
-       | _ -> typ_error l ("The type " ^ string_of_typ typ ^ " is not a record")
+       | _ -> typ_error env l ("The type " ^ string_of_typ typ ^ " is not a record")
      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 = 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 unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error env 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))
@@ -3102,22 +3471,22 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      let backwards_id = mk_id (string_of_id mapping ^ "_backwards") in
      typ_print (lazy ("Trying forwards direction for mapping " ^ string_of_id mapping ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
      begin try irule infer_exp env (E_aux (E_app (forwards_id, xs), (l, ()))) with
-           | Type_error (_, err1) ->
+           | Type_error (_, _, err1) ->
               (* typ_print (lazy ("Error in forwards direction: " ^ string_of_type_error err1)); *)
               typ_print (lazy ("Trying backwards direction for mapping " ^ string_of_id mapping ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
               begin try irule infer_exp env (E_aux (E_app (backwards_id, xs), (l, ()))) with
-                    | Type_error (_, err2) ->
+                    | Type_error (env, _, err2) ->
                        (* typ_print (lazy ("Error in backwards direction: " ^ string_of_type_error err2)); *)
-                       typ_raise l (Err_no_overloading (mapping, [(forwards_id, err1); (backwards_id, err2)]))
+                       typ_raise env l (Err_no_overloading (mapping, [(forwards_id, err1); (backwards_id, err2)]))
               end
      end
   | E_app (f, xs) when List.length (Env.get_overloads f env) > 0 ->
      let rec try_overload = function
-       | (errs, []) -> typ_raise l (Err_no_overloading (f, errs))
+       | (errs, []) -> typ_raise env l (Err_no_overloading (f, errs))
        | (errs, (f :: fs)) -> begin
            typ_print (lazy ("Overload: " ^ string_of_id f ^ "(" ^ string_of_list ", " string_of_exp xs ^ ")"));
            try irule infer_exp env (E_aux (E_app (f, xs), (l, ()))) with
-           | Type_error (_, err) ->
+           | Type_error (_, _, err) ->
               typ_debug (lazy "Error");
               try_overload (errs @ [(f, err)], fs)
          end
@@ -3133,7 +3502,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
        let f, t, is_dec = match ord with
          | Ord_aux (Ord_inc, _) -> f, t, false
          | Ord_aux (Ord_dec, _) -> t, f, true (* reverse direction to typechecking downto as upto loop *)
-         | Ord_aux (Ord_var _, _) -> typ_error l "Cannot check a loop with variable direction!" (* This should never happen *)
+         | Ord_aux (Ord_var _, _) -> typ_error env l "Cannot check a loop with variable direction!" (* This should never happen *)
        in
        let inferred_f = irule infer_exp env f in
        let inferred_t = irule infer_exp env t in
@@ -3149,7 +3518,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
           if not is_dec (* undo reverse direction in annotated ast for downto loop *)
           then annot_exp (E_for (v, inferred_f, inferred_t, checked_step, ord, checked_body)) unit_typ
           else annot_exp (E_for (v, inferred_t, inferred_f, checked_step, ord, checked_body)) unit_typ
-       | _, _ -> typ_error l "Ranges in foreach overlap"
+       | _, _ -> typ_error env l "Ranges in foreach overlap"
      end
   | E_if (cond, then_branch, else_branch) ->
      let cond' = crule check_exp env cond (mk_typ (Typ_id (mk_id "bool"))) in
@@ -3164,11 +3533,17 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
            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)
+        | None -> typ_error env 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')
+        begin match typ_of then_branch' with
+        | Typ_aux (Typ_app (f, [_]), _) when string_of_id f = "atom_bool" ->
+           let else_branch' = crule check_exp (add_opt_constraint (option_map nc_not (assert_constraint env false cond')) env) else_branch bool_typ in
+           annot_exp (E_if (cond', then_branch', else_branch')) bool_typ
+        | _ ->
+           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
      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, ())))
@@ -3176,7 +3551,7 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
   | E_vector_append (v1, E_aux (E_vector [], _)) -> infer_exp env v1
   | E_vector_append (v1, v2) -> infer_exp env (E_aux (E_app (mk_id "append", [v1; v2]), (l, ())))
   | E_vector_subrange (v, n, m) -> infer_exp env (E_aux (E_app (mk_id "vector_subrange", [v; n; m]), (l, ())))
-  | E_vector [] -> typ_error l "Cannot infer type of empty vector"
+  | E_vector [] -> typ_error env l "Cannot infer type of empty vector"
   | E_vector ((item :: items) as vec) ->
      let inferred_item = irule infer_exp env item in
      let checked_items = List.map (fun i -> crule check_exp env i (typ_of inferred_item)) items in
@@ -3228,25 +3603,31 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
   | E_ref id when Env.is_register id env ->
      let _, _, typ = Env.get_register id env in
      annot_exp (E_ref id) (register_typ typ)
-  | _ -> typ_error l ("Cannot infer type of: " ^ string_of_exp exp)
+  | _ -> typ_error env l ("Cannot infer type of: " ^ string_of_exp exp)
 
-and infer_funapp l env f xs ret_ctx_typ = fst (infer_funapp' l env f (Env.get_val_spec f env) xs ret_ctx_typ)
+and infer_funapp l env f xs ret_ctx_typ = infer_funapp' l env f (Env.get_val_spec f env) xs ret_ctx_typ
 
-and instantiation_of (E_aux (exp_aux, (l, _)) as exp) =
-  let env = env_of exp in
-  match exp_aux with
-  | E_app (f, xs) -> snd (infer_funapp' l (Env.no_casts env) f (Env.get_val_spec f env) (List.map strip_exp xs) (Some (typ_of exp)))
+and instantiation_of (E_aux (exp_aux, (l, tannot)) as exp) =
+  match tannot with
+  | Some t ->
+     begin match t.instantiation with
+     | Some inst -> inst
+     | None ->
+        raise (Reporting.err_unreachable l __POS__ "Passed non type-checked function to instantiation_of")
+     end
   | _ -> invalid_arg ("instantiation_of expected application,  got " ^ string_of_exp exp)
 
 and instantiation_of_without_type (E_aux (exp_aux, (l, _)) as exp) =
   let env = env_of exp in
   match exp_aux with
-  | 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)
+  | E_app (f, xs) -> instantiation_of (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 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 annot_exp exp typ eff inst =
+    E_aux (exp, (l, Some { env = env; typ = typ; effect = eff; expected = expected_ret_typ; instantiation = Some inst }))
+  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
@@ -3265,7 +3646,7 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
   let quants, typ_args, typ_ret, eff =
     match Env.expand_synonyms env f_typ with
     | 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")
+    | _ -> typ_error env l (string_of_typ f_typ ^ " is not a function type")
   in
 
   let unifiers = instantiate_simple_equations !quants in
@@ -3278,9 +3659,22 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
 
   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 implicits, typ_args, xs =
+    let typ_args' = List.filter is_not_implicit typ_args in
+    match xs, typ_args' with
+      (* Support the case where a function has only implicit arguments;
+         allow it to be called either as f() or f(i...) *)
+    | [E_aux (E_lit (L_aux (L_unit, _)), _)], [] ->
+       get_implicits typ_args, [], []
+    | _ ->
+       if not (List.length typ_args = List.length xs) then
+         if not (List.length typ_args' = List.length xs) then
+           typ_error env l (Printf.sprintf "Function %s applied to %d args, expected %d (%d explicit): %s" (string_of_id f) (List.length xs) (List.length typ_args) (List.length typ_args') (String.concat ", " (List.map string_of_typ typ_args)))
+         else
+           get_implicits typ_args, typ_args', xs
+       else
+         [], List.map implicit_to_int typ_args, xs
+  in
 
   let instantiate_quant (v, arg) (QI_aux (aux, l) as qi) =
     match aux with
@@ -3295,7 +3689,7 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
     | 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
+         let unifiers = unify l env (KidSet.diff goals (ambiguous_vars !typ_ret)) !typ_ret expect in
          record_unifiers unifiers;
          let unifiers = KBindings.bindings unifiers in
          typ_debug (lazy (Util.("Unifiers " |> magenta |> clear)
@@ -3317,7 +3711,7 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
       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
+        | Unification_error (l, m) -> typ_error env l m
       in
       record_unifiers unifiers;
       let unifiers = KBindings.bindings unifiers in
@@ -3340,8 +3734,15 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
   let xs, _, env = List.fold_left fold_instantiate ([], typ_args, env) xs in
   let xs = List.rev xs in
 
+  let solve_implicit impl = match KBindings.find_opt impl !all_unifiers with
+    | Some (A_aux (A_nexp (Nexp_aux (Nexp_constant c, _)), _)) -> irule infer_exp env (mk_lit_exp (L_num c))
+    | Some (A_aux (A_nexp n, _)) -> irule infer_exp env (mk_exp (E_sizeof n))
+    | _ -> typ_error env l ("Cannot solve implicit " ^ string_of_kid impl ^ " in " ^ string_of_exp (mk_exp (E_app (f, List.map strip_exp xs))))
+  in
+  let xs = List.map solve_implicit implicits @ xs 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))
+    typ_raise env l (Err_unresolved_quants (f, !quants, Env.get_locals env, Env.get_constraints env))
   else ();
 
   let ty_vars = KBindings.bindings (Env.get_typ_vars env) |> List.map (fun (v, k) -> mk_kopt k v) in
@@ -3354,23 +3755,22 @@ and infer_funapp' l env f (typq, f_typ) xs expected_ret_typ =
 
   let universals = KBindings.bindings universals |> List.map fst |> KidSet.of_list in
   let typ_ret =
-    if KidSet.is_empty (KidSet.of_list (List.map kopt_kid existentials)) || KidSet.is_empty (KidSet.diff (typ_frees !typ_ret) universals)
+    if KidSet.is_empty (KidSet.of_list (List.map kopt_kid existentials)) || KidSet.is_empty (KidSet.diff (tyvars_of_typ !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)) typ_ret eff in
+  let exp = annot_exp (E_app (f, xs)) typ_ret eff !all_unifiers in
   typ_debug (lazy ("Returning: " ^ string_of_exp exp));
-
-  exp, !all_unifiers
+  exp
 
 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
-  typ_print (lazy ("Binding " ^ string_of_mpat mpat ^  " to " ^ string_of_typ typ));
-  let annot_mpat mpat typ' = MP_aux (mpat, (l, Some ((env, typ', no_effect), Some typ))) in
+  let (Typ_aux (typ_aux, _) as typ), env = bind_existential l None typ env in
+  typ_print (lazy (Util.("Binding " |> yellow |> clear) ^ string_of_mpat mpat ^  " to " ^ string_of_typ typ));
+  let annot_mpat mpat typ' = MP_aux (mpat, (l, mk_expected_tannot env typ' no_effect (Some typ))) in
   let switch_typ mpat typ = match mpat with
-    | MP_aux (pat_aux, (l, Some ((env, _, eff), exp_typ))) -> MP_aux (pat_aux, (l, Some ((env, typ, eff), exp_typ)))
-    | _ -> typ_error l "Cannot switch type for unannotated mapping-pattern"
+    | MP_aux (pat_aux, (l, Some tannot)) -> MP_aux (pat_aux, (l, Some { tannot with typ = typ }))
+    | _ -> typ_error env l "Cannot switch type for unannotated mapping-pattern"
   in
   let bind_tuple_mpat (tpats, env, guards) mpat typ =
     let tpat, env, guards' = bind_mpat allow_unknown other_env env mpat typ in tpat :: tpats, env, guards' @ guards
@@ -3388,7 +3788,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
        match Env.lookup_id v env with
        | Local (Immutable, _) | Unbound -> annot_mpat (MP_id v) typ, Env.add_local v (Immutable, typ) env, []
        | Local (Mutable, _) | Register _ ->
-          typ_error l ("Cannot shadow mutable local or register in switch statement mapping-pattern " ^ string_of_mpat mpat)
+          typ_error env l ("Cannot shadow mutable local or register in switch statement mapping-pattern " ^ string_of_mpat mpat)
        | Enum enum -> subtyp l env enum typ; annot_mpat (MP_id v) typ, env, []
      end
   | MP_cons (hd_mpat, tl_mpat) ->
@@ -3398,7 +3798,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
           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
-       | _ -> typ_error l "Cannot match cons mapping-pattern against non-list type"
+       | _ -> typ_error env l "Cannot match cons mapping-pattern against non-list type"
      end
   | MP_string_append mpats ->
      begin
@@ -3413,7 +3813,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
           in
           let pats, env, guards = process_mpats env mpats in
           annot_mpat (MP_string_append pats) typ, env, guards
-       | _ -> typ_error l "Cannot match string-append pattern against non-string type"
+       | _ -> typ_error env l "Cannot match string-append pattern against non-string type"
      end
   | MP_list mpats ->
      begin
@@ -3428,14 +3828,14 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
           in
           let mpats, env, guards = process_mpats env mpats in
           annot_mpat (MP_list mpats) typ, env, guards
-       | _ -> typ_error l ("Cannot match list mapping-pattern " ^ string_of_mpat mpat ^ "  against non-list type " ^ string_of_typ typ)
+       | _ -> typ_error env l ("Cannot match list mapping-pattern " ^ string_of_mpat mpat ^ "  against non-list type " ^ string_of_typ typ)
      end
   | MP_tup [] ->
      begin
        match Env.expand_synonyms env typ with
        | Typ_aux (Typ_id typ_id, _) when string_of_id typ_id = "unit" ->
           annot_mpat (MP_tup []) typ, env, []
-       | _ -> typ_error l "Cannot match unit mapping-pattern against non-unit type"
+       | _ -> typ_error env l "Cannot match unit mapping-pattern against non-unit type"
      end
   | MP_tup mpats ->
      begin
@@ -3443,10 +3843,10 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
        | Typ_aux (Typ_tup typs, _) ->
           let tpats, env, guards =
             try List.fold_left2 bind_tuple_mpat ([], env, []) mpats typs with
-            | Invalid_argument _ -> typ_error l "Tuple mapping-pattern and tuple type have different length"
+            | Invalid_argument _ -> typ_error env l "Tuple mapping-pattern and tuple type have different length"
           in
           annot_mpat (MP_tup (List.rev tpats)) typ, env, guards
-       | _ -> typ_error l "Cannot bind tuple mapping-pattern against non tuple type"
+       | _ -> typ_error env l "Cannot bind tuple mapping-pattern against non tuple type"
      end
   | MP_app (f, mpats) when Env.is_union_constructor f env ->
      begin
@@ -3465,18 +3865,18 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
               let arg_typ' = subst_unifiers unifiers arg_typ 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)
+              then typ_error env l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
               else ();
               let ret_typ' = subst_unifiers unifiers ret_typ in
               let tpats, env, guards =
                 try List.fold_left2 bind_tuple_mpat ([], env, []) mpats (untuple arg_typ') with
-                | Invalid_argument _ -> typ_error l "Union constructor mapping-pattern arguments have incorrect length"
+                | Invalid_argument _ -> typ_error env l "Union constructor mapping-pattern arguments have incorrect length"
               in
               annot_mpat (MP_app (f, List.rev tpats)) typ, env, guards
             with
-            | Unification_error (l, m) -> typ_error l ("Unification error when mapping-pattern matching against union constructor: " ^ m)
+            | Unification_error (l, m) -> typ_error env l ("Unification error when mapping-pattern matching against union constructor: " ^ m)
           end
-       | _ -> typ_error l ("Mal-formed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
+       | _ -> typ_error env l ("Mal-formed constructor " ^ string_of_id f ^ " with type " ^ string_of_typ ctor_typ)
      end
   | MP_app (other, mpats) when Env.is_mapping other env ->
      begin
@@ -3495,12 +3895,12 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
               let arg_typ' = subst_unifiers unifiers typ1 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)
+              then typ_error env l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
               else ();
               let ret_typ' = subst_unifiers unifiers typ2 in
               let tpats, env, guards =
                 try List.fold_left2 bind_tuple_mpat ([], env, []) mpats (untuple arg_typ') with
-                | Invalid_argument _ -> typ_error l "Mapping pattern arguments have incorrect length"
+                | Invalid_argument _ -> typ_error env l "Mapping pattern arguments have incorrect length"
               in
               annot_mpat (MP_app (other, List.rev tpats)) typ, env, guards
             with
@@ -3512,22 +3912,22 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
                  let arg_typ' = subst_unifiers unifiers typ2 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)
+                 then typ_error env l ("Quantifiers " ^ string_of_list ", " string_of_quant_item quants' ^ " not resolved in mapping-pattern " ^ string_of_mpat mpat)
                  else ();
                  let ret_typ' = subst_unifiers unifiers typ1 in
                  let tpats, env, guards =
                    try List.fold_left2 bind_tuple_mpat ([], env, []) mpats (untuple arg_typ') with
-                   | Invalid_argument _ -> typ_error l "Mapping pattern arguments have incorrect length"
+                   | Invalid_argument _ -> typ_error env l "Mapping pattern arguments have incorrect length"
                  in
                  annot_mpat (MP_app (other, List.rev tpats)) typ, env, guards
                with
-               | Unification_error (l, m) -> typ_error l ("Unification error when pattern matching against mapping constructor: " ^ m)
+               | Unification_error (l, m) -> typ_error env l ("Unification error when pattern matching against mapping constructor: " ^ m)
           end
        | Typ_aux (typ, _) ->
-          typ_error l ("unifying mapping type, expanded synonyms to non-mapping type??")
+          typ_error env l ("unifying mapping type, expanded synonyms to non-mapping type??")
      end
   | MP_app (f, _) when not (Env.is_union_constructor f env || Env.is_mapping f env) ->
-     typ_error l (string_of_id f ^ " is not a union constructor or mapping in mapping-pattern " ^ string_of_mpat mpat)
+     typ_error env l (string_of_id f ^ " is not a union constructor or mapping in mapping-pattern " ^ string_of_mpat mpat)
   | MP_as (mpat, id) ->
      let (typed_mpat, env, guards) = bind_mpat allow_unknown other_env env mpat typ in
      (annot_mpat (MP_as (typed_mpat, id)) (typ_of_mpat typed_mpat),
@@ -3537,6 +3937,13 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
   | MP_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_mpat (MP_lit lit) (atom_typ (nconstant n)), Env.add_constraint (nc_eq nexp (nconstant n)) env, []
+  (* Similarly, for boolean literals *)
+  | MP_lit (L_aux (L_true, _) as lit) when is_atom_bool typ ->
+     let nc = match destruct_atom_bool env typ with Some n -> n | None -> assert false in
+     annot_mpat (MP_lit lit) (atom_bool_typ nc_true), Env.add_constraint nc env, []
+  | MP_lit (L_aux (L_false, _) as lit) when is_atom_bool typ ->
+     let nc = match destruct_atom_bool env typ with Some n -> n | None -> assert false in
+     annot_mpat (MP_lit lit) (atom_bool_typ nc_false), Env.add_constraint (nc_not nc) env, []
   | _ ->
      let (inferred_mpat, env, guards) = infer_mpat allow_unknown other_env env mpat in
      match subtyp l env typ (typ_of_mpat inferred_mpat) with
@@ -3550,7 +3957,7 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) (
            typed_mpat, env, guard::guards
         | _ -> raise typ_exn
 and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat) =
-  let annot_mpat mpat typ = MP_aux (mpat, (l, Some ((env, typ, no_effect), None))) in
+  let annot_mpat mpat typ = MP_aux (mpat, (l, mk_tannot env typ no_effect)) in
   match mpat_aux with
   | MP_id v ->
      begin
@@ -3560,11 +3967,11 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
           | Local (Immutable, typ) -> bind_mpat allow_unknown other_env env (mk_mpat (MP_typ (mk_mpat (MP_id v), typ))) typ
           | Unbound ->
              if allow_unknown then annot_mpat (MP_id v) unknown_typ, env, [] else
-               typ_error l ("Cannot infer identifier in mapping-pattern " ^ string_of_mpat mpat ^ " - try adding a type annotation")
+               typ_error env l ("Cannot infer identifier in mapping-pattern " ^ string_of_mpat mpat ^ " - try adding a type annotation")
           | _ -> assert false
           end
        | Local (Mutable, _) | Register _ ->
-          typ_error l ("Cannot shadow mutable local or register in mapping-pattern " ^ string_of_mpat mpat)
+          typ_error env l ("Cannot shadow mutable local or register in mapping-pattern " ^ string_of_mpat mpat)
        | Enum enum -> annot_mpat (MP_id v) enum, env, []
      end
   | MP_app (f, mpats) when Env.is_union_constructor f env ->
@@ -3573,7 +3980,7 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
        match Env.expand_synonyms env ctor_typ with
        | Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) ->
           bind_mpat allow_unknown other_env env mpat ret_typ
-       | _ -> typ_error l ("Mal-formed constructor " ^ string_of_id f)
+       | _ -> typ_error env l ("Mal-formed constructor " ^ string_of_id f)
      end
   | MP_app (f, mpats) when Env.is_mapping f env ->
      begin
@@ -3587,7 +3994,7 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
             | Type_error _ ->
                bind_mpat allow_unknown other_env env mpat typ1
           end
-       | _ -> typ_error l ("Malformed mapping type " ^ string_of_id f)
+       | _ -> typ_error env l ("Malformed mapping type " ^ string_of_id f)
      end
   | MP_lit lit ->
      annot_mpat (MP_lit lit) (infer_lit env lit), env, []
@@ -3640,20 +4047,20 @@ and infer_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, ())) as mpat)
       guards)
 
   | _ ->
-     typ_error l ("Couldn't infer type of mapping-pattern " ^ string_of_mpat mpat)
+     typ_error env l ("Couldn't infer type of mapping-pattern " ^ string_of_mpat mpat)
 
 (**************************************************************************)
-(* 5. Effect system                                                       *)
+(* 6. Effect system                                                       *)
 (**************************************************************************)
 
 let effect_of_annot = function
-| Some ((_, _, eff), _) -> eff
+| Some t -> t.effect
 | None -> no_effect
 
 let effect_of (E_aux (exp, (l, annot))) = effect_of_annot annot
 
 let add_effect_annot annot eff = match annot with
-  | Some ((env, typ, eff'), exp_typ) -> Some ((env, typ, union_effects eff eff'), exp_typ)
+  | Some tannot -> Some { tannot with effect = union_effects eff tannot.effect }
   | None -> None
 
 let add_effect (E_aux (exp, (l, annot))) eff =
@@ -3814,8 +4221,8 @@ and propagate_exp_effect_aux = function
   | E_internal_return exp ->
      let p_exp = propagate_exp_effect exp in
      E_internal_return p_exp, effect_of p_exp
-  | exp_aux -> typ_error Parse_ast.Unknown ("Unimplemented: Cannot propagate effect in expression "
-                                            ^ string_of_exp (E_aux (exp_aux, (Parse_ast.Unknown, None))))
+  | exp_aux -> typ_error Env.empty Parse_ast.Unknown ("Unimplemented: Cannot propagate effect in expression "
+                                                      ^ string_of_exp (E_aux (exp_aux, (Parse_ast.Unknown, None))))
 
 and propagate_fexp_effect (FE_aux (FE_Fexp (id, exp), (l, _))) =
   let p_exp = propagate_exp_effect exp in
@@ -3828,9 +4235,9 @@ and propagate_pexp_effect = function
        let p_exp = propagate_exp_effect exp in
        let p_eff = union_effects (effect_of_pat p_pat) (effect_of p_exp) in
        match annot with
-       | Some ((typq, typ, eff), exp_typ) ->
-          Pat_aux (Pat_exp (p_pat, p_exp), (l, Some ((typq, typ, union_effects eff p_eff), exp_typ))),
-         union_effects eff p_eff
+       | Some tannot ->
+          Pat_aux (Pat_exp (p_pat, p_exp), (l, Some { tannot with effect = union_effects tannot.effect p_eff })),
+          union_effects tannot.effect p_eff
        | None -> Pat_aux (Pat_exp (p_pat, p_exp), (l, None)), p_eff
      end
   | Pat_aux (Pat_when (pat, guard, exp), (l, annot)) ->
@@ -3842,9 +4249,9 @@ and propagate_pexp_effect = function
                                           (union_effects (effect_of p_guard) (effect_of p_exp))
        in
        match annot with
-       | Some ((typq, typ, eff), exp_typ) ->
-          Pat_aux (Pat_when (p_pat, p_guard, p_exp), (l, Some ((typq, typ, union_effects eff p_eff), exp_typ))),
-          union_effects eff p_eff
+       | Some tannot ->
+          Pat_aux (Pat_when (p_pat, p_guard, p_exp), (l, Some { tannot with effect = union_effects tannot.effect p_eff })),
+          union_effects tannot.effect p_eff
        | None -> Pat_aux (Pat_when (p_pat, p_guard, p_exp), (l, None)), p_eff
      end
 
@@ -3854,9 +4261,9 @@ and propagate_mpexp_effect = function
        let p_mpat = propagate_mpat_effect mpat in
        let p_eff = effect_of_mpat p_mpat in
        match annot with
-       | Some ((typq, typ, eff), exp_typ) ->
-          MPat_aux (MPat_pat p_mpat, (l, Some ((typq, typ, union_effects eff p_eff), exp_typ))),
-         union_effects eff p_eff
+       | Some tannot ->
+          MPat_aux (MPat_pat p_mpat, (l, Some { tannot with effect = union_effects tannot.effect p_eff })),
+         union_effects tannot.effect p_eff
        | None -> MPat_aux (MPat_pat p_mpat, (l, None)), p_eff
      end
   | MPat_aux (MPat_when (mpat, guard), (l, annot)) ->
@@ -3866,9 +4273,9 @@ and propagate_mpexp_effect = function
        let p_eff = union_effects (effect_of_mpat p_mpat) (effect_of p_guard)
        in
        match annot with
-       | Some ((typq, typ, eff), exp_typ) ->
-          MPat_aux (MPat_when (p_mpat, p_guard), (l, Some ((typq, typ, union_effects eff p_eff), exp_typ))),
-          union_effects eff p_eff
+       | Some tannot ->
+          MPat_aux (MPat_when (p_mpat, p_guard), (l, Some { tannot with effect = union_effects tannot.effect p_eff })),
+          union_effects tannot.effect p_eff
        | None -> MPat_aux (MPat_when (p_mpat, p_guard), (l, None)), p_eff
      end
 
@@ -3917,7 +4324,7 @@ and propagate_pat_effect_aux = function
   | P_vector pats ->
      let p_pats = List.map propagate_pat_effect pats in
      P_vector p_pats, collect_effects_pat p_pats
-  | _ -> typ_error Parse_ast.Unknown "Unimplemented: Cannot propagate effect in pat"
+  | _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented: Cannot propagate effect in pat")
 
 and propagate_mpat_effect (MP_aux (mpat, annot)) =
   let p_mpat, eff = propagate_mpat_effect_aux mpat in
@@ -3953,12 +4360,12 @@ and propagate_mpat_effect_aux = function
   | MP_as (mpat, id) ->
      let p_mpat = propagate_mpat_effect mpat in
      MP_as (p_mpat, id), effect_of_mpat mpat
-  | _ -> typ_error Parse_ast.Unknown "Unimplemented: Cannot propagate effect in mpat"
+  | _ -> raise (Reporting.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented: Cannot propagate effect in mpat")
 
 and propagate_letbind_effect (LB_aux (lb, (l, annot))) =
   let p_lb, eff = propagate_letbind_effect_aux lb in
   match annot with
-  | Some ((typq, typ, eff), exp_typ) -> LB_aux (p_lb, (l, Some ((typq, typ, eff), exp_typ))), eff
+  | Some tannot -> LB_aux (p_lb, (l, Some { tannot with effect = eff })), eff
   | None -> LB_aux (p_lb, (l, None)), eff
 and propagate_letbind_effect_aux = function
   | LB_val (pat, exp) ->
@@ -4000,7 +4407,7 @@ and propagate_lexp_effect_aux = function
      LEXP_field (p_lexp, id),effect_of_lexp p_lexp
 
 (**************************************************************************)
-(* 6. Checking toplevel definitions                                       *)
+(* 7. Checking toplevel definitions                                       *)
 (**************************************************************************)
 
 let check_letdef orig_env (LB_aux (letbind, (l, _))) =
@@ -4013,20 +4420,21 @@ let check_letdef orig_env (LB_aux (letbind, (l, _))) =
        if (BESet.is_empty (effect_set (effect_of checked_bind)) || !opt_no_effects)
        then
          [DEF_val (LB_aux (LB_val (tpat, checked_bind), (l, None)))], env
-       else typ_error l ("Top-level definition with effects " ^ string_of_effect (effect_of checked_bind))
+       else typ_error env l ("Top-level definition with effects " ^ string_of_effect (effect_of checked_bind))
     | LB_val (pat, bind) ->
        let inferred_bind = propagate_exp_effect (irule infer_exp orig_env (strip_exp bind)) in
        let tpat, env = bind_pat_no_guard orig_env (strip_pat pat) (typ_of inferred_bind) in
        if (BESet.is_empty (effect_set (effect_of inferred_bind)) || !opt_no_effects)
        then
          [DEF_val (LB_aux (LB_val (tpat, inferred_bind), (l, None)))], env
-       else typ_error l ("Top-level definition with effects " ^ string_of_effect (effect_of inferred_bind))
+       else typ_error env l ("Top-level definition with effects " ^ string_of_effect (effect_of inferred_bind))
   end
 
 let check_funcl env (FCL_aux (FCL_Funcl (id, pexp), (l, _))) typ =
   match typ with
   | Typ_aux (Typ_fn (typ_args, typ_ret, eff), _) ->
      begin
+       let typ_args = List.map implicit_to_int typ_args in
        let env = Env.add_ret_typ typ_ret env in
        (* We want to forbid polymorphic undefined values in all cases,
           except when type checking the specific undefined_(type)
@@ -4043,15 +4451,15 @@ let check_funcl env (FCL_aux (FCL_Funcl (id, pexp), (l, _))) typ =
           function arguments as like a tuple, and maybe we
           shouldn't. *)
        let typed_pexp, prop_eff =
-         match typ_args with
+         match List.map implicit_to_int typ_args with
          | [typ_arg] ->
             propagate_pexp_effect (check_case env typ_arg (strip_pexp pexp) typ_ret)
-         | _ ->
+         | typ_args ->
             propagate_pexp_effect (check_case env (Typ_aux (Typ_tup typ_args, l)) (strip_pexp pexp) typ_ret)
        in
-       FCL_aux (FCL_Funcl (id, typed_pexp), (l, Some ((env, typ, prop_eff), Some typ)))
+       FCL_aux (FCL_Funcl (id, typed_pexp), (l, mk_expected_tannot env typ prop_eff (Some typ)))
      end
-  | _ -> typ_error l ("Function clause must have function type: " ^ string_of_typ typ ^ " is not a function type")
+  | _ -> typ_error env l ("Function clause must have function type: " ^ string_of_typ typ ^ " is not a function type")
 
 
 let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
@@ -4068,7 +4476,7 @@ let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
 
             let typed_mpexp1, prop_eff1 = propagate_mpexp_effect (check_mpexp right_id_env env (strip_mpexp mpexp1) typ1) in
             let typed_mpexp2, prop_eff2 = propagate_mpexp_effect (check_mpexp left_id_env env (strip_mpexp mpexp2) typ2) in
-            MCL_aux (MCL_bidir (typed_mpexp1, typed_mpexp2), (l, Some ((env, typ, union_effects prop_eff1 prop_eff2), Some typ)))
+            MCL_aux (MCL_bidir (typed_mpexp1, typed_mpexp2), (l, mk_expected_tannot env typ (union_effects prop_eff1 prop_eff2) (Some typ)))
           end
         | MCL_forwards (mpexp, exp) -> begin
             let mpat, _, _ = destruct_mpexp mpexp in
@@ -4076,7 +4484,7 @@ let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
             let typed_mpexp, prop_eff1 = propagate_mpexp_effect (check_mpexp Env.empty env (strip_mpexp mpexp) typ1) in
             let typed_exp = propagate_exp_effect (check_exp mpat_env (strip_exp exp) typ2) in
             let prop_effs = union_effects prop_eff1 (effect_of typed_exp) in
-            MCL_aux (MCL_forwards (typed_mpexp, typed_exp), (l, Some ((env, typ, prop_effs), Some typ)))
+            MCL_aux (MCL_forwards (typed_mpexp, typed_exp), (l, mk_expected_tannot env typ prop_effs (Some typ)))
           end
         | MCL_backwards (mpexp, exp) -> begin
             let mpat, _, _ = destruct_mpexp mpexp in
@@ -4084,20 +4492,19 @@ let check_mapcl : 'a. Env.t -> 'a mapcl -> typ -> tannot mapcl =
             let typed_mpexp, prop_eff1 = propagate_mpexp_effect (check_mpexp Env.empty env (strip_mpexp mpexp) typ2) in
             let typed_exp = propagate_exp_effect (check_exp mpat_env (strip_exp exp) typ1) in
             let prop_effs = union_effects prop_eff1 (effect_of typed_exp) in
-            MCL_aux (MCL_backwards (typed_mpexp, typed_exp), (l, Some ((env, typ, prop_effs), Some typ)))
+            MCL_aux (MCL_backwards (typed_mpexp, typed_exp), (l, mk_expected_tannot 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 env 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
-  | Some ((_, _, eff), _) -> eff
+  | Some t -> t.effect
   | None -> no_effect (* Maybe could be assert false. This should never happen *)
 
-
 let mapcl_effect (MCL_aux (_, (l, annot))) =
   match annot with
-  | Some ((_, _, eff), _) -> eff
+  | Some t -> t.effect
   | None -> no_effect (* Maybe could be assert false. This should never happen *)
 
 let infer_funtyp l env tannotopt funcls =
@@ -4109,7 +4516,7 @@ let infer_funtyp l env tannotopt funcls =
          | P_lit lit -> infer_lit env lit
          | P_typ (typ, _) -> typ
          | P_tup pats -> mk_typ (Typ_tup (List.map typ_from_pat pats))
-         | _ -> typ_error l ("Cannot infer type from pattern " ^ string_of_pat pat)
+         | _ -> typ_error env l ("Cannot infer type from pattern " ^ string_of_pat pat)
        in
        match funcls with
        | [FCL_aux (FCL_Funcl (_, Pat_aux (pexp,_)), _)] ->
@@ -4124,9 +4531,9 @@ let infer_funtyp l env tannotopt funcls =
           in
           let fn_typ = mk_typ (Typ_fn (arg_typs, ret_typ, Effect_aux (Effect_set [], Parse_ast.Unknown))) in
           (quant, fn_typ)
-       | _ -> typ_error l "Cannot infer function type for function with multiple clauses"
+       | _ -> typ_error env l "Cannot infer function type for function with multiple clauses"
      end
-  | Typ_annot_opt_aux (Typ_annot_opt_none, _) -> typ_error l "Cannot infer function type for unannotated function"
+  | Typ_annot_opt_aux (Typ_annot_opt_none, _) -> typ_error env l "Cannot infer function type for unannotated function"
 
 let mk_val_spec env typq typ id =
   let eff =
@@ -4134,14 +4541,14 @@ let mk_val_spec env typq typ id =
     | Typ_aux (Typ_fn (_,_,eff),_) -> eff
     | _ -> no_effect
   in
-  DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ), Parse_ast.Unknown), id, [], false), (Parse_ast.Unknown, Some ((env,typ,eff),None))))
+  DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ), Parse_ast.Unknown), id, [], false), (Parse_ast.Unknown, mk_tannot env typ eff)))
 
 let check_tannotopt env typq ret_typ = function
   | Typ_annot_opt_aux (Typ_annot_opt_none, _) -> ()
   | Typ_annot_opt_aux (Typ_annot_opt_some (annot_typq, annot_ret_typ), l) ->
      if typ_identical env ret_typ annot_ret_typ
      then ()
-     else typ_error l (string_of_bind (typq, ret_typ) ^ " and " ^ string_of_bind (annot_typq, annot_ret_typ) ^ " do not match between function and val spec")
+     else typ_error env l (string_of_bind (typq, ret_typ) ^ " and " ^ string_of_bind (annot_typq, annot_ret_typ) ^ " do not match between function and val spec")
 
 let check_termination_measure env arg_typs pat exp =
   let typ = match arg_typs with [x] -> x | _ -> Typ_aux (Typ_tup arg_typs,Unknown) in
@@ -4153,7 +4560,7 @@ let check_termination_measure_decl env (id, pat, exp) =
   let quant, typ = Env.get_val_spec id env in
   let arg_typs, l = match typ with
     | Typ_aux (Typ_fn (arg_typs, _ ,_),l) -> arg_typs,l
-    | _ -> typ_error (id_loc id) "Function val spec is not a function type"
+    | _ -> typ_error env (id_loc id) "Function val spec is not a function type"
   in
   let env = add_typquant l quant env in
   let tpat, texp = check_termination_measure env arg_typs pat exp in
@@ -4165,23 +4572,24 @@ let check_fundef env (FD_aux (FD_function (recopt, tannotopt, effectopt, funcls)
              (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 typ_error l ("Function declaration expects all definitions to have the same name, "
+                             else typ_error env 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 -> typ_error l "funcl list is empty"
+    | None -> typ_error env l "funcl list is empty"
   in
   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, _) ->
+    | Type_error (_, l, _) ->
        let (quant, typ) = infer_funtyp l env tannotopt funcls in
        false, (quant, typ), env
   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 is not a function type"
+    | Typ_aux (Typ_fn (vtyp_args, vtyp_ret, declared_eff), vl) ->
+       vtyp_args, vtyp_ret, declared_eff, vl
+    | _ -> typ_error env 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)));
@@ -4204,17 +4612,17 @@ let check_fundef env (FD_aux (FD_function (recopt, tannotopt, effectopt, funcls)
     else [], env, declared_eff
   in
   let env = Env.define_val_spec id env in
-  if (equal_effects eff declared_eff || !opt_no_effects)
+  if (subseteq_effects eff declared_eff || !opt_no_effects)
   then
     vs_def @ [DEF_fundef (FD_aux (FD_function (recopt, tannotopt, effectopt, funcls), (l, None)))], env
-  else typ_error l ("Effects do not match: " ^ string_of_effect declared_eff ^ " declared and " ^ string_of_effect eff ^ " found")
+  else typ_error env l ("Effects do not match: " ^ string_of_effect declared_eff ^ " declared and " ^ string_of_effect eff ^ " found")
 
 
 let check_mapdef env (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, _)) as md_aux) =
   typ_print (lazy ("\nChecking mapping " ^ string_of_id id));
   let have_val_spec, (quant, typ), env =
     try true, Env.get_val_spec id env, env with
-    | Type_error (l, _) as err ->
+    | Type_error (_, l, _) as err ->
        match tannot_opt with
        | Typ_annot_opt_aux (Typ_annot_opt_some (quant, typ), _) ->
           false, (quant, typ), env
@@ -4223,18 +4631,18 @@ let check_mapdef env (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, _)) as md
   in
   let vtyp1, vtyp2, vl = match typ with
     | Typ_aux (Typ_bidir (vtyp1, vtyp2), vl) -> vtyp1, vtyp2, vl
-    | _ -> typ_error l "Mapping val spec was not a mapping type"
+    | _ -> typ_error env l "Mapping val spec was not a mapping type"
   in
   begin match tannot_opt with
   | Typ_annot_opt_aux (Typ_annot_opt_none, _) -> ()
   | Typ_annot_opt_aux (Typ_annot_opt_some (annot_typq, annot_typ), l) ->
      if typ_identical env typ annot_typ then ()
-     else typ_error l (string_of_bind (quant, typ) ^ " and " ^ string_of_bind (annot_typq, annot_typ) ^ " do not match between mapping and val spec")
+     else typ_error env l (string_of_bind (quant, typ) ^ " and " ^ string_of_bind (annot_typq, annot_typ) ^ " do not match between mapping and val spec")
   end;
   typ_debug (lazy ("Checking mapdef " ^ string_of_id id ^ " has type " ^ string_of_bind (quant, typ)));
   let vs_def, env =
     if not have_val_spec then
-      [mk_val_spec env quant typ id], Env.add_val_spec id (quant, typ) env
+      [mk_val_spec env quant (Env.expand_synonyms env typ) id], Env.add_val_spec id (quant, typ) env
     else
       [], env
   in
@@ -4245,13 +4653,13 @@ let check_mapdef env (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, _)) as md
   if equal_effects eff no_effect || equal_effects eff (mk_effect [BE_escape]) || !opt_no_effects then
     vs_def @ [DEF_mapdef (MD_aux (MD_mapping (id, tannot_opt, mapcls), (l, None)))], env
   else
-    typ_error l ("Mapping not pure (or escape only): " ^ string_of_effect eff ^ " found")
+    typ_error env 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. *)
 let check_val_spec env (VS_aux (vs, (l, _))) =
-  let annotate vs typ eff = DEF_spec (VS_aux (vs, (l, Some ((env, typ, eff), None)))) in
+  let annotate vs typ eff = DEF_spec (VS_aux (vs, (l, mk_tannot env typ eff))) in
   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));
@@ -4281,7 +4689,7 @@ let check_default env (DT_aux (ds, l)) =
   match ds with
   | DT_order (Ord_aux (Ord_inc, _)) -> [DEF_default (DT_aux (ds, l))], Env.set_default_order_inc env
   | DT_order (Ord_aux (Ord_dec, _)) -> [DEF_default (DT_aux (ds, l))], Env.set_default_order_dec env
-  | DT_order (Ord_aux (Ord_var _, _)) -> typ_error l "Cannot have variable default order"
+  | DT_order (Ord_aux (Ord_var _, _)) -> typ_error env l "Cannot have variable default order"
 
 let kinded_id_arg kind_id =
   let typ_arg arg = A_aux (arg, Parse_ast.Unknown) in
@@ -4304,7 +4712,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 K_type) (KidSet.elements (typ_frees typ))) in
+     let typq = mk_typquant (List.map (mk_qi_id K_type) (KidSet.elements (tyvars_of_typ typ))) in
      env
      |> Env.add_union_id v (typq, typ)
      |> Env.add_val_spec v (typq, typ)
@@ -4321,57 +4729,48 @@ let mk_synonym typq typ_arg =
   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 =
+  let rec subst_args env l kopts args =
     match kopts, args with
     | kopt :: kopts, A_aux (A_nexp arg, _) :: args when is_nat_kopt kopt ->
-       let typ_arg, ncs = subst_args kopts args in
+       let typ_arg, ncs = subst_args env l 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
+       let typ_arg, ncs = subst_args env l 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
+       let typ_arg, ncs = subst_args env l 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
+       let typ_arg, ncs = subst_args env l 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"
+    | _, _ -> typ_error env l "Synonym applied to bad arguments"
   in
-  fun env args ->
-    let typ_arg, ncs = subst_args kopts args in
-    if List.for_all (prove env) ncs
+  fun l env args ->
+    let typ_arg, ncs = subst_args env l kopts args in
+    if List.for_all (prove __POS__ env) ncs
     then typ_arg
-    else typ_error Parse_ast.Unknown ("Could not prove constraints " ^ string_of_list ", " string_of_n_constraint ncs
+    else typ_error env Parse_ast.Unknown ("Could not prove constraints " ^ string_of_list ", " string_of_n_constraint ncs
                                       ^ " 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.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented kind def") in
-  match kdef with
-  | 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.err_unreachable Parse_ast.Unknown __POS__ "Unimplemented Typedef") in
   match tdef with
   | 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, _) ->
+  | TD_record (id, typq, fields, _) ->
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_record id typq fields env
-  | TD_variant (id, nmscm, typq, arms, _) ->
+  | TD_variant (id, typq, arms, _) ->
      let env =
        env
        |> Env.add_variant id (typq, arms)
        |> (fun env -> List.fold_left (fun env tu -> check_type_union env id typq tu) env arms)
      in
      [DEF_type (TD_aux (tdef, (l, None)))], env
-  | TD_enum (id, nmscm, ids, _) ->
+  | TD_enum (id, ids, _) ->
      [DEF_type (TD_aux (tdef, (l, None)))], Env.add_enum id ids env
   | TD_bitfield (id, typ, ranges) ->
      let typ = Env.expand_synonyms env typ in
@@ -4383,18 +4782,21 @@ let rec check_typedef : 'a. Env.t -> 'a type_def -> (tannot def) list * Env.t =
                                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
+          let eval_index_nexp env nexp =
+            int_of_nexp_opt (nexp_simp (Env.expand_nexp_synonyms env nexp)) in
+          let (Defs defs), env =
+            check env (Bitfield.macro (eval_index_nexp env, (typ_error env)) id size order ranges) in
           defs, env
        | _ ->
-          typ_error l "Bad bitfield type"
+          typ_error env 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_variant (id, typq) ->
+     [DEF_scattered (SD_aux (SD_variant (id, 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
@@ -4415,7 +4817,6 @@ and check_def : 'a. Env.t -> 'a def -> (tannot def) list * Env.t =
   fun env def ->
   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
@@ -4431,27 +4832,31 @@ and check_def : 'a. Env.t -> 'a def -> (tannot def) list * Env.t =
   | DEF_spec vs -> check_val_spec env vs
   | DEF_default default -> check_default env default
   | DEF_overload (id, ids) -> [DEF_overload (id, ids)], Env.add_overloads id ids env
-  | DEF_reg_dec (DEC_aux (DEC_reg (typ, id), (l, _))) ->
-     let env = Env.add_register id (mk_effect [BE_rreg]) (mk_effect [BE_wreg]) typ env in
-     [DEF_reg_dec (DEC_aux (DEC_reg (typ, id), (l, Some ((env, typ, no_effect), Some typ))))], env
+  | DEF_reg_dec (DEC_aux (DEC_reg (reffect, weffect, typ, id), (l, _))) ->
+     let env = Env.add_register id reffect weffect typ env in
+     [DEF_reg_dec (DEC_aux (DEC_reg (reffect, weffect, typ, id), (l, mk_expected_tannot env typ no_effect (Some typ))))], env
   | DEF_reg_dec (DEC_aux (DEC_config (id, typ, exp), (l, _))) ->
      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_reg_dec (DEC_aux (DEC_config (id, typ, checked_exp), (l, mk_expected_tannot 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 sdef -> check_scattered env sdef
   | DEF_measure (id, pat, exp) -> [check_termination_measure_decl env (id, pat, exp)], env
 
-and check : 'a. Env.t -> 'a defs -> tannot defs * Env.t =
-  fun env (Defs defs) ->
+and check_defs : 'a. int -> int -> Env.t -> 'a def list -> tannot defs * Env.t =
+  fun n total env defs ->
   match defs with
-  | [] -> (Defs []), env
+  | [] -> Defs [], env
   | def :: defs ->
+     Util.progress "Type check " (string_of_int n ^ "/" ^ string_of_int total) n total;
      let (def, env) = check_def env def in
-     let (Defs defs, env) = check env (Defs defs) in
-     (Defs (def @ defs)), env
+     let Defs defs, env = check_defs (n + 1) total env defs in
+     Defs (def @ defs), env
+
+and check : 'a. Env.t -> 'a defs -> tannot defs * Env.t =
+  fun env (Defs defs) -> let total = List.length defs in check_defs 1 total env defs
 
 and check_with_envs : 'a. Env.t -> 'a def list -> (tannot def list * Env.t) list =
   fun env defs ->
@@ -4463,7 +4868,7 @@ and check_with_envs : 'a. Env.t -> 'a def list -> (tannot def list * Env.t) list
 
 let initial_env =
   Env.empty
-  |> Env.add_prover prove
+  |> Env.add_prover (prove __POS__)
   (* |> Env.add_typ_synonym (mk_id "atom") (fun _ args -> mk_typ (Typ_app (mk_id "range", args @ args))) *)
 
   (* Internal functions for Monomorphise.AtomToItself *)
diff --git a/src/type_check.mli b/src/type_check.mli
index c17d5e0b..4ff52cd9 100644
--- a/src/type_check.mli
+++ b/src/type_check.mli
@@ -80,9 +80,11 @@ type type_error =
   | 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
+  | Err_because of type_error * Ast.l * type_error
 
-exception Type_error of l * type_error;;
+type env
+
+exception Type_error of env * l * type_error;;
 
 val typ_debug : ?level:int -> string Lazy.t -> unit
 val typ_print : string Lazy.t -> unit
@@ -93,7 +95,7 @@ val typ_print : string Lazy.t -> unit
    contains functions that operate on that state. *)
 module Env : sig
   (** Env.t is the type of environments *)
-  type t
+  type t = env
 
   (** Note: Most get_ functions assume the identifiers exist, and throw
      type errors if they don't. *)
@@ -118,6 +120,8 @@ module Env : sig
 
   val add_local : id -> mut * typ -> t -> t
 
+  val add_scattered_variant : id -> typquant -> t -> t
+
   (** Check if a local variable is mutable. Throws Type_error if it
      isn't a local variable. Probably best to use Env.lookup_id
      instead *)
@@ -150,12 +154,8 @@ 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_arg)
-
   val get_overloads : id -> t -> id list
 
-  val get_num_def : id -> t -> nexp
-
   val is_extern : id -> t -> string -> bool
 
   val get_extern : id -> t -> string -> string
@@ -182,6 +182,10 @@ module Env : sig
      old one. *)
   val fresh_kid : ?kid:kid -> t -> kid
 
+  val expand_constraint_synonyms : t -> n_constraint -> n_constraint
+
+  val expand_nexp_synonyms : t -> nexp -> nexp
+    
   val expand_synonyms : t -> typ -> typ
 
   (** Expand type synonyms and remove register annotations (i.e. register<t> -> t)) *)
@@ -214,8 +218,8 @@ val add_typquant : Ast.l -> typquant -> Env.t -> Env.t
    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 destruct_exist_plain : ?name:string option -> typ -> (kinded_id list * n_constraint * typ) option
+val destruct_exist : ?name:string option -> typ -> (kinded_id list * n_constraint * typ) option
 
 val add_existential : Ast.l -> kinded_id list -> n_constraint -> Env.t -> Env.t
 
@@ -305,7 +309,7 @@ val check_fundef : Env.t -> 'a fundef -> tannot def list * Env.t
 
 val check_val_spec : Env.t -> 'a val_spec -> tannot def list * Env.t
 
-val prove : Env.t -> n_constraint -> bool
+val prove : (string * int * int * int) -> Env.t -> n_constraint -> bool
 
 val solve : Env.t -> nexp -> Big_int.num option
 
@@ -320,7 +324,7 @@ val bind_pat : Env.t -> unit pat -> typ -> tannot pat * Env.t * unit Ast.exp lis
    on patterns that have previously been type checked. *)
 val bind_pat_no_guard : Env.t -> unit pat -> typ -> tannot pat * Env.t
 
-val typ_error : Ast.l -> string -> 'a
+val typ_error : Env.t -> Ast.l -> string -> 'a
 
 (** {2 Destructuring type annotations} Partial functions: The
    expressions and patterns passed to these functions must be
@@ -358,9 +362,11 @@ val expected_typ_of : Ast.l * tannot -> typ option
 
 val destruct_atom_nexp : Env.t -> typ -> nexp option
 
+val destruct_atom_bool : Env.t -> typ -> n_constraint option
+
 val destruct_range : Env.t -> typ -> (kid list * n_constraint * nexp * nexp) option
 
-val destruct_numeric : typ -> (kid list * n_constraint * nexp) option
+val destruct_numeric : ?name:string option -> typ -> (kid list * n_constraint * nexp) option
 
 val destruct_vector : Env.t -> typ -> (nexp * order * typ) option
 
diff --git a/src/type_error.ml b/src/type_error.ml
index 9144e993..e75d2cd4 100644
--- a/src/type_error.ml
+++ b/src/type_error.ml
@@ -48,63 +48,16 @@
 (*  SUCH DAMAGE.                                                          *)
 (**************************************************************************)
 
-open PPrint
 open Util
 open Ast
 open Ast_util
 open Type_check
 
-let bullet f xs =
-  group (separate_map hardline (fun x -> string "* " ^^ nest 2 (f x)) xs)
-
-let pp_nexp, pp_n_constraint =
-  let pp_nexp' nexp =
-    string (string_of_nexp nexp)
-  in
-
-  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
+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
@@ -126,7 +79,7 @@ let rec analyze_unresolved_quant2 locals ncs = function
          | _ -> []
        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
+       let nc = List.fold_left (fun nc (v, nexp) -> constraint_subst v (arg_nexp nexp) nc) nc substs in
        if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
          Suggest_add_constraint nc
        else
@@ -140,7 +93,7 @@ let rec analyze_unresolved_quant2 locals ncs = function
               []
          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
+         let nc = List.fold_left (fun nc (v, nexp, _) -> constraint_subst v (arg_nexp nexp) nc) nc substs in
          if not (KidSet.exists is_kid_generated (tyvars_of_constraint nc)) then
            Suggest_none
          else
@@ -149,124 +102,89 @@ let rec analyze_unresolved_quant2 locals ncs = function
   | 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
+let message_of_type_error =
+  let open Error_format in
+  let rec msg = function
+    | Err_because (err, l', err') ->
+       Seq [msg err;
+            Line "This error occured because of a previous error:";
+            Location (l', msg err')]
 
-  | QI_aux (QI_id kopt, _) ->
-     empty
+    | Err_other str -> Line str
 
-let rec pp_type_error = function
-  | 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 "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) ->
+       Seq [Line ("No overloading for " ^ string_of_id id ^ ", tried:");
+            List (List.map (fun (id, err) -> string_of_id id, msg err) errs)]
 
-  | 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_unresolved_quants (id, quants, locals, ncs) ->
+       Seq [Line ("Could not resolve quantifiers for " ^ string_of_id id);
+            Line (bullet ^ " " ^ Util.string_of_list ("\n" ^ bullet ^ " ") string_of_quant_item quants)]
 
-  | Err_subtype (typ1, typ2, constrs, locs) ->
-     (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.loc_to_string l ^ "\n")) (KBindings.bindings locs)
+    | Err_subtype (typ1, typ2, _, vars) ->
+       let vars = KBindings.bindings vars in
+       let vars = List.filter (fun (v, _) -> KidSet.mem v (KidSet.union (tyvars_of_typ typ1) (tyvars_of_typ typ2))) vars in
+       With ((fun ppf -> { ppf with loc_color = Util.yellow }),
+             Seq (Line (string_of_typ typ1 ^ " is not a subtype of " ^ string_of_typ typ2)
+                  :: List.map (fun (kid, l) -> Location (l, Line (string_of_kid kid ^ " bound here"))) vars))
 
   | Err_no_num_ident id ->
-     string "No num identifier" ^^ space ^^ string (string_of_id id)
-
-  | 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)
+     Line ("No num identifier " ^ string_of_id id)
 
-  (* 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
+  | Err_no_casts (exp, typ_from, typ_to, trigger, reasons) ->
+     let coercion =
+       Line ("Tried performing type coercion from " ^ string_of_typ typ_from
+             ^ " to " ^ string_of_typ typ_to
+             ^ " on " ^ string_of_exp exp)
+     in
+     Seq ([coercion; Line "Coercion failed because:"; msg trigger]
+          @ if not (reasons = []) then
+              Line "Possible reasons:" :: List.map msg reasons
+            else
+              [])
+  in
+  msg
 
 let rec string_of_type_error err =
-  let open PPrint in
+  let open Error_format in
   let b = Buffer.create 20 in
-  ToBuffer.pretty 1. 400 b (pp_type_error err);
-  "\n" ^ Buffer.contents b
+  format_message (message_of_type_error err) (buffer_formatter b);
+  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_no_overloading (_, errs) as no_collapse) ->
+     let errs = List.map (fun (_, err) -> collapse_errors err) errs in
+     let interesting = function
+       | Err_other _ -> false
+       | Err_no_casts _ -> false
+       | _ -> true
+     in
+     begin match List.filter interesting errs with
+     | err :: errs ->
+        let fold_equal msg err =
+          match msg, err with
+          | Some msg, Err_no_overloading _ -> 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
+     | [] -> no_collapse
+     end
+  | Err_because (err1, l, err2) as no_collapse ->
+     let err1 = collapse_errors err1 in
+     let err2 = collapse_errors err2 in
+     if string_of_type_error err1 = string_of_type_error err2 then
+       err1
+     else
+       Err_because (err1, l, err2)
   | 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.err_typ l (string_of_type_error err))
+  | Type_error (env, l, err) ->
+     Interactive.env := env;
+     raise (Reporting.err_typ l (string_of_type_error err))
diff --git a/src/util.ml b/src/util.ml
index 5e5654d1..0ff00df1 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -96,6 +96,7 @@
 
 let opt_warnings = ref true
 let opt_colors = ref true
+let opt_verbosity = ref 0
 
 let rec last = function
   | [x] -> x
@@ -465,3 +466,32 @@ 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) '='
+
+let verbose_endline level str =
+  if level >= !opt_verbosity then
+    prerr_endline str
+  else
+    ()
+
+let progress prefix msg n total =
+  if !opt_verbosity > 0 then
+    let len = truncate ((float n /. float total) *. 50.0) in
+    let percent = truncate ((float n /. float total) *. 100.0) in
+    let msg =
+      if String.length msg <= 20 then
+        msg ^ ")" ^ String.make (20 - String.length msg) ' '
+      else
+        String.sub msg 0 17 ^ "...)"
+    in
+    let str = prefix ^ "[" ^ String.make len '=' ^ String.make (50 - len) ' ' ^ "] "
+              ^ string_of_int percent ^ "%"
+              ^ " (" ^ msg
+    in
+    prerr_string str;
+    if n = total then
+      prerr_char '\n'
+    else
+      prerr_string ("\x1B[" ^ string_of_int (String.length str) ^ "D");
+    flush stderr
+  else
+    ()
diff --git a/src/util.mli b/src/util.mli
index fd0242a3..51504941 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -53,6 +53,7 @@ val last : 'a list -> 'a
 
 val opt_warnings : bool ref
 val opt_colors : bool ref
+val opt_verbosity : int ref
 
 val butlast : 'a list -> 'a list
 
@@ -263,3 +264,5 @@ val file_encode_string : string -> string
 
 val log_line : string -> int -> string -> string
 val header : string -> int -> string
+
+val progress : string -> string -> int -> int -> unit